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

1.1       ohara       1: /* -*- mode: C; coding: euc-japan -*- */
1.7     ! ohara       2: /* $OpenXM: OpenXM/src/ox_math/serv2.c,v 1.6 1999/11/06 21:39:37 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:
1.7     ! ohara      18: #define ERROR_ID_UNKNOWN_SM 10
        !            19: #define ERROR_ID_FAILURE_MLINK         11
1.1       ohara      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 {
1.7     ! ohara      30:     int tag;
        !            31:     int length;
        !            32:     cell head[1];
        !            33:     char *function;
1.4       ohara      34: } mlo_function;
                     35:
                     36:
                     37: mlo *receive_mlo_zz()
                     38: {
1.7     ! ohara      39:     char *s;
        !            40:     mlo  *m;
1.4       ohara      41:
1.7     ! ohara      42:     fprintf(stderr, "--debug: MLO == MLTKINT.\n");
        !            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;
1.4       ohara      48: }
                     49:
                     50: mlo *receive_mlo_string()
                     51: {
1.7     ! ohara      52:     char *s;
        !            53:     mlo  *m;
        !            54:     fprintf(stderr, "--debug: MLO == MLTKSTR.\n");
        !            55:     MLGetString(lp, &s);
        !            56:     fprintf(stderr, "--debug: string = \"%s\".\n", s);
        !            57:     m = (cmo *)new_cmo_string(s);
        !            58:     MLDisownString(lp, s);
        !            59:     return m;
1.4       ohara      60: }
                     61:
1.5       ohara      62: cmo *receive_mlo_function()
                     63: {
1.7     ! ohara      64:     char *s;
        !            65:     cmo *m;
1.5       ohara      66:     cmo  *ob;
                     67:     int  i,n;
                     68:
1.7     ! ohara      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((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((cmo_list *)m, ob);
        !            80:     }
1.5       ohara      81:
1.7     ! ohara      82:     MLDisownString(lp, s);
        !            83:     return m;
1.5       ohara      84: }
                     85:
                     86: cmo *receive_mlo_symbol()
                     87: {
1.7     ! ohara      88:     cmo *ob;
        !            89:     char *s;
1.5       ohara      90:
1.7     ! ohara      91:     fprintf(stderr, "--debug: MLO == MLTKSYM.\n");
        !            92:     MLGetSymbol(lp, &s);
        !            93:     fprintf(stderr, "--debug: Symbol \"%s\".\n", s);
1.5       ohara      94:
1.7     ! ohara      95:     ob = new_cmo_indeterminate(new_cmo_string(s));
1.5       ohara      96:
1.7     ! ohara      97:     MLDisownString(lp, s);
        !            98:     return ob;
1.5       ohara      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
1.7     ! ohara     108:        || (lp = MLOpen(argc, argv)) == NULL) {
        !           109:         fprintf(stderr, "Mathematica Kernel not found.\n");
        !           110:         exit(1);
1.1       ohara     111:     }
1.7     ! 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:
1.7     ! ohara     122: cmo *MATH_get_object()
1.1       ohara     123: {
                    124:     /* skip any packets before the first ReturnPacket */
                    125:     while (MLNextPacket(lp) != RETURNPKT) {
                    126:         usleep(10);
                    127:         MLNewPacket(lp);
                    128:     }
1.7     ! ohara     129:     return receive_mlo();
1.4       ohara     130: }
                    131:
