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