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