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