[BACK]Return to serv2.c CVS log [TXT][DIR] Up to [local] / OpenXM / src / ox_math

Annotation of OpenXM/src/ox_math/serv2.c, Revision 1.6

1.1       ohara       1: /* -*- mode: C; coding: euc-japan -*- */
1.6     ! ohara       2: /* $OpenXM: OpenXM/src/ox_math/serv2.c,v 1.5 1999/11/04 19:33:17 ohara Exp $ */
1.1       ohara       3:
                      4: /* Open Mathematica サーバ */
                      5: /* ファイルディスクリプタ 3, 4 は open されていると仮定して動作する. */
                      6:
                      7: /* MathLink との通信部分 */
                      8:
                      9: #include <stdio.h>
                     10: #include <stdlib.h>
                     11: #include <unistd.h>
                     12: #include <gmp.h>
                     13: #include <mathlink.h>
                     14: #include "ox.h"
1.6     ! ohara      15: #include "parse.h"
1.1       ohara      16: #include "serv2.h"
                     17:
                     18: #define UNKNOWN_SM_COMMAND 50000
                     19: #define MATH_ERROR         50001
                     20:
                     21: /* MLINK はポインタ型. */
                     22: MLINK lp = NULL;
                     23:
1.4       ohara      24: typedef cmo mlo;
                     25: typedef cmo_string mlo_string;
                     26: typedef cmo_zz mlo_zz;
                     27:
                     28: /* cmo_list の派生クラス*/
                     29: typedef struct {
                     30:        int tag;
                     31:        int length;
1.5       ohara      32:        cell head[1];
1.4       ohara      33:        char *function;
                     34: } mlo_function;
                     35:
                     36:
                     37: mlo *receive_mlo_zz()
                     38: {
                     39:        char *s;
                     40:        mlo  *m;
                     41:
1.5       ohara      42:        fprintf(stderr, "--debug: MLO == MLTKINT.\n");
1.4       ohara      43:        MLGetString(lp, &s);
                     44:        fprintf(stderr, "--debug: zz = %s.\n", s);
                     45:        m = (mlo *)new_cmo_zz_set_string(s);
                     46:        MLDisownString(lp, s);
                     47:        return m;
                     48: }
                     49:
                     50: mlo *receive_mlo_string()
                     51: {
                     52:        char *s;
                     53:        mlo  *m;
1.5       ohara      54:        fprintf(stderr, "--debug: MLO == MLTKSTR.\n");
1.4       ohara      55:        MLGetString(lp, &s);
1.5       ohara      56:        fprintf(stderr, "--debug: string = \"%s\".\n", s);
1.4       ohara      57:        m = (cmo *)new_cmo_string(s);
                     58:        MLDisownString(lp, s);
                     59:        return m;
                     60: }
                     61:
1.5       ohara      62: cmo *receive_mlo_function()
                     63: {
                     64:        char *s;
                     65:        cmo *m;
                     66:     cmo  *ob;
                     67:     int  i,n;
                     68:
                     69:        fprintf(stderr, "--debug: MLO == MLTKFUNC.\n");
                     70:        MLGetFunction(lp, &s, &n);
                     71:        fprintf(stderr, "--debug: Function = \"%s\", # of args = %d\n", s, n);
                     72:        m = new_cmo_list();
1.6     ! ohara      73:        append_cmo_list((cmo_list *)m, new_cmo_string(s));
1.5       ohara      74:
                     75:        for (i=0; i<n; i++) {
                     76:                fprintf(stderr, "--debug: arg[%d]\n", i);
                     77:                fflush(stderr);
                     78:                ob = receive_mlo();
1.6     ! ohara      79:                append_cmo_list((cmo_list *)m, ob);
1.5       ohara      80:        }
                     81:
                     82:        MLDisownString(lp, s);
                     83:        return m;
                     84: }
                     85:
                     86: cmo *receive_mlo_symbol()
                     87: {
                     88:        cmo *ob;
                     89:        char *s;
                     90:
                     91:        fprintf(stderr, "--debug: MLO == MLTKSYM.\n");
                     92:        MLGetSymbol(lp, &s);
                     93:        fprintf(stderr, "--debug: Symbol \"%s\".\n", s);
                     94:
                     95:        ob = new_cmo_indeterminate(new_cmo_string(s));
                     96:
                     97:        MLDisownString(lp, s);
                     98:        return ob;
                     99: }
                    100:
