|
5864
|
1 /* |
|
|
2 |
|
|
3 Copyright (C) 2001, 2006 Paul Kienzle |
|
|
4 |
|
|
5 This file is part of Octave. |
|
|
6 |
|
|
7 Octave is free software; you can redistribute it and/or modify it |
|
|
8 under the terms of the GNU General Public License as published by the |
|
|
9 Free Software Foundation; either version 2, or (at your option) any |
|
|
10 later version. |
|
|
11 |
|
|
12 Octave is distributed in the hope that it will be useful, but WITHOUT |
|
|
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
|
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
|
15 for more details. |
|
|
16 |
|
|
17 You should have received a copy of the GNU General Public License |
|
|
18 along with Octave; see the file COPYING. If not, write to the Free |
|
|
19 Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
|
|
20 02110-1301, USA. |
|
|
21 |
|
|
22 */ |
|
|
23 |
|
|
24 // This code was originally distributed as part of Octave Forge under |
|
5879
|
25 // the following terms: |
|
5864
|
26 // |
|
|
27 // Author: Paul Kienzle |
|
|
28 // I grant this code to the public domain. |
|
|
29 // 2001-03-22 |
|
|
30 // |
|
|
31 // THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' |
|
|
32 // AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED |
|
|
33 // TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A |
|
|
34 // PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR |
|
|
35 // CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, |
|
|
36 // SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT |
|
|
37 // LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF |
|
|
38 // USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND |
|
|
39 // ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, |
|
|
40 // OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT |
|
|
41 // OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF |
|
|
42 // SUCH DAMAGE. |
|
|
43 |
|
|
44 #include <cfloat> |
|
|
45 #include <csetjmp> |
|
|
46 #include <cstdlib> |
|
|
47 |
|
|
48 #include <iomanip> |
|
|
49 #include <set> |
|
|
50 #include <string> |
|
|
51 |
|
|
52 typedef void *Pix; |
|
|
53 typedef std::set<Pix> MemSet; |
|
|
54 |
|
|
55 #ifdef HAVE_CONFIG_H |
|
|
56 #include <config.h> |
|
|
57 #endif |
|
|
58 |
|
|
59 #include "oct.h" |
|
|
60 #include "pager.h" |
|
|
61 #include "f77-fcn.h" |
|
|
62 #include "unwind-prot.h" |
|
|
63 #include "lo-mappers.h" |
|
|
64 #include "lo-ieee.h" |
|
|
65 #include "parse.h" |
|
|
66 #include "toplev.h" |
|
|
67 #include "variables.h" |
|
|
68 #include "oct-map.h" |
|
|
69 #include "str-vec.h" |
|
|
70 |
|
|
71 // mex file context |
|
|
72 // |
|
|
73 // Class mex keeps track of all memory allocated and frees anything |
|
|
74 // not explicitly marked persistent when the it is destroyed. It also |
|
|
75 // maintains the setjump/longjump buffer required for non-local exit |
|
|
76 // from the mex file, and any other state local to this instance of |
|
|
77 // the mex function invocation. |
|
|
78 class mxArray; |
|
|
79 |
|
5879
|
80 // Prototypes for external functions. Must declare mxArray as a class |
|
5864
|
81 // before including this file. |
|
|
82 #include "mexproto.h" |
|
|
83 |
|
|
84 class mex |
|
|
85 { |
|
|
86 public: |
|
|
87 |
|
|
88 mex (void) { } |
|
|
89 |
|
|
90 ~mex (void) |
|
|
91 { |
|
|
92 if (! memlist.empty ()) |
|
|
93 error("mex: no cleanup performed"); |
|
|
94 } |
|
|
95 |
|
|
96 // free all unmarked pointers obtained from malloc and calloc |
|
|
97 static void cleanup (void *context); |
|
|
98 |
|
|
99 // allocate a pointer, and mark it to be freed on exit |
|
|
100 Pix malloc (int n); |
|
|
101 |
|
|
102 // allocate a pointer to be freed on exit, and initialize to 0 |
|
|
103 Pix calloc (int n, int t); |
|
|
104 |
|
|
105 // reallocate a pointer obtained from malloc or calloc |
|
|
106 Pix realloc (Pix ptr, int n); |
|
|
107 |
|
|
108 // free a pointer obtained from malloc or calloc |
|
|
109 void free (Pix ptr); |
|
|
110 |
|
|
111 // mark a pointer so that it will not be freed on exit |
|
|
112 void persistent (Pix ptr) { unmark (ptr); } |
|
|
113 |
|
|
114 // make a new array value and initialize it with zeros; it will be |
|
|
115 // freed on exit unless marked as persistent |
|
|
116 mxArray *make_value (int nr, int nc, int cmplx); |
|
|
117 |
|
|
118 // make a new array value and initialize from an octave value; it will be |
|
|
119 // freed on exit unless marked as persistent |
|
|
120 mxArray *make_value (const octave_value&); |
|
|
121 |
|
|
122 // make a new structure value and initialize with empty matrices |
|
|
123 // FIXME does this leak memory? Is it persistent? |
|
|
124 mxArray *make_value (int nr, int nc, const string_vector& keys); |
|
|
125 |
|
|
126 // free an array and its contents |
|
|
127 void free_value (mxArray *ptr); |
|
|
128 |
|
|
129 // mark an array and its contents so it will not be freed on exit |
|
|
130 void persistent (mxArray *ptr); |
|
|
131 |
|
|
132 // 1 if error should be returned to MEX file, 0 if abort |
|
|
133 int trap_feval_error; |
|
|
134 |
|
|
135 // longjmp return point if mexErrMsgTxt or error |
|
|
136 jmp_buf jump; |
|
|
137 |
|
|
138 // trigger a long jump back to the mex calling function |
|
|
139 void abort (void) { longjmp (jump, 1); } |
|
|
140 |
|
|
141 private: |
|
|
142 |
|
|
143 // list of memory resources that need to be freed upon exit |
|
|
144 MemSet memlist; |
|
|
145 |
|
|
146 // mark a pointer to be freed on exit |
|
|
147 void mark (Pix p); |
|
|
148 |
|
|
149 // unmark a pointer to be freed on exit, either because it was |
|
|
150 // made persistent, or because it was already freed |
|
|
151 void unmark (Pix p); |
|
|
152 }; |
|
|
153 |
|
|
154 // Current context |
|
|
155 mex *__mex = 0; |
|
|
156 |
|
|
157 // free all unmarked pointers obtained from malloc and calloc |
|
|
158 void |
|
|
159 mex::cleanup (Pix ptr) |
|
|
160 { |
|
|
161 mex *context = static_cast<mex *> (ptr); |
|
|
162 |
|
|
163 for (MemSet::iterator p = context->memlist.begin (); |
|
|
164 p != context->memlist.end (); p++) |
|
|
165 ::free (*p); |
|
|
166 |
|
|
167 context->memlist.clear (); |
|
|
168 } |
|
|
169 |
|
|
170 // mark a pointer to be freed on exit |
|
|
171 void |
|
|
172 mex::mark (Pix p) |
|
|
173 { |
|
|
174 #ifdef DEBUG |
|
|
175 if (memlist.find (p) != memlist.end ()) |
|
|
176 warning ("%s: double registration ignored", mexFunctionName ()); |
|
|
177 #endif |
|
|
178 |
|
|
179 memlist.insert (p); |
|
|
180 } |
|
|
181 |
|
|
182 // unmark a pointer to be freed on exit, either because it was |
|
|
183 // made persistent, or because it was already freed |
|
|
184 void |
|
|
185 mex::unmark (Pix p) |
|
|
186 { |
|
|
187 #ifdef DEBUG |
|
|
188 if (memlist.find (p) != memlist.end ()) |
|
|
189 warning ("%s: value not marked", mexFunctionName ()); |
|
|
190 #endif |
|
|
191 |
|
|
192 memlist.erase (p); |
|
|
193 } |
|
|
194 |
|
|
195 // allocate a pointer, and mark it to be freed on exit |
|
|
196 Pix |
|
|
197 mex::malloc (int n) |
|
|
198 { |
|
|
199 if (n == 0) |
|
|
200 return 0; |
|
|
201 #if 0 |
|
|
202 // FIXME -- how do you allocate and free aligned, non-typed |
|
|
203 // memory in C++? |
|
|
204 Pix ptr = Pix (new double[(n+sizeof(double)-1)/sizeof(double)]); |
|
|
205 #else |
|
|
206 // FIXME -- can we mix C++ and C-style heap management? |
|
|
207 Pix ptr = ::malloc (n); |
|
|
208 |
|
|
209 if (! ptr) |
|
|
210 { |
|
|
211 // FIXME -- could use "octave_new_handler();" instead |
|
|
212 error ("%s: out of memory", mexFunctionName ()); |
|
|
213 abort (); |
|
|
214 } |
|
|
215 #endif |
|
|
216 |
|
|
217 mark (ptr); |
|
|
218 |
|
|
219 return ptr; |
|
|
220 } |
|
|
221 |
|
|
222 // allocate a pointer to be freed on exit, and initialize to 0 |
|
|
223 Pix |
|
|
224 mex::calloc (int n, int t) |
|
|
225 { |
|
|
226 Pix v = malloc (n*t); |
|
|
227 |
|
|
228 memset (v, 0, n*t); |
|
|
229 |
|
|
230 return v; |
|
|
231 } |
|
|
232 |
|
|
233 // reallocate a pointer obtained from malloc or calloc |
|
|
234 Pix |
|
|
235 mex::realloc (Pix ptr, int n) |
|
|
236 { |
|
|
237 #if 0 |
|
|
238 error ("%s: cannot reallocate using C++ new/delete operations", |
|
|
239 mexFunctionName ()); |
|
|
240 abort (); |
|
|
241 #else |
|
|
242 Pix v = 0; |
|
|
243 if (n == 0) |
|
|
244 free (ptr); |
|
|
245 else if (! ptr) |
|
|
246 v = malloc (n); |
|
|
247 else |
|
|
248 { |
|
|
249 v = ::realloc (ptr, n); |
|
|
250 MemSet::iterator p = memlist.find (ptr); |
|
|
251 if (v && p != memlist.end ()) |
|
|
252 { |
|
|
253 memlist.erase (p); |
|
|
254 memlist.insert (v); |
|
|
255 } |
|
|
256 } |
|
|
257 #endif |
|
|
258 return v; |
|
|
259 } |
|
|
260 |
|
|
261 // free a pointer obtained from malloc or calloc |
|
|
262 void |
|
|
263 mex::free (Pix ptr) |
|
|
264 { |
|
|
265 unmark (ptr); |
|
|
266 #if 0 |
|
|
267 delete [] ptr; |
|
|
268 #else |
|
|
269 ::free (ptr); |
|
|
270 #endif |
|
|
271 } |
|
|
272 |
|
|
273 // mxArray data type |
|
|
274 // |
|
|
275 // Class mxArray is not much more than a struct for keeping together |
|
|
276 // dimensions and data. It doesn't even ensure consistency between |
|
|
277 // the dimensions and the data. Unfortunately you can't do better |
|
|
278 // than this without restricting the operations available in Matlab |
|
|
279 // for directly manipulating its mxArray type. |
|
|
280 |
|
|
281 typedef unsigned short mxChar; |
|
|
282 const int mxMAXNAM=64; |
|
|
283 |
|
|
284 class mxArray |
|
|
285 { |
|
|
286 public: |
|
|
287 |
|
|
288 mxArray(void) |
|
|
289 { |
|
|
290 nr = nc = -1; |
|
|
291 pr = pi = NULL; |
|
|
292 keys = NULL; |
|
|
293 pmap = NULL; |
|
|
294 isstr = false; |
|
|
295 aname[0] = '\0'; |
|
|
296 } |
|
|
297 |
|
|
298 ~mxArray (void) |
|
|
299 { |
|
|
300 if (pmap) |
|
|
301 { |
|
|
302 // FIXME why don't string_vectors work? |
|
|
303 for (int i = 0; i < pmap->length (); i++) |
|
|
304 delete [] keys[i]; |
|
|
305 |
|
|
306 delete [] keys; |
|
|
307 } |
|
|
308 } |
|
|
309 |
|
|
310 octave_value as_octave_value (void) const; |
|
|
311 |
|
|
312 int rows (void) const { return nr; } |
|
|
313 int columns (void) const { return nc; } |
|
|
314 void rows (int r) { nr = r; } |
|
|
315 void columns (int c) { nc = c; } |
|
|
316 int dims (void) const { return 2; } |
|
|
317 |
|
|
318 double *imag (void) const { return pi; } |
|
|
319 double *real (void) const { return pr; } |
|
|
320 void imag (double *p) { pi = p; } |
|
|
321 void real (double *p) { pr = p; } |
|
|
322 |
|
|
323 bool is_empty (void) const { return nr==0 || nc==0; } |
|
|
324 bool is_numeric (void) const { return ! isstr && (pr || nr == 0 || nc == 0); } |
|
|
325 bool is_complex (void) const { return pi; } |
|
|
326 bool is_sparse (void) const { return false; } |
|
|
327 bool is_struct (void) const { return pmap; } |
|
|
328 |
|
|
329 bool is_string (void) const { return isstr; } |
|
|
330 void is_string (bool set) { isstr = set; } |
|
|
331 |
|
|
332 const char *name (void) const { return aname; } |
|
|
333 void name (const char *nm) |
|
|
334 { |
|
|
335 strncpy (aname, nm, mxMAXNAM); |
|
|
336 aname[mxMAXNAM]='\0'; |
|
|
337 } |
|
|
338 |
|
|
339 // Structure support functions. Matlab uses a fixed field order |
|
|
340 // (the order in which the fields were added?), but Octave uses an |
|
|
341 // unordered hash for structs. We can emulate a fixed field order |
|
|
342 // using pmap->keys(), which returns a string_vector of key names, |
|
|
343 // but these keys will not be in the same order as the keys given in |
|
|
344 // mxCreateStruct*. Within the creating function, we can populate |
|
|
345 // the key name vector in the order given, so the only problem will |
|
|
346 // be those functions which assume the key order is maintained |
|
|
347 // between calls from Matlab. Unfortunately, these might exist and |
|
|
348 // I can't detect them :-( |
|
|
349 |
|
|
350 // Return the map value |
|
|
351 Octave_map *map (void) const { return pmap; } |
|
|
352 |
|
|
353 // New structure with the given presumed field order (CreateStruct call) |
|
|
354 void map (Octave_map *p, const string_vector& mapkeys) |
|
|
355 { |
|
|
356 pmap = p; |
|
|
357 keys = mapkeys.c_str_vec (); |
|
|
358 } |
|
|
359 |
|
|
360 // New structure with unknown field order (passed in from Octave) |
|
|
361 void map (Octave_map *p) |
|
|
362 { |
|
|
363 pmap = p; |
|
|
364 if (p) |
|
|
365 keys = p->keys().c_str_vec (); |
|
|
366 } |
|
|
367 |
|
|
368 // Get field given field name |
|
|
369 mxArray *field (const std::string& key_arg, const int index) const |
|
|
370 { |
|
|
371 if (pmap && pmap->contains (key_arg)) |
|
|
372 return __mex->make_value (pmap->contents(key_arg)(index)); |
|
|
373 else |
|
|
374 return 0; |
|
|
375 } |
|
|
376 |
|
|
377 // Set field given field name |
|
|
378 void field (const std::string& key_arg, const int index, mxArray *value) |
|
|
379 { |
|
|
380 if (pmap) |
|
|
381 pmap->assign (octave_value (index+1), |
|
|
382 key_arg, Cell (value->as_octave_value ())); |
|
|
383 |
|
|
384 if (error_state) |
|
|
385 __mex->abort (); |
|
|
386 } |
|
|
387 |
|
|
388 // Return number of fields in structure |
|
|
389 int num_keys(void) const { return pmap ? pmap->length () : 0; } |
|
|
390 |
|
|
391 // Return field name from field number |
|
|
392 const std::string key (const int key_num) const |
|
|
393 { |
|
|
394 if (key_num >= 0 && key_num < pmap->length ()) |
|
|
395 return keys[key_num]; |
|
|
396 else |
|
|
397 return 0; |
|
|
398 } |
|
|
399 // Return field number from field name |
|
|
400 int key (const std::string &key_name) const |
|
|
401 { |
|
|
402 for (int i = 0; i < pmap->length (); i++) |
|
|
403 if (key_name == std::string (keys[i])) |
|
|
404 return i; |
|
|
405 |
|
|
406 return -1; |
|
|
407 } |
|
|
408 |
|
|
409 // Get field using field number |
|
|
410 mxArray *field (const int key_num, const int index) const |
|
|
411 { |
|
|
412 if (key_num >= 0 && key_num < pmap->length ()) |
|
|
413 return field (keys[key_num], index); |
|
|
414 else |
|
|
415 return 0; |
|
|
416 } |
|
|
417 |
|
|
418 // Set field using field number |
|
|
419 void field (const int key_num, const int index , mxArray *value) |
|
|
420 { |
|
|
421 if (key_num >= 0 && key_num < pmap->length ()) |
|
|
422 field (keys[key_num], index, value); |
|
|
423 } |
|
|
424 |
|
|
425 private: |
|
|
426 int nr; |
|
|
427 int nc; |
|
|
428 double *pr; |
|
|
429 double *pi; |
|
|
430 // FIXME -- need to have a typeid here instead of complex logic on |
|
|
431 // isstr, pmap, pr, pi, etc. |
|
|
432 Octave_map *pmap; |
|
|
433 // string_vector keys; |
|
|
434 char **keys; |
|
|
435 bool isstr; |
|
|
436 char aname[mxMAXNAM+1]; |
|
|
437 }; |
|
|
438 |
|
|
439 octave_value |
|
|
440 mxArray::as_octave_value (void) const |
|
|
441 { |
|
|
442 octave_value ret; |
|
|
443 |
|
|
444 if (isstr) |
|
|
445 { |
|
|
446 charMatrix chm (nr, nc); |
|
|
447 char *pchm = chm.fortran_vec (); |
|
|
448 for (int i=0; i < nr*nc; i++) |
|
|
449 pchm[i] = NINT (pr[i]); |
|
|
450 ret = octave_value (chm, true); |
|
|
451 } |
|
|
452 else if (pmap) |
|
|
453 { |
|
|
454 ret = octave_value (*pmap); |
|
|
455 } |
|
|
456 else if (pi) |
|
|
457 { |
|
|
458 ComplexMatrix cm (nr, nc); |
|
|
459 Complex *pcm = cm.fortran_vec (); |
|
|
460 for (int i=0; i < nr*nc; i++) |
|
|
461 pcm[i] = Complex (pr[i], pi[i]); |
|
|
462 ret = cm; |
|
|
463 } |
|
|
464 else if (pr) |
|
|
465 { |
|
|
466 Matrix m (nr, nc); |
|
|
467 double *pm = m.fortran_vec (); |
|
|
468 memcpy (pm, pr, nr*nc*sizeof(double)); |
|
|
469 ret = m; |
|
|
470 } |
|
|
471 else |
|
|
472 ret = Matrix (0, 0); |
|
|
473 |
|
|
474 return ret; |
|
|
475 } |
|
|
476 |
|
|
477 |
|
|
478 // mex/mxArray interface |
|
|
479 |
|
|
480 // Make a new array value and initialize from an octave value; it will |
|
|
481 // be freed on exit unless marked as persistent. |
|
|
482 |
|
|
483 mxArray *mex::make_value(const octave_value &ov) |
|
|
484 { |
|
|
485 int nr = -1; |
|
|
486 int nc = -1; |
|
|
487 double *pr = 0; |
|
|
488 double *pi = 0; |
|
|
489 Octave_map *pmap = 0; |
|
|
490 |
|
|
491 if (ov.is_numeric_type () || ov.is_string ()) |
|
|
492 { |
|
|
493 nr = ov.rows (); |
|
|
494 nc = ov.columns (); |
|
|
495 } |
|
|
496 if (ov.is_map ()) |
|
|
497 { |
|
|
498 pmap = new Octave_map (ov.map_value ()); |
|
|
499 nr = ov.rows (); |
|
|
500 nc = ov.columns (); |
|
|
501 } |
|
|
502 else if (nr > 0 && nc > 0) |
|
|
503 { |
|
|
504 if (ov.is_string ()) |
|
|
505 { |
|
|
506 // FIXME - must use 16 bit unicode to represent strings. |
|
|
507 const Matrix m (ov.matrix_value (1)); |
|
|
508 pr = static_cast<double *> (malloc(nr*nc*sizeof(double))); |
|
|
509 memcpy (pr, m.data (), nr*nc*sizeof(double)); |
|
|
510 } |
|
|
511 else if (ov.is_complex_type ()) |
|
|
512 { |
|
|
513 // FIXME -- may want to consider lazy copying of the |
|
|
514 // matrix, but this will only help if the matrix is being |
|
|
515 // passed on to octave via callMATLAB later. |
|
|
516 const ComplexMatrix cm (ov.complex_matrix_value ()); |
|
|
517 const Complex *pz = cm.data (); |
|
|
518 pr = static_cast<double *> (malloc (nr*nc*sizeof(double))); |
|
|
519 pi = static_cast<double *> (malloc (nr*nc*sizeof(double))); |
|
|
520 for (int i = 0; i < nr*nc; i++) |
|
|
521 { |
|
|
522 pr[i] = real (pz[i]); |
|
|
523 pi[i] = imag (pz[i]); |
|
|
524 } |
|
|
525 } |
|
|
526 else |
|
|
527 { |
|
|
528 const Matrix m (ov.matrix_value ()); |
|
|
529 pr = static_cast<double *> (malloc (nr*nc*sizeof(double))); |
|
|
530 memcpy (pr, m.data (), nr*nc*sizeof(double)); |
|
|
531 } |
|
|
532 } |
|
|
533 |
|
|
534 mxArray *value = static_cast<mxArray *> (malloc (sizeof(mxArray))); |
|
|
535 |
|
|
536 value->is_string (ov.is_string ()); |
|
|
537 value->real (pr); |
|
|
538 value->imag (pi); |
|
|
539 value->map (pmap); |
|
|
540 value->rows (nr); |
|
|
541 value->columns (nc); |
|
|
542 value->name (""); |
|
|
543 |
|
|
544 return value; |
|
|
545 } |
|
|
546 |
|
|
547 // Make a new array value and initialize it with zeros; it will be |
|
|
548 // freed on exit unless marked as persistent. |
|
|
549 |
|
|
550 mxArray * |
|
|
551 mex::make_value (int nr, int nc, int cmplx) |
|
|
552 { |
|
|
553 |
|
|
554 mxArray *value = static_cast<mxArray *> (malloc (sizeof(mxArray))); |
|
|
555 double *p = static_cast<double *> (calloc (nr*nc, sizeof(double))); |
|
|
556 |
|
|
557 value->real (p); |
|
|
558 if (cmplx) |
|
|
559 value->imag (static_cast<double *> (calloc (nr*nc, sizeof(double)))); |
|
|
560 else |
|
|
561 value->imag (static_cast<double *> (Pix (0))); |
|
|
562 value->rows (nr); |
|
|
563 value->columns (nc); |
|
|
564 value->is_string (false); |
|
|
565 value->map (0); |
|
|
566 value->name (""); |
|
|
567 |
|
|
568 return value; |
|
|
569 } |
|
|
570 |
|
|
571 // Make a new structure value and initialize with empty matrices |
|
|
572 // FIXME does this leak memory? Is it persistent? |
|
|
573 |
|
|
574 mxArray * |
|
|
575 mex::make_value (int nr, int nc, const string_vector& keys) |
|
|
576 { |
|
|
577 if (keys.length () == 0) |
|
|
578 return 0; |
|
|
579 |
|
|
580 Cell empty (nr, nc); |
|
|
581 Octave_map *pmap = new Octave_map (keys[0], empty); |
|
|
582 for (int i=1; i < keys.length (); i++) |
|
|
583 pmap->assign (keys[i], empty); |
|
|
584 |
|
|
585 mxArray *value = static_cast<mxArray *> (malloc (sizeof(mxArray))); |
|
|
586 |
|
|
587 value->rows (nr); |
|
|
588 value->columns (nc); |
|
|
589 value->map (pmap, keys); |
|
|
590 |
|
|
591 return value; |
|
|
592 } |
|
|
593 |
|
|
594 // free an array and its contents |
|
|
595 |
|
|
596 void |
|
|
597 mex::free_value (mxArray *ptr) |
|
|
598 { |
|
|
599 free (ptr->real ()); |
|
|
600 free (ptr->imag ()); |
|
|
601 free (ptr); |
|
|
602 } |
|
|
603 |
|
|
604 // mark an array and its contents so it will not be freed on exit |
|
|
605 |
|
|
606 void |
|
|
607 mex::persistent (mxArray *ptr) |
|
|
608 { |
|
|
609 persistent (Pix (ptr->real ())); |
|
|
610 persistent (Pix (ptr->imag ())); |
|
|
611 persistent (Pix (ptr)); |
|
|
612 } |
|
|
613 |
|
|
614 |
|
|
615 // Octave interface to mex files |
|
|
616 |
|
|
617 #if 0 |
|
|
618 // Don't bother trapping stop/exit |
|
|
619 // To trap for STOP in fortran code, this needs to be registered with atexit |
|
|
620 static void mex_exit() |
|
|
621 { |
|
|
622 if (__mex) |
|
|
623 { |
|
|
624 error ("%s: program aborted", mexFunctionName ()); |
|
|
625 __mex->abort (); |
|
|
626 } |
|
|
627 } |
|
|
628 #endif |
|
|
629 |
|
|
630 typedef void (*cmex_fptr) (int nlhs, mxArray **plhs, int nrhs, mxArray **prhs); |
|
|
631 typedef F77_RET_T (*fmex_fptr) (int& nlhs, mxArray **plhs, int& nrhs, mxArray **prhs); |
|
|
632 |
|
|
633 enum callstyle { use_fortran, use_C }; |
|
|
634 |
|
|
635 octave_value_list |
|
|
636 call_mex (callstyle cs, void *f, const octave_value_list& args, int nargout) |
|
|
637 { |
|
|
638 #if 0 |
|
|
639 // Don't bother trapping stop/exit |
|
|
640 // FIXME -- should really push "mex_exit" onto the octave |
|
|
641 // atexit stack before we start and pop it when we are through, but |
|
|
642 // the stack handle isn't exported from toplev.cc, so we can't. mex_exit |
|
|
643 // would have to be declared as DEFUN(mex_exit,,,"") of course. |
|
|
644 static bool unregistered = true; |
|
|
645 if (unregistered) |
|
|
646 { |
|
|
647 atexit (mex_exit); |
|
|
648 unregistered = false; |
|
|
649 } |
|
|
650 #endif |
|
|
651 |
|
|
652 // Use nargout+1 since even for zero specified args, still want to |
|
|
653 // be able to return an ans. |
|
|
654 |
|
|
655 int nargin = args.length (); |
|
|
656 OCTAVE_LOCAL_BUFFER(mxArray*, argin, nargin); |
|
|
657 for (int i = 0; i < nargin; i++) |
|
|
658 argin[i] = 0; |
|
|
659 |
|
|
660 int nout = nargout == 0 ? 1 : nargout; |
|
|
661 OCTAVE_LOCAL_BUFFER(mxArray*, argout, nout); |
|
|
662 for (int i = 0; i < nout; i++) |
|
|
663 argout[i] = 0; |
|
|
664 |
|
|
665 mex context; |
|
|
666 unwind_protect::add (mex::cleanup, Pix (&context)); |
|
|
667 |
|
|
668 for (int i = 0; i < nargin; i++) |
|
|
669 argin[i] = context.make_value (args(i)); |
|
|
670 |
|
|
671 // Save old mex pointer. |
|
|
672 unwind_protect_ptr (__mex); |
|
|
673 |
|
|
674 if (setjmp (context.jump) == 0) |
|
|
675 { |
|
|
676 __mex = &context; |
|
|
677 |
|
|
678 if (cs == use_fortran) |
|
|
679 { |
|
|
680 fmex_fptr fcn = FCN_PTR_CAST (fmex_fptr, f); |
|
|
681 |
|
|
682 int tmp_nargout = nargout; |
|
|
683 int tmp_nargin = nargin; |
|
|
684 |
|
|
685 fcn (tmp_nargout, argout, tmp_nargin, argin); |
|
|
686 } |
|
|
687 else |
|
|
688 { |
|
|
689 cmex_fptr fcn = FCN_PTR_CAST (cmex_fptr, f); |
|
|
690 |
|
|
691 fcn (nargout, argout, nargin, argin); |
|
|
692 } |
|
|
693 } |
|
|
694 |
|
|
695 // Restore old mex pointer. |
|
|
696 unwind_protect::run (); |
|
|
697 |
|
|
698 // Convert returned array entries back into octave values. |
|
|
699 |
|
|
700 octave_value_list retval; |
|
|
701 |
|
|
702 if (! error_state) |
|
|
703 { |
|
|
704 if (nargout == 0 && argout[0]) |
|
|
705 retval(0) = argout[0]->as_octave_value (); |
|
|
706 else |
|
|
707 { |
|
|
708 retval.resize (nargout); |
|
|
709 |
|
|
710 for (int i = 0; i < nargout; i++) |
|
|
711 if (argout[i]) |
|
|
712 retval(i) = argout[i]->as_octave_value (); |
|
|
713 } |
|
|
714 } |
|
|
715 |
|
|
716 // Clean up mex resources. |
|
|
717 unwind_protect::run (); |
|
|
718 |
|
|
719 return retval; |
|
|
720 } |
|
|
721 |
|
|
722 octave_value_list |
|
|
723 Fortran_mex (void *f, const octave_value_list& args, int nargout) |
|
|
724 { |
|
|
725 return call_mex (use_fortran, f, args, nargout); |
|
|
726 } |
|
|
727 |
|
|
728 octave_value_list |
|
|
729 C_mex (void *f, const octave_value_list& args, int nargout) |
|
|
730 { |
|
|
731 return call_mex (use_C, f, args, nargout); |
|
|
732 } |
|
|
733 |
|
|
734 // C interface to mex functions: |
|
|
735 |
|
|
736 extern "C" { |
|
|
737 |
|
|
738 const char * |
|
|
739 mexFunctionName (void) |
|
|
740 { |
|
|
741 static char *retval = 0; |
|
|
742 |
|
|
743 delete [] retval; |
|
|
744 |
|
|
745 octave_function *fcn = octave_call_stack::current (); |
|
|
746 |
|
|
747 if (fcn) |
|
|
748 { |
|
|
749 std::string nm = fcn->name (); |
|
|
750 retval = strsave (nm.c_str ()); |
|
|
751 } |
|
|
752 else |
|
|
753 retval = strsave ("unknown"); |
|
|
754 |
|
|
755 return retval; |
|
|
756 } |
|
|
757 |
|
|
758 void |
|
|
759 mexErrMsgTxt (const char *s) |
|
|
760 { |
|
|
761 if (s && strlen (s) > 0) |
|
5879
|
762 error ("%s: %s", mexFunctionName (), s); |
|
5864
|
763 else |
|
|
764 // Just set the error state; don't print msg. |
|
|
765 error (""); |
|
|
766 |
|
|
767 __mex->abort(); |
|
|
768 } |
|
|
769 |
|
5879
|
770 void |
|
|
771 mexErrMsgIdAndTxt (const char *id, const char *s) |
|
|
772 { |
|
|
773 if (s && strlen (s) > 0) |
|
|
774 error_with_id (id, "%s: %s", mexFunctionName (), s); |
|
|
775 else |
|
|
776 // Just set the error state; don't print msg. |
|
|
777 error (""); |
|
|
778 |
|
|
779 __mex->abort(); |
|
|
780 } |
|
|
781 |
|
|
782 void |
|
|
783 mexWarnMsgTxt (const char *s) |
|
|
784 { |
|
|
785 warning ("%s", s); |
|
|
786 } |
|
|
787 |
|
|
788 void |
|
|
789 mexWarnMsgIdAndTxt (const char *id, const char *s) |
|
|
790 { |
|
|
791 warning_with_id (id, "%s", s); |
|
|
792 } |
|
5864
|
793 |
|
|
794 void |
|
|
795 mexPrintf (const char *fmt, ...) |
|
|
796 { |
|
|
797 va_list args; |
|
|
798 va_start (args, fmt); |
|
|
799 octave_vformat (octave_stdout, fmt, args); |
|
|
800 va_end (args); |
|
|
801 } |
|
|
802 |
|
|
803 // Floating point representation. |
|
|
804 |
|
|
805 int mxIsFinite (const double v) { return lo_ieee_finite (v) != 0; } |
|
|
806 int mxIsInf (const double v) { return lo_ieee_isinf (v) != 0; } |
|
5879
|
807 int mxIsNaN (const double v) { return lo_ieee_isnan (v) != 0; } |
|
5864
|
808 |
|
|
809 double mxGetEps (void) { return DBL_EPSILON; } |
|
|
810 double mxGetInf (void) { return lo_ieee_inf_value (); } |
|
|
811 double mxGetNaN (void) { return lo_ieee_nan_value (); } |
|
|
812 |
|
|
813 int |
|
|
814 mexEvalString (const char *s) |
|
|
815 { |
|
|
816 int parse_status; |
|
|
817 octave_value_list ret; |
|
|
818 ret = eval_string (s, false, parse_status, 0); |
|
|
819 if (parse_status || error_state) |
|
|
820 { |
|
|
821 error_state = 0; |
|
|
822 return 1; |
|
|
823 } |
|
|
824 else |
|
|
825 return 0; |
|
|
826 } |
|
|
827 |
|
|
828 int |
|
|
829 mexCallMATLAB (int nargout, mxArray *argout[], |
|
|
830 int nargin, mxArray *argin[], |
|
|
831 const char *fname) |
|
|
832 { |
|
|
833 octave_value_list args; |
|
|
834 |
|
|
835 // FIXME -- do we need unwind protect to clean up args? Off hand, I |
|
|
836 // would say that this problem is endemic to Octave and we will |
|
|
837 // continue to have memory leaks after Ctrl-C until proper exception |
|
|
838 // handling is implemented. longjmp() only clears the stack, so any |
|
|
839 // class which allocates data on the heap is going to leak. |
|
|
840 |
|
|
841 args.resize (nargin); |
|
|
842 |
|
|
843 for (int i = 0; i < nargin; i++) |
|
|
844 args(i) = argin[i]->as_octave_value (); |
|
|
845 |
|
|
846 octave_value_list retval = feval (fname, args, nargout); |
|
|
847 |
|
|
848 if (error_state && __mex->trap_feval_error == 0) |
|
|
849 { |
|
|
850 // FIXME -- is this the correct way to clean up? abort() is |
|
|
851 // going to trigger a long jump, so the normal class destructors |
|
|
852 // will not be called. Hopefully this will reduce things to a |
|
|
853 // tiny leak. Maybe create a new octave memory tracer type |
|
|
854 // which prints a friendly message every time it is |
|
|
855 // created/copied/deleted to check this. |
|
|
856 |
|
|
857 args.resize (0); |
|
|
858 retval.resize (0); |
|
|
859 __mex->abort (); |
|
|
860 } |
|
|
861 |
|
|
862 int num_to_copy = retval.length (); |
|
|
863 |
|
|
864 if (nargout < retval.length ()) |
|
|
865 num_to_copy = nargout; |
|
|
866 |
|
|
867 for (int i = 0; i < num_to_copy; i++) |
|
|
868 { |
|
|
869 // FIXME -- it would be nice to avoid copying the value here, |
|
|
870 // but there is no way to steal memory from a matrix, never mind |
|
|
871 // that matrix memory is allocated by new[] and mxArray memory |
|
|
872 // is allocated by malloc(). |
|
|
873 argout[i] = __mex->make_value (retval (i)); |
|
|
874 } |
|
|
875 |
|
|
876 while (num_to_copy < nargout) |
|
|
877 argout[num_to_copy++] = 0; |
|
|
878 |
|
|
879 if (error_state) |
|
|
880 { |
|
|
881 error_state = 0; |
|
|
882 return 1; |
|
|
883 } |
|
|
884 else |
|
|
885 return 0; |
|
|
886 } |
|
|
887 |
|
|
888 void mexSetTrapFlag (int flag) { __mex->trap_feval_error = flag; } |
|
|
889 |
|
|
890 Pix mxMalloc (int n) { return __mex->malloc(n); } |
|
|
891 Pix mxCalloc (int n, int size) { return __mex->calloc (n, size); } |
|
|
892 Pix mxRealloc (Pix ptr, int n) { return __mex->realloc (ptr, n); } |
|
|
893 void mxFree (Pix ptr) { __mex->free (ptr); } |
|
|
894 void mexMakeMemoryPersistent (Pix ptr) { __mex->persistent (ptr); } |
|
|
895 |
|
|
896 mxArray * |
|
|
897 mxCreateDoubleMatrix (int nr, int nc, int iscomplex) |
|
|
898 { |
|
|
899 return __mex->make_value(nr, nc, iscomplex); |
|
|
900 } |
|
|
901 |
|
|
902 mxArray * |
|
|
903 mxCreateDoubleScalar (double val) |
|
|
904 { |
|
|
905 mxArray *ptr = mxCreateDoubleMatrix (1, 1, 0); |
|
|
906 *mxGetPr (ptr) = val; |
|
|
907 return ptr; |
|
|
908 } |
|
|
909 |
|
|
910 mxArray * |
|
|
911 mxCreateLogicalScalar (int val) |
|
|
912 { |
|
|
913 mxArray *ptr = mxCreateDoubleMatrix (1, 1, 0); |
|
|
914 *mxGetPr (ptr) = val; |
|
|
915 return ptr; |
|
|
916 } |
|
|
917 |
|
|
918 void mxDestroyArray (mxArray *v) { __mex->free (v); } |
|
|
919 |
|
|
920 mxArray * |
|
|
921 mxDuplicateArray (const mxArray *ptr) |
|
|
922 { |
|
|
923 return __mex->make_value (ptr->as_octave_value ()); |
|
|
924 } |
|
|
925 |
|
|
926 void mexMakeArrayPersistent (mxArray *ptr) { __mex->persistent (ptr); } |
|
|
927 |
|
|
928 int mxIsChar (const mxArray *ptr) { return ptr->is_string (); } |
|
|
929 int mxIsSparse (const mxArray *ptr) { return ptr->is_sparse (); } |
|
|
930 int mxIsFull(const mxArray *ptr) { return !ptr->is_sparse (); } |
|
|
931 int mxIsNumeric (const mxArray *ptr) { return ptr->is_numeric (); } |
|
|
932 int mxIsComplex (const mxArray *ptr) { return ptr->is_complex (); } |
|
|
933 int mxIsDouble (const mxArray *) { return true; } |
|
|
934 int mxIsEmpty (const mxArray *ptr) { return ptr->is_empty (); } |
|
|
935 |
|
|
936 int |
|
|
937 mxIsLogicalScalar (const mxArray *ptr) |
|
|
938 { |
|
|
939 return (ptr->is_numeric () |
|
|
940 && ptr->rows () == 1 && ptr->columns () == 1 |
|
|
941 && *ptr->real ()); |
|
|
942 } |
|
|
943 |
|
|
944 double *mxGetPr (const mxArray *ptr) { return ptr->real (); } |
|
|
945 double *mxGetPi (const mxArray *ptr) { return ptr->imag (); } |
|
|
946 int mxGetM (const mxArray *ptr) { return ptr->rows (); } |
|
|
947 int mxGetN (const mxArray *ptr) { return ptr->columns (); } |
|
|
948 int mxGetNumberOfDimensions (const mxArray *ptr) { return ptr->dims (); } |
|
|
949 int mxGetNumberOfElements (const mxArray *ptr) { return ptr->rows () * ptr->columns (); } |
|
|
950 void mxSetM (mxArray *ptr, int M) { ptr->rows (M); } |
|
|
951 void mxSetN (mxArray *ptr, int N) { ptr->columns (N); } |
|
|
952 void mxSetPr (mxArray *ptr, double *pr) { ptr->real (pr); } |
|
|
953 void mxSetPi (mxArray *ptr, double *pi) { ptr->imag (pi); } |
|
|
954 |
|
|
955 double |
|
|
956 mxGetScalar (const mxArray *ptr) |
|
|
957 { |
|
|
958 double *pr = ptr->real (); |
|
|
959 if (! pr) |
|
|
960 mexErrMsgTxt ("calling mxGetScalar on an empty matrix"); |
|
|
961 return pr[0]; |
|
|
962 } |
|
|
963 |
|
|
964 int |
|
|
965 mxGetString (const mxArray *ptr, char *buf, int buflen) |
|
|
966 { |
|
|
967 if (ptr->is_string ()) |
|
|
968 { |
|
|
969 int nr = ptr->rows (); |
|
|
970 int nc = ptr->columns (); |
|
|
971 int n = nr*nc < buflen ? nr*nc : buflen; |
|
|
972 const double *pr = ptr->real (); |
|
|
973 for (int i = 0; i < n; i++) |
|
|
974 buf[i] = NINT (pr[i]); |
|
|
975 if (n < buflen) |
|
|
976 buf[n] = '\0'; |
|
|
977 return n >= buflen; |
|
|
978 } |
|
|
979 else |
|
|
980 return 1; |
|
|
981 } |
|
|
982 |
|
|
983 char * |
|
|
984 mxArrayToString (const mxArray *ptr) |
|
|
985 { |
|
|
986 int nr = ptr->rows (); |
|
|
987 int nc = ptr->columns (); |
|
|
988 int n = nr*nc*sizeof(mxChar)+1; |
|
|
989 char *buf = static_cast<char *> (mxMalloc (n)); |
|
|
990 if (buf) |
|
|
991 mxGetString (ptr, buf, n); |
|
|
992 |
|
|
993 return buf; |
|
|
994 } |
|
|
995 |
|
|
996 mxArray * |
|
|
997 mxCreateString (const char *str) |
|
|
998 { |
|
|
999 int n = strlen (str); |
|
|
1000 mxArray *m = __mex->make_value (1, n, 0); |
|
|
1001 if (! m) |
|
|
1002 return m; |
|
|
1003 m->is_string (true); |
|
|
1004 |
|
|
1005 double *pr = m->real (); |
|
|
1006 for (int i = 0; i < n; i++) |
|
|
1007 pr[i] = str[i]; |
|
|
1008 |
|
|
1009 return m; |
|
|
1010 } |
|
|
1011 |
|
|
1012 mxArray * |
|
|
1013 mxCreateCharMatrixFromStrings (int n, const char **str) |
|
|
1014 { |
|
|
1015 // Find length of the individual strings. |
|
|
1016 Array<int> len (n); |
|
|
1017 |
|
|
1018 for (int i = 0; i < n; i++) |
|
|
1019 len(i) = strlen (str[i]); |
|
|
1020 |
|
|
1021 // Find maximum length. |
|
|
1022 int maxlen = 0; |
|
|
1023 for (int i = 0; i < n; i++) |
|
|
1024 if (len(i) > maxlen) |
|
|
1025 maxlen = len(i); |
|
|
1026 |
|
|
1027 // Need a place to copy them. |
|
|
1028 mxArray *m = __mex->make_value (n, maxlen, 0); |
|
|
1029 if (! m) |
|
|
1030 return m; |
|
|
1031 m->is_string (true); |
|
|
1032 |
|
|
1033 // Do the copy (being sure not to exceed the length of any of the |
|
|
1034 // strings). |
|
|
1035 double *pr = m->real (); |
|
|
1036 for (int j = 0; j < maxlen; j++) |
|
|
1037 for (int i = 0; i < n; i++) |
|
|
1038 if (j < len(i)) |
|
|
1039 *pr++ = str[i][j]; |
|
|
1040 else |
|
|
1041 *pr++ = '\0'; |
|
|
1042 |
|
|
1043 return m; |
|
|
1044 } |
|
|
1045 |
|
|
1046 int |
|
|
1047 mexPutVariable (const char *space, const char *name, mxArray *ptr) |
|
|
1048 { |
|
|
1049 if (! ptr) |
|
|
1050 return 1; |
|
|
1051 |
|
|
1052 if (! name) |
|
|
1053 return 1; |
|
|
1054 |
|
|
1055 if (name[0] == '\0') |
|
|
1056 name = ptr->name (); |
|
|
1057 |
|
|
1058 if (! name || name[0] == '\0') |
|
|
1059 return 1; |
|
|
1060 |
|
|
1061 if (! strcmp (space, "global")) |
|
|
1062 set_global_value (name, ptr->as_octave_value ()); |
|
|
1063 else if (! strcmp (space, "caller")) |
|
|
1064 { |
|
|
1065 // FIXME -- this belongs in variables.cc. |
|
|
1066 symbol_record *sr = curr_sym_tab->lookup (name, true); |
|
|
1067 if (sr) |
|
|
1068 sr->define (ptr->as_octave_value ()); |
|
|
1069 else |
|
|
1070 panic_impossible (); |
|
|
1071 } |
|
|
1072 else if (! strcmp (space, "base")) |
|
|
1073 mexErrMsgTxt ("mexPutVariable: 'base' symbol table not implemented"); |
|
|
1074 else |
|
|
1075 mexErrMsgTxt ("mexPutVariable: symbol table does not exist"); |
|
|
1076 return 0; |
|
|
1077 } |
|
|
1078 |
|
|
1079 mxArray * |
|
5879
|
1080 mexGetVariable (const char *space, const char *name) |
|
5864
|
1081 { |
|
|
1082 mxArray *retval = 0; |
|
|
1083 |
|
|
1084 // FIXME -- this should be in variable.cc, but the correct |
|
|
1085 // functionality is not exported. Particularly, get_global_value() |
|
|
1086 // generates an error if the symbol is undefined. |
|
|
1087 |
|
|
1088 symbol_record *sr = 0; |
|
|
1089 |
|
|
1090 if (! strcmp (space, "global")) |
|
|
1091 sr = global_sym_tab->lookup (name); |
|
|
1092 else if (! strcmp (space, "caller")) |
|
|
1093 sr = curr_sym_tab->lookup (name); |
|
|
1094 else if (! strcmp (space, "base")) |
|
5879
|
1095 mexErrMsgTxt ("mexGetVariable: 'base' symbol table not implemented"); |
|
5864
|
1096 else |
|
5879
|
1097 mexErrMsgTxt ("mexGetVariable: symbol table does not exist"); |
|
5864
|
1098 |
|
|
1099 if (sr) |
|
|
1100 { |
|
|
1101 octave_value sr_def = sr->def (); |
|
|
1102 |
|
|
1103 if (sr_def.is_defined ()) |
|
|
1104 { |
|
|
1105 retval = __mex->make_value (sr_def); |
|
|
1106 retval->name (name); |
|
|
1107 } |
|
|
1108 } |
|
|
1109 |
|
|
1110 return retval; |
|
|
1111 } |
|
|
1112 |
|
5879
|
1113 const mxArray * |
|
|
1114 mexGetVariablePtr (const char *space, const char *name) |
|
5864
|
1115 { |
|
5879
|
1116 return mexGetVariable (space, name); |
|
5864
|
1117 } |
|
|
1118 |
|
|
1119 const char *mxGetName (const mxArray *ptr) { return ptr->name (); } |
|
|
1120 |
|
|
1121 void mxSetName (mxArray *ptr, const char*nm) { ptr->name (nm); } |
|
|
1122 |
|
|
1123 mxArray * |
|
|
1124 mxCreateStructMatrix (int nr, int nc, int num_keys, const char **keys) |
|
|
1125 { |
|
|
1126 const string_vector ordered_keys (keys, num_keys); |
|
|
1127 mxArray *m = __mex->make_value (nr, nc, ordered_keys); |
|
|
1128 return m; |
|
|
1129 } |
|
|
1130 |
|
|
1131 mxArray * |
|
|
1132 mxGetField (const mxArray *ptr, int index, const char *key) |
|
|
1133 { |
|
|
1134 return ptr->field (key, index); |
|
|
1135 } |
|
|
1136 |
|
|
1137 void |
|
|
1138 mxSetField (mxArray *ptr, int index, const char *key, mxArray *val) |
|
|
1139 { |
|
|
1140 ptr->field (key, index, val); |
|
|
1141 } |
|
|
1142 |
|
|
1143 int mxGetNumberOfFields (const mxArray *ptr) { return ptr->num_keys (); } |
|
|
1144 int mxIsStruct (const mxArray *ptr) { return ptr->is_struct (); } |
|
|
1145 |
|
|
1146 const char * |
|
|
1147 mxGetFieldNameByNumber (const mxArray *ptr, int key_num) |
|
|
1148 { |
|
|
1149 return ptr->key(key_num).c_str (); |
|
|
1150 } |
|
|
1151 |
|
|
1152 int |
|
|
1153 mxGetFieldNumber (const mxArray *ptr, const char *key) |
|
|
1154 { |
|
|
1155 return ptr->key (key); |
|
|
1156 } |
|
5879
|
1157 |
|
5864
|
1158 mxArray * |
|
|
1159 mxGetFieldByNumber (const mxArray *ptr, int index, int key_num) |
|
|
1160 { |
|
|
1161 return ptr->field (key_num, index); |
|
|
1162 } |
|
5879
|
1163 |
|
5864
|
1164 void |
|
|
1165 mxSetFieldByNumber (mxArray *ptr, int index, int key_num, mxArray *val) |
|
|
1166 { |
|
|
1167 return ptr->field (key_num,index,val); |
|
|
1168 } |
|
|
1169 |
|
|
1170 } // extern "C" |
|
|
1171 |
|
|
1172 // Fortran interface to mex functions |
|
|
1173 // |
|
|
1174 // Where possible, these call the equivalent C function since that API |
|
|
1175 // is fixed. It costs and extra function call, but is easier to |
|
|
1176 // maintain. |
|
|
1177 |
|
|
1178 extern "C" { |
|
|
1179 |
|
|
1180 void F77_FUNC (mexerrmsgtxt, MEXERRMSGTXT) (const char *s, long slen) |
|
|
1181 { |
|
|
1182 if (slen > 1 || (slen == 1 && s[0] != ' ') ) |
|
|
1183 error ("%s: %.*s", mexFunctionName (), slen, s); |
|
|
1184 else |
|
|
1185 // Just set the error state; don't print msg. |
|
|
1186 error (""); |
|
|
1187 |
|
|
1188 __mex->abort(); |
|
|
1189 } |
|
|
1190 |
|
|
1191 void F77_FUNC (mexprintf, MEXPRINTF) (const char *s, long slen) |
|
|
1192 { |
|
|
1193 mexPrintf ("%.*s\n", slen, s); |
|
|
1194 } |
|
|
1195 |
|
5879
|
1196 int F77_FUNC (mexisfinite, MEXISFINITE) (double v) { return mxIsFinite (v); } |
|
|
1197 int F77_FUNC (mexisinf, MEXISINF) (double v) { return mxIsInf (v); } |
|
|
1198 int F77_FUNC (mexisnan, MEXISNAN) (double v) { return mxIsNaN (v); } |
|
|
1199 |
|
5864
|
1200 double F77_FUNC (mexgeteps, MEXGETEPS) (void) { return mxGetEps (); } |
|
|
1201 double F77_FUNC (mexgetinf, MEXGETINF) (void) { return mxGetInf (); } |
|
|
1202 double F77_FUNC (mexgetnan, MEXGETNAN) (void) { return mxGetNaN (); } |
|
|
1203 |
|
|
1204 // Array access: |
|
|
1205 |
|
|
1206 Pix F77_FUNC (mxcreatefull, MXCREATEFULL) |
|
|
1207 (const int& nr, const int& nc, const int& iscomplex) |
|
|
1208 { |
|
|
1209 return mxCreateDoubleMatrix (nr, nc, iscomplex); |
|
|
1210 } |
|
|
1211 |
|
|
1212 void F77_FUNC (mxfreematrix, MXFREEMATRIX) (mxArray* &p) |
|
|
1213 { |
|
|
1214 mxDestroyArray (p); |
|
|
1215 } |
|
|
1216 |
|
|
1217 Pix F77_FUNC (mxcalloc, MXCALLOC) (const int& n, const int& size) |
|
|
1218 { |
|
|
1219 return mxCalloc (n, size); |
|
|
1220 } |
|
|
1221 |
|
|
1222 void F77_FUNC (mxfree, MXFREE) (const Pix &p) { mxFree (p); } |
|
|
1223 |
|
|
1224 int F77_FUNC (mxgetm, MXGETM) (const mxArray* &p) { return mxGetM (p); } |
|
|
1225 int F77_FUNC (mxgetn, MXGETN) (const mxArray* &p) { return mxGetN (p); } |
|
|
1226 |
|
|
1227 Pix F77_FUNC (mxgetpi, MXGETPI) (const mxArray* &p) { return mxGetPi (p); } |
|
|
1228 Pix F77_FUNC (mxgetpr, MXGETPR) (const mxArray* &p) { return mxGetPr (p); } |
|
|
1229 |
|
|
1230 void F77_FUNC (mxsetm, MXSETM) (mxArray* &p, const int& m) { mxSetM (p, m); } |
|
|
1231 void F77_FUNC (mxsetn, MXSETN) (mxArray* &p, const int& n) { mxSetN (p, n); } |
|
|
1232 |
|
|
1233 void F77_FUNC (mxsetpi, MXSETPI) (mxArray* &p, double *pi) { mxSetPi (p, pi); } |
|
|
1234 void F77_FUNC (mxsetpr, MXSETPR) (mxArray* &p, double *pr) { mxSetPr (p, pr); } |
|
|
1235 |
|
|
1236 int F77_FUNC (mxiscomplex, MXISCOMPLEX) (const mxArray* &p) |
|
|
1237 { |
|
|
1238 return mxIsComplex (p); |
|
|
1239 } |
|
|
1240 |
|
|
1241 int F77_FUNC (mxisdouble, MXISDOUBLE) (const mxArray* &p) |
|
|
1242 { |
|
|
1243 return mxIsDouble (p); |
|
|
1244 } |
|
|
1245 |
|
|
1246 int F77_FUNC (mxisnumeric, MXISNUMERIC) (const mxArray* &p) |
|
|
1247 { |
|
|
1248 return mxIsNumeric(p); |
|
|
1249 } |
|
|
1250 |
|
|
1251 int F77_FUNC (mxisfull, MXISFULL) (const mxArray* &p) |
|
|
1252 { |
|
|
1253 return 1 - mxIsSparse (p); |
|
|
1254 } |
|
|
1255 |
|
|
1256 int F77_FUNC (mxissparse, MXISSPARSE) (const mxArray* &p) |
|
|
1257 { |
|
|
1258 return mxIsSparse (p); |
|
|
1259 } |
|
|
1260 |
|
|
1261 int F77_FUNC (mxisstring, MXISSTRING) (const mxArray* &p) |
|
|
1262 { |
|
|
1263 return mxIsChar (p); |
|
|
1264 } |
|
|
1265 |
|
|
1266 int F77_FUNC (mxgetstring, MXGETSTRING) |
|
|
1267 (const mxArray* &ptr, char *str, const int& len) |
|
|
1268 { |
|
|
1269 return mxGetString (ptr, str, len); |
|
|
1270 } |
|
|
1271 |
|
|
1272 int F77_FUNC (mexcallmatlab, MEXCALLMATLAB) |
|
|
1273 (const int& nargout, mxArray **argout, |
|
|
1274 const int& nargin, mxArray **argin, |
|
|
1275 const char *fname, |
|
|
1276 long fnamelen) |
|
|
1277 { |
|
|
1278 char str[mxMAXNAM+1]; |
|
|
1279 strncpy (str, fname, (fnamelen < mxMAXNAM ? fnamelen : mxMAXNAM)); |
|
|
1280 str[fnamelen] = '\0'; |
|
|
1281 return mexCallMATLAB (nargout, argout, nargin, argin, str); |
|
|
1282 } |
|
|
1283 |
|
|
1284 // Fake pointer support: |
|
|
1285 |
|
|
1286 void F77_FUNC (mxcopyreal8toptr, MXCOPYREAL8TOPTR) |
|
|
1287 (const double *d, const int& prref, const int& len) |
|
|
1288 { |
|
|
1289 double *pr = (double *) prref; |
|
|
1290 for (int i = 0; i < len; i++) |
|
|
1291 pr[i] = d[i]; |
|
|
1292 } |
|
|
1293 |
|
|
1294 void F77_FUNC (mxcopyptrtoreal8, MXCOPYPTRTOREAL8) |
|
|
1295 (const int& prref, double *d, const int& len) |
|
|
1296 { |
|
|
1297 double *pr = (double *) prref; |
|
|
1298 for (int i = 0; i < len; i++) |
|
|
1299 d[i] = pr[i]; |
|
|
1300 } |
|
|
1301 |
|
|
1302 void F77_FUNC (mxcopycomplex16toptr, MXCOPYCOMPLEX16TOPTR) |
|
|
1303 (const double *d, int& prref, int& piref, const int& len) |
|
|
1304 { |
|
|
1305 double *pr = (double *) prref; |
|
|
1306 double *pi = (double *) piref; |
|
|
1307 for (int i = 0; i < len; i++) |
|
|
1308 { |
|
|
1309 pr[i] = d[2*i]; |
|
|
1310 pi[i] = d[2*i+1]; |
|
|
1311 } |
|
|
1312 } |
|
|
1313 |
|
|
1314 void F77_FUNC (mxcopyptrtocomplex16, MXCOPYPTRTOCOMPLEX16) |
|
|
1315 (const int& prref, const int& piref, double *d, const int& len) |
|
|
1316 { |
|
|
1317 double *pr = (double *) prref; |
|
|
1318 double *pi = (double *) piref; |
|
|
1319 for (int i = 0; i < len; i++) |
|
|
1320 { |
|
|
1321 d[2*i] = pr[i]; |
|
|
1322 d[2*i+1] = pi[i]; |
|
|
1323 } |
|
|
1324 } |
|
|
1325 |
|
|
1326 } // extern "C" |
|
|
1327 |
|
|
1328 /* |
|
|
1329 ;;; Local Variables: *** |
|
|
1330 ;;; mode: C++ *** |
|
|
1331 ;;; End: *** |
|
|
1332 */ |
