Annotation of OpenXM/src/ox_math/mlo.c, Revision 1.14
1.4 ohara 1: /* -*- mode: C -*- */
1.14 ! ohara 2: /* $OpenXM: OpenXM/src/ox_math/mlo.c,v 1.13 2003/01/15 10:46:09 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
1.13 ohara 36: #define STATE_RESERVE_INTERRUPTION 4
1.12 ohara 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.14 ! ohara 44: static double mathkernel_version;
! 45:
1.4 ohara 46: /* If this flag sets then we identify MLTKSYM to CMO_INDETERMINATE. */
1.1 ohara 47: int flag_mlo_symbol = FLAG_MLTKSYM_IS_INDETERMINATE;
48:
1.4 ohara 49: /* MLINK is a indentifier of MathLink connection. */
1.1 ohara 50: MLINK stdlink;
51:
1.11 ohara 52: mlo *receive_mlo_real()
53: {
54: char *s;
55: cmo *ob;
1.14 ! ohara 56:
! 57: #if 1
! 58: double d;
! 59: MLGetReal(stdlink, &d);
! 60: ox_printf("MLTKREAL(%lf)", d);
! 61: ob = new_cmo_double(d);
! 62: #else
1.11 ohara 63: /* Yet we have no implementation of CMO_DOUBLE... */
64: MLGetString(stdlink, &s);
65: ox_printf("MLTKREAL(%s)", s);
66: ob = (cmo *)new_cmo_string(s);
67: MLDisownString(stdlink, s);
1.14 ! ohara 68: #endif
1.11 ohara 69: return ob;
70: }
71:
72: mlo *receive_mlo_error()
73: {
74: int errcode = MLError(stdlink);
75: char *s = MLErrorMessage(stdlink);
76: MLClearError(stdlink);
77: ox_printf("MLTKERR(%d,\"%s\")", errcode, s);
1.12 ohara 78: return (cmo *)make_error_object(errcode, new_cmo_string(s));
1.11 ohara 79: }
80:
1.1 ohara 81: mlo *receive_mlo_zz()
82: {
83: char *s;
84: mlo *m;
85:
86: MLGetString(stdlink, &s);
1.11 ohara 87: ox_printf("MLTKINT(%s)", s);
1.1 ohara 88: m = (mlo *)new_cmo_zz_set_string(s);
89: MLDisownString(stdlink, s);
90: return m;
91: }
92:
93: mlo *receive_mlo_string()
94: {
95: char *s;
96: mlo *m;
97: MLGetString(stdlink, &s);
1.11 ohara 98: ox_printf("MLTKSTR(\"%s\")", s);
1.1 ohara 99: m = (cmo *)new_cmo_string(s);
100: MLDisownString(stdlink, s);
101: return m;
102: }
103:
104: cmo *receive_mlo_function()
105: {
106: char *s;
107: cmo *m;
108: cmo *ob;
109: int i,n;
110:
111: MLGetFunction(stdlink, &s, &n);
1.11 ohara 112: ox_printf("MLTKFUNC(%s[#%d])", s, n);
1.1 ohara 113: m = new_cmo_list();
1.7 ohara 114: list_append((cmo_list *)m, new_cmo_string(s));
1.1 ohara 115:
116: for (i=0; i<n; i++) {
1.11 ohara 117: ox_printf(" arg[%d]: ", i);
1.1 ohara 118: ob = receive_mlo();
1.11 ohara 119: ox_printf(", ");
1.7 ohara 120: list_append((cmo_list *)m, ob);
1.1 ohara 121: }
122:
123: MLDisownString(stdlink, s);
124: return m;
125: }
126:
1.3 ohara 127: #if 0
128: cmo *convert_mlo_to_cmo(mlo *m)
129: {
130: if (m->tag == MLO_FUNCTION) {
131: if (strcmp(((mlo_function *)m)->function, "List") == 0) {
132: return convert_mlo_function_list_to_cmo_list(m);
133: }
134: }
135: return m;
136: }
137: #endif
1.8 ohara 138:
139: #define MLO_FUNCTION (CMO_PRIVATE+1)
1.3 ohara 140:
1.1 ohara 141: mlo_function *new_mlo_function(char *function)
142: {
143: mlo_function *c = malloc(sizeof(mlo_function));
144: c->tag = MLO_FUNCTION;
145: c->length = 0;
146: c->head->next = NULL;
147: c->function = function;
148: return c;
149: }
150:
151: cmo *receive_mlo_function_newer()
152: {
153: char *s;
154: mlo_function *m;
155: cmo *ob;
156: int i,n;
157:
158: MLGetFunction(stdlink, &s, &n);
1.11 ohara 159: ox_printf("MLTKFUNC(%s[#%d])", s, n);
1.1 ohara 160: m = new_mlo_function(s);
161: for (i=0; i<n; i++) {
1.11 ohara 162: ox_printf(" arg[%d]: ", i);
1.1 ohara 163: ob = receive_mlo();
1.11 ohara 164: ox_printf(", ");
1.7 ohara 165: list_append((cmo_list *)m, ob);
1.1 ohara 166: }
167:
168: MLDisownString(stdlink, s);
169: return (cmo *)m;
170: }
171:
172: cmo *receive_mlo_symbol()
173: {
174: cmo *ob;
175: char *s;
176:
177: MLGetSymbol(stdlink, &s);
1.11 ohara 178: ox_printf("MLTKSYM(%s)", s);
1.1 ohara 179: if(flag_mlo_symbol == FLAG_MLTKSYM_IS_INDETERMINATE) {
180: ob = new_cmo_indeterminate(new_cmo_string(s));
181: }else {
182: ob = new_cmo_string(s);
183: }
184: MLDisownString(stdlink, s);
185: return ob;
186: }
187:
1.4 ohara 188: /* starting a MathLink connection. */
1.1 ohara 189: int ml_init()
190: {
191: int argc = 2;
192: char *argv[] = {"-linkname", "math -mathlink"};
193:
194: if(MLInitialize(NULL) == NULL
195: || (stdlink = MLOpen(argc, argv)) == NULL) {
1.11 ohara 196: ox_printf("Mathematica Kernel not found.\n");
1.1 ohara 197: exit(1);
198: }
1.14 ! ohara 199: /* set the version of Mathematica kernel. */
! 200: ml_evaluateStringByLocalParser("$VersionNumber");
! 201: mathkernel_version = ((cmo_double *)ml_return())->d;
! 202: ox_printf("Kernel Version = %lf\n", mathkernel_version);
1.1 ohara 203: return 0;
204: }
205:
1.4 ohara 206: /* closing a MathLink connection. */
1.1 ohara 207: int ml_exit()
208: {
209: /* quit Mathematica then close the link */
210: MLPutFunction(stdlink, "Exit", 0);
211: MLClose(stdlink);
212: }
213:
1.12 ohara 214: /* Remember calling ml_select() before ml_return(). */
1.3 ohara 215: int ml_select()
1.1 ohara 216: {
1.12 ohara 217: while(!MLReady(stdlink)) {
218: #if 0
1.13 ohara 219: if (state == STATE_RESERVE_INTERRUPTION) {
1.12 ohara 220: ml_interrupt();
221: }else if (state == STATE_RESERVE_ABORTION) {
222: ml_abort();
223: }
224: #endif
1.1 ohara 225: usleep(10);
226: }
1.3 ohara 227: }
228:
1.4 ohara 229: /* Never forget call ml_flush() after calling send_mlo(). */
1.3 ohara 230: int ml_flush()
231: {
232: MLEndPacket(stdlink);
1.1 ohara 233: }
234:
235: cmo *receive_mlo()
236: {
1.11 ohara 237: int type = MLGetNext(stdlink);
1.1 ohara 238:
1.11 ohara 239: switch(type) {
1.1 ohara 240: case MLTKINT:
1.12 ohara 241: return (cmo *)receive_mlo_zz();
1.1 ohara 242: case MLTKSTR:
1.12 ohara 243: return (cmo *)receive_mlo_string();
1.1 ohara 244: case MLTKREAL:
1.12 ohara 245: return (cmo *)receive_mlo_real();
1.1 ohara 246: case MLTKSYM:
1.12 ohara 247: return (cmo *)receive_mlo_symbol();
1.1 ohara 248: case MLTKFUNC:
1.12 ohara 249: return (cmo *)receive_mlo_function();
1.1 ohara 250: case MLTKERR:
1.12 ohara 251: return (cmo *)receive_mlo_error();
1.1 ohara 252: default:
1.11 ohara 253: ox_printf("MLO is broken?(%d)", type);
254: return NULL;
1.1 ohara 255: }
256: }
257:
1.12 ohara 258: static int send_mlo_int32(cmo *m)
1.1 ohara 259: {
260: MLPutInteger(stdlink, ((cmo_int32 *)m)->i);
261: }
262:
1.12 ohara 263: static int send_mlo_string(cmo *m)
1.1 ohara 264: {
265: char *s = ((cmo_string *)m)->s;
266: MLPutString(stdlink, s);
267: }
268:
1.12 ohara 269: static int send_mlo_zz(cmo *m)
1.1 ohara 270: {
271: char *s;
272: MLPutFunction(stdlink, "ToExpression", 1);
1.3 ohara 273: s = new_string_set_cmo(m);
1.1 ohara 274: MLPutString(stdlink, s);
275: }
276:
1.12 ohara 277: static int send_mlo_list(cmo *c)
1.1 ohara 278: {
279: char *s;
1.7 ohara 280: cell *cp = list_first((cmo_list *)c);
281: int len = list_length((cmo_list *)c);
1.1 ohara 282:
283: MLPutFunction(stdlink, "List", len);
1.7 ohara 284: while(!list_endof(c, cp)) {
1.1 ohara 285: send_mlo(cp->cmo);
1.7 ohara 286: cp = list_next(cp);
1.1 ohara 287: }
288: }
289:
290: int send_mlo(cmo *m)
291: {
292: char *s;
293: switch(m->tag) {
294: case CMO_INT32:
295: send_mlo_int32(m);
296: break;
297: case CMO_ZERO:
298: case CMO_NULL:
299: send_mlo_int32(new_cmo_int32(0));
300: break;
301: case CMO_STRING:
302: send_mlo_string(m);
303: break;
304: case CMO_LIST:
305: send_mlo_list(m);
306: break;
307: case CMO_MATHCAP:
308: send_mlo(((cmo_mathcap *)m)->ob);
309: break;
310: case CMO_ZZ:
311: send_mlo_zz(m);
312: break;
313: default:
314: MLPutFunction(stdlink, "ToExpression", 1);
1.3 ohara 315: s = new_string_set_cmo(m);
1.1 ohara 316: MLPutString(stdlink, s);
317: break;
318: }
319: }
320:
321: int ml_evaluateStringByLocalParser(char *str)
322: {
1.11 ohara 323: ox_printf("ox_evaluateString(%s)\n", str);
324: MLPutFunction(stdlink, "EvaluatePacket", 1);
1.1 ohara 325: MLPutFunction(stdlink, "ToExpression", 1);
326: MLPutString(stdlink, str);
327: MLEndPacket(stdlink);
328: }
329:
330: int ml_executeFunction(char *function, int argc, cmo *argv[])
331: {
332: int i;
1.11 ohara 333: MLPutFunction(stdlink, "EvaluatePacket", 1);
1.1 ohara 334: MLPutFunction(stdlink, function, argc);
335: for (i=0; i<argc; i++) {
336: send_mlo(argv[i]);
337: }
338: MLEndPacket(stdlink);
1.12 ohara 339: }
340:
341: int ml_next_packet()
342: {
343: if (ml_current_packet < 0) {
344: ml_current_packet = MLNextPacket(stdlink);
345: ox_printf("PKT=%d ", ml_current_packet);
346: }
347: return ml_current_packet;
348: }
349:
350: int ml_new_packet()
351: {
352: ml_current_packet = -1;
353: MLNewPacket(stdlink);
354: }
355:
356: /* Remember calling ml_new_packet() after ml_read_packet(). */
357: int ml_read_packet()
358: {
359: int ob=NULL;
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 n;
412: int type = MLGetNext(stdlink);
413: if (type == MLTKSTR) {
414: MLGetString(stdlink, &s);
415: ox_printf("TEXTPKT[MLTKSTR(%s)]", s);
416: MLDisownString(stdlink, s);
417: }else {
418: ox_printf("TEXTPKT is broken? (%d)", type);
419: }
420: }
421:
422: /* References:
423: [1] Todd Gayley: "Re: How to interrupt a running evaluation in MathLink",
424: http://forums.wolfram.com/mathgroup/archive/1999/Apr/msg00174.html
425:
426: From: tgayley@linkobjects.com (Todd Gayley)
427: To: mathgroup@smc.vnet.net
428: Subject: [mg17015] Re: How to interrupt a running evaluation in MathLink
429: */
430:
431: int ml_interrupt()
432: {
433: /* On UNIX, the MLPutMessage(process, MLInterruptMessage)
434: sends ``SIGINT" to the process running on the local machine. */
435: MLPutMessage(stdlink, MLInterruptMessage);
436: state = STATE_INTERRUPTED;
437: }
438:
439: /* Remark:
440: read MENUPKT[MLTKINT(1), MLTKSTR("Interrupt> ")]
441: write "\n"
442: read MENUPKT[MLTKINT(0), MLTKSTR("Interrupt> ")]
443: write "a"
444: read TEXTPKT[Your options are:
445: abort (or a) to abort current calculation
446: continue (or c) to continue
447: exit (or quit) to exit Mathematica
448: inspect (or i) to enter an interactive dialog
449: show (or s) to show current operation (and then continue)
450: trace (or t) to show all operations
451: ]
452: */
453:
454: static int ml_clear_interruption()
455: {
456: if (ml_read_packet() == MENUPKT) {
457: MLPutString(stdlink, "\n");
458: ml_new_packet();
459: if(ml_read_packet() == MENUPKT) {
460: MLPutString(stdlink, "a");
461: ml_new_packet();
462: if(ml_read_packet() == TEXTPKT) {
463: ml_new_packet();
464: ox_printf("END of ml_clear_interruption()\n");
465: state = 0;
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);
478: state = STATE_ABORTED;
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();
494: state = 0;
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();
513: ox_printf("END of ml_return0()\n");
514: return ob;
515: }
516:
517: #if 0
518: mlo *ml_return()
519: {
520: int type;
521: mlo *ob;
522: if (state == STATE_INTERRUPTED) {
523: if ((type = ml_next_packet()) == RETURNPKT) {
524: ob = ml_return0();
525: ml_clear_interruption();
526: }else {
527: ob = new_cmo_indeterminate(new_cmo_string("$Aborted"));
528: ml_clear_interruption();
529: /* ob = ml_return0(); /* need to read RETURNPKT[MLTKSYM($Aborted)] */
530: }
531: }else {
532: ob = ml_return0();
533: }
534: return ob;
535: }
536: #endif
537:
538: mlo *ml_return()
539: {
540: mlo *ob;
541: if (state == STATE_INTERRUPTED) {
542: if (ml_next_packet() == RETURNPKT) {
543: ob = ml_return0();
544: }else {
545: ob = (mlo *)new_cmo_indeterminate(new_cmo_string("$Aborted"));
546: }
547: ml_clear_interruption();
548: }else {
549: ob = ml_return0();
550: }
551: return ob;
1.1 ohara 552: }
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