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