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

1.4       ohara       1: /* -*- mode: C -*- */
1.13    ! ohara       2: /* $OpenXM: OpenXM/src/ox_math/mlo.c,v 1.12 2003/01/15 05:08:10 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.12      ohara      21: static int send_mlo_int32(cmo *m);
                     22: static int send_mlo_string(cmo *m);
                     23: static int send_mlo_zz(cmo *m);
                     24: static int send_mlo_list(cmo *c);
                     25:
                     26: static mlo *ml_read_returnpacket();
                     27: static int ml_read_menupacket();
                     28: static int ml_read_textpacket();
                     29: static int ml_clear_interruption();
                     30: static int ml_clear_abortion();
                     31: static mlo *ml_return0();
                     32:
                     33: /* #define STATE_NONE */
                     34: #define STATE_INTERRUPTED         1
                     35: #define STATE_ABORTED             2
1.13    ! ohara      36: #define STATE_RESERVE_INTERRUPTION 4
1.12      ohara      37: #define STATE_RESERVE_ABORTION    8
                     38: #define STATE_IDLE                16
                     39:
                     40: static unsigned state = 0;
                     41:
                     42: static int ml_current_packet = -1;
                     43:
1.4       ohara      44: /* If this flag sets then we identify MLTKSYM to CMO_INDETERMINATE. */
1.1       ohara      45: int flag_mlo_symbol = FLAG_MLTKSYM_IS_INDETERMINATE;
                     46:
1.4       ohara      47: /* MLINK is a indentifier of MathLink connection. */
1.1       ohara      48: MLINK stdlink;
                     49:
1.11      ohara      50: mlo *receive_mlo_real()
                     51: {
                     52:     char *s;
                     53:     cmo *ob;
                     54:     /* Yet we have no implementation of CMO_DOUBLE... */
                     55:     MLGetString(stdlink, &s);
                     56:     ox_printf("MLTKREAL(%s)", s);
                     57:     ob = (cmo *)new_cmo_string(s);
                     58:     MLDisownString(stdlink, s);
                     59:     return ob;
                     60: }
                     61:
                     62: mlo *receive_mlo_error()
                     63: {
                     64:     int errcode = MLError(stdlink);
                     65:     char *s = MLErrorMessage(stdlink);
                     66:     MLClearError(stdlink);
                     67:     ox_printf("MLTKERR(%d,\"%s\")", errcode, s);
1.12      ohara      68:     return (cmo *)make_error_object(errcode, new_cmo_string(s));
1.11      ohara      69: }
                     70:
1.1       ohara      71: mlo *receive_mlo_zz()
                     72: {
                     73:     char *s;
                     74:     mlo  *m;
                     75:
                     76:     MLGetString(stdlink, &s);
1.11      ohara      77:     ox_printf("MLTKINT(%s)", s);
1.1       ohara      78:     m = (mlo *)new_cmo_zz_set_string(s);
                     79:     MLDisownString(stdlink, s);
                     80:     return m;
                     81: }
                     82:
                     83: mlo *receive_mlo_string()
                     84: {
                     85:     char *s;
                     86:     mlo  *m;
                     87:     MLGetString(stdlink, &s);
1.11      ohara      88:     ox_printf("MLTKSTR(\"%s\")", s);
1.1       ohara      89:     m = (cmo *)new_cmo_string(s);
                     90:     MLDisownString(stdlink, s);
                     91:     return m;
                     92: }
                     93:
                     94: cmo *receive_mlo_function()
                     95: {
                     96:     char *s;
                     97:     cmo *m;
                     98:     cmo  *ob;
                     99:     int  i,n;
                    100:
                    101:     MLGetFunction(stdlink, &s, &n);
1.11      ohara     102:     ox_printf("MLTKFUNC(%s[#%d])", s, n);
1.1       ohara     103:     m = new_cmo_list();
1.7       ohara     104:     list_append((cmo_list *)m, new_cmo_string(s));
1.1       ohara     105:
                    106:     for (i=0; i<n; i++) {
1.11      ohara     107:         ox_printf(" arg[%d]: ", i);
1.1       ohara     108:         ob = receive_mlo();
1.11      ohara     109:         ox_printf(", ");
1.7       ohara     110:         list_append((cmo_list *)m, ob);
1.1       ohara     111:     }
                    112:
                    113:     MLDisownString(stdlink, s);
                    114:     return m;
                    115: }
                    116:
