version 1.8, 2000/11/28 20:16:03 |
version 1.11, 2003/01/13 12:04:53 |
|
|
/* -*- mode: C -*- */ |
/* -*- mode: C -*- */ |
/* $OpenXM: OpenXM/src/ox_math/mlo.c,v 1.7 2000/10/10 19:58:29 ohara Exp $ */ |
/* $OpenXM: OpenXM/src/ox_math/mlo.c,v 1.10 2003/01/11 12:38:57 ohara Exp $ */ |
|
|
/* |
/* |
Copyright (C) Katsuyoshi OHARA, 2000. |
Copyright (C) Katsuyoshi OHARA, 2000. |
|
|
#include <mathlink.h> |
#include <mathlink.h> |
#include <ox_toolkit.h> |
#include <ox_toolkit.h> |
#include "mlo.h" |
#include "mlo.h" |
#include "serv2.h" |
#include "sm.h" |
|
|
/* If this flag sets then we identify MLTKSYM to CMO_INDETERMINATE. */ |
/* If this flag sets then we identify MLTKSYM to CMO_INDETERMINATE. */ |
int flag_mlo_symbol = FLAG_MLTKSYM_IS_INDETERMINATE; |
int flag_mlo_symbol = FLAG_MLTKSYM_IS_INDETERMINATE; |
Line 24 int flag_mlo_symbol = FLAG_MLTKSYM_IS_INDETERMINATE; |
|
Line 24 int flag_mlo_symbol = FLAG_MLTKSYM_IS_INDETERMINATE; |
|
/* MLINK is a indentifier of MathLink connection. */ |
/* MLINK is a indentifier of MathLink connection. */ |
MLINK stdlink; |
MLINK stdlink; |
|
|
|
mlo *receive_mlo_real() |
|
{ |
|
char *s; |
|
cmo *ob; |
|
/* Yet we have no implementation of CMO_DOUBLE... */ |
|
MLGetString(stdlink, &s); |
|
ox_printf("MLTKREAL(%s)", s); |
|
ob = (cmo *)new_cmo_string(s); |
|
MLDisownString(stdlink, s); |
|
return ob; |
|
} |
|
|
|
mlo *receive_mlo_error() |
|
{ |
|
int errcode = MLError(stdlink); |
|
char *s = MLErrorMessage(stdlink); |
|
MLClearError(stdlink); |
|
ox_printf("MLTKERR(%d,\"%s\")", errcode, s); |
|
return (cmo *)make_error_object(ERROR_ID_FAILURE_MLINK, new_cmo_string(s)); |
|
} |
|
|
mlo *receive_mlo_zz() |
mlo *receive_mlo_zz() |
{ |
{ |
char *s; |
char *s; |
mlo *m; |
mlo *m; |
|
|
MLGetString(stdlink, &s); |
MLGetString(stdlink, &s); |
fprintf(stderr, "--debug: MLO == MLTKINT (%s).\n", s); |
ox_printf("MLTKINT(%s)", s); |
m = (mlo *)new_cmo_zz_set_string(s); |
m = (mlo *)new_cmo_zz_set_string(s); |
MLDisownString(stdlink, s); |
MLDisownString(stdlink, s); |
return m; |
return m; |
Line 41 mlo *receive_mlo_string() |
|
Line 62 mlo *receive_mlo_string() |
|
char *s; |
char *s; |
mlo *m; |
mlo *m; |
MLGetString(stdlink, &s); |
MLGetString(stdlink, &s); |
fprintf(stderr, "--debug: MLO == MLTKSTR (\"%s\").\n", s); |
ox_printf("MLTKSTR(\"%s\")", s); |
m = (cmo *)new_cmo_string(s); |
m = (cmo *)new_cmo_string(s); |
MLDisownString(stdlink, s); |
MLDisownString(stdlink, s); |
return m; |
return m; |
Line 55 cmo *receive_mlo_function() |
|
Line 76 cmo *receive_mlo_function() |
|
int i,n; |
int i,n; |
|
|
MLGetFunction(stdlink, &s, &n); |
MLGetFunction(stdlink, &s, &n); |
fprintf(stderr, "--debug: MLO == MLTKFUNC (%s[#%d]).\n", s, n); |
ox_printf("MLTKFUNC(%s[#%d])", s, n); |
m = new_cmo_list(); |
m = new_cmo_list(); |
list_append((cmo_list *)m, new_cmo_string(s)); |
list_append((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); |
ox_printf(" arg[%d]: ", i); |
fflush(stderr); |
|
ob = receive_mlo(); |
ob = receive_mlo(); |
|
ox_printf(", "); |
list_append((cmo_list *)m, ob); |
list_append((cmo_list *)m, ob); |
} |
} |
|
|
Line 102 cmo *receive_mlo_function_newer() |
|
Line 123 cmo *receive_mlo_function_newer() |
|
int i,n; |
int i,n; |
|
|
MLGetFunction(stdlink, &s, &n); |
MLGetFunction(stdlink, &s, &n); |
#ifdef DEBUG |
ox_printf("MLTKFUNC(%s[#%d])", s, n); |
fprintf(stderr, "--debug: MLO == MLTKFUNC, (%s[#%d])\n", s, n); |
|
#endif |
|
m = new_mlo_function(s); |
m = new_mlo_function(s); |
for (i=0; i<n; i++) { |
for (i=0; i<n; i++) { |
fprintf(stderr, "--debug: arg[%d]\n", i); |
ox_printf(" arg[%d]: ", i); |
fflush(stderr); |
|
ob = receive_mlo(); |
ob = receive_mlo(); |
|
ox_printf(", "); |
list_append((cmo_list *)m, ob); |
list_append((cmo_list *)m, ob); |
} |
} |
|
|
Line 123 cmo *receive_mlo_symbol() |
|
Line 142 cmo *receive_mlo_symbol() |
|
char *s; |
char *s; |
|
|
MLGetSymbol(stdlink, &s); |
MLGetSymbol(stdlink, &s); |
#ifdef DEBUG |
ox_printf("MLTKSYM(%s)", s); |
fprintf(stderr, "--debug: MLO == MLTKSYM, (%s).\n", s); |
|
#endif |
|
if(flag_mlo_symbol == FLAG_MLTKSYM_IS_INDETERMINATE) { |
if(flag_mlo_symbol == FLAG_MLTKSYM_IS_INDETERMINATE) { |
ob = new_cmo_indeterminate(new_cmo_string(s)); |
ob = new_cmo_indeterminate(new_cmo_string(s)); |
}else { |
}else { |
|
|
|
|
if(MLInitialize(NULL) == NULL |
if(MLInitialize(NULL) == NULL |
|| (stdlink = MLOpen(argc, argv)) == NULL) { |
|| (stdlink = MLOpen(argc, argv)) == NULL) { |
fprintf(stderr, "Mathematica Kernel not found.\n"); |
ox_printf("Mathematica Kernel not found.\n"); |
exit(1); |
exit(1); |
} |
} |
return 0; |
return 0; |
|
|
|
|
cmo *receive_mlo() |
cmo *receive_mlo() |
{ |
{ |
char *s; |
int type = MLGetNext(stdlink); |
int type; |
|
|
|
switch(type = MLGetNext(stdlink)) { |
switch(type) { |
case MLTKINT: |
case MLTKINT: |
return receive_mlo_zz(); |
return receive_mlo_zz(); |
case MLTKSTR: |
case MLTKSTR: |
return receive_mlo_string(); |
return receive_mlo_string(); |
case MLTKREAL: |
case MLTKREAL: |
/* Yet we have no implementation of CMO_DOUBLE... */ |
return receive_mlo_real(); |
fprintf(stderr, "--debug: MLO == MLTKREAL.\n"); |
|
MLGetString(stdlink, &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"); |
ox_printf("MLTKERR()"); |
return (cmo *)make_error_object(ERROR_ID_FAILURE_MLINK, new_cmo_null()); |
return (cmo *)make_error_object(ERROR_ID_FAILURE_MLINK, new_cmo_null()); |
default: |
default: |
fprintf(stderr, "--debug: MLO(%d) is unknown.\n", type); |
ox_printf("MLO is broken?(%d)", type); |
MLGetString(stdlink, &s); |
return NULL; |
fprintf(stderr, "--debug: \"%s\"\n", s); |
|
return (cmo *)new_cmo_string(s); |
|
} |
} |
} |
} |
|
|
Line 268 int send_mlo(cmo *m) |
|
Line 279 int send_mlo(cmo *m) |
|
|
|
int ml_evaluateStringByLocalParser(char *str) |
int ml_evaluateStringByLocalParser(char *str) |
{ |
{ |
|
ox_printf("ox_evaluateString(%s)\n", str); |
|
MLPutFunction(stdlink, "EvaluatePacket", 1); |
MLPutFunction(stdlink, "ToExpression", 1); |
MLPutFunction(stdlink, "ToExpression", 1); |
MLPutString(stdlink, str); |
MLPutString(stdlink, str); |
MLEndPacket(stdlink); |
MLEndPacket(stdlink); |
Line 276 int ml_evaluateStringByLocalParser(char *str) |
|
Line 289 int ml_evaluateStringByLocalParser(char *str) |
|
int ml_executeFunction(char *function, int argc, cmo *argv[]) |
int ml_executeFunction(char *function, int argc, cmo *argv[]) |
{ |
{ |
int i; |
int i; |
|
MLPutFunction(stdlink, "EvaluatePacket", 1); |
MLPutFunction(stdlink, function, argc); |
MLPutFunction(stdlink, function, argc); |
for (i=0; i<argc; i++) { |
for (i=0; i<argc; i++) { |
send_mlo(argv[i]); |
send_mlo(argv[i]); |