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@12: #include <unistd.h>
samer@18: #include <pthread.h>
samer@0: #include "engine.h"
samer@0: 
samer@15: 
samer@15: #define ALT_LASTERR 1
samer@15: 
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@15: 
samer@15: #ifdef ALT_LASTERR
samer@15: #	define EVALFMT "lasterr('');disp('#');%s"
samer@15: #else
samer@15: #	define EVALFMT "lasterr('');disp('#');%s\nt__ex=lasterr;"
samer@15: #endif
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@18:   const char *magic;
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@18:   eng(): ep(NULL), id(PL_new_atom("")), outbuf(NULL) { magic="mleng"; }
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@18: static pthread_mutex_t EngMutex;
samer@18: 
samer@18: class lock {
samer@18: public:
samer@18: 	lock() { pthread_mutex_lock(&EngMutex); }
samer@18: 	~lock() { pthread_mutex_unlock(&EngMutex); }
samer@18: };
samer@18: 
samer@18: 
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@37:   PL_register_foreign("mlOPEN", 2, (void (*)())mlOpen, 0);
samer@37:   PL_register_foreign("mlCLOSE", 1, (void (*)())mlClose, 0);
samer@37:   PL_register_foreign("mlEXEC", 2, (void (*)())mlExec, 0);
samer@37:   PL_register_foreign("mlWSNAME", 3, (void (*)())mlWSName, 0);
samer@37:   PL_register_foreign("mlWSALLOC", 2, (void (*)())mlWSAlloc, 0);
samer@37:   PL_register_foreign("mlWSGET", 2, (void (*)())mlWSGet,0);
samer@37:   PL_register_foreign("mlWSPUT", 2, (void (*)())mlWSPut, 0);
samer@37:   PL_register_foreign("mlMX2ATOM", 2, (void (*)())mlMx2Atom, 0);
samer@37:   PL_register_foreign("mlMX2FLOAT", 2, (void (*)())mlMx2Float, 0);
samer@37:   PL_register_foreign("mlMX2LOGICAL", 2, (void (*)())mlMx2Logical, 0);
samer@37:   PL_register_foreign("mlMX2STRING", 2, (void (*)())mlMx2String, 0);
samer@37:   PL_register_foreign("mlMXINFO", 3, (void (*)())mlMxInfo, 0);
samer@37:   PL_register_foreign("mlSUB2IND", 3, (void (*)())mlMxSub2Ind, 0);
samer@37:   PL_register_foreign("mlGETFLOAT", 3, (void (*)())mlMxGetFloat, 0);
samer@37:   PL_register_foreign("mlGETLOGICAL", 3, (void (*)())mlMxGetLogical, 0);
samer@37:   PL_register_foreign("mlGETCELL", 3, (void (*)())mlMxGetCell, 0);
samer@37:   PL_register_foreign("mlGETFIELD", 4, (void (*)())mlMxGetField, 0);
samer@37:   PL_register_foreign("mlGETREALS", 2, (void (*)())mlMxGetReals, 0);
samer@37:   PL_register_foreign("mlCREATENUMERIC", 2, (void (*)())mlMxCreateNumeric, 0);
samer@37:   PL_register_foreign("mlCREATECELL", 2, (void (*)())mlMxCreateCell, 0);
samer@37:   PL_register_foreign("mlCREATESTRING", 2, (void (*)())mlMxCreateString, 0);
samer@37:   PL_register_foreign("mlPUTFLOAT", 3, (void (*)())mlMxPutFloat, 0);
samer@37:   PL_register_foreign("mlPUTFLOATS", 3, (void (*)())mlMxPutFloats, 0);
samer@37:   PL_register_foreign("mlPUTCELL", 3, (void (*)())mlMxPutCell, 0);
samer@37:   PL_register_foreign("mlCOPYNOGC", 2, (void (*)())mlMxCopyNoGC, 0);
samer@37:   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@18:   pthread_mutex_init(&EngMutex,NULL);
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@18:   int rc;
samer@0:   // printf("."); fflush(stdout); // sweet brevity 
samer@0:   
samer@0:   char buf[16];
samer@0:   sprintf(buf,"clear %s",x->name);
samer@18:   if (pthread_mutex_trylock(&EngMutex)==0) {
samer@18:      rc=engEvalString(x->engine,buf) ? FALSE : TRUE; 
samer@18: 	  pthread_mutex_unlock(&EngMutex);
samer@18: 	} else {
samer@18: 	//	printf("\n *** cannot release %s while engine locked ***\n",x->name);
samer@18: 		rc=FALSE;
samer@18: 	}
samer@18: 
samer@18: 	if (rc) {
samer@18: 	  x->name[0]=0;
samer@18: 	  x->engine=0;
samer@18:   } 
samer@0:   
samer@18:   return rc;
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@26: static void displayOutput(const char *prefix,const char *p) 
samer@24: {
samer@24: 	while (*p) {
samer@24: 		fputs(prefix,stdout); 
samer@24: 		while (*p && *p!='\n') putchar(*p++); 
samer@24: 		putchar('\n'); if (*p) p++;
samer@24: 	}
samer@24: }
samer@24: 
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@24: 		  displayOutput("| ",engines[i].outbuf);
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@13: 
samer@18: static int raise_exception(const char *msg, const char *loc, const char *info) {
samer@14:   // printf("\n!! raising exception: %s\n",msg);
samer@13:   // return FALSE;
samer@13:  
samer@13:   term_t ex = PL_new_term_ref();
samer@18:   return PL_unify_term(ex, PL_FUNCTOR_CHARS, "error", 2,
samer@18: 			 PL_FUNCTOR_CHARS, "plml_error", 3, PL_CHARS, msg, PL_CHARS, loc, PL_CHARS, info,
samer@18: 			 PL_VARIABLE)
samer@13: 
samer@18: 		  && PL_raise_exception(ex);
samer@13: }
samer@13: 
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@13:   class eng *engine;
samer@13:   try { engine=findEngine(eng); }
samer@18:   catch (PlException &ex) { return ex.plThrow(); }
samer@0: 
samer@13:   //printf("-- Entering mlWSALLOC         \r"); fflush(stdout); 
samer@13:   struct wsvar x;
samer@0: 
samer@13:   x.engine = engine->ep;
samer@13:   x.id     = engine->id;
samer@0: 
samer@15:   // printf("-- mlWSAlloc: Calling uniquevar...       \r"); fflush(stdout); 
samer@18:   {  lock l;
samer@18: 	  if (engEvalString(x.engine, "uniquevar([])")) 
samer@18: 		  return raise_exception("eval_failed","uniquevar","none");
samer@15:   }
samer@15:  
samer@15:   if (strncmp(engine->outbuf,">> \nans =\n\nt_",13)!=0) {
samer@15:      //printf("\n** mlWSAlloc: output buffer looks bad: '%s'\n",engine->outbuf);
samer@18: 	  return raise_exception("bad_output_buffer","uniquevar",engine->outbuf);
samer@15:   }
samer@15: 
samer@16: 	unsigned int len=strlen(engine->outbuf+11)-2;
samer@15: 	if (len+1>sizeof(x.name)) {
samer@18: 	  return raise_exception("name_too_long","uniquevar",engine->outbuf);
samer@15: 	 }
samer@15: 	memcpy(x.name,engine->outbuf+11,len);
samer@15: 	x.name[len]=0;
samer@13: 
samer@13:   return PL_unify_blob(blob,&x,sizeof(x),&ws_blob);
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@18: 	 lock l;
samer@18: 	 // class eng *engine=findEngine(PlTerm(PlAtom(x->id)));
samer@18: 	 // char *before=strdup(engine->outbuf);
samer@18: 	 //printf("-- mlWSGET: calling get variable...\n");
samer@0:     mxArray *p = engGetVariable(x->engine, x->name);
samer@18: 	 //printf("-- mlWSGET: returned from get variable.\n");
samer@17: 	 if (p) return PL_unify_blob(val, (void **)&p, sizeof(p), &mx_blob);
samer@17: 	 else {
samer@18: 		 //printf("\n!! mlWSGet: failed to get %s.\n",x->name);
samer@18: 		 //printf("\n!! mlWSGet: before buffer: %s.\n",before);
samer@18: 		 //printf("\n!! mlWSGet: before after: %s.\n",engine->outbuf);
samer@18: 		 //return raise_exception("get_variable_failed",before,engine->outbuf);
samer@18: 		 return raise_exception("get_variable_failed","mlWSGET",x->name);
samer@17: 	 }
samer@0:   } catch (PlException &e) { 
samer@0:     return e.plThrow(); 
samer@0:   }
samer@0: }
samer@0: 
samer@18: 
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@18: 	 lock   l;
samer@18:     return engPutVariable(x->engine, x->name, term_to_mx(val)) ? FALSE : TRUE;
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@13:   // printf(" - mlExec: Entering                 \r"); fflush(stdout); 
samer@0:   try {
samer@0:     eng *eng=findEngine(engine);
samer@0: 	 const char *cmdstr=PlTerm(cmd);
samer@0: 	 int	cmdlen=strlen(cmdstr);
samer@0: 	 int	rc;
samer@18: 	 lock l;
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:       engPutVariable(eng->ep,"t__cmd",mxcmd);
samer@0:       mxDestroyArray(mxcmd);
samer@0: 		cmdstr="eval(t__cmd)";
samer@0: 		cmdlen=strlen(cmdstr);
samer@0: 	 }
samer@0: 
samer@15: 	 {  // scope for eval_cmd
samer@15: 		 char *eval_cmd = new char[cmdlen+strlen(EVALFMT)-1];
samer@15: 	 	 if (eval_cmd==NULL) throw PlException("Failed to allocate memory for command");
samer@15: 	 	 sprintf(eval_cmd, EVALFMT, cmdstr);
samer@15: 	 	 //printf("-- Calling Matlab engine...                 \r"); fflush(stdout);
samer@18: 		 rc=engEvalString(eng->ep,eval_cmd); 
samer@15: 	 	 //printf("-- Returned from Matlab engine...            \r"); fflush(stdout);
samer@15: 	 	 delete [] eval_cmd;
samer@15: 	}
samer@15: 
samer@15:     if (rc) { throw PlException("mlExec: engEvalString failed."); }
samer@0: 
samer@14: 	 // EVALFMT starts with disp('#'). This means that the output buffer should
samer@15: 	 // contain at least the 5 characters: ">> #\n". If they are not there,
samer@13: 	 // something is terribly wrong and we must throw an exeption to avoid
samer@15: 	 // locking up in triserver.
samer@14:     if (strncmp(eng->outbuf,">> #\n",5)!=0) {
samer@18: 		 throw PlException(PlCompound("bad_output_buffer",PlTermv("exec",eng->outbuf)));
samer@13: 	 }
samer@23: 	
samer@15: 	 // write whatever is in the output buffer now, starting after the "#\n"
samer@24:     displayOutput("| ", eng->outbuf+5);
samer@12: 
samer@15: #ifdef ALT_LASTERR
samer@15: 
samer@15: 	 // --------------- ALTERNATIVE LASTERR SCHEME ------------------
samer@23: 	 // call engine to eval lasterr, then scrape from output buffer: it's faster and easier.
samer@0: 
samer@14: 	 rc=engEvalString(eng->ep,"lasterr");
samer@15: 	 if (rc) { throw PlException("mlExec: unable to execute lasterr"); }
samer@14: 	 if (strncmp(eng->outbuf,">> \nans =",9)!=0) {
samer@18: 		 throw PlException(PlCompound("bad_output_buffer",PlTermv("lasterr",eng->outbuf)));
samer@14: 	 }
samer@14: 
samer@14: 	 if (strncmp(eng->outbuf+11,"     ''",7)!=0) {
samer@14: 		int len=strlen(eng->outbuf+11)-2;
samer@15: 		char *lasterr= new char[len+1];
samer@14: 		term_t desc=PL_new_term_ref();
samer@14: 		term_t cmd=PL_new_term_ref();
samer@14: 		term_t ex=PL_new_term_ref();
samer@15: 
samer@14: 		memcpy(lasterr,eng->outbuf+11,len);
samer@14: 		lasterr[len]=0;
samer@14: 
samer@14: 		PL_put_atom_chars(desc,lasterr);
samer@14: 		PL_put_atom_chars(cmd,cmdstr);
samer@15: 		delete [] lasterr;
samer@15: 
samer@14: 		check(PL_cons_functor(ex,mlerror,engine,desc,cmd));
samer@14: 		throw PlException(ex);
samer@14:     }
samer@14: 
samer@15: #else
samer@14: 
samer@15: 	 // --------------- ORIGINAL LASTERR SCHEME ------------------
samer@15: 	 // Execution puts lasterr into t__ex, then we use engGetVariable to
samer@15: 	 // retrieve it.
samer@15: 
samer@14: 	 //printf(" - mlExec: output buffer: '%s'\n",eng->outbuf);
samer@0:     mxArray *lasterr = engGetVariable(eng->ep, "t__ex");
samer@14: 	 //printf(" - mlExec: output buffer after: ++%s++\n",eng->outbuf);
samer@13: 	 //printf(" - mlExec: Got last error (%p)               \r",lasterr); fflush(stdout);
samer@12: 
samer@12: 	 if (!lasterr) {
samer@13: 		 printf("\n** mlExec: unable to get lasterr.\n");
samer@14: 		 printf("** mlExec: Output buffer contains: '%s'.\n",eng->outbuf);
samer@13: 		 throw PlException("mlExec: unable to get lasterr");
samer@14: 	 }
samer@0:     
samer@15:     if (mxGetNumberOfElements(lasterr)==0) mxDestroyArray(lasterr);
samer@15: 	 else {
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@15: 	 } 
samer@15: #endif
samer@23: 
samer@12: 	 return TRUE;
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: