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