Annotation of OpenXM/src/ox_math/mlo.c, Revision 1.11
1.4 ohara 1: /* -*- mode: C -*- */
1.11 ! ohara 2: /* $OpenXM: OpenXM/src/ox_math/mlo.c,v 1.10 2003/01/11 12:38:57 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.4 ohara 21: /* If this flag sets then we identify MLTKSYM to CMO_INDETERMINATE. */
1.1 ohara 22: int flag_mlo_symbol = FLAG_MLTKSYM_IS_INDETERMINATE;
23:
1.4 ohara 24: /* MLINK is a indentifier of MathLink connection. */
1.1 ohara 25: MLINK stdlink;
26:
1.11 ! ohara 27: mlo *receive_mlo_real()
! 28: {
! 29: char *s;
! 30: cmo *ob;
! 31: /* Yet we have no implementation of CMO_DOUBLE... */
! 32: MLGetString(stdlink, &s);
! 33: ox_printf("MLTKREAL(%s)", s);
! 34: ob = (cmo *)new_cmo_string(s);
! 35: MLDisownString(stdlink, s);
! 36: return ob;
! 37: }
! 38:
! 39: mlo *receive_mlo_error()
! 40: {
! 41: int errcode = MLError(stdlink);
! 42: char *s = MLErrorMessage(stdlink);
! 43: MLClearError(stdlink);
! 44: ox_printf("MLTKERR(%d,\"%s\")", errcode, s);
! 45: return (cmo *)make_error_object(ERROR_ID_FAILURE_MLINK, new_cmo_string(s));
! 46: }
! 47:
1.1 ohara 48: mlo *receive_mlo_zz()
49: {
50: char *s;
51: mlo *m;
52:
53: MLGetString(stdlink, &s);
1.11 ! ohara 54: ox_printf("MLTKINT(%s)", s);
1.1 ohara 55: m = (mlo *)new_cmo_zz_set_string(s);
56: MLDisownString(stdlink, s);
57: return m;
58: }
59:
60: mlo *receive_mlo_string()
61: {
62: char *s;
63: mlo *m;
64: MLGetString(stdlink, &s);
1.11 ! ohara 65: ox_printf("MLTKSTR(\"%s\")", s);
1.1 ohara 66: m = (cmo *)new_cmo_string(s);
67: MLDisownString(stdlink, s);
68: return m;
69: }
70:
71: cmo *receive_mlo_function()
72: {
73: char *s;
74: cmo *m;
75: cmo *ob;
76: int i,n;
77:
78: MLGetFunction(stdlink, &s, &n);
1.11 ! ohara 79: ox_printf("MLTKFUNC(%s[#%d])", s, n);
1.1 ohara 80: m = new_cmo_list();
1.7 ohara 81: list_append((cmo_list *)m, new_cmo_string(s));
1.1 ohara 82:
83: for (i=0; i<n; i++) {
1.11 ! ohara 84: ox_printf(" arg[%d]: ", i);
1.1 ohara 85: ob = receive_mlo();
1.11 ! ohara 86: ox_printf(", ");
1.7 ohara 87: list_append((cmo_list *)m, ob);
1.1 ohara 88: }
89:
90: MLDisownString(stdlink, s);
91: return m;
92: }
93:
1.3 ohara 94: #if 0
95: cmo *convert_mlo_to_cmo(mlo *m)
96: {
97: if (m->tag == MLO_FUNCTION) {
98: if (strcmp(((mlo_function *)m)->function, "List") == 0) {
99: return convert_mlo_function_list_to_cmo_list(m);
100: }
101: }
102: return m;
103: }
104: #endif
1.8 ohara 105:
106: #define MLO_FUNCTION (CMO_PRIVATE+1)
1.3 ohara 107:
1.1 ohara 108: mlo_function *new_mlo_function(char *function)
109: {
110: mlo_function *c = malloc(sizeof(mlo_function));
111: c->tag = MLO_FUNCTION;
112: c->length = 0;
113: c->head->next = NULL;
114: c->function = function;
115: return c;
116: }
117:
118: cmo *receive_mlo_function_newer()
119: {
120: char *s;
121: mlo_function *m;
122: cmo *ob;
123: int i,n;
124:
125: MLGetFunction(stdlink, &s, &n);
1.11 ! ohara 126: ox_printf("MLTKFUNC(%s[#%d])", s, n);
1.1 ohara 127: m = new_mlo_function(s);
128: for (i=0; i<n; i++) {
1.11 ! ohara 129: ox_printf(" arg[%d]: ", i);
1.1 ohara 130: ob = receive_mlo();
1.11 ! ohara 131: ox_printf(", ");
1.7 ohara 132: list_append((cmo_list *)m, ob);
1.1 ohara 133: }
134:
135: MLDisownString(stdlink, s);
136: return (cmo *)m;
137: }
138:
139: cmo *receive_mlo_symbol()
140: {
141: cmo *ob;
142: char *s;
143:
144: MLGetSymbol(stdlink, &s);
1.11 ! ohara 145: ox_printf("MLTKSYM(%s)", s);
1.1 ohara 146: if(flag_mlo_symbol == FLAG_MLTKSYM_IS_INDETERMINATE) {
147: ob = new_cmo_indeterminate(new_cmo_string(s));
148: }else {
149: ob = new_cmo_string(s);
150: }
151: MLDisownString(stdlink, s);
152: return ob;
153: }
154:
1.4 ohara 155: /* starting a MathLink connection. */
1.1 ohara 156: int ml_init()
157: {
158: int argc = 2;
159: char *argv[] = {"-linkname", "math -mathlink"};
160:
161: if(MLInitialize(NULL) == NULL
162: || (stdlink = MLOpen(argc, argv)) == NULL) {
1.11 ! ohara 163: ox_printf("Mathematica Kernel not found.\n");
1.1 ohara 164: exit(1);
165: }
166: return 0;
167: }
168:
1.4 ohara 169: /* closing a MathLink connection. */
1.1 ohara 170: int ml_exit()
171: {
172: /* quit Mathematica then close the link */
173: MLPutFunction(stdlink, "Exit", 0);
174: MLClose(stdlink);
175: }
176:
1.4 ohara 177: /* Never forget call ml_select() before calling receive_mlo(). */
1.3 ohara 178: int ml_select()
1.1 ohara 179: {
180: /* skip any packets before the first ReturnPacket */
181: while (MLNextPacket(stdlink) != RETURNPKT) {
182: usleep(10);
183: MLNewPacket(stdlink);
184: }
1.3 ohara 185: }
186:
1.4 ohara 187: /* Never forget call ml_flush() after calling send_mlo(). */
1.3 ohara 188: int ml_flush()
189: {
190: MLEndPacket(stdlink);
1.1 ohara 191: }
192:
193: cmo *receive_mlo()
194: {
1.11 ! ohara 195: int type = MLGetNext(stdlink);
1.1 ohara 196:
1.11 ! ohara 197: switch(type) {
1.1 ohara 198: case MLTKINT:
199: return receive_mlo_zz();
200: case MLTKSTR:
201: return receive_mlo_string();
202: case MLTKREAL:
1.11 ! ohara 203: return receive_mlo_real();
1.1 ohara 204: case MLTKSYM:
205: return receive_mlo_symbol();
206: case MLTKFUNC:
207: return receive_mlo_function();
208: case MLTKERR:
1.11 ! ohara 209: ox_printf("MLTKERR()");
1.1 ohara 210: return (cmo *)make_error_object(ERROR_ID_FAILURE_MLINK, new_cmo_null());
211: default:
1.11 ! ohara 212: ox_printf("MLO is broken?(%d)", type);
! 213: return NULL;
1.1 ohara 214: }
215: }
216:
217: int send_mlo_int32(cmo *m)
218: {
219: MLPutInteger(stdlink, ((cmo_int32 *)m)->i);
220: }
221:
222: int send_mlo_string(cmo *m)
223: {
224: char *s = ((cmo_string *)m)->s;
225: MLPutString(stdlink, s);
226: }
227:
228: int send_mlo_zz(cmo *m)
229: {
230: char *s;
231: MLPutFunction(stdlink, "ToExpression", 1);
1.3 ohara 232: s = new_string_set_cmo(m);
1.1 ohara 233: MLPutString(stdlink, s);
234: }
235:
236: int send_mlo_list(cmo *c)
237: {
238: char *s;
1.7 ohara 239: cell *cp = list_first((cmo_list *)c);
240: int len = list_length((cmo_list *)c);
1.1 ohara 241:
242: MLPutFunction(stdlink, "List", len);
1.7 ohara 243: while(!list_endof(c, cp)) {
1.1 ohara 244: send_mlo(cp->cmo);
1.7 ohara 245: cp = list_next(cp);
1.1 ohara 246: }
247: }
248:
249: int send_mlo(cmo *m)
250: {
251: char *s;
252: switch(m->tag) {
253: case CMO_INT32:
254: send_mlo_int32(m);
255: break;
256: case CMO_ZERO:
257: case CMO_NULL:
258: send_mlo_int32(new_cmo_int32(0));
259: break;
260: case CMO_STRING:
261: send_mlo_string(m);
262: break;
263: case CMO_LIST:
264: send_mlo_list(m);
265: break;
266: case CMO_MATHCAP:
267: send_mlo(((cmo_mathcap *)m)->ob);
268: break;
269: case CMO_ZZ:
270: send_mlo_zz(m);
271: break;
272: default:
273: MLPutFunction(stdlink, "ToExpression", 1);
1.3 ohara 274: s = new_string_set_cmo(m);
1.1 ohara 275: MLPutString(stdlink, s);
276: break;
277: }
278: }
279:
280: int ml_evaluateStringByLocalParser(char *str)
281: {
1.11 ! ohara 282: ox_printf("ox_evaluateString(%s)\n", str);
! 283: MLPutFunction(stdlink, "EvaluatePacket", 1);
1.1 ohara 284: MLPutFunction(stdlink, "ToExpression", 1);
285: MLPutString(stdlink, str);
286: MLEndPacket(stdlink);
287: }
288:
289: int ml_executeFunction(char *function, int argc, cmo *argv[])
290: {
291: int i;
1.11 ! ohara 292: MLPutFunction(stdlink, "EvaluatePacket", 1);
1.1 ohara 293: MLPutFunction(stdlink, function, argc);
294: for (i=0; i<argc; i++) {
295: send_mlo(argv[i]);
296: }
297: MLEndPacket(stdlink);
298: }
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