=================================================================== RCS file: /home/cvs/OpenXM/src/ox_math/mlo.c,v retrieving revision 1.11 retrieving revision 1.12 diff -u -p -r1.11 -r1.12 --- OpenXM/src/ox_math/mlo.c 2003/01/13 12:04:53 1.11 +++ OpenXM/src/ox_math/mlo.c 2003/01/15 05:08:10 1.12 @@ -1,5 +1,5 @@ /* -*- mode: C -*- */ -/* $OpenXM: OpenXM/src/ox_math/mlo.c,v 1.10 2003/01/11 12:38:57 ohara Exp $ */ +/* $OpenXM: OpenXM/src/ox_math/mlo.c,v 1.11 2003/01/13 12:04:53 ohara Exp $ */ /* Copyright (C) Katsuyoshi OHARA, 2000. @@ -18,6 +18,29 @@ #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(); + +/* #define STATE_NONE */ +#define STATE_INTERRUPTED 1 +#define STATE_ABORTED 2 +#define STATE_RESERVE_INTERRUTION 4 +#define STATE_RESERVE_ABORTION 8 +#define STATE_IDLE 16 + +static unsigned state = 0; + +static int ml_current_packet = -1; + /* If this flag sets then we identify MLTKSYM to CMO_INDETERMINATE. */ int flag_mlo_symbol = FLAG_MLTKSYM_IS_INDETERMINATE; @@ -42,7 +65,7 @@ mlo *receive_mlo_error() char *s = MLErrorMessage(stdlink); MLClearError(stdlink); ox_printf("MLTKERR(%d,\"%s\")", errcode, s); - return (cmo *)make_error_object(ERROR_ID_FAILURE_MLINK, new_cmo_string(s)); + return (cmo *)make_error_object(errcode, new_cmo_string(s)); } mlo *receive_mlo_zz() @@ -174,13 +197,18 @@ int ml_exit() MLClose(stdlink); } -/* Never forget call ml_select() before calling receive_mlo(). */ +/* 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_INTERRUTION) { + ml_interrupt(); + }else if (state == STATE_RESERVE_ABORTION) { + ml_abort(); + } +#endif usleep(10); - MLNewPacket(stdlink); } } @@ -196,36 +224,35 @@ cmo *receive_mlo() 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: - return receive_mlo_real(); + 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: - ox_printf("MLTKERR()"); - return (cmo *)make_error_object(ERROR_ID_FAILURE_MLINK, new_cmo_null()); + return (cmo *)receive_mlo_error(); default: 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); @@ -233,7 +260,7 @@ int send_mlo_zz(cmo *m) MLPutString(stdlink, s); } -int send_mlo_list(cmo *c) +static int send_mlo_list(cmo *c) { char *s; cell *cp = list_first((cmo_list *)c); @@ -295,4 +322,217 @@ int ml_executeFunction(char *function, int argc, cmo * send_mlo(argv[i]); } MLEndPacket(stdlink); +} + +int ml_next_packet() +{ + if (ml_current_packet < 0) { + ml_current_packet = MLNextPacket(stdlink); + ox_printf("PKT=%d ", ml_current_packet); + } + return ml_current_packet; +} + +int ml_new_packet() +{ + ml_current_packet = -1; + MLNewPacket(stdlink); +} + +/* Remember calling ml_new_packet() after ml_read_packet(). */ +int ml_read_packet() +{ + int ob=NULL; + int pkt = ml_next_packet(); + switch(pkt) { + case MENUPKT: + ml_read_menupacket(); + break; + case TEXTPKT: + ml_read_textpacket(); + break; + case RETURNPKT: + ml_read_returnpacket(); + break; + case INPUTNAMEPKT: + ox_printf("INPUTNAMEPKT[]"); + break; + case ILLEGALPKT: + ox_printf("ILLEGALPKT[]"); + break; + case SUSPENDPKT: + ox_printf("SUSPENDPKT[]"); + break; + case RESUMEPKT: + ox_printf("RESUMEPKT[]"); + break; + default: + } + ox_printf("\n"); + return pkt; +} + +static mlo *ml_read_returnpacket() +{ + mlo *ob; + ox_printf("RETURNPKT["); + ob=receive_mlo(); + ox_printf("]"); + + return ob; +} + +static int ml_read_menupacket() +{ + ox_printf("MENUPKT["); + receive_mlo(); + ox_printf(", "); + receive_mlo(); + ox_printf("]"); +} + +static int ml_read_textpacket() +{ + char *s; + int n; + int type = MLGetNext(stdlink); + if (type == MLTKSTR) { + MLGetString(stdlink, &s); + ox_printf("TEXTPKT[MLTKSTR(%s)]", s); + MLDisownString(stdlink, s); + }else { + ox_printf("TEXTPKT is broken? (%d)", type); + } +} + +/* References: +[1] Todd Gayley: "Re: How to interrupt a running evaluation in MathLink", +http://forums.wolfram.com/mathgroup/archive/1999/Apr/msg00174.html + +From: tgayley@linkobjects.com (Todd Gayley) +To: mathgroup@smc.vnet.net +Subject: [mg17015] Re: How to interrupt a running evaluation in MathLink +*/ + +int ml_interrupt() +{ + /* On UNIX, the MLPutMessage(process, MLInterruptMessage) + sends ``SIGINT" to the process running on the local machine. */ + MLPutMessage(stdlink, MLInterruptMessage); + state = STATE_INTERRUPTED; +} + +/* Remark: +read MENUPKT[MLTKINT(1), MLTKSTR("Interrupt> ")] +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; }