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