1.5       ohara     132: cmo *receive_mlo()
1.4       ohara     133: {
                    134:     char *s;
1.7     ! ohara     135:     int type;
1.4       ohara     136:
1.5       ohara     137:     switch(type = MLGetNext(lp)) {
1.1       ohara     138:     case MLTKINT:
1.7     ! ohara     139:         return receive_mlo_zz();
1.1       ohara     140:     case MLTKSTR:
1.7     ! ohara     141:         return receive_mlo_string();
1.4       ohara     142:     case MLTKREAL:
1.7     ! ohara     143:         /* double はまだ... */
1.5       ohara     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:
1.7     ! ohara     150:         return receive_mlo_function();
1.1       ohara     151:     case MLTKERR:
1.4       ohara     152:         fprintf(stderr, "--debug: MLO == MLTKERR.\n");
1.7     ! ohara     153:         return (cmo *)make_error_object(ERROR_ID_FAILURE_MLINK, new_cmo_null());
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.7     ! 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: {
1.7     ! ohara     164:     MLPutInteger(lp, ((cmo_int32 *)m)->i);
1.5       ohara     165: }
                    166:
                    167: int send_mlo_string(cmo *m)
                    168: {
1.7     ! ohara     169:     char *s = ((cmo_string *)m)->s;
        !           170:     MLPutString(lp, s);
        !           171:     fprintf(stderr, "ox_math:: put %s.", s);
1.5       ohara     172: }
                    173:
                    174: int send_mlo_zz(cmo *m)
                    175: {
1.7     ! ohara     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);
1.5       ohara     181: }
                    182:
                    183: int send_mlo_list(cmo *c)
                    184: {
1.7     ! ohara     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.7     ! ohara     199:     send_mlo(m);
        !           200:     MLEndPacket(lp);
1.5       ohara     201: }
                    202:
                    203: int send_mlo(cmo *m)
                    204: {
1.1       ohara     205:     char *s;
                    206:     switch(m->tag) {
                    207:     case CMO_INT32:
1.7     ! ohara     208:         send_mlo_int32(m);
1.1       ohara     209:         break;
                    210:     case CMO_STRING:
1.7     ! ohara     211:         send_mlo_string(m);
1.5       ohara     212:         break;
1.7     ! ohara     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.7     ! ohara     257:     symbol *symp;
1.6       ohara     258:
1.1       ohara     259:     if (m->tag == CMO_STRING) {
1.7     ! ohara     260:         fprintf(stderr, "ox_math:: a CMO_STRING(%s) was pushed.\n", ((cmo_string *)m)->s);
1.5       ohara     261:     }else {
1.7     ! ohara     262:         symp = lookup_by_tag(m->tag);
        !           263:         fprintf(stderr, "ox_math:: a %s was pushed.\n", symp->key);
        !           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.7     ! 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
1.7     ! ohara     298:     symbol *symp = lookup_by_tag(m->tag);
        !           299:
1.6       ohara     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:     }
1.7     ! ohara     316:     return ERROR_ID_UNKNOWN_SM;
1.1       ohara     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.7     ! ohara     330:     m = pop();
        !           331:     if (m->tag == CMO_STRING) {
1.6       ohara     332:         send_ox_cmo(fd_write, m);
1.7     ! ohara     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 {
1.7     ! ohara     336:         err = make_error_object(SM_popString, m);
        !           337:         send_ox_cmo(fd_write, err);
        !           338:     }
        !           339:     return 0;
1.6       ohara     340: }
                    341:
                    342: int local_execute(char *s)
                    343: {
1.7     ! ohara     344:     return 0;
1.1       ohara     345: }
                    346:
                    347: /* この関数はサーバに依存する. */
                    348: int sm_executeStringByLocalParser(int fd_write)
                    349: {
1.7     ! ohara     350:     symbol *symp;
1.6       ohara     351:     cmo* m = pop();
1.7     ! ohara     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
1.7     ! ohara     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_get_object());
        !           366:         }
        !           367:         return 0;
1.1       ohara     368:     }
1.6       ohara     369: #ifdef DEBUG
1.7     ! ohara     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:     }
1.6       ohara     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;
1.7     ! ohara     396:     argv = malloc(argc*sizeof(cmo *));
1.1       ohara     397:     for (i=0; i<argc; i++) {
1.6       ohara     398:         argv[i] = pop();
1.1       ohara     399:     }
                    400:     MATH_executeFunction(func, argc, argv);
1.7     ! ohara     401:     push(MATH_get_object());
1.1       ohara     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: {
1.7     ! ohara     411:     push(make_mathcap_object(VERSION, ID_STRING));
1.1       ohara     412:     return 0;
                    413: }
                    414:
                    415: int receive_sm_command(int fd_read)
                    416: {
                    417:     return receive_int32(fd_read);
                    418: }
                    419:
                    420: int execute_sm_command(int fd_write, int code)
                    421: {
                    422:     int err = 0;
                    423:
                    424:     switch(code) {
                    425:     case SM_popCMO:
                    426:         err = sm_popCMO(fd_write);
                    427:         break;
                    428:     case SM_popString:
                    429:         err = sm_popString(fd_write);
                    430:         break;
                    431:     case SM_mathcap:
                    432:         err = sm_mathcap(fd_write);
                    433:         break;
                    434:     case SM_pops:
                    435:         err = sm_pops(fd_write);
                    436:         break;
                    437:     case SM_executeStringByLocalParser:
                    438:         err = sm_executeStringByLocalParser(fd_write);
                    439:         break;
                    440:     case SM_executeFunction:
                    441:         err = sm_executeFunction(fd_write);
                    442:         break;
1.2       ohara     443:     case SM_setMathCap:
1.1       ohara     444:         pop();  /* 無視する */
                    445:         break;
                    446:     default:
                    447:         fprintf(stderr, "unknown command: %d.\n", code);
1.7     ! ohara     448:         err = ERROR_ID_UNKNOWN_SM;
1.1       ohara     449:     }
                    450:
                    451:     if (err != 0) {
1.7     ! ohara     452:         push((cmo *)make_error_object(err, new_cmo_null()));
1.1       ohara     453:     }
                    454: }

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