[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.13 and 1.16

version 1.13, 2003/01/15 10:46:09 version 1.16, 2003/03/16 16:58:48
Line 1 
Line 1 
 /* -*- mode: C -*- */  /* -*- mode: C -*- */
 /* $OpenXM: OpenXM/src/ox_math/mlo.c,v 1.12 2003/01/15 05:08:10 ohara Exp $ */  /* $OpenXM: OpenXM/src/ox_math/mlo.c,v 1.15 2003/02/12 08:28:40 ohara Exp $ */
   
 /*  /*
    Copyright (C) Katsuyoshi OHARA, 2000.     Copyright (C) Katsuyoshi OHARA, 2000.
Line 30  static int ml_clear_interruption();
Line 30  static int ml_clear_interruption();
 static int ml_clear_abortion();  static int ml_clear_abortion();
 static mlo *ml_return0();  static mlo *ml_return0();
   
 /* #define STATE_NONE */  
 #define STATE_INTERRUPTED         1  
 #define STATE_ABORTED             2  
 #define STATE_RESERVE_INTERRUPTION 4  
 #define STATE_RESERVE_ABORTION    8  
 #define STATE_IDLE                16  
   
 static unsigned state = 0;  
   
 static int ml_current_packet = -1;  static int ml_current_packet = -1;
   
   static double mathkernel_version;
   static char *mathkernel_versionstring = NULL;
   
 /* 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;
   
   static unsigned flag_ml_state = 0;
   
   /* state management for the OpenXM robust interruption */
   unsigned ml_state_set(unsigned fl)
   {
       return flag_ml_state |= fl;
   }
   
   unsigned ml_state_clear(unsigned fl)
   {
       return flag_ml_state &= ~fl;
   }
   
   unsigned ml_state(unsigned fl)
   {
       return (flag_ml_state & fl);
   }
   
   void ml_state_clear_all()
   {
       flag_ml_state = 0;
   }
   
 mlo *receive_mlo_real()  mlo *receive_mlo_real()
 {  {
     char *s;      double d;
     cmo *ob;      MLGetReal(stdlink, &d);
     /* Yet we have no implementation of CMO_DOUBLE... */      ox_printf("%lf", d);
     MLGetString(stdlink, &s);      return new_cmo_double(d);
     ox_printf("MLTKREAL(%s)", s);  
     ob = (cmo *)new_cmo_string(s);  
     MLDisownString(stdlink, s);  
     return ob;  
 }  }
   
 mlo *receive_mlo_error()  mlo *receive_mlo_error()
Line 74  mlo *receive_mlo_zz()
Line 87  mlo *receive_mlo_zz()
     mlo  *m;      mlo  *m;
   
     MLGetString(stdlink, &s);      MLGetString(stdlink, &s);
     ox_printf("MLTKINT(%s)", s);      ox_printf("%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 85  mlo *receive_mlo_string()
Line 98  mlo *receive_mlo_string()
     char *s;      char *s;
     mlo  *m;      mlo  *m;
     MLGetString(stdlink, &s);      MLGetString(stdlink, &s);
     ox_printf("MLTKSTR(\"%s\")", s);      ox_printf("\"%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 99  cmo *receive_mlo_function()
Line 112  cmo *receive_mlo_function()
     int  i,n;      int  i,n;
   
     MLGetFunction(stdlink, &s, &n);      MLGetFunction(stdlink, &s, &n);
     ox_printf("MLTKFUNC(%s[#%d])", s, n);      ox_printf("%s#%d[", s, n);
     m = new_cmo_list();      m = (cmo *)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++) {
         ox_printf(" arg[%d]: ", i);  
         ob = receive_mlo();          ob = receive_mlo();
         ox_printf(", ");          ox_printf(", ");
         list_append((cmo_list *)m, ob);          list_append((cmo_list *)m, ob);
     }      }
       ox_printf("]");
     MLDisownString(stdlink, s);      MLDisownString(stdlink, s);
     return m;      return m;
 }  }
Line 146  cmo *receive_mlo_function_newer()
Line 158  cmo *receive_mlo_function_newer()
     int  i,n;      int  i,n;
   
     MLGetFunction(stdlink, &s, &n);      MLGetFunction(stdlink, &s, &n);
     ox_printf("MLTKFUNC(%s[#%d])", s, n);      ox_printf("%s#%d[", s, n);
     m = new_mlo_function(s);      m = new_mlo_function(s);
     for (i=0; i<n; i++) {      for (i=0; i<n; i++) {
         ox_printf(" arg[%d]: ", i);  
         ob = receive_mlo();          ob = receive_mlo();
         ox_printf(", ");          ox_printf(", ");
         list_append((cmo_list *)m, ob);          list_append((cmo_list *)m, ob);
     }      }
       ox_printf("]");
   
     MLDisownString(stdlink, s);      MLDisownString(stdlink, s);
     return (cmo *)m;      return (cmo *)m;
