[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.5

1.1       ohara       1: /* -*- mode: C; coding: euc-japan -*- */
1.5     ! ohara       2: /* $OpenXM: OpenXM/src/ox_math/serv2.c,v 1.4 1999/11/04 03:05:51 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"
                     15: #include "serv2.h"
                     16:
                     17: #define UNKNOWN_SM_COMMAND 50000
                     18: #define MATH_ERROR         50001
                     19:
                     20: /* MLINK はポインタ型. */
                     21: MLINK lp = NULL;
                     22:
1.4       ohara      23:
                     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();
        !            73:        append_cmo_list(m, new_cmo_string(s));
        !            74:
        !            75:        for (i=0; i<n; i++) {
        !            76:                fprintf(stderr, "--debug: arg[%d]\n", i);
        !            77:                fflush(stderr);
        !            78:                ob = receive_mlo();
        !            79:                append_cmo_list(m, ob);
        !            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:
        !           101:
1.1       ohara     102: /* Mathematica を起動する. */
                    103: int MATH_init()
                    104: {
                    105:     int argc = 2;
                    106:     char *argv[] = {"-linkname", "math -mathlink"};
                    107:
1.5     ! ohara     108:     if(MLInitialize(NULL) == NULL
        !           109:           || (lp = MLOpen(argc, argv)) == NULL) {
        !           110:                fprintf(stderr, "Mathematica Kernel not found.\n");
        !           111:                exit(1);
1.1       ohara     112:     }
1.5     ! ohara     113:        return 0;
1.1       ohara     114: }
                    115:
                    116: int MATH_exit()
                    117: {
                    118:     /* quit Mathematica then close the link */
                    119:     MLPutFunction(lp, "Exit", 0);
                    120:     MLClose(lp);
                    121: }
                    122:
                    123: cmo *MATH_getObject2()
                    124: {
                    125:     /* skip any packets before the first ReturnPacket */
                    126:     while (MLNextPacket(lp) != RETURNPKT) {
                    127:         usleep(10);
                    128:         MLNewPacket(lp);
                    129:     }
1.5     ! ohara     130:        return receive_mlo();
1.4       ohara     131: }
                    132:
1.5     ! ohara     133: cmo *receive_mlo()
1.4       ohara     134: {
                    135:     char *s;
                    136:        int type;
                    137:
1.5     ! ohara     138:     switch(type = MLGetNext(lp)) {
1.1       ohara     139:     case MLTKINT:
1.5     ! ohara     140:                return receive_mlo_zz();
1.1       ohara     141:     case MLTKSTR:
1.5     ! ohara     142:                return receive_mlo_string();
1.4       ohara     143:     case MLTKREAL:
1.5     ! ohara     144:                /* double はまだ... */
        !           145:         fprintf(stderr, "--debug: MLO == MLTKREAL.\n");
1.1       ohara     146:         MLGetString(lp, &s);
1.5     ! ohara     147:         return new_cmo_string(s);
        !           148:     case MLTKSYM:
        !           149:         return receive_mlo_symbol();
        !           150:     case MLTKFUNC:
        !           151:                return receive_mlo_function();
1.1       ohara     152:     case MLTKERR:
1.4       ohara     153:         fprintf(stderr, "--debug: MLO == MLTKERR.\n");
1.5     ! ohara     154:         return gen_error_object(MATH_ERROR);
1.1       ohara     155:     default:
1.5     ! ohara     156:         fprintf(stderr, "--debug: MLO(%d) is unknown.\n", type);
1.1       ohara     157:         MLGetString(lp, &s);
1.4       ohara     158:                fprintf(stderr, "--debug: \"%s\"\n", s);
1.5     ! ohara     159:         return new_cmo_string(s);
1.1       ohara     160:     }
1.5     ! ohara     161: }
        !           162:
        !           163:
        !           164: int send_mlo_int32(cmo *m)
        !           165: {
        !           166:        MLPutInteger(lp, ((cmo_int32 *)m)->i);
        !           167: }
        !           168:
        !           169: int send_mlo_string(cmo *m)
        !           170: {
        !           171:        char *s = ((cmo_string *)m)->s;
        !           172:        MLPutString(lp, s);
        !           173:        fprintf(stderr, "ox_math:: put %s.", s);
        !           174: }
        !           175:
        !           176: int send_mlo_zz(cmo *m)
        !           177: {
        !           178:        char *s;
        !           179:        MLPutFunction(lp, "ToExpression", 1);
        !           180:        s = convert_cmo_to_string(m);
        !           181:        MLPutString(lp, s);
        !           182:        fprintf(stderr, "put %s.", s);
        !           183: }
        !           184:
        !           185: int send_mlo_list(cmo *c)
        !           186: {
        !           187:        char *s;
        !           188:        cell *cp = ((cmo_list *)c)->head;
        !           189:        int len = length_cmo_list((cmo_list *)c);
        !           190:
        !           191:        fprintf(stderr, "ox_math:: put List with %d args.\n", len);
        !           192:        MLPutFunction(lp, "List", len);
        !           193:        while(cp->next != NULL) {
        !           194:                send_mlo(cp->cmo);
        !           195:                cp = cp->next;
        !           196:        }
1.1       ohara     197: }
                    198:
                    199: int MATH_sendObject(cmo *m)
                    200: {
1.5     ! ohara     201:        send_mlo(m);
        !           202:        MLEndPacket(lp);
        !           203: }
        !           204:
        !           205: int send_mlo(cmo *m)
        !           206: {
1.1       ohara     207:     char *s;
                    208:     switch(m->tag) {
                    209:     case CMO_INT32:
1.5     ! ohara     210:                send_mlo_int32(m);
1.1       ohara     211:         break;
                    212:     case CMO_STRING:
1.5     ! ohara     213:                send_mlo_string(m);
        !           214:         break;
        !           215:        case CMO_LIST:
        !           216:                send_mlo_list(m);
1.1       ohara     217:         break;
                    218:     default:
                    219:         MLPutFunction(lp, "ToExpression", 1);
1.3       ohara     220:         s = convert_cmo_to_string(m);
1.1       ohara     221:         MLPutString(lp, s);
                    222:         fprintf(stderr, "put %s.", s);
                    223:         break;
                    224:     }
                    225: }
                    226:
                    227: int MATH_evaluateStringByLocalParser(char *str)
                    228: {
                    229:     MLPutFunction(lp, "ToExpression", 1);
                    230:     MLPutString(lp, str);
                    231:     MLEndPacket(lp);
                    232: }
                    233:
                    234: int MATH_executeFunction(char *function, int argc, cmo *argv[])
                    235: {
                    236:     int i;
                    237:     MLPutFunction(lp, function, argc);
                    238:     for (i=0; i<argc; i++) {
1.5     ! ohara     239:         send_mlo(argv[i]);
1.1       ohara     240:     }
                    241:     MLEndPacket(lp);
                    242: }
                    243:
                    244: /* MathLink 非依存部分 */
                    245:
                    246: #define SIZE_OPERAND_STACK   2048
                    247:
                    248: static cmo* Operand_Stack[SIZE_OPERAND_STACK];
                    249: static int Stack_Pointer = 0;
                    250:
                    251: int initialize_stack()
                    252: {
                    253:     Stack_Pointer = 0;
                    254: }
                    255:
                    256: int push(cmo* m)
                    257: {
                    258: #if DEBUG
                    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 {
        !           262:                fprintf(stderr, "ox_math:: a cmo(%d) was pushed.\n", m->tag);
        !           263:        }
1.1       ohara     264: #endif
                    265:     Operand_Stack[Stack_Pointer] = m;
                    266:     Stack_Pointer++;
                    267:     if (Stack_Pointer >= SIZE_OPERAND_STACK) {
                    268:         fprintf(stderr, "stack over flow.\n");
1.5     ! ohara     269:         exit(1); /* 手抜き */
1.1       ohara     270:     }
                    271: }
                    272:
1.3       ohara     273: /* スタックが空のときは, (CMO_NULL) をかえす. */
1.1       ohara     274: cmo* pop()
                    275: {
                    276:     if (Stack_Pointer > 0) {
                    277:         Stack_Pointer--;
                    278:         return Operand_Stack[Stack_Pointer];
                    279:     }
1.3       ohara     280:     return new_cmo_null();
1.1       ohara     281: }
                    282:
                    283: void pops(int n)
                    284: {
                    285:     Stack_Pointer -= n;
                    286:     if (Stack_Pointer < 0) {
                    287:         Stack_Pointer = 0;
                    288:     }
                    289: }
                    290:
                    291: /* sm_XXX 関数群は、エラーのときは 0 以外の値を返し、呼び出し元で
                    292:    エラーオブジェクトをセットする */
                    293: int sm_popCMO(int fd_write)
                    294: {
                    295:     cmo* m = pop();
                    296:
1.5     ! ohara     297:     fprintf(stderr, "ox_math:: opecode = SM_popCMO. (tag = %d)\n", m->tag);
1.1       ohara     298:     if (m != NULL) {
                    299:         send_ox_cmo(fd_write, m);
                    300:         return 0;
                    301:     }
                    302:     return SM_popCMO;
                    303: }
                    304:
                    305: int sm_pops(int fd_write)
                    306: {
                    307:     cmo* m = pop();
                    308:     if (m != NULL && m->tag == CMO_INT32) {
                    309:         pops(((cmo_int32 *)m)->i);
                    310:         return 0;
                    311:     }
                    312:     return UNKNOWN_SM_COMMAND;
                    313: }
                    314:
                    315: /* MathLink 依存部分 */
                    316: int sm_popString(int fd_write)
                    317: {
                    318:     char* s;
                    319:     cmo*  m;
                    320:
                    321: #ifdef DEBUG
1.5     ! ohara     322:     fprintf(stderr, "ox_math:: opecode = SM_popString.\n");
1.1       ohara     323: #endif
                    324:
1.3       ohara     325:     if ((m = pop()) != NULL && (s = convert_cmo_to_string(m)) != NULL) {
1.2       ohara     326:         send_ox_cmo(fd_write, (cmo *)new_cmo_string(s));
1.1       ohara     327:         return 0;
                    328:     }
                    329:     return SM_popString;
                    330: }
                    331:
                    332: /* この関数はサーバに依存する. */
                    333: int sm_executeStringByLocalParser(int fd_write)
                    334: {
                    335:     cmo* m = NULL;
                    336: #ifdef DEBUG
1.5     ! ohara     337:     fprintf(stderr, "ox_math:: opecode = SM_executeStringByLocalParser.\n");
1.1       ohara     338: #endif
                    339:     if ((m = pop()) != NULL && m->tag == CMO_STRING) {
                    340:         /* for mathematica */
                    341:         /* mathematica に文字列を送って評価させる */
                    342:         MATH_evaluateStringByLocalParser(((cmo_string *)m)->s);
                    343:         push(MATH_getObject2());
                    344:         return 0;
                    345:     }
                    346:     fprintf(stderr, "cannot execute: top of stack is not string!(%p, %d)\n", m, m->tag);
                    347:     return SM_executeStringByLocalParser;
                    348: }
                    349:
                    350: int sm_executeFunction(int fd_write)
                    351: {
                    352:     int i, argc;
                    353:     cmo **argv;
                    354:     char* func;
                    355:     cmo* m;
                    356:
                    357:     if ((m = pop()) == NULL || m->tag != CMO_STRING) {
                    358:         return SM_executeFunction;
                    359:     }
                    360:     func = ((cmo_string *)m)->s;
                    361:
                    362:     if ((m = pop()) == NULL || m->tag != CMO_INT32) {
                    363:         return SM_executeFunction;
                    364:     }
                    365:     argc = ((cmo_int32 *)m)->i;
                    366:     argv = malloc(sizeof(cmo *)*argc);
                    367:     for (i=0; i<argc; i++) {
                    368:         if ((argv[i] = pop()) == NULL) {
                    369:             return SM_executeFunction;
                    370:         }
                    371:     }
                    372:     MATH_executeFunction(func, argc, argv);
                    373:     push(MATH_getObject2());
                    374:     return 0;
                    375: }
                    376:
                    377: /* 平成11年10月13日 */
                    378: #define VERSION 0x11102700
                    379: #define ID_STRING  "ox_math server 1999/10/28 17:29:25"
                    380:
                    381: int sm_mathcap(int fd_write)
                    382: {
                    383:     cmo* c = make_mathcap_object(VERSION, ID_STRING);
                    384:     push(c);
                    385:     return 0;
                    386: }
                    387:
                    388: int receive_sm_command(int fd_read)
                    389: {
                    390:     return receive_int32(fd_read);
                    391: }
                    392:
                    393: int execute_sm_command(int fd_write, int code)
                    394: {
                    395:     int err = 0;
                    396:
                    397:     switch(code) {
                    398:     case SM_popCMO:
                    399:         err = sm_popCMO(fd_write);
                    400:         break;
                    401:     case SM_popString:
                    402:         err = sm_popString(fd_write);
                    403:         break;
                    404:     case SM_mathcap:
                    405:         err = sm_mathcap(fd_write);
                    406:         break;
                    407:     case SM_pops:
                    408:         err = sm_pops(fd_write);
                    409:         break;
                    410:     case SM_executeStringByLocalParser:
                    411:         err = sm_executeStringByLocalParser(fd_write);
                    412:         break;
                    413:     case SM_executeFunction:
                    414:         err = sm_executeFunction(fd_write);
                    415:         break;
1.2       ohara     416:     case SM_setMathCap:
1.1       ohara     417:         pop();  /* 無視する */
                    418:         break;
                    419:     default:
                    420:         fprintf(stderr, "unknown command: %d.\n", code);
                    421:         err = UNKNOWN_SM_COMMAND;
                    422:     }
                    423:
                    424:     if (err != 0) {
1.2       ohara     425:         push((cmo *)gen_error_object(err));
1.1       ohara     426:     }
                    427: }

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