| version 1.9, 1999/11/19 20:51:36 |
version 1.16, 2000/10/10 19:58:30 |
|
|
| /* -*- mode: C; coding: euc-japan -*- */ |
/* -*- mode: C; coding: euc-japan -*- */ |
| /* $OpenXM: OpenXM/src/ox_math/serv2.c,v 1.8 1999/11/18 21:56:44 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 <stdio.h> |
#include <stdio.h> |
| #include <stdlib.h> |
#include <stdlib.h> |
| #include <unistd.h> |
#include <unistd.h> |
| #include <gmp.h> |
#include <gmp.h> |
| #include <mathlink.h> |
#include <mathlink.h> |
| #include "ox.h" |
#include <ox_toolkit.h> |
| #include "parse.h" |
|
| #include "serv2.h" |
#include "serv2.h" |
| |
|
| #define FLAG_MLTKSYM_IS_INDETERMINATE 0 |
extern int flag_mlo_symbol; |
| #define FLAG_MLTKSYM_IS_STRING 1 |
|
| |
|
| int flag_mlo_symbol = FLAG_MLTKSYM_IS_INDETERMINATE; |
/* MathLink independent */ |
| |
#define INIT_S_SIZE 2048 |
| |
#define EXT_S_SIZE 2048 |
| |
|
| #define ERROR_ID_UNKNOWN_SM 10 |
static int stack_size = 0; |
| #define ERROR_ID_FAILURE_MLINK 11 |
static int stack_pointer = 0; |
| |
static cmo **stack = NULL; |
| |
|
| /* MLINK はポインタ型. */ |
int initialize_stack() |
| 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; |
stack_pointer = 0; |
| mlo *m; |
stack_size = INIT_S_SIZE; |
| |
stack = malloc(stack_size*sizeof(cmo*)); |
| 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() |
static int extend_stack() |
| { |
{ |
| char *s; |
int size2 = stack_size + EXT_S_SIZE; |
| mlo *m; |
cmo **stack2 = malloc(size2*sizeof(cmo*)); |
| fprintf(stderr, "--debug: MLO == MLTKSTR.\n"); |
memcpy(stack2, stack, stack_size*sizeof(cmo *)); |
| MLGetString(lp, &s); |
free(stack); |
| fprintf(stderr, "--debug: string = \"%s\".\n", s); |
stack = stack2; |
| m = (cmo *)new_cmo_string(s); |
stack_size = size2; |
| 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 を起動する. */ |
|
| int MATH_init() |
|
| { |
|
| int argc = 2; |
|
| char *argv[] = {"-linkname", "math -mathlink"}; |
|
| |
|
| if(MLInitialize(NULL) == NULL |
|
| || (lp = MLOpen(argc, argv)) == NULL) { |
|
| fprintf(stderr, "Mathematica Kernel not found.\n"); |
|
| exit(1); |
|
| } |
|
| return 0; |
|
| } |
|
| |
|
| int MATH_exit() |
|
| { |
|
| /* quit Mathematica then close the link */ |
|
| MLPutFunction(lp, "Exit", 0); |
|
| MLClose(lp); |
|
| } |
|
| |
|
| cmo *MATH_get_object() |
|
| { |
|
| /* skip any packets before the first ReturnPacket */ |
|
| while (MLNextPacket(lp) != RETURNPKT) { |
|
| usleep(10); |
|
| MLNewPacket(lp); |
|
| } |
|
| return receive_mlo(); |
|
| } |
|
| |
|
| cmo *receive_mlo() |
|
| { |
|
| char *s; |
|
| int type; |
|
| |
|
| switch(type = MLGetNext(lp)) { |
|
| case MLTKINT: |
|
| return receive_mlo_zz(); |
|
| case MLTKSTR: |
|
| return receive_mlo_string(); |
|
| case MLTKREAL: |
|
| /* double はまだ... */ |
|
| fprintf(stderr, "--debug: MLO == MLTKREAL.\n"); |
|
| MLGetString(lp, &s); |
|
| return (cmo *)new_cmo_string(s); |
|
| case MLTKSYM: |
|
| return receive_mlo_symbol(); |
|
| case MLTKFUNC: |
|
| return receive_mlo_function(); |
|
| case MLTKERR: |
|
| fprintf(stderr, "--debug: MLO == MLTKERR.\n"); |
|
| return (cmo *)make_error_object(ERROR_ID_FAILURE_MLINK, new_cmo_null()); |
|
| default: |
|
| fprintf(stderr, "--debug: MLO(%d) is unknown.\n", type); |
|
| MLGetString(lp, &s); |
|
| fprintf(stderr, "--debug: \"%s\"\n", s); |
|
| return (cmo *)new_cmo_string(s); |
|
| } |
|
| } |
|
| |
|
| 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); |
|
| } |
|
| |
|
| int send_mlo_zz(cmo *m) |
|
| { |
|
| char *s; |
|
| MLPutFunction(lp, "ToExpression", 1); |
|
| s = convert_cmo_to_string(m); |
|
| MLPutString(lp, s); |
|
| } |
|
| |
|
| int send_mlo_list(cmo *c) |
|
| { |
|
| char *s; |
|
| cell *cp = ((cmo_list *)c)->head; |
|
| int len = length_cmo_list((cmo_list *)c); |
|
| |
|
| 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_ZERO: |
|
| case CMO_NULL: |
|
| send_mlo_int32(new_cmo_int32(0)); |
|
| break; |
|
| case CMO_STRING: |
|
| send_mlo_string(m); |
|
| break; |
|
| case CMO_LIST: |
|
| send_mlo_list(m); |
|
| break; |
|
| case CMO_MATHCAP: |
|
| send_mlo(((cmo_mathcap *)m)->ob); |
|
| break; |
|
| case CMO_ZZ: |
|
| send_mlo_zz(m); |
|
| break; |
|
| default: |
|
| MLPutFunction(lp, "ToExpression", 1); |
|
| s = convert_cmo_to_string(m); |
|
| MLPutString(lp, 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; i<argc; i++) { |
|
| send_mlo(argv[i]); |
|
| } |
|
| MLEndPacket(lp); |
|
| } |
|
| |
|
| /* MathLink 非依存部分 */ |
|
| |
|
| #define SIZE_OPERAND_STACK 2048 |
|
| |
|
| static cmo* Operand_Stack[SIZE_OPERAND_STACK]; |
|
| static int Stack_Pointer = 0; |
|
| |
|
| int initialize_stack() |
|
| { |
|
| Stack_Pointer = 0; |
|
| } |
|
| |
|
| int push(cmo* m) |
int push(cmo* m) |
| { |
{ |
| #if DEBUG |
#if DEBUG |
| symbol *symp; |
symbol_t symp; |
| |
|
| if (m->tag == CMO_STRING) { |
if (m->tag == CMO_STRING) { |
| fprintf(stderr, "ox_math:: a CMO_STRING(%s) was pushed.\n", ((cmo_string *)m)->s); |
fprintf(stderr, "ox_math:: a CMO_STRING(%s) was pushed.\n", ((cmo_string *)m)->s); |
| }else { |
}else { |
| symp = lookup_by_tag(m->tag); |
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 |
#endif |
| Operand_Stack[Stack_Pointer] = m; |
stack[stack_pointer] = m; |
| Stack_Pointer++; |
stack_pointer++; |
| if (Stack_Pointer >= SIZE_OPERAND_STACK) { |
if (stack_pointer >= stack_size) { |
| fprintf(stderr, "stack over flow.\n"); |
extend_stack(); |
| Stack_Pointer--; |
|
| } |
} |
| } |
} |
| |
|
| /* スタックが空のときは, (CMO_NULL) をかえす. */ |
/* if the stack is empty, then pop() returns (CMO_NULL). */ |
| cmo* pop() |
cmo* pop() |
| { |
{ |
| if (Stack_Pointer > 0) { |
if (stack_pointer > 0) { |
| Stack_Pointer--; |
stack_pointer--; |
| return Operand_Stack[Stack_Pointer]; |
return stack[stack_pointer]; |
| } |
} |
| return new_cmo_null(); |
return new_cmo_null(); |
| } |
} |
| |
|
| void pops(int n) |
void pops(int n) |
| { |
{ |
| Stack_Pointer -= n; |
stack_pointer -= n; |
| if (Stack_Pointer < 0) { |
if (stack_pointer < 0) { |
| Stack_Pointer = 0; |
stack_pointer = 0; |
| } |
} |
| } |
} |
| |
|
| /* sm_XXX 関数群は、エラーのときは 0 以外の値を返し、呼び出し元で |
/* |
| エラーオブジェクトをセットする */ |
if error occurs, then a sm_*() function returns non-zero and |
| int sm_popCMO(int fd_write) |
an error obect is set by a function which calls sm_*(). |
| |
*/ |
| |
int sm_popCMO(OXFILE* oxfp) |
| { |
{ |
| cmo* m = pop(); |
cmo* m = pop(); |
| #ifdef DEBUG |
#ifdef DEBUG |
| symbol *symp = lookup_by_tag(m->tag); |
symbol_t symp = lookup_by_tag(m->tag); |
| |
fprintf(stderr, "ox_math:: opecode = SM_popCMO. (%s)\n", symbol_get_key(symp)); |
| fprintf(stderr, "ox_math:: opecode = SM_popCMO. (%s)\n", symp->key); |
|
| #endif |
#endif |
| |
|
| if (m != NULL) { |
if (m != NULL) { |
| send_ox_cmo(fd_write, m); |
send_ox_cmo(oxfp, m); |
| return 0; |
return 0; |
| } |
} |
| return SM_popCMO; |
return SM_popCMO; |
| } |
} |
| |
|
| int sm_pops(int fd_write) |
int sm_pops(OXFILE* oxfp) |
| { |
{ |
| cmo* m = pop(); |
cmo* m = pop(); |
| if (m != NULL && m->tag == CMO_INT32) { |
if (m != NULL && m->tag == CMO_INT32) { |
| Line 330 int sm_pops(int fd_write) |
|
| Line 116 int sm_pops(int fd_write) |
|
| return ERROR_ID_UNKNOWN_SM; |
return ERROR_ID_UNKNOWN_SM; |
| } |
} |
| |
|
| /* MathLink 依存部分 */ |
/* MathLink dependent */ |
| int sm_popString(int fd_write) |
int sm_popString(OXFILE* oxfp) |
| { |
{ |
| char *s; |
char *s; |
| cmo *err; |
cmo *err; |
| Line 343 int sm_popString(int fd_write) |
|
| Line 129 int sm_popString(int fd_write) |
|
| |
|
| m = pop(); |
m = pop(); |
| if (m->tag == CMO_STRING) { |
if (m->tag == CMO_STRING) { |
| send_ox_cmo(fd_write, m); |
send_ox_cmo(oxfp, m); |
| }else if ((s = convert_cmo_to_string(m)) != NULL) { |
}else if ((s = new_string_set_cmo(m)) != NULL) { |
| send_ox_cmo(fd_write, (cmo *)new_cmo_string(s)); |
send_ox_cmo(oxfp, (cmo *)new_cmo_string(s)); |
| }else { |
}else { |
| err = make_error_object(SM_popString, m); |
err = make_error_object(SM_popString, m); |
| send_ox_cmo(fd_write, err); |
send_ox_cmo(oxfp, err); |
| } |
} |
| return 0; |
return 0; |
| } |
} |
| |
|
| int local_execute(char *s) |
int local_execute(char *s) |
| { |
{ |
| if(*s == 'i') { |
if(*s == 'i') { |
| switch(s[1]) { |
switch(s[1]) { |
| case '+': |
case '+': |
| flag_mlo_symbol = FLAG_MLTKSYM_IS_STRING; |
flag_mlo_symbol = FLAG_MLTKSYM_IS_STRING; |
| break; |
break; |
| case '-': |
case '-': |
| case '=': |
case '=': |
| default: |
default: |
| flag_mlo_symbol = FLAG_MLTKSYM_IS_INDETERMINATE; |
flag_mlo_symbol = FLAG_MLTKSYM_IS_INDETERMINATE; |
| } |
} |
| } |
} |
| return 0; |
return 0; |
| } |
} |
| |
|
| /* この関数はサーバに依存する. */ |
/* The following function is depend on an implementation of a server. */ |
| int sm_executeStringByLocalParser(int fd_write) |
int sm_executeStringByLocalParser(OXFILE* oxfp) |
| { |
{ |
| symbol *symp; |
symbol_t symp; |
| cmo* m = pop(); |
cmo* m = pop(); |
| char *s = NULL; |
char *s = NULL; |
| #ifdef DEBUG |
#ifdef DEBUG |
| Line 385 int sm_executeStringByLocalParser(int fd_write) |
|
| Line 171 int sm_executeStringByLocalParser(int fd_write) |
|
| local_execute(++s); |
local_execute(++s); |
| }else { |
}else { |
| /* for mathematica */ |
/* for mathematica */ |
| /* mathematica に文字列を送って評価させる */ |
/* Sending the string `s' to mathematica for its evaluation. */ |
| MATH_evaluateStringByLocalParser(s); |
ml_evaluateStringByLocalParser(s); |
| push(MATH_get_object()); |
ml_select(); |
| |
push(receive_mlo()); |
| } |
} |
| return 0; |
return 0; |
| } |
} |
| #ifdef DEBUG |
#ifdef DEBUG |
| if ((symp = lookup_by_tag(m->tag)) != NULL) { |
symp = lookup_by_tag(m->tag); |
| fprintf(stderr, "ox_math:: error. the top of stack is %s.\n", symp->key); |
fprintf(stderr, "ox_math:: error. the top of stack is %s.\n", symbol_get_key(symp)); |
| }else { |
|
| fprintf(stderr, "ox_math:: error. the top of stack is unknown cmo. (%d)\n", m->tag); |
|
| } |
|
| #endif |
#endif |
| return SM_executeStringByLocalParser; |
return SM_executeStringByLocalParser; |
| } |
} |
| |
|
| int sm_executeFunction(int fd_write) |
int sm_executeFunction(OXFILE* oxfp) |
| { |
{ |
| int i, argc; |
int i, argc; |
| cmo **argv; |
cmo **argv; |
| Line 422 int sm_executeFunction(int fd_write) |
|
| Line 206 int sm_executeFunction(int fd_write) |
|
| for (i=0; i<argc; i++) { |
for (i=0; i<argc; i++) { |
| argv[i] = pop(); |
argv[i] = pop(); |
| } |
} |
| MATH_executeFunction(func, argc, argv); |
ml_executeFunction(func, argc, argv); |
| push(MATH_get_object()); |
ml_select(); |
| |
push(receive_mlo()); |
| return 0; |
return 0; |
| } |
} |
| |
|
| /* 平成11年10月13日 */ |
#define VERSION 0x11121400 |
| #define VERSION 0x11102700 |
#define ID_STRING "1999/12/14 15:25:00" |
| #define ID_STRING "ox_math server 1999/10/28 17:29:25" |
|
| |
|
| int sm_mathcap(int fd_write) |
int sm_mathcap(OXFILE* oxfp) |
| { |
{ |
| push(make_mathcap_object(VERSION, ID_STRING)); |
mathcap_sysinfo_set(VERSION, ID_STRING, "ox_math"); |
| |
push(mathcap_get()); |
| return 0; |
return 0; |
| } |
} |
| |
|
| int receive_sm_command(int fd_read) |
int receive_sm_command(OXFILE* oxfp) |
| { |
{ |
| return receive_int32(fd_read); |
return receive_int32(oxfp); |
| } |
} |
| |
|
| int execute_sm_command(int fd_write, int code) |
int execute_sm_command(OXFILE* oxfp, int code) |
| { |
{ |
| int err = 0; |
int err = 0; |
| #ifdef DEBUG |
#ifdef DEBUG |
| symbol *sp = lookup_by_tag(code); |
symbol_t sp = lookup_by_tag(code); |
| fprintf(stderr, "ox_math:: %s received.\n", sp->key); |
fprintf(stderr, "ox_math:: %s received.\n", symbol_get_key(sp)); |
| #endif |
#endif |
| |
|
| switch(code) { |
switch(code) { |
| case SM_popCMO: |
case SM_popCMO: |
| err = sm_popCMO(fd_write); |
err = sm_popCMO(oxfp); |
| break; |
break; |
| case SM_popString: |
case SM_popString: |
| err = sm_popString(fd_write); |
err = sm_popString(oxfp); |
| break; |
break; |
| case SM_mathcap: |
case SM_mathcap: |
| err = sm_mathcap(fd_write); |
err = sm_mathcap(oxfp); |
| break; |
break; |
| case SM_pops: |
case SM_pops: |
| err = sm_pops(fd_write); |
err = sm_pops(oxfp); |
| break; |
break; |
| case SM_executeStringByLocalParser: |
case SM_executeStringByLocalParser: |
| err = sm_executeStringByLocalParser(fd_write); |
case SM_executeStringByLocalParserInBatchMode: |
| |
err = sm_executeStringByLocalParser(oxfp); |
| break; |
break; |
| case SM_executeFunction: |
case SM_executeFunction: |
| err = sm_executeFunction(fd_write); |
err = sm_executeFunction(oxfp); |
| break; |
break; |
| case SM_setMathCap: |
|
| pop(); /* 無視する */ |
|
| break; |
|
| case SM_shutdown: |
case SM_shutdown: |
| shutdown(); |
shutdown(); |
| |
break; |
| |
case SM_setMathCap: |
| |
pop(); /* ignore */ |
| break; |
break; |
| default: |
default: |
| fprintf(stderr, "unknown command: %d.\n", code); |
fprintf(stderr, "unknown command: %d.\n", code); |