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