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