[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.6 and 1.12

version 1.6, 2000/03/10 12:38:46 version 1.12, 2003/01/15 05:08:10
Line 1 
Line 1 
 /* -*- 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.11 2003/01/13 12:04:53 ohara Exp $ */
   
 /*  /*
    Copyright (C) Katsuyoshi OHARA, 2000.     Copyright (C) Katsuyoshi OHARA, 2000.
Line 16 
Line 16 
 #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"
   
   static int send_mlo_int32(cmo *m);
   static int send_mlo_string(cmo *m);
   static int send_mlo_zz(cmo *m);
   static int send_mlo_list(cmo *c);
   
   static mlo *ml_read_returnpacket();
   static int ml_read_menupacket();
   static int ml_read_textpacket();
   static int ml_clear_interruption();
   static int ml_clear_abortion();
   static mlo *ml_return0();
   
   /* #define STATE_NONE */
   #define STATE_INTERRUPTED         1
   #define STATE_ABORTED             2
   #define STATE_RESERVE_INTERRUTION 4
   #define STATE_RESERVE_ABORTION    8
   #define STATE_IDLE                16
   
   static unsigned state = 0;
   
   static int ml_current_packet = -1;
   
 /* 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;
   
 /* 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(errcode, 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 85  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 99  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 82  cmo *convert_mlo_to_cmo(mlo *m)
Line 126  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 100  cmo *receive_mlo_function_newer()
Line 146  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 121  cmo *receive_mlo_symbol()
Line 165  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 141  int ml_init()
Line 183  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 155  int ml_exit()
Line 197  int ml_exit()
     MLClose(stdlink);      MLClose(stdlink);
 }  }
   
 /* Never forget call ml_select() before calling receive_mlo(). */  /* Remember calling ml_select() before ml_return(). */
 int ml_select()  int ml_select()
 {  {
     /* skip any packets before the first ReturnPacket */      while(!MLReady(stdlink)) {
     while (MLNextPacket(stdlink) != RETURNPKT) {  #if 0
           if (state == STATE_RESERVE_INTERRUTION) {
               ml_interrupt();
           }else if (state == STATE_RESERVE_ABORTION) {
               ml_abort();
           }
   #endif
         usleep(10);          usleep(10);
         MLNewPacket(stdlink);  
     }      }
 }  }
   
Line 173  int ml_flush()
Line 220  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 (cmo *)receive_mlo_zz();
     case MLTKSTR:      case MLTKSTR:
         return receive_mlo_string();          return (cmo *)receive_mlo_string();
     case MLTKREAL:      case MLTKREAL:
         /* Yet we have no implementation of CMO_DOUBLE... */          return (cmo *)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 (cmo *)receive_mlo_symbol();
     case MLTKFUNC:      case MLTKFUNC:
         return receive_mlo_function();          return (cmo *)receive_mlo_function();
     case MLTKERR:      case MLTKERR:
         fprintf(stderr, "--debug: MLO == MLTKERR.\n");          return (cmo *)receive_mlo_error();
         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);  
     }      }
 }  }
   
 int send_mlo_int32(cmo *m)  static int send_mlo_int32(cmo *m)
 {  {
     MLPutInteger(stdlink, ((cmo_int32 *)m)->i);      MLPutInteger(stdlink, ((cmo_int32 *)m)->i);
 }  }
   
 int send_mlo_string(cmo *m)  static int send_mlo_string(cmo *m)
 {  {
     char *s = ((cmo_string *)m)->s;      char *s = ((cmo_string *)m)->s;
     MLPutString(stdlink, s);      MLPutString(stdlink, s);
 }  }
   
 int send_mlo_zz(cmo *m)  static int send_mlo_zz(cmo *m)
 {  {
     char *s;      char *s;
     MLPutFunction(stdlink, "ToExpression", 1);      MLPutFunction(stdlink, "ToExpression", 1);
Line 220  int send_mlo_zz(cmo *m)
Line 260  int send_mlo_zz(cmo *m)
     MLPutString(stdlink, s);      MLPutString(stdlink, s);
 }  }
   
 int send_mlo_list(cmo *c)  static 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 266  int send_mlo(cmo *m)