1.3       ohara     117: #if 0
                    118: cmo *convert_mlo_to_cmo(mlo *m)
                    119: {
                    120:        if (m->tag == MLO_FUNCTION) {
                    121:                if (strcmp(((mlo_function *)m)->function, "List") == 0) {
                    122:                        return convert_mlo_function_list_to_cmo_list(m);
                    123:                }
                    124:        }
                    125:        return m;
                    126: }
                    127: #endif
1.8       ohara     128:
                    129: #define MLO_FUNCTION   (CMO_PRIVATE+1)
1.3       ohara     130:
1.1       ohara     131: mlo_function *new_mlo_function(char *function)
                    132: {
                    133:     mlo_function *c = malloc(sizeof(mlo_function));
                    134:     c->tag = MLO_FUNCTION;
                    135:     c->length = 0;
                    136:     c->head->next = NULL;
                    137:     c->function = function;
                    138:     return c;
                    139: }
                    140:
                    141: cmo *receive_mlo_function_newer()
                    142: {
                    143:     char *s;
                    144:     mlo_function *m;
                    145:     cmo  *ob;
                    146:     int  i,n;
                    147:
                    148:     MLGetFunction(stdlink, &s, &n);
1.11      ohara     149:     ox_printf("MLTKFUNC(%s[#%d])", s, n);
1.1       ohara     150:     m = new_mlo_function(s);
                    151:     for (i=0; i<n; i++) {
1.11      ohara     152:         ox_printf(" arg[%d]: ", i);
1.1       ohara     153:         ob = receive_mlo();
1.11      ohara     154:         ox_printf(", ");
1.7       ohara     155:         list_append((cmo_list *)m, ob);
1.1       ohara     156:     }
                    157:
                    158:     MLDisownString(stdlink, s);
                    159:     return (cmo *)m;
                    160: }
                    161:
                    162: cmo *receive_mlo_symbol()
                    163: {
                    164:     cmo *ob;
                    165:     char *s;
                    166:
                    167:     MLGetSymbol(stdlink, &s);
1.11      ohara     168:     ox_printf("MLTKSYM(%s)", s);
1.1       ohara     169:     if(flag_mlo_symbol == FLAG_MLTKSYM_IS_INDETERMINATE) {
                    170:         ob = new_cmo_indeterminate(new_cmo_string(s));
                    171:     }else {
                    172:         ob = new_cmo_string(s);
                    173:     }
                    174:     MLDisownString(stdlink, s);
                    175:     return ob;
                    176: }
                    177:
1.4       ohara     178: /* starting a MathLink connection. */
1.1       ohara     179: int ml_init()
                    180: {
                    181:     int argc = 2;
                    182:     char *argv[] = {"-linkname", "math -mathlink"};
                    183:
                    184:     if(MLInitialize(NULL) == NULL
                    185:        || (stdlink = MLOpen(argc, argv)) == NULL) {
1.11      ohara     186:         ox_printf("Mathematica Kernel not found.\n");
1.1       ohara     187:         exit(1);
                    188:     }
                    189:     return 0;
                    190: }
                    191:
1.4       ohara     192: /* closing a MathLink connection. */
1.1       ohara     193: int ml_exit()
                    194: {
                    195:     /* quit Mathematica then close the link */
                    196:     MLPutFunction(stdlink, "Exit", 0);
                    197:     MLClose(stdlink);
                    198: }
                    199:
1.12      ohara     200: /* Remember calling ml_select() before ml_return(). */
1.3       ohara     201: int ml_select()
1.1       ohara     202: {
1.12      ohara     203:     while(!MLReady(stdlink)) {
                    204: #if 0
1.13    ! ohara     205:         if (state == STATE_RESERVE_INTERRUPTION) {
1.12      ohara     206:             ml_interrupt();
                    207:         }else if (state == STATE_RESERVE_ABORTION) {
                    208:             ml_abort();
                    209:         }
                    210: #endif
1.1       ohara     211:         usleep(10);
                    212:     }
1.3       ohara     213: }
                    214:
