Annotation of OpenXM/src/ox_math/serv2.c, Revision 1.9
1.1 ohara 1: /* -*- mode: C; coding: euc-japan -*- */
1.9 ! ohara 2: /* $OpenXM: OpenXM/src/ox_math/serv2.c,v 1.8 1999/11/18 21:56:44 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);
1.5 ohara 179: }
180:
181: int send_mlo_zz(cmo *m)
182: {
1.7 ohara 183: char *s;
184: MLPutFunction(lp, "ToExpression", 1);
185: s = convert_cmo_to_string(m);
186: MLPutString(lp, s);
1.5 ohara 187: }
188:
189: int send_mlo_list(cmo *c)
190: {
1.7 ohara 191: char *s;
192: cell *cp = ((cmo_list *)c)->head;
193: int len = length_cmo_list((cmo_list *)c);
194:
195: MLPutFunction(lp, "List", len);
196: while(cp->next != NULL) {
197: send_mlo(cp->cmo);
198: cp = cp->next;
199: }
1.1 ohara 200: }
201:
202: int MATH_sendObject(cmo *m)
203: {
1.7 ohara 204: send_mlo(m);
205: MLEndPacket(lp);
1.5 ohara 206: }
207:
208: int send_mlo(cmo *m)
209: {
1.1 ohara 210: char *s;
211: switch(m->tag) {
212: case CMO_INT32:
1.7 ohara 213: send_mlo_int32(m);
1.1 ohara 214: break;
1.9 ! ohara 215: case CMO_ZERO:
! 216: case CMO_NULL:
! 217: send_mlo_int32(new_cmo_int32(0));
! 218: break;
1.1 ohara 219: case CMO_STRING:
1.7 ohara 220: send_mlo_string(m);
1.5 ohara 221: break;
1.7 ohara 222: case CMO_LIST:
223: send_mlo_list(m);
1.1 ohara 224: break;
1.9 ! ohara 225: case CMO_MATHCAP:
! 226: send_mlo(((cmo_mathcap *)m)->ob);
! 227: break;
! 228: case CMO_ZZ:
! 229: send_mlo_zz(m);
! 230: break;
1.1 ohara 231: default:
232: MLPutFunction(lp, "ToExpression", 1);
1.3 ohara 233: s = convert_cmo_to_string(m);
1.1 ohara 234: MLPutString(lp, s);
235: break;
236: }
237: }
238:
239: int MATH_evaluateStringByLocalParser(char *str)
240: {
241: MLPutFunction(lp, "ToExpression", 1);
242: MLPutString(lp, str);
243: MLEndPacket(lp);
244: }
245:
246: int MATH_executeFunction(char *function, int argc, cmo *argv[])
247: {
248: int i;
249: MLPutFunction(lp, function, argc);
250: for (i=0; i<argc; i++) {
1.5 ohara 251: send_mlo(argv[i]);
1.1 ohara 252: }
253: MLEndPacket(lp);
254: }
255:
256: /* MathLink 非依存部分 */
257:
258: #define SIZE_OPERAND_STACK 2048
259:
260: static cmo* Operand_Stack[SIZE_OPERAND_STACK];
261: static int Stack_Pointer = 0;
262:
263: int initialize_stack()
264: {
265: Stack_Pointer = 0;
266: }
267:
268: int push(cmo* m)
269: {
270: #if DEBUG
1.7 ohara 271: symbol *symp;
1.6 ohara 272:
1.1 ohara 273: if (m->tag == CMO_STRING) {
1.7 ohara 274: fprintf(stderr, "ox_math:: a CMO_STRING(%s) was pushed.\n", ((cmo_string *)m)->s);
1.5 ohara 275: }else {
1.7 ohara 276: symp = lookup_by_tag(m->tag);
277: fprintf(stderr, "ox_math:: a %s was pushed.\n", symp->key);
278: }
1.1 ohara 279: #endif
280: Operand_Stack[Stack_Pointer] = m;
281: Stack_Pointer++;
282: if (Stack_Pointer >= SIZE_OPERAND_STACK) {
283: fprintf(stderr, "stack over flow.\n");
1.7 ohara 284: Stack_Pointer--;
1.1 ohara 285: }
286: }
287:
1.3 ohara 288: /* スタックが空のときは, (CMO_NULL) をかえす. */
1.1 ohara 289: cmo* pop()
290: {
291: if (Stack_Pointer > 0) {
292: Stack_Pointer--;
293: return Operand_Stack[Stack_Pointer];
294: }
1.3 ohara 295: return new_cmo_null();
1.1 ohara 296: }
297:
298: void pops(int n)
299: {
300: Stack_Pointer -= n;
301: if (Stack_Pointer < 0) {
302: Stack_Pointer = 0;
303: }
304: }
305:
306: /* sm_XXX 関数群は、エラーのときは 0 以外の値を返し、呼び出し元で
307: エラーオブジェクトをセットする */
308: int sm_popCMO(int fd_write)
309: {
310: cmo* m = pop();
1.6 ohara 311: #ifdef DEBUG
1.7 ohara 312: symbol *symp = lookup_by_tag(m->tag);
313:
1.6 ohara 314: fprintf(stderr, "ox_math:: opecode = SM_popCMO. (%s)\n", symp->key);
315: #endif
1.1 ohara 316: if (m != NULL) {
317: send_ox_cmo(fd_write, m);
318: return 0;
319: }
320: return SM_popCMO;
321: }
322:
323: int sm_pops(int fd_write)
324: {
325: cmo* m = pop();
326: if (m != NULL && m->tag == CMO_INT32) {
327: pops(((cmo_int32 *)m)->i);
328: return 0;
329: }
1.7 ohara 330: return ERROR_ID_UNKNOWN_SM;
1.1 ohara 331: }
332:
333: /* MathLink 依存部分 */
334: int sm_popString(int fd_write)
335: {
1.6 ohara 336: char *s;
337: cmo *err;
338: cmo *m;
1.1 ohara 339:
340: #ifdef DEBUG
1.5 ohara 341: fprintf(stderr, "ox_math:: opecode = SM_popString.\n");
1.1 ohara 342: #endif
343:
1.7 ohara 344: m = pop();
345: if (m->tag == CMO_STRING) {
1.6 ohara 346: send_ox_cmo(fd_write, m);
1.7 ohara 347: }else if ((s = convert_cmo_to_string(m)) != NULL) {
1.2 ohara 348: send_ox_cmo(fd_write, (cmo *)new_cmo_string(s));
1.6 ohara 349: }else {
1.7 ohara 350: err = make_error_object(SM_popString, m);
351: send_ox_cmo(fd_write, err);
352: }
353: return 0;
1.6 ohara 354: }
355:
356: int local_execute(char *s)
357: {
1.8 ohara 358: if(*s == 'i') {
359: switch(s[1]) {
360: case '+':
361: flag_mlo_symbol = FLAG_MLTKSYM_IS_STRING;
362: break;
363: case '-':
364: case '=':
365: default:
366: flag_mlo_symbol = FLAG_MLTKSYM_IS_INDETERMINATE;
367: }
368: }
1.7 ohara 369: return 0;
1.1 ohara 370: }
371:
372: /* この関数はサーバに依存する. */
373: int sm_executeStringByLocalParser(int fd_write)
374: {
1.7 ohara 375: symbol *symp;
1.6 ohara 376: cmo* m = pop();
1.7 ohara 377: char *s = NULL;
1.1 ohara 378: #ifdef DEBUG
1.5 ohara 379: fprintf(stderr, "ox_math:: opecode = SM_executeStringByLocalParser.\n");
1.1 ohara 380: #endif
1.6 ohara 381:
382: if (m->tag == CMO_STRING
1.7 ohara 383: && strlen(s = ((cmo_string *)m)->s) != 0) {
384: if (s[0] == ':') {
1.8 ohara 385: local_execute(++s);
1.7 ohara 386: }else {
387: /* for mathematica */
388: /* mathematica に文字列を送って評価させる */
389: MATH_evaluateStringByLocalParser(s);
390: push(MATH_get_object());
391: }
392: return 0;
1.1 ohara 393: }
1.6 ohara 394: #ifdef DEBUG
1.7 ohara 395: if ((symp = lookup_by_tag(m->tag)) != NULL) {
396: fprintf(stderr, "ox_math:: error. the top of stack is %s.\n", symp->key);
397: }else {
398: fprintf(stderr, "ox_math:: error. the top of stack is unknown cmo. (%d)\n", m->tag);
399: }
1.6 ohara 400: #endif
1.1 ohara 401: return SM_executeStringByLocalParser;
402: }
403:
404: int sm_executeFunction(int fd_write)
405: {
406: int i, argc;
407: cmo **argv;
408: char* func;
409: cmo* m;
410:
411: if ((m = pop()) == NULL || m->tag != CMO_STRING) {
412: return SM_executeFunction;
413: }
414: func = ((cmo_string *)m)->s;
415:
416: if ((m = pop()) == NULL || m->tag != CMO_INT32) {
417: return SM_executeFunction;
418: }
1.6 ohara 419:
1.1 ohara 420: argc = ((cmo_int32 *)m)->i;
1.7 ohara 421: argv = malloc(argc*sizeof(cmo *));
1.1 ohara 422: for (i=0; i<argc; i++) {
1.6 ohara 423: argv[i] = pop();
1.1 ohara 424: }
425: MATH_executeFunction(func, argc, argv);
1.7 ohara 426: push(MATH_get_object());
1.1 ohara 427: return 0;
428: }
429:
430: /* 平成11年10月13日 */
431: #define VERSION 0x11102700
432: #define ID_STRING "ox_math server 1999/10/28 17:29:25"
433:
434: int sm_mathcap(int fd_write)
435: {
1.7 ohara 436: push(make_mathcap_object(VERSION, ID_STRING));
1.1 ohara 437: return 0;
438: }
439:
440: int receive_sm_command(int fd_read)
441: {
442: return receive_int32(fd_read);
443: }
444:
445: int execute_sm_command(int fd_write, int code)
446: {
447: int err = 0;
1.8 ohara 448: #ifdef DEBUG
449: symbol *sp = lookup_by_tag(code);
450: fprintf(stderr, "ox_math:: %s received.\n", sp->key);
451: #endif
1.1 ohara 452:
453: switch(code) {
454: case SM_popCMO:
455: err = sm_popCMO(fd_write);
456: break;
457: case SM_popString:
458: err = sm_popString(fd_write);
459: break;
460: case SM_mathcap:
461: err = sm_mathcap(fd_write);
462: break;
463: case SM_pops:
464: err = sm_pops(fd_write);
465: break;
466: case SM_executeStringByLocalParser:
467: err = sm_executeStringByLocalParser(fd_write);
468: break;
469: case SM_executeFunction:
470: err = sm_executeFunction(fd_write);
471: break;
1.2 ohara 472: case SM_setMathCap:
1.1 ohara 473: pop(); /* 無視する */
1.8 ohara 474: break;
475: case SM_shutdown:
476: shutdown();
1.1 ohara 477: break;
478: default:
479: fprintf(stderr, "unknown command: %d.\n", code);
1.7 ohara 480: err = ERROR_ID_UNKNOWN_SM;
1.1 ohara 481: }
482:
483: if (err != 0) {
1.7 ohara 484: push((cmo *)make_error_object(err, new_cmo_null()));
1.1 ohara 485: }
486: }
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