[BACK]Return to ox_asir.c CVS log [TXT][DIR] Up to [local] / OpenXM_contrib2 / asir2000 / io

Annotation of OpenXM_contrib2/asir2000/io/ox_asir.c, Revision 1.15

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>