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