=================================================================== RCS file: /home/cvs/OpenXM/src/ox_math/Attic/serv2.c,v retrieving revision 1.7 retrieving revision 1.16 diff -u -p -r1.7 -r1.16 --- OpenXM/src/ox_math/Attic/serv2.c 1999/11/07 12:12:56 1.7 +++ OpenXM/src/ox_math/Attic/serv2.c 2000/10/10 19:58:30 1.16 @@ -1,312 +1,112 @@ /* -*- mode: C; coding: euc-japan -*- */ -/* $OpenXM: OpenXM/src/ox_math/serv2.c,v 1.6 1999/11/06 21:39:37 ohara Exp $ */ +/* $OpenXM: OpenXM/src/ox_math/serv2.c,v 1.15 2000/03/10 12:45:48 ohara Exp $ */ -/* Open Mathematica サーバ */ -/* ファイルディスクリプタ 3, 4 は open されていると仮定して動作する. */ +/* + Copyright (C) Katsuyoshi OHARA, 2000. + Portions copyright 1999 Wolfram Research, Inc. -/* MathLink との通信部分 */ + You must see OpenXM/Copyright/Copyright.generic. + The MathLink Library is licensed from Wolfram Research Inc.. + See OpenXM/Copyright/Copyright.mathlink for detail. +*/ +/* + Remarks: + file descripter 3 and 4 are already opened by the parent process. +*/ + #include #include #include #include #include -#include "ox.h" -#include "parse.h" +#include #include "serv2.h" -#define ERROR_ID_UNKNOWN_SM 10 -#define ERROR_ID_FAILURE_MLINK 11 +extern int flag_mlo_symbol; -/* MLINK はポインタ型. */ -MLINK lp = NULL; +/* MathLink independent */ +#define INIT_S_SIZE 2048 +#define EXT_S_SIZE 2048 -typedef cmo mlo; -typedef cmo_string mlo_string; -typedef cmo_zz mlo_zz; +static int stack_size = 0; +static int stack_pointer = 0; +static cmo **stack = NULL; -/* cmo_list の派生クラス*/ -typedef struct { - int tag; - int length; - cell head[1]; - char *function; -} mlo_function; - - -mlo *receive_mlo_zz() +int initialize_stack() { - char *s; - mlo *m; - - fprintf(stderr, "--debug: MLO == MLTKINT.\n"); - MLGetString(lp, &s); - fprintf(stderr, "--debug: zz = %s.\n", s); - m = (mlo *)new_cmo_zz_set_string(s); - MLDisownString(lp, s); - return m; + stack_pointer = 0; + stack_size = INIT_S_SIZE; + stack = malloc(stack_size*sizeof(cmo*)); } -mlo *receive_mlo_string() +static int extend_stack() { - char *s; - mlo *m; - fprintf(stderr, "--debug: MLO == MLTKSTR.\n"); - MLGetString(lp, &s); - fprintf(stderr, "--debug: string = \"%s\".\n", s); - m = (cmo *)new_cmo_string(s); - MLDisownString(lp, s); - return m; + int size2 = stack_size + EXT_S_SIZE; + cmo **stack2 = malloc(size2*sizeof(cmo*)); + memcpy(stack2, stack, stack_size*sizeof(cmo *)); + free(stack); + stack = stack2; + stack_size = size2; } -cmo *receive_mlo_function() -{ - char *s; - cmo *m; - cmo *ob; - int i,n; - - fprintf(stderr, "--debug: MLO == MLTKFUNC.\n"); - MLGetFunction(lp, &s, &n); - fprintf(stderr, "--debug: Function = \"%s\", # of args = %d\n", s, n); - m = new_cmo_list(); - append_cmo_list((cmo_list *)m, new_cmo_string(s)); - - for (i=0; ii); -} - -int send_mlo_string(cmo *m) -{ - char *s = ((cmo_string *)m)->s; - MLPutString(lp, s); - fprintf(stderr, "ox_math:: put %s.", s); -} - -int send_mlo_zz(cmo *m) -{ - char *s; - MLPutFunction(lp, "ToExpression", 1); - s = convert_cmo_to_string(m); - MLPutString(lp, s); - fprintf(stderr, "put %s.", s); -} - -int send_mlo_list(cmo *c) -{ - char *s; - cell *cp = ((cmo_list *)c)->head; - int len = length_cmo_list((cmo_list *)c); - - fprintf(stderr, "ox_math:: put List with %d args.\n", len); - MLPutFunction(lp, "List", len); - while(cp->next != NULL) { - send_mlo(cp->cmo); - cp = cp->next; - } -} - -int MATH_sendObject(cmo *m) -{ - send_mlo(m); - MLEndPacket(lp); -} - -int send_mlo(cmo *m) -{ - char *s; - switch(m->tag) { - case CMO_INT32: - send_mlo_int32(m); - break; - case CMO_STRING: - send_mlo_string(m); - break; - case CMO_LIST: - send_mlo_list(m); - break; - default: - MLPutFunction(lp, "ToExpression", 1); - s = convert_cmo_to_string(m); - MLPutString(lp, s); - fprintf(stderr, "put %s.", s); - break; - } -} - -int MATH_evaluateStringByLocalParser(char *str) -{ - MLPutFunction(lp, "ToExpression", 1); - MLPutString(lp, str); - MLEndPacket(lp); -} - -int MATH_executeFunction(char *function, int argc, cmo *argv[]) -{ - int i; - MLPutFunction(lp, function, argc); - for (i=0; itag == CMO_STRING) { fprintf(stderr, "ox_math:: a CMO_STRING(%s) was pushed.\n", ((cmo_string *)m)->s); }else { symp = lookup_by_tag(m->tag); - fprintf(stderr, "ox_math:: a %s was pushed.\n", symp->key); + fprintf(stderr, "ox_math:: a %s was pushed.\n", symbol_get_key(symp)); } #endif - Operand_Stack[Stack_Pointer] = m; - Stack_Pointer++; - if (Stack_Pointer >= SIZE_OPERAND_STACK) { - fprintf(stderr, "stack over flow.\n"); - Stack_Pointer--; + stack[stack_pointer] = m; + stack_pointer++; + if (stack_pointer >= stack_size) { + extend_stack(); } } -/* スタックが空のときは, (CMO_NULL) をかえす. */ +/* if the stack is empty, then pop() returns (CMO_NULL). */ cmo* pop() { - if (Stack_Pointer > 0) { - Stack_Pointer--; - return Operand_Stack[Stack_Pointer]; + if (stack_pointer > 0) { + stack_pointer--; + return stack[stack_pointer]; } return new_cmo_null(); } void pops(int n) { - Stack_Pointer -= n; - if (Stack_Pointer < 0) { - Stack_Pointer = 0; + stack_pointer -= n; + if (stack_pointer < 0) { + stack_pointer = 0; } } -/* sm_XXX 関数群は、エラーのときは 0 以外の値を返し、呼び出し元で - エラーオブジェクトをセットする */ -int sm_popCMO(int fd_write) +/* + if error occurs, then a sm_*() function returns non-zero and + an error obect is set by a function which calls sm_*(). +*/ +int sm_popCMO(OXFILE* oxfp) { cmo* m = pop(); #ifdef DEBUG - symbol *symp = lookup_by_tag(m->tag); - - fprintf(stderr, "ox_math:: opecode = SM_popCMO. (%s)\n", symp->key); + symbol_t symp = lookup_by_tag(m->tag); + fprintf(stderr, "ox_math:: opecode = SM_popCMO. (%s)\n", symbol_get_key(symp)); #endif + if (m != NULL) { - send_ox_cmo(fd_write, m); + send_ox_cmo(oxfp, m); return 0; } return SM_popCMO; } -int sm_pops(int fd_write) +int sm_pops(OXFILE* oxfp) { cmo* m = pop(); if (m != NULL && m->tag == CMO_INT32) { @@ -316,8 +116,8 @@ int sm_pops(int fd_write) return ERROR_ID_UNKNOWN_SM; } -/* MathLink 依存部分 */ -int sm_popString(int fd_write) +/* MathLink dependent */ +int sm_popString(OXFILE* oxfp) { char *s; cmo *err; @@ -329,25 +129,36 @@ int sm_popString(int fd_write) m = pop(); if (m->tag == CMO_STRING) { - send_ox_cmo(fd_write, m); - }else if ((s = convert_cmo_to_string(m)) != NULL) { - send_ox_cmo(fd_write, (cmo *)new_cmo_string(s)); + send_ox_cmo(oxfp, m); + }else if ((s = new_string_set_cmo(m)) != NULL) { + send_ox_cmo(oxfp, (cmo *)new_cmo_string(s)); }else { err = make_error_object(SM_popString, m); - send_ox_cmo(fd_write, err); + send_ox_cmo(oxfp, err); } return 0; } int local_execute(char *s) { + if(*s == 'i') { + switch(s[1]) { + case '+': + flag_mlo_symbol = FLAG_MLTKSYM_IS_STRING; + break; + case '-': + case '=': + default: + flag_mlo_symbol = FLAG_MLTKSYM_IS_INDETERMINATE; + } + } return 0; } -/* この関数はサーバに依存する. */ -int sm_executeStringByLocalParser(int fd_write) +/* The following function is depend on an implementation of a server. */ +int sm_executeStringByLocalParser(OXFILE* oxfp) { - symbol *symp; + symbol_t symp; cmo* m = pop(); char *s = NULL; #ifdef DEBUG @@ -357,26 +168,24 @@ int sm_executeStringByLocalParser(int fd_write) if (m->tag == CMO_STRING && strlen(s = ((cmo_string *)m)->s) != 0) { if (s[0] == ':') { - local_execute(s); + local_execute(++s); }else { /* for mathematica */ - /* mathematica に文字列を送って評価させる */ - MATH_evaluateStringByLocalParser(s); - push(MATH_get_object()); + /* Sending the string `s' to mathematica for its evaluation. */ + ml_evaluateStringByLocalParser(s); + ml_select(); + push(receive_mlo()); } return 0; } #ifdef DEBUG - if ((symp = lookup_by_tag(m->tag)) != NULL) { - fprintf(stderr, "ox_math:: error. the top of stack is %s.\n", symp->key); - }else { - fprintf(stderr, "ox_math:: error. the top of stack is unknown cmo. (%d)\n", m->tag); - } + symp = lookup_by_tag(m->tag); + fprintf(stderr, "ox_math:: error. the top of stack is %s.\n", symbol_get_key(symp)); #endif return SM_executeStringByLocalParser; } -int sm_executeFunction(int fd_write) +int sm_executeFunction(OXFILE* oxfp) { int i, argc; cmo **argv; @@ -397,51 +206,60 @@ int sm_executeFunction(int fd_write) for (i=0; i