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

1.4       ohara       1: /* -*- mode: C -*- */
1.9     ! ohara       2: /* $OpenXM: OpenXM/src/ox_math/mlo.c,v 1.8 2000/11/28 20:16:03 ohara Exp $ */
1.5       ohara       3:
                      4: /*
                      5:    Copyright (C) Katsuyoshi OHARA, 2000.
                      6:    Portions copyright 1999 Wolfram Research, Inc.
                      7:
                      8:    You must see OpenXM/Copyright/Copyright.generic.
                      9:    The MathLink Library is licensed from Wolfram Research Inc..
                     10:    See OpenXM/Copyright/Copyright.mathlink for detail.
                     11: */
1.1       ohara      12:
                     13: #include <stdio.h>
                     14: #include <stdlib.h>
                     15: #include <unistd.h>
                     16: #include <mathlink.h>
1.6       ohara      17: #include <ox_toolkit.h>
1.2       ohara      18: #include "mlo.h"
1.9     ! ohara      19: #include "sm.h"
1.1       ohara      20:
1.4       ohara      21: /* If this flag sets then we identify MLTKSYM to CMO_INDETERMINATE. */
1.1       ohara      22: int flag_mlo_symbol = FLAG_MLTKSYM_IS_INDETERMINATE;
                     23:
1.4       ohara      24: /* MLINK is a indentifier of MathLink connection. */
1.1       ohara      25: MLINK stdlink;
                     26:
                     27: mlo *receive_mlo_zz()
                     28: {
                     29:     char *s;
                     30:     mlo  *m;
                     31:
                     32:     MLGetString(stdlink, &s);
                     33:     fprintf(stderr, "--debug: MLO == MLTKINT (%s).\n", s);
                     34:     m = (mlo *)new_cmo_zz_set_string(s);
                     35:     MLDisownString(stdlink, s);
                     36:     return m;
                     37: }
                     38:
                     39: mlo *receive_mlo_string()
                     40: {
                     41:     char *s;
                     42:     mlo  *m;
                     43:     MLGetString(stdlink, &s);
                     44:     fprintf(stderr, "--debug: MLO == MLTKSTR (\"%s\").\n", s);
                     45:     m = (cmo *)new_cmo_string(s);
                     46:     MLDisownString(stdlink, s);
                     47:     return m;
                     48: }
                     49:
                     50: cmo *receive_mlo_function()
                     51: {
                     52:     char *s;
                     53:     cmo *m;
                     54:     cmo  *ob;
                     55:     int  i,n;
                     56:
                     57:     MLGetFunction(stdlink, &s, &n);
                     58:     fprintf(stderr, "--debug: MLO == MLTKFUNC (%s[#%d]).\n", s, n);
                     59:     m = new_cmo_list();
1.7       ohara      60:     list_append((cmo_list *)m, new_cmo_string(s));
1.1       ohara      61:
                     62:     for (i=0; i<n; i++) {
                     63:         fprintf(stderr, "  --debug: arg[%d]\n", i);
                     64:         fflush(stderr);
                     65:         ob = receive_mlo();
1.7       ohara      66:         list_append((cmo_list *)m, ob);
1.1       ohara      67:     }
                     68:
                     69:     MLDisownString(stdlink, s);
                     70:     return m;
                     71: }
                     72:
1.3       ohara      73: #if 0
                     74: cmo *convert_mlo_to_cmo(mlo *m)
                     75: {
                     76:        if (m->tag == MLO_FUNCTION) {
                     77:                if (strcmp(((mlo_function *)m)->function, "List") == 0) {
                     78:                        return convert_mlo_function_list_to_cmo_list(m);
                     79:                }
                     80:        }
                     81:        return m;
                     82: }
                     83: #endif
1.8       ohara      84:
                     85: #define MLO_FUNCTION   (CMO_PRIVATE+1)
