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