1.4       ohara     215: /* Never forget call ml_flush() after calling send_mlo(). */
1.3       ohara     216: int ml_flush()
                    217: {
                    218:     MLEndPacket(stdlink);
1.1       ohara     219: }
                    220:
                    221: cmo *receive_mlo()
                    222: {
1.11      ohara     223:     int type = MLGetNext(stdlink);
1.1       ohara     224:
1.11      ohara     225:     switch(type) {
1.1       ohara     226:     case MLTKINT:
1.12      ohara     227:         return (cmo *)receive_mlo_zz();
1.1       ohara     228:     case MLTKSTR:
1.12      ohara     229:         return (cmo *)receive_mlo_string();
1.1       ohara     230:     case MLTKREAL:
1.12      ohara     231:         return (cmo *)receive_mlo_real();
1.1       ohara     232:     case MLTKSYM:
1.12      ohara     233:         return (cmo *)receive_mlo_symbol();
1.1       ohara     234:     case MLTKFUNC:
1.12      ohara     235:         return (cmo *)receive_mlo_function();
1.1       ohara     236:     case MLTKERR:
1.12      ohara     237:         return (cmo *)receive_mlo_error();
1.1       ohara     238:     default:
1.11      ohara     239:         ox_printf("MLO is broken?(%d)", type);
                    240:         return NULL;
1.1       ohara     241:     }
                    242: }
                    243:
1.12      ohara     244: static int send_mlo_int32(cmo *m)
1.1       ohara     245: {
                    246:     MLPutInteger(stdlink, ((cmo_int32 *)m)->i);
                    247: }
                    248:
1.12      ohara     249: static int send_mlo_string(cmo *m)
1.1       ohara     250: {
                    251:     char *s = ((cmo_string *)m)->s;
                    252:     MLPutString(stdlink, s);
                    253: }
                    254:
1.12      ohara     255: static int send_mlo_zz(cmo *m)
1.1       ohara     256: {
                    257:     char *s;
                    258:     MLPutFunction(stdlink, "ToExpression", 1);
1.3       ohara     259:     s = new_string_set_cmo(m);
1.1       ohara     260:     MLPutString(stdlink, s);
                    261: }
                    262:
