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