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