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