Annotation of OpenXM/src/ox_math/mlo.c, Revision 1.13
1.4 ohara 1: /* -*- mode: C -*- */
1.13 ! ohara 2: /* $OpenXM: OpenXM/src/ox_math/mlo.c,v 1.12 2003/01/15 05:08:10 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.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
1.13 ! ohara 205: if (state == STATE_RESERVE_INTERRUPTION) {
1.12 ohara 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