1.3       ohara      86:
1.1       ohara      87: mlo_function *new_mlo_function(char *function)
                     88: {
                     89:     mlo_function *c = malloc(sizeof(mlo_function));
                     90:     c->tag = MLO_FUNCTION;
                     91:     c->length = 0;
                     92:     c->head->next = NULL;
                     93:     c->function = function;
                     94:     return c;
                     95: }
                     96:
                     97: cmo *receive_mlo_function_newer()
                     98: {
                     99:     char *s;
                    100:     mlo_function *m;
                    101:     cmo  *ob;
                    102:     int  i,n;
                    103:
                    104:     MLGetFunction(stdlink, &s, &n);
                    105: #ifdef DEBUG
                    106:     fprintf(stderr, "--debug: MLO == MLTKFUNC, (%s[#%d])\n", s, n);
                    107: #endif
                    108:     m = new_mlo_function(s);
                    109:     for (i=0; i<n; i++) {
                    110:         fprintf(stderr, "--debug: arg[%d]\n", i);
                    111:         fflush(stderr);
                    112:         ob = receive_mlo();
1.7       ohara     113:         list_append((cmo_list *)m, ob);
1.1       ohara     114:     }
                    115:
                    116:     MLDisownString(stdlink, s);
                    117:     return (cmo *)m;
                    118: }
                    119:
                    120: cmo *receive_mlo_symbol()
                    121: {
                    122:     cmo *ob;
                    123:     char *s;
                    124:
                    125:     MLGetSymbol(stdlink, &s);
                    126: #ifdef DEBUG
                    127:     fprintf(stderr, "--debug: MLO == MLTKSYM, (%s).\n", s);
                    128: #endif
                    129:     if(flag_mlo_symbol == FLAG_MLTKSYM_IS_INDETERMINATE) {
                    130:         ob = new_cmo_indeterminate(new_cmo_string(s));
                    131:     }else {
                    132:         ob = new_cmo_string(s);
                    133:     }
                    134:     MLDisownString(stdlink, s);
                    135:     return ob;
                    136: }
                    137:
1.4       ohara     138: /* starting a MathLink connection. */
1.1       ohara     139: int ml_init()
                    140: {
                    141:     int argc = 2;
                    142:     char *argv[] = {"-linkname", "math -mathlink"};
                    143:
                    144:     if(MLInitialize(NULL) == NULL
                    145:        || (stdlink = MLOpen(argc, argv)) == NULL) {
                    146:         fprintf(stderr, "Mathematica Kernel not found.\n");
                    147:         exit(1);
                    148:     }
                    149:     return 0;
                    150: }
                    151:
1.4       ohara     152: /* closing a MathLink connection. */
1.1       ohara     153: int ml_exit()
                    154: {
                    155:     /* quit Mathematica then close the link */
                    156:     MLPutFunction(stdlink, "Exit", 0);
                    157:     MLClose(stdlink);
                    158: }
                    159:
1.4       ohara     160: /* Never forget call ml_select() before calling receive_mlo(). */
1.3       ohara     161: int ml_select()
1.1       ohara     162: {
                    163:     /* skip any packets before the first ReturnPacket */
                    164:     while (MLNextPacket(stdlink) != RETURNPKT) {
                    165:         usleep(10);
                    166:         MLNewPacket(stdlink);
                    167:     }
1.3       ohara     168: }
                    169:
1.4       ohara     170: /* Never forget call ml_flush() after calling send_mlo(). */
1.3       ohara     171: int ml_flush()
                    172: {
                    173:     MLEndPacket(stdlink);
1.1       ohara     174: }
                    175:
                    176: cmo *receive_mlo()
                    177: {
                    178:     char *s;
                    179:     int type;
                    180:
                    181:     switch(type = MLGetNext(stdlink)) {
                    182:     case MLTKINT:
                    183:         return receive_mlo_zz();
                    184:     case MLTKSTR:
                    185:         return receive_mlo_string();
                    186:     case MLTKREAL:
1.4       ohara     187:         /* Yet we have no implementation of CMO_DOUBLE... */
1.1       ohara     188:         fprintf(stderr, "--debug: MLO == MLTKREAL.\n");
                    189:         MLGetString(stdlink, &s);
                    190:         return (cmo *)new_cmo_string(s);
                    191:     case MLTKSYM:
                    192:         return receive_mlo_symbol();
                    193:     case MLTKFUNC:
                    194:         return receive_mlo_function();
                    195:     case MLTKERR:
                    196:         fprintf(stderr, "--debug: MLO == MLTKERR.\n");
                    197:         return (cmo *)make_error_object(ERROR_ID_FAILURE_MLINK, new_cmo_null());
                    198:     default:
                    199:         fprintf(stderr, "--debug: MLO(%d) is unknown.\n", type);
                    200:         MLGetString(stdlink, &s);
                    201:         fprintf(stderr, "--debug: \"%s\"\n", s);
                    202:         return (cmo *)new_cmo_string(s);
                    203:     }
                    204: }
                    205:
                    206: int send_mlo_int32(cmo *m)
                    207: {
                    208:     MLPutInteger(stdlink, ((cmo_int32 *)m)->i);
                    209: }
                    210:
                    211: int send_mlo_string(cmo *m)
                    212: {
                    213:     char *s = ((cmo_string *)m)->s;
                    214:     MLPutString(stdlink, s);
                    215: }
                    216:
                    217: int send_mlo_zz(cmo *m)
                    218: {
                    219:     char *s;
                    220:     MLPutFunction(stdlink, "ToExpression", 1);
1.3       ohara     221:     s = new_string_set_cmo(m);
1.1       ohara     222:     MLPutString(stdlink, s);
                    223: }
                    224:
                    225: int send_mlo_list(cmo *c)
                    226: {
                    227:     char *s;
1.7       ohara     228:     cell *cp = list_first((cmo_list *)c);
                    229:     int len = list_length((cmo_list *)c);
1.1       ohara     230:
                    231:     MLPutFunction(stdlink, "List", len);
1.7       ohara     232:     while(!list_endof(c, cp)) {
1.1       ohara     233:         send_mlo(cp->cmo);
1.7       ohara     234:         cp = list_next(cp);
1.1       ohara     235:     }
                    236: }
                    237:
                    238: int send_mlo(cmo *m)
                    239: {
                    240:     char *s;
                    241:     switch(m->tag) {
                    242:     case CMO_INT32:
                    243:         send_mlo_int32(m);
                    244:         break;
                    245:     case CMO_ZERO:
                    246:     case CMO_NULL:
                    247:         send_mlo_int32(new_cmo_int32(0));
                    248:         break;
                    249:     case CMO_STRING:
                    250:         send_mlo_string(m);
                    251:         break;
                    252:     case CMO_LIST:
                    253:         send_mlo_list(m);
                    254:         break;
                    255:     case CMO_MATHCAP:
                    256:         send_mlo(((cmo_mathcap *)m)->ob);
                    257:         break;
                    258:     case CMO_ZZ:
                    259:         send_mlo_zz(m);
                    260:         break;
                    261:     default:
                    262:         MLPutFunction(stdlink, "ToExpression", 1);
1.3       ohara     263:         s = new_string_set_cmo(m);
1.1       ohara     264:         MLPutString(stdlink, s);
                    265:         break;
                    266:     }
                    267: }
                    268:
                    269: int ml_evaluateStringByLocalParser(char *str)
                    270: {
                    271:     MLPutFunction(stdlink, "ToExpression", 1);
                    272:     MLPutString(stdlink, str);
                    273:     MLEndPacket(stdlink);
                    274: }
                    275:
                    276: int ml_executeFunction(char *function, int argc, cmo *argv[])
                    277: {
                    278:     int i;
                    279:     MLPutFunction(stdlink, function, argc);
                    280:     for (i=0; i<argc; i++) {
                    281:         send_mlo(argv[i]);
                    282:     }
                    283:     MLEndPacket(stdlink);
                    284: }

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