Line 167  cmo *receive_mlo_symbol()
Line 179  cmo *receive_mlo_symbol()
     MLGetSymbol(stdlink, &s);      MLGetSymbol(stdlink, &s);
     ox_printf("MLTKSYM(%s)", s);      ox_printf("MLTKSYM(%s)", s);
     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 = (cmo *)new_cmo_indeterminate((cmo *)new_cmo_string(s));
     }else {      }else {
         ob = new_cmo_string(s);          ob = (cmo *)new_cmo_string(s);
     }      }
     MLDisownString(stdlink, s);      MLDisownString(stdlink, s);
     return ob;      return ob;
Line 186  int ml_init()
Line 198  int ml_init()
         ox_printf("Mathematica Kernel not found.\n");          ox_printf("Mathematica Kernel not found.\n");
         exit(1);          exit(1);
     }      }
       /* set the version of Mathematica kernel. */
       ml_evaluateStringByLocalParser("$VersionNumber");
       mathkernel_version = ((cmo_double *)ml_return())->d;
       ml_evaluateStringByLocalParser("$Version");
       mathkernel_versionstring = ((cmo_string *)ml_return())->s;
       ox_printf("Mathematica %lf <%s>\n",
                 mathkernel_version, mathkernel_versionstring);
     return 0;      return 0;
 }  }
   
Line 200  int ml_exit()
Line 219  int ml_exit()
 /* Remember calling ml_select() before ml_return(). */  /* Remember calling ml_select() before ml_return(). */
 int ml_select()  int ml_select()
 {  {
       int i=0;
       MLFlush(stdlink);
     while(!MLReady(stdlink)) {      while(!MLReady(stdlink)) {
 #if 0          if (i==0 && ml_state(RESERVE_INTERRUPTION)) {
         if (state == STATE_RESERVE_INTERRUPTION) {  
             ml_interrupt();              ml_interrupt();
         }else if (state == STATE_RESERVE_ABORTION) {              i++;
             ml_abort();  
         }          }
 #endif  
         usleep(10);          usleep(10);
     }      }
 }  }
Line 236  cmo *receive_mlo()
Line 254  cmo *receive_mlo()
     case MLTKERR:      case MLTKERR:
         return (cmo *)receive_mlo_error();          return (cmo *)receive_mlo_error();
     default:      default:
         ox_printf("MLO is broken?(%d)", type);          ox_printf("broken MLO\(%d)", type);
         return NULL;          return NULL;
     }      }
 }  }
