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