![[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.49 ! noro 47: * $OpenXM: OpenXM_contrib2/asir2000/io/ox_asir.c,v 1.48 2003/12/12 04:59:59 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;
1.49 ! noro 559: host = BDY((STRING)h);
1.46 noro 560: } else {
561: strcpy(port_str,BDY((STRING)p));
562: use_unix = 1;
1.49 ! noro 563: host = 0;
1.46 noro 564: }
565: s = try_connect(use_unix,host,port_str);
566: rank = QTOS((Q)r);
567: if ( register_102(s,rank,1) < 0 ) {
568: create_error(&err,serial,
1.48 noro 569: "failed to connect in ox_tcp_connect_102");
1.45 noro 570: asir_push_one((Obj)err);
1.1 noro 571: }
572: }
573:
1.20 noro 574: void asir_pushCMOtag(unsigned int serial)
1.18 noro 575: {
576: Obj obj;
577: ERR err;
578: USINT ui;
579: int tag;
580:
581: obj = asir_peek_one();
582: if ( cmo_tag(obj,&tag) ) {
583: MKUSINT(ui,tag);
584: asir_push_one((Obj)ui);
585: } else {
586: create_error(&err,serial,"cannot convert to CMO object");
587: asir_push_one((Obj)err);
588: }
589: }
590:
1.20 noro 591: void asir_popString()
1.1 noro 592: {
593: Obj val;
594: char *buf,*obuf;
595: int l;
596: STRING str;
597:
598: val = asir_pop_one();
599: if ( !val )
1.24 noro 600: obuf = "0";
1.1 noro 601: else {
602: l = estimate_length(CO,val);
603: buf = (char *)ALLOCA(l+1);
604: soutput_init(buf);
605: sprintexpr(CO,val);
606: l = strlen(buf);
607: obuf = (char *)MALLOC(l+1);
608: strcpy(obuf,buf);
609: }
610: MKSTR(str,obuf);
611: ox_send_data(0,str);
612: }
613:
1.20 noro 614: void asir_pops()
1.1 noro 615: {
616: int n;
617:
618: n = (int)(((USINT)asir_pop_one())->body);
619: asir_OperandStackPtr = MAX(asir_OperandStackPtr-n,-1);
620: }
621:
1.20 noro 622: void asir_setName(unsigned int serial)
1.1 noro 623: {
624: char *name;
625: int l,n;
626: char *dummy = "=0;";
627: SNODE snode;
628: ERR err;
629:
630: name = ((STRING)asir_pop_one())->body;
631: l = strlen(name);
632: n = l+strlen(dummy)+1;
633: parse_strp = (char *)ALLOCA(n);
634: sprintf(parse_strp,"%s%s",name,dummy);
635: if ( mainparse(&snode) ) {
636: create_error(&err,serial,"cannot set to variable");
637: asir_push_one((Obj)err);
638: } else {
639: FA1((FNODE)FA0(snode)) = (pointer)mkfnode(1,I_FORMULA,asir_pop_one());
640: evalstat(snode);
641: }
642: }
643:
1.20 noro 644: void asir_evalName(unsigned int serial)
1.1 noro 645: {
646: char *name;
647: int l,n;
648: SNODE snode;
649: ERR err;
650: pointer val;
651:
652: name = ((STRING)asir_pop_one())->body;
653: l = strlen(name);
654: n = l+2;
655: parse_strp = (char *)ALLOCA(n);
656: sprintf(parse_strp,"%s;",name);
657: if ( mainparse(&snode) ) {
658: create_error(&err,serial,"no such variable");
659: val = (pointer)err;
660: } else
661: val = evalstat(snode);
662: asir_push_one(val);
663: }
664:
1.20 noro 665: int asir_executeString()
1.1 noro 666: {
667: SNODE snode;
668: pointer val;
669: char *cmd;
1.41 ohara 670: #if defined(PARI)
1.1 noro 671: recover(0);
1.36 noro 672: /* environement is defined in libpari.a */
673: if ( setjmp(environnement) ) {
1.1 noro 674: avma = top; recover(1);
675: resetenv("");
676: }
677: #endif
678: cmd = ((STRING)asir_pop_one())->body;
679: parse_strp = cmd;
680: if ( mainparse(&snode) ) {
681: return -1;
682: }
683: val = evalstat(snode);
684: if ( NEXT(asir_infile) ) {
685: while ( NEXT(asir_infile) ) {
686: if ( mainparse(&snode) ) {
687: asir_push_one(val);
688: return -1;
689: }
690: nextbp = 0;
691: val = evalstat(snode);
692: }
693: }
694: asir_push_one(val);
695: return 0;
696: }
697:
698: static void asir_executeFunction(int serial)
699: {
700: char *func;
701: int argc;
702: FUNC f;
703: Obj result;
704: NODE n,n1;
705: STRING fname;
706: char *path;
707: ERR err;
1.5 noro 708: Obj arg;
1.1 noro 709: static char buf[BUFSIZ];
710:
1.5 noro 711: arg = asir_pop_one();
712: if ( !arg || OID(arg) != O_STR ) {
713: sprintf(buf,"executeFunction : invalid function name");
714: goto error;
715: } else
716: func = ((STRING)arg)->body;
717:
718: arg = asir_pop_one();
719: if ( !arg || OID(arg) != O_USINT ) {
720: sprintf(buf,"executeFunction : invalid argc");
721: goto error;
722: } else
723: argc = (int)(((USINT)arg)->body);
1.1 noro 724:
725: for ( n = 0; argc; argc-- ) {
726: NEXTNODE(n,n1);
727: BDY(n1) = (pointer)asir_pop_one();
728: }
729: if ( n )
730: NEXT(n1) = 0;
731:
732: if ( !strcmp(func,"load") ) {
733: fname = (STRING)BDY(n);
734: if ( OID(fname) == O_STR ) {
735: searchasirpath(BDY(fname),&path);
736: if ( path ) {
737: if ( do_message )
738: fprintf(stderr,"loading %s\n",path);
739: execasirfile(path);
740: } else
741: if ( do_message )
742: fprintf(stderr,"load : %s not found in the search path\n",BDY(fname));
743: }
744: result = 0;
745: } else {
746: searchf(noargsysf,func,&f);
747: if ( !f )
748: searchf(sysf,func,&f);
749: if ( !f )
750: searchf(ubinf,func,&f);
751: if ( !f )
752: searchf(usrf,func,&f);
753: if ( !f ) {
754: sprintf(buf,"executeFunction : the function %s not found",func);
1.5 noro 755: goto error;
1.1 noro 756: } else {
757: result = (Obj)bevalf(f,n);
758: }
759: }
1.5 noro 760: asir_push_one(result);
761: return;
762:
763: error:
764: create_error(&err,serial,buf);
765: result = (Obj)err;
1.1 noro 766: asir_push_one(result);
767: }
768:
1.20 noro 769: void asir_end_flush()
1.1 noro 770: {
771: ox_flushing = 0;
772: }
773:
774: /*
775: asir_OperandStackPtr points to the surface of the stack.
776: That is, the data at the stack top is
777: asir_OperandStack[asir_OperandStackPtr].
778: */
779:
780:
1.20 noro 781: void asir_push_one(Obj obj)
1.1 noro 782: {
783: if ( !obj || OID(obj) != O_VOID ) {
784: asir_OperandStackPtr++;
785: if ( asir_OperandStackPtr >= asir_OperandStackSize ) {
786: asir_OperandStackSize += BUFSIZ;
787: asir_OperandStack
788: = (Obj *)REALLOC(asir_OperandStack,
789: asir_OperandStackSize*sizeof(Obj));
790: }
791: asir_OperandStack[asir_OperandStackPtr] = obj;
792: }
793: }
794:
1.20 noro 795: Obj asir_pop_one() {
1.1 noro 796: if ( asir_OperandStackPtr < 0 ) {
797: if ( do_message )
798: fprintf(stderr,"OperandStack underflow");
799: return 0;
800: } else {
801: if ( do_message )
802: fprintf(stderr,"pop at %d\n",asir_OperandStackPtr);
803: return asir_OperandStack[asir_OperandStackPtr--];
1.18 noro 804: }
805: }
806:
1.20 noro 807: Obj asir_peek_one() {
1.18 noro 808: if ( asir_OperandStackPtr < 0 ) {
809: if ( do_message )
810: fprintf(stderr,"OperandStack underflow");
811: return 0;
812: } else {
813: if ( do_message )
814: fprintf(stderr,"peek at %d\n",asir_OperandStackPtr);
815: return asir_OperandStack[asir_OperandStackPtr];
1.1 noro 816: }
817: }
818:
1.40 noro 819: void ox_asir_init(int argc,char **argv,char *servername)
1.1 noro 820: {
821: char ifname[BUFSIZ];
822: extern int GC_dont_gc;
823: extern int read_exec_file;
824: extern int do_asirrc;
825: extern int do_server_in_X11;
1.37 noro 826: extern char displayname[];
1.1 noro 827: char *getenv();
828: static ox_asir_initialized = 0;
829: FILE *ifp;
1.4 noro 830: char *homedir;
831: char *ptr;
1.32 noro 832: #if !defined(VISUAL)
833: int tmp;
834: #endif
1.1 noro 835:
1.43 noro 836: #if !defined(VISUAL) && !defined(MPI)
1.1 noro 837: do_server_in_X11 = 1; /* XXX */
838: #endif
839: asir_save_handler();
1.41 ohara 840: #if defined(PARI)
1.1 noro 841: risa_pari_init();
842: #endif
843: srandom((int)get_current_time());
844:
845: rtime_init();
846: env_init();
847: endian_init();
848: GC_init();
1.44 noro 849: cppname_init();
1.1 noro 850: process_args(--argc,++argv);
1.37 noro 851: #if defined(__CYGWIN__)
852: if ( !displayname[0] )
853: do_server_in_X11 = 0; /* XXX */
854: #endif
1.1 noro 855: output_init();
856: arf_init();
857: nglob_init();
858: glob_init();
859: sig_init();
860: tty_init();
861: debug_init();
862: pf_init();
863: sysf_init();
864: parif_init();
865: #if defined(VISUAL)
866: init_socket();
867: #endif
868: #if defined(UINIT)
869: reg_sysf();
870: #endif
1.4 noro 871: /* if ASIR_CONFIG is set, execute it; else execute .asirrc */
872: if ( ptr = getenv("ASIR_CONFIG") )
873: strcpy(ifname,ptr);
874: else {
875: homedir = getenv("HOME");
876: if ( !homedir ) {
877: char rootname[BUFSIZ];
878:
879: get_rootdir(rootname,sizeof(rootname));
880: homedir = rootname;
881: }
882: sprintf(ifname,"%s/.asirrc",homedir);
883: }
1.1 noro 884: if ( do_asirrc && (ifp = fopen(ifname,"r")) ) {
885: input_init(ifp,ifname);
1.35 noro 886: if ( !SETJMP(main_env) ) {
1.1 noro 887: read_exec_file = 1;
888: read_eval_loop();
889: read_exec_file = 0;
890: }
891: fclose(ifp);
892: }
893: input_init(0,"string");
1.30 noro 894: /* XXX Windows compatibility */
895: ox_io_init();
1.40 noro 896: create_my_mathcap(servername);
1.1 noro 897: }
898:
1.20 noro 899: void ox_io_init() {
1.1 noro 900: unsigned char c,rc;
1.21 noro 901: extern int I_am_server;
1.26 noro 902:
1.33 noro 903: /* XXX : ssh forwards stdin to a remote host on PC Unix */
904: #if defined(linux)
905: #include <sys/param.h>
1.32 noro 906: int i;
907:
908: close(0);
909: for ( i = 5; i < NOFILE; i++ )
910: close(i);
1.33 noro 911: #elif defined(__FreeBSD__)
1.27 noro 912: #include <sys/resource.h>
1.33 noro 913: int i;
1.32 noro 914: struct rlimit rl;
1.27 noro 915:
1.32 noro 916: getrlimit(RLIMIT_NOFILE,&rl);
917: close(0);
918: for ( i = 5; i < rl.rlim_cur; i++ )
919: close(i);
1.27 noro 920: #endif
1.1 noro 921:
1.21 noro 922: I_am_server = 1;
1.1 noro 923: endian_init();
924: #if defined(VISUAL)
925: if ( !ox_sock_id )
926: exit(0);
927: iofp[0].in = WSIO_open(ox_sock_id,"r");
928: iofp[0].out = WSIO_open(ox_sock_id,"w");
929: #else
930: iofp[0].in = fdopen(3,"r");
931: iofp[0].out = fdopen(4,"w");
932:
1.34 noro 933: #if !defined(__CYGWIN__)
1.1 noro 934: setbuffer(iofp[0].in,(char *)malloc(LBUFSIZ),LBUFSIZ);
935: setbuffer(iofp[0].out,(char *)malloc(LBUFSIZ),LBUFSIZ);
1.34 noro 936: #endif
1.1 noro 937: signal(SIGUSR1,ox_usr1_handler);
938: #endif
939: asir_OperandStackSize = BUFSIZ;
940: asir_OperandStack = (Obj *)CALLOC(asir_OperandStackSize,sizeof(Obj));
941: asir_OperandStackPtr = -1;
942: if ( little_endian )
943: c = 1;
944: else
945: c = 0xff;
946: /* server : write -> read */
947: write_char(iofp[0].out,&c); ox_flush_stream_force(0);
948: read_char(iofp[0].in,&rc);
949: iofp[0].conv = c == rc ? 0 : 1;
1.14 noro 950: /* XXX; for raw I/O */
951: register_server(0,0,0);
1.3 noro 952: }
953:
1.17 noro 954: #if !defined(VISUAL)
1.3 noro 955: /*
956: * Library mode functions
957: */
958:
959: /*
960: * Converts a binary encoded CMO into a risa object
961: * and pushes it onto the stack.
962: */
963:
964: void asir_ox_push_cmo(void *cmo)
965: {
966: Obj obj;
967:
968: ox_copy_init(cmo);
969: ox_buf_to_obj_as_cmo(&obj);
970: asir_push_one(obj);
971: }
972:
973: /*
974: * Pop an object from the stack and converts it
1.28 noro 975: * into a binary encoded CMO.
1.3 noro 976: */
977:
978: int asir_ox_pop_cmo(void *cmo, int limit)
979: {
980: Obj obj;
981: int len;
1.11 noro 982: ERR err;
1.3 noro 983:
984: obj = asir_pop_one();
1.10 noro 985: if ( !valid_as_cmo(obj) ) {
1.11 noro 986: asir_push_one(obj);
987: create_error(&err,0,"The object at the stack top is invalid as a CMO.");
988: obj = (Obj)err;
1.10 noro 989: }
1.3 noro 990: len = count_as_cmo(obj);
991: if ( len <= limit ) {
992: ox_copy_init(cmo);
993: ox_obj_to_buf_as_cmo(obj);
994: return len;
995: } else
996: return -1;
1.28 noro 997: }
998:
999: int asir_ox_pop_string(void *string, int limit)
1000: {
1001: Obj val;
1002: int l;
1003:
1004: val = asir_pop_one();
1005: if ( !val ) {
1006: if ( limit >= 2 ) {
1007: sprintf(string,"0");
1008: l = strlen(string);
1009: } else
1010: l = -1;
1011: } else {
1012: l = estimate_length(CO,val);
1013: if ( l+1 <= limit ) {
1014: soutput_init(string);
1015: sprintexpr(CO,val);
1016: l = strlen(string);
1017: } else
1018: l = -1;
1019: }
1020: return l;
1.3 noro 1021: }
1022:
1023: /*
1024: * Executes an SM command.
1025: */
1026:
1.13 noro 1027: void asir_ox_push_cmd(int cmd)
1.3 noro 1028: {
1.7 noro 1029: int ret;
1030: ERR err;
1031: extern char LastError[];
1032:
1.35 noro 1033: if ( ret = SETJMP(main_env) ) {
1.12 noro 1034: asir_reset_handler();
1.7 noro 1035: if ( ret == 1 ) {
1036: create_error(&err,0,LastError); /* XXX */
1037: asir_push_one((Obj)err);
1038: }
1.12 noro 1039: } else {
1040: asir_save_handler();
1041: asir_set_handler();
1.7 noro 1042: asir_do_cmd(cmd,0);
1.12 noro 1043: asir_reset_handler();
1044: }
1.3 noro 1045: }
1046:
1047: /*
1048: * Executes a string written in Asir.
1049: */
1050:
1051: void asir_ox_execute_string(char *s)
1052: {
1053: STRING str;
1.8 noro 1054: int ret;
1055: ERR err;
1056: extern char LastError[];
1.3 noro 1057:
1058: MKSTR(str,s);
1059: asir_push_one((Obj)str);
1.35 noro 1060: if ( ret = SETJMP(main_env) ) {
1.12 noro 1061: asir_reset_handler();
1.8 noro 1062: if ( ret == 1 ) {
1063: create_error(&err,0,LastError); /* XXX */
1064: asir_push_one((Obj)err);
1065: }
1.12 noro 1066: } else {
1067: asir_save_handler();
1068: asir_set_handler();
1.8 noro 1069: asir_executeString();
1.12 noro 1070: asir_reset_handler();
1071: }
1.3 noro 1072: }
1073:
1074: /*
1075: * Returns the size as a CMO of the object
1076: * at the top of the stack.
1077: */
1078:
1079: int asir_ox_peek_cmo_size()
1080: {
1081: Obj obj;
1082: int len;
1083:
1.38 noro 1084: obj = asir_peek_one();
1.10 noro 1085: if ( !valid_as_cmo(obj) ) {
1086: fprintf(stderr,"The object at the stack top is invalid as a CMO.\n");
1087: return 0;
1088: }
1.3 noro 1089: len = count_as_cmo(obj);
1.38 noro 1090: return len;
1091: }
1092:
1093: int asir_ox_peek_cmo_string_length()
1094: {
1095: Obj obj;
1096: int len;
1097:
1098: obj = asir_peek_one();
1099: if ( !valid_as_cmo(obj) ) {
1100: fprintf(stderr,"The object at the stack top is invalid as a CMO.\n");
1101: return 0;
1102: }
1103: len = estimate_length(CO,obj);
1.39 noro 1104: return len+1;
1.3 noro 1105: }
1106:
1107: /*
1108: * Initialization.
1.11 noro 1109: * byteorder=0 => native
1110: * =1 => network byte order
1.3 noro 1111: */
1112:
1.13 noro 1113: int asir_ox_init(int byteorder)
1.3 noro 1114: {
1115: int tmp;
1116: char ifname[BUFSIZ];
1117: extern int GC_dont_gc;
1118: extern int read_exec_file;
1119: extern int do_asirrc;
1120: extern int do_server_in_X11;
1121: char *getenv();
1122: static ox_asir_initialized = 0;
1123: FILE *ifp;
1124:
1.43 noro 1125: #if !defined(VISUAL) && !defined(MPI)
1.9 noro 1126: do_server_in_X11 = 0; /* XXX */
1.3 noro 1127: #endif
1128: asir_save_handler();
1.41 ohara 1129: #if defined(PARI)
1.3 noro 1130: risa_pari_init();
1131: #endif
1132: srandom((int)get_current_time());
1133:
1134: rtime_init();
1135: env_init();
1136: endian_init();
1137: GC_init();
1138: /* process_args(argc,argv); */
1139: output_init();
1140: arf_init();
1141: nglob_init();
1142: glob_init();
1143: sig_init();
1144: tty_init();
1145: debug_init();
1146: pf_init();
1147: sysf_init();
1148: parif_init();
1149: #if defined(VISUAL)
1150: init_socket();
1151: #endif
1152: #if defined(UINIT)
1153: reg_sysf();
1154: #endif
1155: sprintf(ifname,"%s/.asirrc",getenv("HOME"));
1156: if ( do_asirrc && (ifp = fopen(ifname,"r")) ) {
1157: input_init(ifp,ifname);
1.35 noro 1158: if ( !SETJMP(main_env) ) {
1.3 noro 1159: read_exec_file = 1;
1160: read_eval_loop();
1161: read_exec_file = 0;
1162: }
1163: fclose(ifp);
1164: }
1165: input_init(0,"string");
1166:
1167: asir_OperandStackSize = BUFSIZ;
1168: asir_OperandStack = (Obj *)CALLOC(asir_OperandStackSize,sizeof(Obj));
1169: asir_OperandStackPtr = -1;
1.11 noro 1170: if ( little_endian && byteorder )
1171: lib_ox_need_conv = 1;
1.3 noro 1172: else
1.11 noro 1173: lib_ox_need_conv = 0;
1.3 noro 1174: do_message = 0;
1.11 noro 1175: create_my_mathcap("ox_asir");
1.12 noro 1176: asir_reset_handler();
1.13 noro 1177: return 0;
1.1 noro 1178: }
1.17 noro 1179: #endif