===================================================================
RCS file: /home/cvs/OpenXM/src/ox_math/mlo.c,v
retrieving revision 1.1
retrieving revision 1.11
diff -u -p -r1.1 -r1.11
--- OpenXM/src/ox_math/mlo.c	1999/11/29 12:09:58	1.1
+++ OpenXM/src/ox_math/mlo.c	2003/01/13 12:04:53	1.11
@@ -1,36 +1,57 @@
-/* -*- mode: C; coding: euc-japan -*- */
-/* $OpenXM$ */
+/* -*- mode: C -*- */
+/* $OpenXM: OpenXM/src/ox_math/mlo.c,v 1.10 2003/01/11 12:38:57 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.
+*/
 
 #include <stdio.h>
 #include <stdlib.h>
 #include <unistd.h>
-#include <gmp.h>
 #include <mathlink.h>
-#include "ox.h"
-#include "parse.h"
-#include "serv2.h"
+#include <ox_toolkit.h>
+#include "mlo.h"
+#include "sm.h"
 
+/* If this flag sets then we identify MLTKSYM to CMO_INDETERMINATE. */
 int flag_mlo_symbol = FLAG_MLTKSYM_IS_INDETERMINATE;
 
-/* MLINK はポインタ型. */
+/* MLINK is a indentifier of MathLink connection. */
 MLINK stdlink;
 
-typedef cmo mlo;
-typedef cmo_string mlo_string;
-typedef cmo_zz mlo_zz;
+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()
 {
     char *s;
     mlo  *m;
 
     MLGetString(stdlink, &s);
-    fprintf(stderr, "--debug: MLO == MLTKINT (%s).\n", s);
+    ox_printf("MLTKINT(%s)", s);
     m = (mlo *)new_cmo_zz_set_string(s);
     MLDisownString(stdlink, s);
     return m;
@@ -41,7 +62,7 @@ mlo *receive_mlo_string()
     char *s;
     mlo  *m;
     MLGetString(stdlink, &s);
-    fprintf(stderr, "--debug: MLO == MLTKSTR (\"%s\").\n", s);
+    ox_printf("MLTKSTR(\"%s\")", s);
     m = (cmo *)new_cmo_string(s);
     MLDisownString(stdlink, s);
     return m;
@@ -55,21 +76,35 @@ cmo *receive_mlo_function()
     int  i,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();
-    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++) {
-        fprintf(stderr, "  --debug: arg[%d]\n", i);
-        fflush(stderr);
+        ox_printf(" arg[%d]: ", i);
         ob = receive_mlo();
-        append_cmo_list((cmo_list *)m, ob);
+        ox_printf(", ");
+        list_append((cmo_list *)m, ob);
     }
 
     MLDisownString(stdlink, s);
     return m;
 }
 
