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