1;;; Matlab API interface
2;;; <http://www.mathworks.com/access/helpdesk/help/techdoc/apiref/apiref.shtml>
3;;;
4;;; Copyright (C) 2004-2008 by Sam Steingold
5;;; This is Free Software, distributed under the GNU GPL v2+
6;;; See http://www.gnu.org/copyleft/gpl.html
7
8(defpackage "MATLAB"
9  (:modern t)
10  (:use "COMMON-LISP" "FFI")
11  (:shadowing-import-from "EXPORTING"
12    #:defconstant #:defun #:defmacro #:defvar
13    #:def-c-type #:def-c-enum #:def-c-struct #:def-c-var #:def-call-out))
14
15(in-package "MATLAB")
16
17(setf (documentation (find-package "MATLAB") 'sys::impnotes) "matlab")
18
19;;; types and constants
20
21
22;;; foreign function definitions
23
24(default-foreign-language :stdc)
25
26;;; --- Engine ---
27(c-lines "#include <engine.h>~%")
28(def-c-type Engine c-pointer)
29;; int engClose(Engine *ep);
30(def-call-out engClose (:arguments (ep Engine)) (:return-type int))
31;; Engine *engOpen(const char *startcmd);
32(def-call-out engOpen (:arguments (startcmd c-string)) (:return-type Engine))
33
34;; int engEvalString(Engine *ep, const char *string);
35(def-call-out engEvalString (:arguments (ep Engine) (cmd c-string))
36  (:return-type int))
37;; int engOutputBuffer(Engine *ep, char *p, int n);
38(def-call-out engOutputBuffer (:arguments (ep Engine) (p c-pointer) (n int))
39  (:return-type int))
40
41(def-c-type mxArray c-pointer)
42;; mxArray *engGetVariable(Engine *ep, const char *name);
43(def-call-out engGetVariable (:arguments (ep Engine) (name c-string))
44  (:return-type mxArray))
45;; int engPutVariable(Engine *ep, const char *name, const mxArray *mp);
46(def-call-out engPutVariable
47    (:arguments (ep Engine) (name c-string) (mp mxArray))
48  (:return-type int))
49
50;;; windows-only
51;; int engGetVisible(Engine *ep, bool *value);
52#+win32
53(def-call-out engGetVisible
54    (:arguments (ep Engine) (value (c-ptr boolean) :out))
55  (:return-type int))
56;; int engSetVisible(Engine *ep, bool value);
57#+win32
58(def-call-out engSetVisible (:arguments (ep Engine) (value boolean))
59  (:return-type int))
60
61;;; windows-only
62;; Engine *engOpenSingleUse(const char *startcmd, void *dcom, int *retstatus);
63#+win32
64(def-call-out engOpenSingleUse
65    (:arguments (startcmd c-string) (dcom c-pointer)
66                (retstatus (c-ptr int) :out))
67  (:return-type Engine))
68
69;;; --- MAT-File ---
70(c-lines "#include <mat.h>~%")
71(def-c-type MATFile c-pointer)
72;; int matClose(MATFile *mfp);
73(def-call-out matClose (:arguments (mfp MATFile)) (:return-type int))
74;; MATFile *matOpen(const char *filename, const char *mode);
75(def-call-out matOpen (:arguments (filename c-string) (mode c-string))
76  (:return-type MATFile))
77
78;; char **matGetDir(MATFile *mfp, int *num);
79(def-call-out matGetDir (:arguments (mfp MATFile) (num (c-ptr int) :out))
80  (:return-type c-pointer)) ; release with mxFree()
81
82;; FILE *matGetFp(MATFile *mfp);
83(def-call-out matGetFp (:arguments (mfp MATFile)) (:return-type c-pointer))
84
85;; mxArray *matGetNextVariable(MATFile *mfp, const char *name);
86(def-call-out matGetNextVariable
87    (:arguments (mfp MATFile) (name (c-ptr c-string) :out))
88  (:return-type mxArray))
89
90;; mxArray *matGetNextVariableInfo(MATFile *mfp, const char *name);
91(def-call-out matGetNextVariableInfo
92    (:arguments (mfp MATFile) (name (c-ptr c-string) :out))
93  (:return-type mxArray))
94
95;; mxArray *matGetVariable(MATFile *mfp, const char *name);
96(def-call-out matGetVariable (:arguments (mfp MATFile) (name c-string))
97  (:return-type mxArray))
98;; mxArray *matGetVariableInfo(MATFile *mfp, const char *name);
99(def-call-out matGetVariableInfo (:arguments (mfp MATFile) (name c-string))
100  (:return-type mxArray))
101;; int matPutVariable(MATFile *mfp, const char *name, const mxArray *mp);
102(def-call-out matPutVariable
103    (:arguments (mfp MATFile) (name c-string) (mp mxArray))
104  (:return-type int))
105;; int matDeleteVariable(MATFile *mfp, const char *name);
106(def-call-out matDeleteVariable (:arguments (mfp MATFile) (name c-string))
107  (:return-type int))
108;; int matPutVariableAsGlobal(MATFile*mfp, const char*name, const mxArray*mp);
109(def-call-out matPutVariableAsGlobal
110    (:arguments (mfp MATFile) (name c-string) (mp mxArray))
111  (:return-type int))
112
113
114
115;;; --- MEX ---
116(c-lines "#include <mex.h>~%")
117;; int mexAtExit(void (*ExitFcn)(void));
118(def-call-out mexAtExit (:arguments (func (c-function (:arguments))))
119  (:return-type int))
120;; extern int mexCallMATLAB(
121;;     int         nlhs,                   /* number of expected outputs */
122;;     mxArray     *plhs[],                /* pointer array to outputs */
123;;     int         nrhs,                   /* number of inputs */
124;;     mxArray     *prhs[],                /* pointer array to inputs */
125;;     const char  *fcn_name               /* name of function to execute */
126;;     );
127(def-call-out mexCallMATLAB
128    (:arguments (nlhs int) (plhs (c-ptr (c-array-max mxArray 50)) :out)
129                (nrhs int) (prhs (c-array-max mxArray 50))
130                (fcn_name c-string))
131  (:return-type int))
132;; Issue error message and return to MATLAB prompt
133;; extern void mexErrMsgTxt(const char *error_msg);
134(def-call-out mexErrMsgTxt (:arguments (error_msg c-string))
135  (:return-type nil))
136;; Issue formatted error message with corresponding error identifier and
137;; return to MATLAB prompt.
138;; extern void mexErrMsgIdAndTxt(
139;;    const char * identifier, /* string with error message identifier */
140;;    const char * err_msg,    /* printf-style format */
141;;    ...                      /* any additional arguments */
142;;    );
143(def-call-out mexErrMsgIdAndTxt
144    (:arguments (identifier c-string) (err_msg c-string))
145  (:return-type nil))
146;; Invoke an unidentified warning. Such warnings can only be affected by
147;; the M-code 'warning * all', since they have no specific identifier.
148;; extern void mexWarnMsgTxt(const char *warn_msg);
149(def-call-out mexWarnMsgTxt (:arguments (warn_msg c-string))
150  (:return-type nil))
151;; Invoke a warning with message identifier 'identifier' and message
152;; derived from 'fmt' and subsequent arguments. The warning may either
153;; get printed as is (if it is set to 'on'), or not actually get printed
154;; (if set to 'off'). See 'help warning' in MATLAB for more details.
155;; extern void mexWarnMsgIdAndTxt(
156;;     const char * identifier,    /* string with warning message identifer */
157;;     const char * warn_msg,      /* printf-style format */
158;;     ...                         /* any additional arguments */
159;;     );
160(def-call-out mexWarnMsgIdAndTxt
161    (:arguments (identifier c-string) (warn_msg c-string))
162  (:return-type nil))
163
164;; Parse and execute MATLAB syntax in string.
165;; Returns zero if successful, and a non zero value if an error occurs.
166;; extern int mexEvalString(const char *str /* matlab command string */);
167(def-call-out mexEvalString (:arguments (command c-string))
168  (:return-type int))
169;; mexFunction is the user defined C routine which is called upon
170;; invocation of a mex function.
171;; void mexFunction(
172;;     int           nlhs,      /* number of expected outputs */
173;;     mxArray       *plhs[],   /* array of pointers to output arguments */
174;;     int           nrhs,      /* number of inputs */
175;;     const mxArray *prhs[]    /* array of pointers to input arguments */
176;; );
177;(def-call-out mexFunction
178;    (:arguments (nlhs int) (plhs (c-ptr (c-array-max mxArray 50)) :out)
179;                (nrhs int) (prhs (c-array-max mxArray 50)))
180;  (:return-type nil))
181;; Return the name of a the MEXfunction currently executing.
182;; extern const char *mexFunctionName(void);
183(def-call-out mexFunctionName (:arguments) (:return-type c-string))
184;; API interface which mimics the "get" function
185;; extern const mxArray *mexGet(double handle, const char *property);
186
187(def-call-out mexGet (:arguments (handle double-float) (property c-string))
188  (:return-type mxArray))
189;; mex equivalent to MATLAB's "set" function
190;; extern int mexSet(double handle, const char *property, mxArray *value);
191(def-call-out mexSet
192    (:arguments (handle double-float) (property c-string) (value mxArray))
193  (:return-type int))
194
195;; return a copy of the array value with the specified variable name in
196;; the specified workspace
197;; extern mxArray *mexGetVariable(const char *workspace, const char *name);
198(def-call-out mexGetVariable (:arguments (workspace c-string) (name c-string))
199  (:return-type mxArray))
200;; return a pointer to the array value with the specified variable name
201;; in the specified workspace
202;; extern const mxArray *mexGetVariablePtr(const char *workspace, const char *name);
203(def-call-out mexGetVariablePtr
204    (:arguments (workspace c-string) (name c-string))
205  (:return-type mxArray))
206
207;; Tell whether or not a mxArray is in MATLAB's global workspace.
208;; extern bool mexIsGlobal(const mxArray *pA);
209(def-call-out mexIsGlobal (:arguments (arr mxArray)) (:return-type boolean))
210
211;; Lock a MEX-function so that it cannot be cleared from memory.
212;; extern void mexLock(void);
213(def-call-out mexLock (:arguments) (:return-type nil))
214;; Unlock a locked MEX-function so that it can be cleared from memory.
215;; extern void mexUnlock(void);
216(def-call-out mexUnlock (:arguments) (:return-type nil))
217;; Return true if the MEX-function is currently locked, false otherwise.
218;; extern bool mexIsLocked(void);
219(def-call-out mexIsLocked (:arguments) (:return-type boolean))
220
221;; Remove all components of an array plus the array header itself
222;; from MATLAB's memory allocation list.  The array will now
223;; persist between calls to the mex function.  To destroy this
224;; array, you will need to explicitly call mxDestroyArray().
225;; extern void mexMakeArrayPersistent(mxArray *pa);
226(def-call-out mexMakeArrayPersistent (:arguments (arr mxArray))
227  (:return-type nil))
228;; Remove memory previously allocated via mxCalloc from MATLAB's
229;; memory allocation list.  To free this memory, you will need to
230;; explicitly call mxFree().
231;; extern void mexMakeMemoryPersistent(void *ptr);
232(def-call-out mexMakeMemoryPersistent (:arguments (ptr c-pointer))
233  (:return-type nil))
234
235;; mex equivalent to MATLAB's "disp" function
236;; extern int mexPrintf(const char *fmt, ...);
237
238;; Place a copy of the array value into the specified workspace with the
239;; specified name
240;; extern int mexPutVariable(const char *workspace,const char *name,const mxArray *parray);
241(def-call-out mexPutVariable
242    (:arguments (workspace c-string) (name c-string) (arr mxArray))
243  (:return-type int))
244
245;; set or clear mexCallMATLAB trap flag (if set then an error in
246;; mexCallMATLAB is caught and mexCallMATLAB will return a status value,
247;; if not set an error will cause control to revert to MATLAB)
248;; extern void mexSetTrapFlag(int flag);
249(def-call-out mexSetTrapFlag (:arguments (flag int)) (:return-type nil))
250
251;;; --- MX --- <FIXME:incomplete>
252(c-lines "#include <matrix.h>~%")
253(defconstant mxMAXNAM 64)
254
255;; extern int mxAddField(mxArray array_ptr, const char *field_name);
256(def-call-out mxAddField (:arguments (array_ptr mxArray) (field_name c-string))
257  (:return-type int))
258
259;; void mxFree(void *ptr);
260(def-call-out mxFree (:arguments (ptr c-pointer)) (:return-type nil))
261
262;; typedef enum mxComplexity {mxREAL=0, mxCOMPLEX};
263(def-c-enum mxComplexity (mxREAL 0) mxCOMPLEX})
264
265;; mxArray *mxCreateDoubleMatrix(int m, int n, mxComplexity ComplexFlag);
266(def-call-out mxCreateDoubleMatrix (:return-type (c-pointer mxArray))
267  (:arguments (m int) (n int) (complexflag mxComplexity)))
268;; void mxDestroyArray(mxArray *array_ptr);
269(def-call-out mxDestroyArray (:return-type nil)
270  (:arguments (array_ptr (c-pointer mxArray))))
271
272;; mxArray *mxCreateDoubleScalar(double value);
273(def-call-out mxCreateDoubleScalar (:return-type (c-pointer mxArray))
274  (:arguments (value double-float)))
275
276;; double mxGetEps(void);
277(def-call-out mxGetEps (:return-type double-float) (:arguments))
278
279;; double *mxGetPr(const mxArray *array_ptr);
280(def-call-out mxGetPr (:return-type (c-pointer double-float))
281  (:arguments (array_ptr (c-pointer mxArray))))
282;; double *mxGetPi(const mxArray *array_ptr);
283(def-call-out mxGetPi (:return-type (c-pointer double-float))
284  (:arguments (array_ptr (c-pointer mxArray))))
285;; void mxSetPr(mxArray *array_ptr, double *pr);
286(def-call-out mxSetPr (:return-type nil)
287  (:arguments (array_ptr (c-pointer mxArray))
288              (data (c-pointer double-float))))
289;; void mxSetPi(mxArray *array_ptr, double *pi);
290(def-call-out mxSetPi (:return-type nil)
291  (:arguments (array_ptr (c-pointer mxArray))
292              (data (c-pointer double-float))))
293;; get/set an individial array element
294;; real
295(c-lines "double mx_aref_r (const mxArray *array_ptr, int i, int j, int n) { return mxGetPr(array_ptr)[i+n*j]; }~%")
296(def-call-out mx-aref-r (:return-type double-float) (:name "mx_aref_r")
297  (:arguments (array_ptr (c-pointer mxArray))
298              (i int) (j int) (n int)))
299(c-lines "void set_mx_aref_r (const mxArray *array_ptr, int i, int j, int n, double val) { mxGetPr(array_ptr)[i+n*j] = val; }~%")
300(ffi:def-call-out set_mx_aref_r (:return-type nil)
301  (:arguments (array_ptr (c-pointer mxArray)) (i int) (j int) (n int)
302              (val double-float)))
303(defsetf mx-aref-r set_mx_aref_r)
304;; imaginary
305(c-lines "double mx_aref_i (const mxArray *array_ptr, int i, int j, int n) { return mxGetPr(array_ptr)[i+n*j]; }~%")
306(def-call-out mx-aref-i (:return-type double-float) (:name "mx_aref_i")
307  (:arguments (array_ptr (c-pointer mxArray))
308              (i int) (j int) (n int)))
309(c-lines "void set_mx_aref_i (const mxArray *array_ptr, int i, int j, int n, double val) { mxGetPr(array_ptr)[i+n*j] = val; }~%")
310(ffi:def-call-out set_mx_aref_i (:return-type nil)
311  (:arguments (array_ptr (c-pointer mxArray)) (i int) (j int) (n int)
312              (val double-float)))
313(defsetf mx-aref-i set_mx_aref_i)
314;; void *mxGetData(const mxArray *array_ptr);
315(def-call-out mxGetData (:return-type c-pointer)
316  (:arguments (array_ptr (c-pointer mxArray))))
317
318;; int mxGetNumberOfDimensions(const mxArray *array_ptr);
319(def-call-out mxGetNumberOfDimensions (:return-type int)
320  (:arguments (array_ptr (c-pointer mxArray))))
321;; const int *mxGetDimensions(const mxArray *array_ptr);
322(def-call-out mxGetDimensions (:return-type (c-pointer int))
323  (:arguments (array_ptr (c-pointer mxArray))))
324;; int mxGetNumberOfElements(const mxArray *array_ptr);
325(def-call-out mxGetNumberOfElements (:return-type int)
326  (:arguments (array_ptr (c-pointer mxArray))))
327;; int mxGetElementSize(const mxArray *array_ptr);
328(def-call-out mxGetElementSize (:return-type int)
329  (:arguments (array_ptr (c-pointer mxArray))))
330;; int mxGetNumberOfFields(const mxArray *array_ptr);
331(def-call-out mxGetNumberOfFields (:return-type int)
332  (:arguments (array_ptr (c-pointer mxArray))))
333;; int mxGetNzmax(const mxArray *array_ptr);
334(def-call-out mxGetNzmax (:return-type int)
335  (:arguments (array_ptr (c-pointer mxArray))))
336;; int mxGetM(const mxArray *array_ptr);
337(def-call-out mxGetM (:return-type int)
338  (:arguments (array_ptr (c-pointer mxArray))))
339;; int mxGetN(const mxArray *array_ptr);
340(def-call-out mxGetN (:return-type int)
341  (:arguments (array_ptr (c-pointer mxArray))))
342
343;; double mxGetScalar(const mxArray *array_ptr);
344(def-call-out mxGetScalar (:return-type double-float)
345  (:arguments (array_ptr (c-pointer mxArray))))
346
347;; bool mxIsCell(const mxArray *array_ptr);
348(def-call-out mxIsCell (:return-type boolean)
349  (:arguments (array_ptr (c-pointer mxArray))))
350;; bool mxIsChar(const mxArray *array_ptr);
351(def-call-out mxIsChar (:return-type boolean)
352  (:arguments (array_ptr (c-pointer mxArray))))
353;; bool mxIsComplex(const mxArray *array_ptr);
354(def-call-out mxIsComplex (:return-type boolean)
355  (:arguments (array_ptr (c-pointer mxArray))))
356;; bool mxIsDouble(const mxArray *array_ptr);
357(def-call-out mxIsDouble (:return-type boolean)
358  (:arguments (array_ptr (c-pointer mxArray))))
359;; bool mxIsEmpty(const mxArray *array_ptr);
360(def-call-out mxIsEmpty (:return-type boolean)
361  (:arguments (array_ptr (c-pointer mxArray))))
362;; bool mxIsInt8(const mxArray *array_ptr);
363(def-call-out mxIsInt8 (:return-type boolean)
364  (:arguments (array_ptr (c-pointer mxArray))))
365;; bool mxIsInt16(const mxArray *array_ptr);
366(def-call-out mxIsInt16 (:return-type boolean)
367  (:arguments (array_ptr (c-pointer mxArray))))
368;; bool mxIsInt32(const mxArray *array_ptr);
369(def-call-out mxIsInt32 (:return-type boolean)
370  (:arguments (array_ptr (c-pointer mxArray))))
371;; bool mxIsInt64(const mxArray *array_ptr);
372(def-call-out mxIsInt64 (:return-type boolean)
373  (:arguments (array_ptr (c-pointer mxArray))))
374;; bool mxIsLogical(const mxArray *array_ptr);
375(def-call-out mxIsLogical (:return-type boolean)
376  (:arguments (array_ptr (c-pointer mxArray))))
377;; bool mxIsLogicalScalarTrue(const mxArray *array_ptr);
378(def-call-out mxIsLogicalScalarTrue (:return-type boolean)
379  (:arguments (array_ptr (c-pointer mxArray))))
380;; bool mxIsNumeric(const mxArray *array_ptr);
381(def-call-out mxIsNumeric (:return-type boolean)
382  (:arguments (array_ptr (c-pointer mxArray))))
383;; bool mxIsSparse(const mxArray *array_ptr);
384(def-call-out mxIsSparse (:return-type boolean)
385  (:arguments (array_ptr (c-pointer mxArray))))
386;; bool mxIsSingle(const mxArray *array_ptr);
387(def-call-out mxIsSingle (:return-type boolean)
388  (:arguments (array_ptr (c-pointer mxArray))))
389;; bool mxIsStruct(const mxArray *array_ptr);
390(def-call-out mxIsStruct (:return-type boolean)
391  (:arguments (array_ptr (c-pointer mxArray))))
392;; bool mxIsUint8(const mxArray *array_ptr);
393(def-call-out mxIsUint8 (:return-type boolean)
394  (:arguments (array_ptr (c-pointer mxArray))))
395;; bool mxIsUint16(const mxArray *array_ptr);
396(def-call-out mxIsUint16 (:return-type boolean)
397  (:arguments (array_ptr (c-pointer mxArray))))
398;; bool mxIsUint32(const mxArray *array_ptr);
399(def-call-out mxIsUint32 (:return-type boolean)
400  (:arguments (array_ptr (c-pointer mxArray))))
401;; bool mxIsUint64(const mxArray *array_ptr);
402(def-call-out mxIsUint64 (:return-type boolean)
403  (:arguments (array_ptr (c-pointer mxArray))))
404;; bool mxIsClass(const mxArray *array_ptr, const char *name);
405(def-call-out mxIsClass (:return-type boolean)
406  (:arguments (array_ptr (c-pointer mxArray)) (name c-string)))
407
408(def-c-enum mxClassID
409  (mxUNKNOWN_CLASS 0)
410  mxCELL_CLASS
411  mxSTRUCT_CLASS
412  mxLOGICAL_CLASS
413  mxCHAR_CLASS
414  mxSPARSE_CLASS                ; OBSOLETE! DO NOT USE
415  mxDOUBLE_CLASS
416  mxSINGLE_CLASS
417  mxINT8_CLASS
418  mxUINT8_CLASS
419  mxINT16_CLASS
420  mxUINT16_CLASS
421  mxINT32_CLASS
422  mxUINT32_CLASS
423  mxINT64_CLASS                 ; place holder - future enhancements
424  mxUINT64_CLASS                ; place holder - future enhancements
425  mxFUNCTION_CLASS
426  mxOPAQUE_CLASS
427  mxOBJECT_CLASS)
428;; mxClassID mxGetClassID(const mxArray *array_ptr);
429(def-call-out mxGetClassID (:return-type mxClassID)
430  (:arguments (array_ptr (c-pointer mxArray))))
431;; const char *mxGetClassName(const mxArray *array_ptr);
432(def-call-out mxGetClassName (:return-type c-string)
433  (:arguments (array_ptr (c-pointer mxArray))))
434
435
436(pushnew :matlab *features*)
437(provide "matlab")
438(pushnew "MATLAB" custom:*system-package-list* :test #'string=)
439