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