![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to ox_asir.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / io|
Return to ox_asir.c CVS log | Up to [local] / OpenXM_contrib2 / asir2000 / io |
1.15 noro 1: /*
2: * Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED
3: * All rights reserved.
4: *
5: * FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited,
6: * non-exclusive and royalty-free license to use, copy, modify and
7: * redistribute, solely for non-commercial and non-profit purposes, the
8: * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and
9: * conditions of this Agreement. For the avoidance of doubt, you acquire
10: * only a limited right to use the SOFTWARE hereunder, and FLL or any
11: * third party developer retains all rights, including but not limited to
12: * copyrights, in and to the SOFTWARE.
13: *
14: * (1) FLL does not grant you a license in any way for commercial
15: * purposes. You may use the SOFTWARE only for non-commercial and
16: * non-profit purposes only, such as academic, research and internal
17: * business use.
18: * (2) The SOFTWARE is protected by the Copyright Law of Japan and
19: * international copyright treaties. If you make copies of the SOFTWARE,
20: * with or without modification, as permitted hereunder, you shall affix
21: * to all such copies of the SOFTWARE the above copyright notice.
22: * (3) An explicit reference to this SOFTWARE and its copyright owner
23: * shall be made on your publication or presentation in any form of the
24: * results obtained by use of the SOFTWARE.
25: * (4) In the event that you modify the SOFTWARE, you shall notify FLL by
1.16 noro 26: * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
1.15 noro 27: * for such modification or the source code of the modified part of the
28: * SOFTWARE.
29: *
30: * THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL
31: * MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND
32: * EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS
33: * FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES'
34: * RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY
35: * MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY.
36: * UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT,
37: * OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY
38: * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL
39: * DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES
40: * ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES
41: * FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY
42: * DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF
43: * SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART
44: * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY
45: * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
46: * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
1.55 ! noro 47: * $OpenXM: OpenXM_contrib2/asir2000/io/ox_asir.c,v 1.54 2004/03/04 06:29:47 noro Exp $
1.15 noro 48: */
1.1 noro 49: #include "ca.h"
50: #include "parse.h"
1.6 noro 51: #include "signal.h"
1.1 noro 52: #include "ox.h"
53: #include "version.h"
1.41 ohara 54: #if defined(PARI)
1.6 noro 55: #include "genpari.h"
56: #endif
1.1 noro 57:
58: void ox_usr1_handler();
1.13 noro 59: int asir_ox_init();
1.1 noro 60:
1.36 noro 61: /* environement is defined in libpari.a */
1.51 saito 62: # if !( PARI_VERSION_CODE > 131588)
1.36 noro 63: extern jmp_buf environnement;
1.51 saito 64: # endif
1.45 noro 65: extern int myrank_102,nserver_102;
1.1 noro 66:
67: extern int do_message;
68: extern int ox_flushing;
1.35 noro 69: extern JMP_BUF ox_env;
1.1 noro 70: extern MATHCAP my_mathcap;
71:
1.11 noro 72: extern int little_endian,ox_sock_id;
73:
1.1 noro 74: int ox_sock_id;
1.11 noro 75: int lib_ox_need_conv;
1.1 noro 76:
1.19 noro 77: void create_error(ERR *,unsigned int ,char *);
78:
1.20 noro 79: int asir_OperandStackSize;
80: Obj *asir_OperandStack;
81: int asir_OperandStackPtr = -1;
82:
83: void ox_io_init();
1.40 noro 84: void ox_asir_init(int,char **,char *);
1.20 noro 85: Obj asir_pop_one();
86: Obj asir_peek_one();
87: void asir_push_one(Obj);
88: void asir_end_flush();
89: int asir_executeString();
90: void asir_evalName(unsigned int);
91: void asir_setName(unsigned int);
92: void asir_pops();
93: void asir_popString();
94: void asir_popCMO(unsigned int);
95: void asir_popSerializedLocalObject();
96: void asir_pushCMOtag(unsigned int);
1.45 noro 97: void asir_set_rank_102(unsigned int);
98: void asir_tcp_accept_102(unsigned int);
99: void asir_tcp_connect_102(unsigned int);
100: void asir_reset_102(unsigned int serial);
1.47 noro 101: void asir_bcast_102(unsigned int serial);
102: void asir_reduce_102(unsigned int serial);
1.20 noro 103: LIST asir_GetErrorList();
104: char *name_of_cmd(int);
105: char *name_of_id(int);
106:
107: static void asir_do_cmd(int,unsigned int);
1.1 noro 108: static void asir_executeFunction(int);
109:
1.43 noro 110: #if defined(MPI)
1.14 noro 111: /* XXX : currently MPI version supports only a homogeneous cluster. */
112:
1.1 noro 113: extern int mpi_nprocs,mpi_myid;
114:
115: void ox_mpi_master_init() {
1.14 noro 116: int i,idx;
1.1 noro 117:
1.14 noro 118: for ( i = 0; i < mpi_nprocs; i++ ) {
119: /* ordering information is not exchanged */
120: /* idx should be equal to i */
1.1 noro 121: idx = get_iofp(i,0,0);
1.14 noro 122: register_server(0,idx,idx);
1.1 noro 123: }
124: }
125:
126: void ox_mpi_slave_init() {
1.14 noro 127: int i,idx;
128:
1.1 noro 129: endian_init();
130: fclose(stdin);
1.14 noro 131: for ( i = 0; i < mpi_nprocs; i++ ) {
132: /* ordering information is not exchanged */
133: /* idx should be equal to i */
134: idx = get_iofp(i,0,0);
135: register_server(0,idx,idx);
136: }
1.1 noro 137: asir_OperandStackSize = BUFSIZ;
138: asir_OperandStack = (Obj *)CALLOC(asir_OperandStackSize,sizeof(Obj));
139: asir_OperandStackPtr = -1;
140: }
141: #endif
142:
143: void ox_main(int argc,char **argv) {
144: int id;
1.13 noro 145: int cmd;
1.1 noro 146: Obj obj;
147: ERR err;
148: unsigned int serial;
149: int ret;
150: extern char LastError[];
151:
1.40 noro 152: ox_asir_init(argc,argv,"ox_asir");
1.1 noro 153: if ( do_message )
154: fprintf(stderr,"I'm an ox_asir, Version %d.\n",ASIR_VERSION);
1.35 noro 155: if ( SETJMP(ox_env) ) {
1.1 noro 156: while ( NEXT(asir_infile) )
157: closecurrentinput();
158: ox_send_sync(0);
159: }
160: while ( 1 ) {
161: extern int recv_intr;
162:
163: serial = ox_recv(0,&id,&obj);
164: #if defined(VISUAL)
165: if ( recv_intr ) {
166: if ( recv_intr == 1 ) {
167: recv_intr = 0;
168: int_handler(SIGINT);
169: } else {
170: recv_intr = 0;
171: ox_usr1_handler(0);
172: }
173: }
174: #endif
175: if ( do_message )
176: fprintf(stderr,"#%d Got %s",serial,name_of_id(id));
177: switch ( id ) {
178: case OX_COMMAND:
179: cmd = ((USINT)obj)->body;
180: if ( ox_flushing )
181: break;
182: if ( do_message )
183: fprintf(stderr," %s\n",name_of_cmd(cmd));
1.35 noro 184: if ( ret = SETJMP(main_env) ) {
1.1 noro 185: if ( ret == 1 ) {
186: create_error(&err,serial,LastError);
187: asir_push_one((Obj)err);
1.54 noro 188: while ( NEXT(asir_infile) )
189: closecurrentinput();
1.1 noro 190: }
191: break;
192: }
193: asir_do_cmd(cmd,serial);
194: break;
195: case OX_DATA:
196: case OX_LOCAL_OBJECT_ASIR:
197: if ( ox_flushing )
198: break;
199: if ( do_message )
200: fprintf(stderr," -> data pushed");
201: asir_push_one(obj);
202: break;
203: case OX_SYNC_BALL:
204: asir_end_flush();
205: break;
206: default:
207: break;
208: }
209: if ( do_message )
210: fprintf(stderr,"\n");
211: }
212: }
213:
1.13 noro 214: static void asir_do_cmd(int cmd,unsigned int serial)
1.1 noro 215: {
216: MATHCAP client_mathcap;
217: Q q;
218: int i;
219: LIST list;
220:
221: switch ( cmd ) {
222: case SM_dupErrors:
223: list = asir_GetErrorList();
224: asir_push_one((Obj)list);
225: break;
226: case SM_getsp:
227: i = asir_OperandStackPtr+1;
228: STOQ(i,q);
229: asir_push_one((Obj)q);
230: break;
231: case SM_popSerializedLocalObject:
232: asir_popSerializedLocalObject();
233: break;
234: case SM_popCMO:
235: asir_popCMO(serial);
236: break;
237: case SM_popString:
238: asir_popString();
239: break;
240: case SM_setName:
241: asir_setName(serial);
242: break;
243: case SM_evalName:
244: asir_evalName(serial);
245: break;
246: case SM_executeStringByLocalParser:
247: asir_executeString();
248: break;
249: case SM_executeStringByLocalParserInBatchMode:
250: asir_executeString();
251: asir_pop_one();
252: break;
253: case SM_executeFunction:
254: asir_executeFunction(serial);
255: break;
256: case SM_shutdown:
257: asir_terminate(2);
258: break;
259: case SM_pops:
260: asir_pops();
261: break;
262: case SM_mathcap:
263: asir_push_one((Obj)my_mathcap);
264: break;
265: case SM_setMathcap:
266: client_mathcap = (MATHCAP)asir_pop_one();
267: store_remote_mathcap(0,client_mathcap);
268: break;
1.18 noro 269: case SM_pushCMOtag:
270: asir_pushCMOtag(serial);
271: break;
1.45 noro 272: case SM_set_rank_102:
273: asir_set_rank_102(serial);
274: break;
275: case SM_tcp_accept_102:
276: asir_tcp_accept_102(serial);
277: break;
278: case SM_tcp_connect_102:
279: asir_tcp_connect_102(serial);
280: break;
281: case SM_reset_102:
282: asir_reset_102(serial);
283: break;
1.47 noro 284: case SM_bcast_102:
285: asir_bcast_102(serial);
286: break;
287: case SM_reduce_102:
288: asir_reduce_102(serial);
289: break;
1.1 noro 290: case SM_nop:
291: default:
292: break;
293: }
294: }
295:
1.20 noro 296: char *name_of_id(int id)
1.1 noro 297: {
298: switch ( id ) {
299: case OX_COMMAND:
300: return "OX_COMMAND";
301: break;
302: case OX_DATA:
303: return "OX_DATA";
304: break;
305: case OX_LOCAL_OBJECT_ASIR:
306: return "OX_LOCAL_OBJECT_ASIR";
307: break;
308: case OX_SYNC_BALL:
309: return "OX_SYNC_BALL";
310: break;
311: default:
312: return "Unknown id";
313: break;
314: }
315: }
316:
1.20 noro 317: char *name_of_cmd(int cmd)
1.1 noro 318: {
319: switch ( cmd ) {
320: case SM_popSerializedLocalObject:
321: return "SM_popSerializedLocalObject";
322: break;
323: case SM_popCMO:
324: return "SM_popCMO";
325: break;
326: case SM_popString:
327: return "SM_popString";
328: break;
329: case SM_pops:
330: return "SM_pops";
331: break;
332: case SM_setName:
333: return "SM_setName";
334: break;
335: case SM_evalName:
336: return "SM_evalName";
337: break;
338: case SM_executeStringByLocalParser:
339: return "SM_executeString";
340: break;
341: case SM_executeFunction:
342: return "SM_executeFunction";
343: break;
344: case SM_shutdown:
345: return "SM_shutdown";
346: break;
347: case SM_beginBlock:
348: return "SM_beginBlock";
349: break;
350: case SM_endBlock:
351: return "SM_endBlock";
352: break;
353: case SM_mathcap:
354: return "SM_mathcap";
355: break;
356: case SM_setMathcap:
357: return "SM_setMathcap";
358: break;
359: case SM_getsp:
360: return "SM_setMathcap";
361: break;
362: case SM_dupErrors:
363: return "SM_dupErrors";
364: break;
365: case SM_nop:
366: return "SM_nop";
1.18 noro 367: case SM_pushCMOtag:
368: return "SM_pushCMOtag";
1.45 noro 369: case SM_set_rank_102:
370: return "SM_set_rank_102";
371: break;
372: case SM_tcp_accept_102:
373: return "SM_tcp_accept_102";
374: break;
375: case SM_tcp_connect_102:
376: return "SM_tcp_connect_102";
377: case SM_reset_102:
378: return "SM_reset_102";
379: break;
1.47 noro 380: case SM_bcast_102:
381: return "SM_bcast_102";
382: break;
383: case SM_reduce_102:
384: return "SM_reduce_102";
385: break;
1.1 noro 386: default:
387: return "Unknown cmd";
388: break;
389: }
390: }
391:
1.20 noro 392: LIST asir_GetErrorList()
1.1 noro 393: {
394: int i;
395: NODE n,n0;
396: LIST err;
397: Obj obj;
398:
399: for ( i = 0, n0 = 0; i <= asir_OperandStackPtr; i++ )
400: if ( (obj = asir_OperandStack[i]) && (OID(obj) == O_ERR) ) {
401: NEXTNODE(n0,n); BDY(n) = (pointer)obj;
402: }
403: if ( n0 )
404: NEXT(n) = 0;
405: MKLIST(err,n0);
406: return err;
407: }
408:
1.20 noro 409: void asir_popSerializedLocalObject()
1.1 noro 410: {
411: Obj obj;
412: VL t,vl;
413:
414: obj = asir_pop_one();
415: get_vars_recursive(obj,&vl);
416: for ( t = vl; t; t = NEXT(t) )
417: if ( t->v->attr == (pointer)V_UC )
418: error("bsave : not implemented");
419: ox_send_cmd(0,SM_beginBlock);
420: ox_send_local_ring(0,vl);
421: ox_send_local_data(0,obj);
422: ox_send_cmd(0,SM_endBlock);
423: }
424:
1.20 noro 425: void asir_popCMO(unsigned int serial)
1.1 noro 426: {
427: Obj obj;
428: ERR err;
429:
430: obj = asir_pop_one();
431: if ( valid_as_cmo(obj) )
432: ox_send_data(0,obj);
433: else {
434: create_error(&err,serial,"cannot convert to CMO object");
435: ox_send_data(0,err);
436: asir_push_one(obj);
1.45 noro 437: }
438: }
439:
1.47 noro 440: void asir_reduce_102(unsigned int serial)
441: {
442: Q r;
443: int root;
444: Obj data,obj;
445: ERR err;
446: STRING op;
447: char *opname;
448: void (*func)();
449:
450: func = 0;
451: op = (STRING)asir_pop_one();
452: opname = BDY(op);
453: r = (Q)asir_pop_one();
454: root = QTOS(r);
455: if ( !strcmp(opname,"+") )
456: func = arf_add;
457: else if ( !strcmp(opname,"*") )
458: func = arf_mul;
459: if ( !func ) {
460: create_error(&err,serial,"Invalid opration in ox_reduce_102");
461: asir_push_one(obj);
462: } else
463: ox_reduce_102(root,func);
464: }
465:
466: void asir_bcast_102(unsigned int serial)
467: {
468: Q r;
469: int root;
470: Obj data;
471:
472: r = (Q)asir_pop_one();
473: root = QTOS(r);
474: ox_bcast_102(root);
475: }
476:
1.45 noro 477: void asir_reset_102(unsigned int serial)
478: {
479: int i,j,id;
480: Obj obj;
481:
482: for ( i = 0; i < myrank_102; i++ )
483: do {
484: ox_recv_102(i,&id,&obj);
485: } while ( id != OX_SYNC_BALL );
1.50 noro 486: for ( i = myrank_102+1; i < nserver_102; i++ )
1.45 noro 487: ox_send_sync_102(i);
488: }
489:
490: void asir_set_rank_102(unsigned int serial)
491: {
492: Obj obj;
493: Q rank,nserver;
494: int n,r,stat;
495: NODE arg;
496: ERR err;
497:
498: rank = (Q)asir_pop_one();
499: nserver = (Q)asir_pop_one();
500: stat = 0;
501: if ( !nserver || !INT(nserver) || !INT(rank) ) {
502: stat = -1;
503: } else {
504: n = QTOS(nserver); r = QTOS(rank);
505: if ( n <= 0 || r < 0 || r >= n ) {
506: stat = -1;
507: }
508: myrank_102 = r;
509: nserver_102 = n;
510: }
511: if ( !stat ) return;
512: else {
513: create_error(&err,serial,"Invalid argument(s) in ox_set_rank_102");
514: asir_push_one(obj);
515: }
516: }
517:
518: void asir_tcp_accept_102(unsigned int serial)
519: {
520: Obj obj;
1.46 noro 521: Q r,p;
1.45 noro 522: ERR err;
1.46 noro 523: char port_str[BUFSIZ];
524: int port,s,use_unix,rank;
1.45 noro 525:
1.46 noro 526: r = (Q)asir_pop_one();
527: p = (Q)asir_pop_one();
528: if ( IS_CYGWIN || !p || NUM(p) ) {
529: port = QTOS(p);
530: sprintf(port_str,"%d",port);
531: use_unix = 0;
532: } else {
533: strcpy(port_str,BDY((STRING)p));
534: use_unix = 1;
535: }
536: s = try_bind_listen(use_unix,port_str);
537: s = try_accept(use_unix,s);
538: rank = QTOS((Q)r);
539: if ( register_102(s,rank,1) < 0 ) {
540: create_error(&err,serial,
541: "failed to bind or accept in ox_tcp_accept_102");
1.45 noro 542: asir_push_one((Obj)err);
543: }
544: }
545:
546: void asir_tcp_connect_102(unsigned int serial)
547: {
548: Obj obj;
1.46 noro 549: Q r,p;
550: STRING h;
1.45 noro 551: ERR err;
1.46 noro 552: char *host;
553: char port_str[BUFSIZ];
554: int port,s,use_unix,rank;
555:
556: r = (Q)asir_pop_one();
557: p = (Q)asir_pop_one();
558: h = (STRING)asir_pop_one();
559: if ( IS_CYGWIN || !p || NUM(p) ) {
560: port = QTOS(p);
561: sprintf(port_str,"%d",port);
562: use_unix = 0;
1.49 noro 563: host = BDY((STRING)h);
1.46 noro 564: } else {
565: strcpy(port_str,BDY((STRING)p));
566: use_unix = 1;
1.49 noro 567: host = 0;
1.46 noro 568: }
569: s = try_connect(use_unix,host,port_str);
570: rank = QTOS((Q)r);
571: if ( register_102(s,rank,1) < 0 ) {
572: create_error(&err,serial,
1.48 noro 573: "failed to connect in ox_tcp_connect_102");
1.45 noro 574: asir_push_one((Obj)err);
1.1 noro 575: }
576: }
577:
1.20 noro 578: void asir_pushCMOtag(unsigned int serial)
1.18 noro 579: {
580: Obj obj;
581: ERR err;
582: USINT ui;
583: int tag;
584:
585: obj = asir_peek_one();
586: if ( cmo_tag(obj,&tag) ) {
587: MKUSINT(ui,tag);
588: asir_push_one((Obj)ui);
589: } else {
590: create_error(&err,serial,"cannot convert to CMO object");
591: asir_push_one((Obj)err);
592: }
593: }
594:
1.20 noro 595: void asir_popString()
1.1 noro 596: {
597: Obj val;
1.53 noro 598: char *buf;
1.1 noro 599: int l;
600: STRING str;
601:
602: val = asir_pop_one();
603: if ( !val )
1.53 noro 604: buf = "0";
1.1 noro 605: else {
606: l = estimate_length(CO,val);
607: buf = (char *)ALLOCA(l+1);
608: soutput_init(buf);
609: sprintexpr(CO,val);
610: }
1.52 noro 611: MKSTR(str,buf);
1.1 noro 612: ox_send_data(0,str);
613: }
614:
1.20 noro 615: void asir_pops()
1.1 noro 616: {
617: int n;
618:
619: n = (int)(((USINT)asir_pop_one())->body);
620: asir_OperandStackPtr = MAX(asir_OperandStackPtr-n,-1);
621: }
622:
1.20 noro 623: void asir_setName(unsigned int serial)
1.1 noro 624: {
625: char *name;
626: int l,n;
627: char *dummy = "=0;";
628: SNODE snode;
629: ERR err;
630:
631: name = ((STRING)asir_pop_one())->body;
632: l = strlen(name);
633: n = l+strlen(dummy)+1;
634: parse_strp = (char *)ALLOCA(n);
635: sprintf(parse_strp,"%s%s",name,dummy);
636: if ( mainparse(&snode) ) {
637: create_error(&err,serial,"cannot set to variable");
638: asir_push_one((Obj)err);
639: } else {
640: FA1((FNODE)FA0(snode)) = (pointer)mkfnode(1,I_FORMULA,asir_pop_one());
641: evalstat(snode);
642: }
643: }
644:
1.20 noro 645: void asir_evalName(unsigned int serial)
1.1 noro 646: {
647: char *name;
648: int l,n;
649: SNODE snode;
650: ERR err;
651: pointer val;
652:
653: name = ((STRING)asir_pop_one())->body;
654: l = strlen(name);
655: n = l+2;
656: parse_strp = (char *)ALLOCA(n);
657: sprintf(parse_strp,"%s;",name);
658: if ( mainparse(&snode) ) {
659: create_error(&err,serial,"no such variable");
660: val = (pointer)err;
661: } else
662: val = evalstat(snode);
663: asir_push_one(val);
664: }
665:
1.55 ! noro 666: char *augment_backslash(char *s)
! 667: {
! 668: char *p,*r;
! 669: int i;
! 670:
! 671: for ( i = 0, p = s; *p; p++, i++ ) if ( *p == '\\' ) i++;
! 672: r = (char *)MALLOC_ATOMIC((i+1)*sizeof(char));
! 673: for ( i = 0, p = s; *p; p++, i++ ) {
! 674: if ( *p == '\\' ) r[i++] = '\\';
! 675: r[i] = *p;
! 676: }
! 677: return r;
! 678: }
! 679:
1.20 noro 680: int asir_executeString()
1.1 noro 681: {
682: SNODE snode;
683: pointer val;
684: char *cmd;
1.41 ohara 685: #if defined(PARI)
1.1 noro 686: recover(0);
1.36 noro 687: /* environement is defined in libpari.a */
1.51 saito 688: # if !(PARI_VERSION_CODE > 131588 )
1.36 noro 689: if ( setjmp(environnement) ) {
1.1 noro 690: avma = top; recover(1);
691: resetenv("");
692: }
1.51 saito 693: # endif
1.1 noro 694: #endif
695: cmd = ((STRING)asir_pop_one())->body;
1.55 ! noro 696: parse_strp = augment_backslash(cmd);
1.1 noro 697: if ( mainparse(&snode) ) {
698: return -1;
699: }
700: val = evalstat(snode);
701: if ( NEXT(asir_infile) ) {
702: while ( NEXT(asir_infile) ) {
703: if ( mainparse(&snode) ) {
704: asir_push_one(val);
705: return -1;
706: }
707: nextbp = 0;
708: val = evalstat(snode);
709: }
710: }
711: asir_push_one(val);
712: return 0;
713: }
714:
715: static void asir_executeFunction(int serial)
716: {
717: char *func;
718: int argc;
719: FUNC f;
720: Obj result;
721: NODE n,n1;
722: STRING fname;
723: char *path;
724: ERR err;
1.5 noro 725: Obj arg;
1.1 noro 726: static char buf[BUFSIZ];
727:
1.5 noro 728: arg = asir_pop_one();
729: if ( !arg || OID(arg) != O_STR ) {
730: sprintf(buf,"executeFunction : invalid function name");
731: goto error;
732: } else
733: func = ((STRING)arg)->body;
734:
735: arg = asir_pop_one();
736: if ( !arg || OID(arg) != O_USINT ) {
737: sprintf(buf,"executeFunction : invalid argc");
738: goto error;
739: } else
740: argc = (int)(((USINT)arg)->body);
1.1 noro 741:
742: for ( n = 0; argc; argc-- ) {
743: NEXTNODE(n,n1);
744: BDY(n1) = (pointer)asir_pop_one();
745: }
746: if ( n )
747: NEXT(n1) = 0;
748:
749: if ( !strcmp(func,"load") ) {
750: fname = (STRING)BDY(n);
751: if ( OID(fname) == O_STR ) {
752: searchasirpath(BDY(fname),&path);
753: if ( path ) {
754: if ( do_message )
755: fprintf(stderr,"loading %s\n",path);
756: execasirfile(path);
757: } else
758: if ( do_message )
759: fprintf(stderr,"load : %s not found in the search path\n",BDY(fname));
760: }
761: result = 0;
762: } else {
763: searchf(noargsysf,func,&f);
764: if ( !f )
765: searchf(sysf,func,&f);
766: if ( !f )
767: searchf(ubinf,func,&f);
768: if ( !f )
769: searchf(usrf,func,&f);
770: if ( !f ) {
771: sprintf(buf,"executeFunction : the function %s not found",func);
1.5 noro 772: goto error;
1.1 noro 773: } else {
774: result = (Obj)bevalf(f,n);
775: }
776: }
1.5 noro 777: asir_push_one(result);
778: return;
779:
780: error:
781: create_error(&err,serial,buf);
782: result = (Obj)err;
1.1 noro 783: asir_push_one(result);
784: }
785:
1.20 noro 786: void asir_end_flush()
1.1 noro 787: {
788: ox_flushing = 0;
789: }
790:
791: /*
792: asir_OperandStackPtr points to the surface of the stack.
793: That is, the data at the stack top is
794: asir_OperandStack[asir_OperandStackPtr].
795: */
796:
797:
1.20 noro 798: void asir_push_one(Obj obj)
1.1 noro 799: {
800: if ( !obj || OID(obj) != O_VOID ) {
801: asir_OperandStackPtr++;
802: if ( asir_OperandStackPtr >= asir_OperandStackSize ) {
803: asir_OperandStackSize += BUFSIZ;
804: asir_OperandStack
805: = (Obj *)REALLOC(asir_OperandStack,
806: asir_OperandStackSize*sizeof(Obj));
807: }
808: asir_OperandStack[asir_OperandStackPtr] = obj;
809: }
810: }
811:
1.20 noro 812: Obj asir_pop_one() {
1.1 noro 813: if ( asir_OperandStackPtr < 0 ) {
814: if ( do_message )
815: fprintf(stderr,"OperandStack underflow");
816: return 0;
817: } else {
818: if ( do_message )
819: fprintf(stderr,"pop at %d\n",asir_OperandStackPtr);
820: return asir_OperandStack[asir_OperandStackPtr--];
1.18 noro 821: }
822: }
823:
1.20 noro 824: Obj asir_peek_one() {
1.18 noro 825: if ( asir_OperandStackPtr < 0 ) {
826: if ( do_message )
827: fprintf(stderr,"OperandStack underflow");
828: return 0;
829: } else {
830: if ( do_message )
831: fprintf(stderr,"peek at %d\n",asir_OperandStackPtr);
832: return asir_OperandStack[asir_OperandStackPtr];
1.1 noro 833: }
834: }
835:
1.40 noro 836: void ox_asir_init(int argc,char **argv,char *servername)
1.1 noro 837: {
838: char ifname[BUFSIZ];
839: extern int GC_dont_gc;
840: extern int read_exec_file;
841: extern int do_asirrc;
842: extern int do_server_in_X11;
1.37 noro 843: extern char displayname[];
1.1 noro 844: char *getenv();
845: static ox_asir_initialized = 0;
846: FILE *ifp;
1.4 noro 847: char *homedir;
848: char *ptr;
1.32 noro 849: #if !defined(VISUAL)
850: int tmp;
851: #endif
1.1 noro 852:
1.43 noro 853: #if !defined(VISUAL) && !defined(MPI)
1.1 noro 854: do_server_in_X11 = 1; /* XXX */
855: #endif
856: asir_save_handler();
1.41 ohara 857: #if defined(PARI)
1.1 noro 858: risa_pari_init();
859: #endif
860: srandom((int)get_current_time());
861:
862: rtime_init();
863: env_init();
864: endian_init();
865: GC_init();
1.44 noro 866: cppname_init();
1.1 noro 867: process_args(--argc,++argv);
1.37 noro 868: #if defined(__CYGWIN__)
869: if ( !displayname[0] )
870: do_server_in_X11 = 0; /* XXX */
871: #endif
1.1 noro 872: output_init();
873: arf_init();
874: nglob_init();
875: glob_init();
876: sig_init();
877: tty_init();
878: debug_init();
879: pf_init();
880: sysf_init();
881: parif_init();
882: #if defined(VISUAL)
883: init_socket();
884: #endif
885: #if defined(UINIT)
886: reg_sysf();
887: #endif
1.4 noro 888: /* if ASIR_CONFIG is set, execute it; else execute .asirrc */
889: if ( ptr = getenv("ASIR_CONFIG") )
890: strcpy(ifname,ptr);
891: else {
892: homedir = getenv("HOME");
893: if ( !homedir ) {
894: char rootname[BUFSIZ];
895:
896: get_rootdir(rootname,sizeof(rootname));
897: homedir = rootname;
898: }
899: sprintf(ifname,"%s/.asirrc",homedir);
900: }
1.1 noro 901: if ( do_asirrc && (ifp = fopen(ifname,"r")) ) {
902: input_init(ifp,ifname);
1.35 noro 903: if ( !SETJMP(main_env) ) {
1.1 noro 904: read_exec_file = 1;
905: read_eval_loop();
906: read_exec_file = 0;
907: }
908: fclose(ifp);
909: }
910: input_init(0,"string");
1.30 noro 911: /* XXX Windows compatibility */
912: ox_io_init();
1.40 noro 913: create_my_mathcap(servername);
1.1 noro 914: }
915:
1.20 noro 916: void ox_io_init() {
1.1 noro 917: unsigned char c,rc;
1.21 noro 918: extern int I_am_server;
1.26 noro 919:
1.33 noro 920: /* XXX : ssh forwards stdin to a remote host on PC Unix */
921: #if defined(linux)
922: #include <sys/param.h>
1.32 noro 923: int i;
924:
925: close(0);
926: for ( i = 5; i < NOFILE; i++ )
927: close(i);
1.33 noro 928: #elif defined(__FreeBSD__)
1.27 noro 929: #include <sys/resource.h>
1.33 noro 930: int i;
1.32 noro 931: struct rlimit rl;
1.27 noro 932:
1.32 noro 933: getrlimit(RLIMIT_NOFILE,&rl);
934: close(0);
935: for ( i = 5; i < rl.rlim_cur; i++ )
936: close(i);
1.27 noro 937: #endif
1.1 noro 938:
1.21 noro 939: I_am_server = 1;
1.1 noro 940: endian_init();
941: #if defined(VISUAL)
942: if ( !ox_sock_id )
943: exit(0);
944: iofp[0].in = WSIO_open(ox_sock_id,"r");
945: iofp[0].out = WSIO_open(ox_sock_id,"w");
946: #else
947: iofp[0].in = fdopen(3,"r");
948: iofp[0].out = fdopen(4,"w");
949:
1.34 noro 950: #if !defined(__CYGWIN__)
1.1 noro 951: setbuffer(iofp[0].in,(char *)malloc(LBUFSIZ),LBUFSIZ);
952: setbuffer(iofp[0].out,(char *)malloc(LBUFSIZ),LBUFSIZ);
1.34 noro 953: #endif
1.1 noro 954: signal(SIGUSR1,ox_usr1_handler);
955: #endif
956: asir_OperandStackSize = BUFSIZ;
957: asir_OperandStack = (Obj *)CALLOC(asir_OperandStackSize,sizeof(Obj));
958: asir_OperandStackPtr = -1;
959: if ( little_endian )
960: c = 1;
961: else
962: c = 0xff;
963: /* server : write -> read */
964: write_char(iofp[0].out,&c); ox_flush_stream_force(0);
965: read_char(iofp[0].in,&rc);
966: iofp[0].conv = c == rc ? 0 : 1;
1.14 noro 967: /* XXX; for raw I/O */
968: register_server(0,0,0);
1.3 noro 969: }
970:
1.17 noro 971: #if !defined(VISUAL)
1.3 noro 972: /*
973: * Library mode functions
974: */
975:
976: /*
977: * Converts a binary encoded CMO into a risa object
978: * and pushes it onto the stack.
979: */
980:
981: void asir_ox_push_cmo(void *cmo)
982: {
983: Obj obj;
984:
985: ox_copy_init(cmo);
986: ox_buf_to_obj_as_cmo(&obj);
987: asir_push_one(obj);
988: }
989:
990: /*
991: * Pop an object from the stack and converts it
1.28 noro 992: * into a binary encoded CMO.
1.3 noro 993: */
994:
995: int asir_ox_pop_cmo(void *cmo, int limit)
996: {
997: Obj obj;
998: int len;
1.11 noro 999: ERR err;
1.3 noro 1000:
1001: obj = asir_pop_one();
1.10 noro 1002: if ( !valid_as_cmo(obj) ) {
1.11 noro 1003: asir_push_one(obj);
1004: create_error(&err,0,"The object at the stack top is invalid as a CMO.");
1005: obj = (Obj)err;
1.10 noro 1006: }
1.3 noro 1007: len = count_as_cmo(obj);
1008: if ( len <= limit ) {
1009: ox_copy_init(cmo);
1010: ox_obj_to_buf_as_cmo(obj);
1011: return len;
1012: } else
1013: return -1;
1.28 noro 1014: }
1015:
1016: int asir_ox_pop_string(void *string, int limit)
1017: {
1018: Obj val;
1019: int l;
1020:
1021: val = asir_pop_one();
1022: if ( !val ) {
1023: if ( limit >= 2 ) {
1024: sprintf(string,"0");
1025: l = strlen(string);
1026: } else
1027: l = -1;
1028: } else {
1029: l = estimate_length(CO,val);
1030: if ( l+1 <= limit ) {
1031: soutput_init(string);
1032: sprintexpr(CO,val);
1033: l = strlen(string);
1034: } else
1035: l = -1;
1036: }
1037: return l;
1.3 noro 1038: }
1039:
1040: /*
1041: * Executes an SM command.
1042: */
1043:
1.13 noro 1044: void asir_ox_push_cmd(int cmd)
1.3 noro 1045: {
1.7 noro 1046: int ret;
1047: ERR err;
1048: extern char LastError[];
1049:
1.35 noro 1050: if ( ret = SETJMP(main_env) ) {
1.12 noro 1051: asir_reset_handler();
1.7 noro 1052: if ( ret == 1 ) {
1053: create_error(&err,0,LastError); /* XXX */
1054: asir_push_one((Obj)err);
1055: }
1.12 noro 1056: } else {
1057: asir_save_handler();
1058: asir_set_handler();
1.7 noro 1059: asir_do_cmd(cmd,0);
1.12 noro 1060: asir_reset_handler();
1061: }
1.3 noro 1062: }
1063:
1064: /*
1065: * Executes a string written in Asir.
1066: */
1067:
1068: void asir_ox_execute_string(char *s)
1069: {
1070: STRING str;
1.8 noro 1071: int ret;
1072: ERR err;
1073: extern char LastError[];
1.3 noro 1074:
1075: MKSTR(str,s);
1076: asir_push_one((Obj)str);
1.35 noro 1077: if ( ret = SETJMP(main_env) ) {
1.12 noro 1078: asir_reset_handler();
1.8 noro 1079: if ( ret == 1 ) {
1080: create_error(&err,0,LastError); /* XXX */
1081: asir_push_one((Obj)err);
1082: }
1.12 noro 1083: } else {
1084: asir_save_handler();
1085: asir_set_handler();
1.8 noro 1086: asir_executeString();
1.12 noro 1087: asir_reset_handler();
1088: }
1.3 noro 1089: }
1090:
1091: /*
1092: * Returns the size as a CMO of the object
1093: * at the top of the stack.
1094: */
1095:
1096: int asir_ox_peek_cmo_size()
1097: {
1098: Obj obj;
1099: int len;
1100:
1.38 noro 1101: obj = asir_peek_one();
1.10 noro 1102: if ( !valid_as_cmo(obj) ) {
1103: fprintf(stderr,"The object at the stack top is invalid as a CMO.\n");
1104: return 0;
1105: }
1.3 noro 1106: len = count_as_cmo(obj);
1.38 noro 1107: return len;
1108: }
1109:
1110: int asir_ox_peek_cmo_string_length()
1111: {
1112: Obj obj;
1113: int len;
1114:
1115: obj = asir_peek_one();
1116: if ( !valid_as_cmo(obj) ) {
1117: fprintf(stderr,"The object at the stack top is invalid as a CMO.\n");
1118: return 0;
1119: }
1120: len = estimate_length(CO,obj);
1.39 noro 1121: return len+1;
1.3 noro 1122: }
1123:
1124: /*
1125: * Initialization.
1.11 noro 1126: * byteorder=0 => native
1127: * =1 => network byte order
1.3 noro 1128: */
1129:
1.13 noro 1130: int asir_ox_init(int byteorder)
1.3 noro 1131: {
1132: int tmp;
1133: char ifname[BUFSIZ];
1134: extern int GC_dont_gc;
1135: extern int read_exec_file;
1136: extern int do_asirrc;
1137: extern int do_server_in_X11;
1138: char *getenv();
1139: static ox_asir_initialized = 0;
1140: FILE *ifp;
1141:
1.43 noro 1142: #if !defined(VISUAL) && !defined(MPI)
1.9 noro 1143: do_server_in_X11 = 0; /* XXX */
1.3 noro 1144: #endif
1145: asir_save_handler();
1.41 ohara 1146: #if defined(PARI)
1.3 noro 1147: risa_pari_init();
1148: #endif
1149: srandom((int)get_current_time());
1150:
1151: rtime_init();
1152: env_init();
1153: endian_init();
1154: GC_init();
1155: /* process_args(argc,argv); */
1156: output_init();
1157: arf_init();
1158: nglob_init();
1159: glob_init();
1160: sig_init();
1161: tty_init();
1162: debug_init();
1163: pf_init();
1164: sysf_init();
1165: parif_init();
1166: #if defined(VISUAL)
1167: init_socket();
1168: #endif
1169: #if defined(UINIT)
1170: reg_sysf();
1171: #endif
1172: sprintf(ifname,"%s/.asirrc",getenv("HOME"));
1173: if ( do_asirrc && (ifp = fopen(ifname,"r")) ) {
1174: input_init(ifp,ifname);
1.35 noro 1175: if ( !SETJMP(main_env) ) {
1.3 noro 1176: read_exec_file = 1;
1177: read_eval_loop();
1178: read_exec_file = 0;
1179: }
1180: fclose(ifp);
1181: }
1182: input_init(0,"string");
1183:
1184: asir_OperandStackSize = BUFSIZ;
1185: asir_OperandStack = (Obj *)CALLOC(asir_OperandStackSize,sizeof(Obj));
1186: asir_OperandStackPtr = -1;
1.11 noro 1187: if ( little_endian && byteorder )
1188: lib_ox_need_conv = 1;
1.3 noro 1189: else
1.11 noro 1190: lib_ox_need_conv = 0;
1.3 noro 1191: do_message = 0;
1.11 noro 1192: create_my_mathcap("ox_asir");
1.12 noro 1193: asir_reset_handler();
1.13 noro 1194: return 0;
1.1 noro 1195: }
1.17 noro 1196: #endif