Line 262  static int send_mlo_zz(cmo *m)
Line 280  static int send_mlo_zz(cmo *m)
   
 static int send_mlo_list(cmo *c)  static int send_mlo_list(cmo *c)
 {  {
     char *s;  
     cell *cp = list_first((cmo_list *)c);      cell *cp = list_first((cmo_list *)c);
     int len = list_length((cmo_list *)c);      int len = list_length((cmo_list *)c);
   
Line 275  static int send_mlo_list(cmo *c)
Line 292  static int send_mlo_list(cmo *c)
   
 int send_mlo(cmo *m)  int send_mlo(cmo *m)
 {  {
     char *s;  
     switch(m->tag) {      switch(m->tag) {
     case CMO_INT32:      case CMO_INT32:
         send_mlo_int32(m);          send_mlo_int32(m);
Line 298  int send_mlo(cmo *m)
Line 314  int send_mlo(cmo *m)
         break;          break;
     default:      default:
         MLPutFunction(stdlink, "ToExpression", 1);          MLPutFunction(stdlink, "ToExpression", 1);
         s = new_string_set_cmo(m);          MLPutString(stdlink, new_string_set_cmo(m));
         MLPutString(stdlink, s);  
         break;          break;
     }      }
 }  }
Line 342  int ml_new_packet()
Line 357  int ml_new_packet()
 /* Remember calling ml_new_packet() after ml_read_packet(). */  /* Remember calling ml_new_packet() after ml_read_packet(). */
 int ml_read_packet()  int ml_read_packet()
 {  {
     int ob=NULL;  
     int pkt = ml_next_packet();      int pkt = ml_next_packet();
     switch(pkt) {      switch(pkt) {
     case MENUPKT:      case MENUPKT:
Line 394  static int ml_read_menupacket()
Line 408  static int ml_read_menupacket()
 static int ml_read_textpacket()  static int ml_read_textpacket()
 {  {
     char *s;      char *s;
     int n;  
     int type = MLGetNext(stdlink);      int type = MLGetNext(stdlink);
     if (type == MLTKSTR) {      if (type == MLTKSTR) {
         MLGetString(stdlink, &s);          MLGetString(stdlink, &s);
         ox_printf("TEXTPKT[MLTKSTR(%s)]", s);          ox_printf("TEXTPKT[\"%s\"]", s);
         MLDisownString(stdlink, s);          MLDisownString(stdlink, s);
     }else {      }else {
         ox_printf("TEXTPKT is broken? (%d)", type);          ox_printf("TEXTPKT is broken? (%d)", type);
Line 419  int ml_interrupt()
Line 432  int ml_interrupt()
     /* On UNIX, the MLPutMessage(process, MLInterruptMessage)      /* On UNIX, the MLPutMessage(process, MLInterruptMessage)
        sends ``SIGINT" to the process running on the local machine. */         sends ``SIGINT" to the process running on the local machine. */
     MLPutMessage(stdlink, MLInterruptMessage);      MLPutMessage(stdlink, MLInterruptMessage);
     state = STATE_INTERRUPTED;      ml_state_set(INTERRUPTED);
 }  }
   
 /* Remark:  /* Remark:
Line 441  static int ml_clear_interruption()
Line 454  static int ml_clear_interruption()
 {  {
     if (ml_read_packet() == MENUPKT) {      if (ml_read_packet() == MENUPKT) {
         MLPutString(stdlink, "\n");          MLPutString(stdlink, "\n");
           ox_printf("MLPutString(\"\\n\");\n");
         ml_new_packet();          ml_new_packet();
         if(ml_read_packet() == MENUPKT) {          if(ml_read_packet() == MENUPKT) {
             MLPutString(stdlink, "a");              MLPutString(stdlink, "a");
               ox_printf("MLPutString(\"a\");\n");
             ml_new_packet();              ml_new_packet();
             if(ml_read_packet() == TEXTPKT) {              if(ml_read_packet() == TEXTPKT) {
                 ml_new_packet();                  ml_new_packet();
                 ox_printf("END of ml_clear_interruption()\n");                  ox_printf("\n---END of ml_clear_interruption()---\n");
                 state = 0;  
                 return 0; /* success */                  return 0; /* success */
             }              }
         }          }
Line 461  static int ml_clear_interruption()
Line 475  static int ml_clear_interruption()
 int ml_abort()  int ml_abort()
 {  {
     MLPutMessage(stdlink, MLAbortMessage);      MLPutMessage(stdlink, MLAbortMessage);
     state = STATE_ABORTED;      ml_state_set(ABORTED);
 }  }
   
 /* broken */  /* broken */
Line 477  static int ml_clear_abortion()
Line 491  static int ml_clear_abortion()
         ox_printf("MLError=%s\n", MLErrorMessage(stdlink));          ox_printf("MLError=%s\n", MLErrorMessage(stdlink));
     }      }
     receive_mlo();      receive_mlo();
     state = 0;      ml_state_clear_all();
 }  }
   
 static mlo *ml_return0()  static mlo *ml_return0()
Line 496  static mlo *ml_return0()
Line 510  static mlo *ml_return0()
     }      }
     ob = ml_read_returnpacket();      ob = ml_read_returnpacket();
     ml_new_packet();      ml_new_packet();
     ox_printf("END of ml_return0()\n");      ox_printf("\n---END of ml_return0()---\n");
     return ob;      return ob;
 }  }
   
 #if 0  
 mlo *ml_return()  mlo *ml_return()
 {  {
     int type;  
     mlo *ob;      mlo *ob;
     if (state == STATE_INTERRUPTED) {      if (ml_state(INTERRUPTED)) {
         if ((type = ml_next_packet()) == RETURNPKT) {          if (ml_next_packet() == RETURNPKT) {
               /* a computation has done before the interruption */
             ob = ml_return0();              ob = ml_return0();
             ml_clear_interruption();              ml_clear_interruption();
         }else {          }else {
             ob = new_cmo_indeterminate(new_cmo_string("$Aborted"));  
             ml_clear_interruption();              ml_clear_interruption();
 /*          ob = ml_return0(); /* need to read RETURNPKT[MLTKSYM($Aborted)] */              ml_evaluateStringByLocalParser("0"); /* need for 4.x */
               ob = ml_return0();                   /* ReturnPacket[$Aborted] */
               ml_return0();                        /* need for 4.x */
         }          }
     }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 {      }else {
         ob = ml_return0();          ob = ml_return0();
     }      }
Legend:
Removed from v.1.13  
changed lines
  Added in v.1.16
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>