![[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.56 ! noro 47: * $OpenXM: OpenXM_contrib2/asir2000/io/ox_asir.c,v 1.55 2004/03/09 07:18:26 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.55 noro 699: parse_strp = augment_backslash(cmd);
1.1 noro 700: if ( mainparse(&snode) ) {
701: return -1;
702: }
703: val = evalstat(snode);
704: if ( NEXT(asir_infile) ) {
705: while ( NEXT(asir_infile) ) {
706: if ( mainparse(&snode) ) {
707: asir_push_one(val);
708: return -1;
709: }
710: nextbp = 0;
711: val = evalstat(snode);
712: }
713: }
714: asir_push_one(val);
715: return 0;
716: }
717:
718: static void asir_executeFunction(int serial)
719: {
720: char *func;
721: int argc;
722: FUNC f;
723: Obj result;
724: NODE n,n1;
725: STRING fname;
726: char *path;
727: ERR err;
1.5 noro 728: Obj arg;
1.1 noro 729: static char buf[BUFSIZ];
730:
1.5 noro 731: arg = asir_pop_one();
732: if ( !arg || OID(arg) != O_STR ) {
733: sprintf(buf,"executeFunction : invalid function name");
734: goto error;
735: } else
736: func = ((STRING)arg)->body;
737:
738: arg = asir_pop_one();
739: if ( !arg || OID(arg) != O_USINT ) {
740: sprintf(buf,"executeFunction : invalid argc");
741: goto error;
742: } else
743: argc = (int)(((USINT)arg)->body);
1.1 noro 744:
745: for ( n = 0; argc; argc-- ) {
746: NEXTNODE(n,n1);
747: BDY(n1) = (pointer)asir_pop_one();
748: }
749: if ( n )
750: NEXT(n1) = 0;
751:
752: if ( !strcmp(func,"load") ) {
753: fname = (STRING)BDY(n);
754: if ( OID(fname) == O_STR ) {
755: searchasirpath(BDY(fname),&path);
756: if ( path ) {
757: if ( do_message )
758: fprintf(stderr,"loading %s\n",path);
759: execasirfile(path);
760: } else
761: if ( do_message )
762: fprintf(stderr,"load : %s not found in the search path\n",BDY(fname));
763: }
764: result = 0;
765: } else {
766: searchf(noargsysf,func,&f);
767: if ( !f )
768: searchf(sysf,func,&f);
769: if ( !f )
770: searchf(ubinf,func,&f);
771: if ( !f )
772: searchf(usrf,func,&f);
773: if ( !f ) {
774: sprintf(buf,"executeFunction : the function %s not found",func);
1.5 noro 775: goto error;
1.1 noro 776: } else {
777: result = (Obj)bevalf(f,n);
778: }
779: }
1.5 noro 780: asir_push_one(result);
781: return;
782:
783: error:
784: create_error(&err,serial,buf);
785: result = (Obj)err;
1.1 noro 786: asir_push_one(result);
787: }
788:
1.20 noro 789: void asir_end_flush()
1.1 noro 790: {
791: ox_flushing = 0;
792: }
793:
794: /*
795: asir_OperandStackPtr points to the surface of the stack.
796: That is, the data at the stack top is
797: asir_OperandStack[asir_OperandStackPtr].
798: */
799:
800:
1.20 noro 801: void asir_push_one(Obj obj)
1.1 noro 802: {
803: if ( !obj || OID(obj) != O_VOID ) {
804: asir_OperandStackPtr++;
805: if ( asir_OperandStackPtr >= asir_OperandStackSize ) {
806: asir_OperandStackSize += BUFSIZ;
807: asir_OperandStack
808: = (Obj *)REALLOC(asir_OperandStack,
809: asir_OperandStackSize*sizeof(Obj));
810: }
811: asir_OperandStack[asir_OperandStackPtr] = obj;
812: }
813: }
814:
1.20 noro 815: Obj asir_pop_one() {
1.1 noro 816: if ( asir_OperandStackPtr < 0 ) {
817: if ( do_message )
818: fprintf(stderr,"OperandStack underflow");
819: return 0;
820: } else {
821: if ( do_message )
822: fprintf(stderr,"pop at %d\n",asir_OperandStackPtr);
823: return asir_OperandStack[asir_OperandStackPtr--];
1.18 noro 824: }
825: }
826:
1.20 noro 827: Obj asir_peek_one() {
1.18 noro 828: if ( asir_OperandStackPtr < 0 ) {
829: if ( do_message )
830: fprintf(stderr,"OperandStack underflow");
831: return 0;
832: } else {
833: if ( do_message )
834: fprintf(stderr,"peek at %d\n",asir_OperandStackPtr);
835: return asir_OperandStack[asir_OperandStackPtr];
1.1 noro 836: }
837: }
838:
1.40 noro 839: void ox_asir_init(int argc,char **argv,char *servername)
1.1 noro 840: {
841: char ifname[BUFSIZ];
842: extern int GC_dont_gc;
843: extern int read_exec_file;
844: extern int do_asirrc;
845: extern int do_server_in_X11;
1.37 noro 846: extern char displayname[];
1.1 noro 847: char *getenv();
848: static ox_asir_initialized = 0;
849: FILE *ifp;
1.4 noro 850: char *homedir;
851: char *ptr;
1.32 noro 852: #if !defined(VISUAL)
853: int tmp;
854: #endif
1.1 noro 855:
1.43 noro 856: #if !defined(VISUAL) && !defined(MPI)
1.1 noro 857: do_server_in_X11 = 1; /* XXX */
858: #endif
859: asir_save_handler();
1.41 ohara 860: #if defined(PARI)
1.1 noro 861: risa_pari_init();
862: #endif
863: srandom((int)get_current_time());
864:
865: rtime_init();
866: env_init();
867: endian_init();
868: GC_init();
1.44 noro 869: cppname_init();
1.1 noro 870: process_args(--argc,++argv);
1.37 noro 871: #if defined(__CYGWIN__)
872: if ( !displayname[0] )
873: do_server_in_X11 = 0; /* XXX */
874: #endif
1.1 noro 875: output_init();
876: arf_init();
877: nglob_init();
878: glob_init();
879: sig_init();
880: tty_init();
881: debug_init();
882: pf_init();
883: sysf_init();
884: parif_init();
885: #if defined(VISUAL)
886: init_socket();
887: #endif
888: #if defined(UINIT)
889: reg_sysf();
890: #endif
1.4 noro 891: /* if ASIR_CONFIG is set, execute it; else execute .asirrc */
892: if ( ptr = getenv("ASIR_CONFIG") )
893: strcpy(ifname,ptr);
894: else {
895: homedir = getenv("HOME");
896: if ( !homedir ) {
897: char rootname[BUFSIZ];
898:
899: get_rootdir(rootname,sizeof(rootname));
900: homedir = rootname;
901: }
902: sprintf(ifname,"%s/.asirrc",homedir);
903: }
1.1 noro 904: if ( do_asirrc && (ifp = fopen(ifname,"r")) ) {
905: input_init(ifp,ifname);
1.35 noro 906: if ( !SETJMP(main_env) ) {
1.1 noro 907: read_exec_file = 1;
908: read_eval_loop();
909: read_exec_file = 0;
910: }
911: fclose(ifp);
912: }
913: input_init(0,"string");
1.30 noro 914: /* XXX Windows compatibility */
915: ox_io_init();
1.40 noro 916: create_my_mathcap(servername);
1.1 noro 917: }
918:
1.20 noro 919: void ox_io_init() {
1.1 noro 920: unsigned char c,rc;
1.21 noro 921: extern int I_am_server;
1.26 noro 922:
1.33 noro 923: /* XXX : ssh forwards stdin to a remote host on PC Unix */
924: #if defined(linux)
925: #include <sys/param.h>
1.32 noro 926: int i;
927:
928: close(0);
929: for ( i = 5; i < NOFILE; i++ )
930: close(i);
1.33 noro 931: #elif defined(__FreeBSD__)
1.27 noro 932: #include <sys/resource.h>
1.33 noro 933: int i;
1.32 noro 934: struct rlimit rl;
1.27 noro 935:
1.32 noro 936: getrlimit(RLIMIT_NOFILE,&rl);
937: close(0);
938: for ( i = 5; i < rl.rlim_cur; i++ )
939: close(i);
1.27 noro 940: #endif
1.1 noro 941:
1.21 noro 942: I_am_server = 1;
1.1 noro 943: endian_init();
944: #if defined(VISUAL)
945: if ( !ox_sock_id )
946: exit(0);
947: iofp[0].in = WSIO_open(ox_sock_id,"r");
948: iofp[0].out = WSIO_open(ox_sock_id,"w");
949: #else
950: iofp[0].in = fdopen(3,"r");
951: iofp[0].out = fdopen(4,"w");
952:
1.34 noro 953: #if !defined(__CYGWIN__)
1.1 noro 954: setbuffer(iofp[0].in,(char *)malloc(LBUFSIZ),LBUFSIZ);
955: setbuffer(iofp[0].out,(char *)malloc(LBUFSIZ),LBUFSIZ);
1.34 noro 956: #endif
1.1 noro 957: signal(SIGUSR1,ox_usr1_handler);
958: #endif
959: asir_OperandStackSize = BUFSIZ;
960: asir_OperandStack = (Obj *)CALLOC(asir_OperandStackSize,sizeof(Obj));
961: asir_OperandStackPtr = -1;
962: if ( little_endian )
963: c = 1;
964: else
965: c = 0xff;
966: /* server : write -> read */
967: write_char(iofp[0].out,&c); ox_flush_stream_force(0);
968: read_char(iofp[0].in,&rc);
969: iofp[0].conv = c == rc ? 0 : 1;
1.14 noro 970: /* XXX; for raw I/O */
971: register_server(0,0,0);
1.3 noro 972: }
973:
1.17 noro 974: #if !defined(VISUAL)
1.3 noro 975: /*
976: * Library mode functions
977: */
978:
979: /*
980: * Converts a binary encoded CMO into a risa object
981: * and pushes it onto the stack.
982: */
983:
984: void asir_ox_push_cmo(void *cmo)
985: {
986: Obj obj;
987:
988: ox_copy_init(cmo);
989: ox_buf_to_obj_as_cmo(&obj);
990: asir_push_one(obj);
991: }
992:
993: /*
994: * Pop an object from the stack and converts it
1.28 noro 995: * into a binary encoded CMO.
1.3 noro 996: */
997:
998: int asir_ox_pop_cmo(void *cmo, int limit)
999: {
1000: Obj obj;
1001: int len;
1.11 noro 1002: ERR err;
1.3 noro 1003:
1004: obj = asir_pop_one();
1.10 noro 1005: if ( !valid_as_cmo(obj) ) {
1.11 noro 1006: asir_push_one(obj);
1007: create_error(&err,0,"The object at the stack top is invalid as a CMO.");
1008: obj = (Obj)err;
1.10 noro 1009: }
1.3 noro 1010: len = count_as_cmo(obj);
1011: if ( len <= limit ) {
1012: ox_copy_init(cmo);
1013: ox_obj_to_buf_as_cmo(obj);
1014: return len;
1015: } else
1016: return -1;
1.28 noro 1017: }
1018:
1019: int asir_ox_pop_string(void *string, int limit)
1020: {
1021: Obj val;
1022: int l;
1023:
1024: val = asir_pop_one();
1025: if ( !val ) {
1026: if ( limit >= 2 ) {
1027: sprintf(string,"0");
1028: l = strlen(string);
1029: } else
1030: l = -1;
1031: } else {
1032: l = estimate_length(CO,val);
1033: if ( l+1 <= limit ) {
1034: soutput_init(string);
1035: sprintexpr(CO,val);
1036: l = strlen(string);
1037: } else
1038: l = -1;
1039: }
1040: return l;
1.3 noro 1041: }
1042:
1043: /*
1044: * Executes an SM command.
1045: */
1046:
1.13 noro 1047: void asir_ox_push_cmd(int cmd)
1.3 noro 1048: {
1.7 noro 1049: int ret;
1050: ERR err;
1051: extern char LastError[];
1052:
1.35 noro 1053: if ( ret = SETJMP(main_env) ) {
1.12 noro 1054: asir_reset_handler();
1.7 noro 1055: if ( ret == 1 ) {
1056: create_error(&err,0,LastError); /* XXX */
1057: asir_push_one((Obj)err);
1058: }
1.12 noro 1059: } else {
1060: asir_save_handler();
1061: asir_set_handler();
1.7 noro 1062: asir_do_cmd(cmd,0);
1.12 noro 1063: asir_reset_handler();
1064: }
1.3 noro 1065: }
1066:
1067: /*
1068: * Executes a string written in Asir.
1069: */
1070:
1071: void asir_ox_execute_string(char *s)
1072: {
1073: STRING str;
1.8 noro 1074: int ret;
1075: ERR err;
1076: extern char LastError[];
1.3 noro 1077:
1078: MKSTR(str,s);
1079: asir_push_one((Obj)str);
1.35 noro 1080: if ( ret = SETJMP(main_env) ) {
1.12 noro 1081: asir_reset_handler();
1.8 noro 1082: if ( ret == 1 ) {
1083: create_error(&err,0,LastError); /* XXX */
1084: asir_push_one((Obj)err);
1085: }
1.12 noro 1086: } else {
1087: asir_save_handler();
1088: asir_set_handler();
1.8 noro 1089: asir_executeString();
1.12 noro 1090: asir_reset_handler();
1091: }
1.3 noro 1092: }
1093:
1094: /*
1095: * Returns the size as a CMO of the object
1096: * at the top of the stack.
1097: */
1098:
1099: int asir_ox_peek_cmo_size()
1100: {
1101: Obj obj;
1102: int len;
1103:
1.38 noro 1104: obj = asir_peek_one();
1.10 noro 1105: if ( !valid_as_cmo(obj) ) {
1106: fprintf(stderr,"The object at the stack top is invalid as a CMO.\n");
1107: return 0;
1108: }
1.3 noro 1109: len = count_as_cmo(obj);
1.38 noro 1110: return len;
1111: }
1112:
1113: int asir_ox_peek_cmo_string_length()
1114: {
1115: Obj obj;
1116: int len;
1117:
1118: obj = asir_peek_one();
1119: if ( !valid_as_cmo(obj) ) {
1120: fprintf(stderr,"The object at the stack top is invalid as a CMO.\n");
1121: return 0;
1122: }
1123: len = estimate_length(CO,obj);
1.39 noro 1124: return len+1;
1.3 noro 1125: }
1126:
1127: /*
1128: * Initialization.
1.11 noro 1129: * byteorder=0 => native
1130: * =1 => network byte order
1.3 noro 1131: */
1132:
1.13 noro 1133: int asir_ox_init(int byteorder)
1.3 noro 1134: {
1135: int tmp;
1136: char ifname[BUFSIZ];
1137: extern int GC_dont_gc;
1138: extern int read_exec_file;
1139: extern int do_asirrc;
1140: extern int do_server_in_X11;
1141: char *getenv();
1142: static ox_asir_initialized = 0;
1143: FILE *ifp;
1144:
1.43 noro 1145: #if !defined(VISUAL) && !defined(MPI)
1.9 noro 1146: do_server_in_X11 = 0; /* XXX */
1.3 noro 1147: #endif
1148: asir_save_handler();
1.41 ohara 1149: #if defined(PARI)
1.3 noro 1150: risa_pari_init();
1151: #endif
1152: srandom((int)get_current_time());
1153:
1154: rtime_init();
1155: env_init();
1156: endian_init();
1157: GC_init();
1158: /* process_args(argc,argv); */
1159: output_init();
1160: arf_init();
1161: nglob_init();
1162: glob_init();
1163: sig_init();
1164: tty_init();
1165: debug_init();
1166: pf_init();
1167: sysf_init();
1168: parif_init();
1169: #if defined(VISUAL)
1170: init_socket();
1171: #endif
1172: #if defined(UINIT)
1173: reg_sysf();
1174: #endif
1175: sprintf(ifname,"%s/.asirrc",getenv("HOME"));
1176: if ( do_asirrc && (ifp = fopen(ifname,"r")) ) {
1177: input_init(ifp,ifname);
1.35 noro 1178: if ( !SETJMP(main_env) ) {
1.3 noro 1179: read_exec_file = 1;
1180: read_eval_loop();
1181: read_exec_file = 0;
1182: }
1183: fclose(ifp);
1184: }
1185: input_init(0,"string");
1186:
1187: asir_OperandStackSize = BUFSIZ;
1188: asir_OperandStack = (Obj *)CALLOC(asir_OperandStackSize,sizeof(Obj));
1189: asir_OperandStackPtr = -1;
1.11 noro 1190: if ( little_endian && byteorder )
1191: lib_ox_need_conv = 1;
1.3 noro 1192: else
1.11 noro 1193: lib_ox_need_conv = 0;
1.3 noro 1194: do_message = 0;
1.11 noro 1195: create_my_mathcap("ox_asir");
1.12 noro 1196: asir_reset_handler();
1.13 noro 1197: return 0;
1.1 noro 1198: }
1.17 noro 1199: #endif