version 1.6, 2000/03/10 12:38:46 |
version 1.10, 2003/01/11 12:38:57 |
|
|
/* -*- mode: C -*- */ |
/* -*- mode: C -*- */ |
/* $OpenXM: OpenXM/src/ox_math/mlo.c,v 1.5 2000/01/22 06:29:18 ohara Exp $ */ |
/* $OpenXM: OpenXM/src/ox_math/mlo.c,v 1.9 2000/12/03 21:46:52 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 30 mlo *receive_mlo_zz() |
|
Line 30 mlo *receive_mlo_zz() |
|
mlo *m; |
mlo *m; |
|
|
MLGetString(stdlink, &s); |
MLGetString(stdlink, &s); |
fprintf(stderr, "--debug: MLO == MLTKINT (%s).\n", s); |
fprintf(ox_stderr, "--debug: MLO == MLTKINT (%s).\n", 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 41 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); |
fprintf(ox_stderr, "--debug: MLO == MLTKSTR (\"%s\").\n", 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 55 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); |
fprintf(ox_stderr, "--debug: MLO == MLTKFUNC (%s[#%d]).\n", s, n); |
m = new_cmo_list(); |
m = new_cmo_list(); |
append_cmo_list((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); |
fprintf(ox_stderr, " --debug: arg[%d]\n", i); |
fflush(stderr); |
fflush(ox_stderr); |
ob = receive_mlo(); |
ob = receive_mlo(); |
append_cmo_list((cmo_list *)m, ob); |
list_append((cmo_list *)m, ob); |
} |
} |
|
|
MLDisownString(stdlink, s); |
MLDisownString(stdlink, s); |
Line 82 cmo *convert_mlo_to_cmo(mlo *m) |
|
Line 82 cmo *convert_mlo_to_cmo(mlo *m) |
|
} |
} |
#endif |
#endif |
|
|
|
#define MLO_FUNCTION (CMO_PRIVATE+1) |
|
|
mlo_function *new_mlo_function(char *function) |
mlo_function *new_mlo_function(char *function) |
{ |
{ |
mlo_function *c = malloc(sizeof(mlo_function)); |
mlo_function *c = malloc(sizeof(mlo_function)); |
Line 101 cmo *receive_mlo_function_newer() |
|
Line 103 cmo *receive_mlo_function_newer() |
|
|
|
MLGetFunction(stdlink, &s, &n); |
MLGetFunction(stdlink, &s, &n); |
#ifdef DEBUG |
#ifdef DEBUG |
fprintf(stderr, "--debug: MLO == MLTKFUNC, (%s[#%d])\n", s, n); |
fprintf(ox_stderr, "--debug: MLO == MLTKFUNC, (%s[#%d])\n", s, n); |
#endif |
#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); |
fprintf(ox_stderr, "--debug: arg[%d]\n", i); |
fflush(stderr); |
fflush(ox_stderr); |
ob = receive_mlo(); |
ob = receive_mlo(); |
append_cmo_list((cmo_list *)m, ob); |
list_append((cmo_list *)m, ob); |
} |
} |
|
|
MLDisownString(stdlink, s); |
MLDisownString(stdlink, s); |
Line 122 cmo *receive_mlo_symbol() |
|
Line 124 cmo *receive_mlo_symbol() |
|
|
|
MLGetSymbol(stdlink, &s); |
MLGetSymbol(stdlink, &s); |
#ifdef DEBUG |
#ifdef DEBUG |
fprintf(stderr, "--debug: MLO == MLTKSYM, (%s).\n", s); |
fprintf(ox_stderr, "--debug: MLO == MLTKSYM, (%s).\n", s); |
#endif |
#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)); |
|
|
|
|
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"); |
fprintf(ox_stderr, "Mathematica Kernel not found.\n"); |
exit(1); |
exit(1); |
} |
} |
return 0; |
return 0; |
Line 183 cmo *receive_mlo() |
|
Line 185 cmo *receive_mlo() |
|
return receive_mlo_string(); |
return receive_mlo_string(); |
case MLTKREAL: |
case MLTKREAL: |
/* Yet we have no implementation of CMO_DOUBLE... */ |
/* Yet we have no implementation of CMO_DOUBLE... */ |
fprintf(stderr, "--debug: MLO == MLTKREAL.\n"); |
fprintf(ox_stderr, "--debug: MLO == MLTKREAL.\n"); |
MLGetString(stdlink, &s); |
MLGetString(stdlink, &s); |
return (cmo *)new_cmo_string(s); |
return (cmo *)new_cmo_string(s); |
case MLTKSYM: |
case MLTKSYM: |
Line 191 cmo *receive_mlo() |
|
Line 193 cmo *receive_mlo() |
|
case MLTKFUNC: |
case MLTKFUNC: |
return receive_mlo_function(); |
return receive_mlo_function(); |
case MLTKERR: |
case MLTKERR: |
fprintf(stderr, "--debug: MLO == MLTKERR.\n"); |
fprintf(ox_stderr, "--debug: MLO == MLTKERR.\n"); |
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); |
fprintf(ox_stderr, "--debug: MLO(%d) is unknown.\n", type); |
MLGetString(stdlink, &s); |
MLGetString(stdlink, &s); |
fprintf(stderr, "--debug: \"%s\"\n", s); |
fprintf(ox_stderr, "--debug: \"%s\"\n", s); |
return (cmo *)new_cmo_string(s); |
return (cmo *)new_cmo_string(s); |
} |
} |
} |
} |
Line 223 int send_mlo_zz(cmo *m) |
|
Line 225 int send_mlo_zz(cmo *m) |
|
int send_mlo_list(cmo *c) |
int send_mlo_list(cmo *c) |
{ |
{ |
char *s; |
char *s; |
cell *cp = ((cmo_list *)c)->head; |
cell *cp = list_first((cmo_list *)c); |
int len = length_cmo_list((cmo_list *)c); |
int len = list_length((cmo_list *)c); |
|
|
MLPutFunction(stdlink, "List", len); |
MLPutFunction(stdlink, "List", len); |
while(cp->next != NULL) { |
while(!list_endof(c, cp)) { |
send_mlo(cp->cmo); |
send_mlo(cp->cmo); |
cp = cp->next; |
cp = list_next(cp); |
} |
} |
} |
} |
|
|