Mercurial > hg > plml

changeset 13:440734a35533

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Almost working work around.
author samer
date Wed, 01 Feb 2012 00:27:48 +0000
parents 85c19a49cf7e
children e1f87438e34c
files cpp/Makefile cpp/plml.cpp prolog/plml.pl
diffstat 3 files changed, 72 insertions(+), 67 deletions(-) [+]
line wrap: on
line diff
--- a/cpp/Makefile	Mon Jan 30 23:10:44 2012 +0000
+++ b/cpp/Makefile	Wed Feb 01 00:27:48 2012 +0000
@@ -4,7 +4,7 @@
 TARGET=plml.$(SO)
 INCML=$(MATLAB)/extern/include
 LIBML=$(MATLAB)/bin/$(MLARCH)
-PLLDFLAGS=$(CXX) $(INCLUDES) -I$(INCML) -Wall
+PLLDFLAGS=$(CXX) $(INCLUDES) -I$(INCML) -Wall -g3
 
 .SUFFIXES: .cpp .o .so .dylib
 
--- a/cpp/plml.cpp	Mon Jan 30 23:10:44 2012 +0000
+++ b/cpp/plml.cpp	Wed Feb 01 00:27:48 2012 +0000
@@ -88,7 +88,7 @@
 #define BUFSIZE  32768 // buffer for matlab output
 #define MAXCMDLEN 256
 // #define EVALFMT "t__ex=[];\ntry\n%s\ncatch t__ex\ndisp(getReport(t__ex))\nend"
-#define EVALFMT "lasterr(''); %s\nt__ex=lasterr;if ~isempty(t__ex), beep; end"
+#define EVALFMT "lasterr('');disp(' ');%s\nt__ex=lasterr;"
 
 using namespace std;
 
@@ -473,6 +473,22 @@
   }
 }
 
+
+static int raise_exception(const char *msg) {
+  printf("\n!! raising exception: %s\n",msg);
+  // return FALSE;
+ 
+  term_t ex = PL_new_term_ref();
+  int rc;
+
+  rc = PL_unify_term(ex, PL_FUNCTOR_CHARS, "error", 2,
+			 PL_FUNCTOR_CHARS, "plml_error", 1,
+			 PL_CHARS, msg,
+			 PL_VARIABLE);
+
+  return PL_raise_exception(ex);
+}
+
 /*
  * Workspace variable handling
  */
