version 1.5, 1999/11/04 19:33:17 |
version 1.6, 1999/11/06 21:39:37 |
|
|
/* -*- mode: C; coding: euc-japan -*- */ |
/* -*- mode: C; coding: euc-japan -*- */ |
/* $OpenXM: OpenXM/src/ox_math/serv2.c,v 1.4 1999/11/04 03:05:51 ohara Exp $ */ |
/* $OpenXM: OpenXM/src/ox_math/serv2.c,v 1.5 1999/11/04 19:33:17 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 UNKNOWN_SM_COMMAND 50000 |
|
|
/* MLINK はポインタ型. */ |
/* MLINK はポインタ型. */ |
MLINK lp = NULL; |
MLINK lp = NULL; |
|
|
|
|
typedef cmo mlo; |
typedef cmo mlo; |
typedef cmo_string mlo_string; |
typedef cmo_string mlo_string; |
typedef cmo_zz mlo_zz; |
typedef cmo_zz mlo_zz; |
Line 70 cmo *receive_mlo_function() |
|
Line 70 cmo *receive_mlo_function() |
|
MLGetFunction(lp, &s, &n); |
MLGetFunction(lp, &s, &n); |
fprintf(stderr, "--debug: Function = \"%s\", # of args = %d\n", s, n); |
fprintf(stderr, "--debug: Function = \"%s\", # of args = %d\n", s, n); |
m = new_cmo_list(); |
m = new_cmo_list(); |
append_cmo_list(m, new_cmo_string(s)); |
append_cmo_list((cmo_list *)m, new_cmo_string(s)); |
|
|
for (i=0; i<n; i++) { |
for (i=0; i<n; i++) { |
fprintf(stderr, "--debug: arg[%d]\n", i); |
fprintf(stderr, "--debug: arg[%d]\n", i); |
fflush(stderr); |
fflush(stderr); |
ob = receive_mlo(); |
ob = receive_mlo(); |
append_cmo_list(m, ob); |
append_cmo_list((cmo_list *)m, ob); |
} |
} |
|
|
MLDisownString(lp, s); |
MLDisownString(lp, s); |
Line 98 cmo *receive_mlo_symbol() |
|
Line 98 cmo *receive_mlo_symbol() |
|
return ob; |
return ob; |
} |
} |
|
|
|
|
/* Mathematica を起動する. */ |
/* Mathematica を起動する. */ |
int MATH_init() |
int MATH_init() |
{ |
{ |
Line 144 cmo *receive_mlo() |
|
Line 143 cmo *receive_mlo() |
|
/* double はまだ... */ |
/* double はまだ... */ |
fprintf(stderr, "--debug: MLO == MLTKREAL.\n"); |
fprintf(stderr, "--debug: MLO == MLTKREAL.\n"); |
MLGetString(lp, &s); |
MLGetString(lp, &s); |
return new_cmo_string(s); |
return (cmo *)new_cmo_string(s); |
case MLTKSYM: |
case MLTKSYM: |
return receive_mlo_symbol(); |
return receive_mlo_symbol(); |
case MLTKFUNC: |
case MLTKFUNC: |
return receive_mlo_function(); |
return receive_mlo_function(); |
case MLTKERR: |
case MLTKERR: |
fprintf(stderr, "--debug: MLO == MLTKERR.\n"); |
fprintf(stderr, "--debug: MLO == MLTKERR.\n"); |
return gen_error_object(MATH_ERROR); |
return (cmo *)gen_error_object(MATH_ERROR); |
default: |
default: |
fprintf(stderr, "--debug: MLO(%d) is unknown.\n", type); |
fprintf(stderr, "--debug: MLO(%d) is unknown.\n", type); |
MLGetString(lp, &s); |
MLGetString(lp, &s); |
fprintf(stderr, "--debug: \"%s\"\n", s); |
fprintf(stderr, "--debug: \"%s\"\n", s); |
return new_cmo_string(s); |
return (cmo *)new_cmo_string(s); |
} |
} |
} |
} |
|
|
|
|
int send_mlo_int32(cmo *m) |
int send_mlo_int32(cmo *m) |
{ |
{ |
MLPutInteger(lp, ((cmo_int32 *)m)->i); |
MLPutInteger(lp, ((cmo_int32 *)m)->i); |
Line 256 int initialize_stack() |
|
Line 254 int initialize_stack() |
|
int push(cmo* m) |
int push(cmo* m) |
{ |
{ |
#if DEBUG |
#if DEBUG |
|
symbol *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 { |
fprintf(stderr, "ox_math:: a cmo(%d) was pushed.\n", m->tag); |
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 293 void pops(int n) |
|
Line 294 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, "ox_math:: opecode = SM_popCMO. (tag = %d)\n", m->tag); |
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 315 int sm_pops(int fd_write) |
|
Line 319 int sm_pops(int fd_write) |
|
/* 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, "ox_math:: opecode = 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 = new_cmo_error2(m); |
return SM_popString; |
send_ox_cmo(fd_write, err); |
|
} |
|
return 0; |
} |
} |
|
|
|
int local_execute(char *s) |
|
{ |
|
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, "ox_math:: opecode = 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); |
return 0; |
}else { |
|
/* for mathematica */ |
|
/* mathematica に文字列を送って評価させる */ |
|
MATH_evaluateStringByLocalParser(s); |
|
push(MATH_getObject2()); |
|
} |
|
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 362 int sm_executeFunction(int fd_write) |
|
Line 391 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(sizeof(cmo *)*argc); |
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_getObject2()); |