Annotation of OpenXM/src/ox_math/mlo.c, Revision 1.5
1.4 ohara 1: /* -*- mode: C -*- */
1.5 ! ohara 2: /* $OpenXM: OpenXM/src/ox_math/mlo.c,v 1.4 2000/01/05 06:09:11 ohara Exp $ */
! 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 <gmp.h>
17: #include <mathlink.h>
1.2 ohara 18: #include "oxtag.h"
1.1 ohara 19: #include "ox.h"
1.2 ohara 20: #include "mlo.h"
1.1 ohara 21: #include "serv2.h"
22:
1.4 ohara 23: /* If this flag sets then we identify MLTKSYM to CMO_INDETERMINATE. */
1.1 ohara 24: int flag_mlo_symbol = FLAG_MLTKSYM_IS_INDETERMINATE;
25:
1.4 ohara 26: /* MLINK is a indentifier of MathLink connection. */
1.1 ohara 27: MLINK stdlink;
28:
29: mlo *receive_mlo_zz()
30: {
31: char *s;
32: mlo *m;
33:
34: MLGetString(stdlink, &s);
35: fprintf(stderr, "--debug: MLO == MLTKINT (%s).\n", s);
36: m = (mlo *)new_cmo_zz_set_string(s);
37: MLDisownString(stdlink, s);
38: return m;
39: }
40:
41: mlo *receive_mlo_string()
42: {
43: char *s;
44: mlo *m;
45: MLGetString(stdlink, &s);
46: fprintf(stderr, "--debug: MLO == MLTKSTR (\"%s\").\n", s);
47: m = (cmo *)new_cmo_string(s);
48: MLDisownString(stdlink, s);
49: return m;
50: }
51:
52: cmo *receive_mlo_function()
53: {
54: char *s;
55: cmo *m;
56: cmo *ob;
57: int i,n;
58:
59: MLGetFunction(stdlink, &s, &n);
60: fprintf(stderr, "--debug: MLO == MLTKFUNC (%s[#%d]).\n", s, n);
61: m = new_cmo_list();
62: append_cmo_list((cmo_list *)m, new_cmo_string(s));
63:
64: for (i=0; i<n; i++) {
65: fprintf(stderr, " --debug: arg[%d]\n", i);
66: fflush(stderr);
67: ob = receive_mlo();
68: append_cmo_list((cmo_list *)m, ob);
69: }
70:
71: MLDisownString(stdlink, s);
72: return m;
73: }
74:
1.3 ohara 75: #if 0
76: cmo *convert_mlo_to_cmo(mlo *m)
77: {
78: if (m->tag == MLO_FUNCTION) {
79: if (strcmp(((mlo_function *)m)->function, "List") == 0) {
80: return convert_mlo_function_list_to_cmo_list(m);
81: }
82: }
83: return m;
84: }
85: #endif
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();
113: append_cmo_list((cmo_list *)m, ob);
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;
228: cell *cp = ((cmo_list *)c)->head;
229: int len = length_cmo_list((cmo_list *)c);
230:
231: MLPutFunction(stdlink, "List", len);
232: while(cp->next != NULL) {
233: send_mlo(cp->cmo);
234: cp = cp->next;
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