=================================================================== RCS file: /home/cvs/OpenXM/src/ox_math/mlo.c,v retrieving revision 1.2 retrieving revision 1.14 diff -u -p -r1.2 -r1.14 --- OpenXM/src/ox_math/mlo.c 1999/12/09 22:50:56 1.2 +++ OpenXM/src/ox_math/mlo.c 2003/01/17 11:31:10 1.14 @@ -1,38 +1,90 @@ -/* -*- mode: C; coding: euc-japan -*- */ -/* $OpenXM: OpenXM/src/ox_math/mlo.c,v 1.1 1999/11/29 12:09:58 ohara Exp $ */ +/* -*- mode: C -*- */ +/* $OpenXM: OpenXM/src/ox_math/mlo.c,v 1.13 2003/01/15 10:46:09 ohara Exp $ */ -/* Open Mathematica サーバ */ -/* ファイルディスクリプタ 3, 4 は open されていると仮定して動作する. */ +/* + Copyright (C) Katsuyoshi OHARA, 2000. + Portions copyright 1999 Wolfram Research, Inc. -/* MathLink との通信部分 */ + You must see OpenXM/Copyright/Copyright.generic. + The MathLink Library is licensed from Wolfram Research Inc.. + See OpenXM/Copyright/Copyright.mathlink for detail. +*/ #include #include #include -#include #include -#include "oxtag.h" -#include "ox.h" -#include "parse.h" +#include #include "mlo.h" -#include "serv2.h" +#include "sm.h" +static int send_mlo_int32(cmo *m); +static int send_mlo_string(cmo *m); +static int send_mlo_zz(cmo *m); +static int send_mlo_list(cmo *c); + +static mlo *ml_read_returnpacket(); +static int ml_read_menupacket(); +static int ml_read_textpacket(); +static int ml_clear_interruption(); +static int ml_clear_abortion(); +static mlo *ml_return0(); + +/* #define STATE_NONE */ +#define STATE_INTERRUPTED 1 +#define STATE_ABORTED 2 +#define STATE_RESERVE_INTERRUPTION 4 +#define STATE_RESERVE_ABORTION 8 +#define STATE_IDLE 16 + +static unsigned state = 0; + +static int ml_current_packet = -1; + +static double mathkernel_version; + +/* If this flag sets then we identify MLTKSYM to CMO_INDETERMINATE. */ int flag_mlo_symbol = FLAG_MLTKSYM_IS_INDETERMINATE; -/* MLINK はポインタ型. */ +/* MLINK is a indentifier of MathLink connection. */ MLINK stdlink; -typedef cmo mlo; -typedef cmo_string mlo_string; -typedef cmo_zz mlo_zz; +mlo *receive_mlo_real() +{ + char *s; + cmo *ob; +#if 1 + double d; + MLGetReal(stdlink, &d); + ox_printf("MLTKREAL(%lf)", d); + ob = new_cmo_double(d); +#else + /* Yet we have no implementation of CMO_DOUBLE... */ + MLGetString(stdlink, &s); + ox_printf("MLTKREAL(%s)", s); + ob = (cmo *)new_cmo_string(s); + MLDisownString(stdlink, s); +#endif + return ob; +} + +mlo *receive_mlo_error() +{ + int errcode = MLError(stdlink); + char *s = MLErrorMessage(stdlink); + MLClearError(stdlink); + ox_printf("MLTKERR(%d,\"%s\")", errcode, s); + return (cmo *)make_error_object(errcode, new_cmo_string(s)); +} + mlo *receive_mlo_zz() { char *s; mlo *m; MLGetString(stdlink, &s); - fprintf(stderr, "--debug: MLO == MLTKINT (%s).\n", s); + ox_printf("MLTKINT(%s)", s); m = (mlo *)new_cmo_zz_set_string(s); MLDisownString(stdlink, s); return m; @@ -43,7 +95,7 @@ mlo *receive_mlo_string() char *s; mlo *m; MLGetString(stdlink, &s); - fprintf(stderr, "--debug: MLO == MLTKSTR (\"%s\").\n", s); + ox_printf("MLTKSTR(\"%s\")", s); m = (cmo *)new_cmo_string(s); MLDisownString(stdlink, s); return m; @@ -57,21 +109,35 @@ cmo *receive_mlo_function() int i,n; MLGetFunction(stdlink, &s, &n); - fprintf(stderr, "--debug: MLO == MLTKFUNC (%s[#%d]).\n", s, n); + ox_printf("MLTKFUNC(%s[#%d])", s, n); m = new_cmo_list(); - append_cmo_list((cmo_list *)m, new_cmo_string(s)); + list_append((cmo_list *)m, new_cmo_string(s)); for (i=0; itag == MLO_FUNCTION) { + if (strcmp(((mlo_function *)m)->function, "List") == 0) { + return convert_mlo_function_list_to_cmo_list(m); + } + } + return m; +} +#endif + +#define MLO_FUNCTION (CMO_PRIVATE+1) + mlo_function *new_mlo_function(char *function) { mlo_function *c = malloc(sizeof(mlo_function)); @@ -90,15 +156,13 @@ cmo *receive_mlo_function_newer() int i,n; MLGetFunction(stdlink, &s, &n); -#ifdef DEBUG - fprintf(stderr, "--debug: MLO == MLTKFUNC, (%s[#%d])\n", s, n); -#endif + ox_printf("MLTKFUNC(%s[#%d])", s, n); m = new_mlo_function(s); for (i=0; id; + ox_printf("Kernel Version = %lf\n", mathkernel_version); return 0; } +/* closing a MathLink connection. */ int ml_exit() { /* quit Mathematica then close the link */ @@ -144,84 +211,82 @@ int ml_exit() MLClose(stdlink); } -cmo *ml_get_object() +/* Remember calling ml_select() before ml_return(). */ +int ml_select() { - /* skip any packets before the first ReturnPacket */ - while (MLNextPacket(stdlink) != RETURNPKT) { + while(!MLReady(stdlink)) { +#if 0 + if (state == STATE_RESERVE_INTERRUPTION) { + ml_interrupt(); + }else if (state == STATE_RESERVE_ABORTION) { + ml_abort(); + } +#endif usleep(10); - MLNewPacket(stdlink); } - return receive_mlo(); } +/* Never forget call ml_flush() after calling send_mlo(). */ +int ml_flush() +{ + MLEndPacket(stdlink); +} + cmo *receive_mlo() { - char *s; - int type; + int type = MLGetNext(stdlink); - switch(type = MLGetNext(stdlink)) { + switch(type) { case MLTKINT: - return receive_mlo_zz(); + return (cmo *)receive_mlo_zz(); case MLTKSTR: - return receive_mlo_string(); + return (cmo *)receive_mlo_string(); case MLTKREAL: - /* double はまだ... */ - fprintf(stderr, "--debug: MLO == MLTKREAL.\n"); - MLGetString(stdlink, &s); - return (cmo *)new_cmo_string(s); + return (cmo *)receive_mlo_real(); case MLTKSYM: - return receive_mlo_symbol(); + return (cmo *)receive_mlo_symbol(); case MLTKFUNC: - return receive_mlo_function(); + return (cmo *)receive_mlo_function(); case MLTKERR: - fprintf(stderr, "--debug: MLO == MLTKERR.\n"); - return (cmo *)make_error_object(ERROR_ID_FAILURE_MLINK, new_cmo_null()); + return (cmo *)receive_mlo_error(); default: - fprintf(stderr, "--debug: MLO(%d) is unknown.\n", type); - MLGetString(stdlink, &s); - fprintf(stderr, "--debug: \"%s\"\n", s); - return (cmo *)new_cmo_string(s); + ox_printf("MLO is broken?(%d)", type); + return NULL; } } -int send_mlo_int32(cmo *m) +static int send_mlo_int32(cmo *m) { MLPutInteger(stdlink, ((cmo_int32 *)m)->i); } -int send_mlo_string(cmo *m) +static int send_mlo_string(cmo *m) { char *s = ((cmo_string *)m)->s; MLPutString(stdlink, s); } -int send_mlo_zz(cmo *m) +static int send_mlo_zz(cmo *m) { char *s; MLPutFunction(stdlink, "ToExpression", 1); - s = convert_cmo_to_string(m); + s = new_string_set_cmo(m); MLPutString(stdlink, s); } -int send_mlo_list(cmo *c) +static int send_mlo_list(cmo *c) { char *s; - cell *cp = ((cmo_list *)c)->head; - int len = length_cmo_list((cmo_list *)c); + cell *cp = list_first((cmo_list *)c); + int len = list_length((cmo_list *)c); MLPutFunction(stdlink, "List", len); - while(cp->next != NULL) { + while(!list_endof(c, cp)) { send_mlo(cp->cmo); - cp = cp->next; + cp = list_next(cp); } } -int ml_sendObject(cmo *m) -{ - send_mlo(m); - MLEndPacket(stdlink); -} - int send_mlo(cmo *m) { char *s; @@ -247,7 +312,7 @@ int send_mlo(cmo *m) break; default: MLPutFunction(stdlink, "ToExpression", 1); - s = convert_cmo_to_string(m); + s = new_string_set_cmo(m); MLPutString(stdlink, s); break; } @@ -255,6 +320,8 @@ int send_mlo(cmo *m) int ml_evaluateStringByLocalParser(char *str) { + ox_printf("ox_evaluateString(%s)\n", str); + MLPutFunction(stdlink, "EvaluatePacket", 1); MLPutFunction(stdlink, "ToExpression", 1); MLPutString(stdlink, str); MLEndPacket(stdlink); @@ -263,9 +330,223 @@ int ml_evaluateStringByLocalParser(char *str) int ml_executeFunction(char *function, int argc, cmo *argv[]) { int i; + MLPutFunction(stdlink, "EvaluatePacket", 1); MLPutFunction(stdlink, function, argc); for (i=0; i ")] +write "\n" +read MENUPKT[MLTKINT(0), MLTKSTR("Interrupt> ")] +write "a" +read TEXTPKT[Your options are: + abort (or a) to abort current calculation + continue (or c) to continue + exit (or quit) to exit Mathematica + inspect (or i) to enter an interactive dialog + show (or s) to show current operation (and then continue) + trace (or t) to show all operations +] +*/ + +static int ml_clear_interruption() +{ + if (ml_read_packet() == MENUPKT) { + MLPutString(stdlink, "\n"); + ml_new_packet(); + if(ml_read_packet() == MENUPKT) { + MLPutString(stdlink, "a"); + ml_new_packet(); + if(ml_read_packet() == TEXTPKT) { + ml_new_packet(); + ox_printf("END of ml_clear_interruption()\n"); + state = 0; + return 0; /* success */ + } + } + } + ml_new_packet(); + ox_printf("Ooops!\n"); + return -1; +} + +int ml_abort() +{ + MLPutMessage(stdlink, MLAbortMessage); + state = STATE_ABORTED; +} + +/* broken */ +static int ml_clear_abortion() +{ + while(ml_read_packet()==MENUPKT) { + ml_new_packet(); + } + MLPutString(stdlink, "a"); + ml_new_packet(); + ox_printf("aborted.\n"); + if (MLError(stdlink)) { + ox_printf("MLError=%s\n", MLErrorMessage(stdlink)); + } + receive_mlo(); + state = 0; +} + +static mlo *ml_return0() +{ + mlo *ob; + int pkt; + /* seeking to RETURNPKT */ + while((pkt = ml_next_packet()) != RETURNPKT) { + if (pkt == ILLEGALPKT) { + ob = receive_mlo_error(); + ml_new_packet(); /* OK? */ + return ob; + } + ml_read_packet(); /* debug only */ + ml_new_packet(); + } + ob = ml_read_returnpacket(); + ml_new_packet(); + ox_printf("END of ml_return0()\n"); + return ob; +} + +#if 0 +mlo *ml_return() +{ + int type; + mlo *ob; + if (state == STATE_INTERRUPTED) { + if ((type = ml_next_packet()) == RETURNPKT) { + ob = ml_return0(); + ml_clear_interruption(); + }else { + ob = new_cmo_indeterminate(new_cmo_string("$Aborted")); + ml_clear_interruption(); +/* ob = ml_return0(); /* need to read RETURNPKT[MLTKSYM($Aborted)] */ + } + }else { + ob = ml_return0(); + } + return ob; +} +#endif + +mlo *ml_return() +{ + mlo *ob; + if (state == STATE_INTERRUPTED) { + if (ml_next_packet() == RETURNPKT) { + ob = ml_return0(); + }else { + ob = (mlo *)new_cmo_indeterminate(new_cmo_string("$Aborted")); + } + ml_clear_interruption(); + }else { + ob = ml_return0(); + } + return ob; }