1.12      ohara     263: static int send_mlo_list(cmo *c)
1.1       ohara     264: {
                    265:     char *s;
1.7       ohara     266:     cell *cp = list_first((cmo_list *)c);
                    267:     int len = list_length((cmo_list *)c);
1.1       ohara     268:
                    269:     MLPutFunction(stdlink, "List", len);
1.7       ohara     270:     while(!list_endof(c, cp)) {
1.1       ohara     271:         send_mlo(cp->cmo);
1.7       ohara     272:         cp = list_next(cp);
1.1       ohara     273:     }
                    274: }
                    275:
                    276: int send_mlo(cmo *m)
                    277: {
                    278:     char *s;
                    279:     switch(m->tag) {
                    280:     case CMO_INT32:
                    281:         send_mlo_int32(m);
                    282:         break;
                    283:     case CMO_ZERO:
                    284:     case CMO_NULL:
                    285:         send_mlo_int32(new_cmo_int32(0));
                    286:         break;
                    287:     case CMO_STRING:
                    288:         send_mlo_string(m);
                    289:         break;
                    290:     case CMO_LIST:
                    291:         send_mlo_list(m);
                    292:         break;
                    293:     case CMO_MATHCAP:
                    294:         send_mlo(((cmo_mathcap *)m)->ob);
                    295:         break;
                    296:     case CMO_ZZ:
                    297:         send_mlo_zz(m);
                    298:         break;
                    299:     default:
                    300:         MLPutFunction(stdlink, "ToExpression", 1);
1.3       ohara     301:         s = new_string_set_cmo(m);
1.1       ohara     302:         MLPutString(stdlink, s);
                    303:         break;
                    304:     }
                    305: }
                    306:
                    307: int ml_evaluateStringByLocalParser(char *str)
                    308: {
1.11      ohara     309:     ox_printf("ox_evaluateString(%s)\n", str);
                    310:     MLPutFunction(stdlink, "EvaluatePacket", 1);
1.1       ohara     311:     MLPutFunction(stdlink, "ToExpression", 1);
                    312:     MLPutString(stdlink, str);
                    313:     MLEndPacket(stdlink);
                    314: }
                    315:
                    316: int ml_executeFunction(char *function, int argc, cmo *argv[])
                    317: {
                    318:     int i;
1.11      ohara     319:     MLPutFunction(stdlink, "EvaluatePacket", 1);
1.1       ohara     320:     MLPutFunction(stdlink, function, argc);
                    321:     for (i=0; i<argc; i++) {
                    322:         send_mlo(argv[i]);
                    323:     }
                    324:     MLEndPacket(stdlink);
1.12      ohara     325: }
                    326:
                    327: int ml_next_packet()
                    328: {
                    329:     if (ml_current_packet < 0) {
                    330:         ml_current_packet = MLNextPacket(stdlink);
                    331:         ox_printf("PKT=%d ", ml_current_packet);
                    332:     }
                    333:     return ml_current_packet;
                    334: }
                    335:
                    336: int ml_new_packet()
                    337: {
                    338:     ml_current_packet = -1;
                    339:     MLNewPacket(stdlink);
                    340: }
                    341:
                    342: /* Remember calling ml_new_packet() after ml_read_packet(). */
                    343: int ml_read_packet()
                    344: {
                    345:     int ob=NULL;
                    346:     int pkt = ml_next_packet();
                    347:     switch(pkt) {
                    348:     case MENUPKT:
                    349:         ml_read_menupacket();
                    350:         break;
                    351:     case TEXTPKT:
                    352:         ml_read_textpacket();
                    353:         break;
                    354:     case RETURNPKT:
                    355:         ml_read_returnpacket();
                    356:         break;
                    357:     case INPUTNAMEPKT:
                    358:         ox_printf("INPUTNAMEPKT[]");
                    359:         break;
                    360:     case ILLEGALPKT:
                    361:         ox_printf("ILLEGALPKT[]");
                    362:         break;
                    363:     case SUSPENDPKT:
                    364:         ox_printf("SUSPENDPKT[]");
                    365:         break;
                    366:     case RESUMEPKT:
                    367:         ox_printf("RESUMEPKT[]");
                    368:         break;
                    369:     default:
                    370:     }
                    371:     ox_printf("\n");
                    372:     return pkt;
                    373: }
                    374:
                    375: static mlo *ml_read_returnpacket()
                    376: {
                    377:     mlo *ob;
                    378:     ox_printf("RETURNPKT[");
                    379:     ob=receive_mlo();
                    380:     ox_printf("]");
                    381:
                    382:     return ob;
                    383: }
                    384:
                    385: static int ml_read_menupacket()
                    386: {
                    387:     ox_printf("MENUPKT[");
                    388:     receive_mlo();
                    389:     ox_printf(", ");
                    390:     receive_mlo();
                    391:     ox_printf("]");
                    392: }
                    393:
                    394: static int ml_read_textpacket()
                    395: {
                    396:     char *s;
                    397:     int n;
                    398:     int type = MLGetNext(stdlink);
                    399:     if (type == MLTKSTR) {
                    400:         MLGetString(stdlink, &s);
                    401:         ox_printf("TEXTPKT[MLTKSTR(%s)]", s);
                    402:         MLDisownString(stdlink, s);
                    403:     }else {
                    404:         ox_printf("TEXTPKT is broken? (%d)", type);
                    405:     }
                    406: }
                    407:
                    408: /* References:
                    409: [1] Todd Gayley: "Re: How to interrupt a running evaluation in MathLink",
                    410: http://forums.wolfram.com/mathgroup/archive/1999/Apr/msg00174.html
                    411:
                    412: From: tgayley@linkobjects.com (Todd Gayley)
                    413: To: mathgroup@smc.vnet.net
                    414: Subject: [mg17015] Re: How to interrupt a running evaluation in MathLink
                    415: */
                    416:
                    417: int ml_interrupt()
                    418: {
                    419:     /* On UNIX, the MLPutMessage(process, MLInterruptMessage)
                    420:        sends ``SIGINT" to the process running on the local machine. */
                    421:     MLPutMessage(stdlink, MLInterruptMessage);
                    422:     state = STATE_INTERRUPTED;
                    423: }
                    424:
                    425: /* Remark:
                    426: read MENUPKT[MLTKINT(1), MLTKSTR("Interrupt> ")]
                    427: write "\n"
                    428: read MENUPKT[MLTKINT(0), MLTKSTR("Interrupt> ")]
                    429: write "a"
                    430: read TEXTPKT[Your options are:
                    431:         abort (or a) to abort current calculation
                    432:         continue (or c) to continue
                    433:         exit (or quit) to exit Mathematica
                    434:         inspect (or i) to enter an interactive dialog
                    435:         show (or s) to show current operation (and then continue)
                    436:         trace (or t) to show all operations
                    437: ]
                    438: */
                    439:
                    440: static int ml_clear_interruption()
                    441: {
                    442:     if (ml_read_packet() == MENUPKT) {
                    443:         MLPutString(stdlink, "\n");
                    444:         ml_new_packet();
                    445:         if(ml_read_packet() == MENUPKT) {
                    446:             MLPutString(stdlink, "a");
                    447:             ml_new_packet();
                    448:             if(ml_read_packet() == TEXTPKT) {
                    449:                 ml_new_packet();
                    450:                 ox_printf("END of ml_clear_interruption()\n");
                    451:                 state = 0;
                    452:                 return 0; /* success */
                    453:             }
                    454:         }
                    455:     }
                    456:     ml_new_packet();
                    457:     ox_printf("Ooops!\n");
                    458:     return -1;
                    459: }
                    460:
                    461: int ml_abort()
                    462: {
                    463:     MLPutMessage(stdlink, MLAbortMessage);
                    464:     state = STATE_ABORTED;
                    465: }
                    466:
                    467: /* broken */
                    468: static int ml_clear_abortion()
                    469: {
                    470:     while(ml_read_packet()==MENUPKT) {
                    471:         ml_new_packet();
                    472:     }
                    473:     MLPutString(stdlink, "a");
                    474:     ml_new_packet();
                    475:     ox_printf("aborted.\n");
                    476:     if (MLError(stdlink)) {
                    477:         ox_printf("MLError=%s\n", MLErrorMessage(stdlink));
                    478:     }
                    479:     receive_mlo();
                    480:     state = 0;
                    481: }
                    482:
                    483: static mlo *ml_return0()
                    484: {
                    485:     mlo *ob;
                    486:     int pkt;
                    487:     /* seeking to RETURNPKT */
                    488:     while((pkt = ml_next_packet()) != RETURNPKT) {
                    489:         if (pkt == ILLEGALPKT) {
                    490:             ob = receive_mlo_error();
                    491:             ml_new_packet(); /* OK? */
                    492:             return ob;
                    493:         }
                    494:         ml_read_packet(); /* debug only */
                    495:         ml_new_packet();
                    496:     }
                    497:     ob = ml_read_returnpacket();
                    498:     ml_new_packet();
                    499:     ox_printf("END of ml_return0()\n");
                    500:     return ob;
                    501: }
                    502:
                    503: #if 0
                    504: mlo *ml_return()
                    505: {
                    506:     int type;
                    507:     mlo *ob;
                    508:     if (state == STATE_INTERRUPTED) {
                    509:         if ((type = ml_next_packet()) == RETURNPKT) {
                    510:             ob = ml_return0();
                    511:             ml_clear_interruption();
                    512:         }else {
                    513:             ob = new_cmo_indeterminate(new_cmo_string("$Aborted"));
                    514:             ml_clear_interruption();
                    515: /*          ob = ml_return0(); /* need to read RETURNPKT[MLTKSYM($Aborted)] */
                    516:         }
                    517:     }else {
                    518:         ob = ml_return0();
                    519:     }
                    520:     return ob;
                    521: }
                    522: #endif
                    523:
                    524: mlo *ml_return()
                    525: {
                    526:     mlo *ob;
                    527:     if (state == STATE_INTERRUPTED) {
                    528:         if (ml_next_packet() == RETURNPKT) {
                    529:             ob = ml_return0();
                    530:         }else {
                    531:             ob = (mlo *)new_cmo_indeterminate(new_cmo_string("$Aborted"));
                    532:         }
                    533:         ml_clear_interruption();
                    534:     }else {
                    535:         ob = ml_return0();
                    536:     }
                    537:     return ob;
1.1       ohara     538: }

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