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