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