Annotation of OpenXM/src/ox_math/mlo.c, Revision 1.12
1.4 ohara 1: /* -*- mode: C -*- */
1.12 ! ohara 2: /* $OpenXM: OpenXM/src/ox_math/mlo.c,v 1.11 2003/01/13 12:04:53 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
! 36: #define STATE_RESERVE_INTERRUTION 4
! 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
! 205: if (state == STATE_RESERVE_INTERRUTION) {
! 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>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to mlo.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / ox_math