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