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