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