+#if 0
+cmo *convert_mlo_to_cmo(mlo *m)
+{
+	if (m->tag == MLO_FUNCTION) {
+		if (strcmp(((mlo_function *)m)->function, "List") == 0) {
+			return convert_mlo_function_list_to_cmo_list(m);
+		}
+	}
+	return m;
+}
+#endif
+
+#define MLO_FUNCTION   (CMO_PRIVATE+1)
+
 mlo_function *new_mlo_function(char *function)
 {
     mlo_function *c = malloc(sizeof(mlo_function));
@@ -88,15 +123,13 @@ cmo *receive_mlo_function_newer()
     int  i,n;
 
     MLGetFunction(stdlink, &s, &n);
-#ifdef DEBUG
-    fprintf(stderr, "--debug: MLO == MLTKFUNC, (%s[#%d])\n", s, n);
-#endif
+    ox_printf("MLTKFUNC(%s[#%d])", s, n);
     m = new_mlo_function(s);
     for (i=0; i<n; i++) {
-        fprintf(stderr, "--debug: arg[%d]\n", i);
-        fflush(stderr);
+        ox_printf(" arg[%d]: ", i);
         ob = receive_mlo();
-        append_cmo_list((cmo_list *)m, ob);
+        ox_printf(", ");
+        list_append((cmo_list *)m, ob);
     }
 
     MLDisownString(stdlink, s);
@@ -109,9 +142,7 @@ cmo *receive_mlo_symbol()
     char *s;
 
     MLGetSymbol(stdlink, &s);
-#ifdef DEBUG
-    fprintf(stderr, "--debug: MLO == MLTKSYM, (%s).\n", s);
-#endif
+    ox_printf("MLTKSYM(%s)", s);
     if(flag_mlo_symbol == FLAG_MLTKSYM_IS_INDETERMINATE) {
         ob = new_cmo_indeterminate(new_cmo_string(s));
     }else {
@@ -121,7 +152,7 @@ cmo *receive_mlo_symbol()
     return ob;
 }
 
-/* Mathematica を起動する. */
+/* starting a MathLink connection. */
 int ml_init()
 {
     int argc = 2;
@@ -129,12 +160,13 @@ int ml_init()
 
     if(MLInitialize(NULL) == NULL
        || (stdlink = MLOpen(argc, argv)) == NULL) {
-        fprintf(stderr, "Mathematica Kernel not found.\n");
+        ox_printf("Mathematica Kernel not found.\n");
         exit(1);
     }
     return 0;
 }
 
+/* closing a MathLink connection. */
 int ml_exit()
 {
     /* quit Mathematica then close the link */
@@ -142,43 +174,43 @@ int ml_exit()
     MLClose(stdlink);
 }
 
-cmo *ml_get_object()
+/* Never forget call ml_select() before calling receive_mlo(). */
+int ml_select()
 {
     /* skip any packets before the first ReturnPacket */
     while (MLNextPacket(stdlink) != RETURNPKT) {
         usleep(10);
         MLNewPacket(stdlink);
     }
-    return receive_mlo();
 }
 
+/* Never forget call ml_flush() after calling send_mlo(). */
+int ml_flush()
+{
+    MLEndPacket(stdlink);
+}
+
 cmo *receive_mlo()
 {
-    char *s;
-    int type;
+    int type = MLGetNext(stdlink);
 
-    switch(type = MLGetNext(stdlink)) {
+    switch(type) {
     case MLTKINT:
         return receive_mlo_zz();
     case MLTKSTR:
         return receive_mlo_string();
     case MLTKREAL:
-        /* double はまだ... */
-        fprintf(stderr, "--debug: MLO == MLTKREAL.\n");
-        MLGetString(stdlink, &s);
-        return (cmo *)new_cmo_string(s);
+        return receive_mlo_real();
     case MLTKSYM:
         return receive_mlo_symbol();
     case MLTKFUNC:
         return receive_mlo_function();
     case MLTKERR:
-        fprintf(stderr, "--debug: MLO == MLTKERR.\n");
+        ox_printf("MLTKERR()");
         return (cmo *)make_error_object(ERROR_ID_FAILURE_MLINK, new_cmo_null());
     default:
-        fprintf(stderr, "--debug: MLO(%d) is unknown.\n", type);
-        MLGetString(stdlink, &s);
-        fprintf(stderr, "--debug: \"%s\"\n", s);
-        return (cmo *)new_cmo_string(s);
+        ox_printf("MLO is broken?(%d)", type);
+        return NULL;
     }
 }
 
@@ -197,29 +229,23 @@ int send_mlo_zz(cmo *m)
 {
     char *s;
     MLPutFunction(stdlink, "ToExpression", 1);
-    s = convert_cmo_to_string(m);
+    s = new_string_set_cmo(m);
     MLPutString(stdlink, s);
 }
 
 int send_mlo_list(cmo *c)
 {
     char *s;
-    cell *cp = ((cmo_list *)c)->head;
-    int len = length_cmo_list((cmo_list *)c);
+    cell *cp = list_first((cmo_list *)c);
+    int len = list_length((cmo_list *)c);
 
     MLPutFunction(stdlink, "List", len);
-    while(cp->next != NULL) {
+    while(!list_endof(c, cp)) {
         send_mlo(cp->cmo);
-        cp = cp->next;
+        cp = list_next(cp);
     }
 }
 
-int ml_sendObject(cmo *m)
-{
-    send_mlo(m);
-    MLEndPacket(stdlink);
-}
-
 int send_mlo(cmo *m)
 {
     char *s;
@@ -245,7 +271,7 @@ int send_mlo(cmo *m)
         break;
     default:
         MLPutFunction(stdlink, "ToExpression", 1);
-        s = convert_cmo_to_string(m);
+        s = new_string_set_cmo(m);
         MLPutString(stdlink, s);
         break;
     }
@@ -253,6 +279,8 @@ int send_mlo(cmo *m)
 
 int ml_evaluateStringByLocalParser(char *str)
 {
+    ox_printf("ox_evaluateString(%s)\n", str);
+    MLPutFunction(stdlink, "EvaluatePacket", 1);
     MLPutFunction(stdlink, "ToExpression", 1);
     MLPutString(stdlink, str);
     MLEndPacket(stdlink);
@@ -261,6 +289,7 @@ int ml_evaluateStringByLocalParser(char *str)
 int ml_executeFunction(char *function, int argc, cmo *argv[])
 {
     int i;
+    MLPutFunction(stdlink, "EvaluatePacket", 1);
     MLPutFunction(stdlink, function, argc);
     for (i=0; i<argc; i++) {
         send_mlo(argv[i]);