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

1.4       ohara       1: /* -*- mode: C -*- */
1.5     ! ohara       2: /* $OpenXM: OpenXM/src/ox_math/mlo.c,v 1.4 2000/01/05 06:09:11 ohara Exp $ */
        !             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 <gmp.h>
                     17: #include <mathlink.h>
1.2       ohara      18: #include "oxtag.h"
1.1       ohara      19: #include "ox.h"
1.2       ohara      20: #include "mlo.h"
1.1       ohara      21: #include "serv2.h"
                     22:
1.4       ohara      23: /* If this flag sets then we identify MLTKSYM to CMO_INDETERMINATE. */
1.1       ohara      24: int flag_mlo_symbol = FLAG_MLTKSYM_IS_INDETERMINATE;
                     25:
1.4       ohara      26: /* MLINK is a indentifier of MathLink connection. */
1.1       ohara      27: MLINK stdlink;
                     28:
                     29: mlo *receive_mlo_zz()
                     30: {
                     31:     char *s;
                     32:     mlo  *m;
                     33:
                     34:     MLGetString(stdlink, &s);
                     35:     fprintf(stderr, "--debug: MLO == MLTKINT (%s).\n", s);
                     36:     m = (mlo *)new_cmo_zz_set_string(s);
                     37:     MLDisownString(stdlink, s);
                     38:     return m;
                     39: }
                     40:
                     41: mlo *receive_mlo_string()
                     42: {
                     43:     char *s;
                     44:     mlo  *m;
                     45:     MLGetString(stdlink, &s);
                     46:     fprintf(stderr, "--debug: MLO == MLTKSTR (\"%s\").\n", s);
                     47:     m = (cmo *)new_cmo_string(s);
                     48:     MLDisownString(stdlink, s);
                     49:     return m;
                     50: }
                     51:
                     52: cmo *receive_mlo_function()
                     53: {
                     54:     char *s;
                     55:     cmo *m;
                     56:     cmo  *ob;
                     57:     int  i,n;
                     58:
                     59:     MLGetFunction(stdlink, &s, &n);
                     60:     fprintf(stderr, "--debug: MLO == MLTKFUNC (%s[#%d]).\n", s, n);
                     61:     m = new_cmo_list();
                     62:     append_cmo_list((cmo_list *)m, new_cmo_string(s));
                     63:
                     64:     for (i=0; i<n; i++) {
                     65:         fprintf(stderr, "  --debug: arg[%d]\n", i);
                     66:         fflush(stderr);
                     67:         ob = receive_mlo();
                     68:         append_cmo_list((cmo_list *)m, ob);
                     69:     }
                     70:
                     71:     MLDisownString(stdlink, s);
                     72:     return m;
                     73: }
                     74:
1.3       ohara      75: #if 0
                     76: cmo *convert_mlo_to_cmo(mlo *m)
                     77: {
                     78:        if (m->tag == MLO_FUNCTION) {
                     79:                if (strcmp(((mlo_function *)m)->function, "List") == 0) {
                     80:                        return convert_mlo_function_list_to_cmo_list(m);
                     81:                }
                     82:        }
                     83:        return m;
                     84: }
                     85: #endif
                     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();
                    113:         append_cmo_list((cmo_list *)m, ob);
                    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;
                    228:     cell *cp = ((cmo_list *)c)->head;
                    229:     int len = length_cmo_list((cmo_list *)c);
                    230:
                    231:     MLPutFunction(stdlink, "List", len);
                    232:     while(cp->next != NULL) {
                    233:         send_mlo(cp->cmo);
                    234:         cp = cp->next;
                    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>