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