| version 1.3, 1999/11/03 10:56:40 |
version 1.8, 1999/11/18 21:56:44 |
|
|
| /* -*- mode: C; coding: euc-japan -*- */ |
/* -*- mode: C; coding: euc-japan -*- */ |
| /* $OpenXM: OpenXM/src/ox_math/serv2.c,v 1.2 1999/11/02 06:11:58 ohara Exp $ */ |
/* $OpenXM: OpenXM/src/ox_math/serv2.c,v 1.7 1999/11/07 12:12:56 ohara Exp $ */ |
| |
|
| /* Open Mathematica サーバ */ |
/* Open Mathematica サーバ */ |
| /* ファイルディスクリプタ 3, 4 は open されていると仮定して動作する. */ |
/* ファイルディスクリプタ 3, 4 は open されていると仮定して動作する. */ |
|
|
| #include <gmp.h> |
#include <gmp.h> |
| #include <mathlink.h> |
#include <mathlink.h> |
| #include "ox.h" |
#include "ox.h" |
| |
#include "parse.h" |
| #include "serv2.h" |
#include "serv2.h" |
| |
|
| #define UNKNOWN_SM_COMMAND 50000 |
#define FLAG_MLTKSYM_IS_INDETERMINATE 0 |
| #define MATH_ERROR 50001 |
#define FLAG_MLTKSYM_IS_STRING 1 |
| |
|
| |
int flag_mlo_symbol = FLAG_MLTKSYM_IS_INDETERMINATE; |
| |
|
| |
#define ERROR_ID_UNKNOWN_SM 10 |
| |
#define ERROR_ID_FAILURE_MLINK 11 |
| |
|
| /* 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((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((cmo_list *)m, ob); |
| |
} |
| |
|
| |
MLDisownString(lp, s); |
| |
return m; |
| |
} |
| |
|
| |
cmo *receive_mlo_symbol() |
| |
{ |
| |
cmo *ob; |
| |
char *s; |
| |
|
| |
fprintf(stderr, "--debug: MLO == MLTKSYM"); |
| |
MLGetSymbol(lp, &s); |
| |
fprintf(stderr, ": Symbol = \"%s\".\n", s); |
| |
|
| |
if(flag_mlo_symbol == FLAG_MLTKSYM_IS_INDETERMINATE) { |
| |
ob = new_cmo_indeterminate(new_cmo_string(s)); |
| |
}else { |
| |
ob = 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_get_object() |
| { |
{ |
| 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 (cmo *)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 (cmo *)make_error_object(ERROR_ID_FAILURE_MLINK, new_cmo_null()); |
| 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 (cmo *)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_string(m); |
s = convert_cmo_to_string(m); |
| Line 162 int MATH_executeFunction(char *function, int argc, cmo |
|
| Line 242 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 182 int initialize_stack() |
|
| Line 262 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); |
symbol *symp; |
| |
|
| 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 { |
| |
symp = lookup_by_tag(m->tag); |
| |
fprintf(stderr, "ox_math:: a %s was pushed.\n", symp->key); |
| } |
} |
| #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); |
Stack_Pointer--; |
| } |
} |
| } |
} |
| |
|
| Line 218 void pops(int n) |
|
| Line 302 void pops(int n) |
|
| int sm_popCMO(int fd_write) |
int sm_popCMO(int fd_write) |
| { |
{ |
| cmo* m = pop(); |
cmo* m = pop(); |
| |
#ifdef DEBUG |
| fprintf(stderr, "code: SM_popCMO.\n"); |
symbol *symp = lookup_by_tag(m->tag); |
| |
|
| |
fprintf(stderr, "ox_math:: opecode = SM_popCMO. (%s)\n", symp->key); |
| |
#endif |
| if (m != NULL) { |
if (m != NULL) { |
| send_ox_cmo(fd_write, m); |
send_ox_cmo(fd_write, m); |
| return 0; |
return 0; |
| Line 234 int sm_pops(int fd_write) |
|
| Line 321 int sm_pops(int fd_write) |
|
| pops(((cmo_int32 *)m)->i); |
pops(((cmo_int32 *)m)->i); |
| return 0; |
return 0; |
| } |
} |
| return UNKNOWN_SM_COMMAND; |
return ERROR_ID_UNKNOWN_SM; |
| } |
} |
| |
|
| /* MathLink 依存部分 */ |
/* MathLink 依存部分 */ |
| int sm_popString(int fd_write) |
int sm_popString(int fd_write) |
| { |
{ |
| char* s; |
char *s; |
| cmo* m; |
cmo *err; |
| |
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_string(m)) != NULL) { |
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(fd_write, (cmo *)new_cmo_string(s)); |
| return 0; |
}else { |
| |
err = make_error_object(SM_popString, m); |
| |
send_ox_cmo(fd_write, err); |
| } |
} |
| return SM_popString; |
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) |
int sm_executeStringByLocalParser(int fd_write) |
| { |
{ |
| cmo* m = NULL; |
symbol *symp; |
| |
cmo* m = pop(); |
| |
char *s = 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) { |
|
| /* for mathematica */ |
if (m->tag == CMO_STRING |
| /* mathematica に文字列を送って評価させる */ |
&& strlen(s = ((cmo_string *)m)->s) != 0) { |
| MATH_evaluateStringByLocalParser(((cmo_string *)m)->s); |
if (s[0] == ':') { |
| push(MATH_getObject2()); |
local_execute(++s); |
| |
}else { |
| |
/* for mathematica */ |
| |
/* mathematica に文字列を送って評価させる */ |
| |
MATH_evaluateStringByLocalParser(s); |
| |
push(MATH_get_object()); |
| |
} |
| return 0; |
return 0; |
| } |
} |
| fprintf(stderr, "cannot execute: top of stack is not string!(%p, %d)\n", m, m->tag); |
#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); |
| |
} |
| |
#endif |
| return SM_executeStringByLocalParser; |
return SM_executeStringByLocalParser; |
| } |
} |
| |
|
| Line 287 int sm_executeFunction(int fd_write) |
|
| Line 410 int sm_executeFunction(int fd_write) |
|
| if ((m = pop()) == NULL || m->tag != CMO_INT32) { |
if ((m = pop()) == NULL || m->tag != CMO_INT32) { |
| return SM_executeFunction; |
return SM_executeFunction; |
| } |
} |
| |
|
| argc = ((cmo_int32 *)m)->i; |
argc = ((cmo_int32 *)m)->i; |
| argv = malloc(sizeof(cmo *)*argc); |
argv = malloc(argc*sizeof(cmo *)); |
| for (i=0; i<argc; i++) { |
for (i=0; i<argc; i++) { |
| if ((argv[i] = pop()) == NULL) { |
argv[i] = pop(); |
| return SM_executeFunction; |
|
| } |
|
| } |
} |
| MATH_executeFunction(func, argc, argv); |
MATH_executeFunction(func, argc, argv); |
| push(MATH_getObject2()); |
push(MATH_get_object()); |
| return 0; |
return 0; |
| } |
} |
| |
|
| Line 305 int sm_executeFunction(int fd_write) |
|
| Line 427 int sm_executeFunction(int fd_write) |
|
| |
|
| int sm_mathcap(int fd_write) |
int sm_mathcap(int fd_write) |
| { |
{ |
| cmo* c = make_mathcap_object(VERSION, ID_STRING); |
push(make_mathcap_object(VERSION, ID_STRING)); |
| push(c); |
|
| return 0; |
return 0; |
| } |
} |
| |
|
| Line 318 int receive_sm_command(int fd_read) |
|
| Line 439 int receive_sm_command(int fd_read) |
|
| int execute_sm_command(int fd_write, int code) |
int execute_sm_command(int fd_write, int code) |
| { |
{ |
| int err = 0; |
int err = 0; |
| |
#ifdef DEBUG |
| |
symbol *sp = lookup_by_tag(code); |
| |
fprintf(stderr, "ox_math:: %s received.\n", sp->key); |
| |
#endif |
| |
|
| switch(code) { |
switch(code) { |
| case SM_popCMO: |
case SM_popCMO: |
| Line 341 int execute_sm_command(int fd_write, int code) |
|
| Line 466 int execute_sm_command(int fd_write, int code) |
|
| case SM_setMathCap: |
case SM_setMathCap: |
| pop(); /* 無視する */ |
pop(); /* 無視する */ |
| break; |
break; |
| |
case SM_shutdown: |
| |
shutdown(); |
| |
break; |
| default: |
default: |
| fprintf(stderr, "unknown command: %d.\n", code); |
fprintf(stderr, "unknown command: %d.\n", code); |
| err = UNKNOWN_SM_COMMAND; |
err = ERROR_ID_UNKNOWN_SM; |
| } |
} |
| |
|
| if (err != 0) { |
if (err != 0) { |
| push((cmo *)gen_error_object(err)); |
push((cmo *)make_error_object(err, new_cmo_null())); |
| } |
} |
| } |
} |