[BACK]Return to mlo.c CVS log [TXT][DIR] Up to [local] / OpenXM / src / ox_math

Diff for /OpenXM/src/ox_math/mlo.c between version 1.4 and 1.11

version 1.4, 2000/01/05 06:09:11 version 1.11, 2003/01/13 12:04:53
Line 1 
Line 1 
 /* -*- mode: C -*- */  /* -*- mode: C -*- */
 /* $OpenXM: OpenXM/src/ox_math/mlo.c,v 1.3 1999/12/14 09:31:55 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.
      Portions copyright 1999 Wolfram Research, Inc.
   
      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 <stdio.h>
 #include <stdlib.h>  #include <stdlib.h>
 #include <unistd.h>  #include <unistd.h>
 #include <gmp.h>  
 #include <mathlink.h>  #include <mathlink.h>
 #include "oxtag.h"  #include <ox_toolkit.h>
 #include "ox.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 17  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 34  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 48  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();
     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);          ox_printf(" arg[%d]: ", i);
         fflush(stderr);  
         ob = receive_mlo();          ob = receive_mlo();
         append_cmo_list((cmo_list *)m, ob);          ox_printf(", ");
           list_append((cmo_list *)m, ob);
     }      }
   
     MLDisownString(stdlink, s);      MLDisownString(stdlink, s);
Line 75  cmo *convert_mlo_to_cmo(mlo *m)
Line 103  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 93  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();
         append_cmo_list((cmo_list *)m, ob);          ox_printf(", ");
           list_append((cmo_list *)m, ob);
     }      }
   
     MLDisownString(stdlink, s);      MLDisownString(stdlink, s);
Line 114  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 {
Line 134  int ml_init()
Line 160  int ml_init()
   
     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;
Line 166  int ml_flush()
Line 192  int ml_flush()
   
 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 216  int send_mlo_zz(cmo *m)
Line 236  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);
     }      }
 }  }
   
Line 259  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 267  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]);
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.11
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>