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