1.1       ohara     101: /* Mathematica を起動する. */
                    102: int MATH_init()
                    103: {
                    104:     int argc = 2;
                    105:     char *argv[] = {"-linkname", "math -mathlink"};
                    106:
1.5       ohara     107:     if(MLInitialize(NULL) == NULL
                    108:           || (lp = MLOpen(argc, argv)) == NULL) {
                    109:                fprintf(stderr, "Mathematica Kernel not found.\n");
                    110:                exit(1);
1.1       ohara     111:     }
1.5       ohara     112:        return 0;
1.1       ohara     113: }
                    114:
                    115: int MATH_exit()
                    116: {
                    117:     /* quit Mathematica then close the link */
                    118:     MLPutFunction(lp, "Exit", 0);
                    119:     MLClose(lp);
                    120: }
                    121:
                    122: cmo *MATH_getObject2()
                    123: {
                    124:     /* skip any packets before the first ReturnPacket */
                    125:     while (MLNextPacket(lp) != RETURNPKT) {
                    126:         usleep(10);
                    127:         MLNewPacket(lp);
                    128:     }
1.5       ohara     129:        return receive_mlo();
1.4       ohara     130: }
                    131:
1.5       ohara     132: cmo *receive_mlo()
1.4       ohara     133: {
                    134:     char *s;
                    135:        int type;
                    136:
1.5       ohara     137:     switch(type = MLGetNext(lp)) {
1.1       ohara     138:     case MLTKINT:
1.5       ohara     139:                return receive_mlo_zz();
1.1       ohara     140:     case MLTKSTR:
1.5       ohara     141:                return receive_mlo_string();
1.4       ohara     142:     case MLTKREAL:
1.5       ohara     143:                /* double はまだ... */
                    144:         fprintf(stderr, "--debug: MLO == MLTKREAL.\n");
1.1       ohara     145:         MLGetString(lp, &s);
1.6     ! ohara     146:         return (cmo *)new_cmo_string(s);
1.5       ohara     147:     case MLTKSYM:
                    148:         return receive_mlo_symbol();
                    149:     case MLTKFUNC:
                    150:                return receive_mlo_function();
1.1       ohara     151:     case MLTKERR:
1.4       ohara     152:         fprintf(stderr, "--debug: MLO == MLTKERR.\n");
1.6     ! ohara     153:         return (cmo *)gen_error_object(MATH_ERROR);
1.1       ohara     154:     default:
1.5       ohara     155:         fprintf(stderr, "--debug: MLO(%d) is unknown.\n", type);
1.1       ohara     156:         MLGetString(lp, &s);
1.4       ohara     157:                fprintf(stderr, "--debug: \"%s\"\n", s);
1.6     ! ohara     158:         return (cmo *)new_cmo_string(s);
1.1       ohara     159:     }
1.5       ohara     160: }
                    161:
                    162: int send_mlo_int32(cmo *m)
                    163: {
                    164:        MLPutInteger(lp, ((cmo_int32 *)m)->i);
                    165: }
                    166:
                    167: int send_mlo_string(cmo *m)
                    168: {
                    169:        char *s = ((cmo_string *)m)->s;
                    170:        MLPutString(lp, s);
                    171:        fprintf(stderr, "ox_math:: put %s.", s);
                    172: }
                    173:
                    174: int send_mlo_zz(cmo *m)
                    175: {
                    176:        char *s;
                    177:        MLPutFunction(lp, "ToExpression", 1);
                    178:        s = convert_cmo_to_string(m);
                    179:        MLPutString(lp, s);
                    180:        fprintf(stderr, "put %s.", s);
                    181: }
                    182:
                    183: int send_mlo_list(cmo *c)
                    184: {
                    185:        char *s;
                    186:        cell *cp = ((cmo_list *)c)->head;
                    187:        int len = length_cmo_list((cmo_list *)c);
                    188:
                    189:        fprintf(stderr, "ox_math:: put List with %d args.\n", len);
                    190:        MLPutFunction(lp, "List", len);
                    191:        while(cp->next != NULL) {
                    192:                send_mlo(cp->cmo);
                    193:                cp = cp->next;
                    194:        }
1.1       ohara     195: }
                    196:
                    197: int MATH_sendObject(cmo *m)
                    198: {
1.5       ohara     199:        send_mlo(m);
                    200:        MLEndPacket(lp);
                    201: }
                    202:
                    203: int send_mlo(cmo *m)
                    204: {
1.1       ohara     205:     char *s;
                    206:     switch(m->tag) {
                    207:     case CMO_INT32:
1.5       ohara     208:                send_mlo_int32(m);
1.1       ohara     209:         break;
                    210:     case CMO_STRING:
1.5       ohara     211:                send_mlo_string(m);
                    212:         break;
                    213:        case CMO_LIST:
                    214:                send_mlo_list(m);
1.1       ohara     215:         break;
                    216:     default:
                    217:         MLPutFunction(lp, "ToExpression", 1);
1.3       ohara     218:         s = convert_cmo_to_string(m);
1.1       ohara     219:         MLPutString(lp, s);
                    220:         fprintf(stderr, "put %s.", s);
                    221:         break;
                    222:     }
                    223: }
                    224:
                    225: int MATH_evaluateStringByLocalParser(char *str)
                    226: {
                    227:     MLPutFunction(lp, "ToExpression", 1);
                    228:     MLPutString(lp, str);
                    229:     MLEndPacket(lp);
                    230: }
                    231:
                    232: int MATH_executeFunction(char *function, int argc, cmo *argv[])
                    233: {
                    234:     int i;
                    235:     MLPutFunction(lp, function, argc);
                    236:     for (i=0; i<argc; i++) {
1.5       ohara     237:         send_mlo(argv[i]);
1.1       ohara     238:     }
                    239:     MLEndPacket(lp);
                    240: }
                    241:
                    242: /* MathLink 非依存部分 */
                    243:
                    244: #define SIZE_OPERAND_STACK   2048
                    245:
                    246: static cmo* Operand_Stack[SIZE_OPERAND_STACK];
                    247: static int Stack_Pointer = 0;
                    248:
                    249: int initialize_stack()
                    250: {
                    251:     Stack_Pointer = 0;
                    252: }
                    253:
                    254: int push(cmo* m)
                    255: {
                    256: #if DEBUG
1.6     ! ohara     257:        symbol *symp;
        !           258:
1.1       ohara     259:     if (m->tag == CMO_STRING) {
1.5       ohara     260:         fprintf(stderr, "ox_math:: a cmo_string(%s) was pushed.\n", ((cmo_string *)m)->s);
                    261:     }else {
1.6     ! ohara     262:                symp = lookup_by_tag(m->tag);
        !           263:                fprintf(stderr, "ox_math:: a %s was pushed.\n", symp->key);
1.5       ohara     264:        }
1.1       ohara     265: #endif
                    266:     Operand_Stack[Stack_Pointer] = m;
                    267:     Stack_Pointer++;
                    268:     if (Stack_Pointer >= SIZE_OPERAND_STACK) {
                    269:         fprintf(stderr, "stack over flow.\n");
1.6     ! ohara     270:                Stack_Pointer--;
1.1       ohara     271:     }
                    272: }
                    273:
