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