Mercurial > hg > octave-nkf

comparison src/interp-core/mex.cc @ 15096:909a2797935b

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