@@ -485,35 +501,40 @@
 foreign_t mlWSAlloc(term_t eng, term_t blob) {
   // if varname is already bound, we should check
   // that the name has not been used in the workspace
-  try {
-	 class  eng *engine=findEngine(eng);
-    struct wsvar x;
-	 int rc;
+  class eng *engine;
+  try { engine=findEngine(eng); }
+  catch (PlException ex) { return ex.plThrow(); }
 
-    // in a threaded world, there would either need to be precisely
-    // one engine per thread (so that there are no race conditions on
-    // the Matlab side) or else these lines (down to PL_unify_blob)
-    // need to be atomic.
-    x.engine = engine->ep;
-	 x.id     = engine->id;
+  //printf("-- Entering mlWSALLOC         \r"); fflush(stdout); 
+  struct wsvar x;
+  int rc;
 
-    if (engEvalString(x.engine, "t__0=uniquevar([]);")) 
-		 throw PlException("Cannot execute uniquevar");
+  x.engine = engine->ep;
+  x.id     = engine->id;
 
-    memset(x.name,sizeof(x.name),0);
-	 mxArray *newname=engGetVariable(x.engine, "t__0");
-	 if (newname==NULL) {
-		 engEvalString(x.engine,"clear(t__0)"); // half arsed attempt to fix variable leak
-		 throw PlException("Cannot get new variable name.");
-    }
-	 rc = mxGetString(newname,x.name, sizeof(x.name));
-	 mxDestroyArray(newname);
-    if (rc) throw PlException("Cannot read new variable name.");
+  // printf("-- mlWSAlloc: Calling uniquevar...       \r"); fflush(stdout); 
+  if (engEvalString(x.engine, "t__0=uniquevar([])")) {
+	  return raise_exception("mlWSAlloc: Cannot execute uniquevar");
+  }
 
-    return PL_unify_blob(blob,&x,sizeof(x),&ws_blob);
-  } catch (PlException &e) { 
-    return e.plThrow(); 
+  // fputs("\n>",stdout); fputs(engine->outbuf,stdout); fputs("<\n",stdout);
+  if (strlen(engine->outbuf)==0) {
+	  return raise_exception("mlWSAlloc: Empty output buffer.");
   }
+  memset(x.name,sizeof(x.name),0);
+  // printf(" - mlWSAlloc: Getting variable name...        \r"); fflush(stdout); 
+  mxArray *newname=engGetVariable(x.engine, "t__0");
+  if (newname==NULL) {
+	  return raise_exception("mlWSAlloc: Cannot get new variable name.");
+  }
+  rc = mxGetString(newname,x.name, sizeof(x.name));
+  mxDestroyArray(newname);
+  if (rc) {
+	  return raise_exception("mlWSAlloc: Cannot read new variable name.");
+  }
+
+  // printf("                                                  \r"); fflush(stdout); 
+  return PL_unify_blob(blob,&x,sizeof(x),&ws_blob);
 }
 
 foreign_t mlWSName(term_t blob, term_t name, term_t engine) {
@@ -533,9 +554,9 @@
 foreign_t mlWSGet(term_t var, term_t val) {
   try { 
     struct wsvar *x = term_to_wsvar(var);
-	 printf("-- Entering mlWSGET         \r"); fflush(stdout); 
+	 //printf(" - mlWSGET                 \r"); fflush(stdout); 
     mxArray *p = engGetVariable(x->engine, x->name);
-	 printf("-- Leaving mlWSGET         \r"); fflush(stdout); 
+	 //printf("                           \r"); fflush(stdout); 
     return PL_unify_blob(val, (void **)&p, sizeof(p), &mx_blob);
   } catch (PlException &e) { 
     return e.plThrow(); 
@@ -560,7 +581,7 @@
 // Call a Matlab engine to execute the given command
 foreign_t mlExec(term_t engine, term_t cmd) 
 {
-  printf("-- Entering mlEXEC         \r"); fflush(stdout); 
+  // printf(" - mlExec: Entering                 \r"); fflush(stdout); 
   try {
     eng *eng=findEngine(engine);
 	 const char *cmdstr=PlTerm(cmd);
@@ -580,52 +601,35 @@
 	 eval_cmd = new char[cmdlen+strlen(EVALFMT)-1];
 	 if (eval_cmd==NULL) throw PlException("Failed to allocate memory for command");
 	 sprintf(eval_cmd, EVALFMT, cmdstr);
-	 printf("-- Calling Matlab engine...                 \r"); fflush(stdout);
+	 //printf("-- Calling Matlab engine...                 \r"); fflush(stdout);
 	 rc=engEvalString(eng->ep,eval_cmd);
-	 printf("-- Returned from Matlab engine...            \r"); fflush(stdout);
+	 //printf("-- Returned from Matlab engine...            \r"); fflush(stdout);
 	 delete [] eval_cmd;
 
-    if (rc) printf("** MATLAB evaluation error. Output buffer contains:\n");
+	 // EVALFMT starts with disp(' '). This means that the output buffer should
+	 // contain at least the 5 characters: ">> *\n". If they are not there,
+	 // something is terribly wrong and we must throw an exeption to avoid
+	 // locking up.
+    if (strlen(eng->outbuf)<5) {
+		 printf("\n** mlExec: evaluation error. Empty output buffer.\n");
+		 throw PlException("mlExec: empty output buffer");
+	 }
+    if (rc) printf("\n** mlExec: evaluation error. Output buffer contains:\n");
 	 // write whatever is in the output buffer now.
-    fputs(eng->outbuf,stdout);
+    fputs(eng->outbuf+5,stdout);
 
 	 if (PL_handle_signals()<0) {
-		 printf("** ml_exec: evaluation interrupted by signal.\n");
+		 printf("\n** mlExec: evaluation interrupted by signal.\n");
 		 return FALSE;
 	 }
 
-	 /* { 
-		 int rc;
-		 printf( "--- sleeping for 3 seconds\n");
-		 rc=usleep(3000000);
-		 //printf("press return.\n");
-		 //rc=getchar();
-		 printf( "--- returned %d.\n",rc);
-	 } */ 
-
-	 // SA 2010. Giving up any pretence of being thread-safe -
-	 // each engine is to be used by one Prolog thread ONLY.
-	 // If you want fancy threading stuff, do it in Prolog.
-	 
-
-	 printf("-- Getting last error...             \r"); fflush(stdout);
+	 //printf(" - mlExec: Getting last error...             \r"); fflush(stdout);
     mxArray *lasterr = engGetVariable(eng->ep, "t__ex");
-	 printf("-- Got last error (%p)             \r",lasterr); fflush(stdout);
-
-//	 if (PL_handle_signals()<0) {
-//		 printf("  * ml_exec: getting lasterr  interrupted by signal.\n");
-//		 return FALSE;
-//	 }
+	 //printf(" - mlExec: Got last error (%p)               \r",lasterr); fflush(stdout);
 
 	 if (!lasterr) {
-		 printf("** Failing due to inability to get lasterr.\n");
-		 return FALSE;
-
-		 //PlTerm msg=PlTerm("Failed to get Matlab lasterr.");
-		 //printf("Preparing lasterr=0 exception.\n");
-		 //PlException ex=PlException(msg);
-		 //printf("Throwing lasterr=0 exception.\n");
-		 //throw ex;
+		 printf("\n** mlExec: unable to get lasterr.\n");
+		 throw PlException("mlExec: unable to get lasterr");
 	}
     
     if (mxGetNumberOfElements(lasterr)>0) {
@@ -646,10 +650,10 @@
 	 } else mxDestroyArray(lasterr);
     
     // if we've got this far, then everything went well, so
-	 printf("-- Returning from mlEXEC                \r"); fflush(stdout);
+	 printf("                                        \r"); fflush(stdout); 
 	 return TRUE;
   } catch (PlException &e) { 
-	 printf("** Throwing exception\n");
+	 printf("\n** mlExec: Throwing exception\n");
     return e.plThrow(); 
   }
 }
--- a/prolog/plml.pl	Mon Jan 30 23:10:44 2012 +0000
+++ b/prolog/plml.pl	Wed Feb 01 00:27:48 2012 +0000
@@ -338,7 +338,7 @@
 %  even when multiple values are required.
 ml_eval(Id,X,Types,Vals) :-
 	maplist(alloc_ws(Id),Types,Vars), 
-	ml_exec(Id,hide(wsx(Vars)=X)), flush_output, 
+	ml_exec(Id,hide(wsx(Vars)=X)), 
 	maplist(convert_ws,Types,Vars,Vals).
 
 alloc_ws(I,_,Z) :- mlWSALLOC(I,Z).
@@ -625,7 +625,8 @@
 	bt_call(db_save_all(I,ws(Z),L,Size), db_drop_all(I,L,Size)).
 
 % Most other conversions from ws(_) go via mx(_)
-convert_ws(T,Z,A) :- mlWSGET(Z,X), convert_mx(T,X,A).
+convert_ws(T,Z,A) :- 
+	mlWSGET(Z,X), convert_mx(T,X,A).
 
 
 %% convert_mx( +Type:type, +In:mx_blob, -Out:Type) is det.