Annotation of OpenXM_contrib2/asir2000/io/ox_asir.c, Revision 1.73
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.73 ! noro 47: * $OpenXM: OpenXM_contrib2/asir2000/io/ox_asir.c,v 1.72 2014/05/09 19:35:51 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"
54:
1.72 ohara 55: char *find_asirrc();
1.1 noro 56: void ox_usr1_handler();
1.13 noro 57: int asir_ox_init();
1.1 noro 58:
1.36 noro 59: /* environement is defined in libpari.a */
1.73 ! noro 60: #if 0
1.51 saito 61: # if !( PARI_VERSION_CODE > 131588)
1.36 noro 62: extern jmp_buf environnement;
1.51 saito 63: # endif
1.73 ! noro 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.73 ! noro 708: #if 0
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
1.73 ! noro 719: #endif
1.1 noro 720: cmd = ((STRING)asir_pop_one())->body;
1.58 noro 721: /* XXX : probably this is useless */
722: #if 0
1.55 noro 723: parse_strp = augment_backslash(cmd);
1.58 noro 724: #else
725: parse_strp = cmd;
726: #endif
1.62 noro 727: asir_infile->ln = 1;
1.1 noro 728: if ( mainparse(&snode) ) {
729: return -1;
730: }
731: val = evalstat(snode);
732: if ( NEXT(asir_infile) ) {
733: while ( NEXT(asir_infile) ) {
734: if ( mainparse(&snode) ) {
735: asir_push_one(val);
736: return -1;
737: }
738: nextbp = 0;
739: val = evalstat(snode);
740: }
741: }
742: asir_push_one(val);
743: return 0;
744: }
745:
746: static void asir_executeFunction(int serial)
747: {
748: char *func;
749: int argc;
750: FUNC f;
751: Obj result;
752: NODE n,n1;
753: STRING fname;
754: char *path;
755: ERR err;
1.5 noro 756: Obj arg;
1.1 noro 757: static char buf[BUFSIZ];
758:
1.5 noro 759: arg = asir_pop_one();
760: if ( !arg || OID(arg) != O_STR ) {
761: sprintf(buf,"executeFunction : invalid function name");
762: goto error;
763: } else
764: func = ((STRING)arg)->body;
765:
766: arg = asir_pop_one();
767: if ( !arg || OID(arg) != O_USINT ) {
768: sprintf(buf,"executeFunction : invalid argc");
769: goto error;
770: } else
771: argc = (int)(((USINT)arg)->body);
1.1 noro 772:
773: for ( n = 0; argc; argc-- ) {
774: NEXTNODE(n,n1);
775: BDY(n1) = (pointer)asir_pop_one();
776: }
777: if ( n )
778: NEXT(n1) = 0;
779:
1.59 noro 780: #if 0
1.1 noro 781: if ( !strcmp(func,"load") ) {
782: fname = (STRING)BDY(n);
783: if ( OID(fname) == O_STR ) {
784: searchasirpath(BDY(fname),&path);
785: if ( path ) {
786: if ( do_message )
787: fprintf(stderr,"loading %s\n",path);
788: execasirfile(path);
789: } else
790: if ( do_message )
791: fprintf(stderr,"load : %s not found in the search path\n",BDY(fname));
792: }
793: result = 0;
794: } else {
1.59 noro 795: #endif
1.1 noro 796: searchf(noargsysf,func,&f);
797: if ( !f )
1.69 noro 798: gen_searchf_searchonly(func,&f);
1.1 noro 799: if ( !f ) {
800: sprintf(buf,"executeFunction : the function %s not found",func);
1.5 noro 801: goto error;
1.1 noro 802: } else {
803: result = (Obj)bevalf(f,n);
804: }
1.59 noro 805: #if 0
1.1 noro 806: }
1.59 noro 807: #endif
1.67 noro 808: printf("executeFunction done\n");
1.5 noro 809: asir_push_one(result);
810: return;
811:
812: error:
1.59 noro 813: create_error(&err,serial,buf,0);
1.5 noro 814: result = (Obj)err;
1.1 noro 815: asir_push_one(result);
816: }
817:
1.67 noro 818: static void asir_executeFunctionSync(int serial)
819: {
820: char *func;
821: int argc,i;
822: FUNC f;
823: Obj result=0;
824: NODE n,n1;
825: STRING fname;
826: char *path;
827: ERR err;
828: Obj arg;
829: static char buf[BUFSIZ];
830:
831: arg = asir_pop_one();
832: if ( !arg || OID(arg) != O_STR ) {
833: sprintf(buf,"executeFunction : invalid function name");
834: goto error;
835: } else
836: func = ((STRING)arg)->body;
837:
838: arg = asir_pop_one();
839: if ( !arg || OID(arg) != O_USINT ) {
840: sprintf(buf,"executeFunction : invalid argc");
841: goto error;
842: } else
843: argc = (int)(((USINT)arg)->body);
844:
845: for ( n = 0; argc; argc-- ) {
846: NEXTNODE(n,n1);
847: BDY(n1) = (pointer)asir_pop_one();
848: }
849: if ( n )
850: NEXT(n1) = 0;
851:
852: ox_send_data(0,ONE);
853:
854: #if 0
855: if ( !strcmp(func,"load") ) {
856: fname = (STRING)BDY(n);
857: if ( OID(fname) == O_STR ) {
858: searchasirpath(BDY(fname),&path);
859: if ( path ) {
860: if ( do_message )
861: fprintf(stderr,"loading %s\n",path);
862: execasirfile(path);
863: } else
864: if ( do_message )
865: fprintf(stderr,"load : %s not found in the search path\n",BDY(fname));
866: }
867: result = 0;
868: } else {
869: #endif
870: searchf(noargsysf,func,&f);
871: if ( !f )
1.70 noro 872: gen_searchf_searchonly(func,&f);
1.67 noro 873: if ( !f ) {
874: sprintf(buf,"executeFunction : the function %s not found",func);
875: goto error;
876: } else {
877: result = (Obj)bevalf(f,n);
878: }
879: #if 0
880: }
881: #endif
882: printf("executeFunctionSync done\n");
883: ox_send_data(0,result);
884: return;
885:
886: error:
887: create_error(&err,serial,buf,0);
888: result = (Obj)err;
889: ox_send_data(0,result);
890: }
891:
1.20 noro 892: void asir_end_flush()
1.1 noro 893: {
894: ox_flushing = 0;
895: }
896:
897: /*
898: asir_OperandStackPtr points to the surface of the stack.
899: That is, the data at the stack top is
900: asir_OperandStack[asir_OperandStackPtr].
901: */
902:
903:
1.20 noro 904: void asir_push_one(Obj obj)
1.1 noro 905: {
906: if ( !obj || OID(obj) != O_VOID ) {
907: asir_OperandStackPtr++;
908: if ( asir_OperandStackPtr >= asir_OperandStackSize ) {
909: asir_OperandStackSize += BUFSIZ;
910: asir_OperandStack
911: = (Obj *)REALLOC(asir_OperandStack,
912: asir_OperandStackSize*sizeof(Obj));
913: }
914: asir_OperandStack[asir_OperandStackPtr] = obj;
915: }
916: }
917:
1.20 noro 918: Obj asir_pop_one() {
1.1 noro 919: if ( asir_OperandStackPtr < 0 ) {
920: if ( do_message )
921: fprintf(stderr,"OperandStack underflow");
922: return 0;
923: } else {
924: if ( do_message )
925: fprintf(stderr,"pop at %d\n",asir_OperandStackPtr);
926: return asir_OperandStack[asir_OperandStackPtr--];
1.18 noro 927: }
928: }
929:
1.20 noro 930: Obj asir_peek_one() {
1.18 noro 931: if ( asir_OperandStackPtr < 0 ) {
932: if ( do_message )
933: fprintf(stderr,"OperandStack underflow");
934: return 0;
935: } else {
936: if ( do_message )
937: fprintf(stderr,"peek at %d\n",asir_OperandStackPtr);
938: return asir_OperandStack[asir_OperandStackPtr];
1.1 noro 939: }
940: }
941:
1.40 noro 942: void ox_asir_init(int argc,char **argv,char *servername)
1.1 noro 943: {
1.72 ohara 944: char *ifname;
1.1 noro 945: extern int GC_dont_gc;
946: extern int do_asirrc;
947: extern int do_server_in_X11;
1.37 noro 948: extern char displayname[];
1.1 noro 949: static ox_asir_initialized = 0;
1.61 noro 950: int do_server_sav;
1.32 noro 951: #if !defined(VISUAL)
952: int tmp;
953: #endif
1.1 noro 954:
1.57 noro 955: GC_init();
1.43 noro 956: #if !defined(VISUAL) && !defined(MPI)
1.1 noro 957: do_server_in_X11 = 1; /* XXX */
958: #endif
959: asir_save_handler();
1.73 ! noro 960: #if 0
1.41 ohara 961: #if defined(PARI)
1.1 noro 962: risa_pari_init();
963: #endif
1.73 ! noro 964: #endif
1.1 noro 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.59 noro 993: /* the bottom of the input stack */
994: input_init(0,"string");
995:
1.72 ohara 996: if ( do_asirrc && (ifname = find_asirrc()) ) {
1.61 noro 997: do_server_sav = do_server_in_X11;
998: do_server_in_X11 = 0;
1.60 noro 999: if ( !SETJMP(main_env) )
1000: execasirfile(ifname);
1.61 noro 1001: do_server_in_X11 = do_server_sav;
1.1 noro 1002: }
1.59 noro 1003:
1.30 noro 1004: /* XXX Windows compatibility */
1005: ox_io_init();
1.40 noro 1006: create_my_mathcap(servername);
1.1 noro 1007: }
1008:
1.20 noro 1009: void ox_io_init() {
1.1 noro 1010: unsigned char c,rc;
1.21 noro 1011: extern int I_am_server;
1.26 noro 1012:
1.33 noro 1013: /* XXX : ssh forwards stdin to a remote host on PC Unix */
1014: #if defined(linux)
1015: #include <sys/param.h>
1.32 noro 1016: int i;
1017:
1018: close(0);
1019: for ( i = 5; i < NOFILE; i++ )
1020: close(i);
1.33 noro 1021: #elif defined(__FreeBSD__)
1.27 noro 1022: #include <sys/resource.h>
1.33 noro 1023: int i;
1.32 noro 1024: struct rlimit rl;
1.27 noro 1025:
1.32 noro 1026: getrlimit(RLIMIT_NOFILE,&rl);
1027: close(0);
1028: for ( i = 5; i < rl.rlim_cur; i++ )
1029: close(i);
1.27 noro 1030: #endif
1.1 noro 1031:
1.21 noro 1032: I_am_server = 1;
1.1 noro 1033: endian_init();
1034: #if defined(VISUAL)
1035: if ( !ox_sock_id )
1036: exit(0);
1037: iofp[0].in = WSIO_open(ox_sock_id,"r");
1038: iofp[0].out = WSIO_open(ox_sock_id,"w");
1039: #else
1040: iofp[0].in = fdopen(3,"r");
1041: iofp[0].out = fdopen(4,"w");
1042:
1.34 noro 1043: #if !defined(__CYGWIN__)
1.1 noro 1044: setbuffer(iofp[0].in,(char *)malloc(LBUFSIZ),LBUFSIZ);
1045: setbuffer(iofp[0].out,(char *)malloc(LBUFSIZ),LBUFSIZ);
1.34 noro 1046: #endif
1.1 noro 1047: signal(SIGUSR1,ox_usr1_handler);
1048: #endif
1049: asir_OperandStackSize = BUFSIZ;
1050: asir_OperandStack = (Obj *)CALLOC(asir_OperandStackSize,sizeof(Obj));
1051: asir_OperandStackPtr = -1;
1052: if ( little_endian )
1053: c = 1;
1054: else
1055: c = 0xff;
1056: /* server : write -> read */
1057: write_char(iofp[0].out,&c); ox_flush_stream_force(0);
1058: read_char(iofp[0].in,&rc);
1059: iofp[0].conv = c == rc ? 0 : 1;
1.14 noro 1060: /* XXX; for raw I/O */
1.68 ohara 1061: register_server(0,0,0,-1);
1.3 noro 1062: }
1063:
1.17 noro 1064: #if !defined(VISUAL)
1.3 noro 1065: /*
1066: * Library mode functions
1067: */
1068:
1069: /*
1070: * Converts a binary encoded CMO into a risa object
1071: * and pushes it onto the stack.
1072: */
1073:
1074: void asir_ox_push_cmo(void *cmo)
1075: {
1076: Obj obj;
1077:
1078: ox_copy_init(cmo);
1079: ox_buf_to_obj_as_cmo(&obj);
1080: asir_push_one(obj);
1081: }
1082:
1083: /*
1084: * Pop an object from the stack and converts it
1.28 noro 1085: * into a binary encoded CMO.
1.3 noro 1086: */
1087:
1088: int asir_ox_pop_cmo(void *cmo, int limit)
1089: {
1090: Obj obj;
1091: int len;
1.11 noro 1092: ERR err;
1.3 noro 1093:
1094: obj = asir_pop_one();
1.10 noro 1095: if ( !valid_as_cmo(obj) ) {
1.11 noro 1096: asir_push_one(obj);
1.59 noro 1097: create_error(&err,0,"The object at the stack top is invalid as a CMO.",0);
1.11 noro 1098: obj = (Obj)err;
1.10 noro 1099: }
1.3 noro 1100: len = count_as_cmo(obj);
1101: if ( len <= limit ) {
1102: ox_copy_init(cmo);
1103: ox_obj_to_buf_as_cmo(obj);
1104: return len;
1105: } else
1106: return -1;
1.28 noro 1107: }
1108:
1109: int asir_ox_pop_string(void *string, int limit)
1110: {
1111: Obj val;
1112: int l;
1113:
1114: val = asir_pop_one();
1115: if ( !val ) {
1116: if ( limit >= 2 ) {
1117: sprintf(string,"0");
1118: l = strlen(string);
1119: } else
1120: l = -1;
1121: } else {
1122: l = estimate_length(CO,val);
1123: if ( l+1 <= limit ) {
1124: soutput_init(string);
1125: sprintexpr(CO,val);
1126: l = strlen(string);
1127: } else
1128: l = -1;
1129: }
1130: return l;
1.3 noro 1131: }
1132:
1133: /*
1134: * Executes an SM command.
1135: */
1136:
1.13 noro 1137: void asir_ox_push_cmd(int cmd)
1.3 noro 1138: {
1.7 noro 1139: int ret;
1140: ERR err;
1141: extern char LastError[];
1142:
1.35 noro 1143: if ( ret = SETJMP(main_env) ) {
1.12 noro 1144: asir_reset_handler();
1.7 noro 1145: if ( ret == 1 ) {
1.59 noro 1146: create_error(&err,0,LastError,LastStackTrace); /* XXX */
1.7 noro 1147: asir_push_one((Obj)err);
1148: }
1.12 noro 1149: } else {
1150: asir_save_handler();
1151: asir_set_handler();
1.7 noro 1152: asir_do_cmd(cmd,0);
1.12 noro 1153: asir_reset_handler();
1154: }
1.3 noro 1155: }
1156:
1157: /*
1158: * Executes a string written in Asir.
1159: */
1160:
1161: void asir_ox_execute_string(char *s)
1162: {
1163: STRING str;
1.8 noro 1164: int ret;
1165: ERR err;
1166: extern char LastError[];
1.3 noro 1167:
1168: MKSTR(str,s);
1169: asir_push_one((Obj)str);
1.35 noro 1170: if ( ret = SETJMP(main_env) ) {
1.12 noro 1171: asir_reset_handler();
1.8 noro 1172: if ( ret == 1 ) {
1.59 noro 1173: create_error(&err,0,LastError,LastStackTrace); /* XXX */
1.8 noro 1174: asir_push_one((Obj)err);
1175: }
1.12 noro 1176: } else {
1177: asir_save_handler();
1178: asir_set_handler();
1.8 noro 1179: asir_executeString();
1.12 noro 1180: asir_reset_handler();
1181: }
1.3 noro 1182: }
1183:
1184: /*
1185: * Returns the size as a CMO of the object
1186: * at the top of the stack.
1187: */
1188:
1189: int asir_ox_peek_cmo_size()
1190: {
1191: Obj obj;
1192: int len;
1193:
1.38 noro 1194: obj = asir_peek_one();
1.10 noro 1195: if ( !valid_as_cmo(obj) ) {
1196: fprintf(stderr,"The object at the stack top is invalid as a CMO.\n");
1197: return 0;
1198: }
1.3 noro 1199: len = count_as_cmo(obj);
1.38 noro 1200: return len;
1201: }
1202:
1203: int asir_ox_peek_cmo_string_length()
1204: {
1205: Obj obj;
1206: int len;
1207:
1208: obj = asir_peek_one();
1209: if ( !valid_as_cmo(obj) ) {
1210: fprintf(stderr,"The object at the stack top is invalid as a CMO.\n");
1211: return 0;
1212: }
1213: len = estimate_length(CO,obj);
1.39 noro 1214: return len+1;
1.3 noro 1215: }
1216:
1217: /*
1218: * Initialization.
1.11 noro 1219: * byteorder=0 => native
1220: * =1 => network byte order
1.3 noro 1221: */
1222:
1.13 noro 1223: int asir_ox_init(int byteorder)
1.3 noro 1224: {
1225: int tmp;
1.72 ohara 1226: char *ifname;
1.3 noro 1227: extern int GC_dont_gc;
1228: extern int do_asirrc;
1229: extern int do_server_in_X11;
1230: static ox_asir_initialized = 0;
1231:
1.57 noro 1232: GC_init();
1.43 noro 1233: #if !defined(VISUAL) && !defined(MPI)
1.9 noro 1234: do_server_in_X11 = 0; /* XXX */
1.3 noro 1235: #endif
1236: asir_save_handler();
1.73 ! noro 1237: #if 0
1.41 ohara 1238: #if defined(PARI)
1.3 noro 1239: risa_pari_init();
1240: #endif
1.73 ! noro 1241: #endif
1.3 noro 1242: srandom((int)get_current_time());
1243:
1244: rtime_init();
1245: env_init();
1246: endian_init();
1247: /* process_args(argc,argv); */
1248: output_init();
1249: arf_init();
1250: nglob_init();
1251: glob_init();
1252: sig_init();
1253: tty_init();
1254: debug_init();
1255: pf_init();
1256: sysf_init();
1257: parif_init();
1258: #if defined(VISUAL)
1259: init_socket();
1260: #endif
1261: #if defined(UINIT)
1262: reg_sysf();
1263: #endif
1.60 noro 1264: input_init(0,"string");
1.72 ohara 1265: if ( do_asirrc && (ifname = find_asirrc()) ) {
1.60 noro 1266: if ( !SETJMP(main_env) )
1267: execasirfile(ifname);
1.3 noro 1268: }
1269:
1270: asir_OperandStackSize = BUFSIZ;
1271: asir_OperandStack = (Obj *)CALLOC(asir_OperandStackSize,sizeof(Obj));
1272: asir_OperandStackPtr = -1;
1.11 noro 1273: if ( little_endian && byteorder )
1274: lib_ox_need_conv = 1;
1.3 noro 1275: else
1.11 noro 1276: lib_ox_need_conv = 0;
1.3 noro 1277: do_message = 0;
1.11 noro 1278: create_my_mathcap("ox_asir");
1.12 noro 1279: asir_reset_handler();
1.13 noro 1280: return 0;
1.1 noro 1281: }
1.17 noro 1282: #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