Annotation of OpenXM/src/ox_math/serv2.c, Revision 1.6
1.1 ohara 1: /* -*- mode: C; coding: euc-japan -*- */
1.6 ! ohara 2: /* $OpenXM: OpenXM/src/ox_math/serv2.c,v 1.5 1999/11/04 19:33:17 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>
14: #include "ox.h"
1.6 ! ohara 15: #include "parse.h"
1.1 ohara 16: #include "serv2.h"
17:
18: #define UNKNOWN_SM_COMMAND 50000
19: #define MATH_ERROR 50001
20:
21: /* MLINK はポインタ型. */
22: MLINK lp = NULL;
23:
1.4 ohara 24: typedef cmo mlo;
25: typedef cmo_string mlo_string;
26: typedef cmo_zz mlo_zz;
27:
28: /* cmo_list の派生クラス*/
29: typedef struct {
30: int tag;
31: int length;
1.5 ohara 32: cell head[1];
1.4 ohara 33: char *function;
34: } mlo_function;
35:
36:
37: mlo *receive_mlo_zz()
38: {
39: char *s;
40: mlo *m;
41:
1.5 ohara 42: fprintf(stderr, "--debug: MLO == MLTKINT.\n");
1.4 ohara 43: MLGetString(lp, &s);
44: fprintf(stderr, "--debug: zz = %s.\n", s);
45: m = (mlo *)new_cmo_zz_set_string(s);
46: MLDisownString(lp, s);
47: return m;
48: }
49:
50: mlo *receive_mlo_string()
51: {
52: char *s;
53: mlo *m;
1.5 ohara 54: fprintf(stderr, "--debug: MLO == MLTKSTR.\n");
1.4 ohara 55: MLGetString(lp, &s);
1.5 ohara 56: fprintf(stderr, "--debug: string = \"%s\".\n", s);
1.4 ohara 57: m = (cmo *)new_cmo_string(s);
58: MLDisownString(lp, s);
59: return m;
60: }
61:
1.5 ohara 62: cmo *receive_mlo_function()
63: {
64: char *s;
65: cmo *m;
66: cmo *ob;
67: int i,n;
68:
69: fprintf(stderr, "--debug: MLO == MLTKFUNC.\n");
70: MLGetFunction(lp, &s, &n);
71: fprintf(stderr, "--debug: Function = \"%s\", # of args = %d\n", s, n);
72: m = new_cmo_list();
1.6 ! ohara 73: append_cmo_list((cmo_list *)m, new_cmo_string(s));
1.5 ohara 74:
75: for (i=0; i<n; i++) {
76: fprintf(stderr, "--debug: arg[%d]\n", i);
77: fflush(stderr);
78: ob = receive_mlo();
1.6 ! ohara 79: append_cmo_list((cmo_list *)m, ob);
1.5 ohara 80: }
81:
82: MLDisownString(lp, s);
83: return m;
84: }
85:
86: cmo *receive_mlo_symbol()
87: {
88: cmo *ob;
89: char *s;
90:
91: fprintf(stderr, "--debug: MLO == MLTKSYM.\n");
92: MLGetSymbol(lp, &s);
93: fprintf(stderr, "--debug: Symbol \"%s\".\n", s);
94:
95: ob = new_cmo_indeterminate(new_cmo_string(s));
96:
97: MLDisownString(lp, s);
98: return ob;
99: }
100:
1.1 ohara 101: /* Mathematica を起動する. */
102: int MATH_init()
103: {
104: int argc = 2;
105: char *argv[] = {"-linkname", "math -mathlink"};
106:
1.5 ohara 107: if(MLInitialize(NULL) == NULL
108: || (lp = MLOpen(argc, argv)) == NULL) {
109: fprintf(stderr, "Mathematica Kernel not found.\n");
110: exit(1);
1.1 ohara 111: }
1.5 ohara 112: return 0;
1.1 ohara 113: }
114:
115: int MATH_exit()
116: {
117: /* quit Mathematica then close the link */
118: MLPutFunction(lp, "Exit", 0);
119: MLClose(lp);
120: }
121:
122: cmo *MATH_getObject2()
123: {
124: /* skip any packets before the first ReturnPacket */
125: while (MLNextPacket(lp) != RETURNPKT) {
126: usleep(10);
127: MLNewPacket(lp);
128: }
1.5 ohara 129: return receive_mlo();
1.4 ohara 130: }
131:
1.5 ohara 132: cmo *receive_mlo()
1.4 ohara 133: {
134: char *s;
135: int type;
136:
1.5 ohara 137: switch(type = MLGetNext(lp)) {
1.1 ohara 138: case MLTKINT:
1.5 ohara 139: return receive_mlo_zz();
1.1 ohara 140: case MLTKSTR:
1.5 ohara 141: return receive_mlo_string();
1.4 ohara 142: case MLTKREAL:
1.5 ohara 143: /* double はまだ... */
144: fprintf(stderr, "--debug: MLO == MLTKREAL.\n");
1.1 ohara 145: MLGetString(lp, &s);
1.6 ! ohara 146: return (cmo *)new_cmo_string(s);
1.5 ohara 147: case MLTKSYM:
148: return receive_mlo_symbol();
149: case MLTKFUNC:
150: return receive_mlo_function();
1.1 ohara 151: case MLTKERR:
1.4 ohara 152: fprintf(stderr, "--debug: MLO == MLTKERR.\n");
1.6 ! ohara 153: return (cmo *)gen_error_object(MATH_ERROR);
1.1 ohara 154: default:
1.5 ohara 155: fprintf(stderr, "--debug: MLO(%d) is unknown.\n", type);
1.1 ohara 156: MLGetString(lp, &s);
1.4 ohara 157: fprintf(stderr, "--debug: \"%s\"\n", s);
1.6 ! ohara 158: return (cmo *)new_cmo_string(s);
1.1 ohara 159: }
1.5 ohara 160: }
161:
162: int send_mlo_int32(cmo *m)
163: {
164: MLPutInteger(lp, ((cmo_int32 *)m)->i);
165: }
166:
167: int send_mlo_string(cmo *m)
168: {
169: char *s = ((cmo_string *)m)->s;
170: MLPutString(lp, s);
171: fprintf(stderr, "ox_math:: put %s.", s);
172: }
173:
174: int send_mlo_zz(cmo *m)
175: {
176: char *s;
177: MLPutFunction(lp, "ToExpression", 1);
178: s = convert_cmo_to_string(m);
179: MLPutString(lp, s);
180: fprintf(stderr, "put %s.", s);
181: }
182:
183: int send_mlo_list(cmo *c)
184: {
185: char *s;
186: cell *cp = ((cmo_list *)c)->head;
187: int len = length_cmo_list((cmo_list *)c);
188:
189: fprintf(stderr, "ox_math:: put List with %d args.\n", len);
190: MLPutFunction(lp, "List", len);
191: while(cp->next != NULL) {
192: send_mlo(cp->cmo);
193: cp = cp->next;
194: }
1.1 ohara 195: }
196:
197: int MATH_sendObject(cmo *m)
198: {
1.5 ohara 199: send_mlo(m);
200: MLEndPacket(lp);
201: }
202:
203: int send_mlo(cmo *m)
204: {
1.1 ohara 205: char *s;
206: switch(m->tag) {
207: case CMO_INT32:
1.5 ohara 208: send_mlo_int32(m);
1.1 ohara 209: break;
210: case CMO_STRING:
1.5 ohara 211: send_mlo_string(m);
212: break;
213: case CMO_LIST:
214: send_mlo_list(m);
1.1 ohara 215: break;
216: default:
217: MLPutFunction(lp, "ToExpression", 1);
1.3 ohara 218: s = convert_cmo_to_string(m);
1.1 ohara 219: MLPutString(lp, s);
220: fprintf(stderr, "put %s.", s);
221: break;
222: }
223: }
224:
225: int MATH_evaluateStringByLocalParser(char *str)
226: {
227: MLPutFunction(lp, "ToExpression", 1);
228: MLPutString(lp, str);
229: MLEndPacket(lp);
230: }
231:
232: int MATH_executeFunction(char *function, int argc, cmo *argv[])
233: {
234: int i;
235: MLPutFunction(lp, function, argc);
236: for (i=0; i<argc; i++) {
1.5 ohara 237: send_mlo(argv[i]);
1.1 ohara 238: }
239: MLEndPacket(lp);
240: }
241:
242: /* MathLink 非依存部分 */
243:
244: #define SIZE_OPERAND_STACK 2048
245:
246: static cmo* Operand_Stack[SIZE_OPERAND_STACK];
247: static int Stack_Pointer = 0;
248:
249: int initialize_stack()
250: {
251: Stack_Pointer = 0;
252: }
253:
254: int push(cmo* m)
255: {
256: #if DEBUG
1.6 ! ohara 257: symbol *symp;
! 258:
1.1 ohara 259: if (m->tag == CMO_STRING) {
1.5 ohara 260: fprintf(stderr, "ox_math:: a cmo_string(%s) was pushed.\n", ((cmo_string *)m)->s);
261: }else {
1.6 ! ohara 262: symp = lookup_by_tag(m->tag);
! 263: fprintf(stderr, "ox_math:: a %s was pushed.\n", symp->key);
1.5 ohara 264: }
1.1 ohara 265: #endif
266: Operand_Stack[Stack_Pointer] = m;
267: Stack_Pointer++;
268: if (Stack_Pointer >= SIZE_OPERAND_STACK) {
269: fprintf(stderr, "stack over flow.\n");
1.6 ! ohara 270: Stack_Pointer--;
1.1 ohara 271: }
272: }
273:
1.3 ohara 274: /* スタックが空のときは, (CMO_NULL) をかえす. */
1.1 ohara 275: cmo* pop()
276: {
277: if (Stack_Pointer > 0) {
278: Stack_Pointer--;
279: return Operand_Stack[Stack_Pointer];
280: }
1.3 ohara 281: return new_cmo_null();
1.1 ohara 282: }
283:
284: void pops(int n)
285: {
286: Stack_Pointer -= n;
287: if (Stack_Pointer < 0) {
288: Stack_Pointer = 0;
289: }
290: }
291:
292: /* sm_XXX 関数群は、エラーのときは 0 以外の値を返し、呼び出し元で
293: エラーオブジェクトをセットする */
294: int sm_popCMO(int fd_write)
295: {
296: cmo* m = pop();
1.6 ! ohara 297: #ifdef DEBUG
! 298: symbol *symp = lookup_by_tag(m->tag);
! 299:
! 300: fprintf(stderr, "ox_math:: opecode = SM_popCMO. (%s)\n", symp->key);
! 301: #endif
1.1 ohara 302: if (m != NULL) {
303: send_ox_cmo(fd_write, m);
304: return 0;
305: }
306: return SM_popCMO;
307: }
308:
309: int sm_pops(int fd_write)
310: {
311: cmo* m = pop();
312: if (m != NULL && m->tag == CMO_INT32) {
313: pops(((cmo_int32 *)m)->i);
314: return 0;
315: }
316: return UNKNOWN_SM_COMMAND;
317: }
318:
319: /* MathLink 依存部分 */
320: int sm_popString(int fd_write)
321: {
1.6 ! ohara 322: char *s;
! 323: cmo *err;
! 324: cmo *m;
1.1 ohara 325:
326: #ifdef DEBUG
1.5 ohara 327: fprintf(stderr, "ox_math:: opecode = SM_popString.\n");
1.1 ohara 328: #endif
329:
1.6 ! ohara 330: m = pop();
! 331: if (m->tag == CMO_STRING) {
! 332: send_ox_cmo(fd_write, m);
! 333: }else if ((s = convert_cmo_to_string(m)) != NULL) {
1.2 ohara 334: send_ox_cmo(fd_write, (cmo *)new_cmo_string(s));
1.6 ! ohara 335: }else {
! 336: err = new_cmo_error2(m);
! 337: send_ox_cmo(fd_write, err);
! 338: }
! 339: return 0;
! 340: }
! 341:
! 342: int local_execute(char *s)
! 343: {
! 344: return 0;
1.1 ohara 345: }
346:
347: /* この関数はサーバに依存する. */
348: int sm_executeStringByLocalParser(int fd_write)
349: {
1.6 ! ohara 350: symbol *symp;
! 351: cmo* m = pop();
! 352: char *s = NULL;
1.1 ohara 353: #ifdef DEBUG
1.5 ohara 354: fprintf(stderr, "ox_math:: opecode = SM_executeStringByLocalParser.\n");
1.1 ohara 355: #endif
1.6 ! ohara 356:
! 357: if (m->tag == CMO_STRING
! 358: && strlen(s = ((cmo_string *)m)->s) != 0) {
! 359: if (s[0] == ':') {
! 360: local_execute(s);
! 361: }else {
! 362: /* for mathematica */
! 363: /* mathematica に文字列を送って評価させる */
! 364: MATH_evaluateStringByLocalParser(s);
! 365: push(MATH_getObject2());
! 366: }
! 367: return 0;
1.1 ohara 368: }
1.6 ! ohara 369: #ifdef DEBUG
! 370: if ((symp = lookup_by_tag(m->tag)) != NULL) {
! 371: fprintf(stderr, "ox_math:: error. the top of stack is %s.\n", symp->key);
! 372: }else {
! 373: fprintf(stderr, "ox_math:: error. the top of stack is unknown cmo. (%d)\n", m->tag);
! 374: }
! 375: #endif
1.1 ohara 376: return SM_executeStringByLocalParser;
377: }
378:
379: int sm_executeFunction(int fd_write)
380: {
381: int i, argc;
382: cmo **argv;
383: char* func;
384: cmo* m;
385:
386: if ((m = pop()) == NULL || m->tag != CMO_STRING) {
387: return SM_executeFunction;
388: }
389: func = ((cmo_string *)m)->s;
390:
391: if ((m = pop()) == NULL || m->tag != CMO_INT32) {
392: return SM_executeFunction;
393: }
1.6 ! ohara 394:
1.1 ohara 395: argc = ((cmo_int32 *)m)->i;
396: argv = malloc(sizeof(cmo *)*argc);
397: for (i=0; i<argc; i++) {
1.6 ! ohara 398: argv[i] = pop();
1.1 ohara 399: }
400: MATH_executeFunction(func, argc, argv);
401: push(MATH_getObject2());
402: return 0;
403: }
404:
405: /* 平成11年10月13日 */
406: #define VERSION 0x11102700
407: #define ID_STRING "ox_math server 1999/10/28 17:29:25"
408:
409: int sm_mathcap(int fd_write)
410: {
411: cmo* c = make_mathcap_object(VERSION, ID_STRING);
412: push(c);
413: return 0;
414: }
415:
416: int receive_sm_command(int fd_read)
417: {
418: return receive_int32(fd_read);
419: }
420:
421: int execute_sm_command(int fd_write, int code)
422: {
423: int err = 0;
424:
425: switch(code) {
426: case SM_popCMO:
427: err = sm_popCMO(fd_write);
428: break;
429: case SM_popString:
430: err = sm_popString(fd_write);
431: break;
432: case SM_mathcap:
433: err = sm_mathcap(fd_write);
434: break;
435: case SM_pops:
436: err = sm_pops(fd_write);
437: break;
438: case SM_executeStringByLocalParser:
439: err = sm_executeStringByLocalParser(fd_write);
440: break;
441: case SM_executeFunction:
442: err = sm_executeFunction(fd_write);
443: break;
1.2 ohara 444: case SM_setMathCap:
1.1 ohara 445: pop(); /* 無視する */
446: break;
447: default:
448: fprintf(stderr, "unknown command: %d.\n", code);
449: err = UNKNOWN_SM_COMMAND;
450: }
451:
452: if (err != 0) {
1.2 ohara 453: push((cmo *)gen_error_object(err));
1.1 ohara 454: }
455: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>