=================================================================== RCS file: /home/cvs/OpenXM/src/ox_math/mlo.c,v retrieving revision 1.1 retrieving revision 1.17 diff -u -p -r1.1 -r1.17 --- OpenXM/src/ox_math/mlo.c 1999/11/29 12:09:58 1.1 +++ OpenXM/src/ox_math/mlo.c 2003/03/18 05:20:06 1.17 @@ -1,36 +1,93 @@ -/* -*- mode: C; coding: euc-japan -*- */ -/* $OpenXM$ */ +/* -*- mode: C -*- */ +/* $OpenXM: OpenXM/src/ox_math/mlo.c,v 1.16 2003/03/16 16:58:48 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 "ox.h" -#include "parse.h" -#include "serv2.h" +#include +#include "mlo.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(); + +static int ml_current_packet = -1; + +static double mathkernel_version; +static char *mathkernel_versionstring = NULL; + +/* 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; +static unsigned flag_ml_state = 0; +/* state management for the OpenXM robust interruption */ +unsigned ml_state_set(unsigned fl) +{ + return flag_ml_state |= fl; +} + +unsigned ml_state_clear(unsigned fl) +{ + return flag_ml_state &= ~fl; +} + +unsigned ml_state(unsigned fl) +{ + return (flag_ml_state & fl); +} + +void ml_state_clear_all() +{ + flag_ml_state = 0; +} + +mlo *receive_mlo_real() +{ + double d; + MLGetReal(stdlink, &d); + ox_printf("%lf", d); + return new_cmo_double(d); +} + +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("%s", s); m = (mlo *)new_cmo_zz_set_string(s); MLDisownString(stdlink, s); return m; @@ -41,7 +98,7 @@ mlo *receive_mlo_string() char *s; mlo *m; MLGetString(stdlink, &s); - fprintf(stderr, "--debug: MLO == MLTKSTR (\"%s\").\n", s); + ox_printf("\"%s\"", s); m = (cmo *)new_cmo_string(s); MLDisownString(stdlink, s); return m; @@ -55,21 +112,34 @@ cmo *receive_mlo_function() int i,n; MLGetFunction(stdlink, &s, &n); - fprintf(stderr, "--debug: MLO == MLTKFUNC (%s[#%d]).\n", s, n); - m = new_cmo_list(); - append_cmo_list((cmo_list *)m, new_cmo_string(s)); + ox_printf("%s#%d[", s, n); + m = (cmo *)new_cmo_list(); + 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)); @@ -88,16 +158,14 @@ 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("%s#%d[", s, n); m = new_mlo_function(s); for (i=0; id; + ml_evaluateStringByLocalParser("$Version"); + mathkernel_versionstring = ((cmo_string *)ml_return())->s; + ox_printf("Mathematica %lf <%s>\n", + mathkernel_version, mathkernel_versionstring); return 0; } +/* closing a MathLink connection. */ int ml_exit() { /* quit Mathematica then close the link */ @@ -142,87 +216,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) { + int i=0; + MLFlush(stdlink); + while(!MLReady(stdlink)) { + if (i==0 && ml_state(RESERVE_INTERRUPTION)) { + ml_interrupt(); + i++; + } 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("broken MLO\(%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; switch(m->tag) { case CMO_INT32: send_mlo_int32(m); @@ -245,14 +314,15 @@ int send_mlo(cmo *m) break; default: MLPutFunction(stdlink, "ToExpression", 1); - s = convert_cmo_to_string(m); - MLPutString(stdlink, s); + MLPutString(stdlink, new_string_set_cmo(m)); break; } } 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); @@ -261,9 +331,204 @@ 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"); + ox_printf("MLPutString(\"\\n\");\n"); + ml_new_packet(); + if(ml_read_packet() == MENUPKT) { + MLPutString(stdlink, "a"); + ox_printf("MLPutString(\"a\");\n"); + ml_new_packet(); + if(ml_read_packet() == TEXTPKT) { + ml_new_packet(); + ox_printf("\n---END of ml_clear_interruption()---\n"); + return 0; /* success */ + } + } + } + ml_new_packet(); + ox_printf("Ooops!\n"); + return -1; +} + +int ml_abort() +{ + MLPutMessage(stdlink, MLAbortMessage); + ml_state_set(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(); + ml_state_clear_all(); +} + +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("\n---END of ml_return0()---\n"); + return ob; +} + +mlo *ml_return() +{ + mlo *ob; + if (ml_state(INTERRUPTED)) { + if (ml_next_packet() == RETURNPKT) { + /* a computation has done before the interruption */ + ob = ml_return0(); + ml_clear_interruption(); + }else { + ml_clear_interruption(); + MLFlush(stdlink); /* need for 4.x */ + ob = ml_return0(); /* ReturnPacket[$Aborted] */ + } + }else { + ob = ml_return0(); + } + return ob; }