version 1.2, 1999/11/02 06:11:58 |
version 1.5, 1999/11/04 19:33:17 |
|
|
/* -*- mode: C; coding: euc-japan -*- */ |
/* -*- mode: C; coding: euc-japan -*- */ |
/* $OpenXM$ */ |
/* $OpenXM: OpenXM/src/ox_math/serv2.c,v 1.4 1999/11/04 03:05:51 ohara Exp $ */ |
/* $Id$ */ |
|
|
|
/* Open Mathematica サーバ */ |
/* Open Mathematica サーバ */ |
/* ファイルディスクリプタ 3, 4 は open されていると仮定して動作する. */ |
/* ファイルディスクリプタ 3, 4 は open されていると仮定して動作する. */ |
|
|
#define UNKNOWN_SM_COMMAND 50000 |
#define UNKNOWN_SM_COMMAND 50000 |
#define MATH_ERROR 50001 |
#define MATH_ERROR 50001 |
|
|
|
|
/* MLINK はポインタ型. */ |
/* MLINK はポインタ型. */ |
MLINK lp = NULL; |
MLINK lp = NULL; |
|
|
|
|
|
typedef cmo mlo; |
|
typedef cmo_string mlo_string; |
|
typedef cmo_zz mlo_zz; |
|
|
|
/* cmo_list の派生クラス*/ |
|
typedef struct { |
|
int tag; |
|
int length; |
|
cell head[1]; |
|
char *function; |
|
} mlo_function; |
|
|
|
|
|
mlo *receive_mlo_zz() |
|
{ |
|
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; |
|
} |
|
|
|
mlo *receive_mlo_string() |
|
{ |
|
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; |
|
} |
|
|
|
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(m, new_cmo_string(s)); |
|
|
|
for (i=0; i<n; i++) { |
|
fprintf(stderr, "--debug: arg[%d]\n", i); |
|
fflush(stderr); |
|
ob = receive_mlo(); |
|
append_cmo_list(m, ob); |
|
} |
|
|
|
MLDisownString(lp, s); |
|
return m; |
|
} |
|
|
|
cmo *receive_mlo_symbol() |
|
{ |
|
cmo *ob; |
|
char *s; |
|
|
|
fprintf(stderr, "--debug: MLO == MLTKSYM.\n"); |
|
MLGetSymbol(lp, &s); |
|
fprintf(stderr, "--debug: Symbol \"%s\".\n", s); |
|
|
|
ob = new_cmo_indeterminate(new_cmo_string(s)); |
|
|
|
MLDisownString(lp, s); |
|
return ob; |
|
} |
|
|
|
|
/* Mathematica を起動する. */ |
/* Mathematica を起動する. */ |
int MATH_init() |
int MATH_init() |
{ |
{ |
int argc = 2; |
int argc = 2; |
char *argv[] = {"-linkname", "math -mathlink"}; |
char *argv[] = {"-linkname", "math -mathlink"}; |
|
|
if(MLInitialize(NULL) != NULL) { |
if(MLInitialize(NULL) == NULL |
lp = MLOpen(argc, argv); |
|| (lp = MLOpen(argc, argv)) == NULL) { |
if(lp != NULL) { |
fprintf(stderr, "Mathematica Kernel not found.\n"); |
return 0; |
exit(1); |
} |
|
} |
} |
exit(1); |
return 0; |
} |
} |
|
|
int MATH_exit() |
int MATH_exit() |
|
|
MLClose(lp); |
MLClose(lp); |
} |
} |
|
|
char *MATH_getObject() |
cmo *MATH_getObject2() |
{ |
{ |
char *s; |
|
|
|
/* skip any packets before the first ReturnPacket */ |
/* skip any packets before the first ReturnPacket */ |
while (MLNextPacket(lp) != RETURNPKT) { |
while (MLNextPacket(lp) != RETURNPKT) { |
usleep(10); |
usleep(10); |
MLNewPacket(lp); |
MLNewPacket(lp); |
} |
} |
/* いまはタイプにかかわらず文字列を取得する. */ |
return receive_mlo(); |
switch(MLGetNext(lp)) { |
|
case MLTKINT: |
|
fprintf(stderr, "type is INTEGER.\n"); |
|
MLGetString(lp, &s); |
|
break; |
|
case MLTKSTR: |
|
fprintf(stderr, "type is STRING.\n"); |
|
MLGetString(lp, &s); |
|
break; |
|
default: |
|
MLGetString(lp, &s); |
|
} |
|
return s; |
|
} |
} |
|
|
cmo *MATH_getObject2() |
cmo *receive_mlo() |
{ |
{ |
char *s; |
char *s; |
cmo *m; |
int type; |
char **sp; |
|
int i,n; |
|
|
|
/* skip any packets before the first ReturnPacket */ |
switch(type = MLGetNext(lp)) { |
while (MLNextPacket(lp) != RETURNPKT) { |
|
usleep(10); |
|
MLNewPacket(lp); |
|
} |
|
/* いまはタイプにかかわらず文字列を取得する. */ |
|
switch(MLGetNext(lp)) { |
|
case MLTKINT: |
case MLTKINT: |
fprintf(stderr, "type is INTEGER.\n"); |
return receive_mlo_zz(); |
MLGetString(lp, &s); |
|
m = (cmo *)new_cmo_zz_set_string(s); |
|
break; |
|
case MLTKSTR: |
case MLTKSTR: |
fprintf(stderr, "type is STRING.\n"); |
return receive_mlo_string(); |
|
case MLTKREAL: |
|
/* double はまだ... */ |
|
fprintf(stderr, "--debug: MLO == MLTKREAL.\n"); |
MLGetString(lp, &s); |
MLGetString(lp, &s); |
m = (cmo *)new_cmo_string(s); |
return new_cmo_string(s); |
break; |
|
case MLTKERR: |
|
fprintf(stderr, "type is ERROR.\n"); |
|
m = (cmo *)gen_error_object(MATH_ERROR); |
|
break; |
|
case MLTKSYM: |
case MLTKSYM: |
fprintf(stderr, "MLTKSYM.\n"); |
return receive_mlo_symbol(); |
MLGetString(lp, s); |
|
m = (cmo *)new_cmo_string(s); |
|
break; |
|
case MLTKFUNC: |
case MLTKFUNC: |
fprintf(stderr, "MLTKFUNC.\n"); |
return receive_mlo_function(); |
#if DEBUG |
case MLTKERR: |
MLGetString(lp, s); |
fprintf(stderr, "--debug: MLO == MLTKERR.\n"); |
m = (cmo *)new_cmo_string(s); |
return gen_error_object(MATH_ERROR); |
break; |
|
#endif |
|
MLGetFunction(lp, sp, &n); |
|
fprintf(stderr, "n = %d\n", n); |
|
for (i=0; i<=n; i++) { |
|
fprintf(stderr, "%s "); |
|
} |
|
fprintf(stderr, "\n"); |
|
m = (cmo *)new_cmo_string(s); |
|
break; |
|
case MLTKREAL: |
|
fprintf(stderr, "MLTKREAL is not supported: we use MLTKSTR.\n"); |
|
MLGetString(lp, &s); |
|
m = (cmo *)new_cmo_string(s); |
|
break; |
|
default: |
default: |
fprintf(stderr, "unknown type: we use STRING.\n"); |
fprintf(stderr, "--debug: MLO(%d) is unknown.\n", type); |
MLGetString(lp, &s); |
MLGetString(lp, &s); |
m = (cmo *)new_cmo_string(s); |
fprintf(stderr, "--debug: \"%s\"\n", s); |
|
return new_cmo_string(s); |
} |
} |
return m; |
|
} |
} |
|
|
|
|
|
int send_mlo_int32(cmo *m) |
|
{ |
|
MLPutInteger(lp, ((cmo_int32 *)m)->i); |
|
} |
|
|
|
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) |
int MATH_sendObject(cmo *m) |
{ |
{ |
|
send_mlo(m); |
|
MLEndPacket(lp); |
|
} |
|
|
|
int send_mlo(cmo *m) |
|
{ |
char *s; |
char *s; |
switch(m->tag) { |
switch(m->tag) { |
case CMO_INT32: |
case CMO_INT32: |
MLPutInteger(lp, ((cmo_int32 *)m)->i); |
send_mlo_int32(m); |
break; |
break; |
case CMO_STRING: |
case CMO_STRING: |
s = ((cmo_string *)m)->s; |
send_mlo_string(m); |
MLPutString(lp, s); |
|
fprintf(stderr, "put %s.", s); |
|
break; |
break; |
|
case CMO_LIST: |
|
send_mlo_list(m); |
|
break; |
default: |
default: |
MLPutFunction(lp, "ToExpression", 1); |
MLPutFunction(lp, "ToExpression", 1); |
s = convert_cmo_to_cstring(m); |
s = convert_cmo_to_string(m); |
MLPutString(lp, s); |
MLPutString(lp, s); |
fprintf(stderr, "put %s.", s); |
fprintf(stderr, "put %s.", s); |
break; |
break; |
Line 163 int MATH_executeFunction(char *function, int argc, cmo |
|
Line 236 int MATH_executeFunction(char *function, int argc, cmo |
|
int i; |
int i; |
MLPutFunction(lp, function, argc); |
MLPutFunction(lp, function, argc); |
for (i=0; i<argc; i++) { |
for (i=0; i<argc; i++) { |
MATH_sendObject(argv[i]); |
send_mlo(argv[i]); |
} |
} |
MLEndPacket(lp); |
MLEndPacket(lp); |
} |
} |
Line 183 int initialize_stack() |
|
Line 256 int initialize_stack() |
|
int push(cmo* m) |
int push(cmo* m) |
{ |
{ |
#if DEBUG |
#if DEBUG |
fprintf(stderr, "server:: a cmo is pushed: tag == %d.\n", m->tag); |
|
if (m->tag == CMO_STRING) { |
if (m->tag == CMO_STRING) { |
fprintf(stderr, "server:: %s\n", ((cmo_string *)m)->s); |
fprintf(stderr, "ox_math:: a cmo_string(%s) was pushed.\n", ((cmo_string *)m)->s); |
} |
}else { |
|
fprintf(stderr, "ox_math:: a cmo(%d) was pushed.\n", m->tag); |
|
} |
#endif |
#endif |
Operand_Stack[Stack_Pointer] = m; |
Operand_Stack[Stack_Pointer] = m; |
Stack_Pointer++; |
Stack_Pointer++; |
if (Stack_Pointer >= SIZE_OPERAND_STACK) { |
if (Stack_Pointer >= SIZE_OPERAND_STACK) { |
fprintf(stderr, "stack over flow.\n"); |
fprintf(stderr, "stack over flow.\n"); |
exit(1); |
exit(1); /* 手抜き */ |
} |
} |
} |
} |
|
|
/* エラーのときは NULL を返す */ |
/* スタックが空のときは, (CMO_NULL) をかえす. */ |
/* gen_error_object(SM_popCMO); */ |
|
/* CMO_ERROR2 */ |
|
|
|
cmo* pop() |
cmo* pop() |
{ |
{ |
if (Stack_Pointer > 0) { |
if (Stack_Pointer > 0) { |
Stack_Pointer--; |
Stack_Pointer--; |
return Operand_Stack[Stack_Pointer]; |
return Operand_Stack[Stack_Pointer]; |
} |
} |
return NULL; |
return new_cmo_null(); |
} |
} |
|
|
void pops(int n) |
void pops(int n) |
Line 217 void pops(int n) |
|
Line 288 void pops(int n) |
|
} |
} |
} |
} |
|
|
|
|
/* sm_XXX 関数群は、エラーのときは 0 以外の値を返し、呼び出し元で |
/* sm_XXX 関数群は、エラーのときは 0 以外の値を返し、呼び出し元で |
エラーオブジェクトをセットする */ |
エラーオブジェクトをセットする */ |
int sm_popCMO(int fd_write) |
int sm_popCMO(int fd_write) |
{ |
{ |
cmo* m = pop(); |
cmo* m = pop(); |
|
|
fprintf(stderr, "code: SM_popCMO.\n"); |
fprintf(stderr, "ox_math:: opecode = SM_popCMO. (tag = %d)\n", m->tag); |
if (m != NULL) { |
if (m != NULL) { |
send_ox_cmo(fd_write, m); |
send_ox_cmo(fd_write, m); |
return 0; |
return 0; |
Line 249 int sm_popString(int fd_write) |
|
Line 319 int sm_popString(int fd_write) |
|
cmo* m; |
cmo* m; |
|
|
#ifdef DEBUG |
#ifdef DEBUG |
fprintf(stderr, "code: SM_popString.\n"); |
fprintf(stderr, "ox_math:: opecode = SM_popString.\n"); |
#endif |
#endif |
|
|
if ((m = pop()) != NULL && (s = convert_cmo_to_cstring(m)) != NULL) { |
if ((m = pop()) != NULL && (s = convert_cmo_to_string(m)) != NULL) { |
send_ox_cmo(fd_write, (cmo *)new_cmo_string(s)); |
send_ox_cmo(fd_write, (cmo *)new_cmo_string(s)); |
return 0; |
return 0; |
} |
} |
Line 264 int sm_executeStringByLocalParser(int fd_write) |
|
Line 334 int sm_executeStringByLocalParser(int fd_write) |
|
{ |
{ |
cmo* m = NULL; |
cmo* m = NULL; |
#ifdef DEBUG |
#ifdef DEBUG |
fprintf(stderr, "code: SM_executeStringByLocalParser.\n"); |
fprintf(stderr, "ox_math:: opecode = SM_executeStringByLocalParser.\n"); |
#endif |
#endif |
if ((m = pop()) != NULL && m->tag == CMO_STRING) { |
if ((m = pop()) != NULL && m->tag == CMO_STRING) { |
/* for mathematica */ |
/* for mathematica */ |