1.3       ohara     274: /* スタックが空のときは, (CMO_NULL) をかえす. */
1.1       ohara     275: cmo* pop()
                    276: {
                    277:     if (Stack_Pointer > 0) {
                    278:         Stack_Pointer--;
                    279:         return Operand_Stack[Stack_Pointer];
                    280:     }
1.3       ohara     281:     return new_cmo_null();
1.1       ohara     282: }
                    283:
                    284: void pops(int n)
                    285: {
                    286:     Stack_Pointer -= n;
                    287:     if (Stack_Pointer < 0) {
                    288:         Stack_Pointer = 0;
                    289:     }
                    290: }
                    291:
                    292: /* sm_XXX 関数群は、エラーのときは 0 以外の値を返し、呼び出し元で
                    293:    エラーオブジェクトをセットする */
                    294: int sm_popCMO(int fd_write)
                    295: {
                    296:     cmo* m = pop();
1.6     ! ohara     297: #ifdef DEBUG
        !           298:        symbol *symp = lookup_by_tag(m->tag);
        !           299:
        !           300:     fprintf(stderr, "ox_math:: opecode = SM_popCMO. (%s)\n", symp->key);
        !           301: #endif
1.1       ohara     302:     if (m != NULL) {
                    303:         send_ox_cmo(fd_write, m);
                    304:         return 0;
                    305:     }
                    306:     return SM_popCMO;
                    307: }
                    308:
                    309: int sm_pops(int fd_write)
                    310: {
                    311:     cmo* m = pop();
                    312:     if (m != NULL && m->tag == CMO_INT32) {
                    313:         pops(((cmo_int32 *)m)->i);
                    314:         return 0;
                    315:     }
                    316:     return UNKNOWN_SM_COMMAND;
                    317: }
                    318:
                    319: /* MathLink 依存部分 */
                    320: int sm_popString(int fd_write)
                    321: {
1.6     ! ohara     322:     char *s;
        !           323:     cmo *err;
        !           324:     cmo *m;
1.1       ohara     325:
                    326: #ifdef DEBUG
1.5       ohara     327:     fprintf(stderr, "ox_math:: opecode = SM_popString.\n");
1.1       ohara     328: #endif
                    329:
1.6     ! ohara     330:        m = pop();
        !           331:        if (m->tag == CMO_STRING) {
        !           332:         send_ox_cmo(fd_write, m);
        !           333:        }else if ((s = convert_cmo_to_string(m)) != NULL) {
1.2       ohara     334:         send_ox_cmo(fd_write, (cmo *)new_cmo_string(s));
1.6     ! ohara     335:     }else {
        !           336:                err = new_cmo_error2(m);
        !           337:                send_ox_cmo(fd_write, err);
        !           338:        }
        !           339:        return 0;
        !           340: }
        !           341:
        !           342: int local_execute(char *s)
        !           343: {
        !           344:        return 0;
1.1       ohara     345: }
                    346:
                    347: /* この関数はサーバに依存する. */
                    348: int sm_executeStringByLocalParser(int fd_write)
                    349: {
1.6     ! ohara     350:        symbol *symp;
        !           351:     cmo* m = pop();
        !           352:        char *s = NULL;
1.1       ohara     353: #ifdef DEBUG
1.5       ohara     354:     fprintf(stderr, "ox_math:: opecode = SM_executeStringByLocalParser.\n");
1.1       ohara     355: #endif
1.6     ! ohara     356:
        !           357:     if (m->tag == CMO_STRING
        !           358:                && strlen(s = ((cmo_string *)m)->s) != 0) {
        !           359:                if (s[0] == ':') {
        !           360:                        local_execute(s);
        !           361:                }else {
        !           362:                        /* for mathematica */
        !           363:                        /* mathematica に文字列を送って評価させる */
        !           364:                        MATH_evaluateStringByLocalParser(s);
        !           365:                        push(MATH_getObject2());
        !           366:                }
        !           367:                return 0;
1.1       ohara     368:     }
1.6     ! ohara     369: #ifdef DEBUG
        !           370:        if ((symp = lookup_by_tag(m->tag)) != NULL) {
        !           371:                fprintf(stderr, "ox_math:: error. the top of stack is %s.\n", symp->key);
        !           372:        }else {
        !           373:                fprintf(stderr, "ox_math:: error. the top of stack is unknown cmo. (%d)\n", m->tag);
        !           374:        }
        !           375: #endif
1.1       ohara     376:     return SM_executeStringByLocalParser;
                    377: }
                    378:
                    379: int sm_executeFunction(int fd_write)
                    380: {
                    381:     int i, argc;
                    382:     cmo **argv;
                    383:     char* func;
                    384:     cmo* m;
                    385:
                    386:     if ((m = pop()) == NULL || m->tag != CMO_STRING) {
                    387:         return SM_executeFunction;
                    388:     }
                    389:     func = ((cmo_string *)m)->s;
                    390:
                    391:     if ((m = pop()) == NULL || m->tag != CMO_INT32) {
                    392:         return SM_executeFunction;
                    393:     }
1.6     ! ohara     394:
1.1       ohara     395:     argc = ((cmo_int32 *)m)->i;
                    396:     argv = malloc(sizeof(cmo *)*argc);
                    397:     for (i=0; i<argc; i++) {
1.6     ! ohara     398:         argv[i] = pop();
1.1       ohara     399:     }
                    400:     MATH_executeFunction(func, argc, argv);
                    401:     push(MATH_getObject2());
                    402:     return 0;
                    403: }
                    404:
                    405: /* 平成11年10月13日 */
                    406: #define VERSION 0x11102700
                    407: #define ID_STRING  "ox_math server 1999/10/28 17:29:25"
                    408:
                    409: int sm_mathcap(int fd_write)
                    410: {
                    411:     cmo* c = make_mathcap_object(VERSION, ID_STRING);
                    412:     push(c);
                    413:     return 0;
                    414: }
                    415:
                    416: int receive_sm_command(int fd_read)
                    417: {
                    418:     return receive_int32(fd_read);
                    419: }
                    420:
                    421: int execute_sm_command(int fd_write, int code)
                    422: {
                    423:     int err = 0;
                    424:
                    425:     switch(code) {
                    426:     case SM_popCMO:
                    427:         err = sm_popCMO(fd_write);
                    428:         break;
                    429:     case SM_popString:
                    430:         err = sm_popString(fd_write);
                    431:         break;
                    432:     case SM_mathcap:
                    433:         err = sm_mathcap(fd_write);
                    434:         break;
                    435:     case SM_pops:
                    436:         err = sm_pops(fd_write);
                    437:         break;
                    438:     case SM_executeStringByLocalParser:
                    439:         err = sm_executeStringByLocalParser(fd_write);
                    440:         break;
                    441:     case SM_executeFunction:
                    442:         err = sm_executeFunction(fd_write);
                    443:         break;
1.2       ohara     444:     case SM_setMathCap:
1.1       ohara     445:         pop();  /* 無視する */
                    446:         break;
                    447:     default:
                    448:         fprintf(stderr, "unknown command: %d.\n", code);
                    449:         err = UNKNOWN_SM_COMMAND;
                    450:     }
                    451:
                    452:     if (err != 0) {
1.2       ohara     453:         push((cmo *)gen_error_object(err));
1.1       ohara     454:     }
                    455: }

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