Line 306  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 274  int ml_evaluateStringByLocalParser(char *str)
Line 316  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]);
     }      }
     MLEndPacket(stdlink);      MLEndPacket(stdlink);
   }
   
   int ml_next_packet()
   {
       if (ml_current_packet < 0) {
           ml_current_packet = MLNextPacket(stdlink);
           ox_printf("PKT=%d ", ml_current_packet);
       }
       return ml_current_packet;
   }
   
   int ml_new_packet()
   {
       ml_current_packet = -1;
       MLNewPacket(stdlink);
   }
   
   /* Remember calling ml_new_packet() after ml_read_packet(). */
   int ml_read_packet()
   {
       int ob=NULL;
       int pkt = ml_next_packet();
       switch(pkt) {
       case MENUPKT:
           ml_read_menupacket();
           break;
       case TEXTPKT:
           ml_read_textpacket();
           break;
       case RETURNPKT:
           ml_read_returnpacket();
           break;
       case INPUTNAMEPKT:
           ox_printf("INPUTNAMEPKT[]");
           break;
       case ILLEGALPKT:
           ox_printf("ILLEGALPKT[]");
           break;
       case SUSPENDPKT:
           ox_printf("SUSPENDPKT[]");
           break;
       case RESUMEPKT:
           ox_printf("RESUMEPKT[]");
           break;
       default:
       }
       ox_printf("\n");
       return pkt;
   }
   
   static mlo *ml_read_returnpacket()
   {
       mlo *ob;
       ox_printf("RETURNPKT[");
       ob=receive_mlo();
       ox_printf("]");
   
       return ob;
   }
   
   static int ml_read_menupacket()
   {
       ox_printf("MENUPKT[");
       receive_mlo();
       ox_printf(", ");
       receive_mlo();
       ox_printf("]");
   }
   
   static int ml_read_textpacket()
   {
       char *s;
       int n;
       int type = MLGetNext(stdlink);
       if (type == MLTKSTR) {
           MLGetString(stdlink, &s);
           ox_printf("TEXTPKT[MLTKSTR(%s)]", s);
           MLDisownString(stdlink, s);
       }else {
           ox_printf("TEXTPKT is broken? (%d)", type);
       }
   }
   
   /* References:
   [1] Todd Gayley: "Re: How to interrupt a running evaluation in MathLink",
   http://forums.wolfram.com/mathgroup/archive/1999/Apr/msg00174.html
   
   From: tgayley@linkobjects.com (Todd Gayley)
   To: mathgroup@smc.vnet.net
   Subject: [mg17015] Re: How to interrupt a running evaluation in MathLink
   */
   
   int ml_interrupt()
   {
       /* On UNIX, the MLPutMessage(process, MLInterruptMessage)
          sends ``SIGINT" to the process running on the local machine. */
       MLPutMessage(stdlink, MLInterruptMessage);
       state = STATE_INTERRUPTED;
   }
   
   /* Remark:
   read MENUPKT[MLTKINT(1), MLTKSTR("Interrupt> ")]
   write "\n"
   read MENUPKT[MLTKINT(0), MLTKSTR("Interrupt> ")]
   write "a"
   read TEXTPKT[Your options are:
           abort (or a) to abort current calculation
           continue (or c) to continue
           exit (or quit) to exit Mathematica
           inspect (or i) to enter an interactive dialog
           show (or s) to show current operation (and then continue)
           trace (or t) to show all operations
   ]
   */
   
   static int ml_clear_interruption()
   {
       if (ml_read_packet() == MENUPKT) {
           MLPutString(stdlink, "\n");
           ml_new_packet();
           if(ml_read_packet() == MENUPKT) {
               MLPutString(stdlink, "a");
               ml_new_packet();
               if(ml_read_packet() == TEXTPKT) {
                   ml_new_packet();
                   ox_printf("END of ml_clear_interruption()\n");
                   state = 0;
                   return 0; /* success */
               }
           }
       }
       ml_new_packet();
       ox_printf("Ooops!\n");
       return -1;
   }
   
   int ml_abort()
   {
       MLPutMessage(stdlink, MLAbortMessage);
       state = STATE_ABORTED;
   }
   
   /* broken */
   static int ml_clear_abortion()
   {
       while(ml_read_packet()==MENUPKT) {
           ml_new_packet();
       }
       MLPutString(stdlink, "a");
       ml_new_packet();
       ox_printf("aborted.\n");
       if (MLError(stdlink)) {
           ox_printf("MLError=%s\n", MLErrorMessage(stdlink));
       }
       receive_mlo();
       state = 0;
   }
   
   static mlo *ml_return0()
   {
       mlo *ob;
       int pkt;
       /* seeking to RETURNPKT */
       while((pkt = ml_next_packet()) != RETURNPKT) {
           if (pkt == ILLEGALPKT) {
               ob = receive_mlo_error();
               ml_new_packet(); /* OK? */
               return ob;
           }
           ml_read_packet(); /* debug only */
           ml_new_packet();
       }
       ob = ml_read_returnpacket();
       ml_new_packet();
       ox_printf("END of ml_return0()\n");
       return ob;
   }
   
   #if 0
   mlo *ml_return()
   {
       int type;
       mlo *ob;
       if (state == STATE_INTERRUPTED) {
           if ((type = ml_next_packet()) == RETURNPKT) {
               ob = ml_return0();
               ml_clear_interruption();
           }else {
               ob = new_cmo_indeterminate(new_cmo_string("$Aborted"));
               ml_clear_interruption();
   /*          ob = ml_return0(); /* need to read RETURNPKT[MLTKSYM($Aborted)] */
           }
       }else {
           ob = ml_return0();
       }
       return ob;
   }
   #endif
   
   mlo *ml_return()
   {
       mlo *ob;
       if (state == STATE_INTERRUPTED) {
           if (ml_next_packet() == RETURNPKT) {
               ob = ml_return0();
           }else {
               ob = (mlo *)new_cmo_indeterminate(new_cmo_string("$Aborted"));
           }
           ml_clear_interruption();
       }else {
           ob = ml_return0();
       }
       return ob;
 }  }
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.12
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>