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
ls-mat5.cc
Go to the documentation of this file.
1 /*
2 
3 Copyright (C) 1996-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 // Author: James R. Van Zandt <jrv@vanzandt.mv.com>
24 
25 #ifdef HAVE_CONFIG_H
26 #include <config.h>
27 #endif
28 
29 #include <cfloat>
30 #include <cstring>
31 #include <cctype>
32 
33 #include <fstream>
34 #include <iomanip>
35 #include <iostream>
36 #include <sstream>
37 #include <string>
38 #include <vector>
39 
40 #include "byte-swap.h"
41 #include "data-conv.h"
42 #include "file-ops.h"
43 #include "glob-match.h"
44 #include "lo-mappers.h"
45 #include "mach-info.h"
46 #include "oct-env.h"
47 #include "oct-time.h"
48 #include "quit.h"
49 #include "str-vec.h"
50 #include "file-stat.h"
51 #include "oct-locbuf.h"
52 
53 #include "Cell.h"
54 #include "defun.h"
55 #include "error.h"
56 #include "gripes.h"
57 #include "load-save.h"
58 #include "load-path.h"
59 #include "oct-obj.h"
60 #include "oct-map.h"
61 #include "ov-cell.h"
62 #include "ov-class.h"
63 #include "ov-fcn-inline.h"
64 #include "pager.h"
65 #include "pt-exp.h"
66 #include "sysdep.h"
67 #include "toplev.h"
68 #include "unwind-prot.h"
69 #include "utils.h"
70 #include "variables.h"
71 #include "version.h"
72 #include "dMatrix.h"
73 
74 #include "ls-utils.h"
75 #include "ls-mat5.h"
76 
77 #include "parse.h"
78 #include "defaults.h"
79 
80 #ifdef HAVE_ZLIB
81 #include <zlib.h>
82 #endif
83 
84 #define READ_PAD(is_small_data_element, l) ((is_small_data_element) ? 4 : (((l)+7)/8)*8)
85 #define PAD(l) (((l) > 0 && (l) <= 4) ? 4 : (((l)+7)/8)*8)
86 #define INT8(l) ((l) == miINT8 || (l) == miUINT8 || (l) == miUTF8)
87 
88 
89 // The subsystem data block
91 
92 // FIXME: the following enum values should be the same as the
93 // mxClassID values in mexproto.h, but it seems they have also changed
94 // over time. What is the correct way to handle this and maintain
95 // backward compatibility with old MAT files? For now, use
96 // "MAT_FILE_" instead of "mx" as the prefix for these names to avoid
97 // conflict with the mxClassID enum in mexproto.h.
98 
100 {
101  MAT_FILE_CELL_CLASS=1, // cell array
102  MAT_FILE_STRUCT_CLASS, // structure
104  MAT_FILE_CHAR_CLASS, // character array
105  MAT_FILE_SPARSE_CLASS, // sparse array
106  MAT_FILE_DOUBLE_CLASS, // double precision array
107  MAT_FILE_SINGLE_CLASS, // single precision floating point
108  MAT_FILE_INT8_CLASS, // 8 bit signed integer
109  MAT_FILE_UINT8_CLASS, // 8 bit unsigned integer
110  MAT_FILE_INT16_CLASS, // 16 bit signed integer
111  MAT_FILE_UINT16_CLASS, // 16 bit unsigned integer
112  MAT_FILE_INT32_CLASS, // 32 bit signed integer
113  MAT_FILE_UINT32_CLASS, // 32 bit unsigned integer
114  MAT_FILE_INT64_CLASS, // 64 bit signed integer
115  MAT_FILE_UINT64_CLASS, // 64 bit unsigned integer
116  MAT_FILE_FUNCTION_CLASS, // Function handle
117  MAT_FILE_WORKSPACE_CLASS // Workspace (undocumented)
118 };
119 
120 // Read COUNT elements of data from IS in the format specified by TYPE,
121 // placing the result in DATA. If SWAP is TRUE, swap the bytes of
122 // each element before copying to DATA. FLT_FMT specifies the format
123 // of the data if we are reading floating point numbers.
124 
125 static void
126 read_mat5_binary_data (std::istream& is, double *data,
127  octave_idx_type count, bool swap, mat5_data_type type,
129 {
130 
131  switch (type)
132  {
133  case miINT8:
134  read_doubles (is, data, LS_CHAR, count, swap, flt_fmt);
135  break;
136 
137  case miUTF8:
138  case miUINT8:
139  read_doubles (is, data, LS_U_CHAR, count, swap, flt_fmt);
140  break;
141 
142  case miINT16:
143  read_doubles (is, data, LS_SHORT, count, swap, flt_fmt);
144  break;
145 
146  case miUTF16:
147  case miUINT16:
148  read_doubles (is, data, LS_U_SHORT, count, swap, flt_fmt);
149  break;
150 
151  case miINT32:
152  read_doubles (is, data, LS_INT, count, swap, flt_fmt);
153  break;
154 
155  case miUTF32:
156  case miUINT32:
157  read_doubles (is, data, LS_U_INT, count, swap, flt_fmt);
158  break;
159 
160  case miSINGLE:
161  read_doubles (is, data, LS_FLOAT, count, swap, flt_fmt);
162  break;
163 
164  case miRESERVE1:
165  break;
166 
167  case miDOUBLE:
168  read_doubles (is, data, LS_DOUBLE, count, swap, flt_fmt);
169  break;
170 
171  case miRESERVE2:
172  case miRESERVE3:
173  break;
174 
175  // FIXME: how are the 64-bit cases supposed to work here?
176  case miINT64:
177  read_doubles (is, data, LS_LONG, count, swap, flt_fmt);
178  break;
179 
180  case miUINT64:
181  read_doubles (is, data, LS_U_LONG, count, swap, flt_fmt);
182  break;
183 
184  case miMATRIX:
185  default:
186  break;
187  }
188 }
189 
190 static void
191 read_mat5_binary_data (std::istream& is, float *data,
192  octave_idx_type count, bool swap, mat5_data_type type,
194 {
195 
196  switch (type)
197  {
198  case miINT8:
199  read_floats (is, data, LS_CHAR, count, swap, flt_fmt);
200  break;
201 
202  case miUTF8:
203  case miUINT8:
204  read_floats (is, data, LS_U_CHAR, count, swap, flt_fmt);
205  break;
206 
207  case miINT16:
208  read_floats (is, data, LS_SHORT, count, swap, flt_fmt);
209  break;
210 
211  case miUTF16:
212  case miUINT16:
213  read_floats (is, data, LS_U_SHORT, count, swap, flt_fmt);
214  break;
215 
216  case miINT32:
217  read_floats (is, data, LS_INT, count, swap, flt_fmt);
218  break;
219 
220  case miUTF32:
221  case miUINT32:
222  read_floats (is, data, LS_U_INT, count, swap, flt_fmt);
223  break;
224 
225  case miSINGLE:
226  read_floats (is, data, LS_FLOAT, count, swap, flt_fmt);
227  break;
228 
229  case miRESERVE1:
230  break;
231 
232  case miDOUBLE:
233  read_floats (is, data, LS_DOUBLE, count, swap, flt_fmt);
234  break;
235 
236  case miRESERVE2:
237  case miRESERVE3:
238  break;
239 
240  // FIXME: how are the 64-bit cases supposed to work here?
241  case miINT64:
242  read_floats (is, data, LS_LONG, count, swap, flt_fmt);
243  break;
244 
245  case miUINT64:
246  read_floats (is, data, LS_U_LONG, count, swap, flt_fmt);
247  break;
248 
249  case miMATRIX:
250  default:
251  break;
252  }
253 }
254 
255 template <class T>
256 void
257 read_mat5_integer_data (std::istream& is, T *m, octave_idx_type count,
258  bool swap, mat5_data_type type)
259 {
260 
261 #define READ_INTEGER_DATA(TYPE, swap, data, size, len, stream) \
262  do \
263  { \
264  if (len > 0) \
265  { \
266  OCTAVE_LOCAL_BUFFER (TYPE, ptr, len); \
267  stream.read (reinterpret_cast<char *> (ptr), size * len); \
268  if (swap) \
269  swap_bytes< size > (ptr, len); \
270  for (octave_idx_type i = 0; i < len; i++) \
271  data[i] = ptr[i]; \
272  } \
273  } \
274  while (0)
275 
276  switch (type)
277  {
278  case miINT8:
279  READ_INTEGER_DATA (int8_t, swap, m, 1, count, is);
280  break;
281 
282  case miUINT8:
283  READ_INTEGER_DATA (uint8_t, swap, m, 1, count, is);
284  break;
285 
286  case miINT16:
287  READ_INTEGER_DATA (int16_t, swap, m, 2, count, is);
288  break;
289 
290  case miUINT16:
291  READ_INTEGER_DATA (uint16_t, swap, m, 2, count, is);
292  break;
293 
294  case miINT32:
295  READ_INTEGER_DATA (int32_t, swap, m, 4, count, is);
296  break;
297 
298  case miUINT32:
299  READ_INTEGER_DATA (uint32_t, swap, m, 4, count, is);
300  break;
301 
302  case miSINGLE:
303  case miRESERVE1:
304  case miDOUBLE:
305  case miRESERVE2:
306  case miRESERVE3:
307  break;
308 
309  case miINT64:
310  READ_INTEGER_DATA (int64_t, swap, m, 8, count, is);
311  break;
312 
313  case miUINT64:
314  READ_INTEGER_DATA (uint64_t, swap, m, 8, count, is);
315  break;
316 
317  case miMATRIX:
318  default:
319  break;
320  }
321 
322 #undef READ_INTEGER_DATA
323 
324 }
325 
326 template void
327 read_mat5_integer_data (std::istream& is, octave_int8 *m,
328  octave_idx_type count, bool swap,
330 
331 template void
332 read_mat5_integer_data (std::istream& is, octave_int16 *m,
333  octave_idx_type count, bool swap,
335 
336 template void
337 read_mat5_integer_data (std::istream& is, octave_int32 *m,
338  octave_idx_type count, bool swap,
340 
341 template void
342 read_mat5_integer_data (std::istream& is, octave_int64 *m,
343  octave_idx_type count, bool swap,
345 
346 template void
347 read_mat5_integer_data (std::istream& is, octave_uint8 *m,
348  octave_idx_type count, bool swap,
350 
351 template void
352 read_mat5_integer_data (std::istream& is, octave_uint16 *m,
353  octave_idx_type count, bool swap,
355 
356 template void
357 read_mat5_integer_data (std::istream& is, octave_uint32 *m,
358  octave_idx_type count, bool swap,
360 
361 template void
362 read_mat5_integer_data (std::istream& is, octave_uint64 *m,
363  octave_idx_type count, bool swap,
365 
366 template void
367 read_mat5_integer_data (std::istream& is, int *m,
368  octave_idx_type count, bool swap,
370 
371 #define OCTAVE_MAT5_INTEGER_READ(TYP) \
372  { \
373  TYP re (dims); \
374  \
375  std::streampos tmp_pos; \
376  \
377  if (read_mat5_tag (is, swap, type, len, is_small_data_element)) \
378  { \
379  error ("load: reading matrix data for '%s'", retval.c_str ()); \
380  goto data_read_error; \
381  } \
382  \
383  octave_idx_type n = re.numel (); \
384  tmp_pos = is.tellg (); \
385  read_mat5_integer_data (is, re.fortran_vec (), n, swap, \
386  static_cast<enum mat5_data_type> (type)); \
387  \
388  if (! is || error_state) \
389  { \
390  error ("load: reading matrix data for '%s'", retval.c_str ()); \
391  goto data_read_error; \
392  } \
393  \
394  is.seekg (tmp_pos + static_cast<std::streamoff>\
395  (READ_PAD (is_small_data_element, len))); \
396  \
397  if (imag) \
398  { \
399  /* We don't handle imag integer types, convert to an array */ \
400  NDArray im (dims); \
401  \
402  if (read_mat5_tag (is, swap, type, len, is_small_data_element)) \
403  { \
404  error ("load: reading matrix data for '%s'", \
405  retval.c_str ()); \
406  goto data_read_error; \
407  } \
408  \
409  n = im.numel (); \
410  read_mat5_binary_data (is, im.fortran_vec (), n, swap, \
411  static_cast<enum mat5_data_type> (type), flt_fmt); \
412  \
413  if (! is || error_state) \
414  { \
415  error ("load: reading imaginary matrix data for '%s'", \
416  retval.c_str ()); \
417  goto data_read_error; \
418  } \
419  \
420  ComplexNDArray ctmp (dims); \
421  \
422  for (octave_idx_type i = 0; i < n; i++) \
423  ctmp(i) = Complex (re(i).double_value (), im(i)); \
424  \
425  tc = ctmp; \
426  } \
427  else \
428  tc = re; \
429  }
430 
431 // Read one element tag from stream IS,
432 // place the type code in TYPE, the byte count in BYTES and true (false) to
433 // IS_SMALL_DATA_ELEMENT if the tag is 4 (8) bytes long.
434 // return nonzero on error
435 static int
436 read_mat5_tag (std::istream& is, bool swap, int32_t& type, int32_t& bytes,
437  bool& is_small_data_element)
438 {
439  unsigned int upper;
440  int32_t temp;
441 
442  if (! is.read (reinterpret_cast<char *> (&temp), 4 ))
443  goto data_read_error;
444 
445  if (swap)
446  swap_bytes<4> (&temp);
447 
448  upper = (temp >> 16) & 0xffff;
449  type = temp & 0xffff;
450 
451  if (upper)
452  {
453  // "compressed" format
454  bytes = upper;
455  is_small_data_element = true;
456  }
457  else
458  {
459  if (! is.read (reinterpret_cast<char *> (&temp), 4 ))
460  goto data_read_error;
461  if (swap)
462  swap_bytes<4> (&temp);
463  bytes = temp;
464  is_small_data_element = false;
465  }
466 
467  return 0;
468 
469 data_read_error:
470  return 1;
471 }
472 
473 static void
474 read_int (std::istream& is, bool swap, int32_t& val)
475 {
476  is.read (reinterpret_cast<char *> (&val), 4);
477 
478  if (swap)
479  swap_bytes<4> (&val);
480 }
481 
482 // Extract one data element (scalar, matrix, string, etc.) from stream
483 // IS and place it in TC, returning the name of the variable.
484 //
485 // The data is expected to be in Matlab's "Version 5" .mat format,
486 // though not all the features of that format are supported.
487 //
488 // FILENAME is used for error messages.
489 
490 std::string
491 read_mat5_binary_element (std::istream& is, const std::string& filename,
492  bool swap, bool& global, octave_value& tc)
493 {
494  std::string retval;
495 
496  global = false;
497 
498  // NOTE: these are initialized here instead of closer to where they
499  // are first used to avoid errors from gcc about goto crossing
500  // initialization of variable.
501 
502  bool imag;
503  bool isclass = false;
504  bool logicalvar;
505  dim_vector dims;
506  enum arrayclasstype arrayclass;
507  int16_t number = *(reinterpret_cast<const int16_t *>("\x00\x01"));
508  octave_idx_type nzmax;
509  std::string classname;
510 
511  // MAT files always use IEEE floating point
513  if ((number == 1) ^ swap)
515  else
517 
518  // element type, length and small data element flag
519  int32_t type = 0;
520  int32_t element_length;
521  bool is_small_data_element;
522  if (read_mat5_tag (is, swap, type, element_length, is_small_data_element))
523  return retval; // EOF
524 
525  if (type == miCOMPRESSED)
526  {
527 #ifdef HAVE_ZLIB
528  // If C++ allowed us direct access to the file descriptor of an
529  // ifstream in a uniform way, the code below could be vastly
530  // simplified, and additional copies of the data in memory
531  // wouldn't be needed.
532 
533  OCTAVE_LOCAL_BUFFER (char, inbuf, element_length);
534  is.read (inbuf, element_length);
535 
536  // We uncompress the first 8 bytes of the header to get the buffer length
537  // This will fail with an error Z_MEM_ERROR
538  uLongf destLen = 8;
539  OCTAVE_LOCAL_BUFFER (unsigned int, tmp, 2);
540  if (uncompress (reinterpret_cast<Bytef *> (tmp), &destLen,
541  reinterpret_cast<Bytef *> (inbuf), element_length)
542  != Z_MEM_ERROR)
543  {
544  // Why should I have to initialize outbuf as I'll just overwrite!!
545  if (swap)
546  swap_bytes<4> (tmp, 2);
547 
548  destLen = tmp[1] + 8;
549  std::string outbuf (destLen, ' ');
550 
551  // FIXME: find a way to avoid casting away const here!
552 
553  int err = uncompress (reinterpret_cast<Bytef *>
554  (const_cast<char *> (outbuf.c_str ())),
555  &destLen, reinterpret_cast<Bytef *> (inbuf),
556  element_length);
557 
558  if (err != Z_OK)
559  {
560  std::string msg;
561  switch (err)
562  {
563  case Z_STREAM_END:
564  msg = "stream end";
565  break;
566 
567  case Z_NEED_DICT:
568  msg = "need dict";
569  break;
570 
571  case Z_ERRNO:
572  msg = "errno case";
573  break;
574 
575  case Z_STREAM_ERROR:
576  msg = "stream error";
577  break;
578 
579  case Z_DATA_ERROR:
580  msg = "data error";
581  break;
582 
583  case Z_MEM_ERROR:
584  msg = "mem error";
585  break;
586 
587  case Z_BUF_ERROR:
588  msg = "buf error";
589  break;
590 
591  case Z_VERSION_ERROR:
592  msg = "version error";
593  break;
594  }
595 
596  error ("load: error uncompressing data element (%s from zlib)",
597  msg.c_str ());
598  }
599  else
600  {
601  std::istringstream gz_is (outbuf);
602  retval = read_mat5_binary_element (gz_is, filename,
603  swap, global, tc);
604  }
605  }
606  else
607  error ("load: error probing size of compressed data element");
608 
609  return retval;
610 #else // HAVE_ZLIB
611  error ("load: zlib unavailable, cannot read compressed data element");
612 #endif
613  }
614 
615  std::streampos pos;
616 
617  if (type != miMATRIX)
618  {
619  pos = is.tellg ();
620  error ("load: invalid element type = %d", type);
621  goto early_read_error;
622  }
623 
624  if (element_length == 0)
625  {
626  tc = Matrix ();
627  return retval;
628  }
629 
630  pos = is.tellg ();
631 
632  // array flags subelement
633  int32_t len;
634  if (read_mat5_tag (is, swap, type, len, is_small_data_element) ||
635  type != miUINT32 || len != 8 || is_small_data_element)
636  {
637  error ("load: invalid array flags subelement");
638  goto early_read_error;
639  }
640 
641  int32_t flags;
642  read_int (is, swap, flags);
643 
644  imag = (flags & 0x0800) != 0; // has an imaginary part?
645 
646  global = (flags & 0x0400) != 0; // global variable?
647 
648  logicalvar = (flags & 0x0200) != 0; // boolean ?
649 
650  arrayclass = static_cast<arrayclasstype> (flags & 0xff);
651 
652  int32_t tmp_nzmax;
653  read_int (is, swap, tmp_nzmax); // max number of non-zero in sparse
654  nzmax = tmp_nzmax;
655 
656  // dimensions array subelement
657  if (arrayclass != MAT_FILE_WORKSPACE_CLASS)
658  {
659  int32_t dim_len;
660 
661  if (read_mat5_tag (is, swap, type, dim_len, is_small_data_element) ||
662  type != miINT32)
663  {
664  error ("load: invalid dimensions array subelement");
665  goto early_read_error;
666  }
667 
668  int ndims = dim_len / 4;
669  dims.resize (ndims);
670  for (int i = 0; i < ndims; i++)
671  {
672  int32_t n;
673  read_int (is, swap, n);
674  dims(i) = n;
675  }
676 
677  std::streampos tmp_pos = is.tellg ();
678  is.seekg (tmp_pos + static_cast<std::streamoff>
679  (READ_PAD (is_small_data_element, dim_len) - dim_len));
680  }
681  else
682  {
683  // Why did mathworks decide to not have dims for a workspace!!!
684  dims.resize (2);
685  dims(0) = 1;
686  dims(1) = 1;
687  }
688 
689  if (read_mat5_tag (is, swap, type, len, is_small_data_element) || !INT8(type))
690  {
691  error ("load: invalid array name subelement");
692  goto early_read_error;
693  }
694 
695  {
696  OCTAVE_LOCAL_BUFFER (char, name, len+1);
697 
698  // Structure field subelements have zero-length array name subelements.
699 
700  std::streampos tmp_pos = is.tellg ();
701 
702  if (len)
703  {
704  if (! is.read (name, len ))
705  goto data_read_error;
706 
707  is.seekg (tmp_pos + static_cast<std::streamoff>
708  (READ_PAD (is_small_data_element, len)));
709  }
710 
711  name[len] = '\0';
712  retval = name;
713  }
714 
715  switch (arrayclass)
716  {
717  case MAT_FILE_CELL_CLASS:
718  {
719  Cell cell_array (dims);
720 
721  octave_idx_type n = cell_array.numel ();
722 
723  for (octave_idx_type i = 0; i < n; i++)
724  {
725  octave_value tc2;
726 
727  std::string nm
728  = read_mat5_binary_element (is, filename, swap, global, tc2);
729 
730  if (! is || error_state)
731  {
732  error ("load: reading cell data for '%s'", nm.c_str ());
733  goto data_read_error;
734  }
735 
736  cell_array(i) = tc2;
737  }
738 
739  tc = cell_array;
740  }
741  break;
742 
744  {
745  octave_idx_type nr = dims(0);
746  octave_idx_type nc = dims(1);
747  SparseMatrix sm;
749  octave_idx_type *ridx;
750  octave_idx_type *cidx;
751  double *data;
752 
753  // Setup return value
754  if (imag)
755  {
756  scm = SparseComplexMatrix (nr, nc, nzmax);
757  ridx = scm.ridx ();
758  cidx = scm.cidx ();
759  data = 0;
760  }
761  else
762  {
763  sm = SparseMatrix (nr, nc, nzmax);
764  ridx = sm.ridx ();
765  cidx = sm.cidx ();
766  data = sm.data ();
767  }
768 
769  // row indices
770  std::streampos tmp_pos;
771 
772  if (read_mat5_tag (is, swap, type, len, is_small_data_element))
773  {
774  error ("load: reading sparse row data for '%s'", retval.c_str ());
775  goto data_read_error;
776  }
777 
778  tmp_pos = is.tellg ();
779 
780  read_mat5_integer_data (is, ridx, nzmax, swap,
781  static_cast<enum mat5_data_type> (type));
782 
783  if (! is || error_state)
784  {
785  error ("load: reading sparse row data for '%s'", retval.c_str ());
786  goto data_read_error;
787  }
788 
789  is.seekg (tmp_pos + static_cast<std::streamoff>
790  (READ_PAD (is_small_data_element, len)));
791 
792  // col indices
793  if (read_mat5_tag (is, swap, type, len, is_small_data_element))
794  {
795  error ("load: reading sparse column data for '%s'",
796  retval.c_str ());
797  goto data_read_error;
798  }
799 
800  tmp_pos = is.tellg ();
801 
802  read_mat5_integer_data (is, cidx, nc + 1, swap,
803  static_cast<enum mat5_data_type> (type));
804 
805  if (! is || error_state)
806  {
807  error ("load: reading sparse column data for '%s'",
808  retval.c_str ());
809  goto data_read_error;
810  }
811 
812  is.seekg (tmp_pos + static_cast<std::streamoff>
813  (READ_PAD (is_small_data_element, len)));
814 
815  // real data subelement
816  if (read_mat5_tag (is, swap, type, len, is_small_data_element))
817  {
818  error ("load: reading sparse matrix data for '%s'",
819  retval.c_str ());
820  goto data_read_error;
821  }
822 
823  octave_idx_type nnz = cidx[nc];
824  NDArray re;
825  if (imag)
826  {
827  re = NDArray (dim_vector (nnz, 1));
828  data = re.fortran_vec ();
829  }
830 
831  tmp_pos = is.tellg ();
832  read_mat5_binary_data (is, data, nnz, swap,
833  static_cast<enum mat5_data_type> (type),
834  flt_fmt);
835 
836  if (! is || error_state)
837  {
838  error ("load: reading sparse matrix data for '%s'",
839  retval.c_str ());
840  goto data_read_error;
841  }
842 
843  is.seekg (tmp_pos + static_cast<std::streamoff>
844  (READ_PAD (is_small_data_element, len)));
845 
846  // imaginary data subelement
847  if (imag)
848  {
849  NDArray im (dim_vector (static_cast<int> (nnz), 1));
850 
851  if (read_mat5_tag (is, swap, type, len, is_small_data_element))
852  {
853  error ("load: reading sparse matrix data for '%s'",
854  retval.c_str ());
855  goto data_read_error;
856  }
857 
858  read_mat5_binary_data (is, im.fortran_vec (), nnz, swap,
859  static_cast<enum mat5_data_type> (type),
860  flt_fmt);
861 
862  if (! is || error_state)
863  {
864  error ("load: reading imaginary sparse matrix data for '%s'",
865  retval.c_str ());
866  goto data_read_error;
867  }
868 
869  for (octave_idx_type i = 0; i < nnz; i++)
870  scm.xdata (i) = Complex (re (i), im (i));
871 
872  tc = scm;
873  }
874  else
875  tc = sm;
876  }
877  break;
878 
880  {
881  octave_value tc2;
882  std::string nm
883  = read_mat5_binary_element (is, filename, swap, global, tc2);
884 
885  if (! is || error_state)
886  goto data_read_error;
887 
888  // Octave can handle both "/" and "\" as a directory seperator
889  // and so can ignore the separator field of m0. I think the
890  // sentinel field is also save to ignore.
893  = m0.contents ("function_handle").scalar_map_value ();
894  std::string ftype = m1.contents ("type").string_value ();
895  std::string fname = m1.contents ("function").string_value ();
896  std::string fpath = m1.contents ("file").string_value ();
897 
898  if (ftype == "simple" || ftype == "scopedfunction")
899  {
900  if (fpath.length () == 0)
901  // We have a builtin function
902  tc = make_fcn_handle (fname);
903  else
904  {
905  std::string mroot =
906  m0.contents ("matlabroot").string_value ();
907 
908  if ((fpath.length () >= mroot.length ()) &&
909  fpath.substr (0, mroot.length ()) == mroot &&
910  OCTAVE_EXEC_PREFIX != mroot)
911  {
912  // If fpath starts with matlabroot, and matlabroot
913  // doesn't equal octave_config_info ("exec_prefix")
914  // then the function points to a version of Octave
915  // or Matlab other than the running version. In that
916  // case we replace with the same function in the
917  // running version of Octave?
918 
919  // First check if just replacing matlabroot is enough
920  std::string str = OCTAVE_EXEC_PREFIX +
921  fpath.substr (mroot.length ());
922  file_stat fs (str);
923 
924  if (fs.exists ())
925  {
926  size_t xpos
927  = str.find_last_of (file_ops::dir_sep_chars ());
928 
929  std::string dir_name = str.substr (0, xpos);
930 
931  octave_function *fcn
932  = load_fcn_from_file (str, dir_name, "", fname);
933 
934  if (fcn)
935  {
936  octave_value tmp (fcn);
937 
938  tc = octave_value (new octave_fcn_handle (tmp,
939  fname));
940  }
941  }
942  else
943  {
944  // Next just search for it anywhere in the system path
945  string_vector names(3);
946  names(0) = fname + ".oct";
947  names(1) = fname + ".mex";
948  names(2) = fname + ".m";
949 
951 
952  str =
954 
955  size_t xpos
956  = str.find_last_of (file_ops::dir_sep_chars ());
957 
958  std::string dir_name = str.substr (0, xpos);
959 
960  octave_function *fcn
961  = load_fcn_from_file (str, dir_name, "", fname);
962 
963  if (fcn)
964  {
965  octave_value tmp (fcn);
966 
967  tc = octave_value (new octave_fcn_handle (tmp,
968  fname));
969  }
970  else
971  {
972  warning ("load: can't find the file %s",
973  fpath.c_str ());
974  goto skip_ahead;
975  }
976  }
977  }
978  else
979  {
980  size_t xpos
981  = fpath.find_last_of (file_ops::dir_sep_chars ());
982 
983  std::string dir_name = fpath.substr (0, xpos);
984 
985  octave_function *fcn
986  = load_fcn_from_file (fpath, dir_name, "", fname);
987 
988  if (fcn)
989  {
990  octave_value tmp (fcn);
991 
992  tc = octave_value (new octave_fcn_handle (tmp, fname));
993  }
994  else
995  {
996  warning ("load: can't find the file %s",
997  fpath.c_str ());
998  goto skip_ahead;
999  }
1000  }
1001  }
1002  }
1003  else if (ftype == "nested")
1004  {
1005  warning ("load: can't load nested function");
1006  goto skip_ahead;
1007  }
1008  else if (ftype == "anonymous")
1009  {
1011  = m1.contents ("workspace").scalar_map_value ();
1012  uint32NDArray MCOS = m2.contents ("MCOS").uint32_array_value ();
1013  octave_idx_type off
1014  = static_cast<octave_idx_type>(MCOS(4).double_value ());
1015  m2 = subsys_ov.scalar_map_value ();
1016  m2 = m2.contents ("MCOS").scalar_map_value ();
1017  tc2 = m2.contents ("MCOS").cell_value ()(1 + off).cell_value ()(1);
1018  m2 = tc2.scalar_map_value ();
1019 
1020  unwind_protect_safe frame;
1021 
1022  // Set up temporary scope to use for evaluating the text
1023  // that defines the anonymous function.
1024 
1026  frame.add_fcn (symbol_table::erase_scope, local_scope);
1027 
1028  symbol_table::set_scope (local_scope);
1029 
1030  octave_call_stack::push (local_scope, 0);
1032 
1033  if (m2.nfields () > 0)
1034  {
1035  octave_value tmp;
1036 
1037  for (octave_map::iterator p0 = m2.begin () ;
1038  p0 != m2.end (); p0++)
1039  {
1040  std::string key = m2.key (p0);
1041  octave_value val = m2.contents (p0);
1042 
1043  symbol_table::assign (key, val, local_scope, 0);
1044  }
1045  }
1046 
1047  int parse_status;
1048  octave_value anon_fcn_handle =
1049  eval_string (fname.substr (4), true, parse_status);
1050 
1051  if (parse_status == 0)
1052  {
1053  octave_fcn_handle *fh =
1054  anon_fcn_handle.fcn_handle_value ();
1055 
1056  if (fh)
1057  tc = new octave_fcn_handle (fh->fcn_val (), "@<anonymous>");
1058  else
1059  {
1060  error ("load: failed to load anonymous function handle");
1061  goto skip_ahead;
1062  }
1063  }
1064  else
1065  {
1066  error ("load: failed to load anonymous function handle");
1067  goto skip_ahead;
1068  }
1069 
1070  frame.run ();
1071  }
1072  else
1073  {
1074  error ("load: invalid function handle type");
1075  goto skip_ahead;
1076  }
1077  }
1078  break;
1079 
1081  {
1082  octave_map m (dim_vector (1, 1));
1083  int n_fields = 2;
1084  string_vector field (n_fields);
1085 
1086  for (int i = 0; i < n_fields; i++)
1087  {
1088  int32_t fn_type;
1089  int32_t fn_len;
1090  if (read_mat5_tag (is, swap, fn_type, fn_len, is_small_data_element)
1091  || !INT8(fn_type))
1092  {
1093  error ("load: invalid field name subelement");
1094  goto data_read_error;
1095  }
1096 
1097  OCTAVE_LOCAL_BUFFER (char, elname, fn_len + 1);
1098 
1099  std::streampos tmp_pos = is.tellg ();
1100 
1101  if (fn_len)
1102  {
1103  if (! is.read (elname, fn_len))
1104  goto data_read_error;
1105 
1106  is.seekg (tmp_pos + static_cast<std::streamoff>
1107  (READ_PAD (is_small_data_element, fn_len)));
1108  }
1109 
1110  elname[fn_len] = '\0';
1111 
1112  field(i) = elname;
1113  }
1114 
1115  std::vector<Cell> elt (n_fields);
1116 
1117  for (octave_idx_type i = 0; i < n_fields; i++)
1118  elt[i] = Cell (dims);
1119 
1120  octave_idx_type n = dims.numel ();
1121 
1122  // fields subelements
1123  for (octave_idx_type j = 0; j < n; j++)
1124  {
1125  for (octave_idx_type i = 0; i < n_fields; i++)
1126  {
1127  if (field(i) == "MCOS")
1128  {
1129  octave_value fieldtc;
1130  read_mat5_binary_element (is, filename, swap, global,
1131  fieldtc);
1132  if (! is || error_state)
1133  goto data_read_error;
1134 
1135  elt[i](j) = fieldtc;
1136  }
1137  else
1138  elt[i](j) = octave_value ();
1139  }
1140  }
1141 
1142  for (octave_idx_type i = 0; i < n_fields; i++)
1143  m.assign (field (i), elt[i]);
1144  tc = m;
1145  }
1146  break;
1147 
1148  case MAT_FILE_OBJECT_CLASS:
1149  {
1150  isclass = true;
1151 
1152  if (read_mat5_tag (is, swap, type, len, is_small_data_element) ||
1153  !INT8(type))
1154  {
1155  error ("load: invalid class name");
1156  goto skip_ahead;
1157  }
1158 
1159  {
1160  OCTAVE_LOCAL_BUFFER (char, name, len+1);
1161 
1162  std::streampos tmp_pos = is.tellg ();
1163 
1164  if (len)
1165  {
1166  if (! is.read (name, len ))
1167  goto data_read_error;
1168 
1169  is.seekg (tmp_pos + static_cast<std::streamoff>
1170  (READ_PAD (is_small_data_element, len)));
1171  }
1172 
1173  name[len] = '\0';
1174  classname = name;
1175  }
1176  }
1177  // Fall-through
1178  case MAT_FILE_STRUCT_CLASS:
1179  {
1180  octave_map m (dims);
1181  int32_t fn_type;
1182  int32_t fn_len;
1183  int32_t field_name_length;
1184 
1185  // field name length subelement -- actually the maximum length
1186  // of a field name. The Matlab docs promise this will always
1187  // be 32. We read and use the actual value, on the theory
1188  // that eventually someone will recognize that's a waste of space.
1189  if (read_mat5_tag (is, swap, fn_type, fn_len, is_small_data_element)
1190  || fn_type != miINT32)
1191  {
1192  error ("load: invalid field name length subelement");
1193  goto data_read_error;
1194  }
1195 
1196  if (! is.read (reinterpret_cast<char *> (&field_name_length), fn_len ))
1197  goto data_read_error;
1198 
1199  if (swap)
1200  swap_bytes<4> (&field_name_length);
1201 
1202  // field name subelement. The length of this subelement tells
1203  // us how many fields there are.
1204  if (read_mat5_tag (is, swap, fn_type, fn_len, is_small_data_element)
1205  || !INT8(fn_type))
1206  {
1207  error ("load: invalid field name subelement");
1208  goto data_read_error;
1209  }
1210 
1211  octave_idx_type n_fields = fn_len/field_name_length;
1212 
1213  if (n_fields > 0)
1214  {
1215  fn_len = READ_PAD (is_small_data_element, fn_len);
1216 
1217  OCTAVE_LOCAL_BUFFER (char, elname, fn_len);
1218 
1219  if (! is.read (elname, fn_len))
1220  goto data_read_error;
1221 
1222  std::vector<Cell> elt (n_fields);
1223 
1224  for (octave_idx_type i = 0; i < n_fields; i++)
1225  elt[i] = Cell (dims);
1226 
1227  octave_idx_type n = dims.numel ();
1228 
1229  // fields subelements
1230  for (octave_idx_type j = 0; j < n; j++)
1231  {
1232  for (octave_idx_type i = 0; i < n_fields; i++)
1233  {
1234  octave_value fieldtc;
1235  read_mat5_binary_element (is, filename, swap, global,
1236  fieldtc);
1237  elt[i](j) = fieldtc;
1238  }
1239  }
1240 
1241  for (octave_idx_type i = 0; i < n_fields; i++)
1242  {
1243  const char *key = elname + i*field_name_length;
1244 
1245  m.assign (key, elt[i]);
1246  }
1247  }
1248 
1249  if (isclass)
1250  {
1251  if (classname == "inline")
1252  {
1253  // inline is not an object in Octave but rather an
1254  // overload of a function handle. Special case.
1255  tc =
1256  new octave_fcn_inline (m.contents ("expr")(0).string_value (),
1257  m.contents ("args")(0).string_value ());
1258  }
1259  else
1260  {
1261  octave_class* cls
1262  = new octave_class (m, classname,
1263  std::list<std::string> ());
1264 
1265  if (cls->reconstruct_exemplar ())
1266  {
1267 
1268  if (! cls->reconstruct_parents ())
1269  warning ("load: unable to reconstruct object inheritance");
1270 
1271  tc = cls;
1272  if (load_path::find_method (classname, "loadobj") !=
1273  std::string ())
1274  {
1275  octave_value_list tmp = feval ("loadobj", tc, 1);
1276 
1277  if (! error_state)
1278  tc = tmp(0);
1279  else
1280  goto data_read_error;
1281  }
1282  }
1283  else
1284  {
1285  tc = m;
1286  warning ("load: element has been converted to a structure");
1287  }
1288  }
1289  }
1290  else
1291  tc = m;
1292  }
1293  break;
1294 
1295  case MAT_FILE_INT8_CLASS:
1297  break;
1298 
1299  case MAT_FILE_UINT8_CLASS:
1300  {
1302 
1303  // Logical variables can either be MAT_FILE_UINT8_CLASS or
1304  // MAT_FILE_DOUBLE_CLASS, so check if we have a logical
1305  // variable and convert it.
1306 
1307  if (logicalvar)
1308  {
1309  uint8NDArray in = tc.uint8_array_value ();
1310  octave_idx_type nel = in.numel ();
1311  boolNDArray out (dims);
1312 
1313  for (octave_idx_type i = 0; i < nel; i++)
1314  out(i) = in(i).bool_value ();
1315 
1316  tc = out;
1317  }
1318  }
1319  break;
1320 
1321  case MAT_FILE_INT16_CLASS:
1323  break;
1324 
1325  case MAT_FILE_UINT16_CLASS:
1327  break;
1328 
1329  case MAT_FILE_INT32_CLASS:
1331  break;
1332 
1333  case MAT_FILE_UINT32_CLASS:
1335  break;
1336 
1337  case MAT_FILE_INT64_CLASS:
1339  break;
1340 
1341  case MAT_FILE_UINT64_CLASS:
1343  break;
1344 
1345 
1346  case MAT_FILE_SINGLE_CLASS:
1347  {
1348  FloatNDArray re (dims);
1349 
1350  // real data subelement
1351 
1352  std::streampos tmp_pos;
1353 
1354  if (read_mat5_tag (is, swap, type, len, is_small_data_element))
1355  {
1356  error ("load: reading matrix data for '%s'", retval.c_str ());
1357  goto data_read_error;
1358  }
1359 
1360  octave_idx_type n = re.numel ();
1361  tmp_pos = is.tellg ();
1362  read_mat5_binary_data (is, re.fortran_vec (), n, swap,
1363  static_cast<enum mat5_data_type> (type),
1364  flt_fmt);
1365 
1366  if (! is || error_state)
1367  {
1368  error ("load: reading matrix data for '%s'", retval.c_str ());
1369  goto data_read_error;
1370  }
1371 
1372  is.seekg (tmp_pos + static_cast<std::streamoff>
1373  (READ_PAD (is_small_data_element, len)));
1374 
1375  if (imag)
1376  {
1377  // imaginary data subelement
1378 
1379  FloatNDArray im (dims);
1380 
1381  if (read_mat5_tag (is, swap, type, len, is_small_data_element))
1382  {
1383  error ("load: reading matrix data for '%s'", retval.c_str ());
1384  goto data_read_error;
1385  }
1386 
1387  n = im.numel ();
1388  read_mat5_binary_data (is, im.fortran_vec (), n, swap,
1389  static_cast<enum mat5_data_type> (type),
1390  flt_fmt);
1391 
1392  if (! is || error_state)
1393  {
1394  error ("load: reading imaginary matrix data for '%s'",
1395  retval.c_str ());
1396  goto data_read_error;
1397  }
1398 
1399  FloatComplexNDArray ctmp (dims);
1400 
1401  for (octave_idx_type i = 0; i < n; i++)
1402  ctmp(i) = FloatComplex (re(i), im(i));
1403 
1404  tc = ctmp;
1405  }
1406  else
1407  tc = re;
1408  }
1409  break;
1410 
1411  case MAT_FILE_CHAR_CLASS:
1412  // handle as a numerical array to start with
1413 
1414  case MAT_FILE_DOUBLE_CLASS:
1415  default:
1416  {
1417  NDArray re (dims);
1418 
1419  // real data subelement
1420 
1421  std::streampos tmp_pos;
1422 
1423  if (read_mat5_tag (is, swap, type, len, is_small_data_element))
1424  {
1425  error ("load: reading matrix data for '%s'", retval.c_str ());
1426  goto data_read_error;
1427  }
1428 
1429  octave_idx_type n = re.numel ();
1430  tmp_pos = is.tellg ();
1431  read_mat5_binary_data (is, re.fortran_vec (), n, swap,
1432  static_cast<enum mat5_data_type> (type),
1433  flt_fmt);
1434 
1435  if (! is || error_state)
1436  {
1437  error ("load: reading matrix data for '%s'", retval.c_str ());
1438  goto data_read_error;
1439  }
1440 
1441  is.seekg (tmp_pos + static_cast<std::streamoff>
1442  (READ_PAD (is_small_data_element, len)));
1443 
1444  if (logicalvar)
1445  {
1446  // Logical variables can either be MAT_FILE_UINT8_CLASS or
1447  // MAT_FILE_DOUBLE_CLASS, so check if we have a logical
1448  // variable and convert it.
1449 
1450  boolNDArray out (dims);
1451 
1452  for (octave_idx_type i = 0; i < n; i++)
1453  out (i) = static_cast<bool> (re (i));
1454 
1455  tc = out;
1456  }
1457  else if (imag)
1458  {
1459  // imaginary data subelement
1460 
1461  NDArray im (dims);
1462 
1463  if (read_mat5_tag (is, swap, type, len, is_small_data_element))
1464  {
1465  error ("load: reading matrix data for '%s'", retval.c_str ());
1466  goto data_read_error;
1467  }
1468 
1469  n = im.numel ();
1470  read_mat5_binary_data (is, im.fortran_vec (), n, swap,
1471  static_cast<enum mat5_data_type> (type),
1472  flt_fmt);
1473 
1474  if (! is || error_state)
1475  {
1476  error ("load: reading imaginary matrix data for '%s'",
1477  retval.c_str ());
1478  goto data_read_error;
1479  }
1480 
1481  ComplexNDArray ctmp (dims);
1482 
1483  for (octave_idx_type i = 0; i < n; i++)
1484  ctmp(i) = Complex (re(i), im(i));
1485 
1486  tc = ctmp;
1487  }
1488  else
1489  {
1490  if (arrayclass == MAT_FILE_CHAR_CLASS)
1491  {
1492  if (type == miUTF16 || type == miUTF32)
1493  {
1494  bool found_big_char = false;
1495  for (octave_idx_type i = 0; i < n; i++)
1496  {
1497  if (re(i) > 127)
1498  {
1499  re(i) = '?';
1500  found_big_char = true;
1501  }
1502  }
1503 
1504  if (found_big_char)
1505  warning ("load: can not read non-ASCII portions of UTF characters; replacing unreadable characters with '?'");
1506  }
1507  else if (type == miUTF8)
1508  {
1509  // Search for multi-byte encoded UTF8 characters and
1510  // replace with 0x3F for '?'... Give the user a warning
1511 
1512  bool utf8_multi_byte = false;
1513  for (octave_idx_type i = 0; i < n; i++)
1514  {
1515  unsigned char a = static_cast<unsigned char> (re(i));
1516  if (a > 0x7f)
1517  utf8_multi_byte = true;
1518  }
1519 
1520  if (utf8_multi_byte)
1521  {
1522  warning ("load: can not read multi-byte encoded UTF8 characters; replacing unreadable characters with '?'");
1523  for (octave_idx_type i = 0; i < n; i++)
1524  {
1525  unsigned char a
1526  = static_cast<unsigned char> (re(i));
1527  if (a > 0x7f)
1528  re(i) = '?';
1529  }
1530  }
1531  }
1532  tc = re;
1533  tc = tc.convert_to_str (false, true, '\'');
1534  }
1535  else
1536  tc = re;
1537  }
1538  }
1539  }
1540 
1541  is.seekg (pos + static_cast<std::streamoff> (element_length));
1542 
1543  if (is.eof ())
1544  is.clear ();
1545 
1546  return retval;
1547 
1548 data_read_error:
1549 early_read_error:
1550  error ("load: trouble reading binary file '%s'", filename.c_str ());
1551  return std::string ();
1552 
1553 skip_ahead:
1554  warning ("skipping over '%s'", retval.c_str ());
1555  is.seekg (pos + static_cast<std::streamoff> (element_length));
1556  return read_mat5_binary_element (is, filename, swap, global, tc);
1557 }
1558 
1559 int
1560 read_mat5_binary_file_header (std::istream& is, bool& swap, bool quiet,
1561  const std::string& filename)
1562 {
1563  int16_t version=0, magic=0;
1564  uint64_t subsys_offset;
1565 
1566  is.seekg (116, std::ios::beg);
1567  is.read (reinterpret_cast<char *> (&subsys_offset), 8);
1568 
1569  is.seekg (124, std::ios::beg);
1570  is.read (reinterpret_cast<char *> (&version), 2);
1571  is.read (reinterpret_cast<char *> (&magic), 2);
1572 
1573  if (magic == 0x4d49)
1574  swap = 0;
1575  else if (magic == 0x494d)
1576  swap = 1;
1577  else
1578  {
1579  if (! quiet)
1580  error ("load: can't read binary file");
1581  return -1;
1582  }
1583 
1584  if (! swap) // version number is inverse swapped!
1585  version = ((version >> 8) & 0xff) + ((version & 0xff) << 8);
1586 
1587  if (version != 1 && !quiet)
1588  warning ("load: found version %d binary MAT file, "
1589  "but only prepared for version 1", version);
1590 
1591  if (swap)
1592  swap_bytes<8> (&subsys_offset, 1);
1593 
1594  if (subsys_offset != 0x2020202020202020ULL && subsys_offset != 0ULL)
1595  {
1596  // Read the subsystem data block
1597  is.seekg (subsys_offset, std::ios::beg);
1598 
1599  octave_value tc;
1600  bool global;
1601  read_mat5_binary_element (is, filename, swap, global, tc);
1602 
1603  if (!is || error_state)
1604  return -1;
1605 
1606  if (tc.is_uint8_type ())
1607  {
1608  const uint8NDArray itmp = tc.uint8_array_value ();
1609  octave_idx_type ilen = itmp.numel ();
1610 
1611  // Why should I have to initialize outbuf as just overwrite
1612  std::string outbuf (ilen - 7, ' ');
1613 
1614  // FIXME: find a way to avoid casting away const here
1615  char *ctmp = const_cast<char *> (outbuf.c_str ());
1616  for (octave_idx_type j = 8; j < ilen; j++)
1617  ctmp[j-8] = itmp(j).char_value ();
1618 
1619  std::istringstream fh_ws (outbuf);
1620 
1621  read_mat5_binary_element (fh_ws, filename, swap, global, subsys_ov);
1622 
1623  if (error_state)
1624  return -1;
1625  }
1626  else
1627  return -1;
1628 
1629  // Reposition to just after the header
1630  is.seekg (128, std::ios::beg);
1631  }
1632 
1633  return 0;
1634 }
1635 
1636 static int
1637 write_mat5_tag (std::ostream& is, int type, octave_idx_type bytes)
1638 {
1639  int32_t temp;
1640 
1641  if (bytes > 0 && bytes <= 4)
1642  temp = (bytes << 16) + type;
1643  else
1644  {
1645  temp = type;
1646  if (! is.write (reinterpret_cast<char *> (&temp), 4))
1647  goto data_write_error;
1648  temp = bytes;
1649  }
1650 
1651  if (! is.write (reinterpret_cast<char *> (&temp), 4))
1652  goto data_write_error;
1653 
1654  return 0;
1655 
1656 data_write_error:
1657  return 1;
1658 }
1659 
1660 // Have to use copy here to avoid writing over data accessed via
1661 // Matrix::data().
1662 
1663 #define MAT5_DO_WRITE(TYPE, data, count, stream) \
1664  do \
1665  { \
1666  OCTAVE_LOCAL_BUFFER (TYPE, ptr, count); \
1667  for (octave_idx_type i = 0; i < count; i++) \
1668  ptr[i] = static_cast<TYPE> (data[i]); \
1669  stream.write (reinterpret_cast<char *> (ptr), count * sizeof (TYPE)); \
1670  } \
1671  while (0)
1672 
1673 // write out the numeric values in M to OS,
1674 // preceded by the appropriate tag.
1675 static void
1676 write_mat5_array (std::ostream& os, const NDArray& m, bool save_as_floats)
1677 {
1678  save_type st = LS_DOUBLE;
1679  const double *data = m.data ();
1680 
1681  if (save_as_floats)
1682  {
1683  if (m.too_large_for_float ())
1684  {
1685  warning ("save: some values too large to save as floats --");
1686  warning ("save: saving as doubles instead");
1687  }
1688  else
1689  st = LS_FLOAT;
1690  }
1691 
1692  double max_val, min_val;
1693  if (m.all_integers (max_val, min_val))
1694  st = get_save_type (max_val, min_val);
1695 
1696  mat5_data_type mst;
1697  int size;
1698  switch (st)
1699  {
1700  default:
1701  case LS_DOUBLE: mst = miDOUBLE; size = 8; break;
1702  case LS_FLOAT: mst = miSINGLE; size = 4; break;
1703  case LS_U_CHAR: mst = miUINT8; size = 1; break;
1704  case LS_U_SHORT: mst = miUINT16; size = 2; break;
1705  case LS_U_INT: mst = miUINT32; size = 4; break;
1706  case LS_CHAR: mst = miINT8; size = 1; break;
1707  case LS_SHORT: mst = miINT16; size = 2; break;
1708  case LS_INT: mst = miINT32; size = 4; break;
1709  }
1710 
1711  octave_idx_type nel = m.numel ();
1712  octave_idx_type len = nel*size;
1713 
1714  write_mat5_tag (os, mst, len);
1715 
1716  {
1717  switch (st)
1718  {
1719  case LS_U_CHAR:
1720  MAT5_DO_WRITE (uint8_t, data, nel, os);
1721  break;
1722 
1723  case LS_U_SHORT:
1724  MAT5_DO_WRITE (uint16_t, data, nel, os);
1725  break;
1726 
1727  case LS_U_INT:
1728  MAT5_DO_WRITE (uint32_t, data, nel, os);
1729  break;
1730 
1731  case LS_U_LONG:
1732  MAT5_DO_WRITE (uint64_t, data, nel, os);
1733  break;
1734 
1735  case LS_CHAR:
1736  MAT5_DO_WRITE (int8_t, data, nel, os);
1737  break;
1738 
1739  case LS_SHORT:
1740  MAT5_DO_WRITE (int16_t, data, nel, os);
1741  break;
1742 
1743  case LS_INT:
1744  MAT5_DO_WRITE (int32_t, data, nel, os);
1745  break;
1746 
1747  case LS_LONG:
1748  MAT5_DO_WRITE (int64_t, data, nel, os);
1749  break;
1750 
1751  case LS_FLOAT:
1752  MAT5_DO_WRITE (float, data, nel, os);
1753  break;
1754 
1755  case LS_DOUBLE: // No conversion necessary.
1756  os.write (reinterpret_cast<const char *> (data), len);
1757  break;
1758 
1759  default:
1760  (*current_liboctave_error_handler)
1761  ("unrecognized data format requested");
1762  break;
1763  }
1764  }
1765  if (PAD (len) > len)
1766  {
1767  static char buf[9]="\x00\x00\x00\x00\x00\x00\x00\x00";
1768  os.write (buf, PAD (len) - len);
1769  }
1770 }
1771 
1772 static void
1773 write_mat5_array (std::ostream& os, const FloatNDArray& m, bool)
1774 {
1775  save_type st = LS_FLOAT;
1776  const float *data = m.data ();
1777 
1778  float max_val, min_val;
1779  if (m.all_integers (max_val, min_val))
1780  st = get_save_type (max_val, min_val);
1781 
1782  mat5_data_type mst;
1783  int size;
1784  switch (st)
1785  {
1786  default:
1787  case LS_DOUBLE: mst = miDOUBLE; size = 8; break;
1788  case LS_FLOAT: mst = miSINGLE; size = 4; break;
1789  case LS_U_CHAR: mst = miUINT8; size = 1; break;
1790  case LS_U_SHORT: mst = miUINT16; size = 2; break;
1791  case LS_U_INT: mst = miUINT32; size = 4; break;
1792  case LS_CHAR: mst = miINT8; size = 1; break;
1793  case LS_SHORT: mst = miINT16; size = 2; break;
1794  case LS_INT: mst = miINT32; size = 4; break;
1795  }
1796 
1797  octave_idx_type nel = m.numel ();
1798  octave_idx_type len = nel*size;
1799 
1800  write_mat5_tag (os, mst, len);
1801 
1802  {
1803  switch (st)
1804  {
1805  case LS_U_CHAR:
1806  MAT5_DO_WRITE (uint8_t, data, nel, os);
1807  break;
1808 
1809  case LS_U_SHORT:
1810  MAT5_DO_WRITE (uint16_t, data, nel, os);
1811  break;
1812 
1813  case LS_U_INT:
1814  MAT5_DO_WRITE (uint32_t, data, nel, os);
1815  break;
1816 
1817  case LS_U_LONG:
1818  MAT5_DO_WRITE (uint64_t, data, nel, os);
1819  break;
1820 
1821  case LS_CHAR:
1822  MAT5_DO_WRITE (int8_t, data, nel, os);
1823  break;
1824 
1825  case LS_SHORT:
1826  MAT5_DO_WRITE (int16_t, data, nel, os);
1827  break;
1828 
1829  case LS_INT:
1830  MAT5_DO_WRITE (int32_t, data, nel, os);
1831  break;
1832 
1833  case LS_LONG:
1834  MAT5_DO_WRITE (int64_t, data, nel, os);
1835  break;
1836 
1837  case LS_FLOAT: // No conversion necessary.
1838  os.write (reinterpret_cast<const char *> (data), len);
1839  break;
1840 
1841  case LS_DOUBLE:
1842  MAT5_DO_WRITE (double, data, nel, os);
1843  break;
1844 
1845  default:
1846  (*current_liboctave_error_handler)
1847  ("unrecognized data format requested");
1848  break;
1849  }
1850  }
1851  if (PAD (len) > len)
1852  {
1853  static char buf[9]="\x00\x00\x00\x00\x00\x00\x00\x00";
1854  os.write (buf, PAD (len) - len);
1855  }
1856 }
1857 
1858 template <class T>
1859 void
1860 write_mat5_integer_data (std::ostream& os, const T *m, int size,
1861  octave_idx_type nel)
1862 {
1863  mat5_data_type mst;
1864  unsigned len;
1865 
1866  switch (size)
1867  {
1868  case 1:
1869  mst = miUINT8;
1870  break;
1871  case 2:
1872  mst = miUINT16;
1873  break;
1874  case 4:
1875  mst = miUINT32;
1876  break;
1877  case 8:
1878  mst = miUINT64;
1879  break;
1880  case -1:
1881  mst = miINT8;
1882  size = - size;
1883  break;
1884  case -2:
1885  mst = miINT16;
1886  size = - size;
1887  break;
1888  case -4:
1889  mst = miINT32;
1890  size = - size;
1891  break;
1892  case -8:
1893  default:
1894  mst = miINT64;
1895  size = - size;
1896  break;
1897  }
1898 
1899  len = nel*size;
1900  write_mat5_tag (os, mst, len);
1901 
1902  os.write (reinterpret_cast<const char *> (m), len);
1903 
1904  if (PAD (len) > len)
1905  {
1906  static char buf[9]="\x00\x00\x00\x00\x00\x00\x00\x00";
1907  os.write (buf, PAD (len) - len);
1908  }
1909 }
1910 
1911 template void
1912 write_mat5_integer_data (std::ostream& os, const octave_int8 *m,
1913  int size, octave_idx_type nel);
1914 
1915 template void
1916 write_mat5_integer_data (std::ostream& os, const octave_int16 *m,
1917  int size, octave_idx_type nel);
1918 
1919 template void
1920 write_mat5_integer_data (std::ostream& os, const octave_int32 *m,
1921  int size, octave_idx_type nel);
1922 
1923 template void
1924 write_mat5_integer_data (std::ostream& os, const octave_int64 *m,
1925  int size, octave_idx_type nel);
1926 
1927 template void
1928 write_mat5_integer_data (std::ostream& os, const octave_uint8 *m,
1929  int size, octave_idx_type nel);
1930 
1931 template void
1932 write_mat5_integer_data (std::ostream& os, const octave_uint16 *m,
1933  int size, octave_idx_type nel);
1934 
1935 template void
1936 write_mat5_integer_data (std::ostream& os, const octave_uint32 *m,
1937  int size, octave_idx_type nel);
1938 
1939 template void
1940 write_mat5_integer_data (std::ostream& os, const octave_uint64 *m,
1941  int size, octave_idx_type nel);
1942 
1943 template void
1944 write_mat5_integer_data (std::ostream& os, const int *m,
1945  int size, octave_idx_type nel);
1946 
1947 // Write out cell element values in the cell array to OS, preceded by
1948 // the appropriate tag.
1949 
1950 static bool
1951 write_mat5_cell_array (std::ostream& os, const Cell& cell,
1952  bool mark_as_global, bool save_as_floats)
1953 {
1954  octave_idx_type nel = cell.numel ();
1955 
1956  for (octave_idx_type i = 0; i < nel; i++)
1957  {
1958  octave_value ov = cell(i);
1959 
1960  if (! save_mat5_binary_element (os, ov, "", mark_as_global,
1961  false, save_as_floats))
1962  return false;
1963  }
1964 
1965  return true;
1966 }
1967 
1968 int
1969 save_mat5_array_length (const double* val, octave_idx_type nel,
1970  bool save_as_floats)
1971 {
1972  if (nel > 0)
1973  {
1974  int size = 8;
1975 
1976  if (save_as_floats)
1977  {
1978  bool too_large_for_float = false;
1979  for (octave_idx_type i = 0; i < nel; i++)
1980  {
1981  double tmp = val[i];
1982 
1983  if (xfinite (tmp)
1984  && fabs (tmp) > std::numeric_limits<float>::max ())
1985  {
1986  too_large_for_float = true;
1987  break;
1988  }
1989  }
1990 
1991  if (!too_large_for_float)
1992  size = 4;
1993  }
1994 
1995  // The code below is disabled since get_save_type currently doesn't
1996  // deal with integer types. This will need to be activated if
1997  // get_save_type is changed.
1998 
1999  // double max_val = val[0];
2000  // double min_val = val[0];
2001  // bool all_integers = true;
2002  //
2003  // for (int i = 0; i < nel; i++)
2004  // {
2005  // double val = val[i];
2006  //
2007  // if (val > max_val)
2008  // max_val = val;
2009  //
2010  // if (val < min_val)
2011  // min_val = val;
2012  //
2013  // if (D_NINT (val) != val)
2014  // {
2015  // all_integers = false;
2016  // break;
2017  // }
2018  // }
2019  //
2020  // if (all_integers)
2021  // {
2022  // if (max_val < 256 && min_val > -1)
2023  // size = 1;
2024  // else if (max_val < 65536 && min_val > -1)
2025  // size = 2;
2026  // else if (max_val < 4294967295UL && min_val > -1)
2027  // size = 4;
2028  // else if (max_val < 128 && min_val >= -128)
2029  // size = 1;
2030  // else if (max_val < 32768 && min_val >= -32768)
2031  // size = 2;
2032  // else if (max_val <= 2147483647L && min_val >= -2147483647L)
2033  // size = 4;
2034  // }
2035 
2036  return 8 + nel * size;
2037  }
2038  else
2039  return 8;
2040 }
2041 
2042 int
2043 save_mat5_array_length (const float* /* val */, octave_idx_type nel, bool)
2044 {
2045  if (nel > 0)
2046  {
2047  int size = 4;
2048 
2049 
2050  // The code below is disabled since get_save_type currently doesn't
2051  // deal with integer types. This will need to be activated if
2052  // get_save_type is changed.
2053 
2054  // float max_val = val[0];
2055  // float min_val = val[0];
2056  // bool all_integers = true;
2057  //
2058  // for (int i = 0; i < nel; i++)
2059  // {
2060  // float val = val[i];
2061  //
2062  // if (val > max_val)
2063  // max_val = val;
2064  //
2065  // if (val < min_val)
2066  // min_val = val;
2067  //
2068  // if (D_NINT (val) != val)
2069  // {
2070  // all_integers = false;
2071  // break;
2072  // }
2073  // }
2074  //
2075  // if (all_integers)
2076  // {
2077  // if (max_val < 256 && min_val > -1)
2078  // size = 1;
2079  // else if (max_val < 65536 && min_val > -1)
2080  // size = 2;
2081  // else if (max_val < 4294967295UL && min_val > -1)
2082  // size = 4;
2083  // else if (max_val < 128 && min_val >= -128)
2084  // size = 1;
2085  // else if (max_val < 32768 && min_val >= -32768)
2086  // size = 2;
2087  // else if (max_val <= 2147483647L && min_val >= -2147483647L)
2088  // size = 4;
2089  // }
2090 
2091  // Round nel up to nearest even number of elements. Take into account
2092  // Short tags for 4 byte elements.
2093  return PAD ((nel > 0 && nel * size <= 4 ? 4 : 8) + nel * size);
2094  }
2095  else
2096  return 8;
2097 }
2098 
2099 int
2101  bool save_as_floats)
2102 {
2103  int ret;
2104 
2105  OCTAVE_LOCAL_BUFFER (double, tmp, nel);
2106 
2107  for (octave_idx_type i = 1; i < nel; i++)
2108  tmp[i] = std::real (val[i]);
2109 
2110  ret = save_mat5_array_length (tmp, nel, save_as_floats);
2111 
2112  for (octave_idx_type i = 1; i < nel; i++)
2113  tmp[i] = std::imag (val[i]);
2114 
2115  ret += save_mat5_array_length (tmp, nel, save_as_floats);
2116 
2117  return ret;
2118 }
2119 
2120 int
2122  bool save_as_floats)
2123 {
2124  int ret;
2125 
2126  OCTAVE_LOCAL_BUFFER (float, tmp, nel);
2127 
2128  for (octave_idx_type i = 1; i < nel; i++)
2129  tmp[i] = std::real (val[i]);
2130 
2131  ret = save_mat5_array_length (tmp, nel, save_as_floats);
2132 
2133  for (octave_idx_type i = 1; i < nel; i++)
2134  tmp[i] = std::imag (val[i]);
2135 
2136  ret += save_mat5_array_length (tmp, nel, save_as_floats);
2137 
2138  return ret;
2139 }
2140 
2141 int
2142 save_mat5_element_length (const octave_value& tc, const std::string& name,
2143  bool save_as_floats, bool mat7_format)
2144 {
2145  size_t max_namelen = 63;
2146  size_t len = name.length ();
2147  std::string cname = tc.class_name ();
2148  int ret = 32;
2149 
2150  if (len > 4)
2151  ret += PAD (len > max_namelen ? max_namelen : len);
2152 
2153  ret += PAD (4 * tc.ndims ());
2154 
2155  if (tc.is_string ())
2156  {
2157  charNDArray chm = tc.char_array_value ();
2158  ret += 8;
2159  if (chm.numel () > 2)
2160  ret += PAD (2 * chm.numel ());
2161  }
2162  else if (tc.is_sparse_type ())
2163  {
2164  if (tc.is_complex_type ())
2165  {
2167  octave_idx_type nc = m.cols ();
2168  octave_idx_type nnz = m.nnz ();
2169 
2170  ret += 16 + save_mat5_array_length (m.data (), nnz, save_as_floats);
2171  if (nnz > 1)
2172  ret += PAD (nnz * sizeof (int32_t));
2173  if (nc > 0)
2174  ret += PAD ((nc + 1) * sizeof (int32_t));
2175  }
2176  else
2177  {
2178  const SparseMatrix m = tc.sparse_matrix_value ();
2179  octave_idx_type nc = m.cols ();
2180  octave_idx_type nnz = m.nnz ();
2181 
2182  ret += 16 + save_mat5_array_length (m.data (), nnz, save_as_floats);
2183  if (nnz > 1)
2184  ret += PAD (nnz * sizeof (int32_t));
2185  if (nc > 0)
2186  ret += PAD ((nc + 1) * sizeof (int32_t));
2187  }
2188  }
2189 
2190 #define INT_LEN(nel, size) \
2191  { \
2192  ret += 8; \
2193  octave_idx_type sz = nel * size; \
2194  if (sz > 4) \
2195  ret += PAD (sz); \
2196  }
2197 
2198  else if (cname == "int8")
2199  INT_LEN (tc.int8_array_value ().numel (), 1)
2200  else if (cname == "int16")
2201  INT_LEN (tc.int16_array_value ().numel (), 2)
2202  else if (cname == "int32")
2203  INT_LEN (tc.int32_array_value ().numel (), 4)
2204  else if (cname == "int64")
2205  INT_LEN (tc.int64_array_value ().numel (), 8)
2206  else if (cname == "uint8")
2207  INT_LEN (tc.uint8_array_value ().numel (), 1)
2208  else if (cname == "uint16")
2209  INT_LEN (tc.uint16_array_value ().numel (), 2)
2210  else if (cname == "uint32")
2211  INT_LEN (tc.uint32_array_value ().numel (), 4)
2212  else if (cname == "uint64")
2213  INT_LEN (tc.uint64_array_value ().numel (), 8)
2214  else if (tc.is_bool_type ())
2215  INT_LEN (tc.bool_array_value ().numel (), 1)
2216  else if (tc.is_real_scalar () || tc.is_real_matrix () || tc.is_range ())
2217  {
2218  if (tc.is_single_type ())
2219  {
2220  const FloatNDArray m = tc.float_array_value ();
2221  ret += save_mat5_array_length (m.fortran_vec (), m.numel (),
2222  save_as_floats);
2223  }
2224  else
2225  {
2226  const NDArray m = tc.array_value ();
2227  ret += save_mat5_array_length (m.fortran_vec (), m.numel (),
2228  save_as_floats);
2229  }
2230  }
2231  else if (tc.is_cell ())
2232  {
2233  Cell cell = tc.cell_value ();
2234  octave_idx_type nel = cell.numel ();
2235 
2236  for (int i = 0; i < nel; i++)
2237  ret += 8 +
2238  save_mat5_element_length (cell (i), "", save_as_floats, mat7_format);
2239  }
2240  else if (tc.is_complex_scalar () || tc.is_complex_matrix ())
2241  {
2242  if (tc.is_single_type ())
2243  {
2245  ret += save_mat5_array_length (m.fortran_vec (), m.numel (),
2246  save_as_floats);
2247  }
2248  else
2249  {
2250  const ComplexNDArray m = tc.complex_array_value ();
2251  ret += save_mat5_array_length (m.fortran_vec (), m.numel (),
2252  save_as_floats);
2253  }
2254  }
2255  else if (tc.is_map () || tc.is_inline_function () || tc.is_object ())
2256  {
2257  int fieldcnt = 0;
2258  const octave_map m = tc.map_value ();
2259  octave_idx_type nel = m.numel ();
2260 
2261  if (tc.is_inline_function ())
2262  // length of "inline" is 6
2263  ret += 8 + PAD (6 > max_namelen ? max_namelen : 6);
2264  else if (tc.is_object ())
2265  {
2266  size_t classlen = tc.class_name (). length ();
2267 
2268  ret += 8 + PAD (classlen > max_namelen ? max_namelen : classlen);
2269  }
2270 
2271  for (octave_map::const_iterator i = m.begin (); i != m.end (); i++)
2272  fieldcnt++;
2273 
2274  ret += 16 + fieldcnt * (max_namelen + 1);
2275 
2276 
2277  for (octave_idx_type j = 0; j < nel; j++)
2278  {
2279 
2280  for (octave_map::const_iterator i = m.begin (); i != m.end (); i++)
2281  {
2282  const Cell elts = m.contents (i);
2283 
2284  ret += 8 + save_mat5_element_length (elts(j), "",
2285  save_as_floats, mat7_format);
2286  }
2287  }
2288  }
2289  else
2290  ret = -1;
2291 
2292  return ret;
2293 }
2294 
2295 static void
2297  const octave_idx_type *idx,
2298  octave_idx_type nel)
2299 {
2300  int tmp = sizeof (int32_t);
2301 
2302  OCTAVE_LOCAL_BUFFER (int32_t, tmp_idx, nel);
2303 
2304  for (octave_idx_type i = 0; i < nel; i++)
2305  tmp_idx[i] = idx[i];
2306 
2307  write_mat5_integer_data (os, tmp_idx, -tmp, nel);
2308 }
2309 
2310 static void
2311 gripe_dim_too_large (const std::string& name)
2312 {
2313  warning ("save: skipping %s: dimension too large for MAT format",
2314  name.c_str ());
2315 }
2316 
2317 // save the data from TC along with the corresponding NAME on stream
2318 // OS in the MatLab version 5 binary format. Return true on success.
2319 
2320 bool
2321 save_mat5_binary_element (std::ostream& os,
2322  const octave_value& tc, const std::string& name,
2323  bool mark_as_global, bool mat7_format,
2324  bool save_as_floats, bool compressing)
2325 {
2326  int32_t flags = 0;
2327  int32_t nnz_32 = 0;
2328  std::string cname = tc.class_name ();
2329  size_t max_namelen = 63;
2330 
2331  dim_vector dv = tc.dims ();
2332  int nd = tc.ndims ();
2333  int dim_len = 4*nd;
2334 
2335  static octave_idx_type max_dim_val = std::numeric_limits<int32_t>::max ();
2336 
2337  for (int i = 0; i < nd; i++)
2338  {
2339  if (dv(i) > max_dim_val)
2340  {
2341  gripe_dim_too_large (name);
2342  goto skip_to_next;
2343  }
2344  }
2345 
2346  if (tc.is_sparse_type ())
2347  {
2348  octave_idx_type nnz;
2349  octave_idx_type nc;
2350 
2351  if (tc.is_complex_type ())
2352  {
2354  nnz = scm.nzmax ();
2355  nc = scm.cols ();
2356  }
2357  else
2358  {
2359  SparseMatrix sm = tc.sparse_matrix_value ();
2360  nnz = sm.nzmax ();
2361  nc = sm.cols ();
2362  }
2363 
2364  if (nnz > max_dim_val || nc + 1 > max_dim_val)
2365  {
2366  gripe_dim_too_large (name);
2367  goto skip_to_next;
2368  }
2369 
2370  nnz_32 = nnz;
2371  }
2372  else if (dv.numel () > max_dim_val)
2373  {
2374  gripe_dim_too_large (name);
2375  goto skip_to_next;
2376  }
2377 
2378 #ifdef HAVE_ZLIB
2379  if (mat7_format && !compressing)
2380  {
2381  bool ret = false;
2382 
2383  std::ostringstream buf;
2384 
2385  // The code seeks backwards in the stream to fix the header. Can't
2386  // do this with zlib, so use a stringstream.
2387  ret = save_mat5_binary_element (buf, tc, name, mark_as_global, true,
2388  save_as_floats, true);
2389 
2390  if (ret)
2391  {
2392  // destLen must be at least 0.1% larger than source buffer
2393  // + 12 bytes. Reality is it must be larger again than that.
2394  std::string buf_str = buf.str ();
2395  uLongf srcLen = buf_str.length ();
2396  uLongf destLen = srcLen * 101 / 100 + 12;
2397  OCTAVE_LOCAL_BUFFER (char, out_buf, destLen);
2398 
2399  if (compress (reinterpret_cast<Bytef *> (out_buf), &destLen,
2400  reinterpret_cast<const Bytef *> (buf_str.c_str ()),
2401  srcLen)
2402  == Z_OK)
2403  {
2405  static_cast<octave_idx_type> (destLen));
2406 
2407  os.write (out_buf, destLen);
2408  }
2409  else
2410  {
2411  error ("save: error compressing data element");
2412  ret = false;
2413  }
2414  }
2415 
2416  return ret;
2417  }
2418 #endif
2419 
2421  (tc, name, save_as_floats, mat7_format));
2422 
2423  // array flags subelement
2424  write_mat5_tag (os, miUINT32, 8);
2425 
2426  if (tc.is_bool_type ())
2427  flags |= 0x0200;
2428 
2429  if (mark_as_global)
2430  flags |= 0x0400;
2431 
2432  if (tc.is_complex_scalar () || tc.is_complex_matrix ())
2433  flags |= 0x0800;
2434 
2435  if (tc.is_string ())
2436  flags |= MAT_FILE_CHAR_CLASS;
2437  else if (cname == "int8")
2438  flags |= MAT_FILE_INT8_CLASS;
2439  else if (cname == "int16")
2440  flags |= MAT_FILE_INT16_CLASS;
2441  else if (cname == "int32")
2442  flags |= MAT_FILE_INT32_CLASS;
2443  else if (cname == "int64")
2444  flags |= MAT_FILE_INT64_CLASS;
2445  else if (cname == "uint8" || tc.is_bool_type ())
2446  flags |= MAT_FILE_UINT8_CLASS;
2447  else if (cname == "uint16")
2448  flags |= MAT_FILE_UINT16_CLASS;
2449  else if (cname == "uint32")
2450  flags |= MAT_FILE_UINT32_CLASS;
2451  else if (cname == "uint64")
2452  flags |= MAT_FILE_UINT64_CLASS;
2453  else if (tc.is_sparse_type ())
2454  flags |= MAT_FILE_SPARSE_CLASS;
2455  else if (tc.is_real_scalar () || tc.is_real_matrix () || tc.is_range ()
2456  || tc.is_complex_scalar () || tc.is_complex_matrix ())
2457  {
2458  if (tc.is_single_type ())
2459  flags |= MAT_FILE_SINGLE_CLASS;
2460  else
2461  flags |= MAT_FILE_DOUBLE_CLASS;
2462  }
2463  else if (tc.is_map ())
2464  flags |= MAT_FILE_STRUCT_CLASS;
2465  else if (tc.is_cell ())
2466  flags |= MAT_FILE_CELL_CLASS;
2467  else if (tc.is_inline_function () || tc.is_object ())
2468  flags |= MAT_FILE_OBJECT_CLASS;
2469  else
2470  {
2471  gripe_wrong_type_arg ("save", tc, false);
2472  goto error_cleanup;
2473  }
2474 
2475  os.write (reinterpret_cast<char *> (&flags), 4);
2476  // Matlab seems to have trouble reading files that have nzmax == 0 at
2477  // this point in the file.
2478  if (nnz_32 == 0)
2479  nnz_32 = 1;
2480  os.write (reinterpret_cast<char *> (&nnz_32), 4);
2481 
2482  write_mat5_tag (os, miINT32, dim_len);
2483 
2484  for (int i = 0; i < nd; i++)
2485  {
2486  int32_t n = dv(i);
2487  os.write (reinterpret_cast<char *> (&n), 4);
2488  }
2489 
2490  if (PAD (dim_len) > dim_len)
2491  {
2492  static char buf[9]="\x00\x00\x00\x00\x00\x00\x00\x00";
2493  os.write (buf, PAD (dim_len) - dim_len);
2494  }
2495 
2496  // array name subelement
2497  {
2498  size_t namelen = name.length ();
2499 
2500  if (namelen > max_namelen)
2501  namelen = max_namelen; // Truncate names if necessary
2502 
2503  int paddedlength = PAD (namelen);
2504 
2505  write_mat5_tag (os, miINT8, namelen);
2506  OCTAVE_LOCAL_BUFFER (char, paddedname, paddedlength);
2507  memset (paddedname, 0, paddedlength);
2508  strncpy (paddedname, name.c_str (), namelen);
2509  os.write (paddedname, paddedlength);
2510  }
2511 
2512  // data element
2513  if (tc.is_string ())
2514  {
2515  charNDArray chm = tc.char_array_value ();
2516  octave_idx_type nel = chm.numel ();
2517  octave_idx_type len = nel*2;
2518  octave_idx_type paddedlength = PAD (len);
2519 
2520  OCTAVE_LOCAL_BUFFER (int16_t, buf, nel+3);
2521  write_mat5_tag (os, miUINT16, len);
2522 
2523  const char *s = chm.data ();
2524 
2525  for (octave_idx_type i = 0; i < nel; i++)
2526  buf[i] = *s++ & 0x00FF;
2527 
2528  os.write (reinterpret_cast<char *> (buf), len);
2529 
2530  if (paddedlength > len)
2531  {
2532  static char padbuf[9]="\x00\x00\x00\x00\x00\x00\x00\x00";
2533  os.write (padbuf, paddedlength - len);
2534  }
2535  }
2536  else if (tc.is_sparse_type ())
2537  {
2538  if (tc.is_complex_type ())
2539  {
2541  octave_idx_type nnz = m.nnz ();
2542  octave_idx_type nc = m.cols ();
2543 
2544  write_mat5_sparse_index_vector (os, m.ridx (), nnz);
2545  write_mat5_sparse_index_vector (os, m.cidx (), nc + 1);
2546 
2547  NDArray buf (dim_vector (nnz, 1));
2548 
2549  for (octave_idx_type i = 0; i < nnz; i++)
2550  buf (i) = std::real (m.data (i));
2551 
2552  write_mat5_array (os, buf, save_as_floats);
2553 
2554  for (octave_idx_type i = 0; i < nnz; i++)
2555  buf (i) = std::imag (m.data (i));
2556 
2557  write_mat5_array (os, buf, save_as_floats);
2558  }
2559  else
2560  {
2561  const SparseMatrix m = tc.sparse_matrix_value ();
2562  octave_idx_type nnz = m.nnz ();
2563  octave_idx_type nc = m.cols ();
2564 
2565  write_mat5_sparse_index_vector (os, m.ridx (), nnz);
2566  write_mat5_sparse_index_vector (os, m.cidx (), nc + 1);
2567 
2568  // FIXME
2569  // Is there a way to easily do without this buffer
2570  NDArray buf (dim_vector (nnz, 1));
2571 
2572  for (int i = 0; i < nnz; i++)
2573  buf (i) = m.data (i);
2574 
2575  write_mat5_array (os, buf, save_as_floats);
2576  }
2577  }
2578  else if (cname == "int8")
2579  {
2580  int8NDArray m = tc.int8_array_value ();
2581 
2582  write_mat5_integer_data (os, m.fortran_vec (), -1, m.numel ());
2583  }
2584  else if (cname == "int16")
2585  {
2586  int16NDArray m = tc.int16_array_value ();
2587 
2588  write_mat5_integer_data (os, m.fortran_vec (), -2, m.numel ());
2589  }
2590  else if (cname == "int32")
2591  {
2592  int32NDArray m = tc.int32_array_value ();
2593 
2594  write_mat5_integer_data (os, m.fortran_vec (), -4, m.numel ());
2595  }
2596  else if (cname == "int64")
2597  {
2598  int64NDArray m = tc.int64_array_value ();
2599 
2600  write_mat5_integer_data (os, m.fortran_vec (), -8, m.numel ());
2601  }
2602  else if (cname == "uint8")
2603  {
2604  uint8NDArray m = tc.uint8_array_value ();
2605 
2606  write_mat5_integer_data (os, m.fortran_vec (), 1, m.numel ());
2607  }
2608  else if (cname == "uint16")
2609  {
2611 
2612  write_mat5_integer_data (os, m.fortran_vec (), 2, m.numel ());
2613  }
2614  else if (cname == "uint32")
2615  {
2617 
2618  write_mat5_integer_data (os, m.fortran_vec (), 4, m.numel ());
2619  }
2620  else if (cname == "uint64")
2621  {
2623 
2624  write_mat5_integer_data (os, m.fortran_vec (), 8, m.numel ());
2625  }
2626  else if (tc.is_bool_type ())
2627  {
2628  uint8NDArray m (tc.bool_array_value ());
2629 
2630  write_mat5_integer_data (os, m.fortran_vec (), 1, m.numel ());
2631  }
2632  else if (tc.is_real_scalar () || tc.is_real_matrix () || tc.is_range ())
2633  {
2634  if (tc.is_single_type ())
2635  {
2636  FloatNDArray m = tc.float_array_value ();
2637 
2638  write_mat5_array (os, m, save_as_floats);
2639  }
2640  else
2641  {
2642  NDArray m = tc.array_value ();
2643 
2644  write_mat5_array (os, m, save_as_floats);
2645  }
2646  }
2647  else if (tc.is_cell ())
2648  {
2649  Cell cell = tc.cell_value ();
2650 
2651  if (! write_mat5_cell_array (os, cell, mark_as_global, save_as_floats))
2652  goto error_cleanup;
2653  }
2654  else if (tc.is_complex_scalar () || tc.is_complex_matrix ())
2655  {
2656  if (tc.is_single_type ())
2657  {
2659 
2660  write_mat5_array (os, ::real (m_cmplx), save_as_floats);
2661  write_mat5_array (os, ::imag (m_cmplx), save_as_floats);
2662  }
2663  else
2664  {
2665  ComplexNDArray m_cmplx = tc.complex_array_value ();
2666 
2667  write_mat5_array (os, ::real (m_cmplx), save_as_floats);
2668  write_mat5_array (os, ::imag (m_cmplx), save_as_floats);
2669  }
2670  }
2671  else if (tc.is_map () || tc.is_inline_function () || tc.is_object ())
2672  {
2673  if (tc.is_inline_function () || tc.is_object ())
2674  {
2675  std::string classname = tc.is_object () ? tc.class_name () : "inline";
2676  size_t namelen = classname.length ();
2677 
2678  if (namelen > max_namelen)
2679  namelen = max_namelen; // Truncate names if necessary
2680 
2681  int paddedlength = PAD (namelen);
2682 
2683  write_mat5_tag (os, miINT8, namelen);
2684  OCTAVE_LOCAL_BUFFER (char, paddedname, paddedlength);
2685  memset (paddedname, 0, paddedlength);
2686  strncpy (paddedname, classname.c_str (), namelen);
2687  os.write (paddedname, paddedlength);
2688  }
2689 
2690  octave_map m;
2691 
2692  if (tc.is_object ()
2694  "saveobj") != std::string ())
2695  {
2696  octave_value_list tmp = feval ("saveobj", tc, 1);
2697  if (! error_state)
2698  m = tmp(0).map_value ();
2699  else
2700  goto error_cleanup;
2701  }
2702  else
2703  m = tc.map_value ();
2704 
2705  // an Octave structure */
2706  // recursively write each element of the structure
2707  {
2708  char buf[64];
2709  int32_t maxfieldnamelength = max_namelen + 1;
2710 
2711  octave_idx_type nf = m.nfields ();
2712 
2713  write_mat5_tag (os, miINT32, 4);
2714  os.write (reinterpret_cast<char *> (&maxfieldnamelength), 4);
2715  write_mat5_tag (os, miINT8, nf*maxfieldnamelength);
2716 
2717  // Iterating over the list of keys will preserve the order of
2718  // the fields.
2719  string_vector keys = m.keys ();
2720 
2721  for (octave_idx_type i = 0; i < nf; i++)
2722  {
2723  std::string key = keys(i);
2724 
2725  // write the name of each element
2726  memset (buf, 0, max_namelen + 1);
2727  // only 31 or 63 char names permitted
2728  strncpy (buf, key.c_str (), max_namelen);
2729  os.write (buf, max_namelen + 1);
2730  }
2731 
2732  octave_idx_type len = m.numel ();
2733 
2734  // Create temporary copy of structure contents to avoid
2735  // multiple calls of the contents method.
2736  std::vector<const octave_value *> elts (nf);
2737  for (octave_idx_type i = 0; i < nf; i++)
2738  elts[i] = m.contents (keys(i)).data ();
2739 
2740  for (octave_idx_type j = 0; j < len; j++)
2741  {
2742  // write the data of each element
2743 
2744  // Iterating over the list of keys will preserve the order
2745  // of the fields.
2746  for (octave_idx_type i = 0; i < nf; i++)
2747  {
2748  bool retval2 = save_mat5_binary_element (os, elts[i][j], "",
2749  mark_as_global,
2750  false,
2751  save_as_floats);
2752  if (! retval2)
2753  goto error_cleanup;
2754  }
2755  }
2756  }
2757  }
2758  else
2759  gripe_wrong_type_arg ("save", tc, false);
2760 
2761 skip_to_next:
2762  return true;
2763 
2764 error_cleanup:
2765  error ("save: error while writing '%s' to MAT file", name.c_str ());
2766 
2767  return false;
2768 }