Annotation of OpenXM/src/ox_math/serv2.c, Revision 1.7
1.1 ohara 1: /* -*- mode: C; coding: euc-japan -*- */
1.7 ! ohara 2: /* $OpenXM: OpenXM/src/ox_math/serv2.c,v 1.6 1999/11/06 21:39:37 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.7 ! ohara 18: #define ERROR_ID_UNKNOWN_SM 10
! 19: #define ERROR_ID_FAILURE_MLINK 11
1.1 ohara 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 {
1.7 ! ohara 30: int tag;
! 31: int length;
! 32: cell head[1];
! 33: char *function;
1.4 ohara 34: } mlo_function;
35:
36:
37: mlo *receive_mlo_zz()
38: {
1.7 ! ohara 39: char *s;
! 40: mlo *m;
1.4 ohara 41:
1.7 ! ohara 42: fprintf(stderr, "--debug: MLO == MLTKINT.\n");
! 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;
1.4 ohara 48: }
49:
50: mlo *receive_mlo_string()
51: {
1.7 ! ohara 52: char *s;
! 53: mlo *m;
! 54: fprintf(stderr, "--debug: MLO == MLTKSTR.\n");
! 55: MLGetString(lp, &s);
! 56: fprintf(stderr, "--debug: string = \"%s\".\n", s);
! 57: m = (cmo *)new_cmo_string(s);
! 58: MLDisownString(lp, s);
! 59: return m;
1.4 ohara 60: }
61:
1.5 ohara 62: cmo *receive_mlo_function()
63: {
1.7 ! ohara 64: char *s;
! 65: cmo *m;
1.5 ohara 66: cmo *ob;
67: int i,n;
68:
1.7 ! ohara 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();
! 73: append_cmo_list((cmo_list *)m, new_cmo_string(s));
! 74:
! 75: for (i=0; i<n; i++) {
! 76: fprintf(stderr, "--debug: arg[%d]\n", i);
! 77: fflush(stderr);
! 78: ob = receive_mlo();
! 79: append_cmo_list((cmo_list *)m, ob);
! 80: }
1.5 ohara 81:
1.7 ! ohara 82: MLDisownString(lp, s);
! 83: return m;
1.5 ohara 84: }
85:
86: cmo *receive_mlo_symbol()
87: {
1.7 ! ohara 88: cmo *ob;
! 89: char *s;
1.5 ohara 90:
1.7 ! ohara 91: fprintf(stderr, "--debug: MLO == MLTKSYM.\n");
! 92: MLGetSymbol(lp, &s);
! 93: fprintf(stderr, "--debug: Symbol \"%s\".\n", s);
1.5 ohara 94:
1.7 ! ohara 95: ob = new_cmo_indeterminate(new_cmo_string(s));
1.5 ohara 96:
1.7 ! ohara 97: MLDisownString(lp, s);
! 98: return ob;
1.5 ohara 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
1.7 ! ohara 108: || (lp = MLOpen(argc, argv)) == NULL) {
! 109: fprintf(stderr, "Mathematica Kernel not found.\n");
! 110: exit(1);
1.1 ohara 111: }
1.7 ! 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:
1.7 ! ohara 122: cmo *MATH_get_object()
1.1 ohara 123: {
124: /* skip any packets before the first ReturnPacket */
125: while (MLNextPacket(lp) != RETURNPKT) {
126: usleep(10);
127: MLNewPacket(lp);
128: }
1.7 ! ohara 129: return receive_mlo();
1.4 ohara 130: }
131:
1.5 ohara 132: cmo *receive_mlo()
1.4 ohara 133: {
134: char *s;
1.7 ! ohara 135: int type;
1.4 ohara 136:
1.5 ohara 137: switch(type = MLGetNext(lp)) {
1.1 ohara 138: case MLTKINT:
1.7 ! ohara 139: return receive_mlo_zz();
1.1 ohara 140: case MLTKSTR:
1.7 ! ohara 141: return receive_mlo_string();
1.4 ohara 142: case MLTKREAL:
1.7 ! ohara 143: /* double はまだ... */
1.5 ohara 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:
1.7 ! ohara 150: return receive_mlo_function();
1.1 ohara 151: case MLTKERR:
1.4 ohara 152: fprintf(stderr, "--debug: MLO == MLTKERR.\n");
1.7 ! ohara 153: return (cmo *)make_error_object(ERROR_ID_FAILURE_MLINK, new_cmo_null());
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.7 ! 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: {
1.7 ! ohara 164: MLPutInteger(lp, ((cmo_int32 *)m)->i);
1.5 ohara 165: }
166:
167: int send_mlo_string(cmo *m)
168: {
1.7 ! ohara 169: char *s = ((cmo_string *)m)->s;
! 170: MLPutString(lp, s);
! 171: fprintf(stderr, "ox_math:: put %s.", s);
1.5 ohara 172: }
173:
174: int send_mlo_zz(cmo *m)
175: {
1.7 ! ohara 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);
1.5 ohara 181: }
182:
183: int send_mlo_list(cmo *c)
184: {
1.7 ! ohara 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.7 ! ohara 199: send_mlo(m);
! 200: MLEndPacket(lp);
1.5 ohara 201: }
202:
203: int send_mlo(cmo *m)
204: {
1.1 ohara 205: char *s;
206: switch(m->tag) {
207: case CMO_INT32:
1.7 ! ohara 208: send_mlo_int32(m);
1.1 ohara 209: break;
210: case CMO_STRING:
1.7 ! ohara 211: send_mlo_string(m);
1.5 ohara 212: break;
1.7 ! ohara 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.7 ! ohara 257: symbol *symp;
1.6 ohara 258:
1.1 ohara 259: if (m->tag == CMO_STRING) {
1.7 ! ohara 260: fprintf(stderr, "ox_math:: a CMO_STRING(%s) was pushed.\n", ((cmo_string *)m)->s);
1.5 ohara 261: }else {
1.7 ! ohara 262: symp = lookup_by_tag(m->tag);
! 263: fprintf(stderr, "ox_math:: a %s was pushed.\n", symp->key);
! 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.7 ! 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
1.7 ! ohara 298: symbol *symp = lookup_by_tag(m->tag);
! 299:
1.6 ohara 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: }
1.7 ! ohara 316: return ERROR_ID_UNKNOWN_SM;
1.1 ohara 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.7 ! ohara 330: m = pop();
! 331: if (m->tag == CMO_STRING) {
1.6 ohara 332: send_ox_cmo(fd_write, m);
1.7 ! ohara 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 {
1.7 ! ohara 336: err = make_error_object(SM_popString, m);
! 337: send_ox_cmo(fd_write, err);
! 338: }
! 339: return 0;
1.6 ohara 340: }
341:
342: int local_execute(char *s)
343: {
1.7 ! ohara 344: return 0;
1.1 ohara 345: }
346:
347: /* この関数はサーバに依存する. */
348: int sm_executeStringByLocalParser(int fd_write)
349: {
1.7 ! ohara 350: symbol *symp;
1.6 ohara 351: cmo* m = pop();
1.7 ! ohara 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
1.7 ! ohara 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_get_object());
! 366: }
! 367: return 0;
1.1 ohara 368: }
1.6 ohara 369: #ifdef DEBUG
1.7 ! ohara 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: }
1.6 ohara 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;
1.7 ! ohara 396: argv = malloc(argc*sizeof(cmo *));
1.1 ohara 397: for (i=0; i<argc; i++) {
1.6 ohara 398: argv[i] = pop();
1.1 ohara 399: }
400: MATH_executeFunction(func, argc, argv);
1.7 ! ohara 401: push(MATH_get_object());
1.1 ohara 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: {
1.7 ! ohara 411: push(make_mathcap_object(VERSION, ID_STRING));
1.1 ohara 412: return 0;
413: }
414:
415: int receive_sm_command(int fd_read)
416: {
417: return receive_int32(fd_read);
418: }
419:
420: int execute_sm_command(int fd_write, int code)
421: {
422: int err = 0;
423:
424: switch(code) {
425: case SM_popCMO:
426: err = sm_popCMO(fd_write);
427: break;
428: case SM_popString:
429: err = sm_popString(fd_write);
430: break;
431: case SM_mathcap:
432: err = sm_mathcap(fd_write);
433: break;
434: case SM_pops:
435: err = sm_pops(fd_write);
436: break;
437: case SM_executeStringByLocalParser:
438: err = sm_executeStringByLocalParser(fd_write);
439: break;
440: case SM_executeFunction:
441: err = sm_executeFunction(fd_write);
442: break;
1.2 ohara 443: case SM_setMathCap:
1.1 ohara 444: pop(); /* 無視する */
445: break;
446: default:
447: fprintf(stderr, "unknown command: %d.\n", code);
1.7 ! ohara 448: err = ERROR_ID_UNKNOWN_SM;
1.1 ohara 449: }
450:
451: if (err != 0) {
1.7 ! ohara 452: push((cmo *)make_error_object(err, new_cmo_null()));
1.1 ohara 453: }
454: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>