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

Annotation of OpenXM/src/ox_math/mlo.c, Revision 1.3

1.1       ohara       1: /* -*- mode: C; coding: euc-japan -*- */
1.3     ! ohara       2: /* $OpenXM: OpenXM/src/ox_math/mlo.c,v 1.2 1999/12/09 22:50:56 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>
1.2       ohara      14: #include "oxtag.h"
1.1       ohara      15: #include "ox.h"
                     16: #include "parse.h"
1.2       ohara      17: #include "mlo.h"
1.1       ohara      18: #include "serv2.h"
                     19:
                     20: int flag_mlo_symbol = FLAG_MLTKSYM_IS_INDETERMINATE;
                     21:
                     22: /* MLINK はポインタ型. */
                     23: MLINK stdlink;
                     24:
                     25: mlo *receive_mlo_zz()
                     26: {
                     27:     char *s;
                     28:     mlo  *m;
                     29:
                     30:     MLGetString(stdlink, &s);
                     31:     fprintf(stderr, "--debug: MLO == MLTKINT (%s).\n", s);
                     32:     m = (mlo *)new_cmo_zz_set_string(s);
                     33:     MLDisownString(stdlink, s);
                     34:     return m;
                     35: }
                     36:
                     37: mlo *receive_mlo_string()
                     38: {
                     39:     char *s;
                     40:     mlo  *m;
                     41:     MLGetString(stdlink, &s);
                     42:     fprintf(stderr, "--debug: MLO == MLTKSTR (\"%s\").\n", s);
                     43:     m = (cmo *)new_cmo_string(s);
                     44:     MLDisownString(stdlink, s);
                     45:     return m;
                     46: }
                     47:
                     48: cmo *receive_mlo_function()
                     49: {
                     50:     char *s;
                     51:     cmo *m;
                     52:     cmo  *ob;
                     53:     int  i,n;
                     54:
                     55:     MLGetFunction(stdlink, &s, &n);
                     56:     fprintf(stderr, "--debug: MLO == MLTKFUNC (%s[#%d]).\n", s, n);
                     57:     m = new_cmo_list();
                     58:     append_cmo_list((cmo_list *)m, new_cmo_string(s));
                     59:
                     60:     for (i=0; i<n; i++) {
                     61:         fprintf(stderr, "  --debug: arg[%d]\n", i);
                     62:         fflush(stderr);
                     63:         ob = receive_mlo();
                     64:         append_cmo_list((cmo_list *)m, ob);
                     65:     }
                     66:
                     67:     MLDisownString(stdlink, s);
                     68:     return m;
                     69: }
                     70:
1.3     ! ohara      71: #if 0
        !            72: cmo *convert_mlo_to_cmo(mlo *m)
        !            73: {
        !            74:        if (m->tag == MLO_FUNCTION) {
        !            75:                if (strcmp(((mlo_function *)m)->function, "List") == 0) {
        !            76:                        return convert_mlo_function_list_to_cmo_list(m);
        !            77:                }
        !            78:        }
        !            79:        return m;
        !            80: }
        !            81: #endif
        !            82:
1.1       ohara      83: mlo_function *new_mlo_function(char *function)
                     84: {
                     85:     mlo_function *c = malloc(sizeof(mlo_function));
                     86:     c->tag = MLO_FUNCTION;
                     87:     c->length = 0;
                     88:     c->head->next = NULL;
                     89:     c->function = function;
                     90:     return c;
                     91: }
                     92:
                     93: cmo *receive_mlo_function_newer()
                     94: {
                     95:     char *s;
                     96:     mlo_function *m;
                     97:     cmo  *ob;
                     98:     int  i,n;
                     99:
                    100:     MLGetFunction(stdlink, &s, &n);
                    101: #ifdef DEBUG
                    102:     fprintf(stderr, "--debug: MLO == MLTKFUNC, (%s[#%d])\n", s, n);
                    103: #endif
                    104:     m = new_mlo_function(s);
                    105:     for (i=0; i<n; i++) {
                    106:         fprintf(stderr, "--debug: arg[%d]\n", i);
                    107:         fflush(stderr);
                    108:         ob = receive_mlo();
                    109:         append_cmo_list((cmo_list *)m, ob);
                    110:     }
                    111:
                    112:     MLDisownString(stdlink, s);
                    113:     return (cmo *)m;
                    114: }
                    115:
                    116: cmo *receive_mlo_symbol()
                    117: {
                    118:     cmo *ob;
                    119:     char *s;
                    120:
                    121:     MLGetSymbol(stdlink, &s);
                    122: #ifdef DEBUG
                    123:     fprintf(stderr, "--debug: MLO == MLTKSYM, (%s).\n", s);
                    124: #endif
                    125:     if(flag_mlo_symbol == FLAG_MLTKSYM_IS_INDETERMINATE) {
                    126:         ob = new_cmo_indeterminate(new_cmo_string(s));
                    127:     }else {
                    128:         ob = new_cmo_string(s);
                    129:     }
                    130:     MLDisownString(stdlink, s);
                    131:     return ob;
                    132: }
                    133:
1.3     ! ohara     134: /* Mathematica との通信を開始する. */
1.1       ohara     135: int ml_init()
                    136: {
                    137:     int argc = 2;
                    138:     char *argv[] = {"-linkname", "math -mathlink"};
                    139:
                    140:     if(MLInitialize(NULL) == NULL
                    141:        || (stdlink = MLOpen(argc, argv)) == NULL) {
                    142:         fprintf(stderr, "Mathematica Kernel not found.\n");
                    143:         exit(1);
                    144:     }
                    145:     return 0;
                    146: }
                    147:
1.3     ! ohara     148: /* Mathematica との通信を終了する. */
1.1       ohara     149: int ml_exit()
                    150: {
                    151:     /* quit Mathematica then close the link */
                    152:     MLPutFunction(stdlink, "Exit", 0);
                    153:     MLClose(stdlink);
                    154: }
                    155:
1.3     ! ohara     156: /* receive_mlo() する前に必ず ml_select() しなければならない */
        !           157: int ml_select()
1.1       ohara     158: {
                    159:     /* skip any packets before the first ReturnPacket */
                    160:     while (MLNextPacket(stdlink) != RETURNPKT) {
                    161:         usleep(10);
                    162:         MLNewPacket(stdlink);
                    163:     }
1.3     ! ohara     164: }
        !           165:
        !           166: /* send_mlo() した後で必ず ml_flush() しなければならない */
        !           167: int ml_flush()
        !           168: {
        !           169:     MLEndPacket(stdlink);
1.1       ohara     170: }
                    171:
                    172: cmo *receive_mlo()
                    173: {
                    174:     char *s;
                    175:     int type;
                    176:
                    177:     switch(type = MLGetNext(stdlink)) {
                    178:     case MLTKINT:
                    179:         return receive_mlo_zz();
                    180:     case MLTKSTR:
                    181:         return receive_mlo_string();
                    182:     case MLTKREAL:
                    183:         /* double はまだ... */
                    184:         fprintf(stderr, "--debug: MLO == MLTKREAL.\n");
                    185:         MLGetString(stdlink, &s);
                    186:         return (cmo *)new_cmo_string(s);
                    187:     case MLTKSYM:
                    188:         return receive_mlo_symbol();
                    189:     case MLTKFUNC:
                    190:         return receive_mlo_function();
                    191:     case MLTKERR:
                    192:         fprintf(stderr, "--debug: MLO == MLTKERR.\n");
                    193:         return (cmo *)make_error_object(ERROR_ID_FAILURE_MLINK, new_cmo_null());
                    194:     default:
                    195:         fprintf(stderr, "--debug: MLO(%d) is unknown.\n", type);
                    196:         MLGetString(stdlink, &s);
                    197:         fprintf(stderr, "--debug: \"%s\"\n", s);
                    198:         return (cmo *)new_cmo_string(s);
                    199:     }
                    200: }
                    201:
                    202: int send_mlo_int32(cmo *m)
                    203: {
                    204:     MLPutInteger(stdlink, ((cmo_int32 *)m)->i);
                    205: }
                    206:
                    207: int send_mlo_string(cmo *m)
                    208: {
                    209:     char *s = ((cmo_string *)m)->s;
                    210:     MLPutString(stdlink, s);
                    211: }
                    212:
                    213: int send_mlo_zz(cmo *m)
                    214: {
                    215:     char *s;
                    216:     MLPutFunction(stdlink, "ToExpression", 1);
1.3     ! ohara     217:     s = new_string_set_cmo(m);
1.1       ohara     218:     MLPutString(stdlink, s);
                    219: }
                    220:
                    221: int send_mlo_list(cmo *c)
                    222: {
                    223:     char *s;
                    224:     cell *cp = ((cmo_list *)c)->head;
                    225:     int len = length_cmo_list((cmo_list *)c);
                    226:
                    227:     MLPutFunction(stdlink, "List", len);
                    228:     while(cp->next != NULL) {
                    229:         send_mlo(cp->cmo);
                    230:         cp = cp->next;
                    231:     }
                    232: }
                    233:
                    234: int send_mlo(cmo *m)
                    235: {
                    236:     char *s;
                    237:     switch(m->tag) {
                    238:     case CMO_INT32:
                    239:         send_mlo_int32(m);
                    240:         break;
                    241:     case CMO_ZERO:
                    242:     case CMO_NULL:
                    243:         send_mlo_int32(new_cmo_int32(0));
                    244:         break;
                    245:     case CMO_STRING:
                    246:         send_mlo_string(m);
                    247:         break;
                    248:     case CMO_LIST:
                    249:         send_mlo_list(m);
                    250:         break;
                    251:     case CMO_MATHCAP:
                    252:         send_mlo(((cmo_mathcap *)m)->ob);
                    253:         break;
                    254:     case CMO_ZZ:
                    255:         send_mlo_zz(m);
                    256:         break;
                    257:     default:
                    258:         MLPutFunction(stdlink, "ToExpression", 1);
1.3     ! ohara     259:         s = new_string_set_cmo(m);
1.1       ohara     260:         MLPutString(stdlink, s);
                    261:         break;
                    262:     }
                    263: }
                    264:
                    265: int ml_evaluateStringByLocalParser(char *str)
                    266: {
                    267:     MLPutFunction(stdlink, "ToExpression", 1);
                    268:     MLPutString(stdlink, str);
                    269:     MLEndPacket(stdlink);
                    270: }
                    271:
                    272: int ml_executeFunction(char *function, int argc, cmo *argv[])
                    273: {
                    274:     int i;
                    275:     MLPutFunction(stdlink, function, argc);
                    276:     for (i=0; i<argc; i++) {
                    277:         send_mlo(argv[i]);
                    278:     }
                    279:     MLEndPacket(stdlink);
                    280: }

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