samer@0: /*
samer@0:  * Prolog-MATLAB interface
samer@0:  * Samer Abdallah (2004)
samer@0:  * Christophe Rhodes (2005)
samer@0:  *
samer@0:  * These are some foreign for procedures to enable SWI Prolog to run
samer@0:  * and communicate with a MATLAB computational engine, which is
samer@0:  * started as a separate process on the local or a remote machine.
samer@0:  *
samer@0:  * Communication is handled by the MATLAB engine API (engFoo
samer@0:  * functions) which in turn use a pair of pipes connected to the
samer@0:  * standard input and output of the MATLAB process.
samer@0:  *
samer@0:  * Computations are carried out in the workspace of the MATLAB
samer@0:  * process, but results can be transported in and out of Prolog's
samer@0:  * memory space using the {Get,Put}Variable APIs.
samer@0:  *
samer@0:  * mxArrays can be created and manipulated on the Prolog side.
samer@0:  * For example, a large numeric array can be created and send to
samer@0:  * the engine instead of building a huge expression to evaluate.
samer@0:  *
samer@0:  * NOTE: memory management of mxArrays on the Prolog side is complicated
samer@0:  *   by the use of cell arrays. Currently, there are two kinds of
samer@0:  *   mxArray reference atom: garbage collected ones and non-garbage
samer@0:  *   collected ones. You should generally use GCed atoms, but mxArrays
samer@0:  *   going in or out of cell arrays should not be GCed because the
samer@0:  *   parent cell array should manage them. Hence, newly created arrays
samer@0:  *   (using CREATENUMERIC, CREATECELL and CREATESTRING) are NOT
samer@0:  *   marked for GC because you might want to put them straight into a
samer@0:  *   cell array. Also, mx atoms returned from GETCELL are not GCed.
samer@0:  *   If a new array is not going into a cell array, you should use 
samer@0:  *   NEWREFGC to obtain a managed atom as soon as possible.
samer@0:  * 
samer@0:  *   If you have a managed array you want to put into a cell array,
samer@0:  *   you should use COPYNOGC to make an unmanaged  DEEP COPY of the 
samer@0:  *   original which can safely be put in the cell array using PUTCELL
samer@0:  *
samer@0:  *   A better solution would be to flip the management status of a given
samer@0:  *   mx_blob atom as necessary.
samer@0:  *
samer@0:  * TODO
samer@0:  *
samer@0:  * - (See plmatlab.pl for comments about the syntax for Prolog-side
samer@0:  * users)
samer@0:  *
samer@0:  * - There is a problem if the Matlab script decides to pause - there
samer@0:  * is apparently no way to communicate a keypress to the engine.
samer@0:  *
samer@0:  * - Similarly, there is no way to interrupt a long computation.
samer@0:  * Pressing Ctrl-C to interrupt Prolog seems to have some effect but
samer@0:  * it seems to confuse the Matlab engine.  Empirically, matlab
samer@0:  * processes handle some signals (try kill -SEGV `pidof MATLAB`) but
samer@0:  * not in a useful way.
samer@0:  *
samer@0:  * - There is no established protocol for freeing variables from
samer@0:  * engGetVariable: they are likely to persist for ever, or at least
samer@0:  * for a long time, except for those handled by the finalization of
samer@0:  * prolog terms.
samer@0:  *
samer@0:  * - Memory management of mxArray references (see above notes)
samer@0:  *
samer@0:  * Changes
samer@0:  *      3/10/04: Added code to retrieve logical variables.
samer@0:  *               Added error checking - eval predicates should fail on error.
samer@0:  *
samer@0:  *      5/10/04: Added eng::fp which points to input and output streams
samer@0:  *               of matlab process. This will enable asynchronous evals
samer@0:  *
samer@0:  *      22/10/04: Blob handling for mxArray corrected by liberal sprinkling
samer@0:  *               of asterisks.
samer@0:  *
samer@0:  *      12/12/04: Removed non-blob mxArray code and added blobs for Matlab
samer@0:  *              workspace variables.
samer@0:  *
samer@0:  *      13/12/04: Removed all traces of old ws var handling code.
samer@0:  *
samer@0:  *      (Later changes may be found in the README file)
samer@0:  */
samer@0: 
samer@0: #include <SWI-cpp.h>
samer@0: #include <stdio.h>
samer@0: #include "engine.h"
samer@0: 
samer@0: /* The maximum number of simultaneous connections to Matlab from one
samer@0:    Prolog process. */
samer@0: #define MAXENGINES 4    
samer@0: #define BUFSIZE  32768 // buffer for matlab output
samer@0: #define MAXCMDLEN 256
samer@0: // #define EVALFMT "t__ex=[];\ntry\n%s\ncatch t__ex\ndisp(getReport(t__ex))\nend"
samer@0: #define EVALFMT "lasterr(''); %s\nt__ex=lasterr;"
samer@0: 
samer@0: using namespace std;
samer@0: 
samer@0: // This is for a SWI Prolog BLOB type to manage mxArray pointers.  It
samer@0: // means that the Prolog garbage collector can deal with freeing
samer@0: // unreferenced mxArrays automatically.
samer@0: 
samer@0: 
samer@0: #ifdef MX_API_VER
samer@0: #if MX_API_VER >= 0x07030000
samer@0: #else
samer@0: typedef int mwSize;
samer@0: typedef int mwIndex;
samer@0: #endif
samer@0: #else
samer@0: typedef int mwSize;
samer@0: typedef int mwIndex;
samer@0: #endif
samer@0: 
samer@0: static PL_blob_t mx_blob;
samer@0: static PL_blob_t mxnogc_blob;
samer@0: static functor_t mlerror;
samer@0: 
samer@0: // Extract an mxArray * from a BLOB atom
samer@0: static mxArray *term_to_mx(term_t t) {
samer@0:   PL_blob_t *type;
samer@0:   size_t    len;
samer@0:   void *p;
samer@0:   
samer@0:   PL_get_blob(t, &p, &len, &type);
samer@0:   if (type != &mx_blob && type != &mxnogc_blob) {
samer@0:     throw PlException("Not an mx variable"); 
samer@0:   }
samer@0:   return *(mxArray **) p;
samer@0: }
samer@0: 
samer@0: static mxArray *ablob_to_mx(atom_t a) { 
samer@0:   return term_to_mx(PlTerm(PlAtom(a))); 
samer@0: }
samer@0: 
samer@0: // This is for a SWI Prolog BLOB type to manage Matlab workspace
samer@0: // variables. The variable is cleared and the name reclaimed
samer@0: // when the blob is garbage collected. This kind of blob has no data
samer@0: // apart from the atom's name (ie the variable's name)
samer@0: 
samer@0: static PL_blob_t ws_blob;
samer@0: 
samer@0: // structure for keeping track of workspace variables
samer@0: struct wsvar {
samer@0:   char name[8]; // designed for short machine generated names
samer@0:   Engine *engine; // the matlab engine which owns this variable
samer@0:   atom_t id;    // the id of this engine
samer@0: };
samer@0: 
samer@0: // extract wsvar from blob term
samer@0: static struct wsvar *term_to_wsvar(term_t t) {
samer@0:   PL_blob_t *type;
samer@0:   size_t     len;
samer@0:   void *p;
samer@0:   
samer@0:   PL_get_blob(t, &p, &len, &type);
samer@0:   if (type != &ws_blob) {
samer@0:     throw PlException("Not a ws variable"); 
samer@0:   }
samer@0:   return (struct wsvar *) p;
samer@0: }
samer@0: 
samer@0: // extract wsvar from atom by converting to term first
samer@0: static struct wsvar *atom_to_wsvar(atom_t a) { 
samer@0:   return term_to_wsvar(PlTerm(PlAtom(a)));
samer@0: }
samer@0: 
samer@0: 
samer@0: /* MATLAB engine wrapper class */
samer@0: class eng {
samer@0: public:
samer@0:   Engine *ep;   // MATLAB API engine pointer
samer@0:   atom_t id;    // atom associated with this engine
samer@0:   char *outbuf; // buffer for textual output from MATLAB
samer@0:         
samer@0:   eng(): ep(NULL), id(PL_new_atom("")), outbuf(NULL) {}
samer@0:         
samer@0:   void open(const char *cmd, atom_t id) {
samer@0:     ep=engOpen(cmd);
samer@0:     
samer@0:     if (ep) {
samer@0:       this->id=id;
samer@0:       outbuf=new char[BUFSIZE];
samer@0:       outbuf[BUFSIZE-1]=0;
samer@0:       engOutputBuffer(ep,outbuf,BUFSIZE-1);
samer@0:       printf("Matlab engine (%s) open.\n",PL_atom_chars(id));
samer@0:     } else {
samer@0:       throw PlException("open engine failed");
samer@0:     }
samer@0:   }
samer@0:   void close() { 
samer@0:     engClose(ep); 
samer@0:     id = PL_new_atom(""); 
samer@0:     delete [] outbuf; 
samer@0:     ep=0; 
samer@0:   }
samer@0:   
samer@0:   bool matches(atom_t id) const { return id==this->id; }
samer@0:   bool isOpen() const { return ep!=NULL; }
samer@0: };
samer@0: 
samer@0: // pool of engines, all initially closed
samer@0: static eng engines[MAXENGINES]; 
samer@0: // functor to be used to wrap array pointers
samer@0: 
samer@0: extern "C" {
samer@0: // Functions for mx array atom type
samer@0:   int mx_release(atom_t a);
samer@0:   int mx_compare(atom_t a, atom_t b);
samer@0:   // int mx_write(IOSTREAM *s, atom_t a, int flags);
samer@0:   int mxnogc_release(atom_t a);
samer@0: 
samer@0: // Functions for WS variable atom type
samer@0:   int ws_release(atom_t a);
samer@0:   // int ws_write(IOSTREAM *s, atom_t a, int flags);
samer@0: }
samer@0: 
samer@0: extern "C" {
samer@0:   install_t install();
samer@0:   foreign_t mlOpen(term_t servercmd, term_t engine);
samer@0:   foreign_t mlClose(term_t engine);
samer@0:   foreign_t mlExec(term_t engine, term_t cmd); 
samer@0:   foreign_t mlWSGet(term_t var, term_t val);
samer@0:   foreign_t mlWSPut(term_t var, term_t val);
samer@0:   foreign_t mlWSName(term_t engine, term_t var, term_t id); 
samer@0:   foreign_t mlWSAlloc(term_t engine, term_t var); 
samer@0:   foreign_t mlMx2Atom(term_t mx, term_t atom); 
samer@0:   foreign_t mlMx2Float(term_t mx, term_t num); 
samer@0:   foreign_t mlMx2Logical(term_t mx, term_t num); 
samer@0:   foreign_t mlMx2String(term_t mx, term_t num); 
samer@0:   foreign_t mlMxInfo(term_t mx, term_t size, term_t type);
samer@0:   foreign_t mlMxSub2Ind(term_t mx, term_t subs, term_t ind);
samer@0:   foreign_t mlMxGetFloat(term_t mx, term_t index, term_t value);
samer@0:   foreign_t mlMxGetLogical(term_t mx, term_t index, term_t value);
samer@0:   foreign_t mlMxGetCell(term_t mx, term_t index, term_t value);
samer@0:   foreign_t mlMxGetField(term_t mx, term_t index, term_t field, term_t value);
samer@0:   foreign_t mlMxGetReals(term_t mx, term_t values);
samer@0:   foreign_t mlMxCreateNumeric(term_t size, term_t mx);
samer@0:   foreign_t mlMxCreateCell(term_t size, term_t mx);
samer@0:   foreign_t mlMxCreateString(term_t string, term_t mx);
samer@0:   foreign_t mlMxPutFloat(term_t mx, term_t index, term_t value);
samer@0:   foreign_t mlMxPutFloats(term_t mx, term_t index, term_t values);
samer@0:   foreign_t mlMxPutCell(term_t mx, term_t index, term_t value);
samer@0:   foreign_t mlMxCopyNoGC(term_t src, term_t dst);
samer@0:   foreign_t mlMxNewRefGC(term_t src, term_t dst);
samer@0: }
samer@0: 
samer@0: install_t install() { 
samer@0:   PL_register_foreign("mlOPEN", 2, (void *)mlOpen, 0);
samer@0:   PL_register_foreign("mlCLOSE", 1, (void *)mlClose, 0);
samer@0:   PL_register_foreign("mlEXEC", 2, (void *)mlExec, 0);
samer@0:   PL_register_foreign("mlWSNAME", 3, (void *)mlWSName, 0);
samer@0:   PL_register_foreign("mlWSALLOC", 2, (void *)mlWSAlloc, 0);
samer@0:   PL_register_foreign("mlWSGET", 2, (void *)mlWSGet,0);
samer@0:   PL_register_foreign("mlWSPUT", 2, (void *)mlWSPut, 0);
samer@0:   PL_register_foreign("mlMX2ATOM", 2, (void *)mlMx2Atom, 0);
samer@0:   PL_register_foreign("mlMX2FLOAT", 2, (void *)mlMx2Float, 0);
samer@0:   PL_register_foreign("mlMX2LOGICAL", 2, (void *)mlMx2Logical, 0);
samer@0:   PL_register_foreign("mlMX2STRING", 2, (void *)mlMx2String, 0);
samer@0:   PL_register_foreign("mlMXINFO", 3, (void *)mlMxInfo, 0);
samer@0:   PL_register_foreign("mlSUB2IND", 3, (void *)mlMxSub2Ind, 0);
samer@0:   PL_register_foreign("mlGETFLOAT", 3, (void *)mlMxGetFloat, 0);
samer@0:   PL_register_foreign("mlGETLOGICAL", 3, (void *)mlMxGetLogical, 0);
samer@0:   PL_register_foreign("mlGETCELL", 3, (void *)mlMxGetCell, 0);
samer@0:   PL_register_foreign("mlGETFIELD", 4, (void *)mlMxGetField, 0);
samer@0:   PL_register_foreign("mlGETREALS", 2, (void *)mlMxGetReals, 0);
samer@0:   PL_register_foreign("mlCREATENUMERIC", 2, (void *)mlMxCreateNumeric, 0);
samer@0:   PL_register_foreign("mlCREATECELL", 2, (void *)mlMxCreateCell, 0);
samer@0:   PL_register_foreign("mlCREATESTRING", 2, (void *)mlMxCreateString, 0);
samer@0:   PL_register_foreign("mlPUTFLOAT", 3, (void *)mlMxPutFloat, 0);
samer@0:   PL_register_foreign("mlPUTFLOATS", 3, (void *)mlMxPutFloats, 0);
samer@0:   PL_register_foreign("mlPUTCELL", 3, (void *)mlMxPutCell, 0);
samer@0:   PL_register_foreign("mlCOPYNOGC", 2, (void *)mlMxCopyNoGC, 0);
samer@0:   PL_register_foreign("mlNEWREFGC", 2, (void *)mlMxNewRefGC, 0);
samer@0:   
samer@0:   mx_blob.magic = PL_BLOB_MAGIC;
samer@0:   mx_blob.flags = PL_BLOB_UNIQUE;
samer@0:   mx_blob.name = (char *)"mx";
samer@0:   mx_blob.acquire = 0; 
samer@0:   mx_blob.release = mx_release;
samer@0:   mx_blob.compare = mx_compare;
samer@0:   mx_blob.write   = 0; // mx_write;
samer@0: 
samer@0:   mxnogc_blob.magic = PL_BLOB_MAGIC;
samer@0:   mxnogc_blob.flags = PL_BLOB_UNIQUE;
samer@0:   mxnogc_blob.name = (char *)"mxnogc";
samer@0:   mxnogc_blob.acquire = 0; 
samer@0:   mxnogc_blob.release = mxnogc_release;
samer@0:   mxnogc_blob.compare = mx_compare;
samer@0:   mxnogc_blob.write   = 0; // mx_write;
samer@0: 
samer@0:   ws_blob.magic = PL_BLOB_MAGIC;
samer@0:   ws_blob.flags = PL_BLOB_UNIQUE; 
samer@0:   ws_blob.name = (char *)"ws";
samer@0:   ws_blob.acquire = 0; 
samer@0:   ws_blob.release = ws_release;
samer@0:   ws_blob.compare = 0; 
samer@0:   ws_blob.write   = 0; 
samer@0: 
samer@0:   mlerror=PL_new_functor(PL_new_atom("mlerror"),3);
samer@0: }
samer@0: 
samer@0: void check(int rc) { if (!rc) printf("*** plml: Something failed.\n");}
samer@0: 
samer@0: void check_array_index(mxArray *mx, long i) 
samer@0: {
samer@0: 	 long   n = mxGetNumberOfElements(mx);
samer@0: 	 if (i<=0 || i>n) throw PlException("Index out of bounds");
samer@0: }
samer@0: 
samer@0: int unify_list_sizes(term_t list, const mwSize *ints, int num)
samer@0: {
samer@0: 	list=PL_copy_term_ref(list);
samer@0: 
samer@0: 	for (int i=0; i<num; i++) {
samer@0: 		term_t head=PL_new_term_ref();
samer@0: 		term_t tail=PL_new_term_ref();
samer@0: 		if (!PL_unify_list(list,head,tail)) PL_fail; 
samer@0: 		if (!PL_unify_integer(head,ints[i])) PL_fail;
samer@0: 		list=tail;
samer@0: 	}
samer@0: 	return PL_unify_nil(list);
samer@0: }
samer@0: 
samer@0: int unify_list_doubles(term_t list, double *x, int n)
samer@0: {
samer@0: 	list=PL_copy_term_ref(list);
samer@0: 
samer@0: 	for (int i=0; i<n; i++) {
samer@0: 		term_t head=PL_new_term_ref();
samer@0: 		term_t tail=PL_new_term_ref();
samer@0: 		if (!PL_unify_list(list,head,tail)) PL_fail; 
samer@0: 		if (!PL_unify_float(head,x[i])) PL_fail;
samer@0: 		list=tail;
samer@0: 	}
samer@0: 	return PL_unify_nil(list);
samer@0: }
samer@0: 
samer@0: // read list of integers from term and write to int array
samer@0: int get_list_integers(term_t list, long *len, int *vals)
samer@0: {
samer@0: 	term_t  head=PL_new_term_ref();
samer@0: 	long 		n;
samer@0: 
samer@0: 	// copy term ref so as not to modify original
samer@0: 	list=PL_copy_term_ref(list);
samer@0: 	for (n=0;PL_get_list(list,head,list);n++) {
samer@0: 			if (!PL_get_integer(head,&vals[n])) return false;
samer@0: 	}
samer@0: 	if (!PL_get_nil(list)) return false; 
samer@0: 	*len=n;
samer@0: 	return true;
samer@0: }
samer@0: 
samer@0: // read list of floats from term and write to double array
samer@0: int get_list_doubles(term_t list, long *len, double *vals)
samer@0: {
samer@0: 	term_t  head=PL_new_term_ref();
samer@0: 	long 		n;
samer@0: 
samer@0: 	// copy term ref so as not to modify original
samer@0: 	list=PL_copy_term_ref(list);
samer@0: 	for (n=0;PL_get_list(list,head,list);n++) {
samer@0: 			if (!PL_get_float(head,&vals[n])) return false;
samer@0: 	}
samer@0: 	if (!PL_get_nil(list)) return false; 
samer@0: 	*len=n;
samer@0: 	return true;
samer@0: }
samer@0: 
samer@0: 
samer@0: 
samer@0: /*
samer@0:  * Member functions for SWIs blob atoms, which allow SWI to manage
samer@0:  * garbage collection for user-defined data types.
samer@0:  */
samer@0: int mx_release(atom_t a) {
samer@0:   mxArray *p=ablob_to_mx(a);
samer@0:   mxDestroyArray(p);
samer@0:   return TRUE;
samer@0: }
samer@0: 
samer@0: int mx_compare(atom_t a, atom_t b) {
samer@0:   mxArray *pa=ablob_to_mx(a);
samer@0:   mxArray *pb=ablob_to_mx(b);
samer@0:   if (pa<pb) return -1;
samer@0:   else if (pa>pb) return 1;
samer@0:   else return 0;
samer@0: }
samer@0: 
samer@0: int mxnogc_release(atom_t a) { return TRUE; }
samer@0: 
samer@0: /* 
samer@0: // this requires some jiggery pokery to handle IOSTREAMS. 
samer@0: int mx_write(IOSTREAM *s, atom_t a, int flags) {
samer@0:   mxArray *p=ablob_to_mx(a);
samer@0:   fprintf(s,"<mx:%p>",p);
samer@0: }
samer@0: */
samer@0: 
samer@0: 
samer@0: int ws_release(atom_t a) {
samer@0:   struct wsvar *x=atom_to_wsvar(a);
samer@0:   // printf("."); fflush(stdout); // sweet brevity 
samer@0:   
samer@0:   char buf[16];
samer@0:   sprintf(buf,"clear %s",x->name);
samer@0:   engEvalString(x->engine,buf);
samer@0:   x->name[0]=0;
samer@0:   x->engine=0;
samer@0:   
samer@0:   return TRUE;
samer@0: }
samer@0: 
samer@0: /* see mx_write */
samer@0: //int ws_write(IOSTREAM *s, atom_t a, int flags) {
samer@0: //      struct wsvar *p=atom_to_wsvar(a);
samer@0: //      mxArray *p=ablob_to_mx(a);
samer@0: //      fprintf(s,"%s",p->name);
samer@0: //}
samer@0: 
samer@0: 
samer@0: /* Finds the engine associated with the given term
samer@0:  * (which should just be an atom). Throws an exception
samer@0:  * if the engine is not found.
samer@0:  */
samer@0: static eng *findEngine(term_t id_term) 
samer@0: {
samer@0:   atom_t id; 
samer@0:   if(!PL_get_atom(id_term, &id)) {
samer@0:     throw PlException("id is not an atom");
samer@0:   }
samer@0:   for (int i=0; i<MAXENGINES; i++) {
samer@0:     if (engines[i].matches(id)) return &engines[i];
samer@0:   }
samer@0:   throw PlException("engine not found");
samer@0: }
samer@0: 
samer@0: 
samer@0: /* 
samer@0:  * Open a matlab engine using the given command and associate
samer@0:  * it with the second term, which should be an atom.
samer@0:  */
samer@0: 
samer@0: foreign_t mlOpen(term_t servercmd, term_t id_term) 
samer@0: {
samer@0:   try { 
samer@0:     findEngine(id_term);
samer@0:     printf("mlOPEN/2: Engine %s already open\n",(const char *)PlTerm(id_term));
samer@0:                 PL_succeed;
samer@0:   } catch (...) {}
samer@0:   
samer@0:   try {
samer@0:     // look for an unused engine structure
samer@0:     for (int i=0; i<MAXENGINES; i++) {
samer@0:       if (!engines[i].isOpen()) {
samer@0:         atom_t id;
samer@0:         check(PL_get_atom(id_term,&id));
samer@0:         engines[i].open(PlTerm(servercmd), id);
samer@0: 		  fputs(engines[i].outbuf,stdout);
samer@0:         PL_succeed;
samer@0:       }
samer@0:     }
samer@0:     return PL_warning("mlOPEN/2: no more engines available.");
samer@0:   } catch (PlException &e) { 
samer@0:     return e.plThrow(); 
samer@0:   }
samer@0: }
samer@0: 
samer@0: // Close a previously opened Matlab engine
samer@0: foreign_t mlClose(term_t engine) {
samer@0:   try {   
samer@0:     findEngine(engine)->close(); 
samer@0:     PL_succeed; 
samer@0:   } catch (PlException &e) { 
samer@0:     return e.plThrow(); 
samer@0:   }
samer@0: }
samer@0: 
samer@0: /*
samer@0:  * Workspace variable handling
samer@0:  */
samer@0: 
samer@0: // This will create a new workspace variable with an unused name,
samer@0: // initialise it to an empty array (to reserve the name) and unify
samer@0: // the term (which must be a prolog variable) with a blob representing
samer@0: // the variable. This in turn points back to this engine so that
samer@0: // if garbage collected, the workspace variable is cleared.
samer@0: foreign_t mlWSAlloc(term_t eng, term_t blob) {
samer@0:   // if varname is already bound, we should check
samer@0:   // that the name has not been used in the workspace
samer@0:   try {
samer@0: 	 class  eng *engine=findEngine(eng);
samer@0:     struct wsvar x;
samer@0: 	 int rc;
samer@0: 
samer@0:     // in a threaded world, there would either need to be precisely
samer@0:     // one engine per thread (so that there are no race conditions on
samer@0:     // the Matlab side) or else these lines (down to PL_unify_blob)
samer@0:     // need to be atomic.
samer@0:     x.engine = engine->ep;
samer@0: 	 x.id     = engine->id;
samer@0: 
samer@0:     if (engEvalString(x.engine, "t__0=uniquevar([]);")) 
samer@0: 		 throw PlException("Cannot execute uniquevar");
samer@0: 
samer@0:     memset(x.name,sizeof(x.name),0);
samer@0: 	 mxArray *newname=engGetVariable(x.engine, "t__0");
samer@0: 	 if (newname==NULL) {
samer@0: 		 engEvalString(x.engine,"clear(t__0)"); // half arsed attempt to fix variable leak
samer@0: 		 throw PlException("Cannot get new variable name.");
samer@0:     }
samer@0: 	 rc = mxGetString(newname,x.name, sizeof(x.name));
samer@0: 	 mxDestroyArray(newname);
samer@0:     if (rc) throw PlException("Cannot read new variable name.");
samer@0: 
samer@0:     return PL_unify_blob(blob,&x,sizeof(x),&ws_blob);
samer@0:   } catch (PlException &e) { 
samer@0:     return e.plThrow(); 
samer@0:   }
samer@0: }
samer@0: 
samer@0: foreign_t mlWSName(term_t blob, term_t name, term_t engine) {
samer@0:   // if varname is already bound, we should check
samer@0:   // that the name has not been used in the workspace
samer@0:   try {
samer@0:     struct wsvar *x = term_to_wsvar(blob);
samer@0:     return ( PL_unify_atom_chars(name, x->name)
samer@0: 			&& PL_unify_atom(engine, x->id));
samer@0:   } catch (PlException &e) {
samer@0:     PL_fail; // return e.plThrow(); 
samer@0:   }
samer@0: }
samer@0: 
samer@0: // Get a named variable from the MATLAB workspace and return a term
samer@0: // containing a pointer to an mxArray (in Prolog's memory space).
samer@0: foreign_t mlWSGet(term_t var, term_t val) {
samer@0:   try { 
samer@0:     struct wsvar *x = term_to_wsvar(var);
samer@0:     mxArray *p = engGetVariable(x->engine, x->name);
samer@0:     return PL_unify_blob(val, (void **)&p, sizeof(p), &mx_blob);
samer@0:   } catch (PlException &e) { 
samer@0:     return e.plThrow(); 
samer@0:   }
samer@0: }
samer@0: 
samer@0: // Put an array back in Matlab workspace under given variable name
samer@0: foreign_t mlWSPut(term_t var, term_t val) {
samer@0:   try { 
samer@0:     struct wsvar *x=term_to_wsvar(var);
samer@0:     engPutVariable(x->engine, x->name, term_to_mx(val));
samer@0:     PL_succeed;
samer@0:   } catch (PlException &e) { 
samer@0:     return e.plThrow(); 
samer@0:   }
samer@0: }
samer@0: 
samer@0: /*
samer@0:  * Executing MATLAB code
samer@0:  */
samer@0: 
samer@0: // Call a Matlab engine to execute the given command
samer@0: foreign_t mlExec(term_t engine, term_t cmd) 
samer@0: {
samer@0: //  printf(">>> Entering mlEXEC\n");
samer@0:   try {
samer@0:     eng *eng=findEngine(engine);
samer@0: 	 const char *cmdstr=PlTerm(cmd);
samer@0: 	 char *eval_cmd;
samer@0: 	 int	cmdlen=strlen(cmdstr);
samer@0: 	 int	rc;
samer@0:     
samer@0:     // if string is very long, send it via local mxArray
samer@0:     if (cmdlen>MAXCMDLEN) {
samer@0:       mxArray *mxcmd=mxCreateString(cmdstr);
samer@0: //		printf(" >>> Putting command\n");
samer@0:       engPutVariable(eng->ep,"t__cmd",mxcmd);
samer@0: //		printf(" <<< Put command ok\n");
samer@0:       mxDestroyArray(mxcmd);
samer@0: 		cmdstr="eval(t__cmd)";
samer@0: 		cmdlen=strlen(cmdstr);
samer@0: 	 }
samer@0: 
samer@0: 	 eval_cmd = new char[cmdlen+strlen(EVALFMT)-1];
samer@0: 	 if (eval_cmd==NULL) throw PlException("Failed to allocate memory for command");
samer@0: 	 sprintf(eval_cmd, EVALFMT, cmdstr);
samer@0: //	 printf(" >>> Calling Matlab engine...\n"),
samer@0: 	 rc=engEvalString(eng->ep,eval_cmd);
samer@0: //	 printf(" <<< Returned from Matlab engine...\n"),
samer@0: 	 delete [] eval_cmd;
samer@0: 
samer@0:     if (rc) {
samer@0: 		 // printf("*** MATLAB evaluation error. Output buffer contains:\n"),
samer@0: 		 // fputs(eng->outbuf,stdout);
samer@0: 		 // printf("*** throwing exception.\n");
samer@0: 		 // throw PlException("MATLAB evaluation error");
samer@0: 	 }
samer@0: 
samer@0: 
samer@0: 	 // write whatever is in the output buffer now.
samer@0:     fputs(eng->outbuf,stdout);
samer@0:     
samer@0: 	 // SA 2010. Giving up any pretence of being thread-safe -
samer@0: 	 // each engine is to be used by one Prolog thread ONLY.
samer@0: 	 // If you want fancy threading stuff, do it in Prolog.
samer@0: 
samer@0: //	 printf(" >>> Getting variable\n");
samer@0:     mxArray *lasterr = engGetVariable(eng->ep, "t__ex");
samer@0: //	 printf(" <<< Got variable\n");
samer@0: //	 if (!lasterr) throw PlException("Failed to get status information.");
samer@0:     
samer@0:     if (mxGetNumberOfElements(lasterr)>0) {
samer@0: 		 //char *string=mxArrayToString(mxGetField(lasterr,0,"message"));
samer@0: 		 char *string=mxArrayToString(lasterr);
samer@0: 	    mxDestroyArray(lasterr);
samer@0: 
samer@0: 		term_t desc=PL_new_term_ref();
samer@0: 		term_t cmd=PL_new_term_ref();
samer@0: 		term_t ex=PL_new_term_ref();
samer@0: 
samer@0: 		PL_put_atom_chars(desc,string);
samer@0: 		PL_put_atom_chars(cmd,cmdstr);
samer@0: 		mxFree(string);
samer@0: 		check(PL_cons_functor(ex,mlerror,engine,desc,cmd));
samer@0: 		throw PlException(ex);
samer@0: 		 
samer@0: 	 } else mxDestroyArray(lasterr);
samer@0:     
samer@0:     // if we've got this far, then everything went well, so
samer@0: //	 printf("<<< Returning from mlEXEC\n");
samer@0:     PL_succeed;
samer@0:   } catch (PlException &e) { 
samer@0:     return e.plThrow(); 
samer@0:   }
samer@0: }
samer@0: 
samer@0: // Get a Prolog string out of a matlab char array 
samer@0: foreign_t mlMx2String(term_t mx, term_t a)
samer@0: {
samer@0:   try {
samer@0:     char *str = mxArrayToString(term_to_mx(mx));
samer@0:     if (!str) {
samer@0:       return PL_warning("array is not a character array");
samer@0:     }
samer@0:     int rc = PL_unify_string_chars(a, str);
samer@0:     mxFree(str);
samer@0:     return rc;
samer@0:   } catch (PlException &e) { 
samer@0:     return e.plThrow(); 
samer@0:   }
samer@0: }
samer@0: 
samer@0: // Convert Matlab char array to a Prolog atom
samer@0: foreign_t mlMx2Atom(term_t mx, term_t a)
samer@0: {
samer@0:   try {
samer@0:     char *str = mxArrayToString(term_to_mx(mx));
samer@0:     if (!str) {
samer@0:       return PL_warning("array is not a character array");
samer@0:     }
samer@0:     int rc = PL_unify_atom_chars(a, str);
samer@0:     mxFree(str);
samer@0:     return rc;
samer@0:   } catch (PlException &e) { 
samer@0:     return e.plThrow(); 
samer@0:   }
samer@0: }
samer@0: 
samer@0: // Convert Matlab numerical array with one element to Prolog float
samer@0: foreign_t mlMx2Float(term_t mxterm, term_t a)
samer@0: {
samer@0:   try {
samer@0:     mxArray *mx = term_to_mx(mxterm);
samer@0:     if (!mxIsDouble(mx)) {
samer@0:       return PL_warning("not numeric");
samer@0:     }
samer@0:     if (mxGetNumberOfElements(mx)!=1) {
samer@0:       return PL_warning("Not a scalar");
samer@0:     }
samer@0:     double x = mxGetScalar(mx);
samer@0:     
samer@0:     return PL_unify_float(a, x);
samer@0:   } catch (PlException &e) { 
samer@0:     return e.plThrow(); 
samer@0:   }
samer@0: }
samer@0: 
samer@0: // Convert Matlab numerical (REAL) array to list
samer@0: foreign_t mlMxGetReals(term_t mxterm, term_t a)
samer@0: {
samer@0:   try {
samer@0:     mxArray *mx = term_to_mx(mxterm);
samer@0: 		int       n = mxGetNumberOfElements(mx);
samer@0: 
samer@0:     if (!mxIsDouble(mx)) return PL_warning("not numeric");
samer@0: 		return unify_list_doubles(a,mxGetPr(mx),n);
samer@0:   } catch (PlException &e) { 
samer@0:     return e.plThrow(); 
samer@0:   }
samer@0: }
samer@0: 
samer@0: // Convert Matlab logical or numeric array with one element to 
samer@0: // Prolog integer 0 or 1 (does not fail or succeed depending on 
samer@0: // logical value - this is can be done by prolog code).
samer@0: foreign_t mlMx2Logical(term_t mxterm, term_t a)
samer@0: {
samer@0:   try {
samer@0:     mxArray *mx = term_to_mx(mxterm);
samer@0: 		if (mxGetNumberOfElements(mx) != 1) return PL_warning("Not a scalar");
samer@0: 
samer@0:     int f;
samer@0:     if (mxIsLogical(mx)) {
samer@0:       f = mxIsLogicalScalarTrue(mx) ? 1 : 0;
samer@0:     } else if (mxIsDouble(mx)) {
samer@0:       f = (mxGetScalar(mx) > 0) ? 1 : 0;
samer@0:     } else {
samer@0:       return PL_warning("neither numeric nor logical (captain)");
samer@0:     }
samer@0:     
samer@0:     return PL_unify_integer(a,f);
samer@0:   } catch (PlException &e) { 
samer@0:     return e.plThrow(); 
samer@0:   }
samer@0: }
samer@0: 
samer@0: // Get array information (size and type of elements)
samer@0: foreign_t mlMxInfo(term_t mxterm, term_t size, term_t type)
samer@0: {
samer@0: 	try {
samer@0: 		mxArray     *mx = term_to_mx(mxterm);
samer@0: 		long      ndims = mxGetNumberOfDimensions(mx);
samer@0: 		const mwSize *dims = mxGetDimensions(mx);
samer@0: 		const char *cnm = mxGetClassName(mx);
samer@0: 
samer@0: 		if (PL_unify_atom_chars(type, cnm)) {
samer@0: 			if (dims[ndims-1]==1) ndims--; // remove trailing singletons
samer@0: 			return unify_list_sizes(size,dims,ndims);
samer@0: 		}
samer@0: 		PL_fail;
samer@0: 	} catch (PlException &e) { 
samer@0: 		return e.plThrow(); 
samer@0: 	}
samer@0: }
samer@0: 
samer@0: // Convert multidimensional subscript to linear index
samer@0: foreign_t mlMxSub2Ind(term_t mxterm, term_t substerm, term_t indterm)
samer@0: {
samer@0:   try {
samer@0: 		mxArray *mx=term_to_mx(mxterm);
samer@0: 		mwIndex	subs[64]; // 64 dimensional should be enough!
samer@0: 		long		nsubs;
samer@0: 
samer@0: 		// get substerm as int array
samer@0: 		if (!get_list_integers(substerm,&nsubs,(int *)subs)) // !!
samer@0: 			return PL_warning("Bad subscript list");
samer@0: 
samer@0: 		// switch to zero-based subscripts
samer@0: 		for (int i=0; i<nsubs; i++) subs[i]--;
samer@0: 
samer@0: 		int ind = mxCalcSingleSubscript(mx,nsubs,subs);
samer@0: 		check_array_index(mx,ind);
samer@0: 
samer@0: 		return PL_unify_integer(indterm, ind);
samer@0:   } catch (PlException &e) { 
samer@0:     return e.plThrow(); 
samer@0:   }
samer@0: }
samer@0: 
samer@0: // Dereference double from mx array
samer@0: foreign_t mlMxGetFloat(term_t mxterm, term_t index, term_t value)
samer@0: {
samer@0:   try {
samer@0:     mxArray *mx = term_to_mx(mxterm);
samer@0: 	 long   i;
samer@0: 
samer@0: 	 check(PL_get_long(index,&i));
samer@0: 	 check_array_index(mx,i);
samer@0:     if (!mxIsDouble(mx)) { return PL_warning("not numeric"); }
samer@0: 
samer@0:     double   *p = (double *)mxGetData(mx);
samer@0:     return PL_unify_float(value, p[i-1]);
samer@0:   } catch (PlException &e) { 
samer@0:     return e.plThrow(); 
samer@0:   }
samer@0: }
samer@0: 
samer@0: // Dereference logical from mx array
samer@0: foreign_t mlMxGetLogical(term_t mxterm, term_t index, term_t value)
samer@0: {
samer@0:   try {
samer@0:     mxArray *mx = term_to_mx(mxterm);
samer@0: 	 long   i;
samer@0: 
samer@0: 	 check(PL_get_long(index,&i));
samer@0: 	 check_array_index(mx,i);
samer@0: 
samer@0:     if (mxIsLogical(mx)) {
samer@0: 		 mxLogical *p = mxGetLogicals(mx);
samer@0: 		 return PL_unify_integer(value,(p[i-1]) ? 1 : 0);
samer@0: 	 } else if (mxIsDouble(mx)) {
samer@0: 		 double   *p = (double *)mxGetData(mx);
samer@0: 		 return PL_unify_integer(value, (p[i-1]>0) ? 1 : 0);
samer@0:     } else {
samer@0:       return PL_warning("neither logical nor numeric");
samer@0: 	 }
samer@0: 
samer@0:   } catch (PlException &e) { 
samer@0:     return e.plThrow(); 
samer@0:   }
samer@0: }
samer@0: 
samer@0: // Dereference mxArray from cell array
samer@0: // Note that we return a non-gargage collected atom, otherwise,
samer@0: // the parent cell array would be spoiled when one of its elements
samer@0: // is released and destroyed. However, if the parent cell is 
samer@0: // released and destroyed, any remaining references to elements
samer@0: // will be prematurely invalidated.
samer@0: // FIXME: This is almost certain to confuse the garbage collector
samer@0: foreign_t mlMxGetCell(term_t mxterm, term_t index, term_t value)
samer@0: {
samer@0:   try {
samer@0:     mxArray *mx = term_to_mx(mxterm);
samer@0: 	 long   i;
samer@0: 
samer@0: 	 check(PL_get_long(index,&i));
samer@0: 	 check_array_index(mx,i);
samer@0:     if (!mxIsCell(mx)) { return PL_warning("not numeric"); }
samer@0: 
samer@0:     mxArray   *p = mxGetCell(mx,i-1);
samer@0:     return PL_unify_blob(value, (void **)&p, sizeof(p), &mxnogc_blob);
samer@0:   } catch (PlException &e) { 
samer@0:     return e.plThrow(); 
samer@0:   }
samer@0: }
samer@0: 
samer@0: foreign_t mlMxGetField(term_t mxterm, term_t index, term_t field, term_t value)
samer@0: {
samer@0:   try {
samer@0:     mxArray *mx = term_to_mx(mxterm);
samer@0: 	 long   i;
samer@0: 	 char    *fname;
samer@0: 
samer@0: 	 check(PL_get_long(index,&i));
samer@0: 	 check(PL_get_atom_chars(field,&fname));
samer@0: 	 check_array_index(mx,i);
samer@0:     if (!mxIsStruct(mx)) { return PL_warning("not a structure"); }
samer@0: 
samer@0:     mxArray   *p = mxGetField(mx,i-1,fname);
samer@0: 	 if (!p) return PL_warning("Field not present");
samer@0:     return PL_unify_blob(value, (void **)&p, sizeof(p), &mxnogc_blob);
samer@0:   } catch (PlException &e) { 
samer@0:     return e.plThrow(); 
samer@0:   }
samer@0: }
samer@0: 
samer@0: // Create numeric array. Currently only real double arrays created
samer@0: foreign_t mlMxCreateNumeric(term_t size, term_t mx) {
samer@0:   try { 
samer@0: 		mwSize dims[64];
samer@0: 		long ndims;
samer@0: 
samer@0: 		// get size as int array
samer@0: 		if (!get_list_integers(size,&ndims,(int *)dims)) 
samer@0: 			return PL_warning("Bad size list");
samer@0: 
samer@0:     mxArray *p = mxCreateNumericArray(ndims,dims,mxDOUBLE_CLASS,mxREAL);
samer@0:     return PL_unify_blob(mx, (void **)&p, sizeof(p), &mxnogc_blob);
samer@0:   } catch (PlException &e) { 
samer@0:     return e.plThrow(); 
samer@0:   }
samer@0: }
samer@0: 
samer@0: // Create cell array. 
samer@0: foreign_t mlMxCreateCell(term_t size, term_t mx) {
samer@0:   try { 
samer@0: 		mwSize dims[64];
samer@0: 		long ndims;
samer@0: 
samer@0: 		// get size as int array
samer@0: 		if (!get_list_integers(size,&ndims,(int *)dims)) 
samer@0: 			return PL_warning("Bad size list");
samer@0: 
samer@0:     mxArray *p = mxCreateCellArray(ndims,dims);
samer@0:     return PL_unify_blob(mx, (void **)&p, sizeof(p), &mxnogc_blob);
samer@0:   } catch (PlException &e) { 
samer@0:     return e.plThrow(); 
samer@0:   }
samer@0: }
samer@0: 
samer@0: // Create numeric array. Currently only real double arrays created
samer@0: foreign_t mlMxCreateString(term_t string, term_t mx) {
samer@0:   try { 
samer@0:     mxArray *p = mxCreateString(PlTerm(string));
samer@0:     return PL_unify_blob(mx, (void **)&p, sizeof(p), &mxnogc_blob);
samer@0:   } catch (PlException &e) { 
samer@0:     return e.plThrow(); 
samer@0:   }
samer@0: }
samer@0: 
samer@0: 
samer@0: // Write float into double array
samer@0: foreign_t mlMxPutFloat(term_t mxterm, term_t index, term_t value)
samer@0: {
samer@0:   try {
samer@0: 		mxArray *mx = term_to_mx(mxterm);
samer@0: 		long   i;
samer@0: 		double val;
samer@0: 
samer@0: 		if (!mxIsDouble(mx)) { return PL_warning("not numeric"); }
samer@0: 		check(PL_get_long(index,&i));
samer@0: 		check(PL_get_float(value,&val));
samer@0: 		check_array_index(mx,i);
samer@0: 		*(mxGetPr(mx)+i-1)=val;
samer@0: 		return true;
samer@0:   } catch (PlException &e) { 
samer@0:     return e.plThrow(); 
samer@0:   }
samer@0: }
samer@0: 
samer@0: // Write list of floats into double array starting at given index
samer@0: foreign_t mlMxPutFloats(term_t mxterm, term_t index, term_t values)
samer@0: {
samer@0:   try {
samer@0: 		mxArray *mx = term_to_mx(mxterm);
samer@0: 		long   i, len;
samer@0: 
samer@0: 		if (!mxIsDouble(mx)) { return PL_warning("not numeric"); }
samer@0: 		check(PL_get_long(index,&i));
samer@0: 		check_array_index(mx,i);
samer@0: 		get_list_doubles(values,&len,mxGetPr(mx)+i-1);
samer@0: 		return true;
samer@0:   } catch (PlException &e) { 
samer@0:     return e.plThrow(); 
samer@0:   }
samer@0: }
samer@0: 
samer@0: // Put an mxArray into a cell array
samer@0: // IMPORTANT: the object being put must in a non-memory managed atom
samer@0: foreign_t mlMxPutCell(term_t mxterm, term_t index, term_t element)
samer@0: {
samer@0:   try {
samer@0: 		mxArray *mx = term_to_mx(mxterm);
samer@0: 		mxArray *el = term_to_mx(element);
samer@0: 		long   i;
samer@0: 
samer@0: 		if (!mxIsCell(mx)) { return PL_warning("not a cell array"); }
samer@0: 		check(PL_get_long(index,&i));
samer@0: 		check_array_index(mx,i);
samer@0: 		mxSetCell(mx,i-1,el);
samer@0: 		return true;
samer@0:   } catch (PlException &e) { 
samer@0:     return e.plThrow(); 
samer@0:   }
samer@0: }
samer@0: 
samer@0: foreign_t mlMxCopyNoGC(term_t in, term_t out)
samer@0: {
samer@0:   try {
samer@0:     mxArray *mx = term_to_mx(in);
samer@0: 		mxArray *p = mxDuplicateArray(mx);
samer@0:     return PL_unify_blob(out, (void **)&p, sizeof(p), &mxnogc_blob);
samer@0:   } catch (PlException &e) { 
samer@0:     return e.plThrow(); 
samer@0:   }
samer@0: }
samer@0: 
samer@0: foreign_t mlMxNewRefGC(term_t in, term_t out)
samer@0: {
samer@0:   try {
samer@0:     mxArray *p = term_to_mx(in);
samer@0:     return PL_unify_blob(out, (void **)&p, sizeof(p), &mx_blob);
samer@0:   } catch (PlException &e) { 
samer@0:     return e.plThrow(); 
samer@0:   }
samer@0: }
samer@0: 
samer@0: 
samer@0: /* 
samer@0:  * Local Variables:
samer@0:  * c-basic-offset: 2
samer@0:  * indent-tabs-mode: nil
samer@0:  * End:
samer@0:  */
samer@0: