Mercurial > hg > octave-nkf

comparison src/mex.cc @ 5900:c20eb7330d13

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 2006-07-22 08:31:16 by jwe]
author jwe
date Sat, 22 Jul 2006 08:31:17 +0000
parents 4f1112bfafce
children 6af4cea82cc7
comparison
equal deleted inserted replaced
5899:82c38ce145a7 5900:c20eb7330d13
1 /* 1 #include <config.h>
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
25 // the following terms:
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 2
44 #include <cfloat> 3 #include <cfloat>
45 #include <csetjmp> 4 #include <csetjmp>
5 #include <cstdarg>
46 #include <cstdlib> 6 #include <cstdlib>
47 7 #include <cstring>
48 #include <iomanip> 8 #include <cctype>
9
49 #include <set> 10 #include <set>
50 #include <string> 11
51 12 #include "f77-fcn.h"
52 typedef void *Pix; 13 #include "lo-ieee.h"
53 typedef std::set<Pix> MemSet; 14
54 15 // mxArray must be declared as a class before including mexproto.h.
55 #ifdef HAVE_CONFIG_H 16 class mxArray;
56 #include <config.h> 17 #include "Cell.h"
57 #endif 18 #include "mexproto.h"
58 19 #include "oct-map.h"
59 #include "oct.h" 20 #include "oct-obj.h"
21 #include "ov.h"
22 #include "ov-usr-fcn.h"
60 #include "pager.h" 23 #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" 24 #include "parse.h"
66 #include "toplev.h" 25 #include "toplev.h"
26 #include "unwind-prot.h"
27 #include "utils.h"
67 #include "variables.h" 28 #include "variables.h"
68 #include "oct-map.h" 29
69 #include "str-vec.h" 30 // #define DEBUG 1
70 31
71 // mex file context 32 static int
72 // 33 max_str_len (int m, const char **str)
73 // Class mex keeps track of all memory allocated and frees anything 34 {
74 // not explicitly marked persistent when the it is destroyed. It also 35 int max_len = 0;
75 // maintains the setjump/longjump buffer required for non-local exit 36
76 // from the mex file, and any other state local to this instance of 37 for (int i = 0; i < m; i++)
77 // the mex function invocation.
78 class mxArray;
79
80 // Prototypes for external functions. Must declare mxArray as a class
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 { 38 {
211 // FIXME -- could use "octave_new_handler();" instead 39 int tmp = strlen (str[i]);
212 error ("%s: out of memory", mexFunctionName ()); 40
213 abort (); 41 if (tmp > max_len)
42 max_len = tmp;
214 } 43 }
215 #endif 44
216 45 return max_len;
217 mark (ptr); 46 }
218 47
219 return ptr; 48 static int
220 } 49 valid_key (const char *key)
221 50 {
222 // allocate a pointer to be freed on exit, and initialize to 0 51 int retval = 0;
223 Pix 52
224 mex::calloc (int n, int t) 53 int nel = strlen (key);
225 { 54
226 Pix v = malloc (n*t); 55 if (nel > 0)
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 { 56 {
249 v = ::realloc (ptr, n); 57 if (isalpha (key[0]))
250 MemSet::iterator p = memlist.find (ptr);
251 if (v && p != memlist.end ())
252 { 58 {
253 memlist.erase (p); 59 for (int i = 1; i < nel; i++)
254 memlist.insert (v); 60 {
61 if (! (isalnum (key[i]) || key[i] == '_'))
62 goto done;
63 }
64
65 retval = 1;
255 } 66 }
256 } 67 }
68
69 done:
70
71 return retval;
72 }
73
74 // ------------------------------------------------------------------
75
76 // A class to provide the default implemenation of some of the virtual
77 // functions declared in the mxArray class.
78
79 class mxArray_base : public mxArray
80 {
81 protected:
82
83 mxArray_base (void) : mxArray (xmxArray ()) { }
84
85 public:
86
87 mxArray *clone (void) const = 0;
88
89 ~mxArray_base (void) { }
90
91 octave_value as_octave_value (void) const = 0;
92
93 bool is_octave_value (void) const { return false; }
94
95 int is_cell (void) const = 0;
96
97 int is_char (void) const = 0;
98
99 int is_class (const char *name_arg) const
100 {
101 int retval = 0;
102
103 const char *cname = get_class_name ();
104
105 if (cname && name_arg)
106 retval = ! strcmp (cname, name_arg);
107
108 return retval;
109 }
110
111 int is_complex (void) const = 0;
112
113 int is_double (void) const = 0;
114
115 int is_int16 (void) const = 0;
116
117 int is_int32 (void) const = 0;
118
119 int is_int64 (void) const = 0;
120
121 int is_int8 (void) const = 0;
122
123 int is_logical (void) const = 0;
124
125 int is_numeric (void) const = 0;
126
127 int is_single (void) const = 0;
128
129 int is_sparse (void) const = 0;
130
131 int is_struct (void) const = 0;
132
133 int is_uint16 (void) const = 0;
134
135 int is_uint32 (void) const = 0;
136
137 int is_uint64 (void) const = 0;
138
139 int is_uint8 (void) const = 0;
140
141 int is_logical_scalar (void) const
142 {
143 return is_logical () && get_number_of_elements () == 1;
144 }
145
146 int is_logical_scalar_true (void) const = 0;
147
148 int get_m (void) const = 0;
149
150 int get_n (void) const = 0;
151
152 int *get_dimensions (void) const = 0;
153
154 int get_number_of_dimensions (void) const = 0;
155
156 void set_m (int m) = 0;
157
158 void set_n (int n) = 0;
159
160 void set_dimensions (int *dims_arg, int ndims_arg) = 0;
161
162 int get_number_of_elements (void) const = 0;
163
164 int is_empty (void) const = 0;
165
166 mxClassID get_class_id (void) const = 0;
167
168 const char *get_class_name (void) const = 0;
169
170 void set_class_name (const char *name_arg) = 0;
171
172 mxArray *get_cell (int /*idx*/) const
173 {
174 invalid_type_error ();
175 return 0;
176 }
177
178 void set_cell (int idx, mxArray *val) = 0;
179
180 void *get_data (void) const = 0;
181
182 void *get_imag_data (void) const = 0;
183
184 void set_data (void *pr) = 0;
185
186 void set_imag_data (void *pi) = 0;
187
188 int *get_ir (void) const = 0;
189
190 int *get_jc (void) const = 0;
191
192 int get_nzmax (void) const = 0;
193
194 void set_ir (int *ir) = 0;
195
196 void set_jc (int *jc) = 0;
197
198 void set_nzmax (int nzmax) = 0;
199
200 int add_field (const char *key) = 0;
201
202 void remove_field (int key_num) = 0;
203
204 mxArray *get_field_by_number (int index, int key_num) const = 0;
205
206 void set_field_by_number (int index, int key_num, mxArray *val) = 0;
207
208 int get_number_of_fields (void) const = 0;
209
210 const char *get_field_name_by_number (int key_num) const = 0;
211
212 int get_field_number (const char *key) const = 0;
213
214 int get_string (char *buf, int buflen) const = 0;
215
216 char *array_to_string (void) const = 0;
217
218 int calc_single_subscript (int nsubs, int *subs) const = 0;
219
220 int get_element_size (void) const = 0;
221
222 bool mutation_needed (void) const { return false; }
223
224 mxArray *mutate (void) const { return 0; }
225
226 protected:
227
228 mxArray_base (const mxArray_base&) : mxArray (xmxArray ()) { }
229
230 void invalid_type_error (void) const
231 {
232 error ("invalid type for operation");
233 }
234
235 void error (const char *msg) const
236 {
237 // FIXME
238 ::error ("%s", msg);
239 }
240 };
241
242 // The object that handles values pass to MEX files from Octave. Some
243 // methods in this class may set mutate_flag to TRUE to tell the
244 // mxArray class to convert to the Matlab-style representation and
245 // then invoke the method on that object instead (for example, getting
246 // a pointer to real or imaginary data from a complex object requires
247 // a mutation but getting a pointer to real data from a real object
248 // does not). Changing the representation causes a copy so we try to
249 // avoid it unless it is really necessary. Once the conversion
250 // happens, we delete this representation, so the conversion can only
251 // happen once per call to a MEX file.
252
253 class mxArray_octave_value : public mxArray_base
254 {
255 public:
256
257 mxArray_octave_value (const octave_value& ov)
258 : mxArray_base (), val (ov), mutate_flag (false),
259 id (mxUNKNOWN_CLASS), class_name (0), ndims (-1), dims (0) { }
260
261 mxArray *clone (void) const { return new mxArray_octave_value (*this); }
262
263 ~mxArray_octave_value (void)
264 {
265 mxFree (class_name);
266 mxFree (dims);
267 }
268
269 octave_value as_octave_value (void) const { return val; }
270
271 bool is_octave_value (void) const { return true; }
272
273 int is_cell (void) const { return val.is_cell (); }
274
275 int is_char (void) const { return val.is_string (); }
276
277 int is_complex (void) const { return val.is_complex_type (); }
278
279 int is_double (void) const { return val.is_double_type (); }
280
281 int is_int16 (void) const { return val.is_int16_type (); }
282
283 int is_int32 (void) const { return val.is_int32_type (); }
284
285 int is_int64 (void) const { return val.is_int64_type (); }
286
287 int is_int8 (void) const { return val.is_int8_type (); }
288
289 int is_logical (void) const { return val.is_bool_type (); }
290
291 int is_numeric (void) const { return val.is_numeric_type (); }
292
293 int is_single (void) const { return val.is_single_type (); }
294
295 int is_sparse (void) const { return val.is_sparse_type (); }
296
297 int is_struct (void) const { return val.is_map (); }
298
299 int is_uint16 (void) const { return val.is_uint16_type (); }
300
301 int is_uint32 (void) const { return val.is_int32_type (); }
302
303 int is_uint64 (void) const { return val.is_int64_type (); }
304
305 int is_uint8 (void) const { return val.is_int8_type (); }
306
307 int is_range (void) const { return val.is_range (); }
308
309 int is_real_type (void) const { return val.is_real_type (); }
310
311 int is_logical_scalar_true (void) const
312 {
313 return (is_logical_scalar () && val.is_true ());
314 }
315
316 int get_m (void) const { return val.rows (); }
317
318 int get_n (void) const { return val.columns (); }
319
320 int *get_dimensions (void) const
321 {
322 if (! dims)
323 {
324 // Force ndims to be cached.
325 get_number_of_dimensions ();
326
327 dims = static_cast<int *> (malloc (ndims * sizeof (int)));
328
329 dim_vector dv = val.dims ();
330
331 for (int i = 0; i < ndims; i++)
332 dims[i] = dv(i);
333 }
334
335 return dims;
336 }
337
338 int get_number_of_dimensions (void) const
339 {
340 if (ndims < 0)
341 ndims = val.ndims ();
342
343 return ndims;
344 }
345
346 void set_m (int /*m*/) { panic_impossible (); }
347
348 void set_n (int /*n*/) { panic_impossible (); }
349
350 void set_dimensions (int */*dims_arg*/, int /*ndims_arg*/)
351 {
352 panic_impossible ();
353 }
354
355 int get_number_of_elements (void) const { return val.numel (); }
356
357 int is_empty (void) const { return val.is_empty (); }
358
359 mxClassID get_class_id (void) const
360 {
361 id = mxUNKNOWN_CLASS;
362
363 std::string cn = val.class_name ();
364
365 if (cn == "cell")
366 id = mxCELL_CLASS;
367 else if (cn == "struct")
368 id = mxSTRUCT_CLASS;
369 else if (cn == "logical")
370 id = mxLOGICAL_CLASS;
371 else if (cn == "char")
372 id = mxCHAR_CLASS;
373 else if (cn == "double")
374 id = mxDOUBLE_CLASS;
375 else if (cn == "single")
376 id = mxSINGLE_CLASS;
377 else if (cn == "int8")
378 id = mxINT8_CLASS;
379 else if (cn == "uint8")
380 id = mxUINT8_CLASS;
381 else if (cn == "int16")
382 id = mxINT16_CLASS;
383 else if (cn == "uint16")
384 id = mxUINT16_CLASS;
385 else if (cn == "int32")
386 id = mxINT32_CLASS;
387 else if (cn == "uint32")
388 id = mxUINT32_CLASS;
389 else if (cn == "int64")
390 id = mxINT64_CLASS;
391 else if (cn == "uint64")
392 id = mxUINT64_CLASS;
393 else if (cn == "function handle")
394 id = mxFUNCTION_CLASS;
395
396 return id;
397 }
398
399 const char *get_class_name (void) const
400 {
401 if (! class_name)
402 {
403 std::string s = val.class_name ();
404 class_name = strsave (s.c_str ());
405 }
406
407 return class_name;
408 }
409
410 // Not allowed.
411 void set_class_name (const char */*name_arg*/) { panic_impossible (); }
412
413 mxArray *get_cell (int /*idx*/) const
414 {
415 request_mutation ();
416 return 0;
417 }
418
419 // Not allowed.
420 void set_cell (int /*idx*/, mxArray */*val*/) { panic_impossible (); }
421
422 void *get_data (void) const
423 {
424 void *retval = 0;
425
426 if (is_char ()
427 || (is_numeric () && is_real_type () && ! is_range ()))
428 retval = val.mex_get_data ();
429 else
430 request_mutation ();
431
432 return retval;
433 }
434
435 void *get_imag_data (void) const
436 {
437 void *retval = 0;
438
439 if (is_numeric () && is_real_type ())
440 retval = 0;
441 else
442 request_mutation ();
443
444 return retval;
445 }
446
447 // Not allowed.
448 void set_data (void */*pr*/) { panic_impossible (); }
449
450 // Not allowed.
451 void set_imag_data (void */*pi*/) { panic_impossible (); }
452
453 int *get_ir (void) const
454 {
455 #if SIZEOF_OCTAVE_IDX_TYPE == SIZEOF_INT
456 return val.mex_get_jc ();
457 #else
458 request_mutation ();
459 return 0;
257 #endif 460 #endif
258 return v; 461 }
259 } 462
260 463 int *get_jc (void) const
261 // free a pointer obtained from malloc or calloc 464 {
262 void 465 #if SIZEOF_OCTAVE_IDX_TYPE == SIZEOF_INT
263 mex::free (Pix ptr) 466 return val.mex_get_jc ();
264 {
265 unmark (ptr);
266 #if 0
267 delete [] ptr;
268 #else 467 #else
269 ::free (ptr); 468 request_mutation ();
469 return 0;
270 #endif 470 #endif
271 } 471 }
272 472
273 // mxArray data type 473 int get_nzmax (void) const { return val.nzmax (); }
274 // 474
275 // Class mxArray is not much more than a struct for keeping together 475 // Not allowed.
276 // dimensions and data. It doesn't even ensure consistency between 476 void set_ir (int */*ir*/) { panic_impossible (); }
277 // the dimensions and the data. Unfortunately you can't do better 477
278 // than this without restricting the operations available in Matlab 478 // Not allowed.
279 // for directly manipulating its mxArray type. 479 void set_jc (int */*jc*/) { panic_impossible (); }
280 480
281 typedef unsigned short mxChar; 481 // Not allowed.
282 const int mxMAXNAM=64; 482 void set_nzmax (int /*nzmax*/) { panic_impossible (); }
283 483
284 class mxArray 484 // Not allowed.
285 { 485 int add_field (const char */*key*/)
486 {
487 panic_impossible ();
488 return -1;
489 }
490
491 // Not allowed.
492 void remove_field (int /*key_num*/) { panic_impossible (); }
493
494 mxArray *get_field_by_number (int /*index*/, int /*key_num*/) const
495 {
496 request_mutation ();
497 return 0;
498 }
499
500 // Not allowed.
501 void set_field_by_number (int /*index*/, int /*key_num*/, mxArray */*val*/)
502 {
503 panic_impossible ();
504 }
505
506 int get_number_of_fields (void) const { return val.nfields (); }
507
508 const char *get_field_name_by_number (int /*key_num*/) const
509 {
510 request_mutation ();
511 return 0;
512 }
513
514 int get_field_number (const char */*key*/) const
515 {
516 request_mutation ();
517 return 0;
518 }
519
520 int get_string (char *buf, int buflen) const
521 {
522 int retval = 1;
523
524 int nel = get_number_of_elements ();
525
526 if (val.is_string () && nel < buflen)
527 {
528 charNDArray tmp = val.char_array_value ();
529
530 const char *p = tmp.data ();
531
532 for (int i = 0; i < buflen; i++)
533 buf[i] = p[i];
534
535 buf[nel] = 0;
536
537 retval = 0;
538 }
539
540 return retval;
541 }
542
543 char *array_to_string (void) const
544 {
545 // FIXME -- this is suposed to handle multi-byte character
546 // strings.
547
548 char *buf = 0;
549
550 if (val.is_string ())
551 {
552 int nel = get_number_of_elements ();
553
554 buf = static_cast<char *> (malloc (nel + 1));
555
556 if (buf)
557 {
558 charNDArray tmp = val.char_array_value ();
559
560 const char *p = tmp.data ();
561
562 for (int i = 0; i < nel; i++)
563 buf[i] = p[i];
564
565 buf[nel] = '\0';
566 }
567 }
568
569 return buf;
570 }
571
572 int calc_single_subscript (int nsubs, int *subs) const
573 {
574 int retval = 0;
575
576 // Force ndims, dims to be cached.
577 get_dimensions ();
578
579 int n = nsubs <= ndims ? nsubs : ndims;
580
581 while (--n > 0)
582 retval = retval * dims[n] + subs[n];
583
584 return retval;
585 }
586
587 int get_element_size (void) const
588 {
589 // Force id to be cached.
590 get_class_id ();
591
592 switch (id)
593 {
594 case mxCELL_CLASS: return sizeof (mxArray *);
595 case mxSTRUCT_CLASS: return sizeof (mxArray *);
596 case mxLOGICAL_CLASS: return sizeof (mxLogical);
597 case mxCHAR_CLASS: return sizeof (mxChar);
598 case mxDOUBLE_CLASS: return sizeof (double);
599 case mxSINGLE_CLASS: return sizeof (float);
600 case mxINT8_CLASS: return 1;
601 case mxUINT8_CLASS: return 1;
602 case mxINT16_CLASS: return 2;
603 case mxUINT16_CLASS: return 2;
604 case mxINT32_CLASS: return 4;
605 case mxUINT32_CLASS: return 4;
606 case mxINT64_CLASS: return 8;
607 case mxUINT64_CLASS: return 8;
608 case mxFUNCTION_CLASS: return 0;
609 default: return 0;
610 }
611 }
612
613 bool mutation_needed (void) const { return mutate_flag; }
614
615 void request_mutation (void) const
616 {
617 if (mutate_flag)
618 panic_impossible ();
619
620 mutate_flag = true;
621 }
622
623 mxArray *mutate (void) const { return val.as_mxArray (); }
624
625 protected:
626
627 mxArray_octave_value (const mxArray_octave_value& arg)
628 : mxArray_base (arg), val (arg.val), mutate_flag (arg.mutate_flag),
629 id (arg.id), class_name (strsave (arg.class_name)), ndims (arg.ndims),
630 dims (ndims > 0 ? static_cast<int *> (malloc (ndims * sizeof (int))) : 0)
631 {
632 if (dims)
633 {
634 for (int i = 0; i < ndims; i++)
635 dims[i] = arg.dims[i];
636 }
637 }
638
639 private:
640
641 octave_value val;
642
643 mutable bool mutate_flag;
644
645 // Caching these does not cost much or lead to much duplicated
646 // code. For other things, we just request mutation to a
647 // Matlab-style mxArray object.
648
649 mutable mxClassID id;
650 mutable char *class_name;
651 mutable int ndims;
652 mutable int *dims;
653 };
654
655 // The base class for the Matlab-style representation, used to handle
656 // things that are common to all Matlab-style objects.
657
658 class mxArray_matlab : public mxArray_base
659 {
660 protected:
661
662 mxArray_matlab (mxClassID id_arg = mxUNKNOWN_CLASS)
663 : mxArray_base (), class_name (0), id (id_arg), ndims (0), dims (0) { }
664
665 mxArray_matlab (mxClassID id_arg, int ndims_arg, const int *dims_arg)
666 : mxArray_base (), class_name (0), id (id_arg),
667 ndims (ndims_arg < 2 ? 2 : ndims_arg),
668 dims (static_cast<int *> (malloc (ndims * sizeof (int))))
669 {
670 if (ndims_arg < 2)
671 {
672 dims[0] = 1;
673 dims[1] = 1;
674 }
675
676 for (int i = 0; i < ndims_arg; i++)
677 dims[i] = dims_arg[i];
678
679 for (int i = ndims - 1; i > 1; i--)
680 {
681 if (dims[i] == 1)
682 ndims--;
683 else
684 break;
685 }
686 }
687
688 mxArray_matlab (mxClassID id_arg, const dim_vector& dv)
689 : mxArray_base (), class_name (0), id (id_arg),
690 ndims (dv.length ()),
691 dims (static_cast<int *> (malloc (ndims * sizeof (int))))
692 {
693 for (int i = 0; i < ndims; i++)
694 dims[i] = dv(i);
695
696 for (int i = ndims - 1; i > 1; i--)
697 {
698 if (dims[i] == 1)
699 ndims--;
700 else
701 break;
702 }
703 }
704
705 mxArray_matlab (mxClassID id_arg, int m, int n)
706 : mxArray_base (), class_name (0), id (id_arg), ndims (2),
707 dims (static_cast<int *> (malloc (ndims * sizeof (int))))
708 {
709 dims[0] = m;
710 dims[1] = n;
711 }
712
286 public: 713 public:
287 714
288 mxArray(void) 715 ~mxArray_matlab (void)
289 { 716 {
290 nr = nc = -1; 717 mxFree (class_name);
291 pr = pi = NULL; 718 mxFree (dims);
292 keys = NULL; 719 }
293 pmap = NULL; 720
294 isstr = false; 721 int is_cell (void) const { return id == mxCELL_CLASS; }
295 aname[0] = '\0'; 722
296 } 723 int is_char (void) const { return id == mxCHAR_CLASS; }
297 724
298 ~mxArray (void) 725 int is_complex (void) const { return 0; }
299 { 726
300 if (pmap) 727 int is_double (void) const { return id == mxDOUBLE_CLASS; }
728
729 int is_int16 (void) const { return id == mxINT16_CLASS; }
730
731 int is_int32 (void) const { return id == mxINT32_CLASS; }
732
733 int is_int64 (void) const { return id == mxINT64_CLASS; }
734
735 int is_int8 (void) const { return id == mxINT8_CLASS; }
736
737 int is_logical (void) const { return id == mxLOGICAL_CLASS; }
738
739 int is_numeric (void) const
740 {
741 return (id == mxDOUBLE_CLASS || id == mxSINGLE_CLASS
742 || id == mxINT8_CLASS || id == mxUINT8_CLASS
743 || id == mxINT16_CLASS || id == mxUINT16_CLASS
744 || id == mxINT32_CLASS || id == mxUINT32_CLASS
745 || id == mxINT64_CLASS || id == mxUINT64_CLASS);
746 }
747
748 int is_single (void) const { return id == mxSINGLE_CLASS; }
749
750 int is_sparse (void) const { return 0; }
751
752 int is_struct (void) const { return id == mxSTRUCT_CLASS; }
753
754 int is_uint16 (void) const { return id == mxUINT16_CLASS; }
755
756 int is_uint32 (void) const { return id == mxUINT32_CLASS; }
757
758 int is_uint64 (void) const { return id == mxUINT64_CLASS; }
759
760 int is_uint8 (void) const { return id == mxUINT8_CLASS; }
761
762 int is_logical_scalar_true (void) const
763 {
764 return (is_logical_scalar ()
765 && static_cast<mxLogical *> (get_data ())[0] != 0);
766 }
767
768 int get_m (void) const { return dims[0]; }
769
770 int get_n (void) const { return dims[1]; }
771
772 int *get_dimensions (void) const { return dims; }
773
774 int get_number_of_dimensions (void) const { return ndims; }
775
776 void set_m (int m) { dims[0] = m; }
777
778 void set_n (int n) { dims[1] = n; }
779
780 void set_dimensions (int *dims_arg, int ndims_arg)
781 {
782 dims = dims_arg;
783 ndims = ndims_arg;
784 }
785
786 int get_number_of_elements (void) const
787 {
788 int retval = dims[0];
789
790 for (int i = 1; i < ndims; i++)
791 retval *= dims[i];
792
793 return retval;
794 }
795
796 int is_empty (void) const { return get_number_of_elements () == 0; }
797
798 mxClassID get_class_id (void) const { return id; }
799
800 const char *get_class_name (void) const
801 {
802 switch (id)
301 { 803 {
302 // FIXME why don't string_vectors work? 804 case mxCELL_CLASS: return "cell";
303 for (int i = 0; i < pmap->length (); i++) 805 case mxSTRUCT_CLASS: return "struct";
304 delete [] keys[i]; 806 case mxLOGICAL_CLASS: return "logical";
305 807 case mxCHAR_CLASS: return "char";
306 delete [] keys; 808 case mxDOUBLE_CLASS: return "double";
809 case mxSINGLE_CLASS: return "single";
810 case mxINT8_CLASS: return "int8";
811 case mxUINT8_CLASS: return "uint8";
812 case mxINT16_CLASS: return "int16";
813 case mxUINT16_CLASS: return "uint16";
814 case mxINT32_CLASS: return "int32";
815 case mxUINT32_CLASS: return "uint32";
816 case mxINT64_CLASS: return "int64";
817 case mxUINT64_CLASS: return "uint64";
818 case mxFUNCTION_CLASS: return "function handle";
819 default: return "unknown";
307 } 820 }
308 } 821 }
309 822
310 octave_value as_octave_value (void) const; 823 void set_class_name (const char *name_arg)
311 824 {
312 int rows (void) const { return nr; } 825 mxFree (class_name);
313 int columns (void) const { return nc; } 826 class_name = static_cast<char *> (malloc (strlen (name_arg) + 1));
314 void rows (int r) { nr = r; } 827 strcpy (class_name, name_arg);
315 void columns (int c) { nc = c; } 828 }
316 int dims (void) const { return 2; } 829
317 830 mxArray *get_cell (int /*idx*/) const
318 double *imag (void) const { return pi; } 831 {
319 double *real (void) const { return pr; } 832 invalid_type_error ();
320 void imag (double *p) { pi = p; } 833 return 0;
321 void real (double *p) { pr = p; } 834 }
322 835
323 bool is_empty (void) const { return nr==0 || nc==0; } 836 void set_cell (int /*idx*/, mxArray */*val*/)
324 bool is_numeric (void) const { return ! isstr && (pr || nr == 0 || nc == 0); } 837 {
325 bool is_complex (void) const { return pi; } 838 invalid_type_error ();
326 bool is_sparse (void) const { return false; } 839 }
327 bool is_struct (void) const { return pmap; } 840
328 841 void *get_data (void) const
329 bool is_string (void) const { return isstr; } 842 {
330 void is_string (bool set) { isstr = set; } 843 invalid_type_error ();
331 844 return 0;
332 const char *name (void) const { return aname; } 845 }
333 void name (const char *nm) 846
334 { 847 void *get_imag_data (void) const
335 strncpy (aname, nm, mxMAXNAM); 848 {
336 aname[mxMAXNAM]='\0'; 849 invalid_type_error ();
337 } 850 return 0;
338 851 }
339 // Structure support functions. Matlab uses a fixed field order 852
340 // (the order in which the fields were added?), but Octave uses an 853 void set_data (void */*pr*/)
341 // unordered hash for structs. We can emulate a fixed field order 854 {
342 // using pmap->keys(), which returns a string_vector of key names, 855 invalid_type_error ();
343 // but these keys will not be in the same order as the keys given in 856 }
344 // mxCreateStruct*. Within the creating function, we can populate 857
345 // the key name vector in the order given, so the only problem will 858 void set_imag_data (void */*pi*/)
346 // be those functions which assume the key order is maintained 859 {
347 // between calls from Matlab. Unfortunately, these might exist and 860 invalid_type_error ();
348 // I can't detect them :-( 861 }
349 862
350 // Return the map value 863 int *get_ir (void) const
351 Octave_map *map (void) const { return pmap; } 864 {
352 865 invalid_type_error ();
353 // New structure with the given presumed field order (CreateStruct call) 866 return 0;
354 void map (Octave_map *p, const string_vector& mapkeys) 867 }
355 { 868
356 pmap = p; 869 int *get_jc (void) const
357 keys = mapkeys.c_str_vec (); 870 {
358 } 871 invalid_type_error ();
359 872 return 0;
360 // New structure with unknown field order (passed in from Octave) 873 }
361 void map (Octave_map *p) 874
362 { 875 int get_nzmax (void) const
363 pmap = p; 876 {
364 if (p) 877 invalid_type_error ();
365 keys = p->keys().c_str_vec (); 878 return 0;
366 } 879 }
367 880
368 // Get field given field name 881 void set_ir (int */*ir*/)
369 mxArray *field (const std::string& key_arg, const int index) const 882 {
370 { 883 invalid_type_error ();
371 if (pmap && pmap->contains (key_arg)) 884 }
372 return __mex->make_value (pmap->contents(key_arg)(index)); 885
886 void set_jc (int */*jc*/)
887 {
888 invalid_type_error ();
889 }
890
891 void set_nzmax (int /*nzmax*/)
892 {
893 invalid_type_error ();
894 }
895
896 int add_field (const char */*key*/)
897 {
898 invalid_type_error ();
899 return -1;
900 }
901
902 void remove_field (int /*key_num*/)
903 {
904 invalid_type_error ();
905 }
906
907 mxArray *get_field_by_number (int /*index*/, int /*key_num*/) const
908 {
909 invalid_type_error ();
910 return 0;
911 }
912
913 void set_field_by_number (int /*index*/, int /*key_num*/, mxArray */*val*/)
914 {
915 invalid_type_error ();
916 }
917
918 int get_number_of_fields (void) const
919 {
920 invalid_type_error ();
921 return 0;
922 }
923
924 const char *get_field_name_by_number (int /*key_num*/) const
925 {
926 invalid_type_error ();
927 return 0;
928 }
929
930 int get_field_number (const char */*key*/) const
931 {
932 return -1;
933 }
934
935 int get_string (char */*buf*/, int /*buflen*/) const
936 {
937 invalid_type_error ();
938 return 0;
939 }
940
941 char *array_to_string (void) const
942 {
943 invalid_type_error ();
944 return 0;
945 }
946
947 int calc_single_subscript (int nsubs, int *subs) const
948 {
949 int retval = 0;
950
951 int n = nsubs <= ndims ? nsubs : ndims;
952
953 while (--n > 0)
954 retval = retval * dims[n] + subs[n];
955
956 return retval;
957 }
958
959 int get_element_size (void) const
960 {
961 switch (id)
962 {
963 case mxCELL_CLASS: return sizeof (mxArray *);
964 case mxSTRUCT_CLASS: return sizeof (mxArray *);
965 case mxLOGICAL_CLASS: return sizeof (mxLogical);
966 case mxCHAR_CLASS: return sizeof (mxChar);
967 case mxDOUBLE_CLASS: return sizeof (double);
968 case mxSINGLE_CLASS: return sizeof (float);
969 case mxINT8_CLASS: return 1;
970 case mxUINT8_CLASS: return 1;
971 case mxINT16_CLASS: return 2;
972 case mxUINT16_CLASS: return 2;
973 case mxINT32_CLASS: return 4;
974 case mxUINT32_CLASS: return 4;
975 case mxINT64_CLASS: return 8;
976 case mxUINT64_CLASS: return 8;
977 case mxFUNCTION_CLASS: return 0;
978 default: return 0;
979 }
980 }
981
982 protected:
983
984 mxArray_matlab (const mxArray_matlab& val)
985 : mxArray_base (val), class_name (strsave (val.class_name)),
986 id (val.id), ndims (val.ndims),
987 dims (static_cast<int *> (malloc (ndims * sizeof (int))))
988 {
989 for (int i = 0; i < ndims; i++)
990 dims[i] = val.dims[i];
991 }
992
993 dim_vector
994 dims_to_dim_vector (void) const
995 {
996 int nd = get_number_of_dimensions ();
997
998 int *d = get_dimensions ();
999
1000 dim_vector dv;
1001 dv.resize (nd);
1002
1003 for (int i = 0; i < nd; i++)
1004 dv(i) = d[i];
1005
1006 return dv;
1007 }
1008
1009 private:
1010
1011 char *class_name;
1012
1013 mxClassID id;
1014
1015 int ndims;
1016 int *dims;
1017
1018 void invalid_type_error (void) const
1019 {
1020 error ("invalid type for operation");
1021 }
1022 };
1023
1024 // Matlab-style numeric, character, and logical data.
1025
1026 class mxArray_number : public mxArray_matlab
1027 {
1028 public:
1029
1030 mxArray_number (mxClassID id_arg, int ndims_arg, const int *dims_arg,
1031 mxComplexity flag = mxREAL)
1032 : mxArray_matlab (id_arg, ndims_arg, dims_arg),
1033 pr (calloc (get_number_of_elements (), get_element_size ())),
1034 pi (flag == mxCOMPLEX ? calloc (get_number_of_elements (), get_element_size ()) : 0) { }
1035
1036 mxArray_number (mxClassID id_arg, const dim_vector& dv,
1037 mxComplexity flag = mxREAL)
1038 : mxArray_matlab (id_arg, dv),
1039 pr (calloc (get_number_of_elements (), get_element_size ())),
1040 pi (flag == mxCOMPLEX ? calloc (get_number_of_elements (), get_element_size ()) : 0) { }
1041
1042 mxArray_number (mxClassID id_arg, int m, int n, mxComplexity flag = mxREAL)
1043 : mxArray_matlab (id_arg, m, n),
1044 pr (calloc (get_number_of_elements (), get_element_size ())),
1045 pi (flag == mxCOMPLEX ? calloc (get_number_of_elements (), get_element_size ()) : 0) { }
1046
1047 mxArray_number (mxClassID id_arg, double val)
1048 : mxArray_matlab (id_arg, 1, 1),
1049 pr (calloc (get_number_of_elements (), get_element_size ())),
1050 pi (0)
1051 {
1052 double *dpr = static_cast<double *> (pr);
1053 dpr[0] = val;
1054 }
1055
1056 mxArray_number (mxClassID id_arg, mxLogical val)
1057 : mxArray_matlab (id_arg, 1, 1),
1058 pr (calloc (get_number_of_elements (), get_element_size ())),
1059 pi (0)
1060 {
1061 mxLogical *lpr = static_cast<mxLogical *> (pr);
1062 lpr[0] = val;
1063 }
1064
1065 mxArray_number (const char *str)
1066 : mxArray_matlab (mxCHAR_CLASS, 1, strlen (str)),
1067 pr (calloc (get_number_of_elements (), get_element_size ())),
1068 pi (0)
1069 {
1070 mxChar *cpr = static_cast<mxChar *> (pr);
1071 int nel = get_number_of_elements ();
1072 for (int i = 0; i < nel; i++)
1073 cpr[i] = str[i];
1074 }
1075
1076 mxArray_number (int m, const char **str)
1077 : mxArray_matlab (mxCHAR_CLASS, m, max_str_len (m, str)),
1078 pr (calloc (get_number_of_elements (), get_element_size ())),
1079 pi (0)
1080 {
1081 mxChar *cpr = static_cast<mxChar *> (pr);
1082
1083 int *dv = get_dimensions ();
1084
1085 int nc = dv[1];
1086
1087 for (int j = 0; j < m; j++)
1088 {
1089 const char *ptr = str[j];
1090
1091 int tmp_len = strlen (ptr);
1092
1093 for (int i = 0; i < tmp_len; i++)
1094 cpr[i] = static_cast<mxChar> (ptr[i]);
1095
1096 for (int i = tmp_len; i < nc; i++)
1097 cpr[i] = static_cast<mxChar> (' ');
1098 }
1099 }
1100
1101 mxArray_number *clone (void) const { return new mxArray_number (*this); }
1102
1103 ~mxArray_number (void)
1104 {
1105 mxFree (pr);
1106 mxFree (pi);
1107 }
1108
1109 template <typename ELT_T, typename ARRAY_T, typename ARRAY_ELT_T>
1110 octave_value
1111 int_to_ov (const dim_vector& dv) const
1112 {
1113 octave_value retval;
1114
1115 int nel = get_number_of_elements ();
1116
1117 ELT_T *ppr = static_cast<ELT_T *> (pr);
1118
1119 if (pi)
1120 error ("complex integer types are not supported");
373 else 1121 else
374 return 0; 1122 {
375 } 1123 ARRAY_T val (dv);
376 1124
377 // Set field given field name 1125 ARRAY_ELT_T *ptr = val.fortran_vec ();
378 void field (const std::string& key_arg, const int index, mxArray *value) 1126
379 { 1127 for (int i = 0; i < nel; i++)
380 if (pmap) 1128 ptr[i] = ppr[i];
381 pmap->assign (octave_value (index+1), 1129
382 key_arg, Cell (value->as_octave_value ())); 1130 retval = val;
383 1131 }
384 if (error_state) 1132
385 __mex->abort (); 1133 return retval;
386 } 1134 }
387 1135
388 // Return number of fields in structure 1136 octave_value as_octave_value (void) const
389 int num_keys(void) const { return pmap ? pmap->length () : 0; } 1137 {
390 1138 octave_value retval;
391 // Return field name from field number 1139
392 const std::string key (const int key_num) const 1140 dim_vector dv = dims_to_dim_vector ();
393 { 1141
394 if (key_num >= 0 && key_num < pmap->length ()) 1142 switch (get_class_id ())
395 return keys[key_num]; 1143 {
396 else 1144 case mxLOGICAL_CLASS:
397 return 0; 1145 retval = int_to_ov<bool, boolNDArray, bool> (dv);
398 } 1146 break;
399 // Return field number from field name 1147
400 int key (const std::string &key_name) const 1148 case mxCHAR_CLASS:
401 { 1149 {
402 for (int i = 0; i < pmap->length (); i++) 1150 int nel = get_number_of_elements ();
403 if (key_name == std::string (keys[i])) 1151
404 return i; 1152 mxChar *ppr = static_cast<mxChar *> (pr);
405 1153
406 return -1; 1154 charNDArray val (dv);
407 } 1155
408 1156 char *ptr = val.fortran_vec ();
409 // Get field using field number 1157
410 mxArray *field (const int key_num, const int index) const 1158 for (int i = 0; i < nel; i++)
411 { 1159 ptr[i] = static_cast<char> (ppr[i]);
412 if (key_num >= 0 && key_num < pmap->length ()) 1160
413 return field (keys[key_num], index); 1161 retval = octave_value (val, true, '\'');
414 else 1162 }
415 return 0; 1163 break;
416 } 1164
417 1165 case mxSINGLE_CLASS:
418 // Set field using field number 1166 error ("single precision data type not supported");
419 void field (const int key_num, const int index , mxArray *value) 1167 break;
420 { 1168
421 if (key_num >= 0 && key_num < pmap->length ()) 1169 case mxDOUBLE_CLASS:
422 field (keys[key_num], index, value); 1170 {
1171 int nel = get_number_of_elements ();
1172
1173 double *ppr = static_cast<double *> (pr);
1174
1175 if (pi)
1176 {
1177 ComplexNDArray val (dv);
1178
1179 Complex *ptr = val.fortran_vec ();
1180
1181 double *ppi = static_cast<double *> (pi);
1182
1183 for (int i = 0; i < nel; i++)
1184 ptr[i] = Complex (ppr[i], ppi[i]);
1185
1186 retval = val;
1187 }
1188 else
1189 {
1190 NDArray val (dv);
1191
1192 double *ptr = val.fortran_vec ();
1193
1194 for (int i = 0; i < nel; i++)
1195 ptr[i] = ppr[i];
1196
1197 retval = val;
1198 }
1199 }
1200 break;
1201
1202 case mxINT8_CLASS:
1203 retval = int_to_ov<int8_t, int8NDArray, octave_int8> (dv);
1204 break;
1205
1206 case mxUINT8_CLASS:
1207 retval = int_to_ov<uint8_t, uint8NDArray, octave_uint8> (dv);
1208 break;
1209
1210 case mxINT16_CLASS:
1211 retval = int_to_ov<int16_t, int16NDArray, octave_int16> (dv);
1212 break;
1213
1214 case mxUINT16_CLASS:
1215 retval = int_to_ov<uint16_t, uint16NDArray, octave_uint16> (dv);
1216 break;
1217
1218 case mxINT32_CLASS:
1219 retval = int_to_ov<int32_t, int32NDArray, octave_int32> (dv);
1220 break;
1221
1222 case mxUINT32_CLASS:
1223 retval = int_to_ov<uint32_t, uint32NDArray, octave_uint32> (dv);
1224 break;
1225
1226 case mxINT64_CLASS:
1227 retval = int_to_ov<int64_t, int64NDArray, octave_int64> (dv);
1228 break;
1229
1230 case mxUINT64_CLASS:
1231 retval = int_to_ov<uint64_t, uint64NDArray, octave_uint64> (dv);
1232 break;
1233
1234 default:
1235 panic_impossible ();
1236 }
1237
1238 return retval;
1239 }
1240
1241 int is_complex (void) const { return pi != 0; }
1242
1243 void *get_data (void) const { return pr; }
1244
1245 void *get_imag_data (void) const { return pi; }
1246
1247 void set_data (void *pr_arg) { pr = pr_arg; }
1248
1249 void set_imag_data (void *pi_arg) { pi = pi_arg; }
1250
1251 int get_string (char *buf, int buflen) const
1252 {
1253 int retval = 1;
1254
1255 int n = get_number_of_elements ();
1256
1257 if (n < buflen)
1258 {
1259 mxChar *ptr = static_cast<mxChar *> (pr);
1260
1261 for (int i = 0; i < n; i++)
1262 buf[i] = static_cast<char> (ptr[i]);
1263
1264 buf[n] = 0;
1265 }
1266
1267 return retval;
1268 }
1269
1270 char *array_to_string (void) const
1271 {
1272 // FIXME -- this is suposed to handle multi-byte character
1273 // strings.
1274
1275 int nel = get_number_of_elements ();
1276
1277 char *buf = static_cast<char *> (malloc (nel + 1));
1278
1279 if (buf)
1280 {
1281 mxChar *ptr = static_cast<mxChar *> (pr);
1282
1283 for (int i = 0; i < nel; i++)
1284 buf[i] = static_cast<char> (ptr[i]);
1285
1286 buf[nel] = '\0';
1287 }
1288
1289 return buf;
1290 }
1291
1292 protected:
1293
1294 mxArray_number (const mxArray_number& val)
1295 : mxArray_matlab (val),
1296 pr (malloc (get_number_of_elements () * get_element_size ())),
1297 pi (val.pi ? malloc (get_number_of_elements () * get_element_size ()) : 0)
1298 {
1299 int ntot = get_number_of_elements () * get_element_size ();
1300
1301 memcpy (pr, val.pr, ntot);
1302
1303 if (pi)
1304 memcpy (pi, val.pi, ntot);
423 } 1305 }
424 1306
425 private: 1307 private:
426 int nr; 1308
427 int nc; 1309 void *pr;
428 double *pr; 1310 void *pi;
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 }; 1311 };
1312
1313 // Matlab-style sparse arrays.
1314
1315 class mxArray_sparse : public mxArray_number
1316 {
1317 public:
1318
1319 mxArray_sparse (mxClassID id_arg, int m, int n, int nzmax_arg,
1320 mxComplexity flag = mxREAL)
1321 : mxArray_number (id_arg, m, n, flag), nzmax (nzmax_arg)
1322 {
1323 ir = static_cast<int *> (calloc (nzmax, sizeof (int)));
1324 jc = static_cast<int *> (calloc (nzmax, sizeof (int)));
1325 }
1326
1327 mxArray_sparse *clone (void) const { return new mxArray_sparse (*this); }
1328
1329 ~mxArray_sparse (void)
1330 {
1331 mxFree (ir);
1332 mxFree (jc);
1333 }
1334
1335 octave_value as_octave_value (void) const
1336 {
1337 // FIXME
1338 abort ();
1339 return octave_value ();
1340 }
1341
1342 int is_sparse (void) const { return 1; }
1343
1344 int *get_ir (void) const { return ir; }
1345
1346 int *get_jc (void) const { return jc; }
1347
1348 int get_nzmax (void) const { return nzmax; }
1349
1350 void set_ir (int *ir_arg) { ir = ir_arg; }
1351
1352 void set_jc (int *jc_arg) { jc = jc_arg; }
1353
1354 void set_nzmax (int nzmax_arg) { nzmax = nzmax_arg; }
1355
1356 private:
1357
1358 int nzmax;
1359
1360 int *ir;
1361 int *jc;
1362
1363 mxArray_sparse (const mxArray_sparse& val)
1364 : mxArray_number (val), nzmax (val.nzmax),
1365 ir (static_cast<int *> (malloc (nzmax * sizeof (int)))),
1366 jc (static_cast<int *> (malloc (nzmax * sizeof (int))))
1367 {
1368 for (int i = 0; i < nzmax; i++)
1369 {
1370 ir[i] = val.ir[i];
1371 jc[i] = val.jc[i];
1372 }
1373 }
1374 };
1375
1376 // Matlab-style struct arrays.
1377
1378 class mxArray_struct : public mxArray_matlab
1379 {
1380 public:
1381
1382 mxArray_struct (int ndims_arg, const int *dims_arg, int num_keys_arg,
1383 const char **keys)
1384 : mxArray_matlab (mxSTRUCT_CLASS, ndims_arg, dims_arg), nfields (num_keys_arg),
1385 fields (static_cast<char **> (calloc (nfields, sizeof (char *)))),
1386 data (static_cast<mxArray **> (calloc (nfields * get_number_of_elements (), sizeof (mxArray *))))
1387 {
1388 init (keys);
1389 }
1390
1391 mxArray_struct (const dim_vector& dv, int num_keys_arg, const char **keys)
1392 : mxArray_matlab (mxSTRUCT_CLASS, dv), nfields (num_keys_arg),
1393 fields (static_cast<char **> (calloc (nfields, sizeof (char *)))),
1394 data (static_cast<mxArray **> (calloc (nfields * get_number_of_elements (), sizeof (mxArray *))))
1395 {
1396 init (keys);
1397 }
1398
1399 mxArray_struct (int m, int n, int num_keys_arg, const char **keys)
1400 : mxArray_matlab (mxSTRUCT_CLASS, m, n), nfields (num_keys_arg),
1401 fields (static_cast<char **> (calloc (nfields, sizeof (char *)))),
1402 data (static_cast<mxArray **> (calloc (nfields * get_number_of_elements (), sizeof (mxArray *))))
1403 {
1404 init (keys);
1405 }
1406
1407 void init (const char **keys)
1408 {
1409 for (int i = 0; i < nfields; i++)
1410 fields[i] = strsave (keys[i]);
1411 }
1412
1413 mxArray_struct *clone (void) const { return new mxArray_struct (*this); }
1414
1415 ~mxArray_struct (void)
1416 {
1417 for (int i = 0; i < nfields; i++)
1418 mxFree (fields[i]);
1419
1420 mxFree (fields);
1421
1422 int ntot = nfields * get_number_of_elements ();
1423
1424 for (int i = 0; i < ntot; i++)
1425 mxDestroyArray (data[i]);
1426
1427 mxFree (data);
1428 }
1429
1430 octave_value as_octave_value (void) const
1431 {
1432 dim_vector dv = dims_to_dim_vector ();
1433
1434 string_vector keys (fields, nfields);
1435
1436 Octave_map m;
1437
1438 int ntot = nfields * get_number_of_elements ();
1439
1440 for (int i = 0; i < nfields; i++)
1441 {
1442 Cell c (dv);
1443
1444 octave_value *p = c.fortran_vec ();
1445
1446 int k = 0;
1447 for (int j = i; j < ntot; j += nfields)
1448 p[k++] = data[j]->as_octave_value ();
1449
1450 m.assign (keys[i], c);
1451 }
1452
1453 return m;
1454 }
1455
1456 int add_field (const char *key)
1457 {
1458 int retval = -1;
1459
1460 if (valid_key (key))
1461 {
1462 nfields++;
1463
1464 fields = static_cast<char **> (mxRealloc (fields, nfields * sizeof (char *)));
1465
1466 if (fields)
1467 {
1468 fields[nfields-1] = strsave (key);
1469
1470 int nel = get_number_of_elements ();
1471
1472 int ntot = nfields * nel;
1473
1474 mxArray **new_data = static_cast<mxArray **> (malloc (ntot * sizeof (mxArray *)));
1475
1476 if (new_data)
1477 {
1478 int j = 0;
1479 int k = 0;
1480 int n = 0;
1481
1482 for (int i = 0; i < ntot; i++)
1483 {
1484 if (++n == nfields)
1485 {
1486 new_data[j++] = 0;
1487 n = 0;
1488 }
1489 else
1490 new_data[j++] = data[k++];
1491 }
1492
1493 mxFree (data);
1494
1495 data = new_data;
1496
1497 retval = nfields - 1;
1498 }
1499 }
1500 }
1501
1502 return retval;
1503 }
1504
1505 void remove_field (int key_num)
1506 {
1507 if (key_num >= 0 && key_num < nfields)
1508 {
1509 int nel = get_number_of_elements ();
1510
1511 int ntot = nfields * nel;
1512
1513 int new_nfields = nfields - 1;
1514
1515 char **new_fields = static_cast<char **> (malloc (new_nfields * sizeof (char *)));
1516
1517 mxArray **new_data = static_cast<mxArray **> (malloc (new_nfields * nel * sizeof (mxArray *)));
1518
1519 for (int i = 0; i < key_num; i++)
1520 new_fields[i] = fields[i];
1521
1522 for (int i = key_num + 1; i < nfields; i++)
1523 new_fields[i-1] = fields[i];
1524
1525 if (new_nfields > 0)
1526 {
1527 int j = 0;
1528 int k = 0;
1529 int n = 0;
1530
1531 for (int i = 0; i < ntot; i++)
1532 {
1533 if (n == key_num)
1534 k++;
1535 else
1536 new_data[j++] = data[k++];
1537
1538 if (++n == nfields)
1539 n = 0;
1540 }
1541 }
1542
1543 nfields = new_nfields;
1544
1545 mxFree (fields);
1546 mxFree (data);
1547
1548 fields = new_fields;
1549 data = new_data;
1550 }
1551 }
1552
1553 mxArray *get_field_by_number (int index, int key_num) const
1554 {
1555 int idx = nfields * index + key_num;
1556
1557 return data[idx];
1558 }
1559
1560 void set_field_by_number (int index, int key_num, mxArray *val)
1561 {
1562 int idx = nfields * index + key_num;
1563
1564 data[idx] = val;
1565 }
1566
1567 int get_number_of_fields (void) const { return nfields; }
1568
1569 const char *get_field_name_by_number (int key_num) const
1570 {
1571 return key_num >= 0 && key_num < nfields ? fields[key_num] : 0;
1572 }
1573
1574 int get_field_number (const char *key) const
1575 {
1576 int retval = -1;
1577
1578 for (int i = 0; i < nfields; i++)
1579 {
1580 if (! strcmp (key, fields[i]))
1581 {
1582 retval = i;
1583 break;
1584 }
1585 }
1586
1587 return retval;
1588 }
1589
1590 void *get_data (void) const { return data; }
1591
1592 void set_data (void *data_arg) { data = static_cast<mxArray **> (data_arg); }
1593
1594 private:
1595
1596 int nfields;
1597
1598 char **fields;
1599
1600 mxArray **data;
1601
1602 mxArray_struct (const mxArray_struct& val)
1603 : mxArray_matlab (val), nfields (val.nfields),
1604 fields (static_cast<char **> (malloc (nfields * sizeof (char *)))),
1605 data (static_cast<mxArray **> (malloc (nfields * get_number_of_elements () * sizeof (mxArray *))))
1606 {
1607 for (int i = 0; i < nfields; i++)
1608 fields[i] = strsave (val.fields[i]);
1609
1610 int nel = get_number_of_elements ();
1611
1612 for (int i = 0; i < nel * nfields; i++)
1613 data[i] = val.data[i]->clone ();
1614 }
1615 };
1616
1617 // Matlab-style cell arrays.
1618
1619 class mxArray_cell : public mxArray_matlab
1620 {
1621 public:
1622
1623 mxArray_cell (int ndims_arg, const int *dims_arg)
1624 : mxArray_matlab (mxCELL_CLASS, ndims_arg, dims_arg),
1625 data (static_cast<mxArray **> (calloc (get_number_of_elements (), sizeof (mxArray *)))) { }
1626
1627 mxArray_cell (const dim_vector& dv)
1628 : mxArray_matlab (mxCELL_CLASS, dv),
1629 data (static_cast<mxArray **> (calloc (get_number_of_elements (), sizeof (mxArray *)))) { }
1630
1631 mxArray_cell (int m, int n)
1632 : mxArray_matlab (mxCELL_CLASS, m, n),
1633 data (static_cast<mxArray **> (calloc (get_number_of_elements (), sizeof (mxArray *)))) { }
1634
1635 mxArray_cell *clone (void) const { return new mxArray_cell (*this); }
1636
1637 ~mxArray_cell (void)
1638 {
1639 int nel = get_number_of_elements ();
1640
1641 for (int i = 0; i < nel; i++)
1642 mxDestroyArray (data[i]);
1643
1644 mxFree (data);
1645 }
1646
1647 octave_value as_octave_value (void) const
1648 {
1649 dim_vector dv = dims_to_dim_vector ();
1650
1651 Cell c (dv);
1652
1653 int nel = get_number_of_elements ();
1654
1655 octave_value *p = c.fortran_vec ();
1656
1657 for (int i = 0; i < nel; i++)
1658 p[i] = data[i]->as_octave_value ();
1659
1660 return c;
1661 }
1662
1663 mxArray *get_cell (int idx) const { return data[idx]; }
1664
1665 void set_cell (int idx, mxArray *val) { data[idx] = val; }
1666
1667 void *get_data (void) const { return data; }
1668
1669 void set_data (void *data_arg) { data = static_cast<mxArray **> (data_arg); }
1670
1671 private:
1672
1673 mxArray **data;
1674
1675 mxArray_cell (const mxArray_cell& val)
1676 : mxArray_matlab (val),
1677 data (static_cast<mxArray **> (malloc (get_number_of_elements () * sizeof (mxArray *))))
1678 {
1679 int nel = get_number_of_elements ();
1680
1681 for (int i = 0; i < nel; i++)
1682 data[i] = val.data[i]->clone ();
1683 }
1684 };
1685
1686 // ------------------------------------------------------------------
1687
1688 mxArray::mxArray (const octave_value& ov)
1689 : rep (new mxArray_octave_value (ov)), name (0), persistent (false) { }
1690
1691 mxArray::mxArray (mxClassID id, int ndims, const int *dims, mxComplexity flag)
1692 : rep (new mxArray_number (id, ndims, dims, flag)), name (0), persistent (false) { }
1693
1694 mxArray::mxArray (mxClassID id, const dim_vector& dv, mxComplexity flag)
1695 : rep (new mxArray_number (id, dv, flag)), name (0), persistent (false) { }
1696
1697 mxArray::mxArray (mxClassID id, int m, int n, mxComplexity flag)
1698 : rep (new mxArray_number (id, m, n, flag)), name (0), persistent (false) { }
1699
1700 mxArray::mxArray (mxClassID id, double val)
1701 : rep (new mxArray_number (id, val)), name (0), persistent (false) { }
1702
1703 mxArray::mxArray (mxClassID id, mxLogical val)
1704 : rep (new mxArray_number (id, val)), name (0), persistent (false) { }
1705
1706 mxArray::mxArray (const char *str)
1707 : rep (new mxArray_number (str)), name (0), persistent (false) { }
1708
1709 mxArray::mxArray (int m, const char **str)
1710 : rep (new mxArray_number (m, str)), name (0), persistent (false) { }
1711
1712 mxArray::mxArray (mxClassID id, int m, int n, int nzmax, mxComplexity flag)
1713 : rep (new mxArray_sparse (id, m, n, nzmax, flag)), name (0), persistent (false) { }
1714
1715 mxArray::mxArray (int ndims, const int *dims, int num_keys, const char **keys)
1716 : rep (new mxArray_struct (ndims, dims, num_keys, keys)), name (0), persistent (false) { }
1717
1718 mxArray::mxArray (const dim_vector& dv, int num_keys, const char **keys)
1719 : rep (new mxArray_struct (dv, num_keys, keys)), name (0), persistent (false) { }
1720
1721 mxArray::mxArray (int m, int n, int num_keys, const char **keys)
1722 : rep (new mxArray_struct (m, n, num_keys, keys)), name (0), persistent (false) { }
1723
1724 mxArray::mxArray (int ndims, const int *dims)
1725 : rep (new mxArray_cell (ndims, dims)), name (0), persistent (false) { }
1726
1727 mxArray::mxArray (const dim_vector& dv)
1728 : rep (new mxArray_cell (dv)), name (0), persistent (false) { }
1729
1730 mxArray::mxArray (int m, int n)
1731 : rep (new mxArray_cell (m, n)), name (0), persistent (false) { }
1732
1733 mxArray::~mxArray (void)
1734 {
1735 mxFree (name);
1736
1737 delete rep;
1738 }
438 1739
439 octave_value 1740 octave_value
440 mxArray::as_octave_value (void) const 1741 mxArray::as_octave_value (void) const
441 { 1742 {
442 octave_value ret; 1743 return rep->as_octave_value ();
443 1744 }
444 if (isstr) 1745
1746 void
1747 mxArray::set_name (const char *name_arg)
1748 {
1749 mxFree (name);
1750 name = strsave (name_arg);
1751 }
1752
1753 void
1754 mxArray::maybe_mutate (void) const
1755 {
1756 if (rep->is_octave_value ())
445 { 1757 {
446 charMatrix chm (nr, nc); 1758 // The mutate function returns a pointer to a complete new
447 char *pchm = chm.fortran_vec (); 1759 // mxArray object (or 0, if no mutation happened). We just want
448 for (int i=0; i < nr*nc; i++) 1760 // to replace the existing rep with the rep from the new object.
449 pchm[i] = NINT (pr[i]); 1761
450 ret = octave_value (chm, true); 1762 mxArray *new_val = rep->mutate ();
451 } 1763
452 else if (pmap) 1764 if (new_val)
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 { 1765 {
506 // FIXME - must use 16 bit unicode to represent strings. 1766 delete rep;
507 const Matrix m (ov.matrix_value (1)); 1767 rep = new_val->rep;
508 pr = static_cast<double *> (malloc(nr*nc*sizeof(double))); 1768 new_val->rep = 0;
509 memcpy (pr, m.data (), nr*nc*sizeof(double)); 1769 delete new_val;
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 } 1770 }
532 } 1771 }
533 1772 }
534 mxArray *value = static_cast<mxArray *> (malloc (sizeof(mxArray))); 1773
535 1774 // ------------------------------------------------------------------
536 value->is_string (ov.is_string ()); 1775
537 value->real (pr); 1776 // A clas to manage calls to MEX functions. Mostly deals with memory
538 value->imag (pi); 1777 // management.
539 value->map (pmap); 1778
540 value->rows (nr); 1779 class mex
541 value->columns (nc); 1780 {
542 value->name (""); 1781 public:
543 1782
544 return value; 1783 mex (void) : memlist (), arraylist (), fname (0) { }
545 } 1784
546 1785 ~mex (void)
547 // Make a new array value and initialize it with zeros; it will be 1786 {
548 // freed on exit unless marked as persistent. 1787 if (! memlist.empty ())
549 1788 error ("mex: cleanup failed");
1789
1790 mxFree (fname);
1791 }
1792
1793 const char *function_name (void) const
1794 {
1795 if (! fname)
1796 {
1797 octave_function *fcn = octave_call_stack::current ();
1798
1799 if (fcn)
1800 {
1801 std::string nm = fcn->name ();
1802 fname = strsave (nm.c_str ());
1803 }
1804 else
1805 fname = strsave ("unknown");
1806 }
1807
1808 return fname;
1809 }
1810
1811 // Free all unmarked pointers obtained from malloc and calloc.
1812 static void cleanup (void *ptr)
1813 {
1814 mex *context = static_cast<mex *> (ptr);
1815
1816 for (std::set<void *>::iterator p = context->memlist.begin ();
1817 p != context->memlist.end (); p++)
1818 context->free (*p);
1819
1820 for (std::set<mxArray *>::iterator p = context->arraylist.begin ();
1821 p != context->arraylist.end (); p++)
1822 context->free_value (*p);
1823 }
1824
1825 // allocate a pointer, and mark it to be freed on exit
1826 void *malloc_unmarked (size_t n)
1827 {
1828 void *ptr = ::malloc (n);
1829
1830 #ifdef DEBUG
1831 std::cerr << "malloc " << n << " bytes: " << ptr << std::endl;
1832 #endif
1833
1834 if (! ptr)
1835 {
1836 // FIXME -- could use "octave_new_handler();" instead
1837
1838 error ("%s: failed to allocate %d bytes of memory",
1839 mexFunctionName (), n);
1840
1841 abort ();
1842 }
1843
1844 global_mark (ptr);
1845
1846 return ptr;
1847 }
1848
1849 void *malloc (size_t n)
1850 {
1851 void *ptr = malloc_unmarked (n);
1852
1853 mark (ptr);
1854
1855 return ptr;
1856 }
1857
1858 // Allocate a pointer to be freed on exit, and initialize to 0.
1859 void *calloc_unmarked (size_t n, size_t t)
1860 {
1861 void *ptr = malloc_unmarked (n*t);
1862
1863 memset (ptr, 0, n*t);
1864
1865 return ptr;
1866 }
1867
1868 void *calloc (size_t n, size_t t)
1869 {
1870 void *ptr = calloc_unmarked (n, t);
1871
1872 mark (ptr);
1873
1874 return ptr;
1875 }
1876
1877 // Reallocate a pointer obtained from malloc or calloc. We don't
1878 // need an "unmarked" version of this.
1879 void *realloc (void *ptr, size_t n)
1880 {
1881 void *v = ::realloc (ptr, n);
1882
1883 #ifdef DEBUG
1884 std::cerr << "realloc: " << n << " bytes: " << ptr << std::endl;
1885 #endif
1886
1887 std::set<void *>::iterator p = memlist.find (ptr);
1888
1889 if (v && p != memlist.end ())
1890 {
1891 memlist.erase (p);
1892 memlist.insert (v);
1893 }
1894
1895 p = global_memlist.find (ptr);
1896
1897 if (v && p != global_memlist.end ())
1898 {
1899 global_memlist.erase (p);
1900 global_memlist.insert (v);
1901 }
1902
1903 return v;
1904 }
1905
1906 // Free a pointer obtained from malloc or calloc.
1907 void free (void *ptr)
1908 {
1909 if (ptr)
1910 {
1911 unmark (ptr);
1912
1913 std::set<void *>::iterator p = global_memlist.find (ptr);
1914
1915 if (p != global_memlist.end ())
1916 {
1917 global_memlist.erase (p);
1918
1919 #ifdef DEBUG
1920 std::cerr << "free: " << ptr << std::endl;
1921 #endif
1922 ::free (ptr);
1923 }
1924 else
1925 warning ("mxFree: skipping memory not allocated by mxMalloc, mxCalloc, or mxRealloc");
1926 }
1927 }
1928
1929 // Mark a pointer so that it will not be freed on exit.
1930 void persistent (void *ptr) { unmark (ptr); }
1931
1932 // Make a new array value and initialize from an octave value; it will be
1933 // freed on exit unless marked as persistent.
1934 mxArray *make_value (const octave_value& ov)
1935 {
1936 mxArray *ptr = new mxArray (ov);
1937 arraylist.insert (ptr);
1938 return ptr;
1939 }
1940
1941 // Free an array and its contents.
1942 void free_value (mxArray *ptr)
1943 {
1944 arraylist.erase (ptr);
1945 delete ptr;
1946 }
1947
1948 // Mark an array and its contents so it will not be freed on exit.
1949 void persistent (mxArray *ptr)
1950 {
1951 ptr->mark_persistent ();
1952 }
1953
1954 // 1 if error should be returned to MEX file, 0 if abort.
1955 int trap_feval_error;
1956
1957 // longjmp return point if mexErrMsgTxt or error.
1958 jmp_buf jump;
1959
1960 // Trigger a long jump back to the mex calling function.
1961 void abort (void) { longjmp (jump, 1); }
1962
1963 private:
1964
1965 // List of memory resources that need to be freed upon exit.
1966 std::set<void *> memlist;
1967
1968 std::set<mxArray *> arraylist;
1969
1970 // The name of the currently executing function.
1971 mutable char *fname;
1972
1973 // Mark a pointer to be freed on exit.
1974 void mark (void *p)
1975 {
1976 #ifdef DEBUG
1977 if (memlist.find (p) != memlist.end ())
1978 warning ("%s: double registration ignored", mexFunctionName ());
1979 #endif
1980
1981 memlist.insert (p);
1982 }
1983
1984 // Unmark a pointer to be freed on exit, either because it was
1985 // made persistent, or because it was already freed.
1986 void unmark (void *p)
1987 {
1988 #ifdef DEBUG
1989 if (memlist.find (p) != memlist.end ())
1990 warning ("%s: value not marked", mexFunctionName ());
1991 #endif
1992
1993 memlist.erase (p);
1994 }
1995
1996 // List of memory resources we allocated.
1997 static std::set<void *> global_memlist;
1998
1999 // Mark a pointer as one we allocated.
2000 void global_mark (void *p)
2001 {
2002 #ifdef DEBUG
2003 if (global_memlist.find (p) != global_memlist.end ())
2004 warning ("%s: double registration ignored", mexFunctionName ());
2005 #endif
2006
2007 global_memlist.insert (p);
2008 }
2009
2010 // Unmark a pointer as one we allocated.
2011 void global_unmark (void *p)
2012 {
2013 #ifdef DEBUG
2014 if (global_memlist.find (p) != global_memlist.end ())
2015 warning ("%s: value not marked", mexFunctionName ());
2016 #endif
2017
2018 global_memlist.erase (p);
2019 }
2020 };
2021
2022 // List of memory resources we allocated.
2023 std::set<void *> mex::global_memlist;
2024
2025 // Current context.
2026 mex *mex_context = 0;
2027
2028 void *
2029 mxArray::malloc (size_t n)
2030 {
2031 return mex_context ? mex_context->malloc_unmarked (n) : malloc (n);
2032 }
2033
2034 void *
2035 mxArray::calloc (size_t n, size_t t)
2036 {
2037 return mex_context ? mex_context->calloc_unmarked (n, t) : calloc (n, t);
2038 }
2039
2040 // ------------------------------------------------------------------
2041
2042 // C interface to mxArray objects:
2043
2044 // Floating point predicates.
2045
2046 int
2047 mxIsFinite (const double v)
2048 {
2049 return lo_ieee_finite (v) != 0;
2050 }
2051
2052 int
2053 mxIsInf (const double v)
2054 {
2055 return lo_ieee_isinf (v) != 0;
2056 }
2057
2058 int
2059 mxIsNaN (const double v)
2060 {
2061 return lo_ieee_isnan (v) != 0;
2062 }
2063
2064 double
2065 mxGetEps (void)
2066 {
2067 return DBL_EPSILON;
2068 }
2069
2070 double
2071 mxGetInf (void)
2072 {
2073 return lo_ieee_inf_value ();
2074 }
2075
2076 double
2077 mxGetNaN (void)
2078 {
2079 return lo_ieee_nan_value ();
2080 }
2081
2082 // Memory management.
2083 void *
2084 mxCalloc (size_t n, size_t size)
2085 {
2086 return mex_context ? mex_context->calloc (n, size) : calloc (n, size);
2087 }
2088
2089 void *
2090 mxMalloc (size_t n)
2091 {
2092 return mex_context ? mex_context->malloc (n) : malloc (n);
2093 }
2094
2095 void *
2096 mxRealloc (void *ptr, size_t size)
2097 {
2098 return mex_context ? mex_context->realloc (ptr, size) : realloc (ptr, size);
2099 }
2100
2101 void
2102 mxFree (void *ptr)
2103 {
2104 if (mex_context)
2105 mex_context->free (ptr);
2106 else
2107 free (ptr);
2108 }
2109
2110 // Constructors.
550 mxArray * 2111 mxArray *
551 mex::make_value (int nr, int nc, int cmplx) 2112 mxCreateCellArray (int ndims, const int *dims)
552 { 2113 {
553 2114 return new mxArray (ndims, dims);
554 mxArray *value = static_cast<mxArray *> (malloc (sizeof(mxArray))); 2115 }
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 2116
574 mxArray * 2117 mxArray *
575 mex::make_value (int nr, int nc, const string_vector& keys) 2118 mxCreateCellMatrix (int m, int n)
576 { 2119 {
577 if (keys.length () == 0) 2120 return new mxArray (m, n);
578 return 0; 2121 }
579 2122
580 Cell empty (nr, nc); 2123 mxArray *
581 Octave_map *pmap = new Octave_map (keys[0], empty); 2124 mxCreateCharArray (int ndims, const int *dims)
582 for (int i=1; i < keys.length (); i++) 2125 {
583 pmap->assign (keys[i], empty); 2126 return new mxArray (mxCHAR_CLASS, ndims, dims);
584 2127 }
585 mxArray *value = static_cast<mxArray *> (malloc (sizeof(mxArray))); 2128
586 2129 mxArray *
587 value->rows (nr); 2130 mxCreateCharMatrixFromStrings (int m, const char **str)
588 value->columns (nc); 2131 {
589 value->map (pmap, keys); 2132 return new mxArray (m, str);
590 2133 }
591 return value; 2134
592 } 2135 mxArray *
593 2136 mxCreateDoubleMatrix (int m, int n, mxComplexity flag)
594 // free an array and its contents 2137 {
595 2138 return new mxArray (mxDOUBLE_CLASS, m, n, flag);
2139 }
2140
2141 mxArray *
2142 mxCreateDoubleScalar (double val)
2143 {
2144 return new mxArray (mxDOUBLE_CLASS, val);
2145 }
2146
2147 mxArray *
2148 mxCreateLogicalArray (int ndims, const int *dims)
2149 {
2150 return new mxArray (mxLOGICAL_CLASS, ndims, dims);
2151 }
2152
2153 mxArray *
2154 mxCreateLogicalMatrix (int m, int n)
2155 {
2156 return new mxArray (mxLOGICAL_CLASS, m, n);
2157 }
2158
2159 mxArray *
2160 mxCreateLogicalScalar (int val)
2161 {
2162 return new mxArray (mxLOGICAL_CLASS, val);
2163 }
2164
2165 mxArray *
2166 mxCreateNumericArray (int ndims, const int *dims, mxClassID class_id,
2167 mxComplexity flag)
2168 {
2169 return new mxArray (class_id, ndims, dims, flag);
2170 }
2171
2172 mxArray *
2173 mxCreateNumericMatrix (int m, int n, mxClassID class_id, mxComplexity flag)
2174 {
2175 return new mxArray (class_id, m, n, flag);
2176 }
2177
2178 mxArray *
2179 mxCreateSparse (int m, int n, int nzmax, mxComplexity flag)
2180 {
2181 return new mxArray (mxDOUBLE_CLASS, m, n, nzmax, flag);
2182 }
2183
2184 mxArray *
2185 mxCreateSparseLogicalMatrix (int m, int n, int nzmax)
2186 {
2187 return new mxArray (mxLOGICAL_CLASS, m, n, nzmax);
2188 }
2189
2190 mxArray *
2191 mxCreateString (const char *str)
2192 {
2193 return new mxArray (str);
2194 }
2195
2196 mxArray *
2197 mxCreateStructArray (int ndims, int *dims, int num_keys, const char **keys)
2198 {
2199 return new mxArray (ndims, dims, num_keys, keys);
2200 }
2201
2202 mxArray *
2203 mxCreateStructMatrix (int m, int n, int num_keys, const char **keys)
2204 {
2205 return new mxArray (m, n, num_keys, keys);
2206 }
2207
2208 // Copy constructor.
2209 mxArray *
2210 mxDuplicateArray (const mxArray *ptr)
2211 {
2212 return ptr->clone ();
2213 }
2214
2215 // Destructor.
596 void 2216 void
597 mex::free_value (mxArray *ptr) 2217 mxDestroyArray (mxArray *ptr)
598 { 2218 {
599 free (ptr->real ()); 2219 if (! ptr->is_persistent ())
600 free (ptr->imag ()); 2220 {
601 free (ptr); 2221 if (mex_context)
602 } 2222 mex_context->free_value (ptr);
603 2223 else
604 // mark an array and its contents so it will not be freed on exit 2224 delete ptr;
605 2225 }
2226 }
2227
2228 // Type Predicates.
2229 int
2230 mxIsCell (const mxArray *ptr)
2231 {
2232 return ptr->is_cell ();
2233 }
2234
2235 int
2236 mxIsChar (const mxArray *ptr)
2237 {
2238 return ptr->is_char ();
2239 }
2240
2241 int
2242 mxIsClass (const mxArray *ptr, const char *name)
2243 {
2244 return ptr->is_class (name);
2245 }
2246
2247 int
2248 mxIsComplex (const mxArray *ptr)
2249 {
2250 return ptr->is_complex ();
2251 }
2252
2253 int
2254 mxIsDouble (const mxArray *ptr)
2255 {
2256 return ptr->is_double ();
2257 }
2258
2259 int
2260 mxIsInt16 (const mxArray *ptr)
2261 {
2262 return ptr->is_int16 ();
2263 }
2264
2265 int
2266 mxIsInt32 (const mxArray *ptr)
2267 {
2268 return ptr->is_int32 ();
2269 }
2270
2271 int
2272 mxIsInt64 (const mxArray *ptr)
2273 {
2274 return ptr->is_int64 ();
2275 }
2276
2277 int
2278 mxIsInt8 (const mxArray *ptr)
2279 {
2280 return ptr->is_int8 ();
2281 }
2282
2283 int
2284 mxIsLogical (const mxArray *ptr)
2285 {
2286 return ptr->is_logical ();
2287 }
2288
2289 int
2290 mxIsNumeric (const mxArray *ptr)
2291 {
2292 return ptr->is_numeric ();
2293 }
2294
2295 int
2296 mxIsSingle (const mxArray *ptr)
2297 {
2298 return ptr->is_single ();
2299 }
2300
2301 int
2302 mxIsSparse (const mxArray *ptr)
2303 {
2304 return ptr->is_sparse ();
2305 }
2306
2307 int
2308 mxIsStruct (const mxArray *ptr)
2309 {
2310 return ptr->is_struct ();
2311 }
2312
2313 int
2314 mxIsUint16 (const mxArray *ptr)
2315 {
2316 return ptr->is_uint16 ();
2317 }
2318
2319 int
2320 mxIsUint32 (const mxArray *ptr)
2321 {
2322 return ptr->is_uint32 ();
2323 }
2324
2325 int
2326 mxIsUint64 (const mxArray *ptr)
2327 {
2328 return ptr->is_uint64 ();
2329 }
2330
2331 int
2332 mxIsUint8 (const mxArray *ptr)
2333 {
2334 return ptr->is_uint8 ();
2335 }
2336
2337 // Odd type+size predicate.
2338 int
2339 mxIsLogicalScalar (const mxArray *ptr)
2340 {
2341 return ptr->is_logical_scalar ();
2342 }
2343
2344 // Odd type+size+value predicate.
2345 int
2346 mxIsLogicalScalarTrue (const mxArray *ptr)
2347 {
2348 return ptr->is_logical_scalar_true ();
2349 }
2350
2351 // Size predicate.
2352 int
2353 mxIsEmpty (const mxArray *ptr)
2354 {
2355 return ptr->is_empty ();
2356 }
2357
2358 // Just plain odd thing to ask of a value.
2359 int
2360 mxIsFromGlobalWS (const mxArray */*ptr*/)
2361 {
2362 // FIXME
2363 abort ();
2364 return 0;
2365 }
2366
2367 // Dimension extractors.
2368 int
2369 mxGetM (const mxArray *ptr)
2370 {
2371 return ptr->get_m ();
2372 }
2373
2374 int
2375 mxGetN (const mxArray *ptr)
2376 {
2377 return ptr->get_n ();
2378 }
2379
2380 int *
2381 mxGetDimensions (const mxArray *ptr)
2382 {
2383 return ptr->get_dimensions ();
2384 }
2385
2386 int
2387 mxGetNumberOfDimensions (const mxArray *ptr)
2388 {
2389 return ptr->get_number_of_dimensions ();
2390 }
2391
2392 int
2393 mxGetNumberOfElements (const mxArray *ptr)
2394 {
2395 return ptr->get_number_of_elements ();
2396 }
2397
2398 // Dimension setters.
606 void 2399 void
607 mex::persistent (mxArray *ptr) 2400 mxSetM (mxArray *ptr, int m)
608 { 2401 {
609 persistent (Pix (ptr->real ())); 2402 ptr->set_m (m);
610 persistent (Pix (ptr->imag ())); 2403 }
611 persistent (Pix (ptr)); 2404
612 } 2405 void
613 2406 mxSetN (mxArray *ptr, int n)
614 2407 {
615 // Octave interface to mex files 2408 ptr->set_n (n);
616 2409 }
617 #if 0 2410
618 // Don't bother trapping stop/exit 2411 void
619 // To trap for STOP in fortran code, this needs to be registered with atexit 2412 mxSetDimensions (mxArray *ptr, int *dims, int ndims)
620 static void mex_exit() 2413 {
621 { 2414 ptr->set_dimensions (dims, ndims);
622 if (__mex) 2415 }
623 { 2416
624 error ("%s: program aborted", mexFunctionName ()); 2417 // Data extractors.
625 __mex->abort (); 2418 double *
626 } 2419 mxGetPr (const mxArray *ptr)
627 } 2420 {
628 #endif 2421 return static_cast<double *> (ptr->get_data ());
2422 }
2423
2424 double *
2425 mxGetPi (const mxArray *ptr)
2426 {
2427 return static_cast<double *> (ptr->get_imag_data ());
2428 }
2429
2430 double
2431 mxGetScalar (const mxArray *ptr)
2432 {
2433 double *d = mxGetPr (ptr);
2434 return d[0];
2435 }
2436
2437 mxChar *
2438 mxGetChars (const mxArray *ptr)
2439 {
2440 return static_cast<mxChar *> (ptr->get_data ());
2441 }
2442
2443 mxLogical *
2444 mxGetLogicals (const mxArray *ptr)
2445 {
2446 return static_cast<mxLogical *> (ptr->get_data ());
2447 }
2448
2449 void *
2450 mxGetData (const mxArray *ptr)
2451 {
2452 return ptr->get_data ();
2453 }
2454
2455 void *
2456 mxGetImagData (const mxArray *ptr)
2457 {
2458 return ptr->get_imag_data ();
2459 }
2460
2461 // Data setters.
2462 void
2463 mxSetPr (mxArray *ptr, double *pr)
2464 {
2465 ptr->set_data (pr);
2466 }
2467
2468 void
2469 mxSetPi (mxArray *ptr, double *pi)
2470 {
2471 ptr->set_imag_data (pi);
2472 }
2473
2474 void
2475 mxSetData (mxArray *ptr, void *pr)
2476 {
2477 ptr->set_data (pr);
2478 }
2479
2480 void
2481 mxSetImagData (mxArray *ptr, void *pi)
2482 {
2483 ptr->set_imag_data (pi);
2484 }
2485
2486 // Classes.
2487 mxClassID
2488 mxGetClassID (const mxArray *ptr)
2489 {
2490 return ptr->get_class_id ();
2491 }
2492
2493 const char *
2494 mxGetClassName (const mxArray *ptr)
2495 {
2496 return ptr->get_class_name ();
2497 }
2498
2499 void
2500 mxSetClassName (mxArray *ptr, const char *name)
2501 {
2502 ptr->set_class_name (name);
2503 }
2504
2505 // Cell support.
2506 mxArray *
2507 mxGetCell (const mxArray *ptr, int idx)
2508 {
2509 return ptr->get_cell (idx);
2510 }
2511
2512 void
2513 mxSetCell (mxArray *ptr, int idx, mxArray *val)
2514 {
2515 ptr->set_cell (idx, val);
2516 }
2517
2518 // Sparse support.
2519 int *
2520 mxGetIr (const mxArray *ptr)
2521 {
2522 return ptr->get_ir ();
2523 }
2524
2525 int *
2526 mxGetJc (const mxArray *ptr)
2527 {
2528 return ptr->get_jc ();
2529 }
2530
2531 int
2532 mxGetNzmax (const mxArray *ptr)
2533 {
2534 return ptr->get_nzmax ();
2535 }
2536
2537 void
2538 mxSetIr (mxArray *ptr, int *ir)
2539 {
2540 ptr->set_ir (ir);
2541 }
2542
2543 void
2544 mxSetJc (mxArray *ptr, int *jc)
2545 {
2546 ptr->set_jc (jc);
2547 }
2548
2549 void
2550 mxSetNzmax (mxArray *ptr, int nzmax)
2551 {
2552 ptr->set_nzmax (nzmax);
2553 }
2554
2555 // Structure support.
2556 int
2557 mxAddField (mxArray *ptr, const char *key)
2558 {
2559 return ptr->add_field (key);
2560 }
2561
2562 void
2563 mxRemoveField (mxArray *ptr, int key_num)
2564 {
2565 ptr->remove_field (key_num);
2566 }
2567
2568 mxArray *
2569 mxGetField (const mxArray *ptr, int index, const char *key)
2570 {
2571 int key_num = mxGetFieldNumber (ptr, key);
2572 return mxGetFieldByNumber (ptr, index, key_num);
2573 }
2574
2575 mxArray *
2576 mxGetFieldByNumber (const mxArray *ptr, int index, int key_num)
2577 {
2578 return ptr->get_field_by_number (index, key_num);
2579 }
2580
2581 void
2582 mxSetField (mxArray *ptr, int index, const char *key, mxArray *val)
2583 {
2584 int key_num = mxGetFieldNumber (ptr, key);
2585 mxSetFieldByNumber (ptr, index, key_num, val);
2586 }
2587
2588 void
2589 mxSetFieldByNumber (mxArray *ptr, int index, int key_num, mxArray *val)
2590 {
2591 ptr->set_field_by_number (index, key_num, val);
2592 }
2593
2594 int
2595 mxGetNumberOfFields (const mxArray *ptr)
2596 {
2597 return ptr->get_number_of_fields ();
2598 }
2599
2600 const char *
2601 mxGetFieldNameByNumber (const mxArray *ptr, int key_num)
2602 {
2603 return ptr->get_field_name_by_number (key_num);
2604 }
2605
2606 int
2607 mxGetFieldNumber (const mxArray *ptr, const char *key)
2608 {
2609 return ptr->get_field_number (key);
2610 }
2611
2612 int
2613 mxGetString (const mxArray *ptr, char *buf, int buflen)
2614 {
2615 return ptr->get_string (buf, buflen);
2616 }
2617
2618 char *
2619 mxArrayToString (const mxArray *ptr)
2620 {
2621 return ptr->array_to_string ();
2622 }
2623
2624 int
2625 mxCalcSingleSubscript (const mxArray *ptr, int nsubs, int *subs)
2626 {
2627 return ptr->calc_single_subscript (nsubs, subs);
2628 }
2629
2630 int
2631 mxGetElementSize (const mxArray *ptr)
2632 {
2633 return ptr->get_element_size ();
2634 }
2635
2636 // ------------------------------------------------------------------
629 2637
630 typedef void (*cmex_fptr) (int nlhs, mxArray **plhs, int nrhs, mxArray **prhs); 2638 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); 2639 typedef F77_RET_T (*fmex_fptr) (int& nlhs, mxArray **plhs, int& nrhs, mxArray **prhs);
632 2640
633 enum callstyle { use_fortran, use_C }; 2641 enum callstyle { use_fortran, use_C };
640 // FIXME -- should really push "mex_exit" onto the octave 2648 // FIXME -- should really push "mex_exit" onto the octave
641 // atexit stack before we start and pop it when we are through, but 2649 // 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 2650 // 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. 2651 // would have to be declared as DEFUN(mex_exit,,,"") of course.
644 static bool unregistered = true; 2652 static bool unregistered = true;
2653
645 if (unregistered) 2654 if (unregistered)
646 { 2655 {
647 atexit (mex_exit); 2656 atexit (mex_exit);
648 unregistered = false; 2657 unregistered = false;
649 } 2658 }
650 #endif 2659 #endif
651 2660
652 // Use nargout+1 since even for zero specified args, still want to 2661 // Use at least 1 for nargout since even for zero specified args,
653 // be able to return an ans. 2662 // still want to be able to return an ans.
654 2663
655 int nargin = args.length (); 2664 int nargin = args.length ();
656 OCTAVE_LOCAL_BUFFER(mxArray*, argin, nargin); 2665 OCTAVE_LOCAL_BUFFER (mxArray *, argin, nargin);
657 for (int i = 0; i < nargin; i++) 2666 for (int i = 0; i < nargin; i++)
658 argin[i] = 0; 2667 argin[i] = 0;
659 2668
660 int nout = nargout == 0 ? 1 : nargout; 2669 int nout = nargout == 0 ? 1 : nargout;
661 OCTAVE_LOCAL_BUFFER(mxArray*, argout, nout); 2670 OCTAVE_LOCAL_BUFFER (mxArray *, argout, nout);
662 for (int i = 0; i < nout; i++) 2671 for (int i = 0; i < nout; i++)
663 argout[i] = 0; 2672 argout[i] = 0;
664 2673
665 mex context; 2674 mex context;
666 unwind_protect::add (mex::cleanup, Pix (&context)); 2675
2676 unwind_protect::add (mex::cleanup, static_cast<void *> (&context));
667 2677
668 for (int i = 0; i < nargin; i++) 2678 for (int i = 0; i < nargin; i++)
669 argin[i] = context.make_value (args(i)); 2679 argin[i] = context.make_value (args(i));
670 2680
671 // Save old mex pointer. 2681 // Save old mex pointer.
672 unwind_protect_ptr (__mex); 2682 unwind_protect_ptr (mex_context);
673 2683
674 if (setjmp (context.jump) == 0) 2684 if (setjmp (context.jump) == 0)
675 { 2685 {
676 __mex = &context; 2686 mex_context = &context;
677 2687
678 if (cs == use_fortran) 2688 if (cs == use_fortran)
679 { 2689 {
680 fmex_fptr fcn = FCN_PTR_CAST (fmex_fptr, f); 2690 fmex_fptr fcn = FCN_PTR_CAST (fmex_fptr, f);
681 2691
700 octave_value_list retval; 2710 octave_value_list retval;
701 2711
702 if (! error_state) 2712 if (! error_state)
703 { 2713 {
704 if (nargout == 0 && argout[0]) 2714 if (nargout == 0 && argout[0])
705 retval(0) = argout[0]->as_octave_value ();
706 else
707 { 2715 {
708 retval.resize (nargout); 2716 // We have something for ans.
709 2717 nargout = 1;
710 for (int i = 0; i < nargout; i++) 2718 }
711 if (argout[i]) 2719
2720 retval.resize (nargout);
2721
2722 for (int i = 0; i < nargout; i++)
2723 {
2724 if (argout[i])
2725 {
712 retval(i) = argout[i]->as_octave_value (); 2726 retval(i) = argout[i]->as_octave_value ();
2727
2728 // mxDestroyArray (argout[i]);
2729 }
713 } 2730 }
714 } 2731 }
715 2732
716 // Clean up mex resources. 2733 // Clean up mex resources.
717 unwind_protect::run (); 2734 unwind_protect::run ();
731 return call_mex (use_C, f, args, nargout); 2748 return call_mex (use_C, f, args, nargout);
732 } 2749 }
733 2750
734 // C interface to mex functions: 2751 // C interface to mex functions:
735 2752
736 extern "C" {
737
738 const char * 2753 const char *
739 mexFunctionName (void) 2754 mexFunctionName (void)
740 { 2755 {
741 static char *retval = 0; 2756 return mex_context ? mex_context->function_name () : "unknown";
742 2757 }
743 delete [] retval; 2758
744 2759 int
745 octave_function *fcn = octave_call_stack::current (); 2760 mexCallMATLAB (int nargout, mxArray *argout[], int nargin, mxArray *argin[],
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)
762 error ("%s: %s", mexFunctionName (), s);
763 else
764 // Just set the error state; don't print msg.
765 error ("");
766
767 __mex->abort();
768 }
769
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 }
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; }
807 int mxIsNaN (const double v) { return lo_ieee_isnan (v) != 0; }
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) 2761 const char *fname)
832 { 2762 {
833 octave_value_list args; 2763 octave_value_list args;
834 2764
835 // FIXME -- do we need unwind protect to clean up args? Off hand, I 2765 // FIXME -- do we need unwind protect to clean up args? Off hand, I
843 for (int i = 0; i < nargin; i++) 2773 for (int i = 0; i < nargin; i++)
844 args(i) = argin[i]->as_octave_value (); 2774 args(i) = argin[i]->as_octave_value ();
845 2775
846 octave_value_list retval = feval (fname, args, nargout); 2776 octave_value_list retval = feval (fname, args, nargout);
847 2777
848 if (error_state && __mex->trap_feval_error == 0) 2778 if (error_state && mex_context->trap_feval_error == 0)
849 { 2779 {
850 // FIXME -- is this the correct way to clean up? abort() is 2780 // FIXME -- is this the correct way to clean up? abort() is
851 // going to trigger a long jump, so the normal class destructors 2781 // going to trigger a long jump, so the normal class destructors
852 // will not be called. Hopefully this will reduce things to a 2782 // will not be called. Hopefully this will reduce things to a
853 // tiny leak. Maybe create a new octave memory tracer type 2783 // tiny leak. Maybe create a new octave memory tracer type
854 // which prints a friendly message every time it is 2784 // which prints a friendly message every time it is
855 // created/copied/deleted to check this. 2785 // created/copied/deleted to check this.
856 2786
857 args.resize (0); 2787 args.resize (0);
858 retval.resize (0); 2788 retval.resize (0);
859 __mex->abort (); 2789 mex_context->abort ();
860 } 2790 }
861 2791
862 int num_to_copy = retval.length (); 2792 int num_to_copy = retval.length ();
863 2793
864 if (nargout < retval.length ()) 2794 if (nargout < retval.length ())
868 { 2798 {
869 // FIXME -- it would be nice to avoid copying the value here, 2799 // 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 2800 // but there is no way to steal memory from a matrix, never mind
871 // that matrix memory is allocated by new[] and mxArray memory 2801 // that matrix memory is allocated by new[] and mxArray memory
872 // is allocated by malloc(). 2802 // is allocated by malloc().
873 argout[i] = __mex->make_value (retval (i)); 2803 argout[i] = mex_context->make_value (retval (i));
874 } 2804 }
875 2805
876 while (num_to_copy < nargout) 2806 while (num_to_copy < nargout)
877 argout[num_to_copy++] = 0; 2807 argout[num_to_copy++] = 0;
878 2808
883 } 2813 }
884 else 2814 else
885 return 0; 2815 return 0;
886 } 2816 }
887 2817
888 void mexSetTrapFlag (int flag) { __mex->trap_feval_error = flag; } 2818 void
889 2819 mexSetTrapFlag (int flag)
890 Pix mxMalloc (int n) { return __mex->malloc(n); } 2820 {
891 Pix mxCalloc (int n, int size) { return __mex->calloc (n, size); } 2821 if (mex_context)
892 Pix mxRealloc (Pix ptr, int n) { return __mex->realloc (ptr, n); } 2822 mex_context->trap_feval_error = flag;
893 void mxFree (Pix ptr) { __mex->free (ptr); } 2823 }
894 void mexMakeMemoryPersistent (Pix ptr) { __mex->persistent (ptr); } 2824
2825 int
2826 mexEvalString (const char *s)
2827 {
2828 int retval = 0;
2829
2830 int parse_status;
2831
2832 octave_value_list ret;
2833
2834 ret = eval_string (s, false, parse_status, 0);
2835
2836 if (parse_status || error_state)
2837 {
2838 error_state = 0;
2839
2840 retval = 1;
2841 }
2842
2843 return retval;
2844 }
2845
2846 void
2847 mexErrMsgTxt (const char *s)
2848 {
2849 if (s && strlen (s) > 0)
2850 error ("%s: %s", mexFunctionName (), s);
2851 else
2852 // Just set the error state; don't print msg.
2853 error ("");
2854
2855 mex_context->abort ();
2856 }
2857
2858 void
2859 mexErrMsgIdAndTxt (const char *id, const char *s)
2860 {
2861 if (s && strlen (s) > 0)
2862 error_with_id (id, "%s: %s", mexFunctionName (), s);
2863 else
2864 // Just set the error state; don't print msg.
2865 error ("");
2866
2867 mex_context->abort ();
2868 }
2869
2870 void
2871 mexWarnMsgTxt (const char *s)
2872 {
2873 warning ("%s", s);
2874 }
2875
2876 void
2877 mexWarnMsgIdAndTxt (const char *id, const char *s)
2878 {
2879 warning_with_id (id, "%s", s);
2880 }
2881
2882 void
2883 mexPrintf (const char *fmt, ...)
2884 {
2885 va_list args;
2886 va_start (args, fmt);
2887 octave_vformat (octave_stdout, fmt, args);
2888 va_end (args);
2889 }
895 2890
896 mxArray * 2891 mxArray *
897 mxCreateDoubleMatrix (int nr, int nc, int iscomplex) 2892 mexGetVariable (const char *space, const char *name)
898 { 2893 {
899 return __mex->make_value(nr, nc, iscomplex); 2894 mxArray *retval = 0;
900 } 2895
901 2896 // FIXME -- this should be in variable.cc, but the correct
902 mxArray * 2897 // functionality is not exported. Particularly, get_global_value()
903 mxCreateDoubleScalar (double val) 2898 // generates an error if the symbol is undefined.
904 { 2899
905 mxArray *ptr = mxCreateDoubleMatrix (1, 1, 0); 2900 symbol_record *sr = 0;
906 *mxGetPr (ptr) = val; 2901
907 return ptr; 2902 if (! strcmp (space, "global"))
908 } 2903 sr = global_sym_tab->lookup (name);
909 2904 else if (! strcmp (space, "caller"))
910 mxArray * 2905 sr = curr_sym_tab->lookup (name);
911 mxCreateLogicalScalar (int val) 2906 else if (! strcmp (space, "base"))
912 { 2907 sr = top_level_sym_tab->lookup (name);
913 mxArray *ptr = mxCreateDoubleMatrix (1, 1, 0); 2908 else
914 *mxGetPr (ptr) = val; 2909 mexErrMsgTxt ("mexGetVariable: symbol table does not exist");
915 return ptr; 2910
916 } 2911 if (sr)
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 { 2912 {
969 int nr = ptr->rows (); 2913 octave_value sr_def = sr->def ();
970 int nc = ptr->columns (); 2914
971 int n = nr*nc < buflen ? nr*nc : buflen; 2915 if (sr_def.is_defined ())
972 const double *pr = ptr->real (); 2916 {
973 for (int i = 0; i < n; i++) 2917 retval = mex_context->make_value (sr_def);
974 buf[i] = NINT (pr[i]); 2918
975 if (n < buflen) 2919 retval->set_name (name);
976 buf[n] = '\0'; 2920 }
977 return n >= buflen;
978 } 2921 }
979 else 2922
980 return 1; 2923 return retval;
981 } 2924 }
982 2925
983 char * 2926 const mxArray *
984 mxArrayToString (const mxArray *ptr) 2927 mexGetVariablePtr (const char *space, const char *name)
985 { 2928 {
986 int nr = ptr->rows (); 2929 return mexGetVariable (space, name);
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 } 2930 }
1045 2931
1046 int 2932 int
1047 mexPutVariable (const char *space, const char *name, mxArray *ptr) 2933 mexPutVariable (const char *space, const char *name, mxArray *ptr)
1048 { 2934 {
1051 2937
1052 if (! name) 2938 if (! name)
1053 return 1; 2939 return 1;
1054 2940
1055 if (name[0] == '\0') 2941 if (name[0] == '\0')
1056 name = ptr->name (); 2942 name = ptr->get_name ();
1057 2943
1058 if (! name || name[0] == '\0') 2944 if (! name || name[0] == '\0')
1059 return 1; 2945 return 1;
1060 2946
1061 if (! strcmp (space, "global")) 2947 if (! strcmp (space, "global"))
1062 set_global_value (name, ptr->as_octave_value ()); 2948 set_global_value (name, ptr->as_octave_value ());
1063 else if (! strcmp (space, "caller")) 2949 else
1064 { 2950 {
1065 // FIXME -- this belongs in variables.cc. 2951 // FIXME -- this belongs in variables.cc.
1066 symbol_record *sr = curr_sym_tab->lookup (name, true); 2952
2953 symbol_record *sr = 0;
2954
2955 if (! strcmp (space, "caller"))
2956 sr = curr_sym_tab->lookup (name, true);
2957 else if (! strcmp (space, "base"))
2958 sr = top_level_sym_tab->lookup (name, true);
2959 else
2960 mexErrMsgTxt ("mexPutVariable: symbol table does not exist");
2961
1067 if (sr) 2962 if (sr)
1068 sr->define (ptr->as_octave_value ()); 2963 sr->define (ptr->as_octave_value ());
1069 else 2964 else
1070 panic_impossible (); 2965 panic_impossible ();
1071 } 2966 }
1072 else if (! strcmp (space, "base")) 2967
1073 mexErrMsgTxt ("mexPutVariable: 'base' symbol table not implemented");
1074 else
1075 mexErrMsgTxt ("mexPutVariable: symbol table does not exist");
1076 return 0; 2968 return 0;
1077 } 2969 }
1078 2970
1079 mxArray * 2971 void
1080 mexGetVariable (const char *space, const char *name) 2972 mexMakeArrayPersistent (mxArray *ptr)
1081 { 2973 {
1082 mxArray *retval = 0; 2974 if (mex_context)
1083 2975 mex_context->persistent (ptr);
1084 // FIXME -- this should be in variable.cc, but the correct 2976 }
1085 // functionality is not exported. Particularly, get_global_value() 2977
1086 // generates an error if the symbol is undefined. 2978 void
1087 2979 mexMakeMemoryPersistent (void *ptr)
1088 symbol_record *sr = 0; 2980 {
1089 2981 if (mex_context)
1090 if (! strcmp (space, "global")) 2982 mex_context->persistent (ptr);
1091 sr = global_sym_tab->lookup (name); 2983 }
1092 else if (! strcmp (space, "caller")) 2984
1093 sr = curr_sym_tab->lookup (name); 2985 int
1094 else if (! strcmp (space, "base")) 2986 mexAtExit (void (*/*f*/) (void))
1095 mexErrMsgTxt ("mexGetVariable: 'base' symbol table not implemented"); 2987 {
1096 else 2988 // FIXME
1097 mexErrMsgTxt ("mexGetVariable: symbol table does not exist"); 2989 error ("mexAtExit: not implemented");
1098 2990 return 0;
1099 if (sr) 2991 }
2992
2993 const mxArray *
2994 mexGet (double /*handle*/, const char */*property*/)
2995 {
2996 // FIXME
2997 error ("mexGet: not implemented");
2998 return 0;
2999 }
3000
3001 int
3002 mexIsGlobal (const mxArray *ptr)
3003 {
3004 return mxIsFromGlobalWS (ptr);
3005 }
3006
3007 int
3008 mexIsLocked (void)
3009 {
3010 int retval = 0;
3011
3012 if (mex_context)
1100 { 3013 {
1101 octave_value sr_def = sr->def (); 3014 const char *fname = mexFunctionName ();
1102 3015
1103 if (sr_def.is_defined ()) 3016 retval = mislocked (fname);
3017 }
3018
3019 return retval;
3020 }
3021
3022 std::map<std::string,int> mex_lock_count;
3023
3024 void
3025 mexLock (void)
3026 {
3027 if (mex_context)
3028 {
3029 const char *fname = mexFunctionName ();
3030
3031 if (mex_lock_count.find (fname) == mex_lock_count.end ())
3032 mex_lock_count[fname] = 1;
3033 else
3034 mex_lock_count[fname]++;
3035
3036 mlock (fname);
3037 }
3038 }
3039
3040 int
3041 mexSet (double /*handle*/, const char */*property*/, mxArray */*val*/)
3042 {
3043 // FIXME
3044 error ("mexSet: not implemented");
3045 return 0;
3046 }
3047
3048 void
3049 mexUnlock (void)
3050 {
3051 if (mex_context)
3052 {
3053 const char *fname = mexFunctionName ();
3054
3055 if (mex_lock_count.find (fname) == mex_lock_count.end ())
3056 warning ("mexUnlock: funtion `%s' is not locked", fname);
3057 else
1104 { 3058 {
1105 retval = __mex->make_value (sr_def); 3059 int count = --mex_lock_count[fname];
1106 retval->name (name); 3060
3061 if (count == 0)
3062 {
3063 munlock (fname);
3064
3065 mex_lock_count.erase (fname);
3066 }
1107 } 3067 }
1108 } 3068 }
1109 3069 }
1110 return retval;
1111 }
1112
1113 const mxArray *
1114 mexGetVariablePtr (const char *space, const char *name)
1115 {
1116 return mexGetVariable (space, name);
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 }
1157
1158 mxArray *
1159 mxGetFieldByNumber (const mxArray *ptr, int index, int key_num)
1160 {
1161 return ptr->field (key_num, index);
1162 }
1163
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
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
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 */