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