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