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