# HG changeset patch # User Rik # Date 1372898628 25200 # Node ID 68fc671a933906faa80ca7c2fea6d858111f0c7e # Parent 486c3e2731ff2fc16bc976260843f8ce34df794a maint: Collapse interpfcn and interpfcn-core directories into corefcn directory. * libgui/src/module.mk: Remove -I references to interp-core, interpfcn, add reference to corefcn. * libinterp/Makefile.am: Remove -I references to interp-core, interpfcn, add reference to corefcn. * libinterp/corefcn/module.mk: Add files from interp-core, interpfcn to build system. Copy over special rules from module.mk files in interp-core andd interpfcn. * src/Makefile.am: Replace references to interp-core, interpfcn with those to corefcn. * libinterp/corefcn/Cell.cc, libinterp/corefcn/Cell.h, libinterp/corefcn/action-container.h, libinterp/corefcn/c-file-ptr-stream.cc, libinterp/corefcn/c-file-ptr-stream.h, libinterp/corefcn/comment-list.cc, libinterp/corefcn/comment-list.h, libinterp/corefcn/cutils.c, libinterp/corefcn/cutils.h, libinterp/corefcn/data.cc, libinterp/corefcn/data.h, libinterp/corefcn/debug.cc, libinterp/corefcn/debug.h, libinterp/corefcn/defaults.cc, libinterp/corefcn/defaults.in.h, libinterp/corefcn/defun-dld.h, libinterp/corefcn/defun-int.h, libinterp/corefcn/defun.cc, libinterp/corefcn/defun.h, libinterp/corefcn/dirfns.cc, libinterp/corefcn/dirfns.h, libinterp/corefcn/display.cc, libinterp/corefcn/display.h, libinterp/corefcn/dynamic-ld.cc, libinterp/corefcn/dynamic-ld.h, libinterp/corefcn/error.cc, libinterp/corefcn/error.h, libinterp/corefcn/event-queue.h, libinterp/corefcn/file-io.cc, libinterp/corefcn/file-io.h, libinterp/corefcn/gl-render.cc, libinterp/corefcn/gl-render.h, libinterp/corefcn/gl2ps-renderer.cc, libinterp/corefcn/gl2ps-renderer.h, libinterp/corefcn/gl2ps.c, libinterp/corefcn/gl2ps.h, libinterp/corefcn/graphics.cc, libinterp/corefcn/graphics.in.h, libinterp/corefcn/gripes.cc, libinterp/corefcn/gripes.h, libinterp/corefcn/help.cc, libinterp/corefcn/help.h, libinterp/corefcn/hook-fcn.cc, libinterp/corefcn/hook-fcn.h, libinterp/corefcn/input.cc, libinterp/corefcn/input.h, libinterp/corefcn/jit-ir.cc, libinterp/corefcn/jit-ir.h, libinterp/corefcn/jit-typeinfo.cc, libinterp/corefcn/jit-typeinfo.h, libinterp/corefcn/jit-util.cc, libinterp/corefcn/jit-util.h, libinterp/corefcn/load-path.cc, libinterp/corefcn/load-path.h, libinterp/corefcn/load-save.cc, libinterp/corefcn/load-save.h, libinterp/corefcn/ls-ascii-helper.cc, libinterp/corefcn/ls-ascii-helper.h, libinterp/corefcn/ls-hdf5.cc, libinterp/corefcn/ls-hdf5.h, libinterp/corefcn/ls-mat-ascii.cc, libinterp/corefcn/ls-mat-ascii.h, libinterp/corefcn/ls-mat4.cc, libinterp/corefcn/ls-mat4.h, libinterp/corefcn/ls-mat5.cc, libinterp/corefcn/ls-mat5.h, libinterp/corefcn/ls-oct-ascii.cc, libinterp/corefcn/ls-oct-ascii.h, libinterp/corefcn/ls-oct-binary.cc, libinterp/corefcn/ls-oct-binary.h, libinterp/corefcn/ls-utils.cc, libinterp/corefcn/ls-utils.h, libinterp/corefcn/matherr.c, libinterp/corefcn/mex.cc, libinterp/corefcn/mex.h, libinterp/corefcn/mexproto.h, libinterp/corefcn/mxarray.in.h, libinterp/corefcn/oct-errno.h, libinterp/corefcn/oct-errno.in.cc, libinterp/corefcn/oct-fstrm.cc, libinterp/corefcn/oct-fstrm.h, libinterp/corefcn/oct-hdf5.h, libinterp/corefcn/oct-hist.cc, libinterp/corefcn/oct-hist.h, libinterp/corefcn/oct-iostrm.cc, libinterp/corefcn/oct-iostrm.h, libinterp/corefcn/oct-lvalue.cc, libinterp/corefcn/oct-lvalue.h, libinterp/corefcn/oct-map.cc, libinterp/corefcn/oct-map.h, libinterp/corefcn/oct-obj.cc, libinterp/corefcn/oct-obj.h, libinterp/corefcn/oct-prcstrm.cc, libinterp/corefcn/oct-prcstrm.h, libinterp/corefcn/oct-procbuf.cc, libinterp/corefcn/oct-procbuf.h, libinterp/corefcn/oct-stdstrm.h, libinterp/corefcn/oct-stream.cc, libinterp/corefcn/oct-stream.h, libinterp/corefcn/oct-strstrm.cc, libinterp/corefcn/oct-strstrm.h, libinterp/corefcn/oct.h, libinterp/corefcn/octave-link.cc, libinterp/corefcn/octave-link.h, libinterp/corefcn/pager.cc, libinterp/corefcn/pager.h, libinterp/corefcn/pr-output.cc, libinterp/corefcn/pr-output.h, libinterp/corefcn/procstream.cc, libinterp/corefcn/procstream.h, libinterp/corefcn/profiler.cc, libinterp/corefcn/profiler.h, libinterp/corefcn/pt-jit.cc, libinterp/corefcn/pt-jit.h, libinterp/corefcn/sighandlers.cc, libinterp/corefcn/sighandlers.h, libinterp/corefcn/siglist.c, libinterp/corefcn/siglist.h, libinterp/corefcn/sparse-xdiv.cc, libinterp/corefcn/sparse-xdiv.h, libinterp/corefcn/sparse-xpow.cc, libinterp/corefcn/sparse-xpow.h, libinterp/corefcn/symtab.cc, libinterp/corefcn/symtab.h, libinterp/corefcn/sysdep.cc, libinterp/corefcn/sysdep.h, libinterp/corefcn/toplev.cc, libinterp/corefcn/toplev.h, libinterp/corefcn/txt-eng-ft.cc, libinterp/corefcn/txt-eng-ft.h, libinterp/corefcn/txt-eng.h, libinterp/corefcn/unwind-prot.cc, libinterp/corefcn/unwind-prot.h, libinterp/corefcn/utils.cc, libinterp/corefcn/utils.h, libinterp/corefcn/variables.cc, libinterp/corefcn/variables.h, libinterp/corefcn/workspace-element.h, libinterp/corefcn/xdiv.cc, libinterp/corefcn/xdiv.h, libinterp/corefcn/xgl2ps.c, libinterp/corefcn/xnorm.cc, libinterp/corefcn/xnorm.h, libinterp/corefcn/xpow.cc, libinterp/corefcn/xpow.h, libinterp/corefcn/zfstream.cc, libinterp/corefcn/zfstream.h: Files moved from interp-core and interpfcn directories. * libinterp/interp-core/Cell.cc, libinterp/interp-core/Cell.h, libinterp/interp-core/action-container.h, libinterp/interp-core/c-file-ptr-stream.cc, libinterp/interp-core/c-file-ptr-stream.h, libinterp/interp-core/comment-list.cc, libinterp/interp-core/comment-list.h, libinterp/interp-core/cutils.c, libinterp/interp-core/cutils.h, libinterp/interp-core/defun-dld.h, libinterp/interp-core/defun-int.h, libinterp/interp-core/display.cc, libinterp/interp-core/display.h, libinterp/interp-core/dynamic-ld.cc, libinterp/interp-core/dynamic-ld.h, libinterp/interp-core/event-queue.h, libinterp/interp-core/gl-render.cc, libinterp/interp-core/gl-render.h, libinterp/interp-core/gl2ps-renderer.cc, libinterp/interp-core/gl2ps-renderer.h, libinterp/interp-core/gl2ps.c, libinterp/interp-core/gl2ps.h, libinterp/interp-core/gripes.cc, libinterp/interp-core/gripes.h, libinterp/interp-core/jit-ir.cc, libinterp/interp-core/jit-ir.h, libinterp/interp-core/jit-typeinfo.cc, libinterp/interp-core/jit-typeinfo.h, libinterp/interp-core/jit-util.cc, libinterp/interp-core/jit-util.h, libinterp/interp-core/ls-ascii-helper.cc, libinterp/interp-core/ls-ascii-helper.h, libinterp/interp-core/ls-hdf5.cc, libinterp/interp-core/ls-hdf5.h, libinterp/interp-core/ls-mat-ascii.cc, libinterp/interp-core/ls-mat-ascii.h, libinterp/interp-core/ls-mat4.cc, libinterp/interp-core/ls-mat4.h, libinterp/interp-core/ls-mat5.cc, libinterp/interp-core/ls-mat5.h, libinterp/interp-core/ls-oct-binary.cc, libinterp/interp-core/ls-oct-binary.h, libinterp/interp-core/ls-utils.cc, libinterp/interp-core/ls-utils.h, libinterp/interp-core/matherr.c, libinterp/interp-core/mex.cc, libinterp/interp-core/mex.h, libinterp/interp-core/mexproto.h, libinterp/interp-core/module.mk, libinterp/interp-core/mxarray.in.h, libinterp/interp-core/oct-errno.h, libinterp/interp-core/oct-errno.in.cc, libinterp/interp-core/oct-fstrm.cc, libinterp/interp-core/oct-fstrm.h, libinterp/interp-core/oct-hdf5.h, libinterp/interp-core/oct-iostrm.cc, libinterp/interp-core/oct-iostrm.h, libinterp/interp-core/oct-lvalue.cc, libinterp/interp-core/oct-lvalue.h, libinterp/interp-core/oct-map.cc, libinterp/interp-core/oct-map.h, libinterp/interp-core/oct-obj.cc, libinterp/interp-core/oct-obj.h, libinterp/interp-core/oct-prcstrm.cc, libinterp/interp-core/oct-prcstrm.h, libinterp/interp-core/oct-procbuf.cc, libinterp/interp-core/oct-procbuf.h, libinterp/interp-core/oct-stdstrm.h, libinterp/interp-core/oct-stream.cc, libinterp/interp-core/oct-stream.h, libinterp/interp-core/oct-strstrm.cc, libinterp/interp-core/oct-strstrm.h, libinterp/interp-core/oct.h, libinterp/interp-core/procstream.cc, libinterp/interp-core/procstream.h, libinterp/interp-core/pt-jit.cc, libinterp/interp-core/pt-jit.h, libinterp/interp-core/siglist.c, libinterp/interp-core/siglist.h, libinterp/interp-core/sparse-xdiv.cc, libinterp/interp-core/sparse-xdiv.h, libinterp/interp-core/sparse-xpow.cc, libinterp/interp-core/sparse-xpow.h, libinterp/interp-core/txt-eng-ft.cc, libinterp/interp-core/txt-eng-ft.h, libinterp/interp-core/txt-eng.h, libinterp/interp-core/unwind-prot.cc, libinterp/interp-core/unwind-prot.h, libinterp/interp-core/xdiv.cc, libinterp/interp-core/xdiv.h, libinterp/interp-core/xgl2ps.c, libinterp/interp-core/xnorm.cc, libinterp/interp-core/xnorm.h, libinterp/interp-core/xpow.cc, libinterp/interp-core/xpow.h, libinterp/interp-core/zfstream.cc, libinterp/interp-core/zfstream.h, libinterp/interpfcn/data.cc, libinterp/interpfcn/data.h, libinterp/interpfcn/debug.cc, libinterp/interpfcn/debug.h, libinterp/interpfcn/defaults.cc, libinterp/interpfcn/defaults.in.h, libinterp/interpfcn/defun.cc, libinterp/interpfcn/defun.h, libinterp/interpfcn/dirfns.cc, libinterp/interpfcn/dirfns.h, libinterp/interpfcn/error.cc, libinterp/interpfcn/error.h, libinterp/interpfcn/file-io.cc, libinterp/interpfcn/file-io.h, libinterp/interpfcn/graphics.cc, libinterp/interpfcn/graphics.in.h, libinterp/interpfcn/help.cc, libinterp/interpfcn/help.h, libinterp/interpfcn/hook-fcn.cc, libinterp/interpfcn/hook-fcn.h, libinterp/interpfcn/input.cc, libinterp/interpfcn/input.h, libinterp/interpfcn/load-path.cc, libinterp/interpfcn/load-path.h, libinterp/interpfcn/load-save.cc, libinterp/interpfcn/load-save.h, libinterp/interpfcn/ls-oct-ascii.cc, libinterp/interpfcn/ls-oct-ascii.h, libinterp/interpfcn/module.mk, libinterp/interpfcn/oct-hist.cc, libinterp/interpfcn/oct-hist.h, libinterp/interpfcn/octave-link.cc, libinterp/interpfcn/octave-link.h, libinterp/interpfcn/pager.cc, libinterp/interpfcn/pager.h, libinterp/interpfcn/pr-output.cc, libinterp/interpfcn/pr-output.h, libinterp/interpfcn/profiler.cc, libinterp/interpfcn/profiler.h, libinterp/interpfcn/sighandlers.cc, libinterp/interpfcn/sighandlers.h, libinterp/interpfcn/symtab.cc, libinterp/interpfcn/symtab.h, libinterp/interpfcn/sysdep.cc, libinterp/interpfcn/sysdep.h, libinterp/interpfcn/toplev.cc, libinterp/interpfcn/toplev.h, libinterp/interpfcn/utils.cc, libinterp/interpfcn/utils.h, libinterp/interpfcn/variables.cc, libinterp/interpfcn/variables.h, libinterp/interpfcn/workspace-element.h: deleted files. diff -r 486c3e2731ff -r 68fc671a9339 libgui/src/module.mk --- a/libgui/src/module.mk Wed Jul 03 13:48:49 2013 -0700 +++ b/libgui/src/module.mk Wed Jul 03 17:43:48 2013 -0700 @@ -177,8 +177,7 @@ -I$(top_srcdir)/liboctave/util \ -I$(top_builddir)/libinterp -I$(top_srcdir)/libinterp \ -I$(top_builddir)/libinterp/parse-tree -I$(top_srcdir)/libinterp/parse-tree \ - -I$(top_builddir)/libinterp/interp-core -I$(top_srcdir)/libinterp/interp-core \ - -I$(top_builddir)/libinterp/interpfcn -I$(top_srcdir)/libinterp/interpfcn \ + -I$(top_builddir)/libinterp/corefcn -I$(top_srcdir)/libinterp/corefcn \ -I$(top_srcdir)/libinterp/octave-value src_libgui_src_la_CFLAGS = $(AM_CFLAGS) $(WARN_CFLAGS) diff -r 486c3e2731ff -r 68fc671a9339 libinterp/Makefile.am --- a/libinterp/Makefile.am Wed Jul 03 13:48:49 2013 -0700 +++ b/libinterp/Makefile.am Wed Jul 03 17:43:48 2013 -0700 @@ -33,9 +33,7 @@ -I$(srcdir)/octave-value \ -I$(srcdir)/operators \ -Iparse-tree -I$(srcdir)/parse-tree \ - -Iinterp-core -I$(srcdir)/interp-core \ - -Iinterpfcn -I$(srcdir)/interpfcn \ - -Icorefcn \ + -Icorefcn -I$(srcdir)/corefcn \ -I$(top_builddir)/libgnu -I$(top_srcdir)/libgnu AM_CFLAGS += $(WARN_CFLAGS) @@ -48,11 +46,11 @@ ## $(DEF_FILES), and building those requires all the sources ## (except builtins.cc) to be available. BUILT_SOURCES = \ - interp-core/mxarray.h \ - interp-core/oct-errno.cc \ - interpfcn/defaults.h \ - interpfcn/graphics-props.cc \ - interpfcn/graphics.h \ + corefcn/mxarray.h \ + corefcn/oct-errno.cc \ + corefcn/defaults.h \ + corefcn/graphics-props.cc \ + corefcn/graphics.h \ operators/ops.cc \ parse-tree/lex.cc \ parse-tree/oct-gperf.h \ @@ -71,10 +69,10 @@ ## Files that are created during build process and installed, ## BUT not distributed in tarball. BUILT_NODISTFILES = \ - interp-core/mxarray.h \ - interp-core/oct-errno.cc \ - interpfcn/defaults.h \ - interpfcn/graphics.h \ + corefcn/mxarray.h \ + corefcn/oct-errno.cc \ + corefcn/defaults.h \ + corefcn/graphics.h \ builtin-defun-decls.h \ operators/ops.cc \ oct-conf.h \ @@ -103,7 +101,7 @@ $(BUILT_DISTFILES) octinclude_HEADERS = \ - interpfcn/graphics-props.cc \ + corefcn/graphics-props.cc \ parse-tree/oct-gperf.h \ builtins.h \ builtin-defun-decls.h \ @@ -112,13 +110,12 @@ $(PARSE_TREE_INC) \ $(PARSER_INC) \ $(OPERATORS_INC) \ - $(INTERP_CORE_INC) \ - $(INTERPFCN_INC) + $(COREFCN_INC) nodist_octinclude_HEADERS = \ - interp-core/mxarray.h \ - interpfcn/defaults.h \ - interpfcn/graphics.h \ + corefcn/mxarray.h \ + corefcn/defaults.h \ + corefcn/graphics.h \ oct-conf.h \ version.h @@ -127,8 +124,6 @@ $(OCTAVE_VALUE_SRC) \ $(PARSE_TREE_SRC) \ $(PARSER_SRC) \ - $(INTERP_CORE_SRC) \ - $(INTERPFCN_SRC) \ $(COREFCN_SRC) noinst_LTLIBRARIES = @@ -137,8 +132,6 @@ include octave-value/module.mk include operators/module.mk include template-inst/module.mk -include interp-core/module.mk -include interpfcn/module.mk include corefcn/module.mk include dldfcn/module.mk @@ -161,10 +154,10 @@ $(TEMPLATE_INST_SRC) nodist_liboctinterp_la_SOURCES = \ - interp-core/mxarray.h \ - interp-core/oct-errno.cc \ - interpfcn/defaults.h \ - interpfcn/graphics.h \ + corefcn/mxarray.h \ + corefcn/oct-errno.cc \ + corefcn/defaults.h \ + corefcn/graphics.h \ operators/ops.cc \ builtin-defun-decls.h \ builtins.cc \ @@ -181,8 +174,6 @@ octave-value/liboctave-value.la \ parse-tree/libparse-tree.la \ parse-tree/libparser.la \ - interp-core/libinterp-core.la \ - interpfcn/libinterpfcn.la \ corefcn/libcorefcn.la \ $(top_builddir)/liboctave/liboctave.la \ $(LIBOCTINTERP_LINK_DEPS) @@ -365,7 +356,7 @@ CLEANFILES = \ $(DLDFCN_PKG_ADD_FILE) \ - interpfcn/graphics-props.cc \ + corefcn/graphics-props.cc \ parse-tree/oct-parse.output DISTCLEANFILES = \ diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/Cell.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/Cell.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,320 @@ +/* + +Copyright (C) 1999-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "idx-vector.h" + +#include "Cell.h" +#include "error.h" +#include "gripes.h" +#include "oct-obj.h" + +Cell::Cell (const octave_value_list& ovl) + : Array (ovl.cell_value ()) +{ +} + +Cell::Cell (const string_vector& sv, bool trim) + : Array () +{ + octave_idx_type n = sv.length (); + + if (n > 0) + { + resize (dim_vector (n, 1)); + + for (octave_idx_type i = 0; i < n; i++) + { + std::string s = sv[i]; + + if (trim) + { + size_t pos = s.find_last_not_of (' '); + + s = (pos == std::string::npos) ? "" : s.substr (0, pos+1); + } + + elem(i,0) = s; + } + } +} + +Cell::Cell (const std::list& lst) + : Array () +{ + size_t n = lst.size (); + + if (n > 0) + { + resize (dim_vector (n, 1)); + + octave_idx_type i = 0; + + for (std::list::const_iterator it = lst.begin (); + it != lst.end (); it++) + { + elem(i++,0) = *it; + } + } +} + +Cell::Cell (const Array& sa) + : Array (sa.dims ()) +{ + octave_idx_type n = sa.numel (); + + octave_value *dst = fortran_vec (); + const std::string *src = sa.data (); + + for (octave_idx_type i = 0; i < n; i++) + dst[i] = src[i]; +} + +// Set size to DV, filling with []. Then fill with as many elements of +// SV as possible. + +Cell::Cell (const dim_vector& dv, const string_vector& sv, bool trim) + : Array (dv, Matrix ()) +{ + octave_idx_type n = sv.length (); + + if (n > 0) + { + octave_idx_type m = numel (); + + octave_idx_type len = n > m ? m : n; + + for (octave_idx_type i = 0; i < len; i++) + { + std::string s = sv[i]; + + if (trim) + { + size_t pos = s.find_last_not_of (' '); + + s = (pos == std::string::npos) ? "" : s.substr (0, pos+1); + } + + elem(i) = s; + } + } +} + +bool +Cell::is_cellstr (void) const +{ + bool retval = true; + + octave_idx_type n = numel (); + + for (octave_idx_type i = 0; i < n; i++) + { + if (! elem(i).is_string ()) + { + retval = false; + break; + } + } + + return retval; +} + +Array +Cell::cellstr_value (void) const +{ + Array retval (dims ()); + + octave_idx_type n = numel (); + + for (octave_idx_type i = 0; i < n; i++) + retval.xelem (i) = elem (i).string_value (); + + return retval; +} + +Cell +Cell::index (const octave_value_list& idx_arg, bool resize_ok) const +{ + Cell retval; + + octave_idx_type n = idx_arg.length (); + + switch (n) + { + case 0: + retval = *this; + break; + + case 1: + { + idx_vector i = idx_arg(0).index_vector (); + + if (! error_state) + retval = Array::index (i, resize_ok, Matrix ()); + } + break; + + case 2: + { + idx_vector i = idx_arg(0).index_vector (); + + if (! error_state) + { + idx_vector j = idx_arg(1).index_vector (); + + if (! error_state) + retval = Array::index (i, j, resize_ok, Matrix ()); + } + } + break; + + default: + { + Array iv (dim_vector (n, 1)); + + for (octave_idx_type i = 0; i < n; i++) + { + iv(i) = idx_arg(i).index_vector (); + + if (error_state) + break; + } + + if (!error_state) + retval = Array::index (iv, resize_ok, Matrix ()); + } + break; + } + + return retval; +} + +void +Cell::assign (const octave_value_list& idx_arg, const Cell& rhs, + const octave_value& fill_val) + +{ + octave_idx_type len = idx_arg.length (); + + Array ra_idx (dim_vector (len, 1)); + + for (octave_idx_type i = 0; i < len; i++) + ra_idx(i) = idx_arg(i).index_vector (); + + Array::assign (ra_idx, rhs, fill_val); +} + +void +Cell::delete_elements (const octave_value_list& idx_arg) + +{ + octave_idx_type len = idx_arg.length (); + + Array ra_idx (dim_vector (len, 1)); + + for (octave_idx_type i = 0; i < len; i++) + ra_idx.xelem (i) = idx_arg(i).index_vector (); + + Array::delete_elements (ra_idx); +} + +octave_idx_type +Cell::nnz (void) const +{ + gripe_wrong_type_arg ("nnz", "cell array"); + return -1; +} + +Cell +Cell::column (octave_idx_type i) const +{ + Cell retval; + + if (ndims () < 3) + { + if (i < 0 || i >= cols ()) + error ("invalid column selection"); + else + { + octave_idx_type nr = rows (); + + retval.resize (dim_vector (nr, 1)); + + for (octave_idx_type j = 0; j < nr; j++) + retval.xelem (j) = elem (j, i); + } + } + else + error ("Cell::column: requires 2-d cell array"); + + return retval; +} + +Cell +Cell::concat (const Cell& rb, const Array& ra_idx) +{ + return insert (rb, ra_idx); +} + +Cell& +Cell::insert (const Cell& a, octave_idx_type r, octave_idx_type c) +{ + Array::insert (a, r, c); + return *this; +} + +Cell& +Cell::insert (const Cell& a, const Array& ra_idx) +{ + Array::insert (a, ra_idx); + return *this; +} + +Cell +Cell::map (ctype_mapper fcn) const +{ + Cell retval (dims ()); + octave_value *r = retval.fortran_vec (); + + const octave_value *p = data (); + + for (octave_idx_type i = 0; i < numel (); i++) + r[i] = ((p++)->*fcn) (); + + return retval; +} + +Cell +Cell::diag (octave_idx_type k) const +{ + return Array::diag (k); +} + +Cell +Cell::diag (octave_idx_type m, octave_idx_type n) const +{ + return Array::diag (m, n); +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/Cell.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/Cell.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,150 @@ +/* + +Copyright (C) 1999-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (Cell_h) +#define Cell_h 1 + +#include + +#include "Array.h" +#include "oct-alloc.h" +#include "str-vec.h" +#include "ov.h" + +class octave_value_list; + +class +OCTINTERP_API +Cell : public Array +{ +public: + + Cell (void) + : Array (dim_vector (0, 0)) { } + + Cell (const octave_value& val) + : Array (dim_vector (1, 1), val) { } + + Cell (const octave_value_list& ovl); + + Cell (octave_idx_type n, octave_idx_type m, + const octave_value& val = Matrix ()) + : Array (dim_vector (n, m), val) { } + + Cell (const dim_vector& dv, const octave_value& val = Matrix ()) + : Array (dv, val) { } + + Cell (const Array& c) + : Array (c) { } + + Cell (const Array& c, octave_idx_type nr, octave_idx_type nc) + : Array (c, dim_vector (nr, nc)) { } + + Cell (const string_vector& sv, bool trim = false); + + Cell (const std::list& lst); + + Cell (const Array& sa); + + Cell (const dim_vector& dv, const string_vector& sv, bool trim = false); + + Cell (const Cell& c) + : Array (c) { } + + bool is_cellstr (void) const; + + Array cellstr_value (void) const; + + using Array::index; + + Cell index (const octave_value_list& idx, bool resize_ok = false) const; + + using Array::delete_elements; + + void delete_elements (const octave_value_list& idx); + + using Array::assign; + + void assign (const octave_value_list& idx, const Cell& rhs, + const octave_value& fill_val = Matrix ()); + + Cell reshape (const dim_vector& new_dims) const + { return Array::reshape (new_dims); } + + octave_idx_type nnz (void) const; + + Cell column (octave_idx_type i) const; + + // FIXME + boolMatrix all (int /* dim */ = 0) const { return boolMatrix (); } + + // FIXME + boolMatrix any (int /* dim */ = 0) const { return boolMatrix (); } + + Cell concat (const Cell& rb, const Array& ra_idx); + + Cell& insert (const Cell& a, octave_idx_type r, octave_idx_type c); + Cell& insert (const Cell& a, const Array& ra_idx); + + // FIXME + bool any_element_is_nan (void) const { return false; } + bool is_true (void) const { return false; } + + octave_value resize_fill_value (void) const + { + static Matrix rfv; + return rfv; + } + + Cell diag (octave_idx_type k = 0) const; + + Cell diag (octave_idx_type m, octave_idx_type n) const; + + Cell xisalnum (void) const { return map (&octave_value::xisalnum); } + Cell xisalpha (void) const { return map (&octave_value::xisalpha); } + Cell xisascii (void) const { return map (&octave_value::xisascii); } + Cell xiscntrl (void) const { return map (&octave_value::xiscntrl); } + Cell xisdigit (void) const { return map (&octave_value::xisdigit); } + Cell xisgraph (void) const { return map (&octave_value::xisgraph); } + Cell xislower (void) const { return map (&octave_value::xislower); } + Cell xisprint (void) const { return map (&octave_value::xisprint); } + Cell xispunct (void) const { return map (&octave_value::xispunct); } + Cell xisspace (void) const { return map (&octave_value::xisspace); } + Cell xisupper (void) const { return map (&octave_value::xisupper); } + Cell xisxdigit (void) const { return map (&octave_value::xisxdigit); } + Cell xtoascii (void) const { return map (&octave_value::xtoascii); } + Cell xtolower (void) const { return map (&octave_value::xtolower); } + Cell xtoupper (void) const { return map (&octave_value::xtoupper); } + +private: + + typedef octave_value (octave_value::*ctype_mapper) (void) const; + + Cell map (ctype_mapper) const; +}; + +template<> +inline Cell octave_value_extract (const octave_value& v) + { return v.cell_value (); } + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/action-container.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/action-container.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,341 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_action_container_h) +#define octave_action_container_h 1 + +// This class allows registering actions in a list for later +// execution, either explicitly or when the container goes out of +// scope. + +// FIXME -- is there a better name for this class? + +class +action_container +{ +public: + + // A generic unwind_protect element. Knows how to run itself and + // discard itself. Also, contains a pointer to the next element. + class elem + { + public: + elem (void) { } + + virtual void run (void) { } + + virtual ~elem (void) { } + + friend class action_container; + + private: + + // No copying! + + elem (const elem&); + + elem& operator = (const elem&); + }; + + // An element that merely runs a void (*)(void) function. + + class fcn_elem : public elem + { + public: + fcn_elem (void (*fptr) (void)) + : e_fptr (fptr) { } + + void run (void) { e_fptr (); } + + private: + void (*e_fptr) (void); + }; + + // An element that stores a variable of type T along with a void (*) (T) + // function pointer, and calls the function with the parameter. + + template + class fcn_arg_elem : public elem + { + public: + fcn_arg_elem (void (*fcn) (T), T arg) + : e_fcn (fcn), e_arg (arg) { } + + void run (void) { e_fcn (e_arg); } + + private: + + // No copying! + + fcn_arg_elem (const fcn_arg_elem&); + + fcn_arg_elem& operator = (const fcn_arg_elem&); + + void (*e_fcn) (T); + T e_arg; + }; + + // An element that stores a variable of type T along with a + // void (*) (const T&) function pointer, and calls the function with + // the parameter. + + template + class fcn_crefarg_elem : public elem + { + public: + fcn_crefarg_elem (void (*fcn) (const T&), const T& arg) + : e_fcn (fcn), e_arg (arg) { } + + void run (void) { e_fcn (e_arg); } + + private: + void (*e_fcn) (const T&); + T e_arg; + }; + + // An element for calling a member function. + + template + class method_elem : public elem + { + public: + method_elem (T *obj, void (T::*method) (void)) + : e_obj (obj), e_method (method) { } + + void run (void) { (e_obj->*e_method) (); } + + private: + + T *e_obj; + void (T::*e_method) (void); + + // No copying! + + method_elem (const method_elem&); + + method_elem operator = (const method_elem&); + }; + + // An element for calling a member function with a single argument + + template + class method_arg_elem : public elem + { + public: + method_arg_elem (T *obj, void (T::*method) (A), A arg) + : e_obj (obj), e_method (method), e_arg (arg) { } + + void run (void) { (e_obj->*e_method) (e_arg); } + + private: + + T *e_obj; + void (T::*e_method) (A); + A e_arg; + + // No copying! + + method_arg_elem (const method_arg_elem&); + + method_arg_elem operator = (const method_arg_elem&); + }; + + // An element for calling a member function with a single argument + + template + class method_crefarg_elem : public elem + { + public: + method_crefarg_elem (T *obj, void (T::*method) (const A&), const A& arg) + : e_obj (obj), e_method (method), e_arg (arg) { } + + void run (void) { (e_obj->*e_method) (e_arg); } + + private: + + T *e_obj; + void (T::*e_method) (const A&); + A e_arg; + + // No copying! + + method_crefarg_elem (const method_crefarg_elem&); + + method_crefarg_elem operator = (const method_crefarg_elem&); + }; + + // An element that stores arbitrary variable, and restores it. + + template + class restore_var_elem : public elem + { + public: + restore_var_elem (T& ref, const T& val) + : e_ptr (&ref), e_val (val) { } + + void run (void) { *e_ptr = e_val; } + + private: + + // No copying! + + restore_var_elem (const restore_var_elem&); + + restore_var_elem& operator = (const restore_var_elem&); + + T *e_ptr, e_val; + }; + + // Deletes a class allocated using new. + + template + class delete_ptr_elem : public elem + { + public: + delete_ptr_elem (T *ptr) + : e_ptr (ptr) { } + + void run (void) { delete e_ptr; } + + private: + + T *e_ptr; + + // No copying! + + delete_ptr_elem (const delete_ptr_elem&); + + delete_ptr_elem operator = (const delete_ptr_elem&); + }; + + action_container (void) { } + + virtual ~action_container (void) { } + + virtual void add (elem *new_elem) = 0; + + // Call to void func (void). + void add_fcn (void (*fcn) (void)) + { + add (new fcn_elem (fcn)); + } + + // Call to void func (T). + template + void add_fcn (void (*action) (T), T val) + { + add (new fcn_arg_elem (action, val)); + } + + // Call to void func (const T&). + template + void add_fcn (void (*action) (const T&), const T& val) + { + add (new fcn_crefarg_elem (action, val)); + } + + // Call to T::method (void). + template + void add_method (T *obj, void (T::*method) (void)) + { + add (new method_elem (obj, method)); + } + + // Call to T::method (A). + template + void add_method (T *obj, void (T::*method) (A), A arg) + { + add (new method_arg_elem (obj, method, arg)); + } + + // Call to T::method (const A&). + template + void add_method (T *obj, void (T::*method) (const A&), const A& arg) + { + add (new method_crefarg_elem (obj, method, arg)); + } + + // Call to delete (T*). + + template + void add_delete (T *obj) + { + add (new delete_ptr_elem (obj)); + } + + // Protect any variable. + template + void protect_var (T& var) + { + add (new restore_var_elem (var, var)); + } + + // Protect any variable, value given. + template + void protect_var (T& var, const T& val) + { + add (new restore_var_elem (var, val)); + } + + operator bool (void) const { return ! empty (); } + + virtual void run_first (void) = 0; + + void run (size_t num) + { + if (num > size ()) + num = size (); + + for (size_t i = 0; i < num; i++) + run_first (); + } + + void run (void) { run (size ()); } + + virtual void discard_first (void) = 0; + + void discard (size_t num) + { + if (num > size ()) + num = size (); + + for (size_t i = 0; i < num; i++) + discard_first (); + } + + void discard (void) { discard (size ()); } + + virtual size_t size (void) const = 0; + + bool empty (void) const { return size () == 0; } + +private: + + // No copying! + + action_container (const action_container&); + + action_container& operator = (const action_container&); +}; + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/c-file-ptr-stream.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/c-file-ptr-stream.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,362 @@ +/* + +Copyright (C) 2000-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "c-file-ptr-stream.h" + +#ifndef SEEK_SET +#define SEEK_SET 0 +#endif + +#ifndef SEEK_CUR +#define SEEK_CUR 1 +#endif + +#ifndef SEEK_END +#define SEEK_END 2 +#endif + +c_file_ptr_buf::~c_file_ptr_buf (void) +{ + buf_close (); +} + +// FIXME -- I'm sure there is room for improvement here... + +c_file_ptr_buf::int_type +c_file_ptr_buf::overflow (int_type c) +{ +#if defined (CXX_ISO_COMPLIANT_LIBRARY) + if (f) + return (c != traits_type::eof ()) ? gnulib::fputc (c, f) : flush (); + else + return traits_type::not_eof (c); +#else + if (f) + return (c != EOF) ? gnulib::fputc (c, f) : flush (); + else + return EOF; +#endif +} + +c_file_ptr_buf::int_type +c_file_ptr_buf::underflow_common (bool bump) +{ + if (f) + { + int_type c = gnulib::fgetc (f); + + if (! bump +#if defined (CXX_ISO_COMPLIANT_LIBRARY) + && c != traits_type::eof ()) +#else + && c != EOF) +#endif + ungetc (c, f); + + return c; + } + else +#if defined (CXX_ISO_COMPLIANT_LIBRARY) + return traits_type::eof (); +#else + return EOF; +#endif +} + +c_file_ptr_buf::int_type +c_file_ptr_buf::pbackfail (int_type c) +{ +#if defined (CXX_ISO_COMPLIANT_LIBRARY) + return (c != traits_type::eof () && f) ? ungetc (c, f) : + traits_type::not_eof (c); +#else + return (c != EOF && f) ? ungetc (c, f) : EOF; +#endif +} + +std::streamsize +c_file_ptr_buf::xsputn (const char* s, std::streamsize n) +{ + if (f) + return gnulib::fwrite (s, 1, n, f); + else + return 0; +} + +std::streamsize +c_file_ptr_buf::xsgetn (char *s, std::streamsize n) +{ + if (f) + return gnulib::fread (s, 1, n, f); + else + return 0; +} + +static inline int +seekdir_to_whence (std::ios::seekdir dir) +{ + return ((dir == std::ios::beg) ? SEEK_SET : + (dir == std::ios::cur) ? SEEK_CUR : + (dir == std::ios::end) ? SEEK_END : + dir); +} + +std::streampos +c_file_ptr_buf::seekoff (std::streamoff /* offset */, + std::ios::seekdir /* dir */, + std::ios::openmode) +{ + // FIXME +#if 0 + if (f) + { + fseek (f, offset, seekdir_to_whence (dir)); + + return ftell (f); + } + else + return 0; +#endif + return -1; +} + +std::streampos +c_file_ptr_buf::seekpos (std::streampos /* offset */, std::ios::openmode) +{ + // FIXME +#if 0 + if (f) + { + fseek (f, offset, SEEK_SET); + + return ftell (f); + } + else + return 0; +#endif + return -1; +} + +int +c_file_ptr_buf::sync (void) +{ + flush (); + + return 0; +} + +int +c_file_ptr_buf::flush (void) +{ + return f ? gnulib::fflush (f) : EOF; +} + +int +c_file_ptr_buf::buf_close (void) +{ + int retval = -1; + + flush (); + + if (f) + { + retval = cf (f); + f = 0; + } + + return retval; +} + +int +c_file_ptr_buf::seek (off_t offset, int origin) +{ + return f ? gnulib::fseeko (f, offset, origin) : -1; +} + +off_t +c_file_ptr_buf::tell (void) +{ + return f ? gnulib::ftello (f) : -1; +} + +int +c_file_ptr_buf::file_close (FILE *f) +{ + return gnulib::fclose (f); +} + +#ifdef HAVE_ZLIB + +c_zfile_ptr_buf::~c_zfile_ptr_buf (void) +{ + buf_close (); +} + +// FIXME -- I'm sure there is room for improvement here... + +c_zfile_ptr_buf::int_type +c_zfile_ptr_buf::overflow (int_type c) +{ +#if defined (CXX_ISO_COMPLIANT_LIBRARY) + if (f) + return (c != traits_type::eof ()) ? gzputc (f, c) : flush (); + else + return traits_type::not_eof (c); +#else + if (f) + return (c != EOF) ? gzputc (f, c) : flush (); + else + return EOF; +#endif +} + +c_zfile_ptr_buf::int_type +c_zfile_ptr_buf::underflow_common (bool bump) +{ + if (f) + { + int_type c = gzgetc (f); + + if (! bump +#if defined (CXX_ISO_COMPLIANT_LIBRARY) + && c != traits_type::eof ()) +#else + && c != EOF) +#endif + gzungetc (c, f); + + return c; + } + else +#if defined (CXX_ISO_COMPLIANT_LIBRARY) + return traits_type::eof (); +#else + return EOF; +#endif +} + +c_zfile_ptr_buf::int_type +c_zfile_ptr_buf::pbackfail (int_type c) +{ +#if defined (CXX_ISO_COMPLIANT_LIBRARY) + return (c != traits_type::eof () && f) ? gzungetc (c, f) : + traits_type::not_eof (c); +#else + return (c != EOF && f) ? gzungetc (c, f) : EOF; +#endif +} + +std::streamsize +c_zfile_ptr_buf::xsputn (const char* s, std::streamsize n) +{ + if (f) + return gzwrite (f, s, n); + else + return 0; +} + +std::streamsize +c_zfile_ptr_buf::xsgetn (char *s, std::streamsize n) +{ + if (f) + return gzread (f, s, n); + else + return 0; +} + +std::streampos +c_zfile_ptr_buf::seekoff (std::streamoff /* offset */, + std::ios::seekdir /* dir */, + std::ios::openmode) +{ + // FIXME +#if 0 + if (f) + { + gzseek (f, offset, seekdir_to_whence (dir)); + + return gztell (f); + } + else + return 0; +#endif + return -1; +} + +std::streampos +c_zfile_ptr_buf::seekpos (std::streampos /* offset */, std::ios::openmode) +{ + // FIXME +#if 0 + if (f) + { + gzseek (f, offset, SEEK_SET); + + return gztell (f); + } + else + return 0; +#endif + return -1; +} + +int +c_zfile_ptr_buf::sync (void) +{ + flush (); + + return 0; +} + +int +c_zfile_ptr_buf::flush (void) +{ + // FIXME -- do we need something more complex here, passing + // something other than 0 for the second argument to gzflush and + // checking the return value, etc.? + + return f ? gzflush (f, 0) : EOF; +} + +int +c_zfile_ptr_buf::buf_close (void) +{ + int retval = -1; + + flush (); + + if (f) + { + retval = cf (f); + f = 0; + } + + return retval; +} + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/c-file-ptr-stream.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/c-file-ptr-stream.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,227 @@ +/* + +Copyright (C) 2000-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_c_file_ptr_stream_h) +#define octave_c_file_ptr_stream_h 1 + +#include + +#include + +class +c_file_ptr_buf : public std::streambuf +{ +public: + +#if !defined (CXX_ISO_COMPLIANT_LIBRARY) + typedef int int_type; +#else + typedef std::streambuf::int_type int_type; +#endif + + typedef int (*close_fcn) (FILE *); + + FILE* stdiofile (void) { return f; } + + c_file_ptr_buf (FILE *f_arg, close_fcn cf_arg = file_close) + : std::streambuf (), f (f_arg), cf (cf_arg) + { } + + ~c_file_ptr_buf (void); + + int_type overflow (int_type); + + int_type underflow (void) { return underflow_common (false); } + + int_type uflow (void) { return underflow_common (true); } + + int_type pbackfail (int_type); + + std::streamsize xsputn (const char*, std::streamsize); + + std::streamsize xsgetn (char *, std::streamsize); + + std::streampos seekoff (std::streamoff, std::ios::seekdir, + std::ios::openmode = std::ios::in | std::ios::out); + + std::streampos seekpos (std::streampos, + std::ios::openmode = std::ios::in | std::ios::out); + + int sync (void); + + int flush (void); + + int buf_close (void); + + int file_number () const { return f ? fileno (f) : -1; } + + int seek (off_t offset, int origin); + + off_t tell (void); + + void clear (void) { if (f) clearerr (f); } + + static int file_close (FILE *f); + +protected: + + FILE *f; + + close_fcn cf; + +private: + + int_type underflow_common (bool); + + // No copying! + + c_file_ptr_buf (const c_file_ptr_buf&); + + c_file_ptr_buf& operator = (const c_file_ptr_buf&); +}; + +// FIXME -- the following three classes could probably share +// some code... + +template +class +c_file_ptr_stream : public STREAM_T +{ +public: + + c_file_ptr_stream (FILE_T f, typename BUF_T::close_fcn cf = BUF_T::file_close) + : STREAM_T (0), buf (new BUF_T (f, cf)) { STREAM_T::init (buf); } + + ~c_file_ptr_stream (void) { delete buf; buf = 0; } + + BUF_T *rdbuf (void) { return buf; } + + void stream_close (void) { if (buf) buf->buf_close (); } + + int seek (off_t offset, int origin) + { return buf ? buf->seek (offset, origin) : -1; } + + off_t tell (void) { return buf ? buf->tell () : -1; } + + void clear (void) { if (buf) buf->clear (); STREAM_T::clear (); } + +private: + + BUF_T *buf; + + // No copying! + + c_file_ptr_stream (const c_file_ptr_stream&); + + c_file_ptr_stream& operator = (const c_file_ptr_stream&); +}; + +typedef c_file_ptr_stream i_c_file_ptr_stream; +typedef c_file_ptr_stream o_c_file_ptr_stream; +typedef c_file_ptr_stream io_c_file_ptr_stream; + +#ifdef HAVE_ZLIB + +#ifdef HAVE_ZLIB_H +#include +#endif + +class +c_zfile_ptr_buf : public std::streambuf +{ +public: + +#if !defined (CXX_ISO_COMPLIANT_LIBRARY) + typedef int int_type; +#else + typedef std::streambuf::int_type int_type; +#endif + + typedef int (*close_fcn) (gzFile); + + gzFile stdiofile (void) { return f; } + + c_zfile_ptr_buf (gzFile f_arg, close_fcn cf_arg = file_close) + : std::streambuf (), f (f_arg), cf (cf_arg) + { } + + ~c_zfile_ptr_buf (void); + + int_type overflow (int_type); + + int_type underflow (void) { return underflow_common (false); } + + int_type uflow (void) { return underflow_common (true); } + + int_type pbackfail (int_type); + + std::streamsize xsputn (const char*, std::streamsize); + + std::streamsize xsgetn (char *, std::streamsize); + + std::streampos seekoff (std::streamoff, std::ios::seekdir, + std::ios::openmode = std::ios::in | std::ios::out); + + std::streampos seekpos (std::streampos, + std::ios::openmode = std::ios::in | std::ios::out); + + int sync (void); + + int flush (void); + + int buf_close (void); + + int file_number () const { return -1; } + + int seek (off_t offset, int origin) + { return f ? gzseek (f, offset, origin) >= 0 : -1; } + + off_t tell (void) { return f ? gztell (f) : -1; } + + void clear (void) { if (f) gzclearerr (f); } + + static int file_close (gzFile f) { return ::gzclose (f); } + +protected: + + gzFile f; + + close_fcn cf; + +private: + + int_type underflow_common (bool); + + // No copying! + + c_zfile_ptr_buf (const c_zfile_ptr_buf&); + + c_zfile_ptr_buf& operator = (const c_zfile_ptr_buf&); +}; + +typedef c_file_ptr_stream i_c_zfile_ptr_stream; +typedef c_file_ptr_stream o_c_zfile_ptr_stream; +typedef c_file_ptr_stream io_c_zfile_ptr_stream; + +#endif + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/comment-list.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/comment-list.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,106 @@ +/* + +Copyright (C) 2000-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "lo-utils.h" +#include "singleton-cleanup.h" + +#include "comment-list.h" +#include "error.h" + +octave_comment_buffer *octave_comment_buffer::instance = 0; + +octave_comment_list * +octave_comment_list::dup (void) const +{ + octave_comment_list *new_cl = new octave_comment_list (); + + for (const_iterator p = begin (); p != end (); p++) + { + const octave_comment_elt elt = *p; + + new_cl->append (elt); + } + + return new_cl; +} + +bool +octave_comment_buffer::instance_ok (void) +{ + bool retval = true; + + if (! instance) + { + instance = new octave_comment_buffer (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } + + if (! instance) + { + ::error ("unable to create comment buffer object"); + + retval = false; + } + + return retval; +} + +void +octave_comment_buffer::append (const std::string& s, + octave_comment_elt::comment_type t) +{ + if (instance_ok ()) + instance->do_append (s, t); +} + +octave_comment_list * +octave_comment_buffer::get_comment (void) +{ + return (instance_ok ()) ? instance->do_get_comment () : 0; +} + +void +octave_comment_buffer::do_append (const std::string& s, + octave_comment_elt::comment_type t) +{ + comment_list->append (s, t); +} + +octave_comment_list * +octave_comment_buffer::do_get_comment (void) +{ + octave_comment_list *retval = 0; + + if (comment_list && comment_list->length () > 0) + { + retval = comment_list; + comment_list = new octave_comment_list (); + } + + return retval; +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/comment-list.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/comment-list.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,132 @@ +/* + +Copyright (C) 2000-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_comment_list_h) +#define octave_comment_list_h 1 + +#include + +#include + +extern std::string get_comment_text (void); + +extern char *get_comment_text_c_str (void); + +extern void save_comment_text (const std::string& text); + +class +octave_comment_elt +{ +public: + + enum comment_type + { + unknown, + block, + full_line, + end_of_line, + doc_string, + copyright + }; + + octave_comment_elt (const std::string& s = std::string (), + comment_type t = unknown) + : txt (s), typ (t) { } + + octave_comment_elt (const octave_comment_elt& oc) + : txt (oc.txt), typ (oc.typ) { } + + octave_comment_elt& operator = (const octave_comment_elt& oc) + { + if (this != &oc) + { + txt = oc.txt; + typ = oc.typ; + } + + return *this; + } + + std::string text (void) const { return txt; } + + comment_type type (void) const { return typ; } + + ~octave_comment_elt (void) { } + +private: + + // The text of the comment. + std::string txt; + + // The type of comment. + comment_type typ; +}; + +class +octave_comment_list : public octave_base_list +{ +public: + + octave_comment_list (void) { } + + void append (const octave_comment_elt& elt) + { octave_base_list::append (elt); } + + void append (const std::string& s, + octave_comment_elt::comment_type t = octave_comment_elt::unknown) + { append (octave_comment_elt (s, t)); } + + octave_comment_list *dup (void) const; +}; + +class +octave_comment_buffer +{ +public: + + octave_comment_buffer (void) + : comment_list (new octave_comment_list ()) { } + + ~octave_comment_buffer (void) { delete comment_list; } + + static bool instance_ok (void); + + static void append + (const std::string& s, + octave_comment_elt::comment_type t = octave_comment_elt::unknown); + + static octave_comment_list *get_comment (void); + +private: + + void do_append (const std::string& s, octave_comment_elt::comment_type t); + + octave_comment_list *do_get_comment (void); + + octave_comment_list *comment_list; + + static octave_comment_buffer *instance; + + static void cleanup_instance (void) { delete instance; instance = 0; } +}; + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/cutils.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/cutils.c Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,60 @@ +/* + +Copyright (C) 1999-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include +#include + +#include "cutils.h" + +void +octave_sleep (unsigned int seconds) +{ + sleep (seconds); +} + +void +octave_usleep (unsigned int useconds) +{ + struct timespec delay; + struct timespec remaining; + + unsigned int sec = useconds / 1000000; + unsigned int usec = useconds % 1000000; + + delay.tv_sec = sec; + delay.tv_nsec = usec * 1000; + + nanosleep (&delay, &remaining); +} + +int +octave_raw_vsnprintf (char *buf, size_t n, const char *fmt, va_list args) +{ + return vsnprintf (buf, n, fmt, args); +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/cutils.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/cutils.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,43 @@ +/* + +Copyright (C) 2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_cutils_h) +#define octave_cutils_h 1 + +#include + +#ifdef __cplusplus +extern "C" { +#endif + +OCTINTERP_API void octave_sleep (unsigned int seconds); + +OCTINTERP_API void octave_usleep (unsigned int useconds); + +OCTINTERP_API int +octave_raw_vsnprintf (char *buf, size_t n, const char *fmt, va_list args); + +#ifdef __cplusplus +} +#endif + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/data.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/data.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,7432 @@ +/* + +Copyright (C) 1994-2012 John W. Eaton +Copyright (C) 2009 Jaroslav Hajek +Copyright (C) 2009-2010 VZLU Prague +Copyright (C) 2012 Carlo de Falco + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#ifdef HAVE_SYS_RESOURCE_H +#include +#endif + +#include +#include + +#include + +#include "lo-ieee.h" +#include "lo-math.h" +#include "oct-base64.h" +#include "oct-time.h" +#include "str-vec.h" +#include "quit.h" +#include "mx-base.h" +#include "oct-binmap.h" + +#include "Cell.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "oct-map.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-class.h" +#include "ov-float.h" +#include "ov-complex.h" +#include "ov-flt-complex.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-cx-sparse.h" +#include "parse.h" +#include "pt-mat.h" +#include "utils.h" +#include "variables.h" +#include "pager.h" +#include "xnorm.h" + +#if ! defined (CLOCKS_PER_SEC) +#if defined (CLK_TCK) +#define CLOCKS_PER_SEC CLK_TCK +#else +#error "no definition for CLOCKS_PER_SEC!" +#endif +#endif + +#if ! defined (HAVE_HYPOTF) && defined (HAVE__HYPOTF) +#define hypotf _hypotf +#define HAVE_HYPOTF 1 +#endif + +#define ANY_ALL(FCN) \ + \ + octave_value retval; \ + \ + int nargin = args.length (); \ + \ + if (nargin == 1 || nargin == 2) \ + { \ + int dim = (nargin == 1 ? -1 : args(1).int_value (true) - 1); \ + \ + if (! error_state) \ + { \ + if (dim >= -1) \ + retval = args(0).FCN (dim); \ + else \ + error (#FCN ": invalid dimension argument = %d", dim + 1); \ + } \ + else \ + error (#FCN ": expecting dimension argument to be an integer"); \ + } \ + else \ + print_usage (); \ + \ + return retval + +DEFUN (all, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} all (@var{x})\n\ +@deftypefnx {Built-in Function} {} all (@var{x}, @var{dim})\n\ +For a vector argument, return true (logical 1) if all elements of the vector\n\ +are nonzero.\n\ +\n\ +For a matrix argument, return a row vector of logical ones and\n\ +zeros with each element indicating whether all of the elements of the\n\ +corresponding column of the matrix are nonzero. For example:\n\ +\n\ +@example\n\ +@group\n\ +all ([2, 3; 1, 0]))\n\ + @result{} [ 1, 0 ]\n\ +@end group\n\ +@end example\n\ +\n\ +If the optional argument @var{dim} is supplied, work along dimension\n\ +@var{dim}.\n\ +@seealso{any}\n\ +@end deftypefn") +{ + ANY_ALL (all); +} + +/* +%!test +%! x = ones (3); +%! x(1,1) = 0; +%! assert (all (all (rand (3) + 1) == [1, 1, 1]) == 1); +%! assert (all (all (x) == [0, 1, 1]) == 1); +%! assert (all (x, 1) == [0, 1, 1]); +%! assert (all (x, 2) == [0; 1; 1]); + +%!test +%! x = ones (3, "single"); +%! x(1,1) = 0; +%! assert (all (all (single (rand (3) + 1)) == [1, 1, 1]) == 1); +%! assert (all (all (x) == [0, 1, 1]) == 1); +%! assert (all (x, 1) == [0, 1, 1]); +%! assert (all (x, 2) == [0; 1; 1]); + +%!error all () +%!error all (1, 2, 3) +*/ + +DEFUN (any, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} any (@var{x})\n\ +@deftypefnx {Built-in Function} {} any (@var{x}, @var{dim})\n\ +For a vector argument, return true (logical 1) if any element of the vector\n\ +is nonzero.\n\ +\n\ +For a matrix argument, return a row vector of logical ones and\n\ +zeros with each element indicating whether any of the elements of the\n\ +corresponding column of the matrix are nonzero. For example:\n\ +\n\ +@example\n\ +@group\n\ +any (eye (2, 4))\n\ + @result{} [ 1, 1, 0, 0 ]\n\ +@end group\n\ +@end example\n\ +\n\ +If the optional argument @var{dim} is supplied, work along dimension\n\ +@var{dim}. For example:\n\ +\n\ +@example\n\ +@group\n\ +any (eye (2, 4), 2)\n\ + @result{} [ 1; 1 ]\n\ +@end group\n\ +@end example\n\ +@seealso{all}\n\ +@end deftypefn") +{ + ANY_ALL (any); +} + +/* +%!test +%! x = zeros (3); +%! x(3,3) = 1; +%! assert (all (any (x) == [0, 0, 1]) == 1); +%! assert (all (any (ones (3)) == [1, 1, 1]) == 1); +%! assert (any (x, 1) == [0, 0, 1]); +%! assert (any (x, 2) == [0; 0; 1]); + +%!test +%! x = zeros (3, "single"); +%! x(3,3) = 1; +%! assert (all (any (x) == [0, 0, 1]) == 1); +%! assert (all (any (ones (3, "single")) == [1, 1, 1]) == 1); +%! assert (any (x, 1) == [0, 0, 1]); +%! assert (any (x, 2) == [0; 0; 1]); + +%!error any () +%!error any (1, 2, 3) +*/ + +// These mapping functions may also be useful in other places, eh? + +DEFUN (atan2, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} atan2 (@var{y}, @var{x})\n\ +Compute atan (@var{y} / @var{x}) for corresponding elements of @var{y}\n\ +and @var{x}. Signal an error if @var{y} and @var{x} do not match in size\n\ +and orientation.\n\ +@seealso{tan, tand, tanh, atanh}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2) + { + if (! args(0).is_numeric_type ()) + gripe_wrong_type_arg ("atan2", args(0)); + else if (! args(1).is_numeric_type ()) + gripe_wrong_type_arg ("atan2", args(1)); + else if (args(0).is_complex_type () || args(1).is_complex_type ()) + error ("atan2: not defined for complex numbers"); + else if (args(0).is_single_type () || args(1).is_single_type ()) + { + if (args(0).is_scalar_type () && args(1).is_scalar_type ()) + retval = atan2f (args(0).float_value (), args(1).float_value ()); + else + { + FloatNDArray a0 = args(0).float_array_value (); + FloatNDArray a1 = args(1).float_array_value (); + retval = binmap (a0, a1, ::atan2f, "atan2"); + } + } + else + { + bool a0_scalar = args(0).is_scalar_type (); + bool a1_scalar = args(1).is_scalar_type (); + if (a0_scalar && a1_scalar) + retval = atan2 (args(0).scalar_value (), args(1).scalar_value ()); + else if ((a0_scalar || args(0).is_sparse_type ()) + && (a1_scalar || args(1).is_sparse_type ())) + { + SparseMatrix m0 = args(0).sparse_matrix_value (); + SparseMatrix m1 = args(1).sparse_matrix_value (); + retval = binmap (m0, m1, ::atan2, "atan2"); + } + else + { + NDArray a0 = args(0).array_value (); + NDArray a1 = args(1).array_value (); + retval = binmap (a0, a1, ::atan2, "atan2"); + } + } + } + else + print_usage (); + + return retval; +} + +/* +%!assert (size (atan2 (zeros (0, 2), zeros (0, 2))), [0, 2]) +%!assert (size (atan2 (rand (2, 3, 4), zeros (2, 3, 4))), [2, 3, 4]) +%!assert (size (atan2 (rand (2, 3, 4), 1)), [2, 3, 4]) +%!assert (size (atan2 (1, rand (2, 3, 4))), [2, 3, 4]) +%!assert (size (atan2 (1, 2)), [1, 1]) + +%!test +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); +%! v = [0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]; +%! y = [0, rt3, 1, rt3, -rt3, -1, -rt3, 0]; +%! x = [1, 3, 1, 1, 1, 1, 3, 1]; +%! assert (atan2 (y, x), v, sqrt (eps)); + +%!test +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); +%! v = single ([0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]); +%! y = single ([0, rt3, 1, rt3, -rt3, -1, -rt3, 0]); +%! x = single ([1, 3, 1, 1, 1, 1, 3, 1]); +%! assert (atan2 (y, x), v, sqrt (eps ("single"))); + +%!error atan2 () +%!error atan2 (1, 2, 3) +*/ + + +static octave_value +do_hypot (const octave_value& x, const octave_value& y) +{ + octave_value retval; + + octave_value arg0 = x, arg1 = y; + if (! arg0.is_numeric_type ()) + gripe_wrong_type_arg ("hypot", arg0); + else if (! arg1.is_numeric_type ()) + gripe_wrong_type_arg ("hypot", arg1); + else + { + if (arg0.is_complex_type ()) + arg0 = arg0.abs (); + if (arg1.is_complex_type ()) + arg1 = arg1.abs (); + + if (arg0.is_single_type () || arg1.is_single_type ()) + { + if (arg0.is_scalar_type () && arg1.is_scalar_type ()) + retval = hypotf (arg0.float_value (), arg1.float_value ()); + else + { + FloatNDArray a0 = arg0.float_array_value (); + FloatNDArray a1 = arg1.float_array_value (); + retval = binmap (a0, a1, ::hypotf, "hypot"); + } + } + else + { + bool a0_scalar = arg0.is_scalar_type (); + bool a1_scalar = arg1.is_scalar_type (); + if (a0_scalar && a1_scalar) + retval = hypot (arg0.scalar_value (), arg1.scalar_value ()); + else if ((a0_scalar || arg0.is_sparse_type ()) + && (a1_scalar || arg1.is_sparse_type ())) + { + SparseMatrix m0 = arg0.sparse_matrix_value (); + SparseMatrix m1 = arg1.sparse_matrix_value (); + retval = binmap (m0, m1, ::hypot, "hypot"); + } + else + { + NDArray a0 = arg0.array_value (); + NDArray a1 = arg1.array_value (); + retval = binmap (a0, a1, ::hypot, "hypot"); + } + } + } + + return retval; +} + +DEFUN (hypot, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} hypot (@var{x}, @var{y})\n\ +@deftypefnx {Built-in Function} {} hypot (@var{x}, @var{y}, @var{z}, @dots{})\n\ +Compute the element-by-element square root of the sum of the squares of\n\ +@var{x} and @var{y}. This is equivalent to\n\ +@code{sqrt (@var{x}.^2 + @var{y}.^2)}, but calculated in a manner that\n\ +avoids overflows for large values of @var{x} or @var{y}.\n\ +@code{hypot} can also be called with more than 2 arguments; in this case,\n\ +the arguments are accumulated from left to right:\n\ +\n\ +@example\n\ +@group\n\ +hypot (hypot (@var{x}, @var{y}), @var{z})\n\ +hypot (hypot (hypot (@var{x}, @var{y}), @var{z}), @var{w}), etc.\n\ +@end group\n\ +@end example\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2) + { + retval = do_hypot (args(0), args(1)); + } + else if (nargin >= 3) + { + retval = args(0); + for (int i = 1; i < nargin && ! error_state; i++) + retval = do_hypot (retval, args(i)); + } + else + print_usage (); + + return retval; +} + +/* +%!assert (size (hypot (zeros (0, 2), zeros (0, 2))), [0, 2]) +%!assert (size (hypot (rand (2, 3, 4), zeros (2, 3, 4))), [2, 3, 4]) +%!assert (size (hypot (rand (2, 3, 4), 1)), [2, 3, 4]) +%!assert (size (hypot (1, rand (2, 3, 4))), [2, 3, 4]) +%!assert (size (hypot (1, 2)), [1, 1]) +%!assert (hypot (1:10, 1:10), sqrt (2) * [1:10], 16*eps) +%!assert (hypot (single (1:10), single (1:10)), single (sqrt (2) * [1:10])) +*/ + +template +void +map_2_xlog2 (const Array& x, Array& f, Array& e) +{ + f = Array(x.dims ()); + e = Array(x.dims ()); + for (octave_idx_type i = 0; i < x.numel (); i++) + { + int exp; + f.xelem (i) = xlog2 (x(i), exp); + e.xelem (i) = exp; + } +} + +DEFUN (log2, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} log2 (@var{x})\n\ +@deftypefnx {Mapping Function} {[@var{f}, @var{e}] =} log2 (@var{x})\n\ +Compute the base-2 logarithm of each element of @var{x}.\n\ +\n\ +If called with two output arguments, split @var{x} into\n\ +binary mantissa and exponent so that\n\ +@tex\n\ +${1 \\over 2} \\le \\left| f \\right| < 1$\n\ +@end tex\n\ +@ifnottex\n\ +@code{1/2 <= abs(f) < 1}\n\ +@end ifnottex\n\ +and @var{e} is an integer. If\n\ +@tex\n\ +$x = 0$, $f = e = 0$.\n\ +@end tex\n\ +@ifnottex\n\ +@code{x = 0}, @code{f = e = 0}.\n\ +@end ifnottex\n\ +@seealso{pow2, log, log10, exp}\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + if (nargout < 2) + retval(0) = args(0).log2 (); + else if (args(0).is_single_type ()) + { + if (args(0).is_real_type ()) + { + FloatNDArray f; + FloatNDArray x = args(0).float_array_value (); + // FIXME -- should E be an int value? + FloatMatrix e; + map_2_xlog2 (x, f, e); + retval(1) = e; + retval(0) = f; + } + else if (args(0).is_complex_type ()) + { + FloatComplexNDArray f; + FloatComplexNDArray x = args(0).float_complex_array_value (); + // FIXME -- should E be an int value? + FloatNDArray e; + map_2_xlog2 (x, f, e); + retval(1) = e; + retval(0) = f; + } + } + else if (args(0).is_real_type ()) + { + NDArray f; + NDArray x = args(0).array_value (); + // FIXME -- should E be an int value? + Matrix e; + map_2_xlog2 (x, f, e); + retval(1) = e; + retval(0) = f; + } + else if (args(0).is_complex_type ()) + { + ComplexNDArray f; + ComplexNDArray x = args(0).complex_array_value (); + // FIXME -- should E be an int value? + NDArray e; + map_2_xlog2 (x, f, e); + retval(1) = e; + retval(0) = f; + } + else + gripe_wrong_type_arg ("log2", args(0)); + } + else + print_usage (); + + return retval; +} + +/* +%!assert (log2 ([1/4, 1/2, 1, 2, 4]), [-2, -1, 0, 1, 2]) +%!assert (log2 (Inf), Inf) +%!assert (isnan (log2 (NaN))) +%!assert (log2 (4*i), 2 + log2 (1*i)) +%!assert (log2 (complex (0,Inf)), Inf + log2 (i)) + +%!test +%! [f, e] = log2 ([0,-1; 2,-4; Inf,-Inf]); +%! assert (f, [0,-0.5; 0.5,-0.5; Inf,-Inf]); +%! assert (e(1:2,:), [0,1;2,3]); + +%!test +%! [f, e] = log2 (complex (zeros (3, 2), [0,-1; 2,-4; Inf,-Inf])); +%! assert (f, complex (zeros (3, 2), [0,-0.5; 0.5,-0.5; Inf,-Inf])); +%! assert (e(1:2,:), [0,1; 2,3]); +*/ + +DEFUN (rem, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} rem (@var{x}, @var{y})\n\ +@deftypefnx {Mapping Function} {} fmod (@var{x}, @var{y})\n\ +Return the remainder of the division @code{@var{x} / @var{y}}, computed\n\ +using the expression\n\ +\n\ +@example\n\ +x - y .* fix (x ./ y)\n\ +@end example\n\ +\n\ +An error message is printed if the dimensions of the arguments do not\n\ +agree, or if either of the arguments is complex.\n\ +@seealso{mod}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2) + { + if (! args(0).is_numeric_type ()) + gripe_wrong_type_arg ("rem", args(0)); + else if (! args(1).is_numeric_type ()) + gripe_wrong_type_arg ("rem", args(1)); + else if (args(0).is_complex_type () || args(1).is_complex_type ()) + error ("rem: not defined for complex numbers"); + else if (args(0).is_integer_type () || args(1).is_integer_type ()) + { + builtin_type_t btyp0 = args(0).builtin_type (); + builtin_type_t btyp1 = args(1).builtin_type (); + if (btyp0 == btyp_double || btyp0 == btyp_float) + btyp0 = btyp1; + if (btyp1 == btyp_double || btyp1 == btyp_float) + btyp1 = btyp0; + + if (btyp0 == btyp1) + { + switch (btyp0) + { +#define MAKE_INT_BRANCH(X) \ + case btyp_ ## X: \ + { \ + X##NDArray a0 = args(0).X##_array_value (); \ + X##NDArray a1 = args(1).X##_array_value (); \ + retval = binmap (a0, a1, rem, "rem"); \ + } \ + break + MAKE_INT_BRANCH (int8); + MAKE_INT_BRANCH (int16); + MAKE_INT_BRANCH (int32); + MAKE_INT_BRANCH (int64); + MAKE_INT_BRANCH (uint8); + MAKE_INT_BRANCH (uint16); + MAKE_INT_BRANCH (uint32); + MAKE_INT_BRANCH (uint64); +#undef MAKE_INT_BRANCH + default: + panic_impossible (); + } + } + else + error ("rem: cannot combine %s and %d", + args(0).class_name ().c_str (), args(1).class_name ().c_str ()); + } + else if (args(0).is_single_type () || args(1).is_single_type ()) + { + if (args(0).is_scalar_type () && args(1).is_scalar_type ()) + retval = xrem (args(0).float_value (), args(1).float_value ()); + else + { + FloatNDArray a0 = args(0).float_array_value (); + FloatNDArray a1 = args(1).float_array_value (); + retval = binmap (a0, a1, xrem, "rem"); + } + } + else + { + bool a0_scalar = args(0).is_scalar_type (); + bool a1_scalar = args(1).is_scalar_type (); + if (a0_scalar && a1_scalar) + retval = xrem (args(0).scalar_value (), args(1).scalar_value ()); + else if ((a0_scalar || args(0).is_sparse_type ()) + && (a1_scalar || args(1).is_sparse_type ())) + { + SparseMatrix m0 = args(0).sparse_matrix_value (); + SparseMatrix m1 = args(1).sparse_matrix_value (); + retval = binmap (m0, m1, xrem, "rem"); + } + else + { + NDArray a0 = args(0).array_value (); + NDArray a1 = args(1).array_value (); + retval = binmap (a0, a1, xrem, "rem"); + } + } + } + else + print_usage (); + + return retval; +} + +/* +%!assert (rem ([1, 2, 3; -1, -2, -3], 2), [1, 0, 1; -1, 0, -1]) +%!assert (rem ([1, 2, 3; -1, -2, -3], 2 * ones (2, 3)),[1, 0, 1; -1, 0, -1]) +%!assert (rem (uint8 ([1, 2, 3; -1, -2, -3]), uint8 (2)), uint8 ([1, 0, 1; -1, 0, -1])) +%!assert (uint8 (rem ([1, 2, 3; -1, -2, -3], 2 * ones (2, 3))),uint8 ([1, 0, 1; -1, 0, -1])) + +%!error rem (uint (8), int8 (5)) +%!error rem (uint8 ([1, 2]), uint8 ([3, 4, 5])) +%!error rem () +%!error rem (1, 2, 3) +%!error rem ([1, 2], [3, 4, 5]) +%!error rem (i, 1) +*/ + +/* + +%!assert (size (fmod (zeros (0, 2), zeros (0, 2))), [0, 2]) +%!assert (size (fmod (rand (2, 3, 4), zeros (2, 3, 4))), [2, 3, 4]) +%!assert (size (fmod (rand (2, 3, 4), 1)), [2, 3, 4]) +%!assert (size (fmod (1, rand (2, 3, 4))), [2, 3, 4]) +%!assert (size (fmod (1, 2)), [1, 1]) +*/ + +DEFALIAS (fmod, rem) + +DEFUN (mod, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} mod (@var{x}, @var{y})\n\ +Compute the modulo of @var{x} and @var{y}. Conceptually this is given by\n\ +\n\ +@example\n\ +x - y .* floor (x ./ y)\n\ +@end example\n\ +\n\ +@noindent\n\ +and is written such that the correct modulus is returned for\n\ +integer types. This function handles negative values correctly. That\n\ +is, @code{mod (-1, 3)} is 2, not -1, as @code{rem (-1, 3)} returns.\n\ +@code{mod (@var{x}, 0)} returns @var{x}.\n\ +\n\ +An error results if the dimensions of the arguments do not agree, or if\n\ +either of the arguments is complex.\n\ +@seealso{rem}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2) + { + if (! args(0).is_numeric_type ()) + gripe_wrong_type_arg ("mod", args(0)); + else if (! args(1).is_numeric_type ()) + gripe_wrong_type_arg ("mod", args(1)); + else if (args(0).is_complex_type () || args(1).is_complex_type ()) + error ("mod: not defined for complex numbers"); + else if (args(0).is_integer_type () || args(1).is_integer_type ()) + { + builtin_type_t btyp0 = args(0).builtin_type (); + builtin_type_t btyp1 = args(1).builtin_type (); + if (btyp0 == btyp_double || btyp0 == btyp_float) + btyp0 = btyp1; + if (btyp1 == btyp_double || btyp1 == btyp_float) + btyp1 = btyp0; + + if (btyp0 == btyp1) + { + switch (btyp0) + { +#define MAKE_INT_BRANCH(X) \ + case btyp_ ## X: \ + { \ + X##NDArray a0 = args(0).X##_array_value (); \ + X##NDArray a1 = args(1).X##_array_value (); \ + retval = binmap (a0, a1, mod, "mod"); \ + } \ + break + MAKE_INT_BRANCH (int8); + MAKE_INT_BRANCH (int16); + MAKE_INT_BRANCH (int32); + MAKE_INT_BRANCH (int64); + MAKE_INT_BRANCH (uint8); + MAKE_INT_BRANCH (uint16); + MAKE_INT_BRANCH (uint32); + MAKE_INT_BRANCH (uint64); +#undef MAKE_INT_BRANCH + default: + panic_impossible (); + } + } + else + error ("mod: cannot combine %s and %d", + args(0).class_name ().c_str (), args(1).class_name ().c_str ()); + } + else if (args(0).is_single_type () || args(1).is_single_type ()) + { + if (args(0).is_scalar_type () && args(1).is_scalar_type ()) + retval = xmod (args(0).float_value (), args(1).float_value ()); + else + { + FloatNDArray a0 = args(0).float_array_value (); + FloatNDArray a1 = args(1).float_array_value (); + retval = binmap (a0, a1, xmod, "mod"); + } + } + else + { + bool a0_scalar = args(0).is_scalar_type (); + bool a1_scalar = args(1).is_scalar_type (); + if (a0_scalar && a1_scalar) + retval = xmod (args(0).scalar_value (), args(1).scalar_value ()); + else if ((a0_scalar || args(0).is_sparse_type ()) + && (a1_scalar || args(1).is_sparse_type ())) + { + SparseMatrix m0 = args(0).sparse_matrix_value (); + SparseMatrix m1 = args(1).sparse_matrix_value (); + retval = binmap (m0, m1, xmod, "mod"); + } + else + { + NDArray a0 = args(0).array_value (); + NDArray a1 = args(1).array_value (); + retval = binmap (a0, a1, xmod, "mod"); + } + } + } + else + print_usage (); + + return retval; +} + +/* +## empty input test +%!assert (isempty (mod ([], []))) + +## x mod y, y != 0 tests +%!assert (mod (5, 3), 2) +%!assert (mod (-5, 3), 1) +%!assert (mod (0, 3), 0) +%!assert (mod ([-5, 5, 0], [3, 3, 3]), [1, 2, 0]) +%!assert (mod ([-5; 5; 0], [3; 3; 3]), [1; 2; 0]) +%!assert (mod ([-5, 5; 0, 3], [3, 3 ; 3, 1]), [1, 2 ; 0, 0]) + +## x mod 0 tests +%!assert (mod (5, 0), 5) +%!assert (mod (-5, 0), -5) +%!assert (mod ([-5, 5, 0], [3, 0, 3]), [1, 5, 0]) +%!assert (mod ([-5; 5; 0], [3; 0; 3]), [1; 5; 0]) +%!assert (mod ([-5, 5; 0, 3], [3, 0 ; 3, 1]), [1, 5 ; 0, 0]) +%!assert (mod ([-5, 5; 0, 3], [0, 0 ; 0, 0]), [-5, 5; 0, 3]) + +## mixed scalar/matrix tests +%!assert (mod ([-5, 5; 0, 3], 0), [-5, 5; 0, 3]) +%!assert (mod ([-5, 5; 0, 3], 3), [1, 2; 0, 0]) +%!assert (mod (-5, [0,0; 0,0]), [-5, -5; -5, -5]) +%!assert (mod (-5, [3,0; 3,1]), [1, -5; 1, 0]) +%!assert (mod (-5, [3,2; 3,1]), [1, 1; 1, 0]) + +## integer types +%!assert (mod (uint8 (5), uint8 (4)), uint8 (1)) +%!assert (mod (uint8 ([1:5]), uint8 (4)), uint8 ([1,2,3,0,1])) +%!assert (mod (uint8 ([1:5]), uint8 (0)), uint8 ([1:5])) +%!error (mod (uint8 (5), int8 (4))) + +## mixed integer/real types +%!assert (mod (uint8 (5), 4), uint8 (1)) +%!assert (mod (5, uint8 (4)), uint8 (1)) +%!assert (mod (uint8 ([1:5]), 4), uint8 ([1,2,3,0,1])) + +## non-integer real numbers +%!assert (mod (2.1, 0.1), 0) +%!assert (mod (2.1, 0.2), 0.1, eps) +*/ + +// FIXME: Need to convert the reduction functions of this file for single precision + +#define NATIVE_REDUCTION_1(FCN, TYPE, DIM) \ + (arg.is_ ## TYPE ## _type ()) \ + { \ + TYPE ## NDArray tmp = arg. TYPE ##_array_value (); \ + \ + if (! error_state) \ + { \ + retval = tmp.FCN (DIM); \ + } \ + } + +#define NATIVE_REDUCTION(FCN, BOOL_FCN) \ + \ + octave_value retval; \ + \ + int nargin = args.length (); \ + \ + bool isnative = false; \ + bool isdouble = false; \ + \ + if (nargin > 1 && args(nargin - 1).is_string ()) \ + { \ + std::string str = args(nargin - 1).string_value (); \ + \ + if (! error_state) \ + { \ + if (str == "native") \ + isnative = true; \ + else if (str == "double") \ + isdouble = true; \ + else \ + error ("sum: unrecognized string argument"); \ + nargin --; \ + } \ + } \ + \ + if (nargin == 1 || nargin == 2) \ + { \ + octave_value arg = args(0); \ + \ + int dim = (nargin == 1 ? -1 : args(1).int_value (true) - 1); \ + \ + if (! error_state) \ + { \ + if (dim >= -1) \ + { \ + if (arg.is_sparse_type ()) \ + { \ + if (arg.is_real_type ()) \ + { \ + SparseMatrix tmp = arg.sparse_matrix_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else \ + { \ + SparseComplexMatrix tmp = arg.sparse_complex_matrix_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + } \ + else \ + { \ + if (isnative) \ + { \ + if NATIVE_REDUCTION_1 (FCN, uint8, dim) \ + else if NATIVE_REDUCTION_1 (FCN, uint16, dim) \ + else if NATIVE_REDUCTION_1 (FCN, uint32, dim) \ + else if NATIVE_REDUCTION_1 (FCN, uint64, dim) \ + else if NATIVE_REDUCTION_1 (FCN, int8, dim) \ + else if NATIVE_REDUCTION_1 (FCN, int16, dim) \ + else if NATIVE_REDUCTION_1 (FCN, int32, dim) \ + else if NATIVE_REDUCTION_1 (FCN, int64, dim) \ + else if (arg.is_bool_type ()) \ + { \ + boolNDArray tmp = arg.bool_array_value (); \ + if (! error_state) \ + retval = boolNDArray (tmp.BOOL_FCN (dim)); \ + } \ + else if (arg.is_char_matrix ()) \ + { \ + error (#FCN, ": invalid char type"); \ + } \ + else if (!isdouble && arg.is_single_type ()) \ + { \ + if (arg.is_complex_type ()) \ + { \ + FloatComplexNDArray tmp = \ + arg.float_complex_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else if (arg.is_real_type ()) \ + { \ + FloatNDArray tmp = arg.float_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + } \ + else if (arg.is_complex_type ()) \ + { \ + ComplexNDArray tmp = arg.complex_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else if (arg.is_real_type ()) \ + { \ + NDArray tmp = arg.array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else \ + { \ + gripe_wrong_type_arg (#FCN, arg); \ + return retval; \ + } \ + } \ + else if (arg.is_bool_type ()) \ + { \ + boolNDArray tmp = arg.bool_array_value (); \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else if (!isdouble && arg.is_single_type ()) \ + { \ + if (arg.is_real_type ()) \ + { \ + FloatNDArray tmp = arg.float_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else if (arg.is_complex_type ()) \ + { \ + FloatComplexNDArray tmp = \ + arg.float_complex_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + } \ + else if (arg.is_real_type ()) \ + { \ + NDArray tmp = arg.array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else if (arg.is_complex_type ()) \ + { \ + ComplexNDArray tmp = arg.complex_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else \ + { \ + gripe_wrong_type_arg (#FCN, arg); \ + return retval; \ + } \ + } \ + } \ + else \ + error (#FCN ": invalid dimension argument = %d", dim + 1); \ + } \ + \ + } \ + else \ + print_usage (); \ + \ + return retval + +#define DATA_REDUCTION(FCN) \ + \ + octave_value retval; \ + \ + int nargin = args.length (); \ + \ + if (nargin == 1 || nargin == 2) \ + { \ + octave_value arg = args(0); \ + \ + int dim = (nargin == 1 ? -1 : args(1).int_value (true) - 1); \ + \ + if (! error_state) \ + { \ + if (dim >= -1) \ + { \ + if (arg.is_real_type ()) \ + { \ + if (arg.is_sparse_type ()) \ + { \ + SparseMatrix tmp = arg.sparse_matrix_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else if (arg.is_single_type ()) \ + { \ + FloatNDArray tmp = arg.float_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else \ + { \ + NDArray tmp = arg.array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + } \ + else if (arg.is_complex_type ()) \ + { \ + if (arg.is_sparse_type ()) \ + { \ + SparseComplexMatrix tmp = arg.sparse_complex_matrix_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else if (arg.is_single_type ()) \ + { \ + FloatComplexNDArray tmp = arg.float_complex_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else \ + { \ + ComplexNDArray tmp = arg.complex_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + } \ + else \ + { \ + gripe_wrong_type_arg (#FCN, arg); \ + return retval; \ + } \ + } \ + else \ + error (#FCN ": invalid dimension argument = %d", dim + 1); \ + } \ + } \ + else \ + print_usage (); \ + \ + return retval + +DEFUN (cumprod, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} cumprod (@var{x})\n\ +@deftypefnx {Built-in Function} {} cumprod (@var{x}, @var{dim})\n\ +Cumulative product of elements along dimension @var{dim}. If\n\ +@var{dim} is omitted, it defaults to the first non-singleton dimension.\n\ +\n\ +@seealso{prod, cumsum}\n\ +@end deftypefn") +{ + DATA_REDUCTION (cumprod); +} + +/* +%!assert (cumprod ([1, 2, 3]), [1, 2, 6]) +%!assert (cumprod ([-1; -2; -3]), [-1; 2; -6]) +%!assert (cumprod ([i, 2+i, -3+2i, 4]), [i, -1+2i, -1-8i, -4-32i]) +%!assert (cumprod ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i]), [1, 2, 3; i, 4i, 9i; -1+i, -8+8i, -27+27i]) + +%!assert (cumprod (single ([1, 2, 3])), single ([1, 2, 6])) +%!assert (cumprod (single ([-1; -2; -3])), single ([-1; 2; -6])) +%!assert (cumprod (single ([i, 2+i, -3+2i, 4])), single ([i, -1+2i, -1-8i, -4-32i])) +%!assert (cumprod (single ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single ([1, 2, 3; i, 4i, 9i; -1+i, -8+8i, -27+27i])) + +%!assert (cumprod ([2, 3; 4, 5], 1), [2, 3; 8, 15]) +%!assert (cumprod ([2, 3; 4, 5], 2), [2, 6; 4, 20]) + +%!assert (cumprod (single ([2, 3; 4, 5]), 1), single ([2, 3; 8, 15])) +%!assert (cumprod (single ([2, 3; 4, 5]), 2), single ([2, 6; 4, 20])) + +%!error cumprod () +*/ + +DEFUN (cumsum, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} cumsum (@var{x})\n\ +@deftypefnx {Built-in Function} {} cumsum (@var{x}, @var{dim})\n\ +@deftypefnx {Built-in Function} {} cumsum (@dots{}, \"native\")\n\ +@deftypefnx {Built-in Function} {} cumsum (@dots{}, \"double\")\n\ +@deftypefnx {Built-in Function} {} cumsum (@dots{}, \"extra\")\n\ +Cumulative sum of elements along dimension @var{dim}. If @var{dim}\n\ +is omitted, it defaults to the first non-singleton dimension.\n\ +\n\ +See @code{sum} for an explanation of the optional parameters \"native\",\n\ +\"double\", and \"extra\".\n\ +@seealso{sum, cumprod}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + bool isnative = false; + bool isdouble = false; + + if (nargin > 1 && args(nargin - 1).is_string ()) + { + std::string str = args(nargin - 1).string_value (); + + if (! error_state) + { + if (str == "native") + isnative = true; + else if (str == "double") + isdouble = true; + else + error ("sum: unrecognized string argument"); + nargin --; + } + } + + if (error_state) + return retval; + + if (nargin == 1 || nargin == 2) + { + octave_value arg = args(0); + + int dim = -1; + if (nargin == 2) + { + dim = args(1).int_value () - 1; + if (dim < 0) + error ("cumsum: invalid dimension argument = %d", dim + 1); + } + + if (! error_state) + { + switch (arg.builtin_type ()) + { + case btyp_double: + if (arg.is_sparse_type ()) + retval = arg.sparse_matrix_value ().cumsum (dim); + else + retval = arg.array_value ().cumsum (dim); + break; + case btyp_complex: + if (arg.is_sparse_type ()) + retval = arg.sparse_complex_matrix_value ().cumsum (dim); + else + retval = arg.complex_array_value ().cumsum (dim); + break; + case btyp_float: + if (isdouble) + retval = arg.array_value ().cumsum (dim); + else + retval = arg.float_array_value ().cumsum (dim); + break; + case btyp_float_complex: + if (isdouble) + retval = arg.complex_array_value ().cumsum (dim); + else + retval = arg.float_complex_array_value ().cumsum (dim); + break; + +#define MAKE_INT_BRANCH(X) \ + case btyp_ ## X: \ + if (isnative) \ + retval = arg.X ## _array_value ().cumsum (dim); \ + else \ + retval = arg.array_value ().cumsum (dim); \ + break + MAKE_INT_BRANCH (int8); + MAKE_INT_BRANCH (int16); + MAKE_INT_BRANCH (int32); + MAKE_INT_BRANCH (int64); + MAKE_INT_BRANCH (uint8); + MAKE_INT_BRANCH (uint16); + MAKE_INT_BRANCH (uint32); + MAKE_INT_BRANCH (uint64); +#undef MAKE_INT_BRANCH + + case btyp_bool: + if (arg.is_sparse_type ()) + { + SparseMatrix cs = arg.sparse_matrix_value ().cumsum (dim); + if (isnative) + retval = cs != 0.0; + else + retval = cs; + } + else + { + NDArray cs = arg.bool_array_value ().cumsum (dim); + if (isnative) + retval = cs != 0.0; + else + retval = cs; + } + break; + + default: + gripe_wrong_type_arg ("cumsum", arg); + } + } + } + else + print_usage (); + + return retval; +} + +/* +%!assert (cumsum ([1, 2, 3]), [1, 3, 6]) +%!assert (cumsum ([-1; -2; -3]), [-1; -3; -6]) +%!assert (cumsum ([i, 2+i, -3+2i, 4]), [i, 2+2i, -1+4i, 3+4i]) +%!assert (cumsum ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i]), [1, 2, 3; 1+i, 2+2i, 3+3i; 2+2i, 4+4i, 6+6i]) + +%!assert (cumsum (single ([1, 2, 3])), single ([1, 3, 6])) +%!assert (cumsum (single ([-1; -2; -3])), single ([-1; -3; -6])) +%!assert (cumsum (single ([i, 2+i, -3+2i, 4])), single ([i, 2+2i, -1+4i, 3+4i])) +%!assert (cumsum (single ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single ([1, 2, 3; 1+i, 2+2i, 3+3i; 2+2i, 4+4i, 6+6i])) + +%!assert (cumsum ([1, 2; 3, 4], 1), [1, 2; 4, 6]) +%!assert (cumsum ([1, 2; 3, 4], 2), [1, 3; 3, 7]) + +%!assert (cumsum (single ([1, 2; 3, 4]), 1), single ([1, 2; 4, 6])) +%!assert (cumsum (single ([1, 2; 3, 4]), 2), single ([1, 3; 3, 7])) + +%!error cumsum () +*/ + +DEFUN (diag, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{M} =} diag (@var{v})\n\ +@deftypefnx {Built-in Function} {@var{M} =} diag (@var{v}, @var{k})\n\ +@deftypefnx {Built-in Function} {@var{M} =} diag (@var{v}, @var{m}, @var{n})\n\ +@deftypefnx {Built-in Function} {@var{v} =} diag (@var{M})\n\ +@deftypefnx {Built-in Function} {@var{v} =} diag (@var{M}, @var{k})\n\ +Return a diagonal matrix with vector @var{v} on diagonal @var{k}. The\n\ +second argument is optional. If it is positive, the vector is placed on\n\ +the @var{k}-th super-diagonal. If it is negative, it is placed on the\n\ +@var{-k}-th sub-diagonal. The default value of @var{k} is 0, and the\n\ +vector is placed on the main diagonal. For example:\n\ +\n\ +@example\n\ +@group\n\ +diag ([1, 2, 3], 1)\n\ + @result{} 0 1 0 0\n\ + 0 0 2 0\n\ + 0 0 0 3\n\ + 0 0 0 0\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +The 3-input form returns a diagonal matrix with vector @var{v} on the main\n\ +diagonal and the resulting matrix being of size @var{m} rows x @var{n}\n\ +columns.\n\ +\n\ +Given a matrix argument, instead of a vector, @code{diag} extracts the\n\ +@var{k}-th diagonal of the matrix.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1 && args(0).is_defined ()) + retval = args(0).diag (); + else if (nargin == 2 && args(0).is_defined () && args(1).is_defined ()) + { + octave_idx_type k = args(1).int_value (); + + if (error_state) + error ("diag: invalid argument K"); + else + retval = args(0).diag (k); + } + else if (nargin == 3) + { + octave_value arg0 = args(0); + + if (arg0.ndims () == 2 && (arg0.rows () == 1 || arg0.columns () == 1)) + { + octave_idx_type m = args(1).int_value (); + octave_idx_type n = args(2).int_value (); + + if (! error_state) + retval = arg0.diag (m, n); + else + error ("diag: invalid dimensions"); + } + else + error ("diag: V must be a vector"); + } + else + print_usage (); + + return retval; +} + +/* + +%!assert (full (diag ([1; 2; 3])), [1, 0, 0; 0, 2, 0; 0, 0, 3]) +%!assert (diag ([1; 2; 3], 1), [0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0]) +%!assert (diag ([1; 2; 3], 2), [0, 0, 1, 0, 0; 0, 0, 0, 2, 0; 0, 0, 0, 0, 3; 0, 0, 0, 0, 0; 0, 0, 0, 0, 0]) +%!assert (diag ([1; 2; 3],-1), [0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0]) +%!assert (diag ([1; 2; 3],-2), [0, 0, 0, 0, 0; 0, 0, 0, 0, 0; 1, 0, 0, 0, 0; 0, 2, 0, 0, 0; 0, 0, 3, 0, 0]) + +%!assert (diag ([1, 0, 0; 0, 2, 0; 0, 0, 3]), [1; 2; 3]) +%!assert (diag ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0], 1), [1; 2; 3]) +%!assert (diag ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0], -1), [1; 2; 3]) +%!assert (diag (ones (1, 0), 2), zeros (2)) +%!assert (diag (1:3, 4, 2), [1, 0; 0, 2; 0, 0; 0, 0]) + +%!assert (full (diag (single ([1; 2; 3]))), single ([1, 0, 0; 0, 2, 0; 0, 0, 3])) +%!assert (diag (single ([1; 2; 3]), 1), single ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0])) +%!assert (diag (single ([1; 2; 3]), 2), single ([0, 0, 1, 0, 0; 0, 0, 0, 2, 0; 0, 0, 0, 0, 3; 0, 0, 0, 0, 0; 0, 0, 0, 0, 0])) +%!assert (diag (single ([1; 2; 3]),-1), single ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0])) +%!assert (diag (single ([1; 2; 3]),-2), single ([0, 0, 0, 0, 0; 0, 0, 0, 0, 0; 1, 0, 0, 0, 0; 0, 2, 0, 0, 0; 0, 0, 3, 0, 0])) + +%!assert (diag (single ([1, 0, 0; 0, 2, 0; 0, 0, 3])), single ([1; 2; 3])) +%!assert (diag (single ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0]), 1), single ([1; 2; 3])) +%!assert (diag (single ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0]), -1), single ([1; 2; 3])) + +%!assert (diag (int8 ([1; 2; 3])), int8 ([1, 0, 0; 0, 2, 0; 0, 0, 3])) +%!assert (diag (int8 ([1; 2; 3]), 1), int8 ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0])) +%!assert (diag (int8 ([1; 2; 3]), 2), int8 ([0, 0, 1, 0, 0; 0, 0, 0, 2, 0; 0, 0, 0, 0, 3; 0, 0, 0, 0, 0; 0, 0, 0, 0, 0])) +%!assert (diag (int8 ([1; 2; 3]),-1), int8 ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0])) +%!assert (diag (int8 ([1; 2; 3]),-2), int8 ([0, 0, 0, 0, 0; 0, 0, 0, 0, 0; 1, 0, 0, 0, 0; 0, 2, 0, 0, 0; 0, 0, 3, 0, 0])) + +%!assert (diag (int8 ([1, 0, 0; 0, 2, 0; 0, 0, 3])), int8 ([1; 2; 3])) +%!assert (diag (int8 ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0]), 1), int8 ([1; 2; 3])) +%!assert (diag (int8 ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0]), -1), int8 ([1; 2; 3])) + +## bug #37411 +%!assert (diag (diag ([5, 2, 3])(:,1)), diag([5 0 0 ])) +%!assert (diag (diag ([5, 2, 3])(:,1), 2), [0 0 5 0 0; zeros(4, 5)]) +%!assert (diag (diag ([5, 2, 3])(:,1), -2), [[0 0 5 0 0]', zeros(5, 4)]) + +## Test non-square size +%!assert (diag ([1,2,3], 6, 3), [1 0 0; 0 2 0; 0 0 3; 0 0 0; 0 0 0; 0 0 0]) +%!assert (diag (1, 2, 3), [1,0,0; 0,0,0]); +%!assert (diag ({1}, 2, 3), {1,[],[]; [],[],[]}); +%!assert (diag ({1,2}, 3, 4), {1,[],[],[]; [],2,[],[]; [],[],[],[]}); + +%% Test input validation +%!error diag () +%!error diag (1,2,3,4) +%!error diag (ones (2), 3, 3) +%!error diag (1:3, -4, 3) + +%!assert (diag (1, 3, 3), diag ([1, 0, 0])) +%!assert (diag (i, 3, 3), diag ([i, 0, 0])) +%!assert (diag (single (1), 3, 3), diag ([single(1), 0, 0])) +%!assert (diag (single (i), 3, 3), diag ([single(i), 0, 0])) +%!assert (diag ([1, 2], 3, 3), diag ([1, 2, 0])) +%!assert (diag ([1, 2]*i, 3, 3), diag ([1, 2, 0]*i)) +%!assert (diag (single ([1, 2]), 3, 3), diag (single ([1, 2, 0]))) +%!assert (diag (single ([1, 2]*i), 3, 3), diag (single ([1, 2, 0]*i))) +*/ + +DEFUN (prod, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} prod (@var{x})\n\ +@deftypefnx {Built-in Function} {} prod (@var{x}, @var{dim})\n\ +Product of elements along dimension @var{dim}. If @var{dim} is\n\ +omitted, it defaults to the first non-singleton dimension.\n\ +@seealso{cumprod, sum}\n\ +@end deftypefn") +{ + DATA_REDUCTION (prod); +} + +/* +%!assert (prod ([1, 2, 3]), 6) +%!assert (prod ([-1; -2; -3]), -6) +%!assert (prod ([i, 2+i, -3+2i, 4]), -4 - 32i) +%!assert (prod ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i]), [-1+i, -8+8i, -27+27i]) + +%!assert (prod (single ([1, 2, 3])), single (6)) +%!assert (prod (single ([-1; -2; -3])), single (-6)) +%!assert (prod (single ([i, 2+i, -3+2i, 4])), single (-4 - 32i)) +%!assert (prod (single ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single ([-1+i, -8+8i, -27+27i])) + +%!assert (prod ([1, 2; 3, 4], 1), [3, 8]) +%!assert (prod ([1, 2; 3, 4], 2), [2; 12]) +%!assert (prod (zeros (1, 0)), 1) +%!assert (prod (zeros (1, 0), 1), zeros (1, 0)) +%!assert (prod (zeros (1, 0), 2), 1) +%!assert (prod (zeros (0, 1)), 1) +%!assert (prod (zeros (0, 1), 1), 1) +%!assert (prod (zeros (0, 1), 2), zeros (0, 1)) +%!assert (prod (zeros (2, 0)), zeros (1, 0)) +%!assert (prod (zeros (2, 0), 1), zeros (1, 0)) +%!assert (prod (zeros (2, 0), 2), [1; 1]) +%!assert (prod (zeros (0, 2)), [1, 1]) +%!assert (prod (zeros (0, 2), 1), [1, 1]) +%!assert (prod (zeros (0, 2), 2), zeros (0, 1)) + +%!assert (prod (single ([1, 2; 3, 4]), 1), single ([3, 8])) +%!assert (prod (single ([1, 2; 3, 4]), 2), single ([2; 12])) +%!assert (prod (zeros (1, 0, "single")), single (1)) +%!assert (prod (zeros (1, 0, "single"), 1), zeros (1, 0, "single")) +%!assert (prod (zeros (1, 0, "single"), 2), single (1)) +%!assert (prod (zeros (0, 1, "single")), single (1)) +%!assert (prod (zeros (0, 1, "single"), 1), single (1)) +%!assert (prod (zeros (0, 1, "single"), 2), zeros (0, 1, "single")) +%!assert (prod (zeros (2, 0, "single")), zeros (1, 0, "single")) +%!assert (prod (zeros (2, 0, "single"), 1), zeros (1, 0, "single")) +%!assert (prod (zeros (2, 0, "single"), 2), single ([1; 1])) +%!assert (prod (zeros (0, 2, "single")), single ([1, 1])) +%!assert (prod (zeros (0, 2, "single"), 1), single ([1, 1])) +%!assert (prod (zeros (0, 2, "single"), 2), zeros (0, 1, "single")) + +%!error prod () +*/ + +static bool +all_scalar_1x1 (const octave_value_list& args) +{ + int n_args = args.length (); + for (int i = 0; i < n_args; i++) + if (args(i).numel () != 1) + return false; + + return true; +} + +template +static void +single_type_concat (Array& result, + const octave_value_list& args, + int dim) +{ + int n_args = args.length (); + if (! (equal_types::value + || equal_types::value) + && all_scalar_1x1 (args)) + { + // Optimize all scalars case. + dim_vector dv (1, 1); + if (dim == -1 || dim == -2) + dim = -dim - 1; + else if (dim >= 2) + dv.resize (dim+1, 1); + dv(dim) = n_args; + + result.clear (dv); + + for (int j = 0; j < n_args && ! error_state; j++) + { + octave_quit (); + + result(j) = octave_value_extract (args(j)); + } + } + else + { + OCTAVE_LOCAL_BUFFER (Array, array_list, n_args); + + for (int j = 0; j < n_args && ! error_state; j++) + { + octave_quit (); + + array_list[j] = octave_value_extract (args(j)); + } + + if (! error_state) + result = Array::cat (dim, n_args, array_list); + } +} + +template +static void +single_type_concat (Sparse& result, + const octave_value_list& args, + int dim) +{ + int n_args = args.length (); + OCTAVE_LOCAL_BUFFER (Sparse, sparse_list, n_args); + + for (int j = 0; j < n_args && ! error_state; j++) + { + octave_quit (); + + sparse_list[j] = octave_value_extract (args(j)); + } + + if (! error_state) + result = Sparse::cat (dim, n_args, sparse_list); +} + +// Dispatcher. +template +static TYPE +do_single_type_concat (const octave_value_list& args, int dim) +{ + TYPE result; + + single_type_concat (result, args, dim); + + return result; +} + +template +static void +single_type_concat_map (octave_map& result, + const octave_value_list& args, + int dim) +{ + int n_args = args.length (); + OCTAVE_LOCAL_BUFFER (MAP, map_list, n_args); + + for (int j = 0; j < n_args && ! error_state; j++) + { + octave_quit (); + + map_list[j] = octave_value_extract (args(j)); + } + + if (! error_state) + result = octave_map::cat (dim, n_args, map_list); +} + +static octave_map +do_single_type_concat_map (const octave_value_list& args, + int dim) +{ + octave_map result; + if (all_scalar_1x1 (args)) // optimize all scalars case. + single_type_concat_map (result, args, dim); + else + single_type_concat_map (result, args, dim); + + return result; +} + +static octave_value +attempt_type_conversion (const octave_value& ov, std::string dtype) +{ + octave_value retval; + + // First try to find function in the class of OV that can convert to + // the dispatch type dtype. It will have the name of the dispatch + // type. + + std::string cname = ov.class_name (); + + octave_value fcn = symbol_table::find_method (dtype, cname); + + if (fcn.is_defined ()) + { + octave_value_list result + = fcn.do_multi_index_op (1, octave_value_list (1, ov)); + + if (! error_state && result.length () > 0) + retval = result(0); + else + error ("conversion from %s to %s failed", dtype.c_str (), + cname.c_str ()); + } + else + { + // No conversion function available. Try the constructor for the + // dispatch type. + + fcn = symbol_table::find_method (dtype, dtype); + + if (fcn.is_defined ()) + { + octave_value_list result + = fcn.do_multi_index_op (1, octave_value_list (1, ov)); + + if (! error_state && result.length () > 0) + retval = result(0); + else + error ("%s constructor failed for %s argument", dtype.c_str (), + cname.c_str ()); + } + else + error ("no constructor for %s!", dtype.c_str ()); + } + + return retval; +} + +octave_value +do_class_concat (const octave_value_list& ovl, std::string cattype, int dim) +{ + octave_value retval; + + // Get dominant type for list + + std::string dtype = get_dispatch_type (ovl); + + octave_value fcn = symbol_table::find_method (cattype, dtype); + + if (fcn.is_defined ()) + { + // Have method for dominant type, so call it and let it handle + // conversions. + + octave_value_list tmp2 = fcn.do_multi_index_op (1, ovl); + + if (! error_state) + { + if (tmp2.length () > 0) + retval = tmp2(0); + else + { + error ("%s/%s method did not return a value", + dtype.c_str (), cattype.c_str ()); + goto done; + } + } + else + goto done; + } + else + { + // No method for dominant type, so attempt type conversions for + // all elements that are not of the dominant type, then do the + // default operation for octave_class values. + + octave_idx_type j = 0; + octave_idx_type len = ovl.length (); + octave_value_list tmp (len, octave_value ()); + for (octave_idx_type k = 0; k < len; k++) + { + octave_value elt = ovl(k); + + std::string t1_type = elt.class_name (); + + if (t1_type == dtype) + tmp(j++) = elt; + else if (elt.is_object () || ! elt.is_empty ()) + { + tmp(j++) = attempt_type_conversion (elt, dtype); + + if (error_state) + goto done; + } + } + + tmp.resize (j); + + octave_map m = do_single_type_concat_map (tmp, dim); + + std::string cname = tmp(0).class_name (); + std::list parents = tmp(0).parent_class_name_list (); + + retval = octave_value (new octave_class (m, cname, parents)); + } + + done: + return retval; +} + +static octave_value +do_cat (const octave_value_list& xargs, int dim, std::string fname) +{ + octave_value retval; + + // We may need to convert elements of the list to cells, so make a + // copy. This should be efficient, it is done mostly by incrementing + // reference counts. + octave_value_list args = xargs; + + int n_args = args.length (); + + if (n_args == 0) + retval = Matrix (); + else if (n_args == 1) + retval = args(0); + else if (n_args > 1) + { + std::string result_type; + + bool all_sq_strings_p = true; + bool all_dq_strings_p = true; + bool all_real_p = true; + bool all_cmplx_p = true; + bool any_sparse_p = false; + bool any_cell_p = false; + bool any_class_p = false; + + bool first_elem_is_struct = false; + + for (int i = 0; i < n_args; i++) + { + if (i == 0) + { + result_type = args(i).class_name (); + + first_elem_is_struct = args(i).is_map (); + } + else + result_type = get_concat_class (result_type, args(i).class_name ()); + + if (all_sq_strings_p && ! args(i).is_sq_string ()) + all_sq_strings_p = false; + if (all_dq_strings_p && ! args(i).is_dq_string ()) + all_dq_strings_p = false; + if (all_real_p && ! args(i).is_real_type ()) + all_real_p = false; + if (all_cmplx_p && ! (args(i).is_complex_type () || args(i).is_real_type ())) + all_cmplx_p = false; + if (!any_sparse_p && args(i).is_sparse_type ()) + any_sparse_p = true; + if (!any_cell_p && args(i).is_cell ()) + any_cell_p = true; + if (!any_class_p && args(i).is_object ()) + any_class_p = true; + } + + if (any_cell_p && ! any_class_p && ! first_elem_is_struct) + { + for (int i = 0; i < n_args; i++) + { + if (! args(i).is_cell ()) + args(i) = Cell (args(i)); + } + } + + if (any_class_p) + { + retval = do_class_concat (args, fname, dim); + } + else if (result_type == "double") + { + if (any_sparse_p) + { + if (all_real_p) + retval = do_single_type_concat (args, dim); + else + retval = do_single_type_concat (args, dim); + } + else + { + if (all_real_p) + retval = do_single_type_concat (args, dim); + else + retval = do_single_type_concat (args, dim); + } + } + else if (result_type == "single") + { + if (all_real_p) + retval = do_single_type_concat (args, dim); + else + retval = do_single_type_concat (args, dim); + } + else if (result_type == "char") + { + char type = all_dq_strings_p ? '"' : '\''; + + maybe_warn_string_concat (all_dq_strings_p, all_sq_strings_p); + + charNDArray result = do_single_type_concat (args, dim); + + retval = octave_value (result, type); + } + else if (result_type == "logical") + { + if (any_sparse_p) + retval = do_single_type_concat (args, dim); + else + retval = do_single_type_concat (args, dim); + } + else if (result_type == "int8") + retval = do_single_type_concat (args, dim); + else if (result_type == "int16") + retval = do_single_type_concat (args, dim); + else if (result_type == "int32") + retval = do_single_type_concat (args, dim); + else if (result_type == "int64") + retval = do_single_type_concat (args, dim); + else if (result_type == "uint8") + retval = do_single_type_concat (args, dim); + else if (result_type == "uint16") + retval = do_single_type_concat (args, dim); + else if (result_type == "uint32") + retval = do_single_type_concat (args, dim); + else if (result_type == "uint64") + retval = do_single_type_concat (args, dim); + else if (result_type == "cell") + retval = do_single_type_concat (args, dim); + else if (result_type == "struct") + retval = do_single_type_concat_map (args, dim); + else + { + dim_vector dv = args(0).dims (); + + // Default concatenation. + bool (dim_vector::*concat_rule) (const dim_vector&, int) = &dim_vector::concat; + + if (dim == -1 || dim == -2) + { + concat_rule = &dim_vector::hvcat; + dim = -dim - 1; + } + + for (int i = 1; i < args.length (); i++) + { + if (! (dv.*concat_rule) (args(i).dims (), dim)) + { + // Dimensions do not match. + error ("cat: dimension mismatch"); + return retval; + } + } + + // The lines below might seem crazy, since we take a copy + // of the first argument, resize it to be empty and then resize + // it to be full. This is done since it means that there is no + // recopying of data, as would happen if we used a single resize. + // It should be noted that resize operation is also significantly + // slower than the do_cat_op function, so it makes sense to have + // an empty matrix and copy all data. + // + // We might also start with a empty octave_value using + // tmp = octave_value_typeinfo::lookup_type + // (args(1).type_name()); + // and then directly resize. However, for some types there might + // be some additional setup needed, and so this should be avoided. + + octave_value tmp = args (0); + tmp = tmp.resize (dim_vector (0,0)).resize (dv); + + if (error_state) + return retval; + + int dv_len = dv.length (); + Array ra_idx (dim_vector (dv_len, 1), 0); + + for (int j = 0; j < n_args; j++) + { + // Can't fast return here to skip empty matrices as something + // like cat (1,[],single ([])) must return an empty matrix of + // the right type. + tmp = do_cat_op (tmp, args (j), ra_idx); + + if (error_state) + return retval; + + dim_vector dv_tmp = args (j).dims (); + + if (dim >= dv_len) + { + if (j > 1) + error ("%s: indexing error", fname.c_str ()); + break; + } + else + ra_idx (dim) += (dim < dv_tmp.length () ? + dv_tmp (dim) : 1); + } + retval = tmp; + } + } + else + print_usage (); + + return retval; +} + +DEFUN (horzcat, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} horzcat (@var{array1}, @var{array2}, @dots{}, @var{arrayN})\n\ +Return the horizontal concatenation of N-D array objects, @var{array1},\n\ +@var{array2}, @dots{}, @var{arrayN} along dimension 2.\n\ +\n\ +Arrays may also be concatenated horizontally using the syntax for creating\n\ +new matrices. For example:\n\ +\n\ +@example\n\ +@var{hcat} = [ @var{array1}, @var{array2}, @dots{} ]\n\ +@end example\n\ +@seealso{cat, vertcat}\n\ +@end deftypefn") +{ + return do_cat (args, -2, "horzcat"); +} + +/* +## Test concatenation with all zero matrices +%!assert (horzcat ("", 65*ones (1,10)), "AAAAAAAAAA"); +%!assert (horzcat (65*ones (1,10), ""), "AAAAAAAAAA"); + +%!assert (class (horzcat (int64 (1), int64 (1))), "int64") +%!assert (class (horzcat (int64 (1), int32 (1))), "int64") +%!assert (class (horzcat (int64 (1), int16 (1))), "int64") +%!assert (class (horzcat (int64 (1), int8 (1))), "int64") +%!assert (class (horzcat (int64 (1), uint64 (1))), "int64") +%!assert (class (horzcat (int64 (1), uint32 (1))), "int64") +%!assert (class (horzcat (int64 (1), uint16 (1))), "int64") +%!assert (class (horzcat (int64 (1), uint8 (1))), "int64") +%!assert (class (horzcat (int64 (1), single (1))), "int64") +%!assert (class (horzcat (int64 (1), double (1))), "int64") +%!assert (class (horzcat (int64 (1), cell (1))), "cell") +%!assert (class (horzcat (int64 (1), true)), "int64") +%!assert (class (horzcat (int64 (1), "a")), "char") + +%!assert (class (horzcat (int32 (1), int64 (1))), "int32") +%!assert (class (horzcat (int32 (1), int32 (1))), "int32") +%!assert (class (horzcat (int32 (1), int16 (1))), "int32") +%!assert (class (horzcat (int32 (1), int8 (1))), "int32") +%!assert (class (horzcat (int32 (1), uint64 (1))), "int32") +%!assert (class (horzcat (int32 (1), uint32 (1))), "int32") +%!assert (class (horzcat (int32 (1), uint16 (1))), "int32") +%!assert (class (horzcat (int32 (1), uint8 (1))), "int32") +%!assert (class (horzcat (int32 (1), single (1))), "int32") +%!assert (class (horzcat (int32 (1), double (1))), "int32") +%!assert (class (horzcat (int32 (1), cell (1))), "cell") +%!assert (class (horzcat (int32 (1), true)), "int32") +%!assert (class (horzcat (int32 (1), "a")), "char") + +%!assert (class (horzcat (int16 (1), int64 (1))), "int16") +%!assert (class (horzcat (int16 (1), int32 (1))), "int16") +%!assert (class (horzcat (int16 (1), int16 (1))), "int16") +%!assert (class (horzcat (int16 (1), int8 (1))), "int16") +%!assert (class (horzcat (int16 (1), uint64 (1))), "int16") +%!assert (class (horzcat (int16 (1), uint32 (1))), "int16") +%!assert (class (horzcat (int16 (1), uint16 (1))), "int16") +%!assert (class (horzcat (int16 (1), uint8 (1))), "int16") +%!assert (class (horzcat (int16 (1), single (1))), "int16") +%!assert (class (horzcat (int16 (1), double (1))), "int16") +%!assert (class (horzcat (int16 (1), cell (1))), "cell") +%!assert (class (horzcat (int16 (1), true)), "int16") +%!assert (class (horzcat (int16 (1), "a")), "char") + +%!assert (class (horzcat (int8 (1), int64 (1))), "int8") +%!assert (class (horzcat (int8 (1), int32 (1))), "int8") +%!assert (class (horzcat (int8 (1), int16 (1))), "int8") +%!assert (class (horzcat (int8 (1), int8 (1))), "int8") +%!assert (class (horzcat (int8 (1), uint64 (1))), "int8") +%!assert (class (horzcat (int8 (1), uint32 (1))), "int8") +%!assert (class (horzcat (int8 (1), uint16 (1))), "int8") +%!assert (class (horzcat (int8 (1), uint8 (1))), "int8") +%!assert (class (horzcat (int8 (1), single (1))), "int8") +%!assert (class (horzcat (int8 (1), double (1))), "int8") +%!assert (class (horzcat (int8 (1), cell (1))), "cell") +%!assert (class (horzcat (int8 (1), true)), "int8") +%!assert (class (horzcat (int8 (1), "a")), "char") + +%!assert (class (horzcat (uint64 (1), int64 (1))), "uint64") +%!assert (class (horzcat (uint64 (1), int32 (1))), "uint64") +%!assert (class (horzcat (uint64 (1), int16 (1))), "uint64") +%!assert (class (horzcat (uint64 (1), int8 (1))), "uint64") +%!assert (class (horzcat (uint64 (1), uint64 (1))), "uint64") +%!assert (class (horzcat (uint64 (1), uint32 (1))), "uint64") +%!assert (class (horzcat (uint64 (1), uint16 (1))), "uint64") +%!assert (class (horzcat (uint64 (1), uint8 (1))), "uint64") +%!assert (class (horzcat (uint64 (1), single (1))), "uint64") +%!assert (class (horzcat (uint64 (1), double (1))), "uint64") +%!assert (class (horzcat (uint64 (1), cell (1))), "cell") +%!assert (class (horzcat (uint64 (1), true)), "uint64") +%!assert (class (horzcat (uint64 (1), "a")), "char") + +%!assert (class (horzcat (uint32 (1), int64 (1))), "uint32") +%!assert (class (horzcat (uint32 (1), int32 (1))), "uint32") +%!assert (class (horzcat (uint32 (1), int16 (1))), "uint32") +%!assert (class (horzcat (uint32 (1), int8 (1))), "uint32") +%!assert (class (horzcat (uint32 (1), uint64 (1))), "uint32") +%!assert (class (horzcat (uint32 (1), uint32 (1))), "uint32") +%!assert (class (horzcat (uint32 (1), uint16 (1))), "uint32") +%!assert (class (horzcat (uint32 (1), uint8 (1))), "uint32") +%!assert (class (horzcat (uint32 (1), single (1))), "uint32") +%!assert (class (horzcat (uint32 (1), double (1))), "uint32") +%!assert (class (horzcat (uint32 (1), cell (1))), "cell") +%!assert (class (horzcat (uint32 (1), true)), "uint32") +%!assert (class (horzcat (uint32 (1), "a")), "char") + +%!assert (class (horzcat (uint16 (1), int64 (1))), "uint16") +%!assert (class (horzcat (uint16 (1), int32 (1))), "uint16") +%!assert (class (horzcat (uint16 (1), int16 (1))), "uint16") +%!assert (class (horzcat (uint16 (1), int8 (1))), "uint16") +%!assert (class (horzcat (uint16 (1), uint64 (1))), "uint16") +%!assert (class (horzcat (uint16 (1), uint32 (1))), "uint16") +%!assert (class (horzcat (uint16 (1), uint16 (1))), "uint16") +%!assert (class (horzcat (uint16 (1), uint8 (1))), "uint16") +%!assert (class (horzcat (uint16 (1), single (1))), "uint16") +%!assert (class (horzcat (uint16 (1), double (1))), "uint16") +%!assert (class (horzcat (uint16 (1), cell (1))), "cell") +%!assert (class (horzcat (uint16 (1), true)), "uint16") +%!assert (class (horzcat (uint16 (1), "a")), "char") + +%!assert (class (horzcat (uint8 (1), int64 (1))), "uint8") +%!assert (class (horzcat (uint8 (1), int32 (1))), "uint8") +%!assert (class (horzcat (uint8 (1), int16 (1))), "uint8") +%!assert (class (horzcat (uint8 (1), int8 (1))), "uint8") +%!assert (class (horzcat (uint8 (1), uint64 (1))), "uint8") +%!assert (class (horzcat (uint8 (1), uint32 (1))), "uint8") +%!assert (class (horzcat (uint8 (1), uint16 (1))), "uint8") +%!assert (class (horzcat (uint8 (1), uint8 (1))), "uint8") +%!assert (class (horzcat (uint8 (1), single (1))), "uint8") +%!assert (class (horzcat (uint8 (1), double (1))), "uint8") +%!assert (class (horzcat (uint8 (1), cell (1))), "cell") +%!assert (class (horzcat (uint8 (1), true)), "uint8") +%!assert (class (horzcat (uint8 (1), "a")), "char") + +%!assert (class (horzcat (single (1), int64 (1))), "int64") +%!assert (class (horzcat (single (1), int32 (1))), "int32") +%!assert (class (horzcat (single (1), int16 (1))), "int16") +%!assert (class (horzcat (single (1), int8 (1))), "int8") +%!assert (class (horzcat (single (1), uint64 (1))), "uint64") +%!assert (class (horzcat (single (1), uint32 (1))), "uint32") +%!assert (class (horzcat (single (1), uint16 (1))), "uint16") +%!assert (class (horzcat (single (1), uint8 (1))), "uint8") +%!assert (class (horzcat (single (1), single (1))), "single") +%!assert (class (horzcat (single (1), double (1))), "single") +%!assert (class (horzcat (single (1), cell (1))), "cell") +%!assert (class (horzcat (single (1), true)), "single") +%!assert (class (horzcat (single (1), "a")), "char") + +%!assert (class (horzcat (double (1), int64 (1))), "int64") +%!assert (class (horzcat (double (1), int32 (1))), "int32") +%!assert (class (horzcat (double (1), int16 (1))), "int16") +%!assert (class (horzcat (double (1), int8 (1))), "int8") +%!assert (class (horzcat (double (1), uint64 (1))), "uint64") +%!assert (class (horzcat (double (1), uint32 (1))), "uint32") +%!assert (class (horzcat (double (1), uint16 (1))), "uint16") +%!assert (class (horzcat (double (1), uint8 (1))), "uint8") +%!assert (class (horzcat (double (1), single (1))), "single") +%!assert (class (horzcat (double (1), double (1))), "double") +%!assert (class (horzcat (double (1), cell (1))), "cell") +%!assert (class (horzcat (double (1), true)), "double") +%!assert (class (horzcat (double (1), "a")), "char") + +%!assert (class (horzcat (cell (1), int64 (1))), "cell") +%!assert (class (horzcat (cell (1), int32 (1))), "cell") +%!assert (class (horzcat (cell (1), int16 (1))), "cell") +%!assert (class (horzcat (cell (1), int8 (1))), "cell") +%!assert (class (horzcat (cell (1), uint64 (1))), "cell") +%!assert (class (horzcat (cell (1), uint32 (1))), "cell") +%!assert (class (horzcat (cell (1), uint16 (1))), "cell") +%!assert (class (horzcat (cell (1), uint8 (1))), "cell") +%!assert (class (horzcat (cell (1), single (1))), "cell") +%!assert (class (horzcat (cell (1), double (1))), "cell") +%!assert (class (horzcat (cell (1), cell (1))), "cell") +%!assert (class (horzcat (cell (1), true)), "cell") +%!assert (class (horzcat (cell (1), "a")), "cell") + +%!assert (class (horzcat (true, int64 (1))), "int64") +%!assert (class (horzcat (true, int32 (1))), "int32") +%!assert (class (horzcat (true, int16 (1))), "int16") +%!assert (class (horzcat (true, int8 (1))), "int8") +%!assert (class (horzcat (true, uint64 (1))), "uint64") +%!assert (class (horzcat (true, uint32 (1))), "uint32") +%!assert (class (horzcat (true, uint16 (1))), "uint16") +%!assert (class (horzcat (true, uint8 (1))), "uint8") +%!assert (class (horzcat (true, single (1))), "single") +%!assert (class (horzcat (true, double (1))), "double") +%!assert (class (horzcat (true, cell (1))), "cell") +%!assert (class (horzcat (true, true)), "logical") +%!assert (class (horzcat (true, "a")), "char") + +%!assert (class (horzcat ("a", int64 (1))), "char") +%!assert (class (horzcat ("a", int32 (1))), "char") +%!assert (class (horzcat ("a", int16 (1))), "char") +%!assert (class (horzcat ("a", int8 (1))), "char") +%!assert (class (horzcat ("a", int64 (1))), "char") +%!assert (class (horzcat ("a", int32 (1))), "char") +%!assert (class (horzcat ("a", int16 (1))), "char") +%!assert (class (horzcat ("a", int8 (1))), "char") +%!assert (class (horzcat ("a", single (1))), "char") +%!assert (class (horzcat ("a", double (1))), "char") +%!assert (class (horzcat ("a", cell (1))), "cell") +%!assert (class (horzcat ("a", true)), "char") +%!assert (class (horzcat ("a", "a")), "char") + +%!assert (class (horzcat (cell (1), struct ("foo", "bar"))), "cell") + +%!error horzcat (struct ("foo", "bar"), cell (1)) +*/ + +DEFUN (vertcat, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} vertcat (@var{array1}, @var{array2}, @dots{}, @var{arrayN})\n\ +Return the vertical concatenation of N-D array objects, @var{array1},\n\ +@var{array2}, @dots{}, @var{arrayN} along dimension 1.\n\ +\n\ +Arrays may also be concatenated vertically using the syntax for creating\n\ +new matrices. For example:\n\ +\n\ +@example\n\ +@var{vcat} = [ @var{array1}; @var{array2}; @dots{} ]\n\ +@end example\n\ +@seealso{cat, horzcat}\n\ +@end deftypefn") +{ + return do_cat (args, -1, "vertcat"); +} + +/* +%!test +%! c = {"foo"; "bar"; "bazoloa"}; +%! assert (vertcat (c, "a", "bc", "def"), {"foo"; "bar"; "bazoloa"; "a"; "bc"; "def"}); +*/ + +DEFUN (cat, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} cat (@var{dim}, @var{array1}, @var{array2}, @dots{}, @var{arrayN})\n\ +Return the concatenation of N-D array objects, @var{array1},\n\ +@var{array2}, @dots{}, @var{arrayN} along dimension @var{dim}.\n\ +\n\ +@example\n\ +@group\n\ +A = ones (2, 2);\n\ +B = zeros (2, 2);\n\ +cat (2, A, B)\n\ + @result{} 1 1 0 0\n\ + 1 1 0 0\n\ +@end group\n\ +@end example\n\ +\n\ +Alternatively, we can concatenate @var{A} and @var{B} along the\n\ +second dimension in the following way:\n\ +\n\ +@example\n\ +@group\n\ +[A, B]\n\ +@end group\n\ +@end example\n\ +\n\ +@var{dim} can be larger than the dimensions of the N-D array objects\n\ +and the result will thus have @var{dim} dimensions as the\n\ +following example shows:\n\ +\n\ +@example\n\ +@group\n\ +cat (4, ones (2, 2), zeros (2, 2))\n\ + @result{} ans(:,:,1,1) =\n\ +\n\ + 1 1\n\ + 1 1\n\ +\n\ + ans(:,:,1,2) =\n\ +\n\ + 0 0\n\ + 0 0\n\ +@end group\n\ +@end example\n\ +@seealso{horzcat, vertcat}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () > 0) + { + int dim = args(0).int_value () - 1; + + if (! error_state) + { + if (dim >= 0) + retval = do_cat (args.slice (1, args.length () - 1), dim, "cat"); + else + error ("cat: DIM must be a valid dimension"); + } + else + error ("cat: DIM must be an integer"); + } + else + print_usage (); + + return retval; +} + +/* +%!function ret = __testcat (t1, t2, tr, cmplx) +%! assert (cat (1, cast ([], t1), cast ([], t2)), cast ([], tr)); +%! +%! assert (cat (1, cast (1, t1), cast (2, t2)), cast ([1; 2], tr)); +%! assert (cat (1, cast (1, t1), cast ([2; 3], t2)), cast ([1; 2; 3], tr)); +%! assert (cat (1, cast ([1; 2], t1), cast (3, t2)), cast ([1; 2; 3], tr)); +%! assert (cat (1, cast ([1; 2], t1), cast ([3; 4], t2)), cast ([1; 2; 3; 4], tr)); +%! assert (cat (2, cast (1, t1), cast (2, t2)), cast ([1, 2], tr)); +%! assert (cat (2, cast (1, t1), cast ([2, 3], t2)), cast ([1, 2, 3], tr)); +%! assert (cat (2, cast ([1, 2], t1), cast (3, t2)), cast ([1, 2, 3], tr)); +%! assert (cat (2, cast ([1, 2], t1), cast ([3, 4], t2)), cast ([1, 2, 3, 4], tr)); +%! +%! assert ([cast(1, t1); cast(2, t2)], cast ([1; 2], tr)); +%! assert ([cast(1, t1); cast([2; 3], t2)], cast ([1; 2; 3], tr)); +%! assert ([cast([1; 2], t1); cast(3, t2)], cast ([1; 2; 3], tr)); +%! assert ([cast([1; 2], t1); cast([3; 4], t2)], cast ([1; 2; 3; 4], tr)); +%! assert ([cast(1, t1), cast(2, t2)], cast ([1, 2], tr)); +%! assert ([cast(1, t1), cast([2, 3], t2)], cast ([1, 2, 3], tr)); +%! assert ([cast([1, 2], t1), cast(3, t2)], cast ([1, 2, 3], tr)); +%! assert ([cast([1, 2], t1), cast([3, 4], t2)], cast ([1, 2, 3, 4], tr)); +%! +%! if (nargin == 3 || cmplx) +%! assert (cat (1, cast (1i, t1), cast (2, t2)), cast ([1i; 2], tr)); +%! assert (cat (1, cast (1i, t1), cast ([2; 3], t2)), cast ([1i; 2; 3], tr)); +%! assert (cat (1, cast ([1i; 2], t1), cast (3, t2)), cast ([1i; 2; 3], tr)); +%! assert (cat (1, cast ([1i; 2], t1), cast ([3; 4], t2)), cast ([1i; 2; 3; 4], tr)); +%! assert (cat (2, cast (1i, t1), cast (2, t2)), cast ([1i, 2], tr)); +%! assert (cat (2, cast (1i, t1), cast ([2, 3], t2)), cast ([1i, 2, 3], tr)); +%! assert (cat (2, cast ([1i, 2], t1), cast (3, t2)), cast ([1i, 2, 3], tr)); +%! assert (cat (2, cast ([1i, 2], t1), cast ([3, 4], t2)), cast ([1i, 2, 3, 4], tr)); +%! +%! assert ([cast(1i, t1); cast(2, t2)], cast ([1i; 2], tr)); +%! assert ([cast(1i, t1); cast([2; 3], t2)], cast ([1i; 2; 3], tr)); +%! assert ([cast([1i; 2], t1); cast(3, t2)], cast ([1i; 2; 3], tr)); +%! assert ([cast([1i; 2], t1); cast([3; 4], t2)], cast ([1i; 2; 3; 4], tr)); +%! assert ([cast(1i, t1), cast(2, t2)], cast ([1i, 2], tr)); +%! assert ([cast(1i, t1), cast([2, 3], t2)], cast ([1i, 2, 3], tr)); +%! assert ([cast([1i, 2], t1), cast(3, t2)], cast ([1i, 2, 3], tr)); +%! assert ([cast([1i, 2], t1), cast([3, 4], t2)], cast ([1i, 2, 3, 4], tr)); +%! +%! assert (cat (1, cast (1, t1), cast (2i, t2)), cast ([1; 2i], tr)); +%! assert (cat (1, cast (1, t1), cast ([2i; 3], t2)), cast ([1; 2i; 3], tr)); +%! assert (cat (1, cast ([1; 2], t1), cast (3i, t2)), cast ([1; 2; 3i], tr)); +%! assert (cat (1, cast ([1; 2], t1), cast ([3i; 4], t2)), cast ([1; 2; 3i; 4], tr)); +%! assert (cat (2, cast (1, t1), cast (2i, t2)), cast ([1, 2i], tr)); +%! assert (cat (2, cast (1, t1), cast ([2i, 3], t2)), cast ([1, 2i, 3], tr)); +%! assert (cat (2, cast ([1, 2], t1), cast (3i, t2)), cast ([1, 2, 3i], tr)); +%! assert (cat (2, cast ([1, 2], t1), cast ([3i, 4], t2)), cast ([1, 2, 3i, 4], tr)); +%! +%! assert ([cast(1, t1); cast(2i, t2)], cast ([1; 2i], tr)); +%! assert ([cast(1, t1); cast([2i; 3], t2)], cast ([1; 2i; 3], tr)); +%! assert ([cast([1; 2], t1); cast(3i, t2)], cast ([1; 2; 3i], tr)); +%! assert ([cast([1; 2], t1); cast([3i; 4], t2)], cast ([1; 2; 3i; 4], tr)); +%! assert ([cast(1, t1), cast(2i, t2)], cast ([1, 2i], tr)); +%! assert ([cast(1, t1), cast([2i, 3], t2)], cast ([1, 2i, 3], tr)); +%! assert ([cast([1, 2], t1), cast(3i, t2)], cast ([1, 2, 3i], tr)); +%! assert ([cast([1, 2], t1), cast([3i, 4], t2)], cast ([1, 2, 3i, 4], tr)); +%! +%! assert (cat (1, cast (1i, t1), cast (2i, t2)), cast ([1i; 2i], tr)); +%! assert (cat (1, cast (1i, t1), cast ([2i; 3], t2)), cast ([1i; 2i; 3], tr)); +%! assert (cat (1, cast ([1i; 2], t1), cast (3i, t2)), cast ([1i; 2; 3i], tr)); +%! assert (cat (1, cast ([1i; 2], t1), cast ([3i; 4], t2)), cast ([1i; 2; 3i; 4], tr)); +%! assert (cat (2, cast (1i, t1), cast (2i, t2)), cast ([1i, 2i], tr)); +%! assert (cat (2, cast (1i, t1), cast ([2i, 3], t2)), cast ([1i, 2i, 3], tr)); +%! assert (cat (2, cast ([1i, 2], t1), cast (3i, t2)), cast ([1i, 2, 3i], tr)); +%! assert (cat (2, cast ([1i, 2], t1), cast ([3i, 4], t2)), cast ([1i, 2, 3i, 4], tr)); +%! +%! assert ([cast(1i, t1); cast(2i, t2)], cast ([1i; 2i], tr)); +%! assert ([cast(1i, t1); cast([2i; 3], t2)], cast ([1i; 2i; 3], tr)); +%! assert ([cast([1i; 2], t1); cast(3i, t2)], cast ([1i; 2; 3i], tr)); +%! assert ([cast([1i; 2], t1); cast([3i; 4], t2)], cast ([1i; 2; 3i; 4], tr)); +%! assert ([cast(1i, t1), cast(2i, t2)], cast ([1i, 2i], tr)); +%! assert ([cast(1i, t1), cast([2i, 3], t2)], cast ([1i, 2i, 3], tr)); +%! assert ([cast([1i, 2], t1), cast(3i, t2)], cast ([1i, 2, 3i], tr)); +%! assert ([cast([1i, 2], t1), cast([3i, 4], t2)], cast ([1i, 2, 3i, 4], tr)); +%! endif +%! ret = true; +%!endfunction + +%!assert (__testcat ("double", "double", "double")) +%!assert (__testcat ("single", "double", "single")) +%!assert (__testcat ("double", "single", "single")) +%!assert (__testcat ("single", "single", "single")) + +%!assert (__testcat ("double", "int8", "int8", false)) +%!assert (__testcat ("int8", "double", "int8", false)) +%!assert (__testcat ("single", "int8", "int8", false)) +%!assert (__testcat ("int8", "single", "int8", false)) +%!assert (__testcat ("int8", "int8", "int8", false)) +%!assert (__testcat ("double", "int16", "int16", false)) +%!assert (__testcat ("int16", "double", "int16", false)) +%!assert (__testcat ("single", "int16", "int16", false)) +%!assert (__testcat ("int16", "single", "int16", false)) +%!assert (__testcat ("int16", "int16", "int16", false)) +%!assert (__testcat ("double", "int32", "int32", false)) +%!assert (__testcat ("int32", "double", "int32", false)) +%!assert (__testcat ("single", "int32", "int32", false)) +%!assert (__testcat ("int32", "single", "int32", false)) +%!assert (__testcat ("int32", "int32", "int32", false)) +%!assert (__testcat ("double", "int64", "int64", false)) +%!assert (__testcat ("int64", "double", "int64", false)) +%!assert (__testcat ("single", "int64", "int64", false)) +%!assert (__testcat ("int64", "single", "int64", false)) +%!assert (__testcat ("int64", "int64", "int64", false)) + +%!assert (__testcat ("double", "uint8", "uint8", false)) +%!assert (__testcat ("uint8", "double", "uint8", false)) +%!assert (__testcat ("single", "uint8", "uint8", false)) +%!assert (__testcat ("uint8", "single", "uint8", false)) +%!assert (__testcat ("uint8", "uint8", "uint8", false)) +%!assert (__testcat ("double", "uint16", "uint16", false)) +%!assert (__testcat ("uint16", "double", "uint16", false)) +%!assert (__testcat ("single", "uint16", "uint16", false)) +%!assert (__testcat ("uint16", "single", "uint16", false)) +%!assert (__testcat ("uint16", "uint16", "uint16", false)) +%!assert (__testcat ("double", "uint32", "uint32", false)) +%!assert (__testcat ("uint32", "double", "uint32", false)) +%!assert (__testcat ("single", "uint32", "uint32", false)) +%!assert (__testcat ("uint32", "single", "uint32", false)) +%!assert (__testcat ("uint32", "uint32", "uint32", false)) +%!assert (__testcat ("double", "uint64", "uint64", false)) +%!assert (__testcat ("uint64", "double", "uint64", false)) +%!assert (__testcat ("single", "uint64", "uint64", false)) +%!assert (__testcat ("uint64", "single", "uint64", false)) +%!assert (__testcat ("uint64", "uint64", "uint64", false)) + +%!assert (cat (3, [], [1,2;3,4]), [1,2;3,4]) +%!assert (cat (3, [1,2;3,4], []), [1,2;3,4]) +%!assert (cat (3, [], [1,2;3,4], []), [1,2;3,4]) +%!assert (cat (3, [], [], []), zeros (0, 0, 3)) + +%!assert (cat (3, [], [], 1, 2), cat (3, 1, 2)) +%!assert (cat (3, [], [], [1,2;3,4]), [1,2;3,4]) +%!assert (cat (4, [], [], [1,2;3,4]), [1,2;3,4]) + +%!assert ([zeros(3,2,2); ones(1,2,2)], repmat ([0;0;0;1],[1,2,2]) ) +%!assert ([zeros(3,2,2); ones(1,2,2)], vertcat (zeros (3,2,2), ones (1,2,2)) ) + +%!error cat (3, cat (3, [], []), [1,2;3,4]) +%!error cat (3, zeros (0, 0, 2), [1,2;3,4]) +*/ + +static octave_value +do_permute (const octave_value_list& args, bool inv) +{ + octave_value retval; + + if (args.length () == 2 && args(1).length () >= args(1).ndims ()) + { + Array vec = args(1).int_vector_value (); + + // FIXME -- maybe we should create an idx_vector object + // here and pass that to permute? + + int n = vec.length (); + + for (int i = 0; i < n; i++) + vec(i)--; + + octave_value ret = args(0).permute (vec, inv); + + if (! error_state) + retval = ret; + } + else + print_usage (); + + return retval; +} + +DEFUN (permute, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} permute (@var{A}, @var{perm})\n\ +Return the generalized transpose for an N-D array object @var{A}.\n\ +The permutation vector @var{perm} must contain the elements\n\ +@code{1:ndims (A)} (in any order, but each element must appear only once).\n\ +@seealso{ipermute}\n\ +@end deftypefn") +{ + return do_permute (args, false); +} + +DEFUN (ipermute, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ipermute (@var{A}, @var{iperm})\n\ +The inverse of the @code{permute} function. The expression\n\ +\n\ +@example\n\ +ipermute (permute (A, perm), perm)\n\ +@end example\n\ +\n\ +@noindent\n\ +returns the original array @var{A}.\n\ +@seealso{permute}\n\ +@end deftypefn") +{ + return do_permute (args, true); +} + +DEFUN (length, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} length (@var{a})\n\ +Return the \"length\" of the object @var{a}. For matrix objects, the\n\ +length is the number of rows or columns, whichever is greater (this\n\ +odd definition is used for compatibility with @sc{matlab}).\n\ +@seealso{size}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).length (); + else + print_usage (); + + return retval; +} + +DEFUN (ndims, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ndims (@var{a})\n\ +Return the number of dimensions of @var{a}.\n\ +For any array, the result will always be larger than or equal to 2.\n\ +Trailing singleton dimensions are not counted.\n\ +\n\ +@example\n\ +@group\n\ +ndims (ones (4, 1, 2, 1))\n\ + @result{} 3\n\ +@end group\n\ +@end example\n\ +@seealso{size}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).ndims (); + else + print_usage (); + + return retval; +} + +DEFUN (numel, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} numel (@var{a})\n\ +@deftypefnx {Built-in Function} {} numel (@var{a}, @var{idx1}, @var{idx2}, @dots{})\n\ +Return the number of elements in the object @var{a}.\n\ +Optionally, if indices @var{idx1}, @var{idx2}, @dots{} are supplied,\n\ +return the number of elements that would result from the indexing\n\ +\n\ +@example\n\ +@var{a}(@var{idx1}, @var{idx2}, @dots{})\n\ +@end example\n\ +\n\ +Note that the indices do not have to be numerical. For example,\n\ +\n\ +@example\n\ +@group\n\ +@var{a} = 1;\n\ +@var{b} = ones (2, 3);\n\ +numel (@var{a}, @var{b})\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +will return 6, as this is the number of ways to index with @var{b}.\n\ +\n\ +This method is also called when an object appears as lvalue with cs-list\n\ +indexing, i.e., @code{object@{@dots{}@}} or @code{object(@dots{}).field}.\n\ +@seealso{size}\n\ +@end deftypefn") +{ + octave_value retval; + octave_idx_type nargin = args.length (); + + if (nargin == 1) + retval = args(0).numel (); + else if (nargin > 1) + { + // Don't use numel (const octave_value_list&) here as that corresponds to + // an overloaded call, not to builtin! + retval = dims_to_numel (args(0).dims (), args.slice (1, nargin-1)); + } + else + print_usage (); + + return retval; +} + +DEFUN (size, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} size (@var{a})\n\ +@deftypefnx {Built-in Function} {} size (@var{a}, @var{dim})\n\ +Return the number of rows and columns of @var{a}.\n\ +\n\ +With one input argument and one output argument, the result is returned\n\ +in a row vector. If there are multiple output arguments, the number of\n\ +rows is assigned to the first, and the number of columns to the second,\n\ +etc. For example:\n\ +\n\ +@example\n\ +@group\n\ +size ([1, 2; 3, 4; 5, 6])\n\ + @result{} [ 3, 2 ]\n\ +\n\ +[nr, nc] = size ([1, 2; 3, 4; 5, 6])\n\ + @result{} nr = 3\n\ + @result{} nc = 2\n\ +@end group\n\ +@end example\n\ +\n\ +If given a second argument, @code{size} will return the size of the\n\ +corresponding dimension. For example,\n\ +\n\ +@example\n\ +@group\n\ +size ([1, 2; 3, 4; 5, 6], 2)\n\ + @result{} 2\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +returns the number of columns in the given matrix.\n\ +@seealso{numel, ndims, length, rows, columns}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 1) + { + const dim_vector dimensions = args(0).dims (); + + if (nargout > 1) + { + const dim_vector rdims = dimensions.redim (nargout); + retval.resize (nargout); + for (int i = 0; i < nargout; i++) + retval(i) = rdims(i); + } + else + { + int ndims = dimensions.length (); + + NoAlias m (1, ndims); + + for (int i = 0; i < ndims; i++) + m(i) = dimensions(i); + + retval(0) = m; + } + } + else if (nargin == 2 && nargout < 2) + { + octave_idx_type nd = args(1).int_value (true); + + if (error_state) + error ("size: DIM must be a scalar"); + else + { + const dim_vector dv = args(0).dims (); + + if (nd > 0) + { + if (nd <= dv.length ()) + retval(0) = dv(nd-1); + else + retval(0) = 1; + } + else + error ("size: requested dimension DIM (= %d) out of range", nd); + } + } + else + print_usage (); + + return retval; +} + +DEFUN (size_equal, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} size_equal (@var{a}, @var{b}, @dots{})\n\ +Return true if the dimensions of all arguments agree.\n\ +Trailing singleton dimensions are ignored.\n\ +Called with a single or no argument, size_equal returns true.\n\ +@seealso{size, numel, ndims}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + retval = true; + + if (nargin >= 1) + { + dim_vector a_dims = args(0).dims (); + + for (int i = 1; i < nargin; ++i) + { + dim_vector b_dims = args(i).dims (); + + if (a_dims != b_dims) + { + retval = false; + break; + } + } + } + + return retval; +} + +DEFUN (nnz, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{scalar} =} nnz (@var{a})\n\ +Return the number of non zero elements in @var{a}.\n\ +@seealso{sparse, nzmax}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).nnz (); + else + print_usage (); + + return retval; +} + +DEFUN (nzmax, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{scalar} =} nzmax (@var{SM})\n\ +Return the amount of storage allocated to the sparse matrix @var{SM}.\n\ +Note that Octave tends to crop unused memory at the first opportunity\n\ +for sparse objects. There are some cases of user created sparse objects\n\ +where the value returned by @dfn{nzmax} will not be the same as @dfn{nnz},\n\ +but in general they will give the same result.\n\ +@seealso{nnz, spalloc, sparse}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).nzmax (); + else + print_usage (); + + return retval; +} + +DEFUN (rows, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} rows (@var{a})\n\ +Return the number of rows of @var{a}.\n\ +@seealso{columns, size, length, numel, isscalar, isvector, ismatrix}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).rows (); + else + print_usage (); + + return retval; +} + +DEFUN (columns, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} columns (@var{a})\n\ +Return the number of columns of @var{a}.\n\ +@seealso{rows, size, length, numel, isscalar, isvector, ismatrix}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).columns (); + else + print_usage (); + + return retval; +} + +DEFUN (sum, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} sum (@var{x})\n\ +@deftypefnx {Built-in Function} {} sum (@var{x}, @var{dim})\n\ +@deftypefnx {Built-in Function} {} sum (@dots{}, \"native\")\n\ +@deftypefnx {Built-in Function} {} sum (@dots{}, \"double\")\n\ +@deftypefnx {Built-in Function} {} sum (@dots{}, \"extra\")\n\ +Sum of elements along dimension @var{dim}. If @var{dim} is\n\ +omitted, it defaults to the first non-singleton dimension.\n\ +\n\ +If the optional argument \"native\" is given, then the sum is performed\n\ +in the same type as the original argument, rather than in the default\n\ +double type. For example:\n\ +\n\ +@example\n\ +@group\n\ +sum ([true, true])\n\ + @result{} 2\n\ +sum ([true, true], \"native\")\n\ + @result{} true\n\ +@end group\n\ +@end example\n\ +\n\ +On the contrary, if \"double\" is given, the sum is performed in double\n\ +precision even for single precision inputs.\n\ +\n\ +For double precision inputs, \"extra\" indicates that a more accurate\n\ +algorithm than straightforward summation is to be used. For single precision\n\ +inputs, \"extra\" is the same as \"double\". Otherwise, \"extra\" has no\n\ +effect.\n\ +@seealso{cumsum, sumsq, prod}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + bool isnative = false; + bool isdouble = false; + bool isextra = false; + + if (nargin > 1 && args(nargin - 1).is_string ()) + { + std::string str = args(nargin - 1).string_value (); + + if (! error_state) + { + if (str == "native") + isnative = true; + else if (str == "double") + isdouble = true; + else if (str == "extra") + isextra = true; + else + error ("sum: unrecognized string argument"); + nargin --; + } + } + + if (error_state) + return retval; + + if (nargin == 1 || nargin == 2) + { + octave_value arg = args(0); + + int dim = -1; + if (nargin == 2) + { + dim = args(1).int_value () - 1; + if (dim < 0) + error ("sum: invalid dimension DIM = %d", dim + 1); + } + + if (! error_state) + { + switch (arg.builtin_type ()) + { + case btyp_double: + if (arg.is_sparse_type ()) + { + if (isextra) + warning ("sum: 'extra' not yet implemented for sparse matrices"); + retval = arg.sparse_matrix_value ().sum (dim); + } + else if (isextra) + retval = arg.array_value ().xsum (dim); + else + retval = arg.array_value ().sum (dim); + break; + case btyp_complex: + if (arg.is_sparse_type ()) + { + if (isextra) + warning ("sum: 'extra' not yet implemented for sparse matrices"); + retval = arg.sparse_complex_matrix_value ().sum (dim); + } + else if (isextra) + retval = arg.complex_array_value ().xsum (dim); + else + retval = arg.complex_array_value ().sum (dim); + break; + case btyp_float: + if (isdouble || isextra) + retval = arg.float_array_value ().dsum (dim); + else + retval = arg.float_array_value ().sum (dim); + break; + case btyp_float_complex: + if (isdouble || isextra) + retval = arg.float_complex_array_value ().dsum (dim); + else + retval = arg.float_complex_array_value ().sum (dim); + break; + +#define MAKE_INT_BRANCH(X) \ + case btyp_ ## X: \ + if (isnative) \ + retval = arg.X ## _array_value ().sum (dim); \ + else \ + retval = arg.X ## _array_value ().dsum (dim); \ + break + MAKE_INT_BRANCH (int8); + MAKE_INT_BRANCH (int16); + MAKE_INT_BRANCH (int32); + MAKE_INT_BRANCH (int64); + MAKE_INT_BRANCH (uint8); + MAKE_INT_BRANCH (uint16); + MAKE_INT_BRANCH (uint32); + MAKE_INT_BRANCH (uint64); +#undef MAKE_INT_BRANCH + // GAGME: Accursed Matlab compatibility... + case btyp_char: + if (isextra) + retval = arg.array_value (true).xsum (dim); + else + retval = arg.array_value (true).sum (dim); + break; + case btyp_bool: + if (arg.is_sparse_type ()) + { + if (isnative) + retval = arg.sparse_bool_matrix_value ().any (dim); + else + retval = arg.sparse_bool_matrix_value ().sum (dim); + } + else if (isnative) + retval = arg.bool_array_value ().any (dim); + else + retval = arg.bool_array_value ().sum (dim); + break; + + default: + gripe_wrong_type_arg ("sum", arg); + } + } + } + else + print_usage (); + + return retval; +} + +/* +%!assert (sum ([true,true]), 2) +%!assert (sum ([true,true],"native"), true) +%!assert (sum (int8 ([127,10,-20])), 117) +%!assert (sum (int8 ([127,10,-20]),'native'), int8 (107)) + +%!assert (sum ([1, 2, 3]), 6) +%!assert (sum ([-1; -2; -3]), -6) +%!assert (sum ([i, 2+i, -3+2i, 4]), 3+4i) +%!assert (sum ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i]), [2+2i, 4+4i, 6+6i]) + +%!assert (sum (single ([1, 2, 3])), single (6)) +%!assert (sum (single ([-1; -2; -3])), single (-6)) +%!assert (sum (single ([i, 2+i, -3+2i, 4])), single (3+4i)) +%!assert (sum (single ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single ([2+2i, 4+4i, 6+6i])) + +%!assert (sum ([1, 2; 3, 4], 1), [4, 6]) +%!assert (sum ([1, 2; 3, 4], 2), [3; 7]) +%!assert (sum (zeros (1, 0)), 0) +%!assert (sum (zeros (1, 0), 1), zeros (1, 0)) +%!assert (sum (zeros (1, 0), 2), 0) +%!assert (sum (zeros (0, 1)), 0) +%!assert (sum (zeros (0, 1), 1), 0) +%!assert (sum (zeros (0, 1), 2), zeros (0, 1)) +%!assert (sum (zeros (2, 0)), zeros (1, 0)) +%!assert (sum (zeros (2, 0), 1), zeros (1, 0)) +%!assert (sum (zeros (2, 0), 2), [0; 0]) +%!assert (sum (zeros (0, 2)), [0, 0]) +%!assert (sum (zeros (0, 2), 1), [0, 0]) +%!assert (sum (zeros (0, 2), 2), zeros (0, 1)) +%!assert (sum (zeros (2, 2, 0, 3)), zeros (1, 2, 0, 3)) +%!assert (sum (zeros (2, 2, 0, 3), 2), zeros (2, 1, 0, 3)) +%!assert (sum (zeros (2, 2, 0, 3), 3), zeros (2, 2, 1, 3)) +%!assert (sum (zeros (2, 2, 0, 3), 4), zeros (2, 2, 0)) +%!assert (sum (zeros (2, 2, 0, 3), 7), zeros (2, 2, 0, 3)) + +%!assert (sum (single ([1, 2; 3, 4]), 1), single ([4, 6])) +%!assert (sum (single ([1, 2; 3, 4]), 2), single ([3; 7])) +%!assert (sum (zeros (1, 0, "single")), single (0)) +%!assert (sum (zeros (1, 0, "single"), 1), zeros (1, 0, "single")) +%!assert (sum (zeros (1, 0, "single"), 2), single (0)) +%!assert (sum (zeros (0, 1, "single")), single (0)) +%!assert (sum (zeros (0, 1, "single"), 1), single (0)) +%!assert (sum (zeros (0, 1, "single"), 2), zeros (0, 1, "single")) +%!assert (sum (zeros (2, 0, "single")), zeros (1, 0, "single")) +%!assert (sum (zeros (2, 0, "single"), 1), zeros (1, 0, "single")) +%!assert (sum (zeros (2, 0, "single"), 2), single ([0; 0])) +%!assert (sum (zeros (0, 2, "single")), single ([0, 0])) +%!assert (sum (zeros (0, 2, "single"), 1), single ([0, 0])) +%!assert (sum (zeros (0, 2, "single"), 2), zeros (0, 1, "single")) +%!assert (sum (zeros (2, 2, 0, 3, "single")), zeros (1, 2, 0, 3, "single")) +%!assert (sum (zeros (2, 2, 0, 3, "single"), 2), zeros (2, 1, 0, 3, "single")) +%!assert (sum (zeros (2, 2, 0, 3, "single"), 3), zeros (2, 2, 1, 3, "single")) +%!assert (sum (zeros (2, 2, 0, 3, "single"), 4), zeros (2, 2, 0, "single")) +%!assert (sum (zeros (2, 2, 0, 3, "single"), 7), zeros (2, 2, 0, 3, "single")) + +;-) +%!assert (sum ("Octave") + "8", sumsq (primes (17))) + +%!error sum () +*/ + +DEFUN (sumsq, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} sumsq (@var{x})\n\ +@deftypefnx {Built-in Function} {} sumsq (@var{x}, @var{dim})\n\ +Sum of squares of elements along dimension @var{dim}. If @var{dim}\n\ +is omitted, it defaults to the first non-singleton dimension.\n\ +\n\ +This function is conceptually equivalent to computing\n\ +\n\ +@example\n\ +sum (x .* conj (x), dim)\n\ +@end example\n\ +\n\ +@noindent\n\ +but it uses less memory and avoids calling @code{conj} if @var{x} is real.\n\ +@seealso{sum, prod}\n\ +@end deftypefn") +{ + DATA_REDUCTION (sumsq); +} + +/* +%!assert (sumsq ([1, 2, 3]), 14) +%!assert (sumsq ([-1; -2; 4i]), 21) +%!assert (sumsq ([1, 2, 3; 2, 3, 4; 4i, 6i, 2]), [21, 49, 29]) + +%!assert (sumsq (single ([1, 2, 3])), single (14)) +%!assert (sumsq (single ([-1; -2; 4i])), single (21)) +%!assert (sumsq (single ([1, 2, 3; 2, 3, 4; 4i, 6i, 2])), single ([21, 49, 29])) + +%!assert (sumsq ([1, 2; 3, 4], 1), [10, 20]) +%!assert (sumsq ([1, 2; 3, 4], 2), [5; 25]) + +%!assert (sumsq (single ([1, 2; 3, 4]), 1), single ([10, 20])) +%!assert (sumsq (single ([1, 2; 3, 4]), 2), single ([5; 25])) + +%!error sumsq () +*/ + +DEFUN (islogical, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} islogical (@var{x})\n\ +@deftypefnx {Built-in Function} {} isbool (@var{x})\n\ +Return true if @var{x} is a logical object.\n\ +@seealso{isfloat, isinteger, ischar, isnumeric, isa}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_bool_type (); + else + print_usage (); + + return retval; +} + +DEFALIAS (isbool, islogical); + +/* +%!assert (islogical (true), true) +%!assert (islogical (false), true) +%!assert (islogical ([true, false]), true) +%!assert (islogical (1), false) +%!assert (islogical (1i), false) +%!assert (islogical ([1,1]), false) +%!assert (islogical (single (1)), false) +%!assert (islogical (single (1i)), false) +%!assert (islogical (single ([1,1])), false) +%!assert (islogical (sparse ([true, false])), true) +%!assert (islogical (sparse ([1, 0])), false) +*/ + +DEFUN (isinteger, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isinteger (@var{x})\n\ +Return true if @var{x} is an integer object (int8, uint8, int16, etc.).\n\ +Note that @w{@code{isinteger (14)}} is false because numeric constants in\n\ +Octave are double precision floating point values.\n\ +@seealso{isfloat, ischar, islogical, isnumeric, isa}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_integer_type (); + else + print_usage (); + + return retval; +} + +DEFUN (iscomplex, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} iscomplex (@var{x})\n\ +Return true if @var{x} is a complex-valued numeric object.\n\ +@seealso{isreal, isnumeric, islogical, ischar, isfloat, isa}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_complex_type (); + else + print_usage (); + + return retval; +} + +DEFUN (isfloat, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isfloat (@var{x})\n\ +Return true if @var{x} is a floating-point numeric object.\n\ +Objects of class double or single are floating-point objects.\n\ +@seealso{isinteger, ischar, islogical, isnumeric, isa}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_float_type (); + else + print_usage (); + + return retval; +} + +// FIXME -- perhaps this should be implemented with an +// octave_value member function? + +DEFUN (complex, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} complex (@var{x})\n\ +@deftypefnx {Built-in Function} {} complex (@var{re}, @var{im})\n\ +Return a complex result from real arguments. With 1 real argument @var{x},\n\ +return the complex result @code{@var{x} + 0i}. With 2 real arguments,\n\ +return the complex result @code{@var{re} + @var{im}}. @code{complex} can\n\ +often be more convenient than expressions such as @code{a + i*b}.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +complex ([1, 2], [3, 4])\n\ + @result{} [ 1 + 3i 2 + 4i ]\n\ +@end group\n\ +@end example\n\ +@seealso{real, imag, iscomplex, abs, arg}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + octave_value arg = args(0); + + if (arg.is_complex_type ()) + retval = arg; + else + { + if (arg.is_sparse_type ()) + { + SparseComplexMatrix val = arg.sparse_complex_matrix_value (); + + if (! error_state) + retval = octave_value (new octave_sparse_complex_matrix (val)); + } + else if (arg.is_single_type ()) + { + if (arg.numel () == 1) + { + FloatComplex val = arg.float_complex_value (); + + if (! error_state) + retval = octave_value (new octave_float_complex (val)); + } + else + { + FloatComplexNDArray val = arg.float_complex_array_value (); + + if (! error_state) + retval = octave_value (new octave_float_complex_matrix (val)); + } + } + else + { + if (arg.numel () == 1) + { + Complex val = arg.complex_value (); + + if (! error_state) + retval = octave_value (new octave_complex (val)); + } + else + { + ComplexNDArray val = arg.complex_array_value (); + + if (! error_state) + retval = octave_value (new octave_complex_matrix (val)); + } + } + + if (error_state) + error ("complex: invalid conversion"); + } + } + else if (nargin == 2) + { + octave_value re = args(0); + octave_value im = args(1); + + if (re.is_sparse_type () && im.is_sparse_type ()) + { + const SparseMatrix re_val = re.sparse_matrix_value (); + const SparseMatrix im_val = im.sparse_matrix_value (); + + if (!error_state) + { + if (re.numel () == 1) + { + SparseComplexMatrix result; + if (re_val.nnz () == 0) + result = Complex (0, 1) * SparseComplexMatrix (im_val); + else + { + result = SparseComplexMatrix (im_val.dims (), re_val (0)); + octave_idx_type nr = im_val.rows (); + octave_idx_type nc = im_val.cols (); + + for (octave_idx_type j = 0; j < nc; j++) + { + octave_idx_type off = j * nr; + for (octave_idx_type i = im_val.cidx (j); + i < im_val.cidx (j + 1); i++) + result.data (im_val.ridx (i) + off) = + result.data (im_val.ridx (i) + off) + + Complex (0, im_val.data (i)); + } + } + retval = octave_value (new octave_sparse_complex_matrix (result)); + } + else if (im.numel () == 1) + { + SparseComplexMatrix result; + if (im_val.nnz () == 0) + result = SparseComplexMatrix (re_val); + else + { + result = SparseComplexMatrix (re_val.rows (), re_val.cols (), Complex (0, im_val (0))); + octave_idx_type nr = re_val.rows (); + octave_idx_type nc = re_val.cols (); + + for (octave_idx_type j = 0; j < nc; j++) + { + octave_idx_type off = j * nr; + for (octave_idx_type i = re_val.cidx (j); + i < re_val.cidx (j + 1); i++) + result.data (re_val.ridx (i) + off) = + result.data (re_val.ridx (i) + off) + + re_val.data (i); + } + } + retval = octave_value (new octave_sparse_complex_matrix (result)); + } + else + { + if (re_val.dims () == im_val.dims ()) + { + SparseComplexMatrix result = SparseComplexMatrix (re_val) + + Complex (0, 1) * SparseComplexMatrix (im_val); + retval = octave_value (new octave_sparse_complex_matrix (result)); + } + else + error ("complex: dimension mismatch"); + } + } + } + else if (re.is_single_type () || im.is_single_type ()) + { + if (re.numel () == 1) + { + float re_val = re.float_value (); + + if (im.numel () == 1) + { + float im_val = im.double_value (); + + if (! error_state) + retval = octave_value (new octave_float_complex (FloatComplex (re_val, im_val))); + } + else + { + const FloatNDArray im_val = im.float_array_value (); + + if (! error_state) + { + FloatComplexNDArray result (im_val.dims (), FloatComplex ()); + + for (octave_idx_type i = 0; i < im_val.numel (); i++) + result.xelem (i) = FloatComplex (re_val, im_val(i)); + + retval = octave_value (new octave_float_complex_matrix (result)); + } + } + } + else + { + const FloatNDArray re_val = re.float_array_value (); + + if (im.numel () == 1) + { + float im_val = im.float_value (); + + if (! error_state) + { + FloatComplexNDArray result (re_val.dims (), FloatComplex ()); + + for (octave_idx_type i = 0; i < re_val.numel (); i++) + result.xelem (i) = FloatComplex (re_val(i), im_val); + + retval = octave_value (new octave_float_complex_matrix (result)); + } + } + else + { + const FloatNDArray im_val = im.float_array_value (); + + if (! error_state) + { + if (re_val.dims () == im_val.dims ()) + { + FloatComplexNDArray result (re_val.dims (), FloatComplex ()); + + for (octave_idx_type i = 0; i < re_val.numel (); i++) + result.xelem (i) = FloatComplex (re_val(i), im_val(i)); + + retval = octave_value (new octave_float_complex_matrix (result)); + } + else + error ("complex: dimension mismatch"); + } + } + } + } + else if (re.numel () == 1) + { + double re_val = re.double_value (); + + if (im.numel () == 1) + { + double im_val = im.double_value (); + + if (! error_state) + retval = octave_value (new octave_complex (Complex (re_val, im_val))); + } + else + { + const NDArray im_val = im.array_value (); + + if (! error_state) + { + ComplexNDArray result (im_val.dims (), Complex ()); + + for (octave_idx_type i = 0; i < im_val.numel (); i++) + result.xelem (i) = Complex (re_val, im_val(i)); + + retval = octave_value (new octave_complex_matrix (result)); + } + } + } + else + { + const NDArray re_val = re.array_value (); + + if (im.numel () == 1) + { + double im_val = im.double_value (); + + if (! error_state) + { + ComplexNDArray result (re_val.dims (), Complex ()); + + for (octave_idx_type i = 0; i < re_val.numel (); i++) + result.xelem (i) = Complex (re_val(i), im_val); + + retval = octave_value (new octave_complex_matrix (result)); + } + } + else + { + const NDArray im_val = im.array_value (); + + if (! error_state) + { + if (re_val.dims () == im_val.dims ()) + { + ComplexNDArray result (re_val.dims (), Complex ()); + + for (octave_idx_type i = 0; i < re_val.numel (); i++) + result.xelem (i) = Complex (re_val(i), im_val(i)); + + retval = octave_value (new octave_complex_matrix (result)); + } + else + error ("complex: dimension mismatch"); + } + } + } + + if (error_state) + error ("complex: invalid conversion"); + } + else + print_usage (); + + return retval; +} + +DEFUN (isreal, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isreal (@var{x})\n\ +Return true if @var{x} is a non-complex matrix or scalar.\n\ +For compatibility with @sc{matlab}, this includes logical and character\n\ +matrices.\n\ +@seealso{iscomplex, isnumeric, isa}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_real_type (); + else + print_usage (); + + return retval; +} + +DEFUN (isempty, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isempty (@var{a})\n\ +Return true if @var{a} is an empty matrix (any one of its dimensions is\n\ +zero). Otherwise, return false.\n\ +@seealso{isnull, isa}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + retval = args(0).is_empty (); + else + print_usage (); + + return retval; +} + +/* +%% Debian bug #706376 +%!assert (isempty (speye(2^16)), false) +*/ + +DEFUN (isnumeric, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isnumeric (@var{x})\n\ +Return true if @var{x} is a numeric object, i.e., an integer, real, or\n\ +complex array. Logical and character arrays are not considered to be\n\ +numeric.\n\ +@seealso{isinteger, isfloat, isreal, iscomplex, islogical, ischar, iscell, isstruct, isa}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_numeric_type (); + else + print_usage (); + + return retval; +} + +/* +%!assert (isnumeric (1), true) +%!assert (isnumeric (1i), true) +%!assert (isnumeric ([1,1]), true) +%!assert (isnumeric (single (1)), true) +%!assert (isnumeric (single (1i)), true) +%!assert (isnumeric (single ([1,1])), true) +%!assert (isnumeric (int8 (1)), true) +%!assert (isnumeric (uint8 ([1,1])), true) +%!assert (isnumeric ("Hello World"), false) +%!assert (isnumeric (true), false) +%!assert (isnumeric (false), false) +%!assert (isnumeric ([true, false]), false) +%!assert (isnumeric (sparse ([true, false])), false) +*/ + +DEFUN (ismatrix, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ismatrix (@var{a})\n\ +Return true if @var{a} is a numeric, logical, or character matrix.\n\ +Scalars (1x1 matrices) and vectors (@nospell{1xN} or @nospell{Nx1} matrices)\n\ +are subsets of the more general N-dimensional matrix and @code{ismatrix}\n\ +will return true for these objects as well.\n\ +@seealso{isscalar, isvector, iscell, isstruct, issparse, isa}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + { + octave_value arg = args(0); + + retval = arg.is_matrix_type () || arg.is_scalar_type () || arg.is_range (); + } + else + print_usage (); + + return retval; +} + +/* +%!assert (ismatrix ([])) +%!assert (ismatrix (1)) +%!assert (ismatrix ([1, 2, 3])) +%!assert (ismatrix ([1, 2; 3, 4])) +%!assert (ismatrix (zeros (3, 2, 4))) + +%!assert (ismatrix (single ([]))) +%!assert (ismatrix (single (1))) +%!assert (ismatrix (single ([1, 2, 3]))) +%!assert (ismatrix (single ([1, 2; 3, 4]))) + +%!assert (ismatrix ("t")) +%!assert (ismatrix ("test")) +%!assert (ismatrix (["test"; "ing"])) + +%!test +%! s.a = 1; +%! assert (ismatrix (s), false); + +%!error ismatrix () +%!error ismatrix ([1, 2; 3, 4], 2) +*/ + +static octave_value +fill_matrix (const octave_value_list& args, int val, const char *fcn) +{ + octave_value retval; + + int nargin = args.length (); + + oct_data_conv::data_type dt = oct_data_conv::dt_double; + + dim_vector dims (1, 1); + + if (nargin > 0 && args(nargin-1).is_string ()) + { + std::string nm = args(nargin-1).string_value (); + nargin--; + + dt = oct_data_conv::string_to_data_type (nm); + + if (error_state) + return retval; + } + + switch (nargin) + { + case 0: + break; + + case 1: + get_dimensions (args(0), fcn, dims); + break; + + default: + { + dims.resize (nargin); + + for (int i = 0; i < nargin; i++) + { + dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); + + if (error_state) + { + error ("%s: expecting scalar integer arguments", fcn); + break; + } + } + } + break; + } + + if (! error_state) + { + dims.chop_trailing_singletons (); + + check_dimensions (dims, fcn); + + // FIXME -- perhaps this should be made extensible by + // using the class name to lookup a function to call to create + // the new value. + + // Note that automatic narrowing will handle conversion from + // NDArray to scalar. + + if (! error_state) + { + switch (dt) + { + case oct_data_conv::dt_int8: + retval = int8NDArray (dims, val); + break; + + case oct_data_conv::dt_uint8: + retval = uint8NDArray (dims, val); + break; + + case oct_data_conv::dt_int16: + retval = int16NDArray (dims, val); + break; + + case oct_data_conv::dt_uint16: + retval = uint16NDArray (dims, val); + break; + + case oct_data_conv::dt_int32: + retval = int32NDArray (dims, val); + break; + + case oct_data_conv::dt_uint32: + retval = uint32NDArray (dims, val); + break; + + case oct_data_conv::dt_int64: + retval = int64NDArray (dims, val); + break; + + case oct_data_conv::dt_uint64: + retval = uint64NDArray (dims, val); + break; + + case oct_data_conv::dt_single: + retval = FloatNDArray (dims, val); + break; + + case oct_data_conv::dt_double: + { + if (val == 1 && dims.length () == 2 && dims (0) == 1) + retval = Range (1.0, 0.0, dims (1)); // packed form + else + retval = NDArray (dims, val); + } + break; + + case oct_data_conv::dt_logical: + retval = boolNDArray (dims, val); + break; + + default: + error ("%s: invalid class name", fcn); + break; + } + } + } + + return retval; +} + +static octave_value +fill_matrix (const octave_value_list& args, double val, float fval, + const char *fcn) +{ + octave_value retval; + + int nargin = args.length (); + + oct_data_conv::data_type dt = oct_data_conv::dt_double; + + dim_vector dims (1, 1); + + if (nargin > 0 && args(nargin-1).is_string ()) + { + std::string nm = args(nargin-1).string_value (); + nargin--; + + dt = oct_data_conv::string_to_data_type (nm); + + if (error_state) + return retval; + } + + switch (nargin) + { + case 0: + break; + + case 1: + get_dimensions (args(0), fcn, dims); + break; + + default: + { + dims.resize (nargin); + + for (int i = 0; i < nargin; i++) + { + dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); + + if (error_state) + { + error ("%s: expecting scalar integer arguments", fcn); + break; + } + } + } + break; + } + + if (! error_state) + { + dims.chop_trailing_singletons (); + + check_dimensions (dims, fcn); + + // Note that automatic narrowing will handle conversion from + // NDArray to scalar. + + if (! error_state) + { + switch (dt) + { + case oct_data_conv::dt_single: + retval = FloatNDArray (dims, fval); + break; + + case oct_data_conv::dt_double: + retval = NDArray (dims, val); + break; + + default: + error ("%s: invalid class name", fcn); + break; + } + } + } + + return retval; +} + +static octave_value +fill_matrix (const octave_value_list& args, double val, const char *fcn) +{ + octave_value retval; + + int nargin = args.length (); + + oct_data_conv::data_type dt = oct_data_conv::dt_double; + + dim_vector dims (1, 1); + + if (nargin > 0 && args(nargin-1).is_string ()) + { + std::string nm = args(nargin-1).string_value (); + nargin--; + + dt = oct_data_conv::string_to_data_type (nm); + + if (error_state) + return retval; + } + + switch (nargin) + { + case 0: + break; + + case 1: + get_dimensions (args(0), fcn, dims); + break; + + default: + { + dims.resize (nargin); + + for (int i = 0; i < nargin; i++) + { + dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); + + if (error_state) + { + error ("%s: expecting scalar integer arguments", fcn); + break; + } + } + } + break; + } + + if (! error_state) + { + dims.chop_trailing_singletons (); + + check_dimensions (dims, fcn); + + // Note that automatic narrowing will handle conversion from + // NDArray to scalar. + + if (! error_state) + { + switch (dt) + { + case oct_data_conv::dt_single: + retval = FloatNDArray (dims, static_cast (val)); + break; + + case oct_data_conv::dt_double: + retval = NDArray (dims, val); + break; + + default: + error ("%s: invalid class name", fcn); + break; + } + } + } + + return retval; +} + +static octave_value +fill_matrix (const octave_value_list& args, const Complex& val, + const char *fcn) +{ + octave_value retval; + + int nargin = args.length (); + + oct_data_conv::data_type dt = oct_data_conv::dt_double; + + dim_vector dims (1, 1); + + if (nargin > 0 && args(nargin-1).is_string ()) + { + std::string nm = args(nargin-1).string_value (); + nargin--; + + dt = oct_data_conv::string_to_data_type (nm); + + if (error_state) + return retval; + } + + switch (nargin) + { + case 0: + break; + + case 1: + get_dimensions (args(0), fcn, dims); + break; + + default: + { + dims.resize (nargin); + + for (int i = 0; i < nargin; i++) + { + dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); + + if (error_state) + { + error ("%s: expecting scalar integer arguments", fcn); + break; + } + } + } + break; + } + + if (! error_state) + { + dims.chop_trailing_singletons (); + + check_dimensions (dims, fcn); + + // Note that automatic narrowing will handle conversion from + // NDArray to scalar. + + if (! error_state) + { + switch (dt) + { + case oct_data_conv::dt_single: + retval = FloatComplexNDArray (dims, static_cast (val)); + break; + + case oct_data_conv::dt_double: + retval = ComplexNDArray (dims, val); + break; + + default: + error ("%s: invalid class name", fcn); + break; + } + } + } + + return retval; +} + +static octave_value +fill_matrix (const octave_value_list& args, bool val, const char *fcn) +{ + octave_value retval; + + int nargin = args.length (); + + dim_vector dims (1, 1); + + switch (nargin) + { + case 0: + break; + + case 1: + get_dimensions (args(0), fcn, dims); + break; + + default: + { + dims.resize (nargin); + + for (int i = 0; i < nargin; i++) + { + dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); + + if (error_state) + { + error ("%s: expecting scalar integer arguments", fcn); + break; + } + } + } + break; + } + + if (! error_state) + { + dims.chop_trailing_singletons (); + + check_dimensions (dims, fcn); + + // Note that automatic narrowing will handle conversion from + // NDArray to scalar. + + if (! error_state) + retval = boolNDArray (dims, val); + } + + return retval; +} + +DEFUN (ones, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ones (@var{n})\n\ +@deftypefnx {Built-in Function} {} ones (@var{m}, @var{n})\n\ +@deftypefnx {Built-in Function} {} ones (@var{m}, @var{n}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} ones ([@var{m} @var{n} @dots{}])\n\ +@deftypefnx {Built-in Function} {} ones (@dots{}, @var{class})\n\ +Return a matrix or N-dimensional array whose elements are all 1.\n\ +If invoked with a single scalar integer argument @var{n}, return a square\n\ +@nospell{NxN} matrix. If invoked with two or more scalar\n\ +integer arguments, or a vector of integer values, return an array with\n\ +the given dimensions.\n\ +\n\ +If you need to create a matrix whose values are all the same, you should\n\ +use an expression like\n\ +\n\ +@example\n\ +val_matrix = val * ones (m, n)\n\ +@end example\n\ +\n\ +The optional argument @var{class} specifies the class of the return array\n\ +and defaults to double. For example:\n\ +\n\ +@example\n\ +val = ones (m,n, \"uint8\")\n\ +@end example\n\ +@seealso{zeros}\n\ +@end deftypefn") +{ + return fill_matrix (args, 1, "ones"); +} + +/* +%!assert (ones (3), [1, 1, 1; 1, 1, 1; 1, 1, 1]) +%!assert (ones (2, 3), [1, 1, 1; 1, 1, 1]) +%!assert (ones (3, 2), [1, 1; 1, 1; 1, 1]) +%!assert (size (ones (3, 4, 5)), [3, 4, 5]) + +%!assert (ones (3, "single"), single ([1, 1, 1; 1, 1, 1; 1, 1, 1])) +%!assert (ones (2, 3, "single"), single ([1, 1, 1; 1, 1, 1])) +%!assert (ones (3, 2, "single"), single ([1, 1; 1, 1; 1, 1])) +%!assert (size (ones (3, 4, 5, "single")), [3, 4, 5]) + +%!assert (ones (3, "int8"), int8 ([1, 1, 1; 1, 1, 1; 1, 1, 1])) +%!assert (ones (2, 3, "int8"), int8 ([1, 1, 1; 1, 1, 1])) +%!assert (ones (3, 2, "int8"), int8 ([1, 1; 1, 1; 1, 1])) +%!assert (size (ones (3, 4, 5, "int8")), [3, 4, 5]) +*/ + +DEFUN (zeros, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} zeros (@var{n})\n\ +@deftypefnx {Built-in Function} {} zeros (@var{m}, @var{n})\n\ +@deftypefnx {Built-in Function} {} zeros (@var{m}, @var{n}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} zeros ([@var{m} @var{n} @dots{}])\n\ +@deftypefnx {Built-in Function} {} zeros (@dots{}, @var{class})\n\ +Return a matrix or N-dimensional array whose elements are all 0.\n\ +If invoked with a single scalar integer argument, return a square\n\ +@nospell{NxN} matrix. If invoked with two or more scalar\n\ +integer arguments, or a vector of integer values, return an array with\n\ +the given dimensions.\n\ +\n\ +The optional argument @var{class} specifies the class of the return array\n\ +and defaults to double. For example:\n\ +\n\ +@example\n\ +val = zeros (m,n, \"uint8\")\n\ +@end example\n\ +@seealso{ones}\n\ +@end deftypefn") +{ + return fill_matrix (args, 0, "zeros"); +} + +/* +%!assert (zeros (3), [0, 0, 0; 0, 0, 0; 0, 0, 0]) +%!assert (zeros (2, 3), [0, 0, 0; 0, 0, 0]) +%!assert (zeros (3, 2), [0, 0; 0, 0; 0, 0]) +%!assert (size (zeros (3, 4, 5)), [3, 4, 5]) + +%!assert (zeros (3, "single"), single ([0, 0, 0; 0, 0, 0; 0, 0, 0])) +%!assert (zeros (2, 3, "single"), single ([0, 0, 0; 0, 0, 0])) +%!assert (zeros (3, 2, "single"), single ([0, 0; 0, 0; 0, 0])) +%!assert (size (zeros (3, 4, 5, "single")), [3, 4, 5]) + +%!assert (zeros (3, "int8"), int8 ([0, 0, 0; 0, 0, 0; 0, 0, 0])) +%!assert (zeros (2, 3, "int8"), int8 ([0, 0, 0; 0, 0, 0])) +%!assert (zeros (3, 2, "int8"), int8 ([0, 0; 0, 0; 0, 0])) +%!assert (size (zeros (3, 4, 5, "int8")), [3, 4, 5]) +*/ + +DEFUN (Inf, args, , + "-*- texinfo -*-\n\ +@c List other form of function in documentation index\n\ +@findex inf\n\ +\n\ +@deftypefn {Built-in Function} {} Inf\n\ +@deftypefnx {Built-in Function} {} Inf (@var{n})\n\ +@deftypefnx {Built-in Function} {} Inf (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} Inf (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} Inf (@dots{}, @var{class})\n\ +Return a scalar, matrix or N-dimensional array whose elements are all equal\n\ +to the IEEE representation for positive infinity.\n\ +\n\ +Infinity is produced when results are too large to be represented using the\n\ +the IEEE floating point format for numbers. Two common examples which\n\ +produce infinity are division by zero and overflow.\n\ +\n\ +@example\n\ +@group\n\ +[ 1/0 e^800 ]\n\ +@result{} Inf Inf\n\ +@end group\n\ +@end example\n\ +\n\ +When called with no arguments, return a scalar with the value @samp{Inf}.\n\ +When called with a single argument, return a square matrix with the dimension\n\ +specified. When called with more than one scalar argument the first two\n\ +arguments are taken as the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{isinf, NaN}\n\ +@end deftypefn") +{ + return fill_matrix (args, lo_ieee_inf_value (), + lo_ieee_float_inf_value (), "Inf"); +} + +DEFALIAS (inf, Inf); + +/* +%!assert (inf (3), [Inf, Inf, Inf; Inf, Inf, Inf; Inf, Inf, Inf]) +%!assert (inf (2, 3), [Inf, Inf, Inf; Inf, Inf, Inf]) +%!assert (inf (3, 2), [Inf, Inf; Inf, Inf; Inf, Inf]) +%!assert (size (inf (3, 4, 5)), [3, 4, 5]) + +%!assert (inf (3, "single"), single ([Inf, Inf, Inf; Inf, Inf, Inf; Inf, Inf, Inf])) +%!assert (inf (2, 3, "single"), single ([Inf, Inf, Inf; Inf, Inf, Inf])) +%!assert (inf (3, 2, "single"), single ([Inf, Inf; Inf, Inf; Inf, Inf])) +%!assert (size (inf (3, 4, 5, "single")), [3, 4, 5]) + +%!error (inf (3, "int8")) +%!error (inf (2, 3, "int8")) +%!error (inf (3, 2, "int8")) +%!error (inf (3, 4, 5, "int8")) +*/ + +DEFUN (NaN, args, , + "-*- texinfo -*-\n\ +@c List other form of function in documentation index\n\ +@findex nan\n\ +\n\ +@deftypefn {Built-in Function} {} NaN\n\ +@deftypefnx {Built-in Function} {} NaN (@var{n})\n\ +@deftypefnx {Built-in Function} {} NaN (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} NaN (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} NaN (@dots{}, @var{class})\n\ +Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ +to the IEEE symbol NaN (Not a Number).\n\ +NaN is the result of operations which do not produce a well defined numerical\n\ +result. Common operations which produce a NaN are arithmetic with infinity\n\ +@tex\n\ +($\\infty - \\infty$), zero divided by zero ($0/0$),\n\ +@end tex\n\ +@ifnottex\n\ +(Inf - Inf), zero divided by zero (0/0),\n\ +@end ifnottex\n\ +and any operation involving another NaN value (5 + NaN).\n\ +\n\ +Note that NaN always compares not equal to NaN (NaN != NaN). This behavior\n\ +is specified by the IEEE standard for floating point arithmetic. To\n\ +find NaN values, use the @code{isnan} function.\n\ +\n\ +When called with no arguments, return a scalar with the value @samp{NaN}.\n\ +When called with a single argument, return a square matrix with the dimension\n\ +specified. When called with more than one scalar argument the first two\n\ +arguments are taken as the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{isnan, Inf}\n\ +@end deftypefn") +{ + return fill_matrix (args, lo_ieee_nan_value (), + lo_ieee_float_nan_value (), "NaN"); +} + +DEFALIAS (nan, NaN); + +/* +%!assert (NaN (3), [NaN, NaN, NaN; NaN, NaN, NaN; NaN, NaN, NaN]) +%!assert (NaN (2, 3), [NaN, NaN, NaN; NaN, NaN, NaN]) +%!assert (NaN (3, 2), [NaN, NaN; NaN, NaN; NaN, NaN]) +%!assert (size (NaN (3, 4, 5)), [3, 4, 5]) + +%!assert (NaN (3, "single"), single ([NaN, NaN, NaN; NaN, NaN, NaN; NaN, NaN, NaN])) +%!assert (NaN (2, 3, "single"), single ([NaN, NaN, NaN; NaN, NaN, NaN])) +%!assert (NaN (3, 2, "single"), single ([NaN, NaN; NaN, NaN; NaN, NaN])) +%!assert (size (NaN (3, 4, 5, "single")), [3, 4, 5]) + +%!error (NaN (3, "int8")) +%!error (NaN (2, 3, "int8")) +%!error (NaN (3, 2, "int8")) +%!error (NaN (3, 4, 5, "int8")) +*/ + +DEFUN (e, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} e\n\ +@deftypefnx {Built-in Function} {} e (@var{n})\n\ +@deftypefnx {Built-in Function} {} e (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} e (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} e (@dots{}, @var{class})\n\ +Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ +to the base of natural logarithms. The constant\n\ +@tex\n\ +$e$ satisfies the equation $\\log (e) = 1$.\n\ +@end tex\n\ +@ifnottex\n\ +@samp{e} satisfies the equation @code{log} (e) = 1.\n\ +@end ifnottex\n\ +\n\ +When called with no arguments, return a scalar with the value @math{e}. When\n\ +called with a single argument, return a square matrix with the dimension\n\ +specified. When called with more than one scalar argument the first two\n\ +arguments are taken as the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{log, exp, pi, I}\n\ +@end deftypefn") +{ +#if defined (M_E) + double e_val = M_E; +#else + double e_val = exp (1.0); +#endif + + return fill_matrix (args, e_val, "e"); +} + +DEFUN (eps, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} eps\n\ +@deftypefnx {Built-in Function} {} eps (@var{x})\n\ +@deftypefnx {Built-in Function} {} eps (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} eps (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} eps (@dots{}, @var{class})\n\ +Return a scalar, matrix or N-dimensional array whose elements are all eps,\n\ +the machine precision. More precisely, @code{eps} is the relative spacing\n\ +between any two adjacent numbers in the machine's floating point system.\n\ +This number is obviously system dependent. On machines that support IEEE\n\ +floating point arithmetic, @code{eps} is approximately\n\ +@tex\n\ +$2.2204\\times10^{-16}$ for double precision and $1.1921\\times10^{-7}$\n\ +@end tex\n\ +@ifnottex\n\ +2.2204e-16 for double precision and 1.1921e-07\n\ +@end ifnottex\n\ +for single precision.\n\ +\n\ +When called with no arguments, return a scalar with the value\n\ +@code{eps (1.0)}.\n\ +Given a single argument @var{x}, return the distance between @var{x} and\n\ +the next largest value.\n\ +When called with more than one argument the first two arguments are taken as\n\ +the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{realmax, realmin, intmax, bitmax}\n\ +@end deftypefn") +{ + int nargin = args.length (); + octave_value retval; + + if (nargin == 1 && ! args(0).is_string ()) + { + if (args(0).is_single_type ()) + { + Array x = args(0).float_array_value (); + + if (! error_state) + { + Array epsval (x.dims ()); + + for (octave_idx_type i = 0; i < x.numel (); i++) + { + float val = ::fabsf (x(i)); + if (xisnan (val) || xisinf (val)) + epsval(i) = lo_ieee_nan_value (); + else if (val < std::numeric_limits::min ()) + epsval(i) = powf (2.0, -149e0); + else + { + int expon; + frexpf (val, &expon); + epsval(i) = std::pow (static_cast (2.0), + static_cast (expon - 24)); + } + } + retval = epsval; + } + } + else + { + Array x = args(0).array_value (); + + if (! error_state) + { + Array epsval (x.dims ()); + + for (octave_idx_type i = 0; i < x.numel (); i++) + { + double val = ::fabs (x(i)); + if (xisnan (val) || xisinf (val)) + epsval(i) = lo_ieee_nan_value (); + else if (val < std::numeric_limits::min ()) + epsval(i) = pow (2.0, -1074e0); + else + { + int expon; + frexp (val, &expon); + epsval(i) = std::pow (static_cast (2.0), + static_cast (expon - 53)); + } + retval = epsval; + } + } + } + } + else + retval = fill_matrix (args, std::numeric_limits::epsilon (), + std::numeric_limits::epsilon (), "eps"); + + return retval; +} + +/* +%!assert (eps (1/2), 2^(-53)) +%!assert (eps (1), 2^(-52)) +%!assert (eps (2), 2^(-51)) +%!assert (eps (realmax), 2^971) +%!assert (eps (0), 2^(-1074)) +%!assert (eps (realmin/2), 2^(-1074)) +%!assert (eps (realmin/16), 2^(-1074)) +%!assert (eps (Inf), NaN) +%!assert (eps (NaN), NaN) +%!assert (eps ([1/2 1 2 realmax 0 realmin/2 realmin/16 Inf NaN]), +%! [2^(-53) 2^(-52) 2^(-51) 2^971 2^(-1074) 2^(-1074) 2^(-1074) NaN NaN]) +%!assert (eps (single (1/2)), single (2^(-24))) +%!assert (eps (single (1)), single (2^(-23))) +%!assert (eps (single (2)), single (2^(-22))) +%!assert (eps (realmax ("single")), single (2^104)) +%!assert (eps (single (0)), single (2^(-149))) +%!assert (eps (realmin ("single")/2), single (2^(-149))) +%!assert (eps (realmin ("single")/16), single (2^(-149))) +%!assert (eps (single (Inf)), single (NaN)) +%!assert (eps (single (NaN)), single (NaN)) +%!assert (eps (single ([1/2 1 2 realmax("single") 0 realmin("single")/2 realmin("single")/16 Inf NaN])), +%! single ([2^(-24) 2^(-23) 2^(-22) 2^104 2^(-149) 2^(-149) 2^(-149) NaN NaN])) + +*/ + +DEFUN (pi, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} pi\n\ +@deftypefnx {Built-in Function} {} pi (@var{n})\n\ +@deftypefnx {Built-in Function} {} pi (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} pi (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} pi (@dots{}, @var{class})\n\ +Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ +to the ratio of the circumference of a circle to its\n\ +@tex\n\ +diameter($\\pi$).\n\ +@end tex\n\ +@ifnottex\n\ +diameter.\n\ +@end ifnottex\n\ +Internally, @code{pi} is computed as @samp{4.0 * atan (1.0)}.\n\ +\n\ +When called with no arguments, return a scalar with the value of\n\ +@tex\n\ +$\\pi$.\n\ +@end tex\n\ +@ifnottex\n\ +pi.\n\ +@end ifnottex\n\ +When called with a single argument, return a square matrix with the dimension\n\ +specified. When called with more than one scalar argument the first two\n\ +arguments are taken as the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{e, I}\n\ +@end deftypefn") +{ +#if defined (M_PI) + double pi_val = M_PI; +#else + double pi_val = 4.0 * atan (1.0); +#endif + + return fill_matrix (args, pi_val, "pi"); +} + +DEFUN (realmax, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} realmax\n\ +@deftypefnx {Built-in Function} {} realmax (@var{n})\n\ +@deftypefnx {Built-in Function} {} realmax (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} realmax (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} realmax (@dots{}, @var{class})\n\ +Return a scalar, matrix or N-dimensional array whose elements are all equal\n\ +to the largest floating point number that is representable. The actual\n\ +value is system dependent. On machines that support IEEE\n\ +floating point arithmetic, @code{realmax} is approximately\n\ +@tex\n\ +$1.7977\\times10^{308}$ for double precision and $3.4028\\times10^{38}$\n\ +@end tex\n\ +@ifnottex\n\ +1.7977e+308 for double precision and 3.4028e+38\n\ +@end ifnottex\n\ +for single precision.\n\ +\n\ +When called with no arguments, return a scalar with the value\n\ +@code{realmax (\"double\")}.\n\ +When called with a single argument, return a square matrix with the dimension\n\ +specified. When called with more than one scalar argument the first two\n\ +arguments are taken as the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{realmin, intmax, bitmax, eps}\n\ +@end deftypefn") +{ + return fill_matrix (args, std::numeric_limits::max (), + std::numeric_limits::max (), "realmax"); +} + +DEFUN (realmin, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} realmin\n\ +@deftypefnx {Built-in Function} {} realmin (@var{n})\n\ +@deftypefnx {Built-in Function} {} realmin (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} realmin (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} realmin (@dots{}, @var{class})\n\ +Return a scalar, matrix or N-dimensional array whose elements are all equal\n\ +to the smallest normalized floating point number that is representable.\n\ +The actual value is system dependent. On machines that support\n\ +IEEE floating point arithmetic, @code{realmin} is approximately\n\ +@tex\n\ +$2.2251\\times10^{-308}$ for double precision and $1.1755\\times10^{-38}$\n\ +@end tex\n\ +@ifnottex\n\ +2.2251e-308 for double precision and 1.1755e-38\n\ +@end ifnottex\n\ +for single precision.\n\ +\n\ +When called with no arguments, return a scalar with the value\n\ +@code{realmin (\"double\")}.\n\ +When called with a single argument, return a square matrix with the dimension\n\ +specified. When called with more than one scalar argument the first two\n\ +arguments are taken as the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{realmax, intmin, eps}\n\ +@end deftypefn") +{ + return fill_matrix (args, std::numeric_limits::min (), + std::numeric_limits::min (), "realmin"); +} + +DEFUN (I, args, , + "-*- texinfo -*-\n\ +@c List other forms of function in documentation index\n\ +@findex i\n\ +@findex j\n\ +@findex J\n\ +\n\ +@deftypefn {Built-in Function} {} I\n\ +@deftypefnx {Built-in Function} {} I (@var{n})\n\ +@deftypefnx {Built-in Function} {} I (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} I (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} I (@dots{}, @var{class})\n\ +Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ +to the pure imaginary unit, defined as\n\ +@tex\n\ +$\\sqrt{-1}$.\n\ +@end tex\n\ +@ifnottex\n\ +@code{sqrt (-1)}.\n\ +@end ifnottex\n\ +\n\ +I, and its equivalents i, j, and J, are functions so any of the names may\n\ +be reused for other purposes (such as i for a counter variable).\n\ +\n\ +When called with no arguments, return a scalar with the value @math{i}. When\n\ +called with a single argument, return a square matrix with the dimension\n\ +specified. When called with more than one scalar argument the first two\n\ +arguments are taken as the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{e, pi, log, exp}\n\ +@end deftypefn") +{ + return fill_matrix (args, Complex (0.0, 1.0), "I"); +} + +DEFALIAS (i, I); +DEFALIAS (J, I); +DEFALIAS (j, I); + +DEFUN (NA, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} NA\n\ +@deftypefnx {Built-in Function} {} NA (@var{n})\n\ +@deftypefnx {Built-in Function} {} NA (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} NA (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} NA (@dots{}, @var{class})\n\ +Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ +to the special constant used to designate missing values.\n\ +\n\ +Note that NA always compares not equal to NA (NA != NA).\n\ +To find NA values, use the @code{isna} function.\n\ +\n\ +When called with no arguments, return a scalar with the value @samp{NA}.\n\ +When called with a single argument, return a square matrix with the dimension\n\ +specified. When called with more than one scalar argument the first two\n\ +arguments are taken as the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{isna}\n\ +@end deftypefn") +{ + return fill_matrix (args, lo_ieee_na_value (), + lo_ieee_float_na_value (), "NA"); +} + +/* +%!assert (single (NA ("double")), NA ("single")) +%!assert (double (NA ("single")), NA ("double")) +*/ + +DEFUN (false, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} false (@var{x})\n\ +@deftypefnx {Built-in Function} {} false (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} false (@var{n}, @var{m}, @var{k}, @dots{})\n\ +Return a matrix or N-dimensional array whose elements are all logical 0.\n\ +If invoked with a single scalar integer argument, return a square\n\ +matrix of the specified size. If invoked with two or more scalar\n\ +integer arguments, or a vector of integer values, return an array with\n\ +given dimensions.\n\ +@seealso{true}\n\ +@end deftypefn") +{ + return fill_matrix (args, false, "false"); +} + +DEFUN (true, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} true (@var{x})\n\ +@deftypefnx {Built-in Function} {} true (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} true (@var{n}, @var{m}, @var{k}, @dots{})\n\ +Return a matrix or N-dimensional array whose elements are all logical 1.\n\ +If invoked with a single scalar integer argument, return a square\n\ +matrix of the specified size. If invoked with two or more scalar\n\ +integer arguments, or a vector of integer values, return an array with\n\ +given dimensions.\n\ +@seealso{false}\n\ +@end deftypefn") +{ + return fill_matrix (args, true, "true"); +} + +template +octave_value +identity_matrix (int nr, int nc) +{ + octave_value retval; + + typename MT::element_type one (1); + + if (nr == 1 && nc == 1) + retval = one; + else + { + dim_vector dims (nr, nc); + + typename MT::element_type zero (0); + + MT m (dims, zero); + + if (nr > 0 && nc > 0) + { + int n = std::min (nr, nc); + + for (int i = 0; i < n; i++) + m(i,i) = one; + } + + retval = m; + } + + return retval; +} + +#define INSTANTIATE_EYE(T) \ + template octave_value identity_matrix (int, int) + +INSTANTIATE_EYE (int8NDArray); +INSTANTIATE_EYE (uint8NDArray); +INSTANTIATE_EYE (int16NDArray); +INSTANTIATE_EYE (uint16NDArray); +INSTANTIATE_EYE (int32NDArray); +INSTANTIATE_EYE (uint32NDArray); +INSTANTIATE_EYE (int64NDArray); +INSTANTIATE_EYE (uint64NDArray); +INSTANTIATE_EYE (FloatNDArray); +INSTANTIATE_EYE (NDArray); +INSTANTIATE_EYE (boolNDArray); + +static octave_value +identity_matrix (int nr, int nc, oct_data_conv::data_type dt) +{ + octave_value retval; + + // FIXME -- perhaps this should be made extensible by using + // the class name to lookup a function to call to create the new + // value. + + if (! error_state) + { + switch (dt) + { + case oct_data_conv::dt_int8: + retval = identity_matrix (nr, nc); + break; + + case oct_data_conv::dt_uint8: + retval = identity_matrix (nr, nc); + break; + + case oct_data_conv::dt_int16: + retval = identity_matrix (nr, nc); + break; + + case oct_data_conv::dt_uint16: + retval = identity_matrix (nr, nc); + break; + + case oct_data_conv::dt_int32: + retval = identity_matrix (nr, nc); + break; + + case oct_data_conv::dt_uint32: + retval = identity_matrix (nr, nc); + break; + + case oct_data_conv::dt_int64: + retval = identity_matrix (nr, nc); + break; + + case oct_data_conv::dt_uint64: + retval = identity_matrix (nr, nc); + break; + + case oct_data_conv::dt_single: + retval = FloatDiagMatrix (nr, nc, 1.0f); + break; + + case oct_data_conv::dt_double: + retval = DiagMatrix (nr, nc, 1.0); + break; + + case oct_data_conv::dt_logical: + retval = identity_matrix (nr, nc); + break; + + default: + error ("eye: invalid class name"); + break; + } + } + + return retval; +} + +#undef INT_EYE_MATRIX + +DEFUN (eye, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} eye (@var{n})\n\ +@deftypefnx {Built-in Function} {} eye (@var{m}, @var{n})\n\ +@deftypefnx {Built-in Function} {} eye ([@var{m} @var{n}])\n\ +@deftypefnx {Built-in Function} {} eye (@dots{}, @var{class})\n\ +Return an identity matrix. If invoked with a single scalar argument @var{n},\n\ +return a square @nospell{NxN} identity matrix. If\n\ +supplied two scalar arguments (@var{m}, @var{n}), @code{eye} takes them to be\n\ +the number of rows and columns. If given a vector with two elements,\n\ +@code{eye} uses the values of the elements as the number of rows and columns,\n\ +respectively. For example:\n\ +\n\ +@example\n\ +@group\n\ +eye (3)\n\ + @result{} 1 0 0\n\ + 0 1 0\n\ + 0 0 1\n\ +@end group\n\ +@end example\n\ +\n\ +The following expressions all produce the same result:\n\ +\n\ +@example\n\ +@group\n\ +eye (2)\n\ +@equiv{}\n\ +eye (2, 2)\n\ +@equiv{}\n\ +eye (size ([1, 2; 3, 4])\n\ +@end group\n\ +@end example\n\ +\n\ +The optional argument @var{class}, allows @code{eye} to return an array of\n\ +the specified type, like\n\ +\n\ +@example\n\ +val = zeros (n,m, \"uint8\")\n\ +@end example\n\ +\n\ +Calling @code{eye} with no arguments is equivalent to calling it\n\ +with an argument of 1. Any negative dimensions are treated as zero. \n\ +These odd definitions are for compatibility with @sc{matlab}.\n\ +@seealso{speye, ones, zeros}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + oct_data_conv::data_type dt = oct_data_conv::dt_double; + + // Check for type information. + + if (nargin > 0 && args(nargin-1).is_string ()) + { + std::string nm = args(nargin-1).string_value (); + nargin--; + + dt = oct_data_conv::string_to_data_type (nm); + + if (error_state) + return retval; + } + + switch (nargin) + { + case 0: + retval = identity_matrix (1, 1, dt); + break; + + case 1: + { + octave_idx_type nr, nc; + get_dimensions (args(0), "eye", nr, nc); + + if (! error_state) + retval = identity_matrix (nr, nc, dt); + } + break; + + case 2: + { + octave_idx_type nr, nc; + get_dimensions (args(0), args(1), "eye", nr, nc); + + if (! error_state) + retval = identity_matrix (nr, nc, dt); + } + break; + + default: + print_usage (); + break; + } + + return retval; +} + +/* +%!assert (full (eye (3)), [1, 0, 0; 0, 1, 0; 0, 0, 1]) +%!assert (full (eye (2, 3)), [1, 0, 0; 0, 1, 0]) + +%!assert (full (eye (3,"single")), single ([1, 0, 0; 0, 1, 0; 0, 0, 1])) +%!assert (full (eye (2, 3,"single")), single ([1, 0, 0; 0, 1, 0])) + +%!assert (eye (3, "int8"), int8 ([1, 0, 0; 0, 1, 0; 0, 0, 1])) +%!assert (eye (2, 3, "int8"), int8 ([1, 0, 0; 0, 1, 0])) + +%!error eye (1, 2, 3) +*/ + +template +static octave_value +do_linspace (const octave_value& base, const octave_value& limit, + octave_idx_type n) +{ + typedef typename MT::column_vector_type CVT; + typedef typename MT::element_type T; + + octave_value retval; + + if (base.is_scalar_type ()) + { + T bs = octave_value_extract (base); + if (limit.is_scalar_type ()) + { + T ls = octave_value_extract (limit); + retval = linspace (bs, ls, n); + } + else + { + CVT lv = octave_value_extract (limit); + CVT bv (lv.length (), bs); + retval = linspace (bv, lv, n); + } + } + else + { + CVT bv = octave_value_extract (base); + if (limit.is_scalar_type ()) + { + T ls = octave_value_extract (limit); + CVT lv (bv.length (), ls); + retval = linspace (bv, lv, n); + } + else + { + CVT lv = octave_value_extract (limit); + retval = linspace (bv, lv, n); + } + } + + return retval; +} + +DEFUN (linspace, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} linspace (@var{base}, @var{limit})\n\ +@deftypefnx {Built-in Function} {} linspace (@var{base}, @var{limit}, @var{n})\n\ +Return a row vector with @var{n} linearly spaced elements between\n\ +@var{base} and @var{limit}. If the number of elements is greater than one,\n\ +then the endpoints @var{base} and @var{limit} are always included in\n\ +the range. If @var{base} is greater than @var{limit}, the elements are\n\ +stored in decreasing order. If the number of points is not specified, a\n\ +value of 100 is used.\n\ +\n\ +The @code{linspace} function always returns a row vector if both\n\ +@var{base} and @var{limit} are scalars. If one, or both, of them are column\n\ +vectors, @code{linspace} returns a matrix.\n\ +\n\ +For compatibility with @sc{matlab}, return the second argument (@var{limit})\n\ +if fewer than two values are requested.\n\ +@seealso{logspace}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + octave_idx_type npoints = 100; + + if (nargin != 2 && nargin != 3) + { + print_usage (); + return retval; + } + + if (nargin == 3) + { + // Apparently undocumented Matlab. If the third arg is an empty + // numeric value, the number of points defaults to 1. + + octave_value arg_3 = args(2); + + if (arg_3.is_numeric_type () && arg_3.is_empty ()) + npoints = 1; + else + npoints = arg_3.idx_type_value (); + } + + if (! error_state) + { + octave_value arg_1 = args(0); + octave_value arg_2 = args(1); + + if (arg_1.is_single_type () || arg_2.is_single_type ()) + { + if (arg_1.is_complex_type () || arg_2.is_complex_type ()) + retval = do_linspace (arg_1, arg_2, npoints); + else + retval = do_linspace (arg_1, arg_2, npoints); + + } + else + { + if (arg_1.is_complex_type () || arg_2.is_complex_type ()) + retval = do_linspace (arg_1, arg_2, npoints); + else + retval = do_linspace (arg_1, arg_2, npoints); + } + } + else + error ("linspace: N must be an integer"); + + return retval; +} + + +/* +%!test +%! x1 = linspace (1, 2); +%! x2 = linspace (1, 2, 10); +%! x3 = linspace (1, -2, 10); +%! assert (size (x1) == [1, 100] && x1(1) == 1 && x1(100) == 2); +%! assert (size (x2) == [1, 10] && x2(1) == 1 && x2(10) == 2); +%! assert (size (x3) == [1, 10] && x3(1) == 1 && x3(10) == -2); + +%assert (linspace ([1, 2; 3, 4], 5, 6), linspace (1, 5, 6)) + +%assert (linspace (0, 1, []), 1) + +%!error linspace () +%!error linspace (1, 2, 3, 4) +*/ + +// FIXME -- should accept dimensions as separate args for N-d +// arrays as well as 1-d and 2-d arrays. + +DEFUN (resize, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} resize (@var{x}, @var{m})\n\ +@deftypefnx {Built-in Function} {} resize (@var{x}, @var{m}, @var{n}, @dots{})\n\ +@deftypefnx {Built-in Function} {} resize (@var{x}, [@var{m} @var{n} @dots{}])\n\ +Resize @var{x} cutting off elements as necessary.\n\ +\n\ +In the result, element with certain indices is equal to the corresponding\n\ +element of @var{x} if the indices are within the bounds of @var{x};\n\ +otherwise, the element is set to zero.\n\ +\n\ +In other words, the statement\n\ +\n\ +@example\n\ +y = resize (x, dv)\n\ +@end example\n\ +\n\ +@noindent\n\ +is equivalent to the following code:\n\ +\n\ +@example\n\ +@group\n\ +y = zeros (dv, class (x));\n\ +sz = min (dv, size (x));\n\ +for i = 1:length (sz)\n\ + idx@{i@} = 1:sz(i);\n\ +endfor\n\ +y(idx@{:@}) = x(idx@{:@});\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +but is performed more efficiently.\n\ +\n\ +If only @var{m} is supplied, and it is a scalar, the dimension of the\n\ +result is @var{m}-by-@var{m}.\n\ +If @var{m}, @var{n}, @dots{} are all scalars, then the dimensions of\n\ +the result are @var{m}-by-@var{n}-by-@dots{}.\n\ +If given a vector as input, then the\n\ +dimensions of the result are given by the elements of that vector.\n\ +\n\ +An object can be resized to more dimensions than it has;\n\ +in such case the missing dimensions are assumed to be 1.\n\ +Resizing an object to fewer dimensions is not possible.\n\ +@seealso{reshape, postpad, prepad, cat}\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + + if (nargin == 2) + { + Array vec = args(1).vector_value (); + int ndim = vec.length (); + if (ndim == 1) + { + octave_idx_type m = static_cast (vec(0)); + retval = args(0); + retval = retval.resize (dim_vector (m, m), true); + } + else + { + dim_vector dv; + dv.resize (ndim); + for (int i = 0; i < ndim; i++) + dv(i) = static_cast (vec(i)); + retval = args(0); + retval = retval.resize (dv, true); + } + } + else if (nargin > 2) + { + dim_vector dv; + dv.resize (nargin - 1); + for (octave_idx_type i = 1; i < nargin; i++) + dv(i-1) = static_cast (args(i).scalar_value ()); + if (!error_state) + { + retval = args(0); + retval = retval.resize (dv, true); + } + + } + else + print_usage (); + return retval; +} + +// FIXME -- should use octave_idx_type for dimensions. + +DEFUN (reshape, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} reshape (@var{A}, @var{m}, @var{n}, @dots{})\n\ +@deftypefnx {Built-in Function} {} reshape (@var{A}, [@var{m} @var{n} @dots{}])\n\ +@deftypefnx {Built-in Function} {} reshape (@var{A}, @dots{}, [], @dots{})\n\ +@deftypefnx {Built-in Function} {} reshape (@var{A}, @var{size})\n\ +Return a matrix with the specified dimensions (@var{m}, @var{n}, @dots{})\n\ +whose elements are taken from the matrix @var{A}. The elements of the\n\ +matrix are accessed in column-major order (like Fortran arrays are stored).\n\ +\n\ +The following code demonstrates reshaping a 1x4 row vector into a 2x2 square\n\ +matrix.\n\ +\n\ +@example\n\ +@group\n\ +reshape ([1, 2, 3, 4], 2, 2)\n\ + @result{} 1 3\n\ + 2 4\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +Note that the total number of elements in the original\n\ +matrix (@code{prod (size (@var{A}))}) must match the total number of elements\n\ +in the new matrix (@code{prod ([@var{m} @var{n} @dots{}])}).\n\ +\n\ +A single dimension of the return matrix may be left unspecified and Octave\n\ +will determine its size automatically. An empty matrix ([]) is used to flag\n\ +the unspecified dimension.\n\ +@seealso{resize, vec, postpad, cat, squeeze}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + dim_vector new_dims; + + if (nargin == 2) + { + Array new_size = args(1).octave_idx_type_vector_value (); + + new_dims = dim_vector::alloc (new_size.length ()); + + for (octave_idx_type i = 0; i < new_size.length (); i++) + { + if (new_size(i) < 0) + { + error ("reshape: SIZE must be non-negative"); + break; + } + else + new_dims(i) = new_size(i); + } + } + else if (nargin > 2) + { + new_dims = dim_vector::alloc (nargin-1); + int empty_dim = -1; + + for (int i = 1; i < nargin; i++) + { + if (args(i).is_empty ()) + { + if (empty_dim > 0) + { + error ("reshape: only a single dimension can be unknown"); + break; + } + else + { + empty_dim = i; + new_dims(i-1) = 1; + } + } + else + { + new_dims(i-1) = args(i).idx_type_value (); + + if (error_state) + break; + else if (new_dims(i-1) < 0) + { + error ("reshape: SIZE must be non-negative"); + break; + } + } + } + + if (! error_state && (empty_dim > 0)) + { + octave_idx_type nel = new_dims.numel (); + + if (nel == 0) + new_dims(empty_dim-1) = 0; + else + { + octave_idx_type a_nel = args(0).numel (); + octave_idx_type size_empty_dim = a_nel / nel; + + if (a_nel != size_empty_dim * nel) + error ("reshape: SIZE is not divisible by the product of known dimensions (= %d)", nel); + else + new_dims(empty_dim-1) = size_empty_dim; + } + } + } + else + { + print_usage (); + return retval; + } + + if (! error_state) + retval = args(0).reshape (new_dims); + + return retval; +} + +/* +%!assert (size (reshape (ones (4, 4), 2, 8)), [2, 8]) +%!assert (size (reshape (ones (4, 4), 8, 2)), [8, 2]) +%!assert (size (reshape (ones (15, 4), 1, 60)), [1, 60]) +%!assert (size (reshape (ones (15, 4), 60, 1)), [60, 1]) + +%!assert (size (reshape (ones (4, 4, "single"), 2, 8)), [2, 8]) +%!assert (size (reshape (ones (4, 4, "single"), 8, 2)), [8, 2]) +%!assert (size (reshape (ones (15, 4, "single"), 1, 60)), [1, 60]) +%!assert (size (reshape (ones (15, 4, "single"), 60, 1)), [60, 1]) + +%!test +%! s.a = 1; +%! fail ("reshape (s, 2, 3)"); + +%!error reshape () +%!error reshape (1, 2, 3, 4) +*/ + +DEFUN (vec, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{v} =} vec (@var{x})\n\ +@deftypefnx {Built-in Function} {@var{v} =} vec (@var{x}, @var{dim})\n\ +Return the vector obtained by stacking the columns of the matrix @var{x}\n\ +one above the other. Without @var{dim} this is equivalent to\n\ +@code{@var{x}(:)}. If @var{dim} is supplied, the dimensions of @var{v}\n\ +are set to @var{dim} with all elements along the last dimension.\n\ +This is equivalent to @code{shiftdim (@var{x}(:), 1-@var{dim})}.\n\ +@seealso{vech, resize, cat}\n\ +@end deftypefn") +{ + octave_value retval; + int dim = 1; + + int nargin = args.length (); + + if (nargin < 1 || nargin > 2) + print_usage () ; + + if (! error_state && nargin == 2) + { + dim = args(1).idx_type_value (); + + if (dim < 1) + error ("vec: DIM must be greater than zero"); + } + + if (! error_state) + { + octave_value colon (octave_value::magic_colon_t); + octave_value arg = args(0); + retval = arg.single_subsref ("(", colon); + + + if (! error_state && dim > 1) + { + dim_vector new_dims = dim_vector::alloc (dim); + + for (int i = 0; i < dim-1; i++) + new_dims(i) = 1; + + new_dims(dim-1) = retval.numel (); + + retval = retval.reshape (new_dims); + } + } + + return retval; +} + +/* +%!assert (vec ([1, 2; 3, 4]), [1; 3; 2; 4]) +%!assert (vec ([1, 3, 2, 4]), [1; 3; 2; 4]) +%!assert (vec ([1, 2, 3, 4], 2), [1, 2, 3, 4]) +%!assert (vec ([1, 2; 3, 4]), vec ([1, 2; 3, 4], 1)) +%!assert (vec ([1, 2; 3, 4], 1), [1; 3; 2; 4]) +%!assert (vec ([1, 2; 3, 4], 2), [1, 3, 2, 4]) +%!assert (vec ([1, 3; 2, 4], 3), reshape ([1, 2, 3, 4], 1, 1, 4)) +%!assert (vec ([1, 3; 2, 4], 3), shiftdim (vec ([1, 3; 2, 4]), -2)) + +%!error vec () +%!error vec (1, 2, 3) +%!error vec ([1, 2; 3, 4], 0) +*/ + +DEFUN (squeeze, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} squeeze (@var{x})\n\ +Remove singleton dimensions from @var{x} and return the result.\n\ +Note that for compatibility with @sc{matlab}, all objects have\n\ +a minimum of two dimensions and row vectors are left unchanged.\n\ +@seealso{reshape}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).squeeze (); + else + print_usage (); + + return retval; +} + +DEFUN (full, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{FM} =} full (@var{SM})\n\ +Return a full storage matrix from a sparse, diagonal, permutation matrix\n\ +or a range.\n\ +@seealso{sparse}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).full_value (); + else + print_usage (); + + return retval; +} + +// Compute various norms of the vector X. + +DEFUN (norm, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} norm (@var{A})\n\ +@deftypefnx {Built-in Function} {} norm (@var{A}, @var{p})\n\ +@deftypefnx {Built-in Function} {} norm (@var{A}, @var{p}, @var{opt})\n\ +Compute the p-norm of the matrix @var{A}. If the second argument is\n\ +missing, @code{p = 2} is assumed.\n\ +\n\ +If @var{A} is a matrix (or sparse matrix):\n\ +\n\ +@table @asis\n\ +@item @var{p} = @code{1}\n\ +1-norm, the largest column sum of the absolute values of @var{A}.\n\ +\n\ +@item @var{p} = @code{2}\n\ +Largest singular value of @var{A}.\n\ +\n\ +@item @var{p} = @code{Inf} or @code{\"inf\"}\n\ +@cindex infinity norm\n\ +Infinity norm, the largest row sum of the absolute values of @var{A}.\n\ +\n\ +@item @var{p} = @code{\"fro\"}\n\ +@cindex Frobenius norm\n\ +Frobenius norm of @var{A}, @code{sqrt (sum (diag (@var{A}' * @var{A})))}.\n\ +\n\ +@item other @var{p}, @code{@var{p} > 1}\n\ +@cindex general p-norm\n\ +maximum @code{norm (A*x, p)} such that @code{norm (x, p) == 1}\n\ +@end table\n\ +\n\ +If @var{A} is a vector or a scalar:\n\ +\n\ +@table @asis\n\ +@item @var{p} = @code{Inf} or @code{\"inf\"}\n\ +@code{max (abs (@var{A}))}.\n\ +\n\ +@item @var{p} = @code{-Inf}\n\ +@code{min (abs (@var{A}))}.\n\ +\n\ +@item @var{p} = @code{\"fro\"}\n\ +Frobenius norm of @var{A}, @code{sqrt (sumsq (abs (A)))}.\n\ +\n\ +@item @var{p} = 0\n\ +Hamming norm - the number of nonzero elements.\n\ +\n\ +@item other @var{p}, @code{@var{p} > 1}\n\ +p-norm of @var{A}, @code{(sum (abs (@var{A}) .^ @var{p})) ^ (1/@var{p})}.\n\ +\n\ +@item other @var{p} @code{@var{p} < 1}\n\ +the p-pseudonorm defined as above.\n\ +@end table\n\ +\n\ +If @var{opt} is the value @code{\"rows\"}, treat each row as a vector and\n\ +compute its norm. The result is returned as a column vector.\n\ +Similarly, if @var{opt} is @code{\"columns\"} or @code{\"cols\"} then compute\n\ +the norms of each column and return a row vector.\n\ +@seealso{cond, svd}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin >= 1 && nargin <= 3) + { + octave_value x_arg = args(0); + + if (x_arg.ndims () == 2) + { + enum { sfmatrix, sfcols, sfrows, sffrob, sfinf } strflag = sfmatrix; + if (nargin > 1 && args(nargin-1).is_string ()) + { + std::string str = args(nargin-1).string_value (); + if (str == "cols" || str == "columns") + strflag = sfcols; + else if (str == "rows") + strflag = sfrows; + else if (str == "fro") + strflag = sffrob; + else if (str == "inf") + strflag = sfinf; + else + error ("norm: unrecognized option: %s", str.c_str ()); + // we've handled the last parameter, so act as if it was removed + nargin --; + } + else if (nargin > 1 && ! args(1).is_scalar_type ()) + gripe_wrong_type_arg ("norm", args(1), true); + + if (! error_state) + { + octave_value p_arg = (nargin > 1) ? args(1) : octave_value (2); + switch (strflag) + { + case sfmatrix: + retval(0) = xnorm (x_arg, p_arg); + break; + case sfcols: + retval(0) = xcolnorms (x_arg, p_arg); + break; + case sfrows: + retval(0) = xrownorms (x_arg, p_arg); + break; + case sffrob: + retval(0) = xfrobnorm (x_arg); + break; + case sfinf: + retval(0) = xnorm (x_arg, octave_Inf); + break; + } + } + } + else + error ("norm: only valid for 2-D objects"); + } + else + print_usage (); + + return retval; +} + +/* +%!shared x +%! x = [1, -3, 4, 5, -7]; +%!assert (norm (x,1), 20) +%!assert (norm (x,2), 10) +%!assert (norm (x,3), 8.24257059961711, -4*eps) +%!assert (norm (x,Inf), 7) +%!assert (norm (x,-Inf), 1) +%!assert (norm (x,"inf"), 7) +%!assert (norm (x,"fro"), 10, -eps) +%!assert (norm (x), 10) +%!assert (norm ([1e200, 1]), 1e200) +%!assert (norm ([3+4i, 3-4i, sqrt(31)]), 9, -4*eps) +%!shared m +%! m = magic (4); +%!assert (norm (m,1), 34) +%!assert (norm (m,2), 34, -eps) +%!assert (norm (m,Inf), 34) +%!assert (norm (m,"inf"), 34) +%!shared m2, flo, fhi +%! m2 = [1,2;3,4]; +%! flo = 1e-300; +%! fhi = 1e+300; +%!assert (norm (flo*m2,"fro"), sqrt (30)*flo, -eps) +%!assert (norm (fhi*m2,"fro"), sqrt (30)*fhi, -eps) + +%!shared x +%! x = single ([1, -3, 4, 5, -7]); +%!assert (norm (x,1), single (20)) +%!assert (norm (x,2), single (10)) +%!assert (norm (x,3), single (8.24257059961711), -4*eps ("single")) +%!assert (norm (x,Inf), single (7)) +%!assert (norm (x,-Inf), single (1)) +%!assert (norm (x,"inf"), single (7)) +%!assert (norm (x,"fro"), single (10), -eps ("single")) +%!assert (norm (x), single (10)) +%!assert (norm (single ([1e200, 1])), single (1e200)) +%!assert (norm (single ([3+4i, 3-4i, sqrt(31)])), single (9), -4*eps ("single")) +%!shared m +%! m = single (magic (4)); +%!assert (norm (m,1), single (34)) +%!assert (norm (m,2), single (34), -eps ("single")) +%!assert (norm (m,Inf), single (34)) +%!assert (norm (m,"inf"), single (34)) +%!shared m2, flo, fhi +%! m2 = single ([1,2;3,4]); +%! flo = single (1e-300); +%! fhi = single (1e+300); +%!assert (norm (flo*m2,"fro"), single (sqrt (30)*flo), -eps ("single")) +%!assert (norm (fhi*m2,"fro"), single (sqrt (30)*fhi), -eps ("single")) + +%!test +%! ## Test for norm returning NaN on sparse matrix (bug #30631) +%! A = sparse (2,2); +%! A(2,1) = 1; +%! assert (norm (A), 1); +*/ + +static octave_value +unary_op_defun_body (octave_value::unary_op op, + const octave_value_list& args) +{ + octave_value retval; + if (args.length () == 1) + retval = do_unary_op (op, args(0)); + else + print_usage (); + + return retval; +} + +DEFUN (not, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} not (@var{x})\n\ +Return the logical NOT of @var{x}. This function is equivalent to\n\ +@code{! x}.\n\ +@seealso{and, or, xor}\n\ +@end deftypefn") +{ + return unary_op_defun_body (octave_value::op_not, args); +} + +DEFUN (uplus, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} uplus (@var{x})\n\ +This function and @w{@xcode{+ x}} are equivalent.\n\ +@seealso{uminus, plus, minus}\n\ +@end deftypefn") +{ + return unary_op_defun_body (octave_value::op_uplus, args); +} + +DEFUN (uminus, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} uminus (@var{x})\n\ +This function and @w{@xcode{- x}} are equivalent.\n\ +@seealso{uplus, minus}\n\ +@end deftypefn") +{ + return unary_op_defun_body (octave_value::op_uminus, args); +} + +DEFUN (transpose, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} transpose (@var{x})\n\ +Return the transpose of @var{x}.\n\ +This function and @xcode{x.'} are equivalent.\n\ +@seealso{ctranspose}\n\ +@end deftypefn") +{ + return unary_op_defun_body (octave_value::op_transpose, args); +} + +/* +%!assert (2.', 2) +%!assert (2i.', 2i) +%!assert ([1:4].', [1;2;3;4]) +%!assert ([1;2;3;4].', [1:4]) +%!assert ([1,2;3,4].', [1,3;2,4]) +%!assert ([1,2i;3,4].', [1,3;2i,4]) + +%!assert (transpose ([1,2;3,4]), [1,3;2,4]) + +%!assert (single (2).', single (2)) +%!assert (single (2i).', single (2i)) +%!assert (single ([1:4]).', single ([1;2;3;4])) +%!assert (single ([1;2;3;4]).', single ([1:4])) +%!assert (single ([1,2;3,4]).', single ([1,3;2,4])) +%!assert (single ([1,2i;3,4]).', single ([1,3;2i,4])) + +%!assert (transpose (single ([1,2;3,4])), single ([1,3;2,4])) +*/ + +DEFUN (ctranspose, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ctranspose (@var{x})\n\ +Return the complex conjugate transpose of @var{x}.\n\ +This function and @xcode{x'} are equivalent.\n\ +@seealso{transpose}\n\ +@end deftypefn") +{ + return unary_op_defun_body (octave_value::op_hermitian, args); +} + +/* +%!assert (2', 2) +%!assert (2i', -2i) +%!assert ([1:4]', [1;2;3;4]) +%!assert ([1;2;3;4]', [1:4]) +%!assert ([1,2;3,4]', [1,3;2,4]) +%!assert ([1,2i;3,4]', [1,3;-2i,4]) + +%!assert (ctranspose ([1,2i;3,4]), [1,3;-2i,4]) + +%!assert (single (2)', single (2)) +%!assert (single (2i)', single (-2i)) +%!assert (single ([1:4])', single ([1;2;3;4])) +%!assert (single ([1;2;3;4])', single ([1:4])) +%!assert (single ([1,2;3,4])', single ([1,3;2,4])) +%!assert (single ([1,2i;3,4])', single ([1,3;-2i,4])) + +%!assert (ctranspose (single ([1,2i;3,4])), single ([1,3;-2i,4])) +*/ + +static octave_value +binary_op_defun_body (octave_value::binary_op op, + const octave_value_list& args) +{ + octave_value retval; + + if (args.length () == 2) + retval = do_binary_op (op, args(0), args(1)); + else + print_usage (); + + return retval; +} + +static octave_value +binary_assoc_op_defun_body (octave_value::binary_op op, + octave_value::assign_op aop, + const octave_value_list& args) +{ + octave_value retval; + int nargin = args.length (); + + switch (nargin) + { + case 0: + print_usage (); + break; + case 1: + retval = args(0); + break; + case 2: + retval = do_binary_op (op, args(0), args(1)); + break; + default: + retval = do_binary_op (op, args(0), args(1)); + for (int i = 2; i < nargin; i++) + retval.assign (aop, args(i)); + break; + } + + return retval; +} + +DEFUN (plus, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} plus (@var{x}, @var{y})\n\ +@deftypefnx {Built-in Function} {} plus (@var{x1}, @var{x2}, @dots{})\n\ +This function and @w{@xcode{x + y}} are equivalent.\n\ +If more arguments are given, the summation is applied\n\ +cumulatively from left to right:\n\ +\n\ +@example\n\ +(@dots{}((x1 + x2) + x3) + @dots{})\n\ +@end example\n\ +\n\ +At least one argument is required.\n\ +@seealso{minus, uplus}\n\ +@end deftypefn") +{ + return binary_assoc_op_defun_body (octave_value::op_add, + octave_value::op_add_eq, args); +} + +DEFUN (minus, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} minus (@var{x}, @var{y})\n\ +This function and @w{@xcode{x - y}} are equivalent.\n\ +@seealso{plus, uminus}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_sub, args); +} + +DEFUN (mtimes, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} mtimes (@var{x}, @var{y})\n\ +@deftypefnx {Built-in Function} {} mtimes (@var{x1}, @var{x2}, @dots{})\n\ +Return the matrix multiplication product of inputs.\n\ +This function and @w{@xcode{x * y}} are equivalent.\n\ +If more arguments are given, the multiplication is applied\n\ +cumulatively from left to right:\n\ +\n\ +@example\n\ +(@dots{}((x1 * x2) * x3) * @dots{})\n\ +@end example\n\ +\n\ +At least one argument is required.\n\ +@seealso{times, plus, minus, rdivide, mrdivide, mldivide, mpower}\n\ +@end deftypefn") +{ + return binary_assoc_op_defun_body (octave_value::op_mul, + octave_value::op_mul_eq, args); +} + +DEFUN (mrdivide, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} mrdivide (@var{x}, @var{y})\n\ +Return the matrix right division of @var{x} and @var{y}.\n\ +This function and @w{@xcode{x / y}} are equivalent.\n\ +@seealso{mldivide, rdivide, plus, minus}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_div, args); +} + +DEFUN (mpower, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} mpower (@var{x}, @var{y})\n\ +Return the matrix power operation of @var{x} raised to the @var{y} power.\n\ +This function and @w{@xcode{x ^ y}} are equivalent.\n\ +@seealso{power, mtimes, plus, minus}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_pow, args); +} + +DEFUN (mldivide, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} mldivide (@var{x}, @var{y})\n\ +Return the matrix left division of @var{x} and @var{y}.\n\ +This function and @w{@xcode{x @xbackslashchar{} y}} are equivalent.\n\ +@seealso{mrdivide, ldivide, rdivide}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_ldiv, args); +} + +DEFUN (lt, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} lt (@var{x}, @var{y})\n\ +This function is equivalent to @w{@code{x < y}}.\n\ +@seealso{le, eq, ge, gt, ne}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_lt, args); +} + +DEFUN (le, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} le (@var{x}, @var{y})\n\ +This function is equivalent to @w{@code{x <= y}}.\n\ +@seealso{eq, ge, gt, ne, lt}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_le, args); +} + +DEFUN (eq, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} eq (@var{x}, @var{y})\n\ +Return true if the two inputs are equal.\n\ +This function is equivalent to @w{@code{x == y}}.\n\ +@seealso{ne, isequal, le, ge, gt, ne, lt}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_eq, args); +} + +DEFUN (ge, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ge (@var{x}, @var{y})\n\ +This function is equivalent to @w{@code{x >= y}}.\n\ +@seealso{le, eq, gt, ne, lt}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_ge, args); +} + +DEFUN (gt, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} gt (@var{x}, @var{y})\n\ +This function is equivalent to @w{@code{x > y}}.\n\ +@seealso{le, eq, ge, ne, lt}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_gt, args); +} + +DEFUN (ne, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ne (@var{x}, @var{y})\n\ +Return true if the two inputs are not equal.\n\ +This function is equivalent to @w{@code{x != y}}.\n\ +@seealso{eq, isequal, le, ge, lt}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_ne, args); +} + +DEFUN (times, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} times (@var{x}, @var{y})\n\ +@deftypefnx {Built-in Function} {} times (@var{x1}, @var{x2}, @dots{})\n\ +Return the element-by-element multiplication product of inputs.\n\ +This function and @w{@xcode{x .* y}} are equivalent.\n\ +If more arguments are given, the multiplication is applied\n\ +cumulatively from left to right:\n\ +\n\ +@example\n\ +(@dots{}((x1 .* x2) .* x3) .* @dots{})\n\ +@end example\n\ +\n\ +At least one argument is required.\n\ +@seealso{mtimes, rdivide}\n\ +@end deftypefn") +{ + return binary_assoc_op_defun_body (octave_value::op_el_mul, + octave_value::op_el_mul_eq, args); +} + +DEFUN (rdivide, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} rdivide (@var{x}, @var{y})\n\ +Return the element-by-element right division of @var{x} and @var{y}.\n\ +This function and @w{@xcode{x ./ y}} are equivalent.\n\ +@seealso{ldivide, mrdivide, times, plus}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_el_div, args); +} + +DEFUN (power, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} power (@var{x}, @var{y})\n\ +Return the element-by-element operation of @var{x} raised to the\n\ +@var{y} power. If several complex results are possible,\n\ +returns the one with smallest non-negative argument (angle). Use\n\ +@code{realpow}, @code{realsqrt}, @code{cbrt}, or @code{nthroot} if a\n\ +real result is preferred.\n\ +\n\ +This function and @w{@xcode{x .^ y}} are equivalent.\n\ +@seealso{mpower, realpow, realsqrt, cbrt, nthroot}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_el_pow, args); +} + +DEFUN (ldivide, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ldivide (@var{x}, @var{y})\n\ +Return the element-by-element left division of @var{x} and @var{y}.\n\ +This function and @w{@xcode{x .@xbackslashchar{} y}} are equivalent.\n\ +@seealso{rdivide, mldivide, times, plus}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_el_ldiv, args); +} + +DEFUN (and, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} and (@var{x}, @var{y})\n\ +@deftypefnx {Built-in Function} {} and (@var{x1}, @var{x2}, @dots{})\n\ +Return the logical AND of @var{x} and @var{y}.\n\ +This function is equivalent to @w{@code{x & y}}.\n\ +If more arguments are given, the logical and is applied\n\ +cumulatively from left to right:\n\ +\n\ +@example\n\ +(@dots{}((x1 & x2) & x3) & @dots{})\n\ +@end example\n\ +\n\ +At least one argument is required.\n\ +@seealso{or, not, xor}\n\ +@end deftypefn") +{ + return binary_assoc_op_defun_body (octave_value::op_el_and, + octave_value::op_el_and_eq, args); +} + +DEFUN (or, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} or (@var{x}, @var{y})\n\ +@deftypefnx {Built-in Function} {} or (@var{x1}, @var{x2}, @dots{})\n\ +Return the logical OR of @var{x} and @var{y}.\n\ +This function is equivalent to @w{@code{x | y}}.\n\ +If more arguments are given, the logical or is applied\n\ +cumulatively from left to right:\n\ +\n\ +@example\n\ +(@dots{}((x1 | x2) | x3) | @dots{})\n\ +@end example\n\ +\n\ +At least one argument is required.\n\ +@seealso{and, not, xor}\n\ +@end deftypefn") +{ + return binary_assoc_op_defun_body (octave_value::op_el_or, + octave_value::op_el_or_eq, args); +} + +static double tic_toc_timestamp = -1.0; + +DEFUN (tic, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} tic ()\n\ +@deftypefnx {Built-in Function} {@var{id} =} tic ()\n\ +@deftypefnx {Built-in Function} {} toc ()\n\ +@deftypefnx {Built-in Function} {} toc (@var{id})\n\ +@deftypefnx {Built-in Function} {@var{val} =} toc (@dots{})\n\ +Set or check a wall-clock timer. Calling @code{tic} without an\n\ +output argument sets the internal timer state. Subsequent calls\n\ +to @code{toc} return the number of seconds since the timer was set.\n\ +For example,\n\ +\n\ +@example\n\ +@group\n\ +tic ();\n\ +# many computations later@dots{}\n\ +elapsed_time = toc ();\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +will set the variable @code{elapsed_time} to the number of seconds since\n\ +the most recent call to the function @code{tic}.\n\ +\n\ +If called with one output argument, @code{tic} returns a scalar\n\ +of type @code{uint64} that may be later passed to @code{toc}.\n\ +\n\ +@example\n\ +@group\n\ +id = tic; sleep (5); toc (id)\n\ + @result{} 5.0010\n\ +@end group\n\ +@end example\n\ +\n\ +Calling @code{tic} and @code{toc} this way allows nested timing calls.\n\ +\n\ +If you are more interested in the CPU time that your process used, you\n\ +should use the @code{cputime} function instead. The @code{tic} and\n\ +@code{toc} functions report the actual wall clock time that elapsed\n\ +between the calls. This may include time spent processing other jobs or\n\ +doing nothing at all.\n\ +@seealso{toc, cputime}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin != 0) + warning ("tic: ignoring extra arguments"); + + octave_time now; + + double tmp = now.double_value (); + + if (nargout > 0) + { + double ip = 0.0; + double frac = modf (tmp, &ip); + uint64_t microsecs = static_cast (CLOCKS_PER_SEC * frac); + microsecs += CLOCKS_PER_SEC * static_cast (ip); + retval = octave_uint64 (microsecs); + } + else + tic_toc_timestamp = tmp; + + return retval; +} + +DEFUN (toc, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} toc ()\n\ +@deftypefnx {Built-in Function} {} toc (@var{id})\n\ +@deftypefnx {Built-in Function} {@var{val} =} toc (@dots{})\n\ +@seealso{tic, cputime}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + double start_time = tic_toc_timestamp; + + if (nargin > 1) + print_usage (); + else + { + if (nargin == 1) + { + octave_uint64 id = args(0).uint64_scalar_value (); + + if (! error_state) + { + uint64_t val = id.value (); + + start_time + = (static_cast (val / CLOCKS_PER_SEC) + + static_cast (val % CLOCKS_PER_SEC) / CLOCKS_PER_SEC); + + // FIXME -- should we also check to see whether the start + // time is after the beginning of this Octave session? + } + else + error ("toc: invalid ID"); + } + + if (! error_state) + { + if (start_time < 0) + error ("toc called before timer set"); + else + { + octave_time now; + + double tmp = now.double_value () - start_time; + + if (nargout > 0) + retval = tmp; + else + octave_stdout << "Elapsed time is " << tmp << " seconds.\n"; + } + } + } + + return retval; +} + +/* +%!shared id +%! id = tic (); +%!assert (isa (id, "uint64")) +%!assert (isa (toc (id), "double")) +*/ + +DEFUN (cputime, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{total}, @var{user}, @var{system}] =} cputime ();\n\ +Return the CPU time used by your Octave session. The first output is\n\ +the total time spent executing your process and is equal to the sum of\n\ +second and third outputs, which are the number of CPU seconds spent\n\ +executing in user mode and the number of CPU seconds spent executing in\n\ +system mode, respectively. If your system does not have a way to report\n\ +CPU time usage, @code{cputime} returns 0 for each of its output values.\n\ +Note that because Octave used some CPU time to start, it is reasonable\n\ +to check to see if @code{cputime} works by checking to see if the total\n\ +CPU time used is nonzero.\n\ +@seealso{tic, toc}\n\ +@end deftypefn") +{ + octave_value_list retval; + int nargin = args.length (); + double usr = 0.0; + double sys = 0.0; + + if (nargin != 0) + warning ("tic: ignoring extra arguments"); + +#if defined (HAVE_GETRUSAGE) + + struct rusage ru; + + getrusage (RUSAGE_SELF, &ru); + + usr = static_cast (ru.ru_utime.tv_sec) + + static_cast (ru.ru_utime.tv_usec) * 1e-6; + + sys = static_cast (ru.ru_stime.tv_sec) + + static_cast (ru.ru_stime.tv_usec) * 1e-6; + +#else + + struct tms t; + + times (&t); + + unsigned long ticks; + unsigned long seconds; + unsigned long fraction; + + ticks = t.tms_utime + t.tms_cutime; + fraction = ticks % CLOCKS_PER_SEC; + seconds = ticks / CLOCKS_PER_SEC; + + usr = static_cast (seconds) + static_cast(fraction) / + static_cast(CLOCKS_PER_SEC); + + ticks = t.tms_stime + t.tms_cstime; + fraction = ticks % CLOCKS_PER_SEC; + seconds = ticks / CLOCKS_PER_SEC; + + sys = static_cast (seconds) + static_cast(fraction) / + static_cast(CLOCKS_PER_SEC); + +#endif + + retval(2) = sys; + retval(1) = usr; + retval(0) = sys + usr; + + return retval; +} + +DEFUN (sort, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{s}, @var{i}] =} sort (@var{x})\n\ +@deftypefnx {Built-in Function} {[@var{s}, @var{i}] =} sort (@var{x}, @var{dim})\n\ +@deftypefnx {Built-in Function} {[@var{s}, @var{i}] =} sort (@var{x}, @var{mode})\n\ +@deftypefnx {Built-in Function} {[@var{s}, @var{i}] =} sort (@var{x}, @var{dim}, @var{mode})\n\ +Return a copy of @var{x} with the elements arranged in increasing\n\ +order. For matrices, @code{sort} orders the elements within columns\n\ +\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +sort ([1, 2; 2, 3; 3, 1])\n\ + @result{} 1 1\n\ + 2 2\n\ + 3 3\n\ +@end group\n\ +@end example\n\ +\n\ +If the optional argument @var{dim} is given, then the matrix is sorted\n\ +along the dimension defined by @var{dim}. The optional argument @code{mode}\n\ +defines the order in which the values will be sorted. Valid values of\n\ +@code{mode} are \"ascend\" or \"descend\".\n\ +\n\ +The @code{sort} function may also be used to produce a matrix\n\ +containing the original row indices of the elements in the sorted\n\ +matrix. For example:\n\ +\n\ +@example\n\ +@group\n\ +[s, i] = sort ([1, 2; 2, 3; 3, 1])\n\ + @result{} s = 1 1\n\ + 2 2\n\ + 3 3\n\ + @result{} i = 1 3\n\ + 2 1\n\ + 3 2\n\ +@end group\n\ +@end example\n\ +\n\ +For equal elements, the indices are such that equal elements are listed\n\ +in the order in which they appeared in the original list.\n\ +\n\ +Sorting of complex entries is done first by magnitude (@code{abs (@var{z})})\n\ +and for any ties by phase angle (@code{angle (z)}). For example:\n\ +\n\ +@example\n\ +@group\n\ +sort ([1+i; 1; 1-i])\n\ + @result{} 1 + 0i\n\ + 1 - 1i\n\ + 1 + 1i\n\ +@end group\n\ +@end example\n\ +\n\ +NaN values are treated as being greater than any other value and are sorted\n\ +to the end of the list.\n\ +\n\ +The @code{sort} function may also be used to sort strings and cell arrays\n\ +of strings, in which case ASCII dictionary order (uppercase 'A' precedes\n\ +lowercase 'a') of the strings is used.\n\ +\n\ +The algorithm used in @code{sort} is optimized for the sorting of partially\n\ +ordered lists.\n\ +@seealso{sortrows, issorted}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + sortmode smode = ASCENDING; + + if (nargin < 1 || nargin > 3) + { + print_usage (); + return retval; + } + + bool return_idx = nargout > 1; + + octave_value arg = args(0); + + int dim = 0; + if (nargin > 1) + { + if (args(1).is_string ()) + { + std::string mode = args(1).string_value (); + if (mode == "ascend") + smode = ASCENDING; + else if (mode == "descend") + smode = DESCENDING; + else + { + error ("sort: MODE must be either \"ascend\" or \"descend\""); + return retval; + } + } + else + dim = args(1).nint_value () - 1; + } + + if (nargin > 2) + { + if (args(1).is_string ()) + { + print_usage (); + return retval; + } + + if (! args(2).is_string ()) + { + error ("sort: MODE must be a string"); + return retval; + } + std::string mode = args(2).string_value (); + if (mode == "ascend") + smode = ASCENDING; + else if (mode == "descend") + smode = DESCENDING; + else + { + error ("sort: MODE must be either \"ascend\" or \"descend\""); + return retval; + } + } + + const dim_vector dv = arg.dims (); + if (nargin == 1 || args(1).is_string ()) + { + // Find first non singleton dimension + dim = dv.first_non_singleton (); + } + else + { + if (dim < 0) + { + error ("sort: DIM must be a valid dimension"); + return retval; + } + } + + if (return_idx) + { + retval.resize (2); + + Array sidx; + + retval(0) = arg.sort (sidx, dim, smode); + retval(1) = idx_vector (sidx, dv(dim)); // No checking, the extent is known. + } + else + retval(0) = arg.sort (dim, smode); + + return retval; +} + +/* +## Double +%!assert (sort ([NaN, 1, -1, 2, Inf]), [-1, 1, 2, Inf, NaN]) +%!assert (sort ([NaN, 1, -1, 2, Inf], 1), [NaN, 1, -1, 2, Inf]) +%!assert (sort ([NaN, 1, -1, 2, Inf], 2), [-1, 1, 2, Inf, NaN]) +%!assert (sort ([NaN, 1, -1, 2, Inf], 3), [NaN, 1, -1, 2, Inf]) +%!assert (sort ([NaN, 1, -1, 2, Inf], "ascend"), [-1, 1, 2, Inf, NaN]) +%!assert (sort ([NaN, 1, -1, 2, Inf], 2, "ascend"), [-1, 1, 2, Inf, NaN]) +%!assert (sort ([NaN, 1, -1, 2, Inf], "descend"), [NaN, Inf, 2, 1, -1]) +%!assert (sort ([NaN, 1, -1, 2, Inf], 2, "descend"), [NaN, Inf, 2, 1, -1]) +%!assert (sort ([3, 1, 7, 5; 8, 2, 6, 4]), [3, 1, 6, 4; 8, 2, 7, 5]) +%!assert (sort ([3, 1, 7, 5; 8, 2, 6, 4], 1), [3, 1, 6, 4; 8, 2, 7, 5]) +%!assert (sort ([3, 1, 7, 5; 8, 2, 6, 4], 2), [1, 3, 5, 7; 2, 4, 6, 8]) +%!assert (sort (1), 1) + +%!test +%! [v, i] = sort ([NaN, 1, -1, Inf, 1]); +%! assert (v, [-1, 1, 1, Inf, NaN]); +%! assert (i, [3, 2, 5, 4, 1]); + +## Complex +%!assert (sort ([NaN, 1i, -1, 2, Inf]), [1i, -1, 2, Inf, NaN]) +%!assert (sort ([NaN, 1i, -1, 2, Inf], 1), [NaN, 1i, -1, 2, Inf]) +%!assert (sort ([NaN, 1i, -1, 2, Inf], 2), [1i, -1, 2, Inf, NaN]) +%!assert (sort ([NaN, 1i, -1, 2, Inf], 3), [NaN, 1i, -1, 2, Inf]) +%!assert (sort ([NaN, 1i, -1, 2, Inf], "ascend"), [1i, -1, 2, Inf, NaN]) +%!assert (sort ([NaN, 1i, -1, 2, Inf], 2, "ascend"), [1i, -1, 2, Inf, NaN]) +%!assert (sort ([NaN, 1i, -1, 2, Inf], "descend"), [NaN, Inf, 2, -1, 1i]) +%!assert (sort ([NaN, 1i, -1, 2, Inf], 2, "descend"), [NaN, Inf, 2, -1, 1i]) +%!assert (sort ([3, 1i, 7, 5; 8, 2, 6, 4]), [3, 1i, 6, 4; 8, 2, 7, 5]) +%!assert (sort ([3, 1i, 7, 5; 8, 2, 6, 4], 1), [3, 1i, 6, 4; 8, 2, 7, 5]) +%!assert (sort ([3, 1i, 7, 5; 8, 2, 6, 4], 2), [1i, 3, 5, 7; 2, 4, 6, 8]) +%!assert (sort (1i), 1i) + +%!test +%! [v, i] = sort ([NaN, 1i, -1, Inf, 1, 1i]); +%! assert (v, [1, 1i, 1i, -1, Inf, NaN]); +%! assert (i, [5, 2, 6, 3, 4, 1]); + +## Single +%!assert (sort (single ([NaN, 1, -1, 2, Inf])), single ([-1, 1, 2, Inf, NaN])) +%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 1), single ([NaN, 1, -1, 2, Inf])) +%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 2), single ([-1, 1, 2, Inf, NaN])) +%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 3), single ([NaN, 1, -1, 2, Inf])) +%!assert (sort (single ([NaN, 1, -1, 2, Inf]), "ascend"), single ([-1, 1, 2, Inf, NaN])) +%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 2, "ascend"), single ([-1, 1, 2, Inf, NaN])) +%!assert (sort (single ([NaN, 1, -1, 2, Inf]), "descend"), single ([NaN, Inf, 2, 1, -1])) +%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 2, "descend"), single ([NaN, Inf, 2, 1, -1])) +%!assert (sort (single ([3, 1, 7, 5; 8, 2, 6, 4])), single ([3, 1, 6, 4; 8, 2, 7, 5])) +%!assert (sort (single ([3, 1, 7, 5; 8, 2, 6, 4]), 1), single ([3, 1, 6, 4; 8, 2, 7, 5])) +%!assert (sort (single ([3, 1, 7, 5; 8, 2, 6, 4]), 2), single ([1, 3, 5, 7; 2, 4, 6, 8])) +%!assert (sort (single (1)), single (1)) + +%!test +%! [v, i] = sort (single ([NaN, 1, -1, Inf, 1])); +%! assert (v, single ([-1, 1, 1, Inf, NaN])); +%! assert (i, [3, 2, 5, 4, 1]); + +## Single Complex +%!assert (sort (single ([NaN, 1i, -1, 2, Inf])), single ([1i, -1, 2, Inf, NaN])) +%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 1), single ([NaN, 1i, -1, 2, Inf])) +%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 2), single ([1i, -1, 2, Inf, NaN])) +%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 3), single ([NaN, 1i, -1, 2, Inf])) +%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), "ascend"), single ([1i, -1, 2, Inf, NaN])) +%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 2, "ascend"), single ([1i, -1, 2, Inf, NaN])) +%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), "descend"), single ([NaN, Inf, 2, -1, 1i])) +%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 2, "descend"), single ([NaN, Inf, 2, -1, 1i])) +%!assert (sort (single ([3, 1i, 7, 5; 8, 2, 6, 4])), single ([3, 1i, 6, 4; 8, 2, 7, 5])) +%!assert (sort (single ([3, 1i, 7, 5; 8, 2, 6, 4]), 1), single ([3, 1i, 6, 4; 8, 2, 7, 5])) +%!assert (sort (single ([3, 1i, 7, 5; 8, 2, 6, 4]), 2), single ([1i, 3, 5, 7; 2, 4, 6, 8])) +%!assert (sort (single (1i)), single (1i)) + +%!test +%! [v, i] = sort (single ([NaN, 1i, -1, Inf, 1, 1i])); +%! assert (v, single ([1, 1i, 1i, -1, Inf, NaN])); +%! assert (i, [5, 2, 6, 3, 4, 1]); + +## Bool +%!assert (sort ([true, false, true, false]), [false, false, true, true]) +%!assert (sort ([true, false, true, false], 1), [true, false, true, false]) +%!assert (sort ([true, false, true, false], 2), [false, false, true, true]) +%!assert (sort ([true, false, true, false], 3), [true, false, true, false]) +%!assert (sort ([true, false, true, false], "ascend"), [false, false, true, true]) +%!assert (sort ([true, false, true, false], 2, "ascend"), [false, false, true, true]) +%!assert (sort ([true, false, true, false], "descend"), [true, true, false, false]) +%!assert (sort ([true, false, true, false], 2, "descend"), [true, true, false, false]) +%!assert (sort (true), true) + +%!test +%! [v, i] = sort ([true, false, true, false]); +%! assert (v, [false, false, true, true]); +%! assert (i, [2, 4, 1, 3]); + +## Sparse Double +%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf])), sparse ([-1, 0, 0, 1, 2, Inf, NaN])) +%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 1), sparse ([0, NaN, 1, 0, -1, 2, Inf])) +%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 2), sparse ([-1, 0, 0, 1, 2, Inf, NaN])) +%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 3), sparse ([0, NaN, 1, 0, -1, 2, Inf])) +%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), "ascend"), sparse ([-1, 0, 0, 1, 2, Inf, NaN])) +%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 2, "ascend"), sparse ([-1, 0, 0, 1, 2, Inf, NaN])) +%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), "descend"), sparse ([NaN, Inf, 2, 1, 0, 0, -1])) +%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 2, "descend"), sparse ([NaN, Inf, 2, 1, 0, 0, -1])) + +%!shared a +%! a = randn (10, 10); +%! a(a < 0) = 0; +%!assert (sort (sparse (a)), sparse (sort (a))) +%!assert (sort (sparse (a), 1), sparse (sort (a, 1))) +%!assert (sort (sparse (a), 2), sparse (sort (a, 2))) +%!test +%! [v, i] = sort (a); +%! [vs, is] = sort (sparse (a)); +%! assert (vs, sparse (v)); +%! assert (is, i); + +## Sparse Complex +%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf])), sparse ([0, 0, 1i, -1, 2, Inf, NaN])) +%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 1), sparse ([0, NaN, 1i, 0, -1, 2, Inf])) +%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 2), sparse ([0, 0, 1i, -1, 2, Inf, NaN])) +%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 3), sparse ([0, NaN, 1i, 0, -1, 2, Inf])) +%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), "ascend"), sparse ([0, 0, 1i, -1, 2, Inf, NaN])) +%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 2, "ascend"), sparse ([0, 0, 1i, -1, 2, Inf, NaN])) +%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), "descend"), sparse ([NaN, Inf, 2, -1, 1i, 0, 0])) +%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 2, "descend"), sparse ([NaN, Inf, 2, -1, 1i, 0, 0])) + +%!shared a +%! a = randn (10, 10); +%! a(a < 0) = 0; +%! a = 1i * a; +%!assert (sort (sparse (a)), sparse (sort (a))) +%!assert (sort (sparse (a), 1), sparse (sort (a, 1))) +%!assert (sort (sparse (a), 2), sparse (sort (a, 2))) +%!test +%! [v, i] = sort (a); +%! [vs, is] = sort (sparse (a)); +%! assert (vs, sparse (v)); +%! assert (is, i); + +## Sparse Bool +%!assert (sort (sparse ([true, false, true, false])), sparse ([false, false, true, true])) +%!assert (sort (sparse ([true, false, true, false]), 1), sparse ([true, false, true, false])) +%!assert (sort (sparse ([true, false, true, false]), 2), sparse ([false, false, true, true])) +%!assert (sort (sparse ([true, false, true, false]), 3), sparse ([true, false, true, false])) +%!assert (sort (sparse ([true, false, true, false]), "ascend"), sparse ([false, false, true, true])) +%!assert (sort (sparse ([true, false, true, false]), 2, "ascend"), sparse ([false, false, true, true])) +%!assert (sort (sparse ([true, false, true, false]), "descend"), sparse ([true, true, false, false])) +%!assert (sort (sparse ([true, false, true, false]), 2, "descend"), sparse ([true, true, false, false])) + +%!test +%! [v, i] = sort (sparse ([true, false, true, false])); +%! assert (v, sparse ([false, false, true, true])); +%! assert (i, [2, 4, 1, 3]); + +## Cell string array +%!shared a, b, c +%! a = {"Alice", "Cecile", "Eric", "Barry", "David"}; +%! b = {"Alice", "Barry", "Cecile", "David", "Eric"}; +%! c = {"Eric", "David", "Cecile", "Barry", "Alice"}; +%!assert (sort (a), b) +%!assert (sort (a, 1), a) +%!assert (sort (a, 2), b) +%!assert (sort (a, 3), a) +%!assert (sort (a, "ascend"), b) +%!assert (sort (a, 2, "ascend"), b) +%!assert (sort (a, "descend"), c) +%!assert (sort (a, 2, "descend"), c) + +%!test +%! [v, i] = sort (a); +%! assert (i, [1, 4, 2, 5, 3]); + +%!error sort () +%!error sort (1, 2, 3, 4) +*/ + +// Sort the rows of the matrix @var{a} according to the order +// specified by @var{mode}, which can either be 'ascend' or 'descend' +// and return the index vector corresponding to the sort order. +// +// This function does not yet support sparse matrices. + +DEFUN (__sort_rows_idx__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __sort_rows_idx__ (@var{a}, @var{mode})\n\ +Undocumented internal function.\n\ +@end deftypefn\n") +{ + octave_value retval; + + int nargin = args.length (); + sortmode smode = ASCENDING; + + if (nargin < 1 || nargin > 2 || (nargin == 2 && ! args(1).is_string ())) + { + print_usage (); + return retval; + } + + if (nargin > 1) + { + std::string mode = args(1).string_value (); + if (mode == "ascend") + smode = ASCENDING; + else if (mode == "descend") + smode = DESCENDING; + else + { + error ("__sort_rows_idx__: MODE must be either \"ascend\" or \"descend\""); + return retval; + } + } + + octave_value arg = args(0); + + if (arg.is_sparse_type ()) + error ("__sort_rows_idx__: sparse matrices not yet supported"); + if (arg.ndims () == 2) + { + Array idx = arg.sort_rows_idx (smode); + + retval = octave_value (idx, true, true); + } + else + error ("__sort_rows_idx__: needs a 2-dimensional object"); + + return retval; +} + +static sortmode +get_sort_mode_option (const octave_value& arg, const char *argn) +{ + // FIXME -- we initialize to UNSORTED here to avoid a GCC warning + // about possibly using sortmode uninitialized. + // FIXME -- shouldn't these modes be scoped inside a class? + sortmode smode = UNSORTED; + + std::string mode = arg.string_value (); + + if (error_state) + error ("issorted: expecting %s argument to be a character string", argn); + else if (mode == "ascending") + smode = ASCENDING; + else if (mode == "descending") + smode = DESCENDING; + else if (mode == "either") + smode = UNSORTED; + else + error ("issorted: MODE must be \"ascending\", \"descending\", or \"either\""); + + return smode; +} + +DEFUN (issorted, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} issorted (@var{a})\n\ +@deftypefnx {Built-in Function} {} issorted (@var{a}, @var{mode})\n\ +@deftypefnx {Built-in Function} {} issorted (@var{a}, \"rows\", @var{mode})\n\ +Return true if the array is sorted according to @var{mode}, which\n\ +may be either \"ascending\", \"descending\", or \"either\". By default,\n\ + @var{mode} is \"ascending\". NaNs are treated in the same manner as\n\ +@code{sort}.\n\ +\n\ +If the optional argument \"rows\" is supplied, check whether\n\ +the array is sorted by rows as output by the function @code{sortrows}\n\ +(with no options).\n\ +\n\ +This function does not support sparse matrices.\n\ +@seealso{sort, sortrows}\n\ +@end deftypefn\n") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin < 1 || nargin > 3) + { + print_usage (); + return retval; + } + + bool by_rows = false; + + sortmode smode = ASCENDING; + + if (nargin > 1) + { + octave_value mode_arg; + + if (nargin == 3) + smode = get_sort_mode_option (args(2), "third"); + + std::string tmp = args(1).string_value (); + + if (! error_state) + { + if (tmp == "rows") + by_rows = true; + else + smode = get_sort_mode_option (args(1), "second"); + } + else + error ("expecting second argument to be character string"); + + if (error_state) + return retval; + } + + octave_value arg = args(0); + + if (by_rows) + { + if (arg.is_sparse_type ()) + error ("issorted: sparse matrices not yet supported"); + if (arg.ndims () == 2) + retval = arg.is_sorted_rows (smode) != UNSORTED; + else + error ("issorted: A must be a 2-dimensional object"); + } + else + { + if (arg.dims ().is_vector ()) + retval = args(0).is_sorted (smode) != UNSORTED; + else + error ("issorted: needs a vector"); + } + + return retval; +} + +/* +%!shared sm, um, sv, uv +%! sm = [1, 2; 3, 4]; +%! um = [3, 1; 2, 4]; +%! sv = [1, 2, 3, 4]; +%! uv = [2, 1, 4, 3]; +%!assert (issorted (sm, "rows")) +%!assert (!issorted (um, "rows")) +%!assert (issorted (sv)) +%!assert (!issorted (uv)) +%!assert (issorted (sv')) +%!assert (!issorted (uv')) +%!assert (issorted (sm, "rows", "ascending")) +%!assert (!issorted (um, "rows", "ascending")) +%!assert (issorted (sv, "ascending")) +%!assert (!issorted (uv, "ascending")) +%!assert (issorted (sv', "ascending")) +%!assert (!issorted (uv', "ascending")) +%!assert (!issorted (sm, "rows", "descending")) +%!assert (issorted (flipud (sm), "rows", "descending")) +%!assert (!issorted (sv, "descending")) +%!assert (issorted (fliplr (sv), "descending")) +%!assert (!issorted (sv', "descending")) +%!assert (issorted (fliplr (sv)', "descending")) +%!assert (!issorted (um, "rows", "either")) +%!assert (!issorted (uv, "either")) +%!assert (issorted (sm, "rows", "either")) +%!assert (issorted (flipud (sm), "rows", "either")) +%!assert (issorted (sv, "either")) +%!assert (issorted (fliplr (sv), "either")) +%!assert (issorted (sv', "either")) +%!assert (issorted (fliplr (sv)', "either")) +*/ + +DEFUN (nth_element, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} nth_element (@var{x}, @var{n})\n\ +@deftypefnx {Built-in Function} {} nth_element (@var{x}, @var{n}, @var{dim})\n\ +Select the n-th smallest element of a vector, using the ordering defined by\n\ +@code{sort}. In other words, the result is equivalent to\n\ +@code{sort(@var{x})(@var{n})}.\n\ +@var{n} can also be a contiguous range, either ascending @code{l:u}\n\ +or descending @code{u:-1:l}, in which case a range of elements is returned.\n\ +If @var{x} is an array, @code{nth_element} operates along the dimension\n\ +defined by @var{dim}, or the first non-singleton dimension if @var{dim} is\n\ +not given.\n\ +\n\ +nth_element encapsulates the C++ standard library algorithms nth_element and\n\ +partial_sort. On average, the complexity of the operation is O(M*log(K)),\n\ +where @w{@code{M = size (@var{x}, @var{dim})}} and\n\ +@w{@code{K = length (@var{n})}}.\n\ +This function is intended for cases where the ratio K/M is small; otherwise,\n\ +it may be better to use @code{sort}.\n\ +@seealso{sort, min, max}\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + + if (nargin == 2 || nargin == 3) + { + octave_value argx = args(0); + + int dim = -1; + if (nargin == 3) + { + dim = args(2).int_value (true) - 1; + if (dim < 0) + error ("nth_element: DIM must be a valid dimension"); + } + if (dim < 0) + dim = argx.dims ().first_non_singleton (); + + idx_vector n = args(1).index_vector (); + + if (error_state) + return retval; + + switch (argx.builtin_type ()) + { + case btyp_double: + retval = argx.array_value ().nth_element (n, dim); + break; + case btyp_float: + retval = argx.float_array_value ().nth_element (n, dim); + break; + case btyp_complex: + retval = argx.complex_array_value ().nth_element (n, dim); + break; + case btyp_float_complex: + retval = argx.float_complex_array_value ().nth_element (n, dim); + break; +#define MAKE_INT_BRANCH(X) \ + case btyp_ ## X: \ + retval = argx.X ## _array_value ().nth_element (n, dim); \ + break + + MAKE_INT_BRANCH (int8); + MAKE_INT_BRANCH (int16); + MAKE_INT_BRANCH (int32); + MAKE_INT_BRANCH (int64); + MAKE_INT_BRANCH (uint8); + MAKE_INT_BRANCH (uint16); + MAKE_INT_BRANCH (uint32); + MAKE_INT_BRANCH (uint64); +#undef MAKE_INT_BRANCH + default: + if (argx.is_cellstr ()) + retval = argx.cellstr_value ().nth_element (n, dim); + else + gripe_wrong_type_arg ("nth_element", argx); + } + } + else + print_usage (); + + return retval; +} + +template +static NDT +do_accumarray_sum (const idx_vector& idx, const NDT& vals, + octave_idx_type n = -1) +{ + typedef typename NDT::element_type T; + if (n < 0) + n = idx.extent (0); + else if (idx.extent (n) > n) + error ("accumarray: index out of range"); + + NDT retval (dim_vector (n, 1), T ()); + + if (vals.numel () == 1) + retval.idx_add (idx, vals (0)); + else if (vals.numel () == idx.length (n)) + retval.idx_add (idx, vals); + else + error ("accumarray: dimensions mismatch"); + + return retval; +} + +DEFUN (__accumarray_sum__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __accumarray_sum__ (@var{idx}, @var{vals}, @var{n})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + if (nargin >= 2 && nargin <= 3 && args(0).is_numeric_type ()) + { + idx_vector idx = args(0).index_vector (); + octave_idx_type n = -1; + if (nargin == 3) + n = args(2).idx_type_value (true); + + if (! error_state) + { + octave_value vals = args(1); + if (vals.is_range ()) + { + Range r = vals.range_value (); + if (r.inc () == 0) + vals = r.base (); + } + + if (vals.is_single_type ()) + { + if (vals.is_complex_type ()) + retval = do_accumarray_sum (idx, vals.float_complex_array_value (), n); + else + retval = do_accumarray_sum (idx, vals.float_array_value (), n); + } + else if (vals.is_numeric_type () || vals.is_bool_type ()) + { + if (vals.is_complex_type ()) + retval = do_accumarray_sum (idx, vals.complex_array_value (), n); + else + retval = do_accumarray_sum (idx, vals.array_value (), n); + } + else + gripe_wrong_type_arg ("accumarray", vals); + } + } + else + print_usage (); + + return retval; +} + +template +static NDT +do_accumarray_minmax (const idx_vector& idx, const NDT& vals, + octave_idx_type n, bool ismin, + const typename NDT::element_type& zero_val) +{ + typedef typename NDT::element_type T; + if (n < 0) + n = idx.extent (0); + else if (idx.extent (n) > n) + error ("accumarray: index out of range"); + + NDT retval (dim_vector (n, 1), zero_val); + + // Pick minimizer or maximizer. + void (MArray::*op) (const idx_vector&, const MArray&) = + ismin ? (&MArray::idx_min) : (&MArray::idx_max); + + octave_idx_type l = idx.length (n); + if (vals.numel () == 1) + (retval.*op) (idx, NDT (dim_vector (l, 1), vals(0))); + else if (vals.numel () == l) + (retval.*op) (idx, vals); + else + error ("accumarray: dimensions mismatch"); + + return retval; +} + +static octave_value_list +do_accumarray_minmax_fun (const octave_value_list& args, + bool ismin) +{ + octave_value retval; + int nargin = args.length (); + if (nargin >= 3 && nargin <= 4 && args(0).is_numeric_type ()) + { + idx_vector idx = args(0).index_vector (); + octave_idx_type n = -1; + if (nargin == 4) + n = args(3).idx_type_value (true); + + if (! error_state) + { + octave_value vals = args(1), zero = args (2); + + switch (vals.builtin_type ()) + { + case btyp_double: + retval = do_accumarray_minmax (idx, vals.array_value (), n, ismin, + zero.double_value ()); + break; + case btyp_float: + retval = do_accumarray_minmax (idx, vals.float_array_value (), n, ismin, + zero.float_value ()); + break; + case btyp_complex: + retval = do_accumarray_minmax (idx, vals.complex_array_value (), n, ismin, + zero.complex_value ()); + break; + case btyp_float_complex: + retval = do_accumarray_minmax (idx, vals.float_complex_array_value (), n, ismin, + zero.float_complex_value ()); + break; +#define MAKE_INT_BRANCH(X) \ + case btyp_ ## X: \ + retval = do_accumarray_minmax (idx, vals.X ## _array_value (), n, ismin, \ + zero.X ## _scalar_value ()); \ + break + + MAKE_INT_BRANCH (int8); + MAKE_INT_BRANCH (int16); + MAKE_INT_BRANCH (int32); + MAKE_INT_BRANCH (int64); + MAKE_INT_BRANCH (uint8); + MAKE_INT_BRANCH (uint16); + MAKE_INT_BRANCH (uint32); + MAKE_INT_BRANCH (uint64); +#undef MAKE_INT_BRANCH + case btyp_bool: + retval = do_accumarray_minmax (idx, vals.array_value (), n, ismin, + zero.bool_value ()); + break; + default: + gripe_wrong_type_arg ("accumarray", vals); + } + } + } + else + print_usage (); + + return retval; +} + +DEFUN (__accumarray_min__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __accumarray_min__ (@var{idx}, @var{vals}, @var{zero}, @var{n})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + return do_accumarray_minmax_fun (args, true); +} + +DEFUN (__accumarray_max__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __accumarray_max__ (@var{idx}, @var{vals}, @var{zero}, @var{n})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + return do_accumarray_minmax_fun (args, false); +} + +template +static NDT +do_accumdim_sum (const idx_vector& idx, const NDT& vals, + int dim = -1, octave_idx_type n = -1) +{ + typedef typename NDT::element_type T; + if (n < 0) + n = idx.extent (0); + else if (idx.extent (n) > n) + error ("accumdim: index out of range"); + + dim_vector vals_dim = vals.dims (), rdv = vals_dim; + + if (dim < 0) + dim = vals.dims ().first_non_singleton (); + else if (dim >= rdv.length ()) + rdv.resize (dim+1, 1); + + rdv(dim) = n; + + NDT retval (rdv, T ()); + + if (idx.length () != vals_dim(dim)) + error ("accumdim: dimension mismatch"); + + retval.idx_add_nd (idx, vals, dim); + + return retval; +} + +DEFUN (__accumdim_sum__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __accumdim_sum__ (@var{idx}, @var{vals}, @var{dim}, @var{n})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + if (nargin >= 2 && nargin <= 4 && args(0).is_numeric_type ()) + { + idx_vector idx = args(0).index_vector (); + int dim = -1; + if (nargin >= 3) + dim = args(2).int_value () - 1; + + octave_idx_type n = -1; + if (nargin == 4) + n = args(3).idx_type_value (true); + + if (! error_state) + { + octave_value vals = args(1); + + if (vals.is_single_type ()) + { + if (vals.is_complex_type ()) + retval = do_accumdim_sum (idx, vals.float_complex_array_value (), dim, n); + else + retval = do_accumdim_sum (idx, vals.float_array_value (), dim, n); + } + else if (vals.is_numeric_type () || vals.is_bool_type ()) + { + if (vals.is_complex_type ()) + retval = do_accumdim_sum (idx, vals.complex_array_value (), dim, n); + else + retval = do_accumdim_sum (idx, vals.array_value (), dim, n); + } + else + gripe_wrong_type_arg ("accumdim", vals); + } + } + else + print_usage (); + + return retval; +} + +template +static NDT +do_merge (const Array& mask, + const NDT& tval, const NDT& fval) +{ + typedef typename NDT::element_type T; + dim_vector dv = mask.dims (); + NDT retval (dv); + + bool tscl = tval.numel () == 1, fscl = fval.numel () == 1; + + if ((! tscl && tval.dims () != dv) + || (! fscl && fval.dims () != dv)) + error ("merge: MASK, TVAL, and FVAL dimensions must match"); + else + { + T *rv = retval.fortran_vec (); + octave_idx_type n = retval.numel (); + + const T *tv = tval.data (), *fv = fval.data (); + const bool *mv = mask.data (); + + if (tscl) + { + if (fscl) + { + T ts = tv[0], fs = fv[0]; + for (octave_idx_type i = 0; i < n; i++) + rv[i] = mv[i] ? ts : fs; + } + else + { + T ts = tv[0]; + for (octave_idx_type i = 0; i < n; i++) + rv[i] = mv[i] ? ts : fv[i]; + } + } + else + { + if (fscl) + { + T fs = fv[0]; + for (octave_idx_type i = 0; i < n; i++) + rv[i] = mv[i] ? tv[i] : fs; + } + else + { + for (octave_idx_type i = 0; i < n; i++) + rv[i] = mv[i] ? tv[i] : fv[i]; + } + } + } + + return retval; +} + +#define MAKE_INT_BRANCH(INTX) \ + else if (tval.is_ ## INTX ## _type () && fval.is_ ## INTX ## _type ()) \ + { \ + retval = do_merge (mask, \ + tval.INTX ## _array_value (), \ + fval.INTX ## _array_value ()); \ + } + +DEFUN (merge, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} merge (@var{mask}, @var{tval}, @var{fval})\n\ +@deftypefnx {Built-in Function} {} ifelse (@var{mask}, @var{tval}, @var{fval})\n\ +Merge elements of @var{true_val} and @var{false_val}, depending on the\n\ +value of @var{mask}. If @var{mask} is a logical scalar, the other two\n\ +arguments can be arbitrary values. Otherwise, @var{mask} must be a logical\n\ +array, and @var{tval}, @var{fval} should be arrays of matching class, or\n\ +cell arrays. In the scalar mask case, @var{tval} is returned if @var{mask}\n\ +is true, otherwise @var{fval} is returned.\n\ +\n\ +In the array mask case, both @var{tval} and @var{fval} must be either\n\ +scalars or arrays with dimensions equal to @var{mask}. The result is\n\ +constructed as follows:\n\ +\n\ +@example\n\ +@group\n\ +result(mask) = tval(mask);\n\ +result(! mask) = fval(! mask);\n\ +@end group\n\ +@end example\n\ +\n\ +@var{mask} can also be arbitrary numeric type, in which case\n\ +it is first converted to logical.\n\ +@seealso{logical, diff}\n\ +@end deftypefn") +{ + int nargin = args.length (); + octave_value retval; + + if (nargin == 3 && (args(0).is_bool_type () || args(0).is_numeric_type ())) + { + octave_value mask_val = args(0); + + if (mask_val.is_scalar_type ()) + retval = mask_val.is_true () ? args(1) : args(2); + else + { + boolNDArray mask = mask_val.bool_array_value (); + octave_value tval = args(1), fval = args(2); + if (tval.is_double_type () && fval.is_double_type ()) + { + if (tval.is_complex_type () || fval.is_complex_type ()) + retval = do_merge (mask, + tval.complex_array_value (), + fval.complex_array_value ()); + else + retval = do_merge (mask, + tval.array_value (), + fval.array_value ()); + } + else if (tval.is_single_type () && fval.is_single_type ()) + { + if (tval.is_complex_type () || fval.is_complex_type ()) + retval = do_merge (mask, + tval.float_complex_array_value (), + fval.float_complex_array_value ()); + else + retval = do_merge (mask, + tval.float_array_value (), + fval.float_array_value ()); + } + else if (tval.is_string () && fval.is_string ()) + { + bool sq_string = tval.is_sq_string () || fval.is_sq_string (); + retval = octave_value (do_merge (mask, + tval.char_array_value (), + fval.char_array_value ()), + sq_string ? '\'' : '"'); + } + else if (tval.is_cell () && fval.is_cell ()) + { + retval = do_merge (mask, + tval.cell_value (), + fval.cell_value ()); + } + + MAKE_INT_BRANCH (int8) + MAKE_INT_BRANCH (int16) + MAKE_INT_BRANCH (int32) + MAKE_INT_BRANCH (int64) + MAKE_INT_BRANCH (uint8) + MAKE_INT_BRANCH (uint16) + MAKE_INT_BRANCH (uint32) + MAKE_INT_BRANCH (uint64) + + else + error ("merge: cannot merge %s with %s with array mask", + tval.class_name ().c_str (), + fval.class_name ().c_str ()); + } + } + else + print_usage (); + + return retval; +} + +DEFALIAS (ifelse, merge); + +#undef MAKE_INT_BRANCH + +template +static SparseT +do_sparse_diff (const SparseT& array, octave_idx_type order, + int dim) +{ + SparseT retval = array; + if (dim == 1) + { + octave_idx_type k = retval.columns (); + while (order > 0 && k > 0) + { + idx_vector col1 (':'), col2 (':'), sl1 (1, k), sl2 (0, k-1); + retval = SparseT (retval.index (col1, sl1)) - SparseT (retval.index (col2, sl2)); + assert (retval.columns () == k-1); + order--; + k--; + } + } + else + { + octave_idx_type k = retval.rows (); + while (order > 0 && k > 0) + { + idx_vector col1 (':'), col2 (':'), sl1 (1, k), sl2 (0, k-1); + retval = SparseT (retval.index (sl1, col1)) - SparseT (retval.index (sl2, col2)); + assert (retval.rows () == k-1); + order--; + k--; + } + } + + return retval; +} + +static octave_value +do_diff (const octave_value& array, octave_idx_type order, + int dim = -1) +{ + octave_value retval; + + const dim_vector& dv = array.dims (); + if (dim == -1) + { + dim = array.dims ().first_non_singleton (); + + // Bother Matlab. This behavior is really wicked. + if (dv(dim) <= order) + { + if (dv(dim) == 1) + retval = array.resize (dim_vector (0, 0)); + else + { + retval = array; + while (order > 0) + { + if (dim == dv.length ()) + { + retval = do_diff (array, order, dim - 1); + order = 0; + } + else if (dv(dim) == 1) + dim++; + else + { + retval = do_diff (array, dv(dim) - 1, dim); + order -= dv(dim) - 1; + dim++; + } + } + } + + return retval; + } + } + + if (array.is_integer_type ()) + { + if (array.is_int8_type ()) + retval = array.int8_array_value ().diff (order, dim); + else if (array.is_int16_type ()) + retval = array.int16_array_value ().diff (order, dim); + else if (array.is_int32_type ()) + retval = array.int32_array_value ().diff (order, dim); + else if (array.is_int64_type ()) + retval = array.int64_array_value ().diff (order, dim); + else if (array.is_uint8_type ()) + retval = array.uint8_array_value ().diff (order, dim); + else if (array.is_uint16_type ()) + retval = array.uint16_array_value ().diff (order, dim); + else if (array.is_uint32_type ()) + retval = array.uint32_array_value ().diff (order, dim); + else if (array.is_uint64_type ()) + retval = array.uint64_array_value ().diff (order, dim); + else + panic_impossible (); + } + else if (array.is_sparse_type ()) + { + if (array.is_complex_type ()) + retval = do_sparse_diff (array.sparse_complex_matrix_value (), order, dim); + else + retval = do_sparse_diff (array.sparse_matrix_value (), order, dim); + } + else if (array.is_single_type ()) + { + if (array.is_complex_type ()) + retval = array.float_complex_array_value ().diff (order, dim); + else + retval = array.float_array_value ().diff (order, dim); + } + else + { + if (array.is_complex_type ()) + retval = array.complex_array_value ().diff (order, dim); + else + retval = array.array_value ().diff (order, dim); + } + + return retval; +} + +DEFUN (diff, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} diff (@var{x})\n\ +@deftypefnx {Built-in Function} {} diff (@var{x}, @var{k})\n\ +@deftypefnx {Built-in Function} {} diff (@var{x}, @var{k}, @var{dim})\n\ +If @var{x} is a vector of length @math{n}, @code{diff (@var{x})} is the\n\ +vector of first differences\n\ +@tex\n\ + $x_2 - x_1, \\ldots{}, x_n - x_{n-1}$.\n\ +@end tex\n\ +@ifnottex\n\ + @var{x}(2) - @var{x}(1), @dots{}, @var{x}(n) - @var{x}(n-1).\n\ +@end ifnottex\n\ +\n\ +If @var{x} is a matrix, @code{diff (@var{x})} is the matrix of column\n\ +differences along the first non-singleton dimension.\n\ +\n\ +The second argument is optional. If supplied, @code{diff (@var{x},\n\ +@var{k})}, where @var{k} is a non-negative integer, returns the\n\ +@var{k}-th differences. It is possible that @var{k} is larger than\n\ +the first non-singleton dimension of the matrix. In this case,\n\ +@code{diff} continues to take the differences along the next\n\ +non-singleton dimension.\n\ +\n\ +The dimension along which to take the difference can be explicitly\n\ +stated with the optional variable @var{dim}. In this case the\n\ +@var{k}-th order differences are calculated along this dimension.\n\ +In the case where @var{k} exceeds @code{size (@var{x}, @var{dim})}\n\ +an empty matrix is returned.\n\ +@seealso{sort, merge}\n\ +@end deftypefn") +{ + int nargin = args.length (); + octave_value retval; + + if (nargin < 1 || nargin > 3) + print_usage (); + else if (! (args(0).is_numeric_type () || args(0).is_bool_type ())) + error ("diff: X must be numeric or logical"); + + if (! error_state) + { + int dim = -1; + octave_idx_type order = 1; + if (nargin > 1) + { + if (args(1).is_scalar_type ()) + order = args(1).idx_type_value (true, false); + else if (! args(1).is_zero_by_zero ()) + error ("order K must be a scalar or []"); + if (! error_state && order < 0) + error ("order K must be non-negative"); + } + + if (nargin > 2) + { + dim = args(2).int_value (true, false); + if (! error_state && (dim < 1 || dim > args(0).ndims ())) + error ("DIM must be a valid dimension"); + else + dim -= 1; + } + + if (! error_state) + retval = do_diff (args(0), order, dim); + } + + return retval; +} + +/* +%!assert (diff ([1, 2, 3, 4]), [1, 1, 1]) +%!assert (diff ([1, 3, 7, 19], 2), [2, 8]) +%!assert (diff ([1, 2; 5, 4; 8, 7; 9, 6; 3, 1]), [4, 2; 3, 3; 1, -1; -6, -5]) +%!assert (diff ([1, 2; 5, 4; 8, 7; 9, 6; 3, 1], 3), [-1, -5; -5, 0]) +%!assert (isempty (diff (1))) + +%!error diff () +%!error diff (1, 2, 3, 4) +%!error diff ("foo") +%!error diff ([1, 2; 3, 4], -1) +*/ + +template +static Array +do_repelems (const Array& src, const Array& rep) +{ + Array retval; + + assert (rep.ndims () == 2 && rep.rows () == 2); + + octave_idx_type n = rep.columns (), l = 0; + for (octave_idx_type i = 0; i < n; i++) + { + octave_idx_type k = rep(1, i); + if (k < 0) + { + error ("repelems: second row must contain non-negative numbers"); + return retval; + } + + l += k; + } + + retval.clear (1, l); + T *dest = retval.fortran_vec (); + l = 0; + for (octave_idx_type i = 0; i < n; i++) + { + octave_idx_type k = rep(1, i); + std::fill_n (dest, k, src.checkelem (rep(0, i) - 1)); + dest += k; + } + + return retval; +} + +DEFUN (repelems, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} repelems (@var{x}, @var{r})\n\ +Construct a vector of repeated elements from @var{x}. @var{r}\n\ +is a 2x@var{N} integer matrix specifying which elements to repeat and\n\ +how often to repeat each element.\n\ +\n\ +Entries in the first row, @var{r}(1,j), select an element to repeat.\n\ +The corresponding entry in the second row, @var{r}(2,j), specifies\n\ +the repeat count. If @var{x} is a matrix then the columns of @var{x} are\n\ +imagined to be stacked on top of each other for purposes of the selection\n\ +index. A row vector is always returned.\n\ +\n\ +Conceptually the result is calculated as follows:\n\ +\n\ +@example\n\ +@group\n\ +y = [];\n\ +for i = 1:columns (@var{r})\n\ + y = [y, @var{x}(@var{r}(1,i)*ones(1, @var{r}(2,i)))];\n\ +endfor\n\ +@end group\n\ +@end example\n\ +@seealso{repmat, cat}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 2) + { + octave_value x = args(0); + + const Matrix rm = args(1).matrix_value (); + if (error_state) + return retval; + else if (rm.rows () != 2 || rm.ndims () != 2) + { + error ("repelems: R must be a matrix with two rows"); + return retval; + } + else + { + NoAlias< Array > r (rm.dims ()); + + for (octave_idx_type i = 0; i < rm.numel (); i++) + { + octave_idx_type rx = rm(i); + if (static_cast (rx) != rm(i)) + { + error ("repelems: R must be a matrix of integers"); + return retval; + } + + r(i) = rx; + } + + switch (x.builtin_type ()) + { +#define BTYP_BRANCH(X, EX) \ + case btyp_ ## X: \ + retval = do_repelems (x.EX ## _value (), r); \ + break + + BTYP_BRANCH (double, array); + BTYP_BRANCH (float, float_array); + BTYP_BRANCH (complex, complex_array); + BTYP_BRANCH (float_complex, float_complex_array); + BTYP_BRANCH (bool, bool_array); + BTYP_BRANCH (char, char_array); + + BTYP_BRANCH (int8, int8_array); + BTYP_BRANCH (int16, int16_array); + BTYP_BRANCH (int32, int32_array); + BTYP_BRANCH (int64, int64_array); + BTYP_BRANCH (uint8, uint8_array); + BTYP_BRANCH (uint16, uint16_array); + BTYP_BRANCH (uint32, uint32_array); + BTYP_BRANCH (uint64, uint64_array); + + BTYP_BRANCH (cell, cell); + //BTYP_BRANCH (struct, map);//FIXME +#undef BTYP_BRANCH + + default: + gripe_wrong_type_arg ("repelems", x); + } + } + } + else + print_usage (); + + return retval; +} + +DEFUN (base64_encode, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{s} =} base64_encode (@var{x})\n\ +Encode a double matrix or array @var{x} into the base64 format string\n\ +@var{s}.\n\ +\n\ +@seealso{base64_decode}\n\ +@end deftypefn") +{ + octave_value_list retval; + int nargin = args.length (); + + if (nargin != 1) + print_usage (); + else + { + if (! args(0).is_numeric_type ()) + error ("base64_encode: encoding is supported only for numeric arrays"); + else if (args(0).is_complex_type () + || args(0).is_sparse_type ()) + error ("base64_encode: encoding complex or sparse data is not supported"); + else if (args(0).is_integer_type ()) + { +#define MAKE_INT_BRANCH(X) \ + if (args(0).is_ ## X ## _type ()) \ + { \ + const X##NDArray in = args(0). X## _array_value (); \ + size_t inlen = \ + in.numel () * sizeof (X## _t) / sizeof (char); \ + const char* inc = \ + reinterpret_cast (in.data ()); \ + char* out; \ + if (! error_state \ + && octave_base64_encode (inc, inlen, &out)) \ + retval(0) = octave_value (out); \ + } + + MAKE_INT_BRANCH(int8) + else MAKE_INT_BRANCH(int16) + else MAKE_INT_BRANCH(int32) + else MAKE_INT_BRANCH(int64) + else MAKE_INT_BRANCH(uint8) + else MAKE_INT_BRANCH(uint16) + else MAKE_INT_BRANCH(uint32) + else MAKE_INT_BRANCH(uint64) +#undef MAKE_INT_BRANCH + + else + panic_impossible (); + } + else if (args(0).is_single_type ()) + { + const Array in = args(0).float_array_value (); + size_t inlen; + inlen = in.numel () * sizeof (float) / sizeof (char); + const char* inc; + inc = reinterpret_cast (in.data ()); + char* out; + if (! error_state + && octave_base64_encode (inc, inlen, &out)) + retval(0) = octave_value (out); + } + else + { + const Array in = args(0).array_value (); + size_t inlen; + inlen = in.numel () * sizeof (double) / sizeof (char); + const char* inc; + inc = reinterpret_cast (in.data ()); + char* out; + if (! error_state + && octave_base64_encode (inc, inlen, &out)) + retval(0) = octave_value (out); + } + } + return retval; +} + +/* +%!assert (base64_encode (single (pi)), "2w9JQA==") +%!assert (base64_encode (uint8 ([0 0 0])), "AAAA") +%!assert (base64_encode (uint16 ([0 0 0])), "AAAAAAAA") +%!assert (base64_encode (uint32 ([0 0 0])), "AAAAAAAAAAAAAAAA") +%!assert (base64_encode (uint64 ([0 0 0])), "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA") +%!assert (base64_encode (uint8 ([255 255 255])), "////") + +%!error base64_encode () +%!error base64_encode (1,2) +%!error base64_encode ("A string") +%!error base64_encode ({"A cell array"}) +%!error base64_encode (struct ()) +*/ + +DEFUN (base64_decode, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{x} =} base64_decode (@var{s})\n\ +@deftypefnx {Built-in Function} {@var{x} =} base64_decode (@var{s}, @var{dims})\n\ +Decode the double matrix or array @var{x} from the base64 encoded string\n\ +@var{s}. The optional input parameter @var{dims} should be a vector\n\ +containing the dimensions of the decoded array.\n\ +@seealso{base64_encode}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin < 1 || nargin > 2) + print_usage (); + else + { + dim_vector dims; + + if (nargin > 1) + { + const Array size = + args(1).octave_idx_type_vector_value (); + + if (! error_state) + { + dims = dim_vector::alloc (size.length ()); + for (octave_idx_type i = 0; i < size.length (); i++) + dims(i) = size(i); + } + } + + const std::string str = args(0).string_value (); + + if (! error_state) + { + Array res = octave_base64_decode (str); + + if (nargin > 1) + res = res.reshape (dims); + + retval = res; + } + } + + return retval; +} + +/* +%!assert (base64_decode (base64_encode (pi)), pi) +%! +%!test +%! in = randn (10); +%! outv = base64_decode (base64_encode (in)); +%! outm = base64_decode (base64_encode (in), size (in)); +%! assert (outv, in(:).'); +%! assert (outm, in); + +%!error base64_decode () +%!error base64_decode (1,2,3) +%!error base64_decode (1, "this is not a valid set of dimensions") +%!error base64_decode (1) +%!error base64_decode ("AQ=") +%!error base64_decode ("AQ==") +*/ diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/data.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/data.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,34 @@ +/* + +Copyright (C) 2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_data_h) +#define octave_data_h 1 + +#include + +class octave_value; +class octave_value_list; + +extern OCTINTERP_API octave_value +do_class_concat (const octave_value_list& ovl, std::string cattype, int dim); + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/debug.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/debug.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,1458 @@ +/* + +Copyright (C) 2001-2012 Ben Sapp +Copyright (C) 2007-2009 John Swensen + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include +#include +#include +#include + +#include "file-stat.h" +#include "singleton-cleanup.h" + +#include "defun.h" +#include "error.h" +#include "help.h" +#include "input.h" +#include "pager.h" +#include "octave-link.h" +#include "oct-obj.h" +#include "utils.h" +#include "parse.h" +#include "symtab.h" +#include "gripes.h" +#include "ov.h" +#include "ov-usr-fcn.h" +#include "ov-fcn.h" +#include "ov-struct.h" +#include "pt-pr-code.h" +#include "pt-bp.h" +#include "pt-eval.h" +#include "pt-stmt.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "variables.h" + +#include "debug.h" + +// Initialize the singleton object +bp_table *bp_table::instance = 0; + +static std::string +snarf_file (const std::string& fname) +{ + std::string retval; + + file_stat fs (fname); + + if (fs) + { + size_t sz = fs.size (); + + std::ifstream file (fname.c_str (), std::ios::in|std::ios::binary); + + if (file) + { + std::string buf (sz+1, 0); + + file.read (&buf[0], sz+1); + + if (file.eof ()) + { + // Expected to read the entire file. + + retval = buf; + } + else + error ("error reading file %s", fname.c_str ()); + } + } + + return retval; +} + +static std::deque +get_line_offsets (const std::string& buf) +{ + // This could maybe be smarter. Is deque the right thing to use + // here? + + std::deque offsets; + + offsets.push_back (0); + + size_t len = buf.length (); + + for (size_t i = 0; i < len; i++) + { + char c = buf[i]; + + if (c == '\r' && ++i < len) + { + c = buf[i]; + + if (c == '\n') + offsets.push_back (i+1); + else + offsets.push_back (i); + } + else if (c == '\n') + offsets.push_back (i+1); + } + + offsets.push_back (len); + + return offsets; +} + +std::string +get_file_line (const std::string& fname, size_t line) +{ + std::string retval; + + static std::string last_fname; + + static std::string buf; + + static std::deque offsets; + + if (fname != last_fname) + { + buf = snarf_file (fname); + + offsets = get_line_offsets (buf); + } + + if (line > 0) + line--; + + if (line < offsets.size () - 1) + { + size_t bol = offsets[line]; + size_t eol = offsets[line+1]; + + while (eol > 0 && eol > bol && (buf[eol-1] == '\n' || buf[eol-1] == '\r')) + eol--; + + retval = buf.substr (bol, eol - bol); + } + + return retval; +} + +// Return a pointer to the user-defined function FNAME. If FNAME is +// empty, search backward for the first user-defined function in the +// current call stack. + +static octave_user_code * +get_user_code (const std::string& fname = std::string ()) +{ + octave_user_code *dbg_fcn = 0; + + if (fname.empty ()) + dbg_fcn = octave_call_stack::caller_user_code (); + else + { + octave_value fcn = symbol_table::find_function (fname); + + if (fcn.is_defined () && fcn.is_user_code ()) + dbg_fcn = fcn.user_code_value (); + } + + return dbg_fcn; +} + +static void +parse_dbfunction_params (const char *who, const octave_value_list& args, + std::string& symbol_name, bp_table::intmap& lines) +{ + int nargin = args.length (); + int idx = 0; + int list_idx = 0; + symbol_name = std::string (); + lines = bp_table::intmap (); + + if (args.length () == 0) + return; + + // If we are already in a debugging function. + if (octave_call_stack::caller_user_code ()) + { + idx = 0; + symbol_name = get_user_code ()->name (); + } + else if (args(0).is_map ()) + { + // Problem because parse_dbfunction_params() can only pass out a + // single function + } + else if (args(0).is_string ()) + { + symbol_name = args(0).string_value (); + if (error_state) + return; + idx = 1; + } + else + error ("%s: invalid parameter specified", who); + + for (int i = idx; i < nargin; i++ ) + { + if (args(i).is_string ()) + { + int line = atoi (args(i).string_value ().c_str ()); + if (error_state) + break; + lines[list_idx++] = line; + } + else if (args(i).is_map ()) + octave_stdout << who << ": accepting a struct" << std::endl; + else + { + const NDArray arg = args(i).array_value (); + + if (error_state) + break; + + for (octave_idx_type j = 0; j < arg.nelem (); j++) + { + int line = static_cast (arg.elem (j)); + if (error_state) + break; + lines[list_idx++] = line; + } + + if (error_state) + break; + } + } +} + +bool +bp_table::instance_ok (void) +{ + bool retval = true; + + if (! instance) + { + instance = new bp_table (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } + + if (! instance) + { + ::error ("unable to create breakpoint table!"); + retval = false; + } + + return retval; +} + +bool +bp_table::do_add_breakpoint_1 (octave_user_code *fcn, + const std::string& fname, + const bp_table::intmap& line, + bp_table::intmap& retval) +{ + bool found = false; + + tree_statement_list *cmds = fcn->body (); + + std::string file = fcn->fcn_file_name (); + + if (cmds) + { + retval = cmds->add_breakpoint (file, line); + + for (intmap_iterator p = retval.begin (); p != retval.end (); p++) + { + if (p->second != 0) + { + bp_set.insert (fname); + found = true; + break; + } + } + } + + return found; +} + +bp_table::intmap +bp_table::do_add_breakpoint (const std::string& fname, + const bp_table::intmap& line) +{ + intmap retval; + + octave_user_code *dbg_fcn = get_user_code (fname); + + if (dbg_fcn) + { + if (! do_add_breakpoint_1 (dbg_fcn, fname, line, retval)) + { + // Search subfunctions in the order they appear in the file. + + const std::list subfcn_names + = dbg_fcn->subfunction_names (); + + std::map subfcns + = dbg_fcn->subfunctions (); + + for (std::list::const_iterator p = subfcn_names.begin (); + p != subfcn_names.end (); p++) + { + std::map::const_iterator + q = subfcns.find (*p); + + if (q != subfcns.end ()) + { + octave_user_code *dbg_subfcn = q->second.user_code_value (); + + if (do_add_breakpoint_1 (dbg_subfcn, fname, line, retval)) + break; + } + } + } + } + else + error ("add_breakpoint: unable to find the requested function\n"); + + tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; + + return retval; +} + + +int +bp_table::do_remove_breakpoint_1 (octave_user_code *fcn, + const std::string& fname, + const bp_table::intmap& line) +{ + int retval = 0; + + std::string file = fcn->fcn_file_name (); + + tree_statement_list *cmds = fcn->body (); + + // FIXME -- move the operation on cmds to the + // tree_statement_list class? + + if (cmds) + { + octave_value_list results = cmds->list_breakpoints (); + + if (results.length () > 0) + { + octave_idx_type len = line.size (); + + for (int i = 0; i < len; i++) + { + const_intmap_iterator p = line.find (i); + + if (p != line.end ()) + { + int lineno = p->second; + + cmds->delete_breakpoint (lineno); + + if (! file.empty ()) + octave_link::update_breakpoint (false, file, lineno); + } + } + + results = cmds->list_breakpoints (); + + bp_set_iterator it = bp_set.find (fname); + if (results.length () == 0 && it != bp_set.end ()) + bp_set.erase (it); + } + + retval = results.length (); + } + + return retval; +} + +int +bp_table::do_remove_breakpoint (const std::string& fname, + const bp_table::intmap& line) +{ + int retval = 0; + + octave_idx_type len = line.size (); + + if (len == 0) + { + intmap results = remove_all_breakpoints_in_file (fname); + retval = results.size (); + } + else + { + octave_user_code *dbg_fcn = get_user_code (fname); + + if (dbg_fcn) + { + retval = do_remove_breakpoint_1 (dbg_fcn, fname, line); + + // Search subfunctions in the order they appear in the file. + + const std::list subfcn_names + = dbg_fcn->subfunction_names (); + + std::map subfcns + = dbg_fcn->subfunctions (); + + for (std::list::const_iterator p = subfcn_names.begin (); + p != subfcn_names.end (); p++) + { + std::map::const_iterator + q = subfcns.find (*p); + + if (q != subfcns.end ()) + { + octave_user_code *dbg_subfcn = q->second.user_code_value (); + + retval += do_remove_breakpoint_1 (dbg_subfcn, fname, line); + } + } + } + else + error ("remove_breakpoint: unable to find the requested function\n"); + } + + tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; + + return retval; +} + +bp_table::intmap +bp_table::do_remove_all_breakpoints_in_file_1 (octave_user_code *fcn, + const std::string& fname) +{ + intmap retval; + + std::string file = fcn->fcn_file_name (); + + tree_statement_list *cmds = fcn->body (); + + if (cmds) + { + retval = cmds->remove_all_breakpoints (file); + + bp_set_iterator it = bp_set.find (fname); + if (it != bp_set.end ()) + bp_set.erase (it); + } + + return retval; +} + +bp_table::intmap +bp_table::do_remove_all_breakpoints_in_file (const std::string& fname, + bool silent) +{ + intmap retval; + + octave_user_code *dbg_fcn = get_user_code (fname); + + if (dbg_fcn) + { + retval = do_remove_all_breakpoints_in_file_1 (dbg_fcn, fname); + + // Order is not important here. + + typedef std::map::const_iterator + subfcns_const_iterator; + + std::map subfcns = dbg_fcn->subfunctions (); + + for (subfcns_const_iterator p = subfcns.begin (); + p != subfcns.end (); p++) + { + octave_user_code *dbg_subfcn = p->second.user_code_value (); + + intmap tmp = do_remove_all_breakpoints_in_file_1 (dbg_subfcn, fname); + + // Merge new list with retval. + retval.insert (tmp.begin (), tmp.end ()); + } + } + else if (! silent) + error ("remove_all_breakpoint_in_file: " + "unable to find the requested function\n"); + + tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; + + return retval; +} + +void +bp_table::do_remove_all_breakpoints (void) +{ + for (const_bp_set_iterator it = bp_set.begin (); it != bp_set.end (); it++) + remove_all_breakpoints_in_file (*it); + + + tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; +} + +std::string +do_find_bkpt_list (octave_value_list slist, + std::string match) +{ + std::string retval; + + for (int i = 0; i < slist.length (); i++) + { + if (slist (i).string_value () == match) + { + retval = slist(i).string_value (); + break; + } + } + + return retval; +} + + +bp_table::fname_line_map +bp_table::do_get_breakpoint_list (const octave_value_list& fname_list) +{ + fname_line_map retval; + + for (bp_set_iterator it = bp_set.begin (); it != bp_set.end (); it++) + { + if (fname_list.length () == 0 + || do_find_bkpt_list (fname_list, *it) != "") + { + octave_user_code *f = get_user_code (*it); + + if (f) + { + tree_statement_list *cmds = f->body (); + + // FIXME -- move the operation on cmds to the + // tree_statement_list class? + if (cmds) + { + octave_value_list bkpts = cmds->list_breakpoints (); + octave_idx_type len = bkpts.length (); + + if (len > 0) + { + bp_table::intmap bkpts_vec; + + for (int i = 0; i < len; i++) + bkpts_vec[i] = bkpts (i).double_value (); + + std::string symbol_name = f->name (); + + retval[symbol_name] = bkpts_vec; + } + } + } + } + } + + return retval; +} + +static octave_value +intmap_to_ov (const bp_table::intmap& line) +{ + int idx = 0; + + NDArray retval (dim_vector (1, line.size ())); + + for (size_t i = 0; i < line.size (); i++) + { + bp_table::const_intmap_iterator p = line.find (i); + + if (p != line.end ()) + { + int lineno = p->second; + retval(idx++) = lineno; + } + } + + retval.resize (dim_vector (1, idx)); + + return retval; +} + +DEFUN (dbstop, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{rline} =} dbstop (\"@var{func}\")\n\ +@deftypefnx {Built-in Function} {@var{rline} =} dbstop (\"@var{func}\", @var{line})\n\ +@deftypefnx {Built-in Function} {@var{rline} =} dbstop (\"@var{func}\", @var{line1}, @var{line2}, @dots{})\n\ +Set a breakpoint in function @var{func}.\n\ +\n\ +Arguments are\n\ +\n\ +@table @var\n\ +@item func\n\ +Function name as a string variable. When already in debug\n\ +mode this should be left out and only the line should be given.\n\ +\n\ +@item line\n\ +Line number where the breakpoint should be set. Multiple\n\ +lines may be given as separate arguments or as a vector.\n\ +@end table\n\ +\n\ +When called with a single argument @var{func}, the breakpoint\n\ +is set at the first executable line in the named function.\n\ +\n\ +The optional output @var{rline} is the real line number where the\n\ +breakpoint was set. This can differ from specified line if\n\ +the line is not executable. For example, if a breakpoint attempted on a\n\ +blank line then Octave will set the real breakpoint at the\n\ +next executable line.\n\ +@seealso{dbclear, dbstatus, dbstep, debug_on_error, debug_on_warning, debug_on_interrupt}\n\ +@end deftypefn") +{ + bp_table::intmap retval; + std::string symbol_name; + bp_table::intmap lines; + + parse_dbfunction_params ("dbstop", args, symbol_name, lines); + + if (lines.size () == 0) + lines[0] = 1; + + if (! error_state) + retval = bp_table::add_breakpoint (symbol_name, lines); + + return intmap_to_ov (retval); +} + +DEFUN (dbclear, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} dbclear (\"@var{func}\")\n\ +@deftypefnx {Built-in Function} {} dbclear (\"@var{func}\", @var{line}, @dots{})\n\ +@deftypefnx {Built-in Function} {} dbclear (@var{line}, @dots{})\n\ +Delete a breakpoint in the function @var{func}.\n\ +\n\ +Arguments are\n\ +\n\ +@table @var\n\ +@item func\n\ +Function name as a string variable. When already in debug\n\ +mode this argument should be omitted and only the line number should be\n\ +given.\n\ +\n\ +@item line\n\ +Line number from which to remove a breakpoint. Multiple\n\ +lines may be given as separate arguments or as a vector.\n\ +@end table\n\ +\n\ +When called without a line number specification all breakpoints\n\ +in the named function are cleared.\n\ +\n\ +If the requested line is not a breakpoint no action is performed.\n\ +@seealso{dbstop, dbstatus, dbwhere}\n\ +@end deftypefn") +{ + octave_value retval; + std::string symbol_name = ""; + bp_table::intmap lines; + + parse_dbfunction_params ("dbclear", args, symbol_name, lines); + + if (! error_state) + bp_table::remove_breakpoint (symbol_name, lines); + + return retval; +} + +DEFUN (dbstatus, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} dbstatus ()\n\ +@deftypefnx {Built-in Function} {@var{brk_list} =} dbstatus ()\n\ +@deftypefnx {Built-in Function} {@var{brk_list} =} dbstatus (\"@var{func}\")\n\ +Report the location of active breakpoints.\n\ +\n\ +When called with no input or output arguments, print the list of\n\ +all functions with breakpoints and the line numbers where those\n\ +breakpoints are set.\n\ +If a function name @var{func} is specified then only report breakpoints\n\ +for the named function.\n\ +\n\ +The optional return argument @var{brk_list} is a struct array with the\n\ +following fields.\n\ +\n\ +@table @asis\n\ +@item name\n\ +The name of the function with a breakpoint.\n\ +\n\ +@item file\n\ +The name of the m-file where the function code is located.\n\ +\n\ +@item line\n\ +A line number, or vector of line numbers, with a breakpoint.\n\ +@end table\n\ +\n\ +@seealso{dbclear, dbwhere}\n\ +@end deftypefn") +{ + octave_map retval; + int nargin = args.length (); + octave_value_list fcn_list; + bp_table::fname_line_map bp_list; + std::string symbol_name; + + if (nargin != 0 && nargin != 1) + { + error ("dbstatus: only zero or one arguments accepted\n"); + return octave_value (); + } + + if (nargin == 1) + { + if (args(0).is_string ()) + { + symbol_name = args(0).string_value (); + fcn_list(0) = symbol_name; + bp_list = bp_table::get_breakpoint_list (fcn_list); + } + else + gripe_wrong_type_arg ("dbstatus", args(0)); + } + else + { + octave_user_code *dbg_fcn = get_user_code (); + if (dbg_fcn) + { + symbol_name = dbg_fcn->name (); + fcn_list(0) = symbol_name; + } + + bp_list = bp_table::get_breakpoint_list (fcn_list); + } + + if (nargout == 0) + { + // Print out the breakpoint information. + + for (bp_table::fname_line_map_iterator it = bp_list.begin (); + it != bp_list.end (); it++) + { + bp_table::intmap m = it->second; + + size_t nel = m.size (); + + octave_stdout << "breakpoint in " << it->first; + if (nel > 1) + octave_stdout << " at lines "; + else + octave_stdout << " at line "; + + for (size_t j = 0; j < nel; j++) + octave_stdout << m[j] << ((j < nel - 1) ? ", " : "."); + + if (nel > 0) + octave_stdout << std::endl; + } + return octave_value (); + } + else + { + // Fill in an array for return. + + int i = 0; + Cell names (dim_vector (bp_list.size (), 1)); + Cell file (dim_vector (bp_list.size (), 1)); + Cell line (dim_vector (bp_list.size (), 1)); + + for (bp_table::const_fname_line_map_iterator it = bp_list.begin (); + it != bp_list.end (); it++) + { + names(i) = it->first; + line(i) = intmap_to_ov (it->second); + file(i) = do_which (it->first); + i++; + } + + retval.assign ("name", names); + retval.assign ("file", file); + retval.assign ("line", line); + + return octave_value (retval); + } +} + +DEFUN (dbwhere, , , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} dbwhere\n\ +In debugging mode, report the current file and line number where\n\ +execution is stopped.\n\ +@seealso{dbstatus, dbcont, dbstep, dbup}\n\ +@end deftypefn") +{ + octave_value retval; + + octave_user_code *dbg_fcn = get_user_code (); + + if (dbg_fcn) + { + bool have_file = true; + + std::string name = dbg_fcn->fcn_file_name (); + + if (name.empty ()) + { + have_file = false; + + name = dbg_fcn->name (); + } + + octave_stdout << "stopped in " << name << " at "; + + int l = octave_call_stack::caller_user_code_line (); + + if (l > 0) + { + octave_stdout << " line " << l << std::endl; + + if (have_file) + { + std::string line = get_file_line (name, l); + + if (! line.empty ()) + octave_stdout << l << ": " << line << std::endl; + } + } + else + octave_stdout << " " << std::endl; + } + else + error ("dbwhere: must be inside a user function to use dbwhere\n"); + + return retval; +} + +// Copied and modified from the do_type command in help.cc +// Maybe we could share some code? +void +do_dbtype (std::ostream& os, const std::string& name, int start, int end) +{ + std::string ff = fcn_file_in_path (name); + + if (! ff.empty ()) + { + std::ifstream fs (ff.c_str (), std::ios::in); + + if (fs) + { + char ch; + int line = 1; + bool isnewline = true; + + // FIXME: Why not use line-oriented input here [getline()]? + while (fs.get (ch) && line <= end) + { + if (isnewline && line >= start) + { + os << line << "\t"; + isnewline = false; + } + + if (line >= start) + { + os << ch; + } + + if (ch == '\n') + { + line++; + isnewline = true; + } + } + } + else + os << "dbtype: unable to open '" << ff << "' for reading!\n"; + } + else + os << "dbtype: unknown function " << name << "\n"; + + os.flush (); +} + +DEFUN (dbtype, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} dbtype\n\ +@deftypefnx {Command} {} dbtype @var{lineno}\n\ +@deftypefnx {Command} {} dbtype @var{startl:endl}\n\ +@deftypefnx {Command} {} dbtype @var{startl:end}\n\ +@deftypefnx {Command} {} dbtype @var{func}\n\ +@deftypefnx {Command} {} dbtype @var{func} @var{lineno}\n\ +@deftypefnx {Command} {} dbtype @var{func} @var{startl:endl}\n\ +@deftypefnx {Command} {} dbtype @var{func} @var{startl:end}\n\ +Display a script file with line numbers.\n\ +\n\ +When called with no arguments in debugging mode, display the script file\n\ +currently being debugged. An optional range specification can be used to\n\ +list only a portion of the file. The special keyword \"end\" is a valid\n\ +line number specification for the last line of the file.\n\ +\n\ +When called with the name of a function, list that script file with line\n\ +numbers.\n\ +@seealso{dbwhere, dbstatus, dbstop}\n\ +@end deftypefn") +{ + octave_value retval; + octave_user_code *dbg_fcn; + + int nargin = args.length (); + string_vector argv = args.make_argv ("dbtype"); + + if (! error_state) + { + switch (nargin) + { + case 0: // dbtype + dbg_fcn = get_user_code (); + + if (dbg_fcn) + do_dbtype (octave_stdout, dbg_fcn->name (), 0, + std::numeric_limits::max ()); + else + error ("dbtype: must be inside a user function to give no arguments to dbtype\n"); + break; + + case 1: // (dbtype func) || (dbtype start:end) + { + std::string arg = argv[1]; + + size_t ind = arg.find (':'); + + if (ind != std::string::npos) // (dbtype start:end) + { + dbg_fcn = get_user_code (); + + if (dbg_fcn) + { + std::string start_str = arg.substr (0, ind); + std::string end_str = arg.substr (ind + 1); + + int start, end; + start = atoi (start_str.c_str ()); + if (end_str == "end") + end = std::numeric_limits::max (); + else + end = atoi (end_str.c_str ()); + + if (std::min (start, end) <= 0) + error ("dbtype: start and end lines must be >= 1\n"); + + if (start <= end) + do_dbtype (octave_stdout, dbg_fcn->name (), start, end); + else + error ("dbtype: start line must be less than end line\n"); + } + } + else // (dbtype func) + { + dbg_fcn = get_user_code (arg); + + if (dbg_fcn) + do_dbtype (octave_stdout, dbg_fcn->name (), 0, + std::numeric_limits::max ()); + else + error ("dbtype: function <%s> not found\n", arg.c_str ()); + } + } + break; + + case 2: // (dbtype func start:end) , (dbtype func start) + dbg_fcn = get_user_code (argv[1]); + + if (dbg_fcn) + { + std::string arg = argv[2]; + int start, end; + size_t ind = arg.find (':'); + + if (ind != std::string::npos) + { + std::string start_str = arg.substr (0, ind); + std::string end_str = arg.substr (ind + 1); + + start = atoi (start_str.c_str ()); + if (end_str == "end") + end = std::numeric_limits::max (); + else + end = atoi (end_str.c_str ()); + } + else + { + start = atoi (arg.c_str ()); + end = start; + } + + if (std::min (start, end) <= 0) + error ("dbtype: start and end lines must be >= 1\n"); + + if (start <= end) + do_dbtype (octave_stdout, dbg_fcn->name (), start, end); + else + error ("dbtype: start line must be less than end line\n"); + } + else + error ("dbtype: function <%s> not found\n", argv[1].c_str ()); + + break; + + default: + error ("dbtype: expecting zero, one, or two arguments\n"); + } + } + + return retval; +} + +DEFUN (dblist, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} dblist\n\ +@deftypefnx {Command} {} dblist @var{n}\n\ +In debugging mode, list @var{n} lines of the function being debugged\n\ +centered around the the current line to be executed. If unspecified @var{n}\n\ +defaults to 10 (+/- 5 lines)\n\ +@seealso{dbwhere, dbtype}\n\ +@end deftypefn") +{ + octave_value retval; + + int n = 10; + + if (args.length () == 1) + { + octave_value arg = args(0); + + if (arg.is_string ()) + { + std::string s_arg = arg.string_value (); + + n = atoi (s_arg.c_str ()); + } + else + n = args(0).int_value (); + + if (n < 0) + error ("dblist: N must be a non-negative integer"); + } + + octave_user_code *dbg_fcn = get_user_code (); + + if (dbg_fcn) + { + bool have_file = true; + + std::string name = dbg_fcn->fcn_file_name (); + + if (name.empty ()) + { + have_file = false; + name = dbg_fcn->name (); + } + + int l = octave_call_stack::caller_user_code_line (); + + if (l > 0) + { + if (have_file) + { + int l_min = std::max (l - n/2, 0); + int l_max = l + n/2; + do_dbtype (octave_stdout, dbg_fcn->name (), l_min, l-1); + + std::string line = get_file_line (name, l); + if (! line.empty ()) + octave_stdout << l << "-->\t" << line << std::endl; + + do_dbtype (octave_stdout, dbg_fcn->name (), l+1, l_max); + } + } + else + { + octave_stdout << "dblist: unable to determine source code line" + << std::endl; + } + } + else + error ("dblist: must be inside a user function to use dblist\n"); + + return retval; +} + +static octave_value_list +do_dbstack (const octave_value_list& args, int nargout, std::ostream& os) +{ + octave_value_list retval; + + unwind_protect frame; + + octave_idx_type curr_frame = -1; + + size_t nskip = 0; + + if (args.length () == 1) + { + int n = 0; + + octave_value arg = args(0); + + if (arg.is_string ()) + { + std::string s_arg = arg.string_value (); + + n = atoi (s_arg.c_str ()); + } + else + n = args(0).int_value (); + + if (n > 0) + nskip = n; + else + error ("dbstack: N must be a non-negative integer"); + } + + if (! error_state) + { + octave_map stk = octave_call_stack::backtrace (nskip, curr_frame); + + if (nargout == 0) + { + octave_idx_type nframes_to_display = stk.numel (); + + if (nframes_to_display > 0) + { + os << "stopped in:\n\n"; + + Cell names = stk.contents ("name"); + Cell files = stk.contents ("file"); + Cell lines = stk.contents ("line"); + + bool show_top_level = true; + + size_t max_name_len = 0; + + for (octave_idx_type i = 0; i < nframes_to_display; i++) + { + std::string name = names(i).string_value (); + + max_name_len = std::max (name.length (), max_name_len); + } + + for (octave_idx_type i = 0; i < nframes_to_display; i++) + { + std::string name = names(i).string_value (); + std::string file = files(i).string_value (); + int line = lines(i).int_value (); + + if (show_top_level && i == curr_frame) + show_top_level = false; + + os << (i == curr_frame ? " --> " : " ") + << std::setw (max_name_len) << name + << " at line " << line + << " [" << file << "]" + << std::endl; + } + + if (show_top_level) + os << " --> top level" << std::endl; + } + } + else + { + retval(1) = curr_frame < 0 ? 1 : curr_frame + 1; + retval(0) = stk; + } + } + + return retval; +} + +// A function that can be easily called from a debugger print the Octave +// stack. This can be useful for finding what line of code the +// interpreter is currently executing when the debugger is stopped in +// some C++ function, for example. + +void +show_octave_dbstack (void) +{ + do_dbstack (octave_value_list (), 0, std::cerr); +} + +DEFUN (dbstack, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Command} {} dbstack\n\ +@deftypefnx {Command} {} dbstack @var{n}\n\ +@deftypefnx {Built-in Function} {[@var{stack}, @var{idx}] =} dbstack (@dots{})\n\ +Display or return current debugging function stack information.\n\ +With optional argument @var{n}, omit the @var{n} innermost stack frames.\n\ +\n\ +The optional return argument @var{stack} is a struct array with the\n\ +following fields:\n\ +\n\ +@table @asis\n\ +@item file\n\ +The name of the m-file where the function code is located.\n\ +\n\ +@item name\n\ +The name of the function with a breakpoint.\n\ +\n\ +@item line\n\ +The line number of an active breakpoint.\n\ +\n\ +@item column\n\ +The column number of the line where the breakpoint begins.\n\ +\n\ +@item scope\n\ +Undocumented.\n\ +\n\ +@item context\n\ +Undocumented.\n\ +@end table\n\ +\n\ +The return argument @var{idx} specifies which element of the @var{stack}\n\ +struct array is currently active.\n\ +@seealso{dbup, dbdown, dbwhere, dbstatus}\n\ +@end deftypefn") +{ + return do_dbstack (args, nargout, octave_stdout); +} + +static void +do_dbupdown (const octave_value_list& args, const std::string& who) +{ + int n = 1; + + if (args.length () == 1) + { + octave_value arg = args(0); + + if (arg.is_string ()) + { + std::string s_arg = arg.string_value (); + + n = atoi (s_arg.c_str ()); + } + else + n = args(0).int_value (); + } + + if (! error_state) + { + if (who == "dbup") + n = -n; + + if (! octave_call_stack::goto_frame_relative (n, true)) + error ("%s: invalid stack frame", who.c_str ()); + } +} + +DEFUN (dbup, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} dbup\n\ +@deftypefnx {Built-in Function} {} dbup (@var{n})\n\ +In debugging mode, move up the execution stack @var{n} frames.\n\ +If @var{n} is omitted, move up one frame.\n\ +@seealso{dbstack, dbdown}\n\ +@end deftypefn") +{ + octave_value retval; + + do_dbupdown (args, "dbup"); + + return retval; +} + +DEFUN (dbdown, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} dbdown\n\ +@deftypefnx {Built-in Function} {} dbdown (@var{n})\n\ +In debugging mode, move down the execution stack @var{n} frames.\n\ +If @var{n} is omitted, move down one frame.\n\ +@seealso{dbstack, dbup}\n\ +@end deftypefn") +{ + octave_value retval; + + do_dbupdown (args, "dbdown"); + + return retval; +} + +DEFUN (dbstep, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} dbstep\n\ +@deftypefnx {Command} {} dbstep @var{n}\n\ +@deftypefnx {Command} {} dbstep in\n\ +@deftypefnx {Command} {} dbstep out\n\ +@deftypefnx {Command} {} dbnext @dots{}\n\ +In debugging mode, execute the next @var{n} lines of code.\n\ +If @var{n} is omitted, execute the next single line of code.\n\ +If the next line of code is itself defined in terms of an m-file remain in\n\ +the existing function.\n\ +\n\ +Using @code{dbstep in} will cause execution of the next line to step into\n\ +any m-files defined on the next line. Using @code{dbstep out} will cause\n\ +execution to continue until the current function returns.\n\ +\n\ +@code{dbnext} is an alias for @code{dbstep}.\n\ +@seealso{dbcont, dbquit}\n\ +@end deftypefn") +{ + if (Vdebugging) + { + int nargin = args.length (); + + if (nargin > 1) + print_usage (); + else if (nargin == 1) + { + if (args(0).is_string ()) + { + std::string arg = args(0).string_value (); + + if (! error_state) + { + if (arg == "in") + { + Vdebugging = false; + + tree_evaluator::dbstep_flag = -1; + } + else if (arg == "out") + { + Vdebugging = false; + + tree_evaluator::dbstep_flag = -2; + } + else + { + int n = atoi (arg.c_str ()); + + if (n > 0) + { + Vdebugging = false; + + tree_evaluator::dbstep_flag = n; + } + else + error ("dbstep: invalid argument"); + } + } + } + else + error ("dbstep: input argument must be a character string"); + } + else + { + Vdebugging = false; + + tree_evaluator::dbstep_flag = 1; + } + } + else + error ("dbstep: can only be called in debug mode"); + + return octave_value_list (); +} + +DEFALIAS (dbnext, dbstep); + +DEFUN (dbcont, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} dbcont\n\ +Leave command-line debugging mode and continue code execution normally.\n\ +@seealso{dbstep, dbquit}\n\ +@end deftypefn") +{ + if (Vdebugging) + { + if (args.length () == 0) + { + Vdebugging = false; + + tree_evaluator::reset_debug_state (); + } + else + print_usage (); + } + else + error ("dbcont: can only be called in debug mode"); + + return octave_value_list (); +} + +DEFUN (dbquit, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} dbquit\n\ +Quit debugging mode immediately without further code execution and\n\ +return to the Octave prompt.\n\ +@seealso{dbcont, dbstep}\n\ +@end deftypefn") +{ + if (Vdebugging) + { + if (args.length () == 0) + { + Vdebugging = false; + + tree_evaluator::reset_debug_state (); + + octave_throw_interrupt_exception (); + } + else + print_usage (); + } + else + error ("dbquit: can only be called in debug mode"); + + return octave_value_list (); +} + +DEFUN (isdebugmode, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isdebugmode ()\n\ +Return true if in debugging mode, otherwise false.\n\ +@seealso{dbwhere, dbstack, dbstatus}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 0) + retval = Vdebugging; + else + print_usage (); + + return retval; +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/debug.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/debug.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,143 @@ +/* + +Copyright (C) 2001-2012 Ben Sapp + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_debug_h) +#define octave_debug_h 1 + +#include +#include +#include "ov.h" +#include "dRowVector.h" + +class octave_value_list; +class octave_user_code; + +// Interface to breakpoints,. + +class +OCTINTERP_API +bp_table +{ +private: + + bp_table (void) : bp_set () { } + + ~bp_table (void) { } + +public: + + typedef std::map intmap; + + typedef intmap::const_iterator const_intmap_iterator; + typedef intmap::iterator intmap_iterator; + + typedef std::map fname_line_map; + + typedef fname_line_map::const_iterator const_fname_line_map_iterator; + typedef fname_line_map::iterator fname_line_map_iterator; + + static bool instance_ok (void); + + // Add a breakpoint at the nearest executable line. + static intmap add_breakpoint (const std::string& fname = "", + const intmap& lines = intmap ()) + { + return instance_ok () + ? instance->do_add_breakpoint (fname, lines) : intmap (); + } + + // Remove a breakpoint from a line in file. + static int remove_breakpoint (const std::string& fname = "", + const intmap& lines = intmap ()) + { + return instance_ok () + ? instance->do_remove_breakpoint (fname, lines) : 0; + } + + // Remove all the breakpoints in a specified file. + static intmap remove_all_breakpoints_in_file (const std::string& fname, + bool silent = false) + { + return instance_ok () + ? instance->do_remove_all_breakpoints_in_file (fname, silent) : intmap (); + } + + // Remove all the breakpoints registered with octave. + static void remove_all_breakpoints (void) + { + if (instance_ok ()) + instance->do_remove_all_breakpoints (); + } + + // Return all breakpoints. Each element of the map is a vector + // containing the breakpoints corresponding to a given function name. + static fname_line_map + get_breakpoint_list (const octave_value_list& fname_list) + { + return instance_ok () + ? instance->do_get_breakpoint_list (fname_list) : fname_line_map (); + } + + static bool + have_breakpoints (void) + { + return instance_ok () ? instance->do_have_breakpoints () : 0; + } + +private: + + typedef std::set::const_iterator const_bp_set_iterator; + typedef std::set::iterator bp_set_iterator; + + // Set of function names containing at least one breakpoint. + std::set bp_set; + + static bp_table *instance; + + static void cleanup_instance (void) { delete instance; instance = 0; } + + bool do_add_breakpoint_1 (octave_user_code *fcn, const std::string& fname, + const intmap& line, intmap& retval); + + intmap do_add_breakpoint (const std::string& fname, const intmap& lines); + + int do_remove_breakpoint_1 (octave_user_code *fcn, const std::string&, + const intmap& lines); + + int do_remove_breakpoint (const std::string&, const intmap& lines); + + intmap do_remove_all_breakpoints_in_file_1 (octave_user_code *fcn, + const std::string& fname); + + intmap do_remove_all_breakpoints_in_file (const std::string& fname, + bool silent); + + void do_remove_all_breakpoints (void); + + fname_line_map do_get_breakpoint_list (const octave_value_list& fname_list); + + bool do_have_breakpoints (void) { return (! bp_set.empty ()); } +}; + +extern std::string get_file_line (const std::string& fname, size_t line); + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/defaults.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/defaults.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,606 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include +#include +#include + +#include +#include + +#include "dir-ops.h" +#include "oct-env.h" +#include "file-stat.h" +#include "pathsearch.h" +#include "str-vec.h" + +#include +#include "defun.h" +#include "error.h" +#include "file-ops.h" +#include "gripes.h" +#include "help.h" +#include "input.h" +#include "load-path.h" +#include "oct-obj.h" +#include "ov.h" +#include "parse.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "variables.h" +#include + +std::string Voctave_home; + +std::string Vbin_dir; +std::string Vinfo_dir; +std::string Vdata_dir; +std::string Vlibexec_dir; +std::string Varch_lib_dir; +std::string Vlocal_arch_lib_dir; +std::string Vlocal_api_arch_lib_dir; +std::string Vlocal_ver_arch_lib_dir; + +std::string Vlocal_ver_oct_file_dir; +std::string Vlocal_api_oct_file_dir; +std::string Vlocal_oct_file_dir; + +std::string Vlocal_ver_fcn_file_dir; +std::string Vlocal_api_fcn_file_dir; +std::string Vlocal_fcn_file_dir; + +std::string Voct_etc_dir; +std::string Voct_locale_dir; + +std::string Voct_file_dir; +std::string Vfcn_file_dir; + +std::string Vimage_dir; + +// The path that will be searched for programs that we execute. +// (--exec-path path) +static std::string VEXEC_PATH; + +// Name of the editor to be invoked by the edit_history command. +std::string VEDITOR; + +static std::string VIMAGE_PATH; + +std::string Vlocal_site_defaults_file; +std::string Vsite_defaults_file; + +std::string Vbuilt_in_docstrings_file; + +std::string +subst_octave_home (const std::string& s) +{ + std::string retval; + + std::string prefix = OCTAVE_PREFIX; + + retval = s; + + if (Voctave_home != prefix) + { + octave_idx_type len = prefix.length (); + + if (s.substr (0, len) == prefix) + retval.replace (0, len, Voctave_home); + } + + if (file_ops::dir_sep_char () != '/') + std::replace (retval.begin (), retval.end (), '/', + file_ops::dir_sep_char ()); + + return retval; +} + +static void +set_octave_home (void) +{ + std::string oh = octave_env::getenv ("OCTAVE_HOME"); + + Voctave_home = oh.empty () ? std::string (OCTAVE_PREFIX) : oh; +} + +static void +set_default_info_dir (void) +{ + Vinfo_dir = subst_octave_home (OCTAVE_INFODIR); +} + +static void +set_default_data_dir (void) +{ + Vdata_dir = subst_octave_home (OCTAVE_DATADIR); +} + +static void +set_default_libexec_dir (void) +{ + Vlibexec_dir = subst_octave_home (OCTAVE_LIBEXECDIR); +} + +static void +set_default_arch_lib_dir (void) +{ + Varch_lib_dir = subst_octave_home (OCTAVE_ARCHLIBDIR); +} + +static void +set_default_local_arch_lib_dir (void) +{ + Vlocal_arch_lib_dir = subst_octave_home (OCTAVE_LOCALARCHLIBDIR); +} + +static void +set_default_local_api_arch_lib_dir (void) +{ + Vlocal_api_arch_lib_dir = subst_octave_home (OCTAVE_LOCALAPIARCHLIBDIR); +} + +static void +set_default_local_ver_arch_lib_dir (void) +{ + Vlocal_ver_arch_lib_dir = subst_octave_home (OCTAVE_LOCALVERARCHLIBDIR); +} + +static void +set_default_local_ver_oct_file_dir (void) +{ + Vlocal_ver_oct_file_dir = subst_octave_home (OCTAVE_LOCALVEROCTFILEDIR); +} + +static void +set_default_local_api_oct_file_dir (void) +{ + Vlocal_api_oct_file_dir = subst_octave_home (OCTAVE_LOCALAPIOCTFILEDIR); +} + +static void +set_default_local_oct_file_dir (void) +{ + Vlocal_oct_file_dir = subst_octave_home (OCTAVE_LOCALOCTFILEDIR); +} + +static void +set_default_local_ver_fcn_file_dir (void) +{ + Vlocal_ver_fcn_file_dir = subst_octave_home (OCTAVE_LOCALVERFCNFILEDIR); +} + +static void +set_default_local_api_fcn_file_dir (void) +{ + Vlocal_api_fcn_file_dir = subst_octave_home (OCTAVE_LOCALAPIFCNFILEDIR); +} + +static void +set_default_local_fcn_file_dir (void) +{ + Vlocal_fcn_file_dir = subst_octave_home (OCTAVE_LOCALFCNFILEDIR); +} + +static void +set_default_fcn_file_dir (void) +{ + Vfcn_file_dir = subst_octave_home (OCTAVE_FCNFILEDIR); +} + +static void +set_default_image_dir (void) +{ + Vimage_dir = subst_octave_home (OCTAVE_IMAGEDIR); +} + +static void +set_default_oct_etc_dir (void) +{ + Voct_etc_dir = subst_octave_home (OCTAVE_OCTETCDIR); +} + +static void +set_default_oct_locale_dir (void) +{ + Voct_locale_dir = subst_octave_home (OCTAVE_OCTLOCALEDIR); +} + +static void +set_default_oct_file_dir (void) +{ + Voct_file_dir = subst_octave_home (OCTAVE_OCTFILEDIR); +} + +static void +set_default_bin_dir (void) +{ + Vbin_dir = subst_octave_home (OCTAVE_BINDIR); +} + +void +set_exec_path (const std::string& path_arg) +{ + std::string tpath = path_arg; + + if (tpath.empty ()) + tpath = octave_env::getenv ("OCTAVE_EXEC_PATH"); + + if (tpath.empty ()) + tpath = Vlocal_ver_arch_lib_dir + dir_path::path_sep_str () + + Vlocal_api_arch_lib_dir + dir_path::path_sep_str () + + Vlocal_arch_lib_dir + dir_path::path_sep_str () + + Varch_lib_dir + dir_path::path_sep_str () + + Vbin_dir; + + VEXEC_PATH = tpath; + + // FIXME -- should we really be modifying PATH in the environment? + // The way things are now, Octave will ignore directories set in the + // PATH with calls like + // + // setenv ("PATH", "/my/path"); + // + // To fix this, I think Octave should be searching the combination of + // PATH and EXEC_PATH for programs that it executes instead of setting + // the PATH in the environment and relying on the shell to do the + // searching. + + // This is static so that even if set_exec_path is called more than + // once, shell_path is the original PATH from the environment, + // before we start modifying it. + static std::string shell_path = octave_env::getenv ("PATH"); + + if (! shell_path.empty ()) + tpath = shell_path + dir_path::path_sep_str () + tpath; + + octave_env::putenv ("PATH", tpath); +} + +void +set_image_path (const std::string& path) +{ + VIMAGE_PATH = "."; + + std::string tpath = path; + + if (tpath.empty ()) + tpath = octave_env::getenv ("OCTAVE_IMAGE_PATH"); + + if (! tpath.empty ()) + VIMAGE_PATH += dir_path::path_sep_str () + tpath; + + tpath = genpath (Vimage_dir, ""); + + if (! tpath.empty ()) + VIMAGE_PATH += dir_path::path_sep_str () + tpath; +} + +static void +set_default_doc_cache_file (void) +{ + if (Vdoc_cache_file.empty ()) + { + std::string def_file = subst_octave_home (OCTAVE_DOC_CACHE_FILE); + + std::string env_file = octave_env::getenv ("OCTAVE_DOC_CACHE_FILE"); + + Vdoc_cache_file = env_file.empty () ? def_file : env_file; + } +} + +static void +set_default_texi_macros_file (void) +{ + if (Vtexi_macros_file.empty ()) + { + std::string def_file = subst_octave_home (OCTAVE_TEXI_MACROS_FILE); + + std::string env_file = octave_env::getenv ("OCTAVE_TEXI_MACROS_FILE"); + + Vtexi_macros_file = env_file.empty () ? def_file : env_file; + } +} + +static void +set_default_info_file (void) +{ + if (Vinfo_file.empty ()) + { + std::string std_info_file = subst_octave_home (OCTAVE_INFOFILE); + + std::string oct_info_file = octave_env::getenv ("OCTAVE_INFO_FILE"); + + Vinfo_file = oct_info_file.empty () ? std_info_file : oct_info_file; + } +} + +static void +set_default_info_prog (void) +{ + if (Vinfo_program.empty ()) + { + std::string oct_info_prog = octave_env::getenv ("OCTAVE_INFO_PROGRAM"); + + if (oct_info_prog.empty ()) + Vinfo_program = "info"; + else + Vinfo_program = std::string (oct_info_prog); + } +} + +static void +set_default_editor (void) +{ + VEDITOR = "emacs"; + + std::string env_editor = octave_env::getenv ("EDITOR"); + + if (! env_editor.empty ()) + VEDITOR = env_editor; +} + +static void +set_local_site_defaults_file (void) +{ + std::string lsf = octave_env::getenv ("OCTAVE_SITE_INITFILE"); + + if (lsf.empty ()) + { + Vlocal_site_defaults_file = subst_octave_home (OCTAVE_LOCALSTARTUPFILEDIR); + Vlocal_site_defaults_file.append ("/octaverc"); + } + else + Vlocal_site_defaults_file = lsf; +} + +static void +set_site_defaults_file (void) +{ + std::string sf = octave_env::getenv ("OCTAVE_VERSION_INITFILE"); + + if (sf.empty ()) + { + Vsite_defaults_file = subst_octave_home (OCTAVE_STARTUPFILEDIR); + Vsite_defaults_file.append ("/octaverc"); + } + else + Vsite_defaults_file = sf; +} + +static void +set_built_in_docstrings_file (void) +{ + if (Vbuilt_in_docstrings_file.empty ()) + { + std::string df = octave_env::getenv ("OCTAVE_BUILT_IN_DOCSTRINGS_FILE"); + + if (df.empty ()) + Vbuilt_in_docstrings_file + = Voct_etc_dir + file_ops::dir_sep_str () + "built-in-docstrings"; + else + Vbuilt_in_docstrings_file = df; + } +} + +void +install_defaults (void) +{ + // OCTAVE_HOME must be set first! + + set_octave_home (); + + set_default_info_dir (); + + set_default_data_dir (); + + set_default_libexec_dir (); + + set_default_arch_lib_dir (); + + set_default_local_ver_arch_lib_dir (); + set_default_local_api_arch_lib_dir (); + set_default_local_arch_lib_dir (); + + set_default_local_ver_oct_file_dir (); + set_default_local_api_oct_file_dir (); + set_default_local_oct_file_dir (); + + set_default_local_ver_fcn_file_dir (); + set_default_local_api_fcn_file_dir (); + set_default_local_fcn_file_dir (); + + set_default_oct_etc_dir (); + set_default_oct_locale_dir (); + + set_default_fcn_file_dir (); + set_default_oct_file_dir (); + + set_default_image_dir (); + + set_default_bin_dir (); + + set_exec_path (); + + set_image_path (); + + set_default_doc_cache_file (); + + set_default_texi_macros_file (); + + set_default_info_file (); + + set_default_info_prog (); + + set_default_editor (); + + set_local_site_defaults_file (); + + set_site_defaults_file (); + + set_built_in_docstrings_file (); +} + +DEFUN (EDITOR, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} EDITOR ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} EDITOR (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} EDITOR (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the editor to\n\ +use with the @code{edit_history} command. The default value is taken from\n\ +the environment variable @w{@env{EDITOR}} when Octave starts. If the\n\ +environment variable is not initialized, @w{@env{EDITOR}} will be set to\n\ +@code{\"emacs\"}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{edit_history}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (EDITOR); +} + +/* +%!test +%! orig_val = EDITOR (); +%! old_val = EDITOR ("X"); +%! assert (orig_val, old_val); +%! assert (EDITOR (), "X"); +%! EDITOR (orig_val); +%! assert (EDITOR (), orig_val); + +%!error (EDITOR (1, 2)) +*/ + +DEFUN (EXEC_PATH, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} EXEC_PATH ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} EXEC_PATH (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} EXEC_PATH (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies a colon separated\n\ +list of directories to append to the shell PATH when executing external\n\ +programs. The initial value of is taken from the environment variable\n\ +@w{@env{OCTAVE_EXEC_PATH}}, but that value can be overridden by\n\ +the command line argument @option{--exec-path PATH}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + octave_value retval = SET_NONEMPTY_INTERNAL_STRING_VARIABLE (EXEC_PATH); + + if (args.length () > 0) + set_exec_path (VEXEC_PATH); + + return retval; +} + +/* +%!test +%! orig_val = EXEC_PATH (); +%! old_val = EXEC_PATH ("X"); +%! assert (orig_val, old_val); +%! assert (EXEC_PATH (), "X"); +%! EXEC_PATH (orig_val); +%! assert (EXEC_PATH (), orig_val); + +%!error (EXEC_PATH (1, 2)) +*/ + +DEFUN (IMAGE_PATH, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} IMAGE_PATH ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} IMAGE_PATH (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} IMAGE_PATH (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies a colon separated\n\ +list of directories in which to search for image files.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (IMAGE_PATH); +} + +/* +%!test +%! orig_val = IMAGE_PATH (); +%! old_val = IMAGE_PATH ("X"); +%! assert (orig_val, old_val); +%! assert (IMAGE_PATH (), "X"); +%! IMAGE_PATH (orig_val); +%! assert (IMAGE_PATH (), orig_val); + +%!error (IMAGE_PATH (1, 2)) +*/ + +DEFUN (OCTAVE_HOME, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} OCTAVE_HOME ()\n\ +Return the name of the top-level Octave installation directory.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 0) + retval = Voctave_home; + else + print_usage (); + + return retval; +} + +/* +%!assert (ischar (OCTAVE_HOME ())) +%!error OCTAVE_HOME (1) +*/ + +DEFUNX ("OCTAVE_VERSION", FOCTAVE_VERSION, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} OCTAVE_VERSION ()\n\ +Return the version number of Octave, as a string.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + retval = OCTAVE_VERSION; + else + print_usage (); + + return retval; +} + +/* +%!assert (ischar (OCTAVE_VERSION ())) +%!error OCTAVE_VERSION (1) +*/ diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/defaults.in.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/defaults.in.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,231 @@ +// %NO_EDIT_WARNING% +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_defaults_h) +#define octave_defaults_h 1 + +#include + +#include "pathsearch.h" + +#ifndef OCTAVE_CANONICAL_HOST_TYPE +#define OCTAVE_CANONICAL_HOST_TYPE %OCTAVE_CANONICAL_HOST_TYPE% +#endif + +#ifndef OCTAVE_DEFAULT_PAGER +#define OCTAVE_DEFAULT_PAGER %OCTAVE_DEFAULT_PAGER% +#endif + +#ifndef OCTAVE_ARCHLIBDIR +#define OCTAVE_ARCHLIBDIR %OCTAVE_ARCHLIBDIR% +#endif + +#ifndef OCTAVE_BINDIR +#define OCTAVE_BINDIR %OCTAVE_BINDIR% +#endif + +#ifndef OCTAVE_DATADIR +#define OCTAVE_DATADIR %OCTAVE_DATADIR% +#endif + +#ifndef OCTAVE_DATAROOTDIR +#define OCTAVE_DATAROOTDIR %OCTAVE_DATAROOTDIR% +#endif + +#ifndef OCTAVE_DOC_CACHE_FILE +#define OCTAVE_DOC_CACHE_FILE %OCTAVE_DOC_CACHE_FILE% +#endif + +#ifndef OCTAVE_TEXI_MACROS_FILE +#define OCTAVE_TEXI_MACROS_FILE %OCTAVE_TEXI_MACROS_FILE% +#endif + +#ifndef OCTAVE_EXEC_PREFIX +#define OCTAVE_EXEC_PREFIX %OCTAVE_EXEC_PREFIX% +#endif + +#ifndef OCTAVE_FCNFILEDIR +#define OCTAVE_FCNFILEDIR %OCTAVE_FCNFILEDIR% +#endif + +#ifndef OCTAVE_IMAGEDIR +#define OCTAVE_IMAGEDIR %OCTAVE_IMAGEDIR% +#endif + +#ifndef OCTAVE_INCLUDEDIR +#define OCTAVE_INCLUDEDIR %OCTAVE_INCLUDEDIR% +#endif + +#ifndef OCTAVE_INFODIR +#define OCTAVE_INFODIR %OCTAVE_INFODIR% +#endif + +#ifndef OCTAVE_INFOFILE +#define OCTAVE_INFOFILE %OCTAVE_INFOFILE% +#endif + +#ifndef OCTAVE_LIBDIR +#define OCTAVE_LIBDIR %OCTAVE_LIBDIR% +#endif + +#ifndef OCTAVE_LIBEXECDIR +#define OCTAVE_LIBEXECDIR %OCTAVE_LIBEXECDIR% +#endif + +#ifndef OCTAVE_LIBEXECDIR +#define OCTAVE_LIBEXECDIR %OCTAVE_LIBEXECDIR% +#endif + +#ifndef OCTAVE_LOCALAPIFCNFILEDIR +#define OCTAVE_LOCALAPIFCNFILEDIR %OCTAVE_LOCALAPIFCNFILEDIR% +#endif + +#ifndef OCTAVE_LOCALAPIOCTFILEDIR +#define OCTAVE_LOCALAPIOCTFILEDIR %OCTAVE_LOCALAPIOCTFILEDIR% +#endif + +#ifndef OCTAVE_LOCALARCHLIBDIR +#define OCTAVE_LOCALARCHLIBDIR %OCTAVE_LOCALARCHLIBDIR% +#endif + +#ifndef OCTAVE_LOCALFCNFILEDIR +#define OCTAVE_LOCALFCNFILEDIR %OCTAVE_LOCALFCNFILEDIR% +#endif + +#ifndef OCTAVE_LOCALOCTFILEDIR +#define OCTAVE_LOCALOCTFILEDIR %OCTAVE_LOCALOCTFILEDIR% +#endif + +#ifndef OCTAVE_LOCALSTARTUPFILEDIR +#define OCTAVE_LOCALSTARTUPFILEDIR %OCTAVE_LOCALSTARTUPFILEDIR% +#endif + +#ifndef OCTAVE_LOCALAPIARCHLIBDIR +#define OCTAVE_LOCALAPIARCHLIBDIR %OCTAVE_LOCALAPIARCHLIBDIR% +#endif + +#ifndef OCTAVE_LOCALVERARCHLIBDIR +#define OCTAVE_LOCALVERARCHLIBDIR %OCTAVE_LOCALVERARCHLIBDIR% +#endif + +#ifndef OCTAVE_LOCALVERFCNFILEDIR +#define OCTAVE_LOCALVERFCNFILEDIR %OCTAVE_LOCALVERFCNFILEDIR% +#endif + +#ifndef OCTAVE_LOCALVEROCTFILEDIR +#define OCTAVE_LOCALVEROCTFILEDIR %OCTAVE_LOCALVEROCTFILEDIR% +#endif + +#ifndef OCTAVE_MAN1DIR +#define OCTAVE_MAN1DIR %OCTAVE_MAN1DIR% +#endif + +#ifndef OCTAVE_MAN1EXT +#define OCTAVE_MAN1EXT %OCTAVE_MAN1EXT% +#endif + +#ifndef OCTAVE_MANDIR +#define OCTAVE_MANDIR %OCTAVE_MANDIR% +#endif + +#ifndef OCTAVE_OCTFILEDIR +#define OCTAVE_OCTFILEDIR %OCTAVE_OCTFILEDIR% +#endif + +#ifndef OCTAVE_OCTETCDIR +#define OCTAVE_OCTETCDIR %OCTAVE_OCTETCDIR% +#endif + +#ifndef OCTAVE_OCTLOCALEDIR +#define OCTAVE_OCTLOCALEDIR %OCTAVE_OCTLOCALEDIR% +#endif + +#ifndef OCTAVE_OCTINCLUDEDIR +#define OCTAVE_OCTINCLUDEDIR %OCTAVE_OCTINCLUDEDIR% +#endif + +#ifndef OCTAVE_OCTLIBDIR +#define OCTAVE_OCTLIBDIR %OCTAVE_OCTLIBDIR% +#endif + +#ifndef OCTAVE_OCTTESTSDIR +#define OCTAVE_OCTTESTSDIR %OCTAVE_OCTTESTSDIR% +#endif + +#ifndef OCTAVE_PREFIX +#define OCTAVE_PREFIX %OCTAVE_PREFIX% +#endif + +#ifndef OCTAVE_STARTUPFILEDIR +#define OCTAVE_STARTUPFILEDIR %OCTAVE_STARTUPFILEDIR% +#endif + +#ifndef OCTAVE_RELEASE +#define OCTAVE_RELEASE %OCTAVE_RELEASE% +#endif + +extern OCTINTERP_API std::string Voctave_home; + +extern OCTINTERP_API std::string Vbin_dir; +extern OCTINTERP_API std::string Vinfo_dir; +extern OCTINTERP_API std::string Vdata_dir; +extern OCTINTERP_API std::string Vlibexec_dir; +extern OCTINTERP_API std::string Varch_lib_dir; +extern OCTINTERP_API std::string Vlocal_arch_lib_dir; +extern OCTINTERP_API std::string Vlocal_ver_arch_lib_dir; + +extern OCTINTERP_API std::string Vlocal_ver_oct_file_dir; +extern OCTINTERP_API std::string Vlocal_api_oct_file_dir; +extern OCTINTERP_API std::string Vlocal_oct_file_dir; + +extern OCTINTERP_API std::string Vlocal_ver_fcn_file_dir; +extern OCTINTERP_API std::string Vlocal_api_fcn_file_dir; +extern OCTINTERP_API std::string Vlocal_fcn_file_dir; + +extern OCTINTERP_API std::string Voct_etc_dir; +extern OCTINTERP_API std::string Voct_locale_dir; + +extern OCTINTERP_API std::string Voct_file_dir; +extern OCTINTERP_API std::string Vfcn_file_dir; + +extern OCTINTERP_API std::string Vimage_dir; + +// Name of the editor to be invoked by the edit_history command. +extern OCTINTERP_API std::string VEDITOR; + +extern OCTINTERP_API std::string Vlocal_site_defaults_file; +extern OCTINTERP_API std::string Vsite_defaults_file; + +extern OCTINTERP_API std::string Vbuilt_in_docstrings_file; + +// Name of the FFTW wisdom program. +extern OCTINTERP_API std::string Vfftw_wisdom_program; + +extern OCTINTERP_API std::string subst_octave_home (const std::string&); + +extern OCTINTERP_API void install_defaults (void); + +extern OCTINTERP_API void set_exec_path (const std::string& path = std::string ()); +extern OCTINTERP_API void set_image_path (const std::string& path = std::string ()); + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/defun-dld.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/defun-dld.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,71 @@ +/* + +Copyright (C) 1994-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_defun_dld_h) +#define octave_defun_dld_h 1 + +#if defined (octave_defun_h) +#error defun.h and defun-dld.h both included in same file! +#endif + +#include "defun-int.h" + +// Define a builtin function that may be loaded dynamically at run +// time. +// +// If Octave is not configured for dynamic linking of builtin +// functions, this is the same as DEFUN, except that it will generate +// an extra externally visible function. +// +// The first DECLARE_FUN is for the benefit of the installer function +// and the second is for the definition of the function. + +#if defined (MAKE_BUILTINS) + +#define DEFUN_DLD(name, args_name, nargout_name, doc) \ + DEFUN_DLD_INTERNAL (name, args_name, nargout_name, doc) + +// This one can be used when 'name' cannot be used directly (if it is +// already defined as a macro). In that case, name is already a +// quoted string, and the internal name of the function must be passed +// too (the convention is to use a prefix of "F", so "foo" becomes +// "Ffoo") as well as the name of the generated installer function +// (the convention is to use a prefix of "G", so "foo" becomes "Gfoo"). + +#define DEFUNX_DLD(name, fname, gname, args_name, nargout_name, doc) \ + DEFUNX_DLD_INTERNAL (name, fname, args_name, nargout_name, doc) + +#else + +#define DEFUN_DLD(name, args_name, nargout_name, doc) \ + DECLARE_FUN (name, args_name, nargout_name); \ + DEFINE_FUN_INSTALLER_FUN (name, doc) \ + DECLARE_FUN (name, args_name, nargout_name) + +#define DEFUNX_DLD(name, fname, gname, args_name, nargout_name, doc) \ + DECLARE_FUNX (fname, args_name, nargout_name); \ + DEFINE_FUNX_INSTALLER_FUN (name, fname, gname, doc) \ + DECLARE_FUNX (fname, args_name, nargout_name) + +#endif + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/defun-int.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/defun-int.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,187 @@ +/* + +Copyright (C) 1994-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_defun_int_h) +#define octave_defun_int_h 1 + +#include + +#include "ov-builtin.h" +#include "ov-dld-fcn.h" +#include "symtab.h" +#include "version.h" + +class octave_value; + +extern OCTINTERP_API void print_usage (void); +extern OCTINTERP_API void print_usage (const std::string&); + +extern OCTINTERP_API void check_version (const std::string& version, const std::string& fcn); + +extern OCTINTERP_API void +install_builtin_function (octave_builtin::fcn f, const std::string& name, + const std::string& file, const std::string& doc, + bool can_hide_function = true); + +extern OCTINTERP_API void +install_dld_function (octave_dld_function::fcn f, const std::string& name, + const octave_shlib& shl, const std::string& doc, + bool relative = false); + +extern OCTINTERP_API void +install_mex_function (void *fptr, bool fmex, const std::string& name, + const octave_shlib& shl, bool relative = false); + +extern OCTINTERP_API void +alias_builtin (const std::string& alias, const std::string& name); + +// Gets the shlib of the currently executing DLD function, if any. +extern OCTINTERP_API octave_shlib +get_current_shlib (void); + +// This is a convenience class that calls the above function automatically at +// construction time. When deriving new classes, you can either use it as a field +// or as a parent (with multiple inheritance). + +class octave_auto_shlib : public octave_shlib +{ +public: + octave_auto_shlib (void) + : octave_shlib (get_current_shlib ()) { } + octave_auto_shlib (const octave_shlib& shl) + : octave_shlib (shl) { } +}; + +extern OCTINTERP_API bool +defun_isargout (int, int); + +extern OCTINTERP_API void +defun_isargout (int, int, bool *); + +#define DECLARE_FUNX(name, args_name, nargout_name) \ + OCTAVE_EXPORT octave_value_list \ + name (const octave_value_list& args_name, int nargout_name) + +#define DECLARE_FUN(name, args_name, nargout_name) \ + DECLARE_FUNX (F ## name, args_name, nargout_name) + +// Define the code that will be used to insert the new function into +// the symbol table. We look for this name instead of the actual +// function so that we can easily install the doc std::string too. + +typedef bool (*octave_dld_fcn_installer) (const octave_shlib&, bool relative); + +typedef octave_function * (*octave_dld_fcn_getter) (const octave_shlib&, bool relative); + +#define DEFINE_FUN_INSTALLER_FUN(name, doc) \ + DEFINE_FUNX_INSTALLER_FUN(#name, F ## name, G ## name, doc) + +#define DEFINE_FUNX_INSTALLER_FUN(name, fname, gname, doc) \ + extern "C" \ + OCTAVE_EXPORT \ + octave_function * \ + gname (const octave_shlib& shl, bool relative) \ + { \ + octave_function *retval = 0; \ + \ + check_version (OCTAVE_API_VERSION, name); \ + \ + if (! error_state) \ + { \ + octave_dld_function *fcn = octave_dld_function::create (fname, shl, name, doc); \ + \ + if (relative) \ + fcn->mark_relative (); \ + \ + retval = fcn; \ + } \ + \ + return retval; \ + } + +// MAKE_BUILTINS is defined to extract function names and related +// information and create the *.df files that are eventually used to +// create the builtins.cc file. + +#if defined (MAKE_BUILTINS) + +// Generate code to install name in the symbol table. The script +// mkdefs will create a .def file for every .cc file that uses DEFUN, +// or DEFCMD. + +#define DEFUN_INTERNAL(name, args_name, nargout_name, doc) \ + BEGIN_INSTALL_BUILTIN \ + XDEFUN_INTERNAL (name, args_name, nargout_name, doc) \ + END_INSTALL_BUILTIN + +#define DEFCONSTFUN_INTERNAL(name, args_name, nargout_name, doc) \ + BEGIN_INSTALL_BUILTIN \ + XDEFCONSTFUN_INTERNAL (name, args_name, nargout_name, doc) \ + END_INSTALL_BUILTIN + +#define DEFUNX_INTERNAL(name, fname, args_name, nargout_name, doc) \ + BEGIN_INSTALL_BUILTIN \ + XDEFUNX_INTERNAL (name, fname, args_name, nargout_name, doc) \ + END_INSTALL_BUILTIN + +// Generate code to install name in the symbol table. The script +// mkdefs will create a .def file for every .cc file that uses +// DEFUN_DLD. + +#define DEFUN_DLD_INTERNAL(name, args_name, nargout_name, doc) \ + BEGIN_INSTALL_BUILTIN \ + XDEFUN_DLD_INTERNAL (name, args_name, nargout_name, doc) \ + END_INSTALL_BUILTIN + +#define DEFUNX_DLD_INTERNAL(name, fname, args_name, nargout_name, doc) \ + BEGIN_INSTALL_BUILTIN \ + XDEFUNX_DLD_INTERNAL (name, fname, args_name, nargout_name, doc) \ + END_INSTALL_BUILTIN + +// Generate code for making another name for an existing function. + +#define DEFALIAS_INTERNAL(alias, name) \ + BEGIN_INSTALL_BUILTIN \ + XDEFALIAS_INTERNAL(alias, name) \ + END_INSTALL_BUILTIN + +#else /* ! MAKE_BUILTINS */ + +// Generate the first line of the function definition. This ensures +// that the internal functions all have the same signature. + +#define DEFUN_INTERNAL(name, args_name, nargout_name, doc) \ + DECLARE_FUN (name, args_name, nargout_name) + +#define DEFCONSTFUN_INTERNAL(name, args_name, nargout_name, doc) \ + DECLARE_FUN (name, args_name, nargout_name) + +#define DEFUNX_INTERNAL(name, fname, args_name, nargout_name, doc) \ + DECLARE_FUNX (fname, args_name, nargout_name) + +// No definition is required for an alias. + +#define DEFALIAS_INTERNAL(alias, name) + +#endif /* ! MAKE_BUILTINS */ + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/defun.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/defun.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,200 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include "defun.h" +#include "dynamic-ld.h" +#include "error.h" +#include "help.h" +#include "ov.h" +#include "ov-builtin.h" +#include "ov-dld-fcn.h" +#include "ov-fcn.h" +#include "ov-mex-fcn.h" +#include "ov-usr-fcn.h" +#include "oct-obj.h" +#include "oct-lvalue.h" +#include "pager.h" +#include "symtab.h" +#include "toplev.h" +#include "variables.h" +#include "parse.h" + +// Print the usage part of the doc string of FCN (user-defined or DEFUN). +void +print_usage (void) +{ + const octave_function *cur = octave_call_stack::current (); + if (cur) + print_usage (cur->name ()); + else + error ("print_usage: invalid function"); +} + +void +print_usage (const std::string& name) +{ + feval ("print_usage", octave_value (name), 0); +} + +void +check_version (const std::string& version, const std::string& fcn) +{ + if (version != OCTAVE_API_VERSION) + { + error ("API version %s found in .oct file function '%s'\n" + " does not match the running Octave (API version %s)\n" + " this can lead to incorrect results or other failures\n" + " you can fix this problem by recompiling this .oct file", + version.c_str (), fcn.c_str (), OCTAVE_API_VERSION); + } +} + +// Install variables and functions in the symbol tables. + +void +install_builtin_function (octave_builtin::fcn f, const std::string& name, + const std::string& file, const std::string& doc, + bool /* can_hide_function -- not yet implemented */) +{ + octave_value fcn (new octave_builtin (f, name, file, doc)); + + symbol_table::install_built_in_function (name, fcn); +} + +void +install_dld_function (octave_dld_function::fcn f, const std::string& name, + const octave_shlib& shl, const std::string& doc, + bool relative) +{ + octave_dld_function *fcn = new octave_dld_function (f, shl, name, doc); + + if (relative) + fcn->mark_relative (); + + octave_value fval (fcn); + + symbol_table::install_built_in_function (name, fval); +} + +void +install_mex_function (void *fptr, bool fmex, const std::string& name, + const octave_shlib& shl, bool relative) +{ + octave_mex_function *fcn = new octave_mex_function (fptr, fmex, shl, name); + + if (relative) + fcn->mark_relative (); + + octave_value fval (fcn); + + symbol_table::install_built_in_function (name, fval); +} + +void +alias_builtin (const std::string& alias, const std::string& name) +{ + symbol_table::alias_built_in_function (alias, name); +} + +octave_shlib +get_current_shlib (void) +{ + octave_shlib retval; + + octave_function *curr_fcn = octave_call_stack::current (); + if (curr_fcn) + { + if (curr_fcn->is_dld_function ()) + { + octave_dld_function *dld = dynamic_cast (curr_fcn); + retval = dld->get_shlib (); + } + else if (curr_fcn->is_mex_function ()) + { + octave_mex_function *mex = dynamic_cast (curr_fcn); + retval = mex->get_shlib (); + } + } + + return retval; +} + +bool defun_isargout (int nargout, int iout) +{ + const std::list *lvalue_list = octave_builtin::curr_lvalue_list; + if (iout >= std::max (nargout, 1)) + return false; + else if (lvalue_list) + { + int k = 0; + for (std::list::const_iterator p = lvalue_list->begin (); + p != lvalue_list->end (); p++) + { + if (k == iout) + return ! p->is_black_hole (); + k += p->numel (); + if (k > iout) + break; + } + + return true; + } + else + return true; +} + +void defun_isargout (int nargout, int nout, bool *isargout) +{ + const std::list *lvalue_list = octave_builtin::curr_lvalue_list; + if (lvalue_list) + { + int k = 0; + for (std::list::const_iterator p = lvalue_list->begin (); + p != lvalue_list->end () && k < nout; p++) + { + if (p->is_black_hole ()) + isargout[k++] = false; + else + { + int l = std::min (k + p->numel (), + static_cast (nout)); + while (k < l) + isargout[k++] = true; + } + } + } + else + for (int i = 0; i < nout; i++) + isargout[i] = true; + + for (int i = std::max (nargout, 1); i < nout; i++) + isargout[i] = false; +} + diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/defun.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/defun.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,66 @@ +/* + +Copyright (C) 1994-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_defun_h) +#define octave_defun_h 1 + +#if defined (octave_defun_dld_h) +#error defun.h and defun-dld.h both included in same file! +#endif + +#include "defun-int.h" + +// Define a builtin function. +// +// name is the name of the function, unqouted. +// +// args_name is the name of the octave_value_list variable used to pass +// the argument list to this function. +// +// nargout_name is the name of the int variable used to pass the +// number of output arguments this function is expected to produce. +// +// doc is the simple help text for the function. + +#define DEFUN(name, args_name, nargout_name, doc) \ + DEFUN_INTERNAL (name, args_name, nargout_name, doc) + +// This one can be used when 'name' cannot be used directly (if it is +// already defined as a macro). In that case, name is already a +// quoted string, and the internal name of the function must be passed +// too (the convention is to use a prefix of "F", so "foo" becomes "Ffoo"). + +#define DEFUNX(name, fname, args_name, nargout_name, doc) \ + DEFUNX_INTERNAL (name, fname, args_name, nargout_name, doc) + +// This is a function with a name that can't be hidden by a variable. +#define DEFCONSTFUN(name, args_name, nargout_name, doc) \ + DEFCONSTFUN_INTERNAL (name, args_name, nargout_name, doc) + +// Make alias another name for the existing function name. This macro +// must be used in the same file where name is defined, after the +// definition for name. + +#define DEFALIAS(alias, name) \ + DEFALIAS_INTERNAL (alias, name) + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/dirfns.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/dirfns.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,789 @@ +/* + +Copyright (C) 1994-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include +#include +#include + +#include +#include + +#include +#include + +#include "file-ops.h" +#include "file-stat.h" +#include "glob-match.h" +#include "oct-env.h" +#include "pathsearch.h" +#include "str-vec.h" + +#include "Cell.h" +#include "defun.h" +#include "dir-ops.h" +#include "dirfns.h" +#include "error.h" +#include "gripes.h" +#include "input.h" +#include "load-path.h" +#include "octave-link.h" +#include "oct-obj.h" +#include "pager.h" +#include "procstream.h" +#include "sysdep.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +// TRUE means we ask for confirmation before recursively removing a +// directory tree. +static bool Vconfirm_recursive_rmdir = true; + +// The time we last time we changed directories. +octave_time Vlast_chdir_time = 0.0; + +static int +octave_change_to_directory (const std::string& newdir) +{ + std::string xdir = file_ops::tilde_expand (newdir); + + int cd_ok = octave_env::chdir (xdir); + + if (cd_ok) + { + Vlast_chdir_time.stamp (); + + // FIXME -- should these actions be handled as a list of functions + // to call so users can add their own chdir handlers? + + load_path::update (); + + octave_link::change_directory (octave_env::get_current_directory ()); + } + else + error ("%s: %s", newdir.c_str (), gnulib::strerror (errno)); + + return cd_ok; +} + +DEFUN (cd, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Command} {} cd dir\n\ +@deftypefnx {Command} {} chdir dir\n\ +Change the current working directory to @var{dir}. If @var{dir} is\n\ +omitted, the current directory is changed to the user's home\n\ +directory. For example,\n\ +\n\ +@example\n\ +cd ~/octave\n\ +@end example\n\ +\n\ +@noindent\n\ +changes the current working directory to @file{~/octave}. If the\n\ +directory does not exist, an error message is printed and the working\n\ +directory is not changed.\n\ +@seealso{mkdir, rmdir, dir}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("cd"); + + if (error_state) + return retval; + + if (argc > 1) + { + std::string dirname = argv[1]; + + if (dirname.length () > 0 + && ! octave_change_to_directory (dirname)) + { + return retval; + } + } + else + { + // Behave like Unixy shells for "cd" by itself, but be Matlab + // compatible if doing "current_dir = cd". + + if (nargout == 0) + { + std::string home_dir = octave_env::get_home_directory (); + + if (home_dir.empty () || ! octave_change_to_directory (home_dir)) + return retval; + } + else + retval = octave_value (octave_env::get_current_directory ()); + } + + return retval; +} + +DEFALIAS (chdir, cd); + +DEFUN (pwd, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} pwd ()\n\ +Return the current working directory.\n\ +@seealso{dir, ls}\n\ +@end deftypefn") +{ + return octave_value (octave_env::get_current_directory ()); +} + +DEFUN (readdir, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{files}, @var{err}, @var{msg}] =} readdir (@var{dir})\n\ +Return names of the files in the directory @var{dir} as a cell array of\n\ +strings. If an error occurs, return an empty cell array in @var{files}.\n\ +\n\ +If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ +Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ +system-dependent error message.\n\ +@seealso{ls, dir, glob}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(2) = std::string (); + retval(1) = -1.0; + retval(0) = Cell (); + + if (args.length () == 1) + { + std::string dirname = args(0).string_value (); + + if (error_state) + gripe_wrong_type_arg ("readdir", args(0)); + else + { + dir_entry dir (dirname); + + if (dir) + { + string_vector dirlist = dir.read (); + retval(1) = 0.0; + retval(0) = Cell (dirlist.sort ()); + } + else + { + retval(2) = dir.error (); + } + } + } + else + print_usage (); + + return retval; +} + +// FIXME -- should maybe also allow second arg to specify +// mode? OTOH, that might cause trouble with compatibility later... + +DEFUNX ("mkdir", Fmkdir, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} mkdir (@var{dir})\n\ +@deftypefnx {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} mkdir (@var{parent}, @var{dir})\n\ +Create a directory named @var{dir} in the directory @var{parent}.\n\ +\n\ +If successful, @var{status} is 1, with @var{msg} and @var{msgid} empty\n\ +character strings. Otherwise, @var{status} is 0, @var{msg} contains a\n\ +system-dependent error message, and @var{msgid} contains a unique\n\ +message identifier.\n\ +@seealso{rmdir}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(2) = std::string (); + retval(1) = std::string (); + retval(0) = false; + + int nargin = args.length (); + + std::string dirname; + + if (nargin == 2) + { + std::string parent = args(0).string_value (); + std::string dir = args(1).string_value (); + + if (error_state) + { + gripe_wrong_type_arg ("mkdir", args(0)); + return retval; + } + else + dirname = file_ops::concat (parent, dir); + } + else if (nargin == 1) + { + dirname = args(0).string_value (); + + if (error_state) + { + gripe_wrong_type_arg ("mkdir", args(0)); + return retval; + } + } + + if (nargin == 1 || nargin == 2) + { + std::string msg; + + dirname = file_ops::tilde_expand (dirname); + + file_stat fs (dirname); + + if (fs && fs.is_dir ()) + { + // For compatibility with Matlab, we return true when the + // directory already exists. + + retval(2) = "mkdir"; + retval(1) = "directory exists"; + retval(0) = true; + } + else + { + int status = octave_mkdir (dirname, 0777, msg); + + if (status < 0) + { + retval(2) = "mkdir"; + retval(1) = msg; + } + else + retval(0) = true; + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("rmdir", Frmdir, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} rmdir (@var{dir})\n\ +@deftypefnx {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} rmdir (@var{dir}, \"s\")\n\ +Remove the directory named @var{dir}.\n\ +\n\ +If successful, @var{status} is 1, with @var{msg} and @var{msgid} empty\n\ +character strings. Otherwise, @var{status} is 0, @var{msg} contains a\n\ +system-dependent error message, and @var{msgid} contains a unique\n\ +message identifier.\n\ +\n\ +If the optional second parameter is supplied with value @code{\"s\"},\n\ +recursively remove all subdirectories as well.\n\ +@seealso{mkdir, confirm_recursive_rmdir}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(2) = std::string (); + retval(1) = std::string (); + retval(0) = false; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + std::string dirname = args(0).string_value (); + + if (error_state) + gripe_wrong_type_arg ("rmdir", args(0)); + else + { + std::string fulldir = file_ops::tilde_expand (dirname); + int status = -1; + std::string msg; + + if (nargin == 2) + { + if (args(1).string_value () == "s") + { + bool doit = true; + + if (interactive && Vconfirm_recursive_rmdir) + { + std::string prompt + = "remove entire contents of " + fulldir + "? "; + + doit = octave_yes_or_no (prompt); + } + + if (doit) + status = octave_recursive_rmdir (fulldir, msg); + } + else + error ("rmdir: expecting second argument to be \"s\""); + } + else + status = octave_rmdir (fulldir, msg); + + if (status < 0) + { + retval(2) = "rmdir"; + retval(1) = msg; + } + else + retval(0) = true; + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("link", Flink, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} link (@var{old}, @var{new})\n\ +Create a new link (also known as a hard link) to an existing file.\n\ +\n\ +If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ +Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ +system-dependent error message.\n\ +@seealso{symlink}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1.0; + + if (args.length () == 2) + { + std::string from = args(0).string_value (); + + if (error_state) + gripe_wrong_type_arg ("link", args(0)); + else + { + std::string to = args(1).string_value (); + + if (error_state) + gripe_wrong_type_arg ("link", args(1)); + else + { + std::string msg; + + int status = octave_link (from, to, msg); + + retval(0) = status; + + if (status < 0) + retval(1) = msg; + } + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("symlink", Fsymlink, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} symlink (@var{old}, @var{new})\n\ +Create a symbolic link @var{new} which contains the string @var{old}.\n\ +\n\ +If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ +Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ +system-dependent error message.\n\ +@seealso{link, readlink}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1.0; + + if (args.length () == 2) + { + std::string from = args(0).string_value (); + + if (error_state) + gripe_wrong_type_arg ("symlink", args(0)); + else + { + std::string to = args(1).string_value (); + + if (error_state) + gripe_wrong_type_arg ("symlink", args(1)); + else + { + std::string msg; + + int status = octave_symlink (from, to, msg); + + retval(0) = status; + + if (status < 0) + retval(1) = msg; + } + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("readlink", Freadlink, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{result}, @var{err}, @var{msg}] =} readlink (@var{symlink})\n\ +Read the value of the symbolic link @var{symlink}.\n\ +\n\ +If successful, @var{result} contains the contents of the symbolic link\n\ +@var{symlink}, @var{err} is 0 and @var{msg} is an empty string.\n\ +Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ +system-dependent error message.\n\ +@seealso{link, symlink}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(2) = std::string (); + retval(1) = -1.0; + retval(0) = std::string (); + + if (args.length () == 1) + { + std::string symlink = args(0).string_value (); + + if (error_state) + gripe_wrong_type_arg ("readlink", args(0)); + else + { + std::string result; + std::string msg; + + int status = octave_readlink (symlink, result, msg); + + if (status < 0) + retval(2) = msg; + retval(1) = status; + retval(0) = result; + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("rename", Frename, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} rename (@var{old}, @var{new})\n\ +Change the name of file @var{old} to @var{new}.\n\ +\n\ +If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ +Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ +system-dependent error message.\n\ +@seealso{ls, dir}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1.0; + + if (args.length () == 2) + { + std::string from = args(0).string_value (); + + if (error_state) + gripe_wrong_type_arg ("rename", args(0)); + else + { + std::string to = args(1).string_value (); + + if (error_state) + gripe_wrong_type_arg ("rename", args(1)); + else + { + std::string msg; + + int status = octave_rename (from, to, msg); + + retval(0) = status; + + if (status < 0) + retval(1) = msg; + } + } + } + else + print_usage (); + + return retval; +} + +DEFUN (glob, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} glob (@var{pattern})\n\ +Given an array of pattern strings (as a char array or a cell array) in\n\ +@var{pattern}, return a cell array of file names that match any of\n\ +them, or an empty cell array if no patterns match. The pattern strings are\n\ +interpreted as filename globbing patterns (as they are used by Unix shells).\n\ +Within a pattern\n\ +\n\ +@table @code\n\ +@item *\n\ +matches any string, including the null string,\n\ +\n\ +@item ?\n\ +matches any single character, and\n\ +\n\ +@item [@dots{}]\n\ +matches any of the enclosed characters.\n\ +@end table\n\ +\n\ +Tilde expansion\n\ +is performed on each of the patterns before looking for matching file\n\ +names. For example:\n\ +\n\ +@example\n\ +ls\n\ + @result{}\n\ + file1 file2 file3 myfile1 myfile1b\n\ +glob (\"*file1\")\n\ + @result{}\n\ + @{\n\ + [1,1] = file1\n\ + [2,1] = myfile1\n\ + @}\n\ +glob (\"myfile?\")\n\ + @result{}\n\ + @{\n\ + [1,1] = myfile1\n\ + @}\n\ +glob (\"file[12]\")\n\ + @result{}\n\ + @{\n\ + [1,1] = file1\n\ + [2,1] = file2\n\ + @}\n\ +@end example\n\ +@seealso{ls, dir, readdir}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + { + string_vector pat = args(0).all_strings (); + + if (error_state) + gripe_wrong_type_arg ("glob", args(0)); + else + { + glob_match pattern (file_ops::tilde_expand (pat)); + + retval = Cell (pattern.glob ()); + } + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! tmpdir = tmpnam; +%! filename = {"file1", "file2", "file3", "myfile1", "myfile1b"}; +%! if (mkdir (tmpdir)) +%! cwd = pwd; +%! cd (tmpdir); +%! if strcmp (canonicalize_file_name (pwd), canonicalize_file_name (tmpdir)) +%! a = 0; +%! for n = 1:5 +%! save (filename{n}, "a"); +%! endfor +%! else +%! rmdir (tmpdir); +%! error ("Couldn't change to temporary dir"); +%! endif +%! else +%! error ("Couldn't create temporary directory"); +%! endif +%! result1 = glob ("*file1"); +%! result2 = glob ("myfile?"); +%! result3 = glob ("file[12]"); +%! for n = 1:5 +%! delete (filename{n}); +%! endfor +%! cd (cwd); +%! rmdir (tmpdir); +%! assert (result1, {"file1"; "myfile1"}); +%! assert (result2, {"myfile1"}); +%! assert (result3, {"file1"; "file2"}); +*/ + +DEFUNX ("fnmatch", Ffnmatch, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} fnmatch (@var{pattern}, @var{string})\n\ +Return 1 or zero for each element of @var{string} that matches any of\n\ +the elements of the string array @var{pattern}, using the rules of\n\ +filename pattern matching. For example:\n\ +\n\ +@example\n\ +@group\n\ +fnmatch (\"a*b\", @{\"ab\"; \"axyzb\"; \"xyzab\"@})\n\ + @result{} [ 1; 1; 0 ]\n\ +@end group\n\ +@end example\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 2) + { + string_vector pat = args(0).all_strings (); + string_vector str = args(1).all_strings (); + + if (error_state) + gripe_wrong_type_arg ("fnmatch", args(0)); + else + { + glob_match pattern (file_ops::tilde_expand (pat)); + + retval = pattern.match (str); + } + } + else + print_usage (); + + return retval; +} + +DEFUN (filesep, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} filesep ()\n\ +@deftypefnx {Built-in Function} {} filesep (\"all\")\n\ +Return the system-dependent character used to separate directory names.\n\ +\n\ +If \"all\" is given, the function returns all valid file separators in\n\ +the form of a string. The list of file separators is system-dependent.\n\ +It is @samp{/} (forward slash) under UNIX or @w{Mac OS X}, @samp{/} and\n\ +@samp{\\} (forward and backward slashes) under Windows.\n\ +@seealso{pathsep}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 0) + retval = file_ops::dir_sep_str (); + else if (args.length () == 1) + { + std::string s = args(0).string_value (); + + if (! error_state) + { + if (s == "all") + retval = file_ops::dir_sep_chars (); + else + gripe_wrong_type_arg ("filesep", args(0)); + } + else + gripe_wrong_type_arg ("filesep", args(0)); + } + else + print_usage (); + + return retval; +} + +DEFUN (pathsep, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} pathsep ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} pathsep (@var{new_val})\n\ +Query or set the character used to separate directories in a path.\n\ +@seealso{filesep}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargout > 0 || nargin == 0) + retval = dir_path::path_sep_str (); + + if (nargin == 1) + { + std::string sval = args(0).string_value (); + + if (! error_state) + { + switch (sval.length ()) + { + case 1: + dir_path::path_sep_char (sval[0]); + break; + + case 0: + dir_path::path_sep_char ('\0'); + break; + + default: + error ("pathsep: argument must be a single character"); + break; + } + } + else + error ("pathsep: argument must be a single character"); + } + else if (nargin > 1) + print_usage (); + + return retval; +} + +DEFUN (confirm_recursive_rmdir, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} confirm_recursive_rmdir ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} confirm_recursive_rmdir (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} confirm_recursive_rmdir (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave\n\ +will ask for confirmation before recursively removing a directory tree.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (confirm_recursive_rmdir); +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/dirfns.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/dirfns.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,35 @@ +/* + +Copyright (C) 1994-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_dirfns_h) +#define octave_dirfns_h 1 + +#include + +#include + +#include "oct-time.h" + +// The time we last time we changed directories. +extern octave_time Vlast_chdir_time; + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/display.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/display.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,188 @@ +/* + +Copyright (C) 2009-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#if defined (OCTAVE_USE_WINDOWS_API) +#include +#elif defined (HAVE_FRAMEWORK_CARBON) +#include +#elif defined (HAVE_X_WINDOWS) +#include +#endif + +#include "singleton-cleanup.h" + +#include "display.h" +#include "error.h" + +display_info *display_info::instance = 0; + +#if defined (HAVE_FRAMEWORK_CARBON) && ! defined (HAVE_CARBON_CGDISPLAYBITSPERPIXEL) +// FIXME - This will only work for MacOS > 10.5. For earlier versions +// this code is not needed (use CGDisplayBitsPerPixel instead). +size_t DisplayBitsPerPixel (CGDirectDisplayID display) +{ + CGDisplayModeRef mode = CGDisplayCopyDisplayMode (display); + CFStringRef pixelEncoding = CGDisplayModeCopyPixelEncoding (mode); + + if (CFStringCompare (pixelEncoding, CFSTR (IO32BitDirectPixels), 0) == 0) + return 32; + else if (CFStringCompare (pixelEncoding, CFSTR (IO16BitDirectPixels), 0) == 0) + return 16; + else + return 8; +} +#endif + +void +display_info::init (bool query) +{ + if (query) + { +#if defined (OCTAVE_USE_WINDOWS_API) + + HDC hdc = GetDC (0); + + if (hdc) + { + dp = GetDeviceCaps (hdc, BITSPIXEL); + + ht = GetDeviceCaps (hdc, VERTRES); + wd = GetDeviceCaps (hdc, HORZRES); + + double ht_mm = GetDeviceCaps (hdc, VERTSIZE); + double wd_mm = GetDeviceCaps (hdc, HORZSIZE); + + rx = wd * 25.4 / wd_mm; + ry = ht * 25.4 / ht_mm; + + dpy_avail = true; + } + else + warning ("no graphical display found"); + +#elif defined (HAVE_FRAMEWORK_CARBON) + + CGDirectDisplayID display = CGMainDisplayID (); + + if (display) + { +# if defined (HAVE_CARBON_CGDISPLAYBITSPERPIXEL) + // For MacOS < 10.7 use the line below + dp = CGDisplayBitsPerPixel (display); +# else + // For MacOS > 10.5 use the line below + dp = DisplayBitsPerPixel (display); +# endif + + ht = CGDisplayPixelsHigh (display); + wd = CGDisplayPixelsWide (display); + + CGSize sz_mm = CGDisplayScreenSize (display); + // For MacOS >= 10.6, CGSize is a struct keeping 2 CGFloat values, + // but the CGFloat typedef is not present on older systems, + // so use double instead. + double ht_mm = sz_mm.height; + double wd_mm = sz_mm.width; + + rx = wd * 25.4 / wd_mm; + ry = ht * 25.4 / ht_mm; + + dpy_avail = true; + } + else + warning ("no graphical display found"); + +#elif defined (HAVE_X_WINDOWS) + + const char *display_name = getenv ("DISPLAY"); + + if (display_name && *display_name) + { + Display *display = XOpenDisplay (display_name); + + if (display) + { + Screen *screen = DefaultScreenOfDisplay (display); + + if (screen) + { + dp = DefaultDepthOfScreen (screen); + + ht = HeightOfScreen (screen); + wd = WidthOfScreen (screen); + + int screen_number = XScreenNumberOfScreen (screen); + + double ht_mm = DisplayHeightMM (display, screen_number); + double wd_mm = DisplayWidthMM (display, screen_number); + + rx = wd * 25.4 / wd_mm; + ry = ht * 25.4 / ht_mm; + } + else + warning ("X11 display has no default screen"); + + XCloseDisplay (display); + + dpy_avail = true; + } + else + warning ("unable to open X11 DISPLAY"); + } + else + warning ("X11 DISPLAY environment variable not set"); +#else + + warning ("no graphical display found"); + +#endif + } +} + +bool +display_info::instance_ok (bool query) +{ + bool retval = true; + + if (! instance) + { + instance = new display_info (query); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } + + if (! instance) + { + ::error ("unable to create display_info object!"); + + retval = false; + } + + return retval; +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/display.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/display.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,108 @@ +/* + +Copyright (C) 2009-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_display_h) +#define octave_display_h 1 + +class Matrix; + +class display_info +{ +protected: + + display_info (bool query = true) + : ht (1), wd (1), dp (0), rx (72), ry (72), dpy_avail (false) + { + init (query); + } + +public: + + static int height (void) + { + return instance_ok () ? instance->do_height () : 0; + } + + static int width (void) + { + return instance_ok () ? instance->do_width () : 0; + } + + static int depth (void) + { + return instance_ok () ? instance->do_depth () : 0; + } + + static double x_dpi (void) + { + return instance_ok () ? instance->do_x_dpi () : 0; + } + + static double y_dpi (void) + { + return instance_ok () ? instance->do_y_dpi () : 0; + } + + static bool display_available (void) + { + return instance_ok () ? instance->do_display_available () : false; + } + + // To disable querying the window system for defaults, this function + // must be called before any other display_info function. + static void no_window_system (void) + { + instance_ok (false); + } + +private: + + static display_info *instance; + + static void cleanup_instance (void) { delete instance; instance = 0; } + + // Height, width, and depth of the display. + int ht; + int wd; + int dp; + + // X- and Y- Resolution of the display in dots (pixels) per inch. + double rx; + double ry; + + bool dpy_avail; + + int do_height (void) const { return ht; } + int do_width (void) const { return wd; } + int do_depth (void) const { return dp; } + + double do_x_dpi (void) const { return rx; } + double do_y_dpi (void) const { return ry; } + + bool do_display_available (void) const { return dpy_avail; } + + void init (bool query = true); + + static bool instance_ok (bool query = true); +}; + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/dynamic-ld.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/dynamic-ld.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,477 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include "file-stat.h" +#include "oct-env.h" +#include "oct-time.h" +#include "singleton-cleanup.h" + +#include + +#include "defun.h" +#include "dynamic-ld.h" +#include "ov-fcn.h" +#include "ov-dld-fcn.h" +#include "ov-mex-fcn.h" +#include "parse.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +#define STRINGIFY(s) STRINGIFY1(s) +#define STRINGIFY1(s) #s + +class +octave_shlib_list +{ +public: + + typedef std::list::iterator iterator; + typedef std::list::const_iterator const_iterator; + + static void append (const octave_shlib& shl); + + static void remove (octave_shlib& shl, octave_shlib::close_hook cl_hook = 0); + + static octave_shlib find_file (const std::string& file_name); + + static void display (void); + +private: + + octave_shlib_list (void) : lib_list () { } + + ~octave_shlib_list (void) { } + + void do_append (const octave_shlib& shl); + + void do_remove (octave_shlib& shl, octave_shlib::close_hook cl_hook = 0); + + octave_shlib do_find_file (const std::string& file_name) const; + + void do_display (void) const; + + static octave_shlib_list *instance; + + static void cleanup_instance (void) { delete instance; instance = 0; } + + static bool instance_ok (void); + + // List of libraries we have loaded. + std::list lib_list; + + // No copying! + + octave_shlib_list (const octave_shlib_list&); + + octave_shlib_list& operator = (const octave_shlib_list&); +}; + +octave_shlib_list *octave_shlib_list::instance = 0; + +void +octave_shlib_list::do_append (const octave_shlib& shl) +{ + lib_list.push_back (shl); +} + +void +octave_shlib_list::do_remove (octave_shlib& shl, + octave_shlib::close_hook cl_hook) +{ + for (iterator p = lib_list.begin (); p != lib_list.end (); p++) + { + if (*p == shl) + { + // Erase first to avoid potentially invalidating the pointer by the + // following hooks. + lib_list.erase (p); + + shl.close (cl_hook); + + break; + } + } +} + +octave_shlib +octave_shlib_list::do_find_file (const std::string& file_name) const +{ + octave_shlib retval; + + for (const_iterator p = lib_list.begin (); p != lib_list.end (); p++) + { + if (p->file_name () == file_name) + { + retval = *p; + break; + } + } + + return retval; +} + +void +octave_shlib_list::do_display (void) const +{ + std::cerr << "current shared libraries:" << std::endl; + for (const_iterator p = lib_list.begin (); p != lib_list.end (); p++) + std::cerr << " " << p->file_name () << std::endl; +} + +bool +octave_shlib_list::instance_ok (void) +{ + bool retval = true; + + if (! instance) + { + instance = new octave_shlib_list (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } + + if (! instance) + { + ::error ("unable to create shared library list object!"); + + retval = false; + } + + return retval; +} + +void +octave_shlib_list::append (const octave_shlib& shl) +{ + if (instance_ok ()) + instance->do_append (shl); +} + +void +octave_shlib_list::remove (octave_shlib& shl, + octave_shlib::close_hook cl_hook) +{ + if (instance_ok ()) + instance->do_remove (shl, cl_hook); +} + +octave_shlib +octave_shlib_list::find_file (const std::string& file_name) +{ + return (instance_ok ()) + ? instance->do_find_file (file_name) : octave_shlib (); +} + +void +octave_shlib_list::display (void) +{ + if (instance_ok ()) + instance->do_display (); +} + +octave_dynamic_loader *octave_dynamic_loader::instance = 0; + +bool octave_dynamic_loader::doing_load = false; + +bool +octave_dynamic_loader::instance_ok (void) +{ + bool retval = true; + + if (! instance) + { + instance = new octave_dynamic_loader (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } + + if (! instance) + { + ::error ("unable to create dynamic loader object!"); + + retval = false; + } + + return retval; +} + +static void +do_clear_function (const std::string& fcn_name) +{ + warning_with_id ("Octave:reload-forces-clear", " %s", fcn_name.c_str ()); + + symbol_table::clear_dld_function (fcn_name); +} + +static void +clear (octave_shlib& oct_file) +{ + if (oct_file.number_of_functions_loaded () > 1) + { + warning_with_id ("Octave:reload-forces-clear", + "reloading %s clears the following functions:", + oct_file.file_name ().c_str ()); + + octave_shlib_list::remove (oct_file, do_clear_function); + } + else + octave_shlib_list::remove (oct_file, symbol_table::clear_dld_function); +} + +octave_function * +octave_dynamic_loader::do_load_oct (const std::string& fcn_name, + const std::string& file_name, + bool relative) +{ + octave_function *retval = 0; + + unwind_protect frame; + + frame.protect_var (octave_dynamic_loader::doing_load); + + doing_load = true; + + octave_shlib oct_file = octave_shlib_list::find_file (file_name); + + if (oct_file && oct_file.is_out_of_date ()) + clear (oct_file); + + if (! oct_file) + { + oct_file.open (file_name); + + if (! error_state && oct_file) + octave_shlib_list::append (oct_file); + } + + if (! error_state) + { + if (oct_file) + { + void *function = oct_file.search (fcn_name, name_mangler); + + if (! function) + { + // FIXME -- can we determine this C mangling scheme + // automatically at run time or configure time? + + function = oct_file.search (fcn_name, name_uscore_mangler); + } + + if (function) + { + octave_dld_fcn_getter f + = FCN_PTR_CAST (octave_dld_fcn_getter, function); + + retval = f (oct_file, relative); + + if (! retval) + ::error ("failed to install .oct file function '%s'", + fcn_name.c_str ()); + } + } + else + ::error ("%s is not a valid shared library", + file_name.c_str ()); + } + + return retval; +} + +octave_function * +octave_dynamic_loader::do_load_mex (const std::string& fcn_name, + const std::string& file_name, + bool /*relative*/) +{ + octave_function *retval = 0; + + unwind_protect frame; + + frame.protect_var (octave_dynamic_loader::doing_load); + + doing_load = true; + + octave_shlib mex_file = octave_shlib_list::find_file (file_name); + + if (mex_file && mex_file.is_out_of_date ()) + clear (mex_file); + + if (! mex_file) + { + mex_file.open (file_name); + + if (! error_state && mex_file) + octave_shlib_list::append (mex_file); + } + + if (! error_state) + { + if (mex_file) + { + void *function = 0; + + bool have_fmex = false; + + function = mex_file.search (fcn_name, mex_mangler); + + if (! function) + { + // FIXME -- can we determine this C mangling scheme + // automatically at run time or configure time? + + function = mex_file.search (fcn_name, mex_uscore_mangler); + + if (! function) + { + function = mex_file.search (fcn_name, mex_f77_mangler); + + if (function) + have_fmex = true; + } + } + + if (function) + retval = new octave_mex_function (function, have_fmex, + mex_file, fcn_name); + else + ::error ("failed to install .mex file function '%s'", + fcn_name.c_str ()); + } + else + ::error ("%s is not a valid shared library", + file_name.c_str ()); + } + + return retval; +} + +bool +octave_dynamic_loader::do_remove_oct (const std::string& fcn_name, + octave_shlib& shl) +{ + bool retval = false; + + // We don't need to do anything if this is called because we are in + // the process of reloading a .oct file that has changed. + + if (! doing_load) + { + retval = shl.remove (fcn_name); + + if (shl.number_of_functions_loaded () == 0) + octave_shlib_list::remove (shl); + } + + return retval; +} + +bool +octave_dynamic_loader::do_remove_mex (const std::string& fcn_name, + octave_shlib& shl) +{ + bool retval = false; + + // We don't need to do anything if this is called because we are in + // the process of reloading a .oct file that has changed. + + if (! doing_load) + { + retval = shl.remove (fcn_name); + + if (shl.number_of_functions_loaded () == 0) + octave_shlib_list::remove (shl); + } + + return retval; +} + +octave_function * +octave_dynamic_loader::load_oct (const std::string& fcn_name, + const std::string& file_name, + bool relative) +{ + return (instance_ok ()) + ? instance->do_load_oct (fcn_name, file_name, relative) : 0; +} + +octave_function * +octave_dynamic_loader::load_mex (const std::string& fcn_name, + const std::string& file_name, + bool relative) +{ + return (instance_ok ()) + ? instance->do_load_mex (fcn_name, file_name, relative) : 0; +} + +bool +octave_dynamic_loader::remove_oct (const std::string& fcn_name, + octave_shlib& shl) +{ + return (instance_ok ()) ? instance->do_remove_oct (fcn_name, shl) : false; +} + +bool +octave_dynamic_loader::remove_mex (const std::string& fcn_name, + octave_shlib& shl) +{ + return (instance_ok ()) ? instance->do_remove_mex (fcn_name, shl) : false; +} + +std::string +octave_dynamic_loader::name_mangler (const std::string& name) +{ + return "G" + name; +} + +std::string +octave_dynamic_loader::name_uscore_mangler (const std::string& name) +{ + return "_G" + name; +} + +std::string +octave_dynamic_loader::mex_mangler (const std::string&) +{ + return "mexFunction"; +} + +std::string +octave_dynamic_loader::mex_uscore_mangler (const std::string&) +{ + return "_mexFunction"; +} + +std::string +octave_dynamic_loader::mex_f77_mangler (const std::string&) +{ + return STRINGIFY (F77_FUNC (mexfunction, MEXFUNCTION)); +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/dynamic-ld.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/dynamic-ld.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,100 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_dynamic_ld_h) +#define octave_dynamic_ld_h 1 + +#include + +#include "oct-shlib.h" + +class octave_function; + +class +octave_dynamic_loader +{ +protected: + + octave_dynamic_loader (void) { } + +public: + + virtual ~octave_dynamic_loader (void) { } + + static octave_function * + load_oct (const std::string& fcn_name, + const std::string& file_name = std::string (), + bool relative = false); + + static octave_function * + load_mex (const std::string& fcn_name, + const std::string& file_name = std::string (), + bool relative = false); + + static bool remove_oct (const std::string& fcn_name, octave_shlib& shl); + + static bool remove_mex (const std::string& fcn_name, octave_shlib& shl); + +private: + + // No copying! + + octave_dynamic_loader (const octave_dynamic_loader&); + + octave_dynamic_loader& operator = (const octave_dynamic_loader&); + + static octave_dynamic_loader *instance; + + static void cleanup_instance (void) { delete instance; instance = 0; } + + static bool instance_ok (void); + + octave_function * + do_load_oct (const std::string& fcn_name, + const std::string& file_name = std::string (), + bool relative = false); + + octave_function * + do_load_mex (const std::string& fcn_name, + const std::string& file_name = std::string (), + bool relative = false); + + bool do_remove_oct (const std::string& fcn_name, octave_shlib& shl); + + bool do_remove_mex (const std::string& fcn_name, octave_shlib& shl); + + static bool doing_load; + +protected: + + static std::string name_mangler (const std::string& name); + + static std::string name_uscore_mangler (const std::string& name); + + static std::string mex_mangler (const std::string& name); + + static std::string mex_uscore_mangler (const std::string& name); + + static std::string mex_f77_mangler (const std::string& name); +}; + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/error.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/error.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,2040 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include +#include +#include + +#include "defun.h" +#include "error.h" +#include "input.h" +#include "pager.h" +#include "oct-obj.h" +#include "oct-map.h" +#include "utils.h" +#include "ov.h" +#include "ov-usr-fcn.h" +#include "pt-pr-code.h" +#include "pt-stmt.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "variables.h" + +// TRUE means that Octave will try to beep obnoxiously before printing +// error messages. +static bool Vbeep_on_error = false; + +// TRUE means that Octave will try to enter the debugger when an error +// is encountered. This will also inhibit printing of the normal +// traceback message (you will only see the top-level error message). +bool Vdebug_on_error = false; + +// TRUE means that Octave will try to enter the debugger when a warning +// is encountered. +bool Vdebug_on_warning = false; + +// TRUE means that Octave will try to display a stack trace when a +// warning is encountered. +static bool Vbacktrace_on_warning = false; + +// TRUE means that Octave will print a verbose warning. Currently unused. +static bool Vverbose_warning; + +// TRUE means that Octave will print no warnings, but lastwarn will be +//updated +static bool Vquiet_warning = false; + +// A structure containing (most of) the current state of warnings. +static octave_map warning_options; + +// The text of the last error message. +static std::string Vlast_error_message; + +// The text of the last warning message. +static std::string Vlast_warning_message; + +// The last warning message id. +static std::string Vlast_warning_id; + +// The last error message id. +static std::string Vlast_error_id; + +// The last file in which an error occured +static octave_map Vlast_error_stack; + +// Current error state. +// +// Valid values: +// +// -2: an error has occurred, but don't print any messages. +// -1: an error has occurred, we are printing a traceback +// 0: no error +// 1: an error has occurred +// +int error_state = 0; + +// Current warning state. +// +// Valid values: +// +// 0: no warning +// 1: a warning has occurred +// +int warning_state = 0; + +// Tell the error handler whether to print messages, or just store +// them for later. Used for handling errors in eval() and +// the 'unwind_protect' statement. +int buffer_error_messages = 0; + +// TRUE means error messages are turned off. +bool discard_error_messages = false; + +// TRUE means warning messages are turned off. +bool discard_warning_messages = false; + +void +reset_error_handler (void) +{ + error_state = 0; + warning_state = 0; + buffer_error_messages = 0; + discard_error_messages = false; +} + +static void +initialize_warning_options (const std::string& state) +{ + octave_scalar_map initw; + + initw.setfield ("identifier", "all"); + initw.setfield ("state", state); + + warning_options = initw; +} + +static octave_map +initialize_last_error_stack (void) +{ + return octave_call_stack::empty_backtrace (); +} + +// Warning messages are never buffered. + +static void +vwarning (const char *name, const char *id, const char *fmt, va_list args) +{ + if (discard_warning_messages) + return; + + flush_octave_stdout (); + + std::ostringstream output_buf; + + if (name) + output_buf << name << ": "; + + octave_vformat (output_buf, fmt, args); + + output_buf << std::endl; + + // FIXME -- we really want to capture the message before it + // has all the formatting goop attached to it. We probably also + // want just the message, not the traceback information. + + std::string msg_string = output_buf.str (); + + if (! warning_state) + { + // This is the first warning in a possible series. + + Vlast_warning_id = id; + Vlast_warning_message = msg_string; + } + + if (! Vquiet_warning) + { + octave_diary << msg_string; + + std::cerr << msg_string; + } +} + +static void +verror (bool save_last_error, std::ostream& os, + const char *name, const char *id, const char *fmt, va_list args, + bool with_cfn = false) +{ + if (discard_error_messages) + return; + + if (! buffer_error_messages) + flush_octave_stdout (); + + // FIXME -- we really want to capture the message before it + // has all the formatting goop attached to it. We probably also + // want just the message, not the traceback information. + + std::ostringstream output_buf; + + octave_vformat (output_buf, fmt, args); + + std::string base_msg = output_buf.str (); + + bool to_beep_or_not_to_beep_p = Vbeep_on_error && ! error_state; + + std::string msg_string; + + if (to_beep_or_not_to_beep_p) + msg_string = "\a"; + + if (name) + msg_string += std::string (name) + ": "; + + // If with_fcn is specified, we'll attempt to prefix the message with the name + // of the current executing function. But we'll do so only if: + // 1. the name is not empty (anonymous function) + // 2. it is not already there (including the following colon) + if (with_cfn) + { + octave_function *curfcn = octave_call_stack::current (); + if (curfcn) + { + std::string cfn = curfcn->name (); + if (! cfn.empty ()) + { + cfn += ':'; + if (cfn.length () > base_msg.length () + || base_msg.compare (0, cfn.length (), cfn) != 0) + { + msg_string += cfn + ' '; + } + } + } + } + + msg_string += base_msg + "\n"; + + if (! error_state && save_last_error) + { + // This is the first error in a possible series. + + Vlast_error_id = id; + Vlast_error_message = base_msg; + + octave_user_code *fcn = octave_call_stack::caller_user_code (); + + if (fcn) + { + octave_idx_type curr_frame = -1; + + Vlast_error_stack = octave_call_stack::backtrace (0, curr_frame); + } + else + Vlast_error_stack = initialize_last_error_stack (); + } + + if (! buffer_error_messages) + { + octave_diary << msg_string; + os << msg_string; + } +} + +// Note that we don't actually print any message if the error string +// is just "" or "\n". This allows error ("") and error ("\n") to +// just set the error state. + +static void +error_1 (std::ostream& os, const char *name, const char *id, + const char *fmt, va_list args, bool with_cfn = false) +{ + if (error_state != -2) + { + if (fmt) + { + if (*fmt) + { + size_t len = strlen (fmt); + + if (len > 0) + { + if (fmt[len - 1] == '\n') + { + if (len > 1) + { + char *tmp_fmt = strsave (fmt); + tmp_fmt[len - 1] = '\0'; + verror (true, os, name, id, tmp_fmt, args, with_cfn); + delete [] tmp_fmt; + } + + error_state = -2; + } + else + { + verror (true, os, name, id, fmt, args, with_cfn); + + if (! error_state) + error_state = 1; + } + } + } + } + else + panic ("error_1: invalid format"); + } +} + +void +vmessage (const char *name, const char *fmt, va_list args) +{ + verror (false, std::cerr, name, "", fmt, args); +} + +void +message (const char *name, const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + vmessage (name, fmt, args); + va_end (args); +} + +void +vmessage_with_id (const char *name, const char *id, const char *fmt, + va_list args) +{ + verror (false, std::cerr, name, id, fmt, args); +} + +void +message_with_id (const char *name, const char *id, const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + vmessage_with_id (name, id, fmt, args); + va_end (args); +} + +void +usage_1 (const char *id, const char *fmt, va_list args) +{ + verror (true, std::cerr, "usage", id, fmt, args); + error_state = -1; +} + +void +vusage (const char *fmt, va_list args) +{ + usage_1 ("", fmt, args); +} + +void +usage (const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + vusage (fmt, args); + va_end (args); +} + +void +vusage_with_id (const char *id, const char *fmt, va_list args) +{ + usage_1 (id, fmt, args); +} + +void +usage_with_id (const char *id, const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + vusage_with_id (id, fmt, args); + va_end (args); +} + +static void +pr_where_2 (const char *fmt, va_list args) +{ + if (fmt) + { + if (*fmt) + { + size_t len = strlen (fmt); + + if (len > 0) + { + if (fmt[len - 1] == '\n') + { + if (len > 1) + { + char *tmp_fmt = strsave (fmt); + tmp_fmt[len - 1] = '\0'; + verror (false, std::cerr, 0, "", tmp_fmt, args); + delete [] tmp_fmt; + } + } + else + verror (false, std::cerr, 0, "", fmt, args); + } + } + } + else + panic ("pr_where_2: invalid format"); +} + +static void +pr_where_1 (const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + pr_where_2 (fmt, args); + va_end (args); +} + +static void +pr_where (const char *who) +{ + octave_idx_type curr_frame = -1; + + octave_map stk = octave_call_stack::backtrace (0, curr_frame); + + octave_idx_type nframes_to_display = stk.numel (); + + if (nframes_to_display > 0) + { + pr_where_1 ("%s: called from\n", who); + + Cell names = stk.contents ("name"); + Cell lines = stk.contents ("line"); + Cell columns = stk.contents ("column"); + + for (octave_idx_type i = 0; i < nframes_to_display; i++) + { + octave_value name = names(i); + octave_value line = lines(i); + octave_value column = columns(i); + + std::string nm = name.string_value (); + + pr_where_1 (" %s at line %d column %d\n", nm.c_str (), + line.int_value (), column.int_value ()); + } + } +} + +static void +error_2 (const char *id, const char *fmt, va_list args, bool with_cfn = false) +{ + int init_state = error_state; + + error_1 (std::cerr, "error", id, fmt, args, with_cfn); + + if ((interactive || forced_interactive) + && Vdebug_on_error && init_state == 0 + && octave_call_stack::caller_user_code ()) + { + unwind_protect frame; + frame.protect_var (Vdebug_on_error); + Vdebug_on_error = false; + + error_state = 0; + + pr_where ("error"); + + do_keyboard (octave_value_list ()); + } +} + +void +verror (const char *fmt, va_list args) +{ + error_2 ("", fmt, args); +} + +void +error (const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + verror (fmt, args); + va_end (args); +} + +void +verror_with_cfn (const char *fmt, va_list args) +{ + error_2 ("", fmt, args, true); +} + +void +error_with_cfn (const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + verror_with_cfn (fmt, args); + va_end (args); +} + +void +verror_with_id (const char *id, const char *fmt, va_list args) +{ + error_2 (id, fmt, args); +} + +void +error_with_id (const char *id, const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + verror_with_id (id, fmt, args); + va_end (args); +} + +void +verror_with_id_cfn (const char *id, const char *fmt, va_list args) +{ + error_2 (id, fmt, args, true); +} + +void +error_with_id_cfn (const char *id, const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + verror_with_id_cfn (id, fmt, args); + va_end (args); +} + +static int +check_state (const std::string& state) +{ + // -1: not found + // 0: found, "off" + // 1: found, "on" + // 2: found, "error" + + if (state == "off") + return 0; + else if (state == "on") + return 1; + else if (state == "error") + return 2; + else + return -1; +} + +// For given warning ID, return 0 if warnings are disabled, 1 if +// enabled, and 2 if the given ID should be an error instead of a +// warning. + +int +warning_enabled (const std::string& id) +{ + int retval = 0; + + int all_state = -1; + int id_state = -1; + + octave_idx_type nel = warning_options.numel (); + + if (nel > 0) + { + Cell identifier = warning_options.contents ("identifier"); + Cell state = warning_options.contents ("state"); + + bool all_found = false; + bool id_found = false; + + for (octave_idx_type i = 0; i < nel; i++) + { + octave_value ov = identifier(i); + std::string ovs = ov.string_value (); + + if (! all_found && ovs == "all") + { + all_state = check_state (state(i).string_value ()); + + if (all_state >= 0) + all_found = true; + } + + if (! id_found && ovs == id) + { + id_state = check_state (state(i).string_value ()); + + if (id_state >= 0) + id_found = true; + } + + if (all_found && id_found) + break; + } + } + + // If "all" is not present, assume warnings are enabled. + if (all_state == -1) + all_state = 1; + + if (all_state == 0) + { + if (id_state >= 0) + retval = id_state; + } + else if (all_state == 1) + { + if (id_state == 0 || id_state == 2) + retval = id_state; + else + retval = all_state; + } + else if (all_state == 2) + { + if (id_state == 0) + retval= id_state; + else + retval = all_state; + } + + return retval; +} + +static void +warning_1 (const char *id, const char *fmt, va_list args) +{ + int warn_opt = warning_enabled (id); + + if (warn_opt == 2) + { + // Handle this warning as an error. + + error_2 (id, fmt, args); + } + else if (warn_opt == 1) + { + vwarning ("warning", id, fmt, args); + + if (! symbol_table::at_top_level () + && Vbacktrace_on_warning + && ! warning_state + && ! discard_warning_messages) + pr_where ("warning"); + + warning_state = 1; + + if ((interactive || forced_interactive) + && Vdebug_on_warning + && octave_call_stack::caller_user_code ()) + { + unwind_protect frame; + frame.protect_var (Vdebug_on_warning); + Vdebug_on_warning = false; + + do_keyboard (octave_value_list ()); + } + } +} + +void +vwarning (const char *fmt, va_list args) +{ + warning_1 ("", fmt, args); +} + +void +warning (const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + vwarning (fmt, args); + va_end (args); +} + +void +vwarning_with_id (const char *id, const char *fmt, va_list args) +{ + warning_1 (id, fmt, args); +} + +void +warning_with_id (const char *id, const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + vwarning_with_id (id, fmt, args); + va_end (args); +} + +void +vparse_error (const char *fmt, va_list args) +{ + error_1 (std::cerr, 0, "", fmt, args); +} + +void +parse_error (const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + vparse_error (fmt, args); + va_end (args); +} + +void +vparse_error_with_id (const char *id, const char *fmt, va_list args) +{ + error_1 (std::cerr, 0, id, fmt, args); +} + +void +parse_error_with_id (const char *id, const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + vparse_error_with_id (id, fmt, args); + va_end (args); +} + +void +rethrow_error (const char *id, const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + error_1 (std::cerr, 0, id, fmt, args); + va_end (args); +} + +void +panic (const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + buffer_error_messages = 0; + discard_error_messages = false; + verror (false, std::cerr, "panic", "", fmt, args); + va_end (args); + abort (); +} + +static void +defun_usage_message_1 (const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + error_1 (octave_stdout, 0, "", fmt, args); + va_end (args); +} + +void +defun_usage_message (const std::string& msg) +{ + defun_usage_message_1 ("%s", msg.c_str ()); +} + +typedef void (*error_fun)(const char *, const char *, ...); + +extern octave_value_list Fsprintf (const octave_value_list&, int); + +static std::string +handle_message (error_fun f, const char *id, const char *msg, + const octave_value_list& args, bool have_fmt) +{ + std::string retval; + + std::string tstr; + + int nargin = args.length (); + + if (nargin > 0) + { + octave_value arg; + + if (have_fmt) + { + octave_value_list tmp = Fsprintf (args, 1); + arg = tmp(0); + } + else + arg = args(0); + + if (arg.is_defined ()) + { + if (arg.is_string ()) + { + tstr = arg.string_value (); + msg = tstr.c_str (); + + if (! msg) + return retval; + } + else if (arg.is_empty ()) + return retval; + } + } + +// Ugh. + + size_t len = strlen (msg); + + if (len > 0) + { + if (msg[len - 1] == '\n') + { + if (len > 1) + { + char *tmp_msg = strsave (msg); + tmp_msg[len - 1] = '\0'; + f (id, "%s\n", tmp_msg); + retval = tmp_msg; + delete [] tmp_msg; + } + } + else + { + f (id, "%s", msg); + retval = msg; + } + } + + return retval; +} + +DEFUN (rethrow, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} rethrow (@var{err})\n\ +Reissue a previous error as defined by @var{err}. @var{err} is a structure\n\ +that must contain at least the 'message' and 'identifier' fields. @var{err}\n\ +can also contain a field 'stack' that gives information on the assumed\n\ +location of the error. Typically @var{err} is returned from\n\ +@code{lasterror}.\n\ +@seealso{lasterror, lasterr, error}\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + + if (nargin != 1) + print_usage (); + else + { + const octave_scalar_map err = args(0).scalar_map_value (); + + if (! error_state) + { + if (err.contains ("message") && err.contains ("identifier")) + { + std::string msg = err.contents ("message").string_value (); + std::string id = err.contents ("identifier").string_value (); + int len = msg.length (); + + std::string file; + std::string nm; + int l = -1; + int c = -1; + + octave_map err_stack = initialize_last_error_stack (); + + if (err.contains ("stack")) + { + err_stack = err.contents ("stack").map_value (); + + if (err_stack.numel () > 0) + { + if (err_stack.contains ("file")) + file = err_stack.contents ("file")(0).string_value (); + + if (err_stack.contains ("name")) + nm = err_stack.contents ("name")(0).string_value (); + + if (err_stack.contains ("line")) + l = err_stack.contents ("line")(0).nint_value (); + + if (err_stack.contains ("column")) + c = err_stack.contents ("column")(0).nint_value (); + } + } + + // Ugh. + char *tmp_msg = strsave (msg.c_str ()); + if (tmp_msg[len-1] == '\n') + { + if (len > 1) + { + tmp_msg[len - 1] = '\0'; + rethrow_error (id.c_str (), "%s\n", tmp_msg); + } + } + else + rethrow_error (id.c_str (), "%s", tmp_msg); + delete [] tmp_msg; + + // FIXME -- is this the right thing to do for + // Vlast_error_stack? Should it be saved and restored + // with unwind_protect? + + Vlast_error_stack = err_stack; + + if (err.contains ("stack")) + { + if (file.empty ()) + { + if (nm.empty ()) + { + if (l > 0) + { + if (c > 0) + pr_where_1 ("error: near line %d, column %d", + l, c); + else + pr_where_1 ("error: near line %d", l); + } + } + else + { + if (l > 0) + { + if (c > 0) + pr_where_1 ("error: called from '%s' near line %d, column %d", + nm.c_str (), l, c); + else + pr_where_1 ("error: called from '%d' near line %d", nm.c_str (), l); + } + } + } + else + { + if (nm.empty ()) + { + if (l > 0) + { + if (c > 0) + pr_where_1 ("error: in file %s near line %d, column %d", + file.c_str (), l, c); + else + pr_where_1 ("error: in file %s near line %d", file.c_str (), l); + } + } + else + { + if (l > 0) + { + if (c > 0) + pr_where_1 ("error: called from '%s' in file %s near line %d, column %d", + nm.c_str (), file.c_str (), l, c); + else + pr_where_1 ("error: called from '%d' in file %s near line %d", nm.c_str (), file.c_str (), l); + } + } + } + } + } + else + error ("rethrow: ERR structure must contain the fields 'message and 'identifier'"); + } + } + return retval; +} + +// Determine whether the first argument to error or warning function +// should be handled as the message identifier or as the format string. + +static bool +maybe_extract_message_id (const std::string& caller, + const octave_value_list& args, + octave_value_list& nargs, + std::string& id) +{ + nargs = args; + id = std::string (); + + int nargin = args.length (); + + bool have_fmt = nargin > 1; + + if (nargin > 0) + { + std::string arg1 = args(0).string_value (); + + if (! error_state) + { + // For compatibility with Matlab, an identifier must contain + // ':', but not at the beginning or the end, and it must not + // contain '%' (even if it is not a valid conversion + // operator) or whitespace. + + if (arg1.find_first_of ("% \f\n\r\t\v") == std::string::npos + && arg1.find (':') != std::string::npos + && arg1[0] != ':' + && arg1[arg1.length ()-1] != ':') + { + if (nargin > 1) + { + id = arg1; + + nargs.resize (nargin-1); + + for (int i = 1; i < nargin; i++) + nargs(i-1) = args(i); + } + else + nargs(0) = "call to " + caller + + " with message identifier requires message"; + } + } + } + + return have_fmt; +} + +DEFUN (error, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} error (@var{template}, @dots{})\n\ +@deftypefnx {Built-in Function} {} error (@var{id}, @var{template}, @dots{})\n\ +Format the optional arguments under the control of the template string\n\ +@var{template} using the same rules as the @code{printf} family of\n\ +functions (@pxref{Formatted Output}) and print the resulting message\n\ +on the @code{stderr} stream. The message is prefixed by the character\n\ +string @samp{error: }.\n\ +\n\ +Calling @code{error} also sets Octave's internal error state such that\n\ +control will return to the top level without evaluating any more\n\ +commands. This is useful for aborting from functions or scripts.\n\ +\n\ +If the error message does not end with a new line character, Octave will\n\ +print a traceback of all the function calls leading to the error. For\n\ +example, given the following function definitions:\n\ +\n\ +@example\n\ +@group\n\ +function f () g (); end\n\ +function g () h (); end\n\ +function h () nargin == 1 || error (\"nargin != 1\"); end\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +calling the function @code{f} will result in a list of messages that\n\ +can help you to quickly locate the exact location of the error:\n\ +\n\ +@example\n\ +@group\n\ +f ()\n\ +error: nargin != 1\n\ +error: called from:\n\ +error: error at line -1, column -1\n\ +error: h at line 1, column 27\n\ +error: g at line 1, column 15\n\ +error: f at line 1, column 15\n\ +@end group\n\ +@end example\n\ +\n\ +If the error message ends in a new line character, Octave will print the\n\ +message but will not display any traceback messages as it returns\n\ +control to the top level. For example, modifying the error message\n\ +in the previous example to end in a new line causes Octave to only print\n\ +a single message:\n\ +\n\ +@example\n\ +@group\n\ +function h () nargin == 1 || error (\"nargin != 1\\n\"); end\n\ +f ()\n\ +error: nargin != 1\n\ +@end group\n\ +@end example\n\ +\n\ +A null string (\"\") input to @code{error} will be ignored and the code\n\ +will continue running as if the statement were a NOP@. This is for\n\ +compatibility with @sc{matlab}. It also makes it possible to write code such\n\ +as\n\ +\n\ +@example\n\ +@group\n\ +err_msg = \"\";\n\ +if (CONDITION 1)\n\ + err_msg = \"CONDITION 1 found\";\n\ +elseif (CONDITION2)\n\ + err_msg = \"CONDITION 2 found\";\n\ +@dots{}\n\ +endif\n\ +error (err_msg);\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +which will only stop execution if an error has been found.\n\ +\n\ +Implementation Note: For compatibility with @sc{matlab}, escape\n\ +sequences (e.g., \"\\n\" => newline) are processed in @var{template}\n\ +regardless of whether @var{template} has been defined within single quotes\n\ +as long as there are two or more input arguments.\n\ +Use a second backslash to stop interpolation of the escape sequence (e.g.,\n\ +\"\\\\n\") or use the @code{regexptranslate} function.\n\ +@seealso{warning, lasterror}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + octave_value_list nargs = args; + + std::string id; + + if (nargin == 0) + print_usage (); + else + { + bool have_fmt = false; + + if (nargin == 1 && args(0).is_map ()) + { + // empty struct is not an error. return and resume calling function. + if (args(0).is_empty ()) + return retval; + + octave_value_list tmp; + + octave_scalar_map m = args(0).scalar_map_value (); + + // empty struct is not an error. return and resume calling function. + if (m.nfields () == 0) + return retval; + + if (m.contains ("message")) + { + octave_value c = m.getfield ("message"); + + if (c.is_string ()) + nargs(0) = c.string_value (); + } + + if (m.contains ("identifier")) + { + octave_value c = m.getfield ("identifier"); + + if (c.is_string ()) + id = c.string_value (); + } + + // FIXME -- also need to handle "stack" field in error + // structure, but that will require some more significant + // surgery on handle_message, error_with_id, etc. + } + else + { + have_fmt = maybe_extract_message_id ("error", args, nargs, id); + + if (error_state) + return retval; + } + + handle_message (error_with_id, id.c_str (), "unspecified error", + nargs, have_fmt); + } + + return retval; +} + +static octave_scalar_map +warning_query (const std::string& id_arg) +{ + octave_scalar_map retval; + + std::string id = id_arg; + + if (id == "last") + id = Vlast_warning_id; + + Cell ident = warning_options.contents ("identifier"); + Cell state = warning_options.contents ("state"); + + octave_idx_type nel = ident.numel (); + + bool found = false; + + std::string val; + + for (octave_idx_type i = 0; i < nel; i++) + { + if (ident(i).string_value () == id) + { + val = state(i).string_value (); + found = true; + break; + } + } + + if (! found) + { + for (octave_idx_type i = 0; i < nel; i++) + { + if (ident(i).string_value () == "all") + { + val = state(i).string_value (); + found = true; + break; + } + } + } + + if (found) + { + retval.assign ("identifier", id); + retval.assign ("state", val); + } + else + error ("warning: unable to find default warning state!"); + + return retval; +} + +DEFUN (warning, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} warning (@var{template}, @dots{})\n\ +@deftypefnx {Built-in Function} {} warning (@var{id}, @var{template}, @dots{})\n\ +@deftypefnx {Built-in Function} {} warning (\"on\", @var{id})\n\ +@deftypefnx {Built-in Function} {} warning (\"off\", @var{id})\n\ +@deftypefnx {Built-in Function} {} warning (\"query\", @var{id})\n\ +@deftypefnx {Built-in Function} {} warning (\"error\", @var{id})\n\ +@deftypefnx {Built-in Function} {} warning (@var{state}, @var{id}, \"local\")\n\ +Format the optional arguments under the control of the template string\n\ +@var{template} using the same rules as the @code{printf} family of\n\ +functions (@pxref{Formatted Output}) and print the resulting message\n\ +on the @code{stderr} stream. The message is prefixed by the character\n\ +string @samp{warning: }.\n\ +You should use this function when you want to notify the user\n\ +of an unusual condition, but only when it makes sense for your program\n\ +to go on.\n\ +\n\ +The optional message identifier allows users to enable or disable\n\ +warnings tagged by @var{id}. A message identifier is of the form\n\ +\"NAMESPACE:WARNING-NAME\". Octave's own warnings use the \"Octave\"\n\ +namespace (@pxref{docXwarning_ids}). The special identifier @samp{\"all\"}\n\ +may be used to set the state of all warnings.\n\ +\n\ +If the first argument is @samp{\"on\"} or @samp{\"off\"}, set the state\n\ +of a particular warning using the identifier @var{id}. If the first\n\ +argument is @samp{\"query\"}, query the state of this warning instead.\n\ +If the identifier is omitted, a value of @samp{\"all\"} is assumed. If\n\ +you set the state of a warning to @samp{\"error\"}, the warning named by\n\ +@var{id} is handled as if it were an error instead. So, for example, the\n\ +following handles all warnings as errors:\n\ +\n\ +@example\n\ +@group\n\ +warning (\"error\");\n\ +@end group\n\ +@end example\n\ +\n\ +If the state is @samp{\"on\"}, @samp{\"off\"}, or @samp{\"error\"}\n\ +and the third argument is @samp{\"local\"}, then the warning state\n\ +will be set temporarily, until the end of the current function.\n\ +Changes to warning states that are set locally affect the current\n\ +function and all functions called from the current scope. The\n\ +previous warning state is restored on return from the current\n\ +function. The \"local\" option is ignored if used in the top-level\n\ +workspace.\n\ +\n\ +Implementation Note: For compatibility with @sc{matlab}, escape\n\ +sequences (e.g., \"\\n\" => newline) are processed in @var{template}\n\ +regardless of whether @var{template} has been defined within single quotes\n\ +as long as there are two or more input arguments.\n\ +Use a second backslash to stop interpolation of the escape sequence (e.g.,\n\ +\"\\\\n\") or use the @code{regexptranslate} function.\n\ +@seealso{warning_ids, lastwarn, error}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + int argc = nargin + 1; + + bool done = false; + + if (argc > 1 && args.all_strings_p ()) + { + string_vector argv = args.make_argv ("warning"); + + if (! error_state) + { + std::string arg1 = argv(1); + std::string arg2 = "all"; + + if (argc >= 3) + arg2 = argv(2); + + if (arg1 == "on" || arg1 == "off" || arg1 == "error") + { + octave_map old_warning_options = warning_options; + + if (argc == 4 && argv(3) == "local" + && ! symbol_table::at_top_level ()) + { + symbol_table::scope_id scope + = octave_call_stack::current_scope (); + + symbol_table::context_id context + = octave_call_stack::current_context (); + + octave_scalar_map val = warning_query (arg2); + + octave_value curr_state = val.contents ("state"); + + // FIXME -- this might be better with a dictionary + // object. + + octave_value curr_warning_states + = symbol_table::varval (".saved_warning_states.", + scope, context); + + octave_map m; + + if (curr_warning_states.is_defined ()) + m = curr_warning_states.map_value (); + else + { + string_vector fields (2); + + fields(0) = "identifier"; + fields(1) = "state"; + + m = octave_map (dim_vector (0, 1), fields); + } + + if (error_state) + panic_impossible (); + + Cell ids = m.contents ("identifier"); + Cell states = m.contents ("state"); + + octave_idx_type nel = states.numel (); + bool found = false; + octave_idx_type i; + for (i = 0; i < nel; i++) + { + std::string id = ids(i).string_value (); + + if (error_state) + panic_impossible (); + + if (id == arg2) + { + states(i) = curr_state; + found = true; + break; + } + } + + if (! found) + { + m.resize (dim_vector (nel+1, 1)); + + ids.resize (dim_vector (nel+1, 1)); + states.resize (dim_vector (nel+1, 1)); + + ids(nel) = arg2; + states(nel) = curr_state; + } + + m.contents ("identifier") = ids; + m.contents ("state") = states; + + symbol_table::assign + (".saved_warning_states.", m, scope, context); + + // Now ignore the "local" argument and continue to + // handle the current setting. + argc--; + } + + if (arg2 == "all") + { + octave_map tmp; + + Cell id (1, 1); + Cell st (1, 1); + + id(0) = arg2; + st(0) = arg1; + + // Since internal Octave functions are not + // compatible, turning all warnings into errors + // should leave the state of + // Octave:matlab-incompatible alone. + + if (arg1 == "error" + && warning_options.contains ("identifier")) + { + octave_idx_type n = 1; + + Cell tid = warning_options.contents ("identifier"); + Cell tst = warning_options.contents ("state"); + + for (octave_idx_type i = 0; i < tid.numel (); i++) + { + octave_value vid = tid(i); + + if (vid.is_string ()) + { + std::string key = vid.string_value (); + + if (key == "Octave:matlab-incompatible" + || key == "Octave:single-quote-string") + { + id.resize (dim_vector (1, n+1)); + st.resize (dim_vector (1, n+1)); + + id(n) = tid(i); + st(n) = tst(i); + + n++; + } + } + } + } + + tmp.assign ("identifier", id); + tmp.assign ("state", st); + + warning_options = tmp; + + done = true; + } + else if (arg2 == "backtrace") + { + if (arg1 != "error") + { + Vbacktrace_on_warning = (arg1 == "on"); + done = true; + } + } + else if (arg2 == "debug") + { + if (arg1 != "error") + { + Vdebug_on_warning = (arg1 == "on"); + done = true; + } + } + else if (arg2 == "verbose") + { + if (arg1 != "error") + { + Vverbose_warning = (arg1 == "on"); + done = true; + } + } + else if (arg2 == "quiet") + { + if (arg1 != "error") + { + Vquiet_warning = (arg1 == "on"); + done = true; + } + } + else + { + if (arg2 == "last") + arg2 = Vlast_warning_id; + + if (arg2 == "all") + initialize_warning_options (arg1); + else + { + Cell ident = warning_options.contents ("identifier"); + Cell state = warning_options.contents ("state"); + + octave_idx_type nel = ident.numel (); + + bool found = false; + + for (octave_idx_type i = 0; i < nel; i++) + { + if (ident(i).string_value () == arg2) + { + // FIXME -- if state for "all" is + // same as arg1, we can simply remove the + // item from the list. + + state(i) = arg1; + warning_options.assign ("state", state); + found = true; + break; + } + } + + if (! found) + { + // FIXME -- if state for "all" is + // same as arg1, we don't need to do anything. + + ident.resize (dim_vector (1, nel+1)); + state.resize (dim_vector (1, nel+1)); + + ident(nel) = arg2; + state(nel) = arg1; + + warning_options.clear (); + + warning_options.assign ("identifier", ident); + warning_options.assign ("state", state); + } + } + + done = true; + } + + if (done && nargout > 0) + retval = old_warning_options; + } + else if (arg1 == "query") + { + if (arg2 == "all") + retval = warning_options; + else if (arg2 == "backtrace" || arg2 == "debug" + || arg2 == "verbose" || arg2 == "quiet") + { + octave_scalar_map tmp; + tmp.assign ("identifier", arg2); + if (arg2 == "backtrace") + tmp.assign ("state", Vbacktrace_on_warning ? "on" : "off"); + else if (arg2 == "debug") + tmp.assign ("state", Vdebug_on_warning ? "on" : "off"); + else if (arg2 == "verbose") + tmp.assign ("state", Vverbose_warning ? "on" : "off"); + else + tmp.assign ("state", Vquiet_warning ? "on" : "off"); + + retval = tmp; + } + else + retval = warning_query (arg2); + + done = true; + } + } + } + else if (argc == 1) + { + retval = warning_options; + + done = true; + } + else if (argc == 2) + { + octave_value arg = args(0); + + octave_map old_warning_options = warning_options; + + if (arg.is_map ()) + { + octave_map m = arg.map_value (); + + if (m.contains ("identifier") && m.contains ("state")) + warning_options = m; + else + error ("warning: expecting structure with fields 'identifier' and 'state'"); + + done = true; + + if (nargout > 0) + retval = old_warning_options; + } + } + + if (! (error_state || done)) + { + octave_value_list nargs = args; + + std::string id; + + bool have_fmt = maybe_extract_message_id ("warning", args, nargs, id); + + if (error_state) + return retval; + + std::string prev_msg = Vlast_warning_message; + + std::string curr_msg = handle_message (warning_with_id, id.c_str (), + "unspecified warning", nargs, + have_fmt); + + if (nargout > 0) + retval = prev_msg; + } + + return retval; +} + +octave_value_list +set_warning_state (const std::string& id, const std::string& state) +{ + octave_value_list args; + + args(1) = id; + args(0) = state; + + return Fwarning (args, 1); +} + +octave_value_list +set_warning_state (const octave_value_list& args) +{ + return Fwarning (args, 1); +} + +void +disable_warning (const std::string& id) +{ + set_warning_state (id, "off"); +} + +void +initialize_default_warning_state (void) +{ + initialize_warning_options ("on"); + + // Most people will want to have the following disabled. + + disable_warning ("Octave:array-to-scalar"); + disable_warning ("Octave:array-to-vector"); + disable_warning ("Octave:imag-to-real"); + disable_warning ("Octave:matlab-incompatible"); + disable_warning ("Octave:missing-semicolon"); + disable_warning ("Octave:neg-dim-as-zero"); + disable_warning ("Octave:resize-on-range-error"); + disable_warning ("Octave:separator-insert"); + disable_warning ("Octave:single-quote-string"); + disable_warning ("Octave:str-to-num"); + disable_warning ("Octave:mixed-string-concat"); + disable_warning ("Octave:variable-switch-label"); + + // This should be an error unless we are in maximum braindamage mode. + // FIXME: Not quite right. This sets the error state even for braindamage + // mode. Also, this error is not triggered in normal mode because another + // error handler catches it first and gives: + // error: subscript indices must be either positive integers or logicals + set_warning_state ("Octave:noninteger-range-as-index", "error"); + +} + +DEFUN (lasterror, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{lasterr} =} lasterror ()\n\ +@deftypefnx {Built-in Function} {} lasterror (@var{err})\n\ +@deftypefnx {Built-in Function} {} lasterror (\"reset\")\n\ +Query or set the last error message structure. When called without\n\ +arguments, return a structure containing the last error message and other\n\ +information related to this error. The elements of the structure are:\n\ +\n\ +@table @asis\n\ +@item 'message'\n\ +The text of the last error message\n\ +\n\ +@item 'identifier'\n\ +The message identifier of this error message\n\ +\n\ +@item 'stack'\n\ +A structure containing information on where the message occurred. This may\n\ +be an empty structure if the information cannot\n\ +be obtained. The fields of the structure are:\n\ +\n\ +@table @asis\n\ +@item 'file'\n\ +The name of the file where the error occurred\n\ +\n\ +@item 'name'\n\ +The name of function in which the error occurred\n\ +\n\ +@item 'line'\n\ +The line number at which the error occurred\n\ +\n\ +@item 'column'\n\ +An optional field with the column number at which the error occurred\n\ +@end table\n\ +@end table\n\ +\n\ +The last error structure may be set by passing a scalar structure, @var{err},\n\ +as input. Any fields of @var{err} that match those above are set while any\n\ +unspecified fields are initialized with default values.\n\ +\n\ +If @code{lasterror} is called with the argument \"reset\", all fields are\n\ +set to their default values.\n\ +@seealso{lasterr, error, lastwarn}\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + + unwind_protect frame; + + frame.protect_var (error_state); + error_state = 0; + + if (nargin < 2) + { + octave_scalar_map err; + + err.assign ("message", Vlast_error_message); + err.assign ("identifier", Vlast_error_id); + + err.assign ("stack", octave_value (Vlast_error_stack)); + + if (nargin == 1) + { + if (args(0).is_string ()) + { + if (args(0).string_value () == "reset") + { + Vlast_error_message = std::string (); + Vlast_error_id = std::string (); + + Vlast_error_stack = initialize_last_error_stack (); + } + else + error ("lasterror: unrecognized string argument"); + } + else if (args(0).is_map ()) + { + octave_scalar_map new_err = args(0).scalar_map_value (); + octave_scalar_map new_err_stack; + std::string new_error_message; + std::string new_error_id; + std::string new_error_file; + std::string new_error_name; + int new_error_line = -1; + int new_error_column = -1; + + if (! error_state && new_err.contains ("message")) + { + const std::string tmp = + new_err.getfield ("message").string_value (); + new_error_message = tmp; + } + + if (! error_state && new_err.contains ("identifier")) + { + const std::string tmp = + new_err.getfield ("identifier").string_value (); + new_error_id = tmp; + } + + if (! error_state && new_err.contains ("stack")) + { + new_err_stack = + new_err.getfield ("stack").scalar_map_value (); + + if (! error_state && new_err_stack.contains ("file")) + { + const std::string tmp = + new_err_stack.getfield ("file").string_value (); + new_error_file = tmp; + } + + if (! error_state && new_err_stack.contains ("name")) + { + const std::string tmp = + new_err_stack.getfield ("name").string_value (); + new_error_name = tmp; + } + + if (! error_state && new_err_stack.contains ("line")) + { + const int tmp = + new_err_stack.getfield ("line").nint_value (); + new_error_line = tmp; + } + + if (! error_state && new_err_stack.contains ("column")) + { + const int tmp = + new_err_stack.getfield ("column").nint_value (); + new_error_column = tmp; + } + } + + if (! error_state) + { + Vlast_error_message = new_error_message; + Vlast_error_id = new_error_id; + + if (new_err.contains ("stack")) + { + new_err_stack.setfield ("file", new_error_file); + new_err_stack.setfield ("name", new_error_name); + new_err_stack.setfield ("line", new_error_line); + new_err_stack.setfield ("column", new_error_column); + Vlast_error_stack = new_err_stack; + } + else + { + // No stack field. Fill it in with backtrace info. + octave_idx_type curr_frame = -1; + + Vlast_error_stack + = octave_call_stack::backtrace (0, curr_frame); + } + } + } + else + error ("lasterror: argument must be a structure or a string"); + } + + if (! error_state) + retval = err; + } + else + print_usage (); + + return retval; +} + +DEFUN (lasterr, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{msg}, @var{msgid}] =} lasterr ()\n\ +@deftypefnx {Built-in Function} {} lasterr (@var{msg})\n\ +@deftypefnx {Built-in Function} {} lasterr (@var{msg}, @var{msgid})\n\ +Query or set the last error message. When called without input arguments,\n\ +return the last error message and message identifier. With one\n\ +argument, set the last error message to @var{msg}. With two arguments,\n\ +also set the last message identifier.\n\ +@seealso{lasterror, error, lastwarn}\n\ +@end deftypefn") +{ + octave_value_list retval; + + unwind_protect frame; + + frame.protect_var (error_state); + error_state = 0; + + int argc = args.length () + 1; + + if (argc < 4) + { + string_vector argv = args.make_argv ("lasterr"); + + if (! error_state) + { + std::string prev_error_id = Vlast_error_id; + std::string prev_error_message = Vlast_error_message; + + if (argc > 2) + Vlast_error_id = argv(2); + + if (argc > 1) + Vlast_error_message = argv(1); + + if (argc == 1 || nargout > 0) + { + retval(1) = prev_error_id; + retval(0) = prev_error_message; + } + } + else + error ("lasterr: expecting arguments to be character strings"); + } + else + print_usage (); + + return retval; +} + +DEFUN (lastwarn, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{msg}, @var{msgid}] =} lastwarn ()\n\ +@deftypefnx {Built-in Function} {} lastwarn (@var{msg})\n\ +@deftypefnx {Built-in Function} {} lastwarn (@var{msg}, @var{msgid})\n\ +Query or set the last warning message. When called without input arguments,\n\ +return the last warning message and message identifier. With one\n\ +argument, set the last warning message to @var{msg}. With two arguments,\n\ +also set the last message identifier.\n\ +@seealso{warning, lasterror, lasterr}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + if (argc < 4) + { + string_vector argv = args.make_argv ("lastwarn"); + + if (! error_state) + { + std::string prev_warning_id = Vlast_warning_id; + std::string prev_warning_message = Vlast_warning_message; + + if (argc > 2) + Vlast_warning_id = argv(2); + + if (argc > 1) + Vlast_warning_message = argv(1); + + if (argc == 1 || nargout > 0) + { + warning_state = 0; + retval(1) = prev_warning_id; + retval(0) = prev_warning_message; + } + } + else + error ("lastwarn: expecting arguments to be character strings"); + } + else + print_usage (); + + return retval; +} + +DEFUN (usage, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} usage (@var{msg})\n\ +Print the message @var{msg}, prefixed by the string @samp{usage: }, and\n\ +set Octave's internal error state such that control will return to the\n\ +top level without evaluating any more commands. This is useful for\n\ +aborting from functions.\n\ +\n\ +After @code{usage} is evaluated, Octave will print a traceback of all\n\ +the function calls leading to the usage message.\n\ +\n\ +You should use this function for reporting problems errors that result\n\ +from an improper call to a function, such as calling a function with an\n\ +incorrect number of arguments, or with arguments of the wrong type. For\n\ +example, most functions distributed with Octave begin with code like\n\ +this\n\ +\n\ +@example\n\ +@group\n\ +if (nargin != 2)\n\ + usage (\"foo (a, b)\");\n\ +endif\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +to check for the proper number of arguments.\n\ +@end deftypefn") +{ + octave_value_list retval; + handle_message (usage_with_id, "", "unknown", args, true); + return retval; +} + +DEFUN (beep_on_error, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} beep_on_error ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} beep_on_error (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} beep_on_error (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave will try\n\ +to ring the terminal bell before printing an error message.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (beep_on_error); +} + +DEFUN (debug_on_error, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} debug_on_error ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} debug_on_error (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} debug_on_error (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave will try\n\ +to enter the debugger when an error is encountered. This will also\n\ +inhibit printing of the normal traceback message (you will only see\n\ +the top-level error message).\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{debug_on_warning, debug_on_interrupt}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (debug_on_error); +} + +DEFUN (debug_on_warning, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} debug_on_warning ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} debug_on_warning (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} debug_on_warning (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave will try\n\ +to enter the debugger when a warning is encountered.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{debug_on_error, debug_on_interrupt}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (debug_on_warning); +} + +std::string +last_error_message (void) +{ + return Vlast_error_message; +} + +std::string +last_error_id (void) +{ + return Vlast_error_id; +} + +std::string +last_warning_message (void) +{ + return Vlast_warning_message; +} + +std::string +last_warning_id (void) +{ + return Vlast_warning_id; +} + +void +interpreter_try (unwind_protect& frame) +{ + frame.protect_var (error_state); + frame.protect_var (buffer_error_messages); + frame.protect_var (Vdebug_on_error); + frame.protect_var (Vdebug_on_warning); + + buffer_error_messages++; + Vdebug_on_error = false; + Vdebug_on_warning = false; +} + + diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/error.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/error.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,142 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_error_h) +#define octave_error_h 1 + +#include +#include + +class octave_value_list; +class unwind_protect; + +#define panic_impossible() \ + panic ("impossible state reached in file '%s' at line %d", \ + __FILE__, __LINE__) + +extern OCTINTERP_API void reset_error_handler (void); + +extern OCTINTERP_API int warning_enabled (const std::string& id); + +extern OCTINTERP_API void vmessage (const char *name, const char *fmt, va_list args); +extern OCTINTERP_API void message (const char *name, const char *fmt, ...); + +extern OCTINTERP_API void vusage (const char *fmt, va_list args); +extern OCTINTERP_API void usage (const char *fmt, ...); + +extern OCTINTERP_API void vwarning (const char *fmt, va_list args); +extern OCTINTERP_API void warning (const char *fmt, ...); + +extern OCTINTERP_API void verror (const char *fmt, va_list args); +extern OCTINTERP_API void error (const char *fmt, ...); + +extern OCTINTERP_API void verror_with_cfn (const char *fmt, va_list args); +extern OCTINTERP_API void error_with_cfn (const char *fmt, ...); + +extern OCTINTERP_API void vparse_error (const char *fmt, va_list args); +extern OCTINTERP_API void parse_error (const char *fmt, ...); + +extern OCTINTERP_API void +vmessage_with_id (const char *id, const char *name, const char *fmt, va_list args); + +extern OCTINTERP_API void +message_with_id (const char *id, const char *name, const char *fmt, ...); + +extern OCTINTERP_API void +vusage_with_id (const char *id, const char *fmt, va_list args); + +extern OCTINTERP_API void +usage_with_id (const char *id, const char *fmt, ...); + +extern OCTINTERP_API void +vwarning_with_id (const char *id, const char *fmt, va_list args); + +extern OCTINTERP_API void +warning_with_id (const char *id, const char *fmt, ...); + +extern OCTINTERP_API void +verror_with_id (const char *id, const char *fmt, va_list args); + +extern OCTINTERP_API void +error_with_id (const char *id, const char *fmt, ...); + +extern OCTINTERP_API void +verror_with_id_cfn (const char *id, const char *fmt, va_list args); + +extern OCTINTERP_API void +error_with_id_cfn (const char *id, const char *fmt, ...); + +extern OCTINTERP_API void +vparse_error_with_id (const char *id, const char *fmt, va_list args); + +extern OCTINTERP_API void +parse_error_with_id (const char *id, const char *fmt, ...); + +extern OCTINTERP_API void panic (const char *fmt, ...) GCC_ATTR_NORETURN; + +// Helper function for print_usage defined in defun.cc. +extern OCTINTERP_API void defun_usage_message (const std::string& msg); + +extern OCTINTERP_API octave_value_list +set_warning_state (const std::string& id, const std::string& state); + +extern OCTINTERP_API octave_value_list +set_warning_state (const octave_value_list& args); + +extern OCTINTERP_API void disable_warning (const std::string& id); +extern OCTINTERP_API void initialize_default_warning_state (void); + +// TRUE means that Octave will try to enter the debugger when an error +// is encountered. This will also inhibit printing of the normal +// traceback message (you will only see the top-level error message). +extern OCTINTERP_API bool Vdebug_on_error; + +// TRUE means that Octave will try to enter the debugger when a warning +// is encountered. +extern OCTINTERP_API bool Vdebug_on_warning; + +// Current error state. +extern OCTINTERP_API int error_state; + +// Current warning state. +extern OCTINTERP_API int warning_state; + +// Tell the error handler whether to print messages, or just store +// them for later. Used for handling errors in eval() and +// the 'unwind_protect' statement. +extern OCTINTERP_API int buffer_error_messages; + +// TRUE means error messages are turned off. +extern OCTINTERP_API bool discard_error_messages; + +// TRUE means warning messages are turned off. +extern OCTINTERP_API bool discard_warning_messages; + +// Helper functions to pass last error and warning messages and ids +extern OCTINTERP_API std::string last_error_message (void); +extern OCTINTERP_API std::string last_error_id (void); +extern OCTINTERP_API std::string last_warning_message (void); +extern OCTINTERP_API std::string last_warning_id (void); + +extern OCTINTERP_API void interpreter_try (unwind_protect&); + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/event-queue.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/event-queue.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,125 @@ +/* + +Copyright (C) 2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_event_queue_h) +#define octave_event_queue_h 1 + +#include +#include + +#include "action-container.h" + +class +event_queue : public action_container +{ +public: + + event_queue (void) : fifo () { } + + // Destructor should not raise an exception, so all actions + // registered should be exception-safe (but setting error_state is + // allowed). If you're not sure, see event_queue_safe. + + ~event_queue (void) { run (); } + + void add (elem *new_elem) + { + fifo.push (new_elem); + } + + void run_first (void) + { + if (! empty ()) + { + // No leak on exception! + std::auto_ptr ptr (fifo.front ()); + fifo.pop (); + ptr->run (); + } + } + + void discard_first (void) + { + if (! empty ()) + { + elem *ptr = fifo.front (); + fifo.pop (); + delete ptr; + } + } + + size_t size (void) const { return fifo.size (); } + +protected: + + std::queue fifo; + +private: + + // No copying! + + event_queue (const event_queue&); + + event_queue& operator = (const event_queue&); +}; + +// Like event_queue, but this one will guard against the +// possibility of seeing an exception (or interrupt) in the cleanup +// actions. Not that we can do much about it, but at least we won't +// crash. + +class +event_queue_safe : public event_queue +{ +private: + + static void gripe_exception (void); + +public: + + event_queue_safe (void) : event_queue () { } + + ~event_queue_safe (void) + { + while (! empty ()) + { + try + { + run_first (); + } + catch (...) // Yes, the black hole. Remember we're in a dtor. + { + gripe_exception (); + } + } + } + +private: + + // No copying! + + event_queue_safe (const event_queue_safe&); + + event_queue_safe& operator = (const event_queue_safe&); +}; + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/file-io.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/file-io.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,2308 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Originally written by John C. Campbell +// +// Thomas Baier added the original versions of +// the following functions: +// +// popen +// pclose +// execute (now popen2.m) +// sync_system (now merged with system) +// async_system (now merged with system) + +// Extensively revised by John W. Eaton , +// April 1996. + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include +#include +#include +#include + +#include +#include +#include + +#ifdef HAVE_ZLIB_H +#include +#endif + +#include "error.h" +#include "file-ops.h" +#include "file-stat.h" +#include "lo-ieee.h" +#include "oct-env.h" +#include "oct-locbuf.h" + +#include "defun.h" +#include "file-io.h" +#include "load-path.h" +#include "oct-fstrm.h" +#include "oct-iostrm.h" +#include "oct-map.h" +#include "oct-obj.h" +#include "oct-prcstrm.h" +#include "oct-stream.h" +#include "oct-strstrm.h" +#include "pager.h" +#include "sysdep.h" +#include "utils.h" +#include "variables.h" + +static octave_value stdin_file; +static octave_value stdout_file; +static octave_value stderr_file; + +static octave_stream stdin_stream; +static octave_stream stdout_stream; +static octave_stream stderr_stream; + +void +initialize_file_io (void) +{ + stdin_stream = octave_istream::create (&std::cin, "stdin"); + + // This uses octave_stdout (see pager.h), not std::cout so that Octave's + // standard output stream will pass through the pager. + + stdout_stream = octave_ostream::create (&octave_stdout, "stdout"); + + stderr_stream = octave_ostream::create (&std::cerr, "stderr"); + + stdin_file = octave_stream_list::insert (stdin_stream); + stdout_file = octave_stream_list::insert (stdout_stream); + stderr_file = octave_stream_list::insert (stderr_stream); +} + +void +close_files (void) +{ + octave_stream_list::clear (); +} + +// List of files to delete when we exit or crash. +// +// FIXME -- this should really be static, but that causes +// problems on some systems. +std::stack tmp_files; + +void +mark_for_deletion (const std::string& file) +{ + tmp_files.push (file); +} + +void +cleanup_tmp_files (void) +{ + while (! tmp_files.empty ()) + { + std::string filename = tmp_files.top (); + tmp_files.pop (); + gnulib::unlink (filename.c_str ()); + } +} + +static void +normalize_fopen_mode (std::string& mode, bool& use_zlib) +{ + use_zlib = false; + + if (! mode.empty ()) + { + // Could probably be faster, but does it really matter? + + // Accept 'W', 'R', and 'A' as 'w', 'r', and 'a' but we warn about + // them because Matlab says they don't perform "automatic + // flushing" but we don't know precisely what action that implies. + + size_t pos = mode.find ('W'); + + if (pos != std::string::npos) + { + warning_with_id ("Octave:fopen-mode", + "fopen: treating mode \"W\" as equivalent to \"w\""); + mode[pos] = 'w'; + } + + pos = mode.find ('R'); + + if (pos != std::string::npos) + { + warning_with_id ("Octave:fopen-mode", + "fopen: treating mode \"R\" as equivalent to \"r\""); + mode[pos] = 'r'; + } + + pos = mode.find ('A'); + + if (pos != std::string::npos) + { + warning_with_id ("Octave:fopen-mode", + "fopen: treating mode \"A\" as equivalent to \"a\""); + mode[pos] = 'a'; + } + + pos = mode.find ('z'); + + if (pos != std::string::npos) + { +#if defined (HAVE_ZLIB) + use_zlib = true; + mode.erase (pos, 1); +#else + error ("this version of Octave does not support gzipped files"); +#endif + } + + if (! error_state) + { + // Use binary mode if 't' is not specified, but don't add + // 'b' if it is already present. + + size_t bpos = mode.find ('b'); + size_t tpos = mode.find ('t'); + + if (bpos == std::string::npos && tpos == std::string::npos) + mode += 'b'; + } + } +} + +static std::ios::openmode +fopen_mode_to_ios_mode (const std::string& mode) +{ + std::ios::openmode retval = std::ios::in; + + if (! error_state) + { + if (mode == "rt") + retval = std::ios::in; + else if (mode == "wt") + retval = std::ios::out | std::ios::trunc; + else if (mode == "at") + retval = std::ios::out | std::ios::app; + else if (mode == "r+t" || mode == "rt+") + retval = std::ios::in | std::ios::out; + else if (mode == "w+t" || mode == "wt+") + retval = std::ios::in | std::ios::out | std::ios::trunc; + else if (mode == "a+t" || mode == "at+") + retval = std::ios::in | std::ios::out | std::ios::app; + else if (mode == "rb" || mode == "r") + retval = std::ios::in | std::ios::binary; + else if (mode == "wb" || mode == "w") + retval = std::ios::out | std::ios::trunc | std::ios::binary; + else if (mode == "ab" || mode == "a") + retval = std::ios::out | std::ios::app | std::ios::binary; + else if (mode == "r+b" || mode == "rb+" || mode == "r+") + retval = std::ios::in | std::ios::out | std::ios::binary; + else if (mode == "w+b" || mode == "wb+" || mode == "w+") + retval = (std::ios::in | std::ios::out | std::ios::trunc + | std::ios::binary); + else if (mode == "a+b" || mode == "ab+" || mode == "a+") + retval = (std::ios::in | std::ios::out | std::ios::app + | std::ios::binary); + else + ::error ("invalid mode specified"); + } + + return retval; +} + +DEFUN (fclose, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} fclose (@var{fid})\n\ +@deftypefnx {Built-in Function} {} fclose (\"all\")\n\ +Close the specified file. If successful, @code{fclose} returns 0,\n\ +otherwise, it returns -1. The second form of the @code{fclose} call closes\n\ +all open files except @code{stdout}, @code{stderr}, and @code{stdin}.\n\ +@seealso{fopen, freport}\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 1) + retval = octave_stream_list::remove (args(0), "fclose"); + else + print_usage (); + + return retval; +} + +DEFUN (fclear, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} fclear (@var{fid})\n\ +Clear the stream state for the specified file.\n\ +@seealso{fopen}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + int fid = octave_stream_list::get_file_number (args (0)); + + octave_stream os = octave_stream_list::lookup (fid, "fclear"); + + if (! error_state) + os.clearerr (); + } + else + print_usage (); + + return retval; +} + +DEFUN (fflush, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} fflush (@var{fid})\n\ +Flush output to @var{fid}. This is useful for ensuring that all\n\ +pending output makes it to the screen before some other event occurs.\n\ +For example, it is always a good idea to flush the standard output\n\ +stream before calling @code{input}.\n\ +\n\ +@code{fflush} returns 0 on success and an OS dependent error value\n\ +(@minus{}1 on Unix) on error.\n\ +@seealso{fopen, fclose}\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 1) + { + // FIXME -- any way to avoid special case for stdout? + + int fid = octave_stream_list::get_file_number (args (0)); + + if (fid == 1) + { + flush_octave_stdout (); + + retval = 0; + } + else + { + octave_stream os = octave_stream_list::lookup (fid, "fflush"); + + if (! error_state) + retval = os.flush (); + } + } + else + print_usage (); + + return retval; +} + +DEFUN (fgetl, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{str} =} fgetl (@var{fid})\n\ +@deftypefnx {Built-in Function} {@var{str} =} fgetl (@var{fid}, @var{len})\n\ +Read characters from a file, stopping after a newline, or EOF,\n\ +or @var{len} characters have been read. The characters read, excluding\n\ +the possible trailing newline, are returned as a string.\n\ +\n\ +If @var{len} is omitted, @code{fgetl} reads until the next newline\n\ +character.\n\ +\n\ +If there are no more characters to read, @code{fgetl} returns @minus{}1.\n\ +\n\ +To read a line and return the terminating newline see @code{fgets}.\n\ +@seealso{fgets, fscanf, fread, fopen}\n\ +@end deftypefn") +{ + static std::string who = "fgetl"; + + octave_value_list retval; + + retval(1) = 0; + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + octave_stream os = octave_stream_list::lookup (args(0), who); + + if (! error_state) + { + octave_value len_arg = (nargin == 2) ? args(1) : octave_value (); + + bool err = false; + + std::string tmp = os.getl (len_arg, err, who); + + if (! (error_state || err)) + { + retval(1) = tmp.length (); + retval(0) = tmp; + } + } + } + else + print_usage (); + + return retval; +} + +DEFUN (fgets, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{str} =} fgets (@var{fid})\n\ +@deftypefnx {Built-in Function} {@var{str} =} fgets (@var{fid}, @var{len})\n\ +Read characters from a file, stopping after a newline, or EOF,\n\ +or @var{len} characters have been read. The characters read, including\n\ +the possible trailing newline, are returned as a string.\n\ +\n\ +If @var{len} is omitted, @code{fgets} reads until the next newline\n\ +character.\n\ +\n\ +If there are no more characters to read, @code{fgets} returns @minus{}1.\n\ +\n\ +To read a line and discard the terminating newline see @code{fgetl}.\n\ +@seealso{fputs, fgetl, fscanf, fread, fopen}\n\ +@end deftypefn") +{ + static std::string who = "fgets"; + + octave_value_list retval; + + retval(1) = 0.0; + retval(0) = -1.0; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + octave_stream os = octave_stream_list::lookup (args(0), who); + + if (! error_state) + { + octave_value len_arg = (nargin == 2) ? args(1) : octave_value (); + + bool err = false; + + std::string tmp = os.gets (len_arg, err, who); + + if (! (error_state || err)) + { + retval(1) = tmp.length (); + retval(0) = tmp; + } + } + } + else + print_usage (); + + return retval; +} + +DEFUN (fskipl, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{nlines} =} fskipl (@var{fid})\n\ +@deftypefnx {Built-in Function} {@var{nlines} =} fskipl (@var{fid}, @var{count})\n\ +@deftypefnx {Built-in Function} {@var{nlines} =} fskipl (@var{fid}, Inf)\n\ +Read and skip @var{count} lines from the file descriptor @var{fid}.\n\ +@code{fskipl} discards characters until an end-of-line is encountered exactly\n\ +@var{count}-times, or until the end-of-file marker is found.\n\ +\n\ +If @var{count} is omitted, it defaults to 1. @var{count} may also be\n\ +@code{Inf}, in which case lines are skipped until the end of the file.\n\ +This form is suitable for counting the number of lines in a file.\n\ +\n\ +Returns the number of lines skipped (end-of-line sequences encountered).\n\ +@seealso{fgetl, fgets, fscanf, fopen}\n\ +@end deftypefn") +{ + static std::string who = "fskipl"; + + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + octave_stream os = octave_stream_list::lookup (args(0), who); + + if (! error_state) + { + octave_value count_arg = (nargin == 2) ? args(1) : octave_value (); + + bool err = false; + + off_t tmp = os.skipl (count_arg, err, who); + + if (! (error_state || err)) + retval = tmp; + } + } + else + print_usage (); + + return retval; +} + + +static octave_stream +do_stream_open (const std::string& name, const std::string& mode_arg, + const std::string& arch, int& fid) +{ + octave_stream retval; + + fid = -1; + + std::string mode = mode_arg; + bool use_zlib = false; + normalize_fopen_mode (mode, use_zlib); + + std::ios::openmode md = fopen_mode_to_ios_mode (mode); + + if (! error_state) + { + oct_mach_info::float_format flt_fmt = + oct_mach_info::string_to_float_format (arch); + + if (! error_state) + { + std::string fname = file_ops::tilde_expand (name); + + file_stat fs (fname); + + if (! (md & std::ios::out + || octave_env::absolute_pathname (fname) + || octave_env::rooted_relative_pathname (fname))) + { + if (! fs.exists ()) + { + std::string tmp + = octave_env::make_absolute (load_path::find_file (fname)); + + if (! tmp.empty ()) + { + warning_with_id ("Octave:fopen-file-in-path", + "fopen: file found in load path"); + fname = tmp; + } + } + } + + if (! fs.is_dir ()) + { +#if defined (HAVE_ZLIB) + if (use_zlib) + { + FILE *fptr = gnulib::fopen (fname.c_str (), mode.c_str ()); + + int fd = fileno (fptr); + + gzFile gzf = ::gzdopen (fd, mode.c_str ()); + + if (fptr) + retval = octave_zstdiostream::create (fname, gzf, fd, + md, flt_fmt); + else + retval.error (gnulib::strerror (errno)); + } + else +#endif + { + FILE *fptr = gnulib::fopen (fname.c_str (), mode.c_str ()); + + retval = octave_stdiostream::create (fname, fptr, md, flt_fmt); + + if (! fptr) + retval.error (gnulib::strerror (errno)); + } + + } + } + } + + return retval; +} + +static octave_stream +do_stream_open (const octave_value& tc_name, const octave_value& tc_mode, + const octave_value& tc_arch, const char *fcn, int& fid) +{ + octave_stream retval; + + fid = -1; + + std::string name = tc_name.string_value (); + + if (! error_state) + { + std::string mode = tc_mode.string_value (); + + if (! error_state) + { + std::string arch = tc_arch.string_value (); + + if (! error_state) + retval = do_stream_open (name, mode, arch, fid); + else + ::error ("%s: architecture type must be a string", fcn); + } + else + ::error ("%s: file mode must be a string", fcn); + } + else + ::error ("%s: file name must be a string", fcn); + + return retval; +} + +DEFUN (fopen, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{fid}, @var{msg}] =} fopen (@var{name}, @var{mode}, @var{arch})\n\ +@deftypefnx {Built-in Function} {@var{fid_list} =} fopen (\"all\")\n\ +@deftypefnx {Built-in Function} {[@var{file}, @var{mode}, @var{arch}] =} fopen (@var{fid})\n\ +The first form of the @code{fopen} function opens the named file with\n\ +the specified mode (read-write, read-only, etc.) and architecture\n\ +interpretation (IEEE big endian, IEEE little endian, etc.), and returns\n\ +an integer value that may be used to refer to the file later. If an\n\ +error occurs, @var{fid} is set to @minus{}1 and @var{msg} contains the\n\ +corresponding system error message. The @var{mode} is a one or two\n\ +character string that specifies whether the file is to be opened for\n\ +reading, writing, or both.\n\ +\n\ +The second form of the @code{fopen} function returns a vector of file ids\n\ +corresponding to all the currently open files, excluding the\n\ +@code{stdin}, @code{stdout}, and @code{stderr} streams.\n\ +\n\ +The third form of the @code{fopen} function returns information about the\n\ +open file given its file id.\n\ +\n\ +For example,\n\ +\n\ +@example\n\ +myfile = fopen (\"splat.dat\", \"r\", \"ieee-le\");\n\ +@end example\n\ +\n\ +@noindent\n\ +opens the file @file{splat.dat} for reading. If necessary, binary\n\ +numeric values will be read assuming they are stored in IEEE format with\n\ +the least significant bit first, and then converted to the native\n\ +representation.\n\ +\n\ +Opening a file that is already open simply opens it again and returns a\n\ +separate file id. It is not an error to open a file several times,\n\ +though writing to the same file through several different file ids may\n\ +produce unexpected results.\n\ +\n\ +The possible values @samp{mode} may have are\n\ +\n\ +@table @asis\n\ +@item @samp{r}\n\ +Open a file for reading.\n\ +\n\ +@item @samp{w}\n\ +Open a file for writing. The previous contents are discarded.\n\ +\n\ +@item @samp{a}\n\ +Open or create a file for writing at the end of the file.\n\ +\n\ +@item @samp{r+}\n\ +Open an existing file for reading and writing.\n\ +\n\ +@item @samp{w+}\n\ +Open a file for reading or writing. The previous contents are\n\ +discarded.\n\ +\n\ +@item @samp{a+}\n\ +Open or create a file for reading or writing at the end of the\n\ +file.\n\ +@end table\n\ +\n\ +Append a \"t\" to the mode string to open the file in text mode or a\n\ +\"b\" to open in binary mode. On Windows and Macintosh systems, text\n\ +mode reading and writing automatically converts linefeeds to the\n\ +appropriate line end character for the system (carriage-return linefeed\n\ +on Windows, carriage-return on Macintosh). The default if no mode is\n\ +specified is binary mode.\n\ +\n\ +Additionally, you may append a \"z\" to the mode string to open a\n\ +gzipped file for reading or writing. For this to be successful, you\n\ +must also open the file in binary mode.\n\ +\n\ +The parameter @var{arch} is a string specifying the default data format\n\ +for the file. Valid values for @var{arch} are:\n\ +\n\ +@table @samp\n\ +@item native\n\ +The format of the current machine (this is the default).\n\ +\n\ +@item ieee-be\n\ +IEEE big endian format.\n\ +\n\ +@item ieee-le\n\ +IEEE little endian format.\n\ +\n\ +@item vaxd\n\ +VAX D floating format.\n\ +\n\ +@item vaxg\n\ +VAX G floating format.\n\ +\n\ +@item cray\n\ +Cray floating format.\n\ +@end table\n\ +\n\ +@noindent\n\ +however, conversions are currently only supported for @samp{native}\n\ +@samp{ieee-be}, and @samp{ieee-le} formats.\n\ +@seealso{fclose, fgets, fgetl, fscanf, fread, fputs, fdisp, fprintf, fwrite, fskipl, fseek, frewind, ftell, feof, ferror, fclear, fflush, freport}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(0) = -1.0; + + int nargin = args.length (); + + if (nargin == 1) + { + if (args(0).is_string ()) + { + // If there is only one argument and it is a string but it + // is not the string "all", we assume it is a file to open + // with MODE = "r". To open a file called "all", you have + // to supply more than one argument. + + if (nargout < 2 && args(0).string_value () == "all") + return octave_stream_list::open_file_numbers (); + } + else + { + string_vector tmp = octave_stream_list::get_info (args(0)); + + if (! error_state) + { + retval(2) = tmp(2); + retval(1) = tmp(1); + retval(0) = tmp(0); + } + + return retval; + } + } + + if (nargin > 0 && nargin < 4) + { + octave_value mode = (nargin == 2 || nargin == 3) + ? args(1) : octave_value ("r"); + + octave_value arch = (nargin == 3) + ? args(2) : octave_value ("native"); + + int fid = -1; + + octave_stream os = do_stream_open (args(0), mode, arch, "fopen", fid); + + if (os && ! error_state) + { + retval(1) = ""; + retval(0) = octave_stream_list::insert (os); + } + else + { + int error_number = 0; + + retval(1) = os.error (false, error_number); + retval(0) = -1.0; + } + } + else + print_usage (); + + return retval; +} + +DEFUN (freport, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} freport ()\n\ +Print a list of which files have been opened, and whether they are open\n\ +for reading, writing, or both. For example:\n\ +\n\ +@example\n\ +@group\n\ +freport ()\n\ +\n\ + @print{} number mode name\n\ + @print{}\n\ + @print{} 0 r stdin\n\ + @print{} 1 w stdout\n\ + @print{} 2 w stderr\n\ + @print{} 3 r myfile\n\ +@end group\n\ +@end example\n\ +@seealso{fopen, fclose}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin > 0) + warning ("freport: ignoring extra arguments"); + + octave_stdout << octave_stream_list::list_open_files (); + + return retval; +} + +DEFUN (frewind, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} frewind (@var{fid})\n\ +Move the file pointer to the beginning of the file @var{fid}, returning\n\ +0 for success, and -1 if an error was encountered. It is equivalent to\n\ +@code{fseek (@var{fid}, 0, SEEK_SET)}.\n\ +@seealso{fseek, ftell, fopen}\n\ +@end deftypefn") +{ + octave_value retval; + + int result = -1; + + int nargin = args.length (); + + if (nargin == 1) + { + octave_stream os = octave_stream_list::lookup (args(0), "frewind"); + + if (! error_state) + result = os.rewind (); + } + else + print_usage (); + + if (nargout > 0) + retval = result; + + return retval; +} + +DEFUN (fseek, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} fseek (@var{fid}, @var{offset})\n\ +@deftypefnx {Built-in Function} {} fseek (@var{fid}, @var{offset}, @var{origin})\n\ +@deftypefnx {Built-in Function} {@var{status} =} fseek (@dots{})\n\ +Set the file pointer to any location within the file @var{fid}.\n\ +\n\ +The pointer is positioned @var{offset} characters from the @var{origin},\n\ +which may be one of the predefined variables @w{@code{SEEK_CUR}} (current\n\ +position), @w{@code{SEEK_SET}} (beginning), or @w{@code{SEEK_END}} (end of\n\ +file) or strings \"cof\", \"bof\" or \"eof\". If @var{origin} is omitted,\n\ +@w{@code{SEEK_SET}} is assumed. @var{offset} may be positive, negative, or zero but not all combinations of @var{origin} and @var{offset} can be realized.\n\ +\n\ +Return 0 on success and -1 on error.\n\ +@seealso{fskipl, frewind, ftell, fopen}\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 2 || nargin == 3) + { + octave_stream os = octave_stream_list::lookup (args(0), "fseek"); + + if (! error_state) + { + octave_value origin_arg = (nargin == 3) + ? args(2) : octave_value (-1.0); + + retval = os.seek (args(1), origin_arg); + } + } + else + print_usage (); + + return retval; +} + +DEFUN (ftell, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ftell (@var{fid})\n\ +Return the position of the file pointer as the number of characters\n\ +from the beginning of the file @var{fid}.\n\ +@seealso{fseek, feof, fopen}\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 1) + { + octave_stream os = octave_stream_list::lookup (args(0), "ftell"); + + if (! error_state) + retval = os.tell (); + } + else + print_usage (); + + return retval; +} + +DEFUN (fprintf, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} fprintf (@var{fid}, @var{template}, @dots{})\n\ +This function is just like @code{printf}, except that the output is\n\ +written to the stream @var{fid} instead of @code{stdout}.\n\ +If @var{fid} is omitted, the output is written to @code{stdout}.\n\ +@seealso{fputs, fdisp, fwrite, fscanf, printf, sprintf, fopen}\n\ +@end deftypefn") +{ + static std::string who = "fprintf"; + + octave_value retval; + + int result = -1; + + int nargin = args.length (); + + if (nargin > 1 || (nargin > 0 && args(0).is_string ())) + { + octave_stream os; + int fmt_n = 0; + + if (args(0).is_string ()) + { + os = octave_stream_list::lookup (1, who); + } + else + { + fmt_n = 1; + os = octave_stream_list::lookup (args(0), who); + } + + if (! error_state) + { + if (args(fmt_n).is_string ()) + { + octave_value_list tmp_args; + + if (nargin > 1 + fmt_n) + { + tmp_args.resize (nargin-fmt_n-1, octave_value ()); + + for (int i = fmt_n + 1; i < nargin; i++) + tmp_args(i-fmt_n-1) = args(i); + } + + result = os.printf (args(fmt_n), tmp_args, who); + } + else + ::error ("%s: format TEMPLATE must be a string", who.c_str ()); + } + } + else + print_usage (); + + if (nargout > 0) + retval = result; + + return retval; +} + +DEFUN (printf, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} printf (@var{template}, @dots{})\n\ +Print optional arguments under the control of the template string\n\ +@var{template} to the stream @code{stdout} and return the number of\n\ +characters printed.\n\ +@ifclear OCTAVE_MANUAL\n\ +\n\ +See the Formatted Output section of the GNU Octave manual for a\n\ +complete description of the syntax of the template string.\n\ +@end ifclear\n\ +@seealso{fprintf, sprintf, scanf}\n\ +@end deftypefn") +{ + static std::string who = "printf"; + + octave_value retval; + + int result = -1; + + int nargin = args.length (); + + if (nargin > 0) + { + if (args(0).is_string ()) + { + octave_value_list tmp_args; + + if (nargin > 1) + { + tmp_args.resize (nargin-1, octave_value ()); + + for (int i = 1; i < nargin; i++) + tmp_args(i-1) = args(i); + } + + result = stdout_stream.printf (args(0), tmp_args, who); + } + else + ::error ("%s: format TEMPLATE must be a string", who.c_str ()); + } + else + print_usage (); + + if (nargout > 0) + retval = result; + + return retval; +} + +DEFUN (fputs, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} fputs (@var{fid}, @var{string})\n\ +Write a string to a file with no formatting.\n\ +\n\ +Return a non-negative number on success and EOF on error.\n\ +@seealso{fdisp, fprintf, fwrite, fopen}\n\ +@end deftypefn") +{ + static std::string who = "fputs"; + + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 2) + { + octave_stream os = octave_stream_list::lookup (args(0), who); + + if (! error_state) + retval = os.puts (args(1), who); + } + else + print_usage (); + + return retval; +} + +DEFUN (puts, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} puts (@var{string})\n\ +Write a string to the standard output with no formatting.\n\ +\n\ +Return a non-negative number on success and EOF on error.\n\ +@seealso{fputs, disp}\n\ +@end deftypefn") +{ + static std::string who = "puts"; + + octave_value retval = -1; + + if (args.length () == 1) + retval = stdout_stream.puts (args(0), who); + else + print_usage (); + + return retval; +} + +DEFUN (sprintf, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} sprintf (@var{template}, @dots{})\n\ +This is like @code{printf}, except that the output is returned as a\n\ +string. Unlike the C library function, which requires you to provide a\n\ +suitably sized string as an argument, Octave's @code{sprintf} function\n\ +returns the string, automatically sized to hold all of the items\n\ +converted.\n\ +@seealso{printf, fprintf, sscanf}\n\ +@end deftypefn") +{ + static std::string who = "sprintf"; + + octave_value_list retval; + + int nargin = args.length (); + + if (nargin > 0) + { + retval(2) = -1.0; + retval(1) = "unknown error"; + retval(0) = ""; + + octave_ostrstream *ostr = new octave_ostrstream (); + + octave_stream os (ostr); + + if (os.is_valid ()) + { + octave_value fmt_arg = args(0); + + if (fmt_arg.is_string ()) + { + octave_value_list tmp_args; + + if (nargin > 1) + { + tmp_args.resize (nargin-1, octave_value ()); + + for (int i = 1; i < nargin; i++) + tmp_args(i-1) = args(i); + } + + retval(2) = os.printf (fmt_arg, tmp_args, who); + retval(1) = os.error (); + retval(0) = octave_value (ostr->str (), + fmt_arg.is_sq_string () ? '\'' : '"'); + } + else + ::error ("%s: format TEMPLATE must be a string", who.c_str ()); + } + else + ::error ("%s: unable to create output buffer", who.c_str ()); + } + else + print_usage (); + + return retval; +} + +DEFUN (fscanf, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{val}, @var{count}, @var{errmsg}] =} fscanf (@var{fid}, @var{template}, @var{size})\n\ +@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}, @var{errmsg}] =} fscanf (@var{fid}, @var{template}, \"C\")\n\ +In the first form, read from @var{fid} according to @var{template},\n\ +returning the result in the matrix @var{val}.\n\ +\n\ +The optional argument @var{size} specifies the amount of data to read\n\ +and may be one of\n\ +\n\ +@table @code\n\ +@item Inf\n\ +Read as much as possible, returning a column vector.\n\ +\n\ +@item @var{nr}\n\ +Read up to @var{nr} elements, returning a column vector.\n\ +\n\ +@item [@var{nr}, Inf]\n\ +Read as much as possible, returning a matrix with @var{nr} rows. If the\n\ +number of elements read is not an exact multiple of @var{nr}, the last\n\ +column is padded with zeros.\n\ +\n\ +@item [@var{nr}, @var{nc}]\n\ +Read up to @code{@var{nr} * @var{nc}} elements, returning a matrix with\n\ +@var{nr} rows. If the number of elements read is not an exact multiple\n\ +of @var{nr}, the last column is padded with zeros.\n\ +@end table\n\ +\n\ +@noindent\n\ +If @var{size} is omitted, a value of @code{Inf} is assumed.\n\ +\n\ +A string is returned if @var{template} specifies only character\n\ +conversions.\n\ +\n\ +The number of items successfully read is returned in @var{count}.\n\ +\n\ +If an error occurs, @var{errmsg} contains a system-dependent error message.\n\ +\n\ +In the second form, read from @var{fid} according to @var{template},\n\ +with each conversion specifier in @var{template} corresponding to a\n\ +single scalar return value. This form is more ``C-like'', and also\n\ +compatible with previous versions of Octave. The number of successful\n\ +conversions is returned in @var{count}\n\ +@ifclear OCTAVE_MANUAL\n\ +\n\ +See the Formatted Input section of the GNU Octave manual for a\n\ +complete description of the syntax of the template string.\n\ +@end ifclear\n\ +@seealso{fgets, fgetl, fread, scanf, sscanf, fopen}\n\ +@end deftypefn") +{ + static std::string who = "fscanf"; + + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 3 && args(2).is_string ()) + { + octave_stream os = octave_stream_list::lookup (args(0), who); + + if (! error_state) + { + if (args(1).is_string ()) + retval = os.oscanf (args(1), who); + else + ::error ("%s: format TEMPLATE must be a string", who.c_str ()); + } + } + else + { + retval(2) = "unknown error"; + retval(1) = 0.0; + retval(0) = Matrix (); + + if (nargin == 2 || nargin == 3) + { + octave_stream os = octave_stream_list::lookup (args(0), who); + + if (! error_state) + { + if (args(1).is_string ()) + { + octave_idx_type count = 0; + + Array size = (nargin == 3) + ? args(2).vector_value () + : Array (dim_vector (1, 1), lo_ieee_inf_value ()); + + if (! error_state) + { + octave_value tmp = os.scanf (args(1), size, count, who); + + if (! error_state) + { + retval(2) = os.error (); + retval(1) = count; + retval(0) = tmp; + } + } + } + else + ::error ("%s: format must be a string", who.c_str ()); + } + } + else + print_usage (); + } + + return retval; +} + +static std::string +get_sscanf_data (const octave_value& val) +{ + std::string retval; + + if (val.is_string ()) + { + octave_value tmp = val.reshape (dim_vector (1, val.numel ())); + + retval = tmp.string_value (); + } + else + ::error ("sscanf: argument STRING must be a string"); + + return retval; +} + +DEFUN (sscanf, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{val}, @var{count}, @var{errmsg}, @var{pos}] =} sscanf (@var{string}, @var{template}, @var{size})\n\ +@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}, @var{errmsg}] =} sscanf (@var{string}, @var{template}, \"C\")\n\ +This is like @code{fscanf}, except that the characters are taken from the\n\ +string @var{string} instead of from a stream. Reaching the end of the\n\ +string is treated as an end-of-file condition. In addition to the values\n\ +returned by @code{fscanf}, the index of the next character to be read\n\ +is returned in @var{pos}.\n\ +@seealso{fscanf, scanf, sprintf}\n\ +@end deftypefn") +{ + static std::string who = "sscanf"; + + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 3 && args(2).is_string ()) + { + std::string data = get_sscanf_data (args(0)); + + if (! error_state) + { + octave_stream os = octave_istrstream::create (data); + + if (os.is_valid ()) + { + if (args(1).is_string ()) + retval = os.oscanf (args(1), who); + else + ::error ("%s: format TEMPLATE must be a string", who.c_str ()); + } + else + ::error ("%s: unable to create temporary input buffer", + who.c_str ()); + } + else + ::error ("%s: argument STRING must be a string", who.c_str ()); + } + else + { + if (nargin == 2 || nargin == 3) + { + retval(3) = -1.0; + retval(2) = "unknown error"; + retval(1) = 0.0; + retval(0) = Matrix (); + + std::string data = get_sscanf_data (args(0)); + + if (! error_state) + { + octave_stream os = octave_istrstream::create (data); + + if (os.is_valid ()) + { + if (args(1).is_string ()) + { + octave_idx_type count = 0; + + Array size = (nargin == 3) + ? args(2).vector_value () + : Array (dim_vector (1, 1), + lo_ieee_inf_value ()); + + octave_value tmp = os.scanf (args(1), size, count, who); + + if (! error_state) + { + // FIXME -- is this the right thing to do? + // Extract error message first, because getting + // position will clear it. + std::string errmsg = os.error (); + + retval(3) + = (os.eof () ? data.length () : os.tell ()) + 1; + retval(2) = errmsg; + retval(1) = count; + retval(0) = tmp; + } + } + else + ::error ("%s: format TEMPLATE must be a string", who.c_str ()); + } + else + ::error ("%s: unable to create temporary input buffer", + who.c_str ()); + } + } + else + print_usage (); + } + + return retval; +} + +DEFUN (scanf, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{val}, @var{count}, @var{errmsg}] =} scanf (@var{template}, @var{size})\n\ +@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}, @var{errmsg}]] =} scanf (@var{template}, \"C\")\n\ +This is equivalent to calling @code{fscanf} with @var{fid} = @code{stdin}.\n\ +\n\ +It is currently not useful to call @code{scanf} in interactive\n\ +programs.\n\ +@seealso{fscanf, sscanf, printf}\n\ +@end deftypefn") +{ + int nargin = args.length (); + + octave_value_list tmp_args (nargin+1, octave_value ()); + + tmp_args (0) = 0.0; + for (int i = 0; i < nargin; i++) + tmp_args (i+1) = args (i); + + return Ffscanf (tmp_args, nargout); +} + +static octave_value +do_fread (octave_stream& os, const octave_value& size_arg, + const octave_value& prec_arg, const octave_value& skip_arg, + const octave_value& arch_arg, octave_idx_type& count) +{ + octave_value retval; + + count = -1; + + Array size = size_arg.vector_value (); + + if (! error_state) + { + std::string prec = prec_arg.string_value (); + + if (! error_state) + { + int block_size = 1; + oct_data_conv::data_type input_type; + oct_data_conv::data_type output_type; + + oct_data_conv::string_to_data_type (prec, block_size, + input_type, output_type); + + if (! error_state) + { + int skip = skip_arg.int_value (true); + + if (! error_state) + { + std::string arch = arch_arg.string_value (); + + if (! error_state) + { + oct_mach_info::float_format flt_fmt + = oct_mach_info::string_to_float_format (arch); + + if (! error_state) + retval = os.read (size, block_size, input_type, + output_type, skip, flt_fmt, count); + } + else + ::error ("fread: ARCH architecture type must be a string"); + } + else + ::error ("fread: SKIP must be an integer"); + } + else + ::error ("fread: invalid PRECISION specified"); + } + else + ::error ("fread: PRECISION must be a string"); + } + else + ::error ("fread: invalid SIZE specified"); + + return retval; +} + +DEFUN (fread, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{val}, @var{count}] =} fread (@var{fid}, @var{size}, @var{precision}, @var{skip}, @var{arch})\n\ +Read binary data of type @var{precision} from the specified file ID\n\ +@var{fid}.\n\ +\n\ +The optional argument @var{size} specifies the amount of data to read\n\ +and may be one of\n\ +\n\ +@table @code\n\ +@item Inf\n\ +Read as much as possible, returning a column vector.\n\ +\n\ +@item @var{nr}\n\ +Read up to @var{nr} elements, returning a column vector.\n\ +\n\ +@item [@var{nr}, Inf]\n\ +Read as much as possible, returning a matrix with @var{nr} rows. If the\n\ +number of elements read is not an exact multiple of @var{nr}, the last\n\ +column is padded with zeros.\n\ +\n\ +@item [@var{nr}, @var{nc}]\n\ +Read up to @code{@var{nr} * @var{nc}} elements, returning a matrix with\n\ +@var{nr} rows. If the number of elements read is not an exact multiple\n\ +of @var{nr}, the last column is padded with zeros.\n\ +@end table\n\ +\n\ +@noindent\n\ +If @var{size} is omitted, a value of @code{Inf} is assumed.\n\ +\n\ +The optional argument @var{precision} is a string specifying the type of\n\ +data to read and may be one of\n\ +\n\ +@table @asis\n\ +@item \"schar\"\n\ +@itemx \"signed char\"\n\ +Signed character.\n\ +\n\ +@item \"uchar\"\n\ +@itemx \"unsigned char\"\n\ +Unsigned character.\n\ +\n\ +@item \"int8\"\n\ +@itemx \"integer*1\"\n\ +\n\ +8-bit signed integer.\n\ +\n\ +@item \"int16\"\n\ +@itemx \"integer*2\"\n\ +16-bit signed integer.\n\ +\n\ +@item \"int32\"\n\ +@itemx \"integer*4\"\n\ +32-bit signed integer.\n\ +\n\ +@item \"int64\"\n\ +@itemx \"integer*8\"\n\ +64-bit signed integer.\n\ +\n\ +@item \"uint8\"\n\ +8-bit unsigned integer.\n\ +\n\ +@item \"uint16\"\n\ +16-bit unsigned integer.\n\ +\n\ +@item \"uint32\"\n\ +32-bit unsigned integer.\n\ +\n\ +@item \"uint64\"\n\ +64-bit unsigned integer.\n\ +\n\ +@item \"single\"\n\ +@itemx \"float32\"\n\ +@itemx \"real*4\"\n\ +32-bit floating point number.\n\ +\n\ +@item \"double\"\n\ +@itemx \"float64\"\n\ +@itemx \"real*8\"\n\ +64-bit floating point number.\n\ +\n\ +@item \"char\"\n\ +@itemx \"char*1\"\n\ +Single character.\n\ +\n\ +@item \"short\"\n\ +Short integer (size is platform dependent).\n\ +\n\ +@item \"int\"\n\ +Integer (size is platform dependent).\n\ +\n\ +@item \"long\"\n\ +Long integer (size is platform dependent).\n\ +\n\ +@item \"ushort\"\n\ +@itemx \"unsigned short\"\n\ +Unsigned short integer (size is platform dependent).\n\ +\n\ +@item \"uint\"\n\ +@itemx \"unsigned int\"\n\ +Unsigned integer (size is platform dependent).\n\ +\n\ +@item \"ulong\"\n\ +@itemx \"unsigned long\"\n\ +Unsigned long integer (size is platform dependent).\n\ +\n\ +@item \"float\"\n\ +Single precision floating point number (size is platform dependent).\n\ +@end table\n\ +\n\ +@noindent\n\ +The default precision is @code{\"uchar\"}.\n\ +\n\ +The @var{precision} argument may also specify an optional repeat\n\ +count. For example, @samp{32*single} causes @code{fread} to read\n\ +a block of 32 single precision floating point numbers. Reading in\n\ +blocks is useful in combination with the @var{skip} argument.\n\ +\n\ +The @var{precision} argument may also specify a type conversion.\n\ +For example, @samp{int16=>int32} causes @code{fread} to read 16-bit\n\ +integer values and return an array of 32-bit integer values. By\n\ +default, @code{fread} returns a double precision array. The special\n\ +form @samp{*TYPE} is shorthand for @samp{TYPE=>TYPE}.\n\ +\n\ +The conversion and repeat counts may be combined. For example, the\n\ +specification @samp{32*single=>single} causes @code{fread} to read\n\ +blocks of single precision floating point values and return an array\n\ +of single precision values instead of the default array of double\n\ +precision values.\n\ +\n\ +The optional argument @var{skip} specifies the number of bytes to skip\n\ +after each element (or block of elements) is read. If it is not\n\ +specified, a value of 0 is assumed. If the final block read is not\n\ +complete, the final skip is omitted. For example,\n\ +\n\ +@example\n\ +fread (f, 10, \"3*single=>single\", 8)\n\ +@end example\n\ +\n\ +@noindent\n\ +will omit the final 8-byte skip because the last read will not be\n\ +a complete block of 3 values.\n\ +\n\ +The optional argument @var{arch} is a string specifying the data format\n\ +for the file. Valid values are\n\ +\n\ +@table @code\n\ +@item \"native\"\n\ +The format of the current machine.\n\ +\n\ +@item \"ieee-be\"\n\ +IEEE big endian.\n\ +\n\ +@item \"ieee-le\"\n\ +IEEE little endian.\n\ +\n\ +@item \"vaxd\"\n\ +VAX D floating format.\n\ +\n\ +@item \"vaxg\"\n\ +VAX G floating format.\n\ +\n\ +@item \"cray\"\n\ +Cray floating format.\n\ +@end table\n\ +\n\ +@noindent\n\ +Conversions are currently only supported for @code{\"ieee-be\"} and\n\ +@code{\"ieee-le\"} formats.\n\ +\n\ +The data read from the file is returned in @var{val}, and the number of\n\ +values read is returned in @code{count}\n\ +@seealso{fwrite, fgets, fgetl, fscanf, fopen}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin > 0 && nargin < 6) + { + retval(1) = -1.0; + retval(0) = Matrix (); + + octave_stream os = octave_stream_list::lookup (args(0), "fread"); + + if (! error_state) + { + octave_value size = lo_ieee_inf_value (); + octave_value prec = "uchar"; + octave_value skip = 0; + octave_value arch = "unknown"; + + int idx = 1; + + if (nargin > idx && ! args(idx).is_string ()) + size = args(idx++); + + if (nargin > idx) + prec = args(idx++); + + if (nargin > idx) + skip = args(idx++); + + if (nargin > idx) + arch = args(idx++); + else if (skip.is_string ()) + { + arch = skip; + skip = 0; + } + + octave_idx_type count = -1; + + octave_value tmp = do_fread (os, size, prec, skip, arch, count); + + retval(1) = count; + retval(0) = tmp; + } + } + else + print_usage (); + + return retval; +} + +static int +do_fwrite (octave_stream& os, const octave_value& data, + const octave_value& prec_arg, const octave_value& skip_arg, + const octave_value& arch_arg) +{ + int retval = -1; + + std::string prec = prec_arg.string_value (); + + if (! error_state) + { + int block_size = 1; + oct_data_conv::data_type output_type; + + oct_data_conv::string_to_data_type (prec, block_size, output_type); + + if (! error_state) + { + int skip = skip_arg.int_value (true); + + if (! error_state) + { + std::string arch = arch_arg.string_value (); + + if (! error_state) + { + oct_mach_info::float_format flt_fmt + = oct_mach_info::string_to_float_format (arch); + + if (! error_state) + retval = os.write (data, block_size, output_type, + skip, flt_fmt); + } + else + ::error ("fwrite: ARCH architecture type must be a string"); + } + else + ::error ("fwrite: SKIP must be an integer"); + } + else + ::error ("fwrite: invalid PRECISION specified"); + } + else + ::error ("fwrite: PRECISION must be a string"); + + return retval; +} + +DEFUN (fwrite, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{count} =} fwrite (@var{fid}, @var{data}, @var{precision}, @var{skip}, @var{arch})\n\ +Write data in binary form of type @var{precision} to the specified file\n\ +ID @var{fid}, returning the number of values successfully written to the\n\ +file.\n\ +\n\ +The argument @var{data} is a matrix of values that are to be written to\n\ +the file. The values are extracted in column-major order.\n\ +\n\ +The remaining arguments @var{precision}, @var{skip}, and @var{arch} are\n\ +optional, and are interpreted as described for @code{fread}.\n\ +\n\ +The behavior of @code{fwrite} is undefined if the values in @var{data}\n\ +are too large to fit in the specified precision.\n\ +@seealso{fread, fputs, fprintf, fopen}\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin > 1 && nargin < 6) + { + octave_stream os = octave_stream_list::lookup (args(0), "fwrite"); + + if (! error_state) + { + octave_value prec = "uchar"; + octave_value skip = 0; + octave_value arch = "unknown"; + + int idx = 1; + + octave_value data = args(idx++); + + if (nargin > idx) + prec = args(idx++); + + if (nargin > idx) + skip = args(idx++); + + if (nargin > idx) + arch = args(idx++); + else if (skip.is_string ()) + { + arch = skip; + skip = 0; + } + + double status = do_fwrite (os, data, prec, skip, arch); + + retval = status; + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("feof", Ffeof, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} feof (@var{fid})\n\ +Return 1 if an end-of-file condition has been encountered for a given\n\ +file and 0 otherwise. Note that it will only return 1 if the end of the\n\ +file has already been encountered, not if the next read operation will\n\ +result in an end-of-file condition.\n\ +@seealso{fread, fopen}\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 1) + { + octave_stream os = octave_stream_list::lookup (args(0), "feof"); + + if (! error_state) + retval = os.eof () ? 1.0 : 0.0; + } + else + print_usage (); + + return retval; +} + +DEFUNX ("ferror", Fferror, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} ferror (@var{fid})\n\ +@deftypefnx {Built-in Function} {[@var{err}, @var{msg}] =} ferror (@var{fid}, \"clear\")\n\ +Return 1 if an error condition has been encountered for the file ID\n\ +@var{fid} and 0 otherwise. Note that it will only return 1 if an error\n\ +has already been encountered, not if the next operation will result in\n\ +an error condition.\n\ +\n\ +The second argument is optional. If it is supplied, also clear the\n\ +error condition.\n\ +@seealso{fclear, fopen}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + octave_stream os = octave_stream_list::lookup (args(0), "ferror"); + + if (! error_state) + { + bool clear = false; + + if (nargin == 2) + { + std::string opt = args(1).string_value (); + + if (! error_state) + clear = (opt == "clear"); + else + return retval; + } + + int error_number = 0; + + std::string error_message = os.error (clear, error_number); + + retval(1) = error_number; + retval(0) = error_message; + } + } + else + print_usage (); + + return retval; +} + +DEFUN (popen, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{fid} =} popen (@var{command}, @var{mode})\n\ +Start a process and create a pipe. The name of the command to run is\n\ +given by @var{command}. The file identifier corresponding to the input\n\ +or output stream of the process is returned in @var{fid}. The argument\n\ +@var{mode} may be\n\ +\n\ +@table @code\n\ +@item \"r\"\n\ +The pipe will be connected to the standard output of the process, and\n\ +open for reading.\n\ +\n\ +@item \"w\"\n\ +The pipe will be connected to the standard input of the process, and\n\ +open for writing.\n\ +@end table\n\ +\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +fid = popen (\"ls -ltr / | tail -3\", \"r\");\n\ +while (ischar (s = fgets (fid)))\n\ + fputs (stdout, s);\n\ +endwhile\n\ +\n\ + @print{} drwxr-xr-x 33 root root 3072 Feb 15 13:28 etc\n\ + @print{} drwxr-xr-x 3 root root 1024 Feb 15 13:28 lib\n\ + @print{} drwxrwxrwt 15 root root 2048 Feb 17 14:53 tmp\n\ +@end group\n\ +@end example\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 2) + { + std::string name = args(0).string_value (); + + if (! error_state) + { + std::string mode = args(1).string_value (); + + if (! error_state) + { + if (mode == "r") + { + octave_stream ips = octave_iprocstream::create (name); + + retval = octave_stream_list::insert (ips); + } + else if (mode == "w") + { + octave_stream ops = octave_oprocstream::create (name); + + retval = octave_stream_list::insert (ops); + } + else + ::error ("popen: invalid MODE specified"); + } + else + ::error ("popen: MODE must be a string"); + } + else + ::error ("popen: COMMAND must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("pclose", Fpclose, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} pclose (@var{fid})\n\ +Close a file identifier that was opened by @code{popen}. You may also\n\ +use @code{fclose} for the same purpose.\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 1) + retval = octave_stream_list::remove (args(0), "pclose"); + else + print_usage (); + + return retval; +} + +DEFUNX ("tmpnam", Ftmpnam, args, , + "-*- texinfo -*-\n\ +@c List other forms of function in documentation index\n\ +@findex octave_tmp_file_name\n\ +\n\ +@deftypefn {Built-in Function} {} tmpnam ()\n\ +@deftypefnx {Built-in Function} {} tmpnam (@var{dir})\n\ +@deftypefnx {Built-in Function} {} tmpnam (@var{dir}, @var{prefix})\n\ +Return a unique temporary file name as a string.\n\ +\n\ +If @var{prefix} is omitted, a value of @code{\"oct-\"} is used.\n\ +If @var{dir} is also omitted, the default directory for temporary files\n\ +is used. If @var{dir} is provided, it must exist, otherwise the default\n\ +directory for temporary files is used. Since the named file is not\n\ +opened, by @code{tmpnam}, it is possible (though relatively unlikely)\n\ +that it will not be available by the time your program attempts to open it.\n\ +@seealso{tmpfile, mkstemp, P_tmpdir}\n\ +@end deftypefn") +{ + octave_value retval; + + int len = args.length (); + + if (len < 3) + { + std::string dir = len > 0 ? args(0).string_value () : std::string (); + + if (! error_state) + { + std::string pfx + = len > 1 ? args(1).string_value () : std::string ("oct-"); + + if (! error_state) + retval = octave_tempnam (dir, pfx); + else + ::error ("PREFIX must be a string"); + } + else + ::error ("DIR argument must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFALIAS (octave_tmp_file_name, tmpnam); + +DEFUN (tmpfile, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{fid}, @var{msg}] =} tmpfile ()\n\ +Return the file ID corresponding to a new temporary file with a unique\n\ +name. The file is opened in binary read/write (@code{\"w+b\"}) mode.\n\ +The file will be deleted automatically when it is closed or when Octave\n\ +exits.\n\ +\n\ +If successful, @var{fid} is a valid file ID and @var{msg} is an empty\n\ +string. Otherwise, @var{fid} is -1 and @var{msg} contains a\n\ +system-dependent error message.\n\ +@seealso{tmpnam, mkstemp, P_tmpdir}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 0) + { + FILE *fid = gnulib::tmpfile (); + + if (fid) + { + std::string nm; + + std::ios::openmode md = fopen_mode_to_ios_mode ("w+b"); + + octave_stream s = octave_stdiostream::create (nm, fid, md); + + if (s) + retval(0) = octave_stream_list::insert (s); + else + error ("tmpfile: failed to create octave_stdiostream object"); + + } + else + { + retval(1) = gnulib::strerror (errno); + retval(0) = -1; + } + } + else + print_usage (); + + return retval; +} + +DEFUN (mkstemp, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{fid}, @var{name}, @var{msg}] =} mkstemp (@var{template}, @var{delete})\n\ +Return the file ID corresponding to a new temporary file with a unique\n\ +name created from @var{template}. The last six characters of @var{template}\n\ +must be @code{XXXXXX} and these are replaced with a string that makes the\n\ +filename unique. The file is then created with mode read/write and\n\ +permissions that are system dependent (on GNU/Linux systems, the permissions\n\ +will be 0600 for versions of glibc 2.0.7 and later). The file is opened\n\ +in binary mode and with the @w{@code{O_EXCL}} flag.\n\ +\n\ +If the optional argument @var{delete} is supplied and is true,\n\ +the file will be deleted automatically when Octave exits.\n\ +\n\ +If successful, @var{fid} is a valid file ID, @var{name} is the name of\n\ +the file, and @var{msg} is an empty string. Otherwise, @var{fid}\n\ +is -1, @var{name} is empty, and @var{msg} contains a system-dependent\n\ +error message.\n\ +@seealso{tmpfile, tmpnam, P_tmpdir}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(2) = std::string (); + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + std::string tmpl8 = args(0).string_value (); + + if (! error_state) + { + OCTAVE_LOCAL_BUFFER (char, tmp, tmpl8.size () + 1); + strcpy (tmp, tmpl8.c_str ()); + + int fd = gnulib::mkostemp (tmp, O_BINARY); + + if (fd < 0) + { + retval(2) = gnulib::strerror (errno); + retval(0) = fd; + } + else + { + const char *fopen_mode = "w+b"; + + FILE *fid = fdopen (fd, fopen_mode); + + if (fid) + { + std::string nm = tmp; + + std::ios::openmode md = fopen_mode_to_ios_mode (fopen_mode); + + octave_stream s = octave_stdiostream::create (nm, fid, md); + + if (s) + { + retval(1) = nm; + retval(0) = octave_stream_list::insert (s); + + if (nargin == 2 && args(1).is_true ()) + mark_for_deletion (nm); + } + else + error ("mkstemp: failed to create octave_stdiostream object"); + } + else + { + retval(2) = gnulib::strerror (errno); + retval(0) = -1; + } + } + } + else + error ("mkstemp: TEMPLATE argument must be a string"); + } + else + print_usage (); + + return retval; +} + +static int +convert (int x, int ibase, int obase) +{ + int retval = 0; + + int tmp = x % obase; + + if (tmp > ibase - 1) + ::error ("umask: invalid digit"); + else + { + retval = tmp; + int mult = ibase; + while ((x = (x - tmp) / obase)) + { + tmp = x % obase; + if (tmp > ibase - 1) + { + ::error ("umask: invalid digit"); + break; + } + retval += mult * tmp; + mult *= ibase; + } + } + + return retval; +} + +DEFUNX ("umask", Fumask, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} umask (@var{mask})\n\ +Set the permission mask for file creation. The parameter @var{mask}\n\ +is an integer, interpreted as an octal number. If successful,\n\ +returns the previous value of the mask (as an integer to be\n\ +interpreted as an octal number); otherwise an error message is printed.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int status = 0; + + if (args.length () == 1) + { + int mask = args(0).int_value (true); + + if (! error_state) + { + if (mask < 0) + { + status = -1; + ::error ("umask: MASK must be a positive integer value"); + } + else + { + int oct_mask = convert (mask, 8, 10); + + if (! error_state) + status = convert (octave_umask (oct_mask), 10, 8); + } + } + else + { + status = -1; + ::error ("umask: MASK must be an integer"); + } + } + else + print_usage (); + + if (status >= 0) + retval(0) = status; + + return retval; +} + +static octave_value +const_value (const char *, const octave_value_list& args, int val) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + retval = val; + else + print_usage (); + + return retval; +} + +DEFUNX ("P_tmpdir", FP_tmpdir, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} P_tmpdir ()\n\ +Return the default name of the directory for temporary files on\n\ +this system. The name of this directory is system dependent.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + retval = get_P_tmpdir (); + else + print_usage (); + + return retval; +} + +// NOTE: the values of SEEK_SET, SEEK_CUR, and SEEK_END have to be +// this way for Matlab compatibility. + +DEFUNX ("SEEK_SET", FSEEK_SET, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} SEEK_SET ()\n\ +@deftypefnx {Built-in Function} {} SEEK_CUR ()\n\ +@deftypefnx {Built-in Function} {} SEEK_END ()\n\ +Return the numerical value to pass to @code{fseek} to perform\n\ +one of the following actions:\n\ +\n\ +@table @code\n\ +@item SEEK_SET\n\ +Position file relative to the beginning.\n\ +\n\ +@item SEEK_CUR\n\ +Position file relative to the current position.\n\ +\n\ +@item SEEK_END\n\ +Position file relative to the end.\n\ +@end table\n\ +@seealso{fseek}\n\ +@end deftypefn") +{ + return const_value ("SEEK_SET", args, -1); +} + +DEFUNX ("SEEK_CUR", FSEEK_CUR, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} SEEK_CUR ()\n\ +Return the numerical value to pass to @code{fseek} to\n\ +position the file pointer relative to the current position.\n\ +@seealso{SEEK_SET, SEEK_END}.\n\ +@end deftypefn") +{ + return const_value ("SEEK_CUR", args, 0); +} + +DEFUNX ("SEEK_END", FSEEK_END, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} SEEK_END ()\n\ +Return the numerical value to pass to @code{fseek} to\n\ +position the file pointer relative to the end of the file.\n\ +@seealso{SEEK_SET, SEEK_CUR}.\n\ +@end deftypefn") +{ + return const_value ("SEEK_END", args, 1); +} + +static octave_value +const_value (const char *, const octave_value_list& args, + const octave_value& val) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + retval = val; + else + print_usage (); + + return retval; +} + +DEFUNX ("stdin", Fstdin, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} stdin ()\n\ +Return the numeric value corresponding to the standard input stream.\n\ +When Octave is used interactively, this is filtered through the command\n\ +line editing functions.\n\ +@seealso{stdout, stderr}\n\ +@end deftypefn") +{ + return const_value ("stdin", args, stdin_file); +} + +DEFUNX ("stdout", Fstdout, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} stdout ()\n\ +Return the numeric value corresponding to the standard output stream.\n\ +Data written to the standard output is normally filtered through the pager.\n\ +@seealso{stdin, stderr}\n\ +@end deftypefn") +{ + return const_value ("stdout", args, stdout_file); +} + +DEFUNX ("stderr", Fstderr, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} stderr ()\n\ +Return the numeric value corresponding to the standard error stream.\n\ +Even if paging is turned on, the standard error is not sent to the\n\ +pager. It is useful for error messages and prompts.\n\ +@seealso{stdin, stdout}\n\ +@end deftypefn") +{ + return const_value ("stderr", args, stderr_file); +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/file-io.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/file-io.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,36 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Written by John C. Campbell + +#if !defined (octave_file_io_h) +#define octave_file_io_h 1 + +extern OCTINTERP_API void initialize_file_io (void); + +extern OCTINTERP_API void close_files (void); + +extern OCTINTERP_API void mark_for_deletion (const std::string&); + +extern OCTINTERP_API void cleanup_tmp_files (void); + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/gl-render.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/gl-render.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,3048 @@ +/* + +Copyright (C) 2008-2012 Michael Goffioul + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#if defined (HAVE_OPENGL) + +#include + +#include +#include "oct-locbuf.h" +#include "oct-refcount.h" +#include "gl-render.h" +#include "txt-eng.h" +#include "txt-eng-ft.h" + +#define LIGHT_MODE GL_FRONT_AND_BACK + +// Win32 API requires the CALLBACK attributes for +// GLU callback functions. Define it to empty on +// other platforms. +#ifndef CALLBACK +#define CALLBACK +#endif + +static octave_idx_type +xmin (octave_idx_type x, octave_idx_type y) +{ + return x < y ? x : y; +} + +class +opengl_texture +{ +protected: + class texture_rep + { + public: + texture_rep (void) + : id (), w (), h (), tw (), th (), tx (), ty (), + valid (false), count (1) + { } + + texture_rep (GLuint id_arg, int w_arg, int h_arg, int tw_arg, int th_arg) + : id (id_arg), w (w_arg), h (h_arg), tw (tw_arg), th (th_arg), + tx (double(w)/tw), ty (double(h)/th), valid (true), + count (1) { } + + ~texture_rep (void) + { + if (valid) + glDeleteTextures (1, &id); + } + + void bind (int mode) const + { if (valid) glBindTexture (mode, id); } + + void tex_coord (double q, double r) const + { if (valid) glTexCoord2d (q*tx, r*ty); } + + GLuint id; + int w, h; + int tw, th; + double tx, ty; + bool valid; + octave_refcount count; + }; + + texture_rep *rep; + +private: + opengl_texture (texture_rep *_rep) : rep (_rep) { } + +public: + opengl_texture (void) : rep (new texture_rep ()) { } + + opengl_texture (const opengl_texture& tx) + : rep (tx.rep) + { + rep->count++; + } + + ~opengl_texture (void) + { + if (--rep->count == 0) + delete rep; + } + + opengl_texture& operator = (const opengl_texture& tx) + { + if (--rep->count == 0) + delete rep; + + rep = tx.rep; + rep->count++; + + return *this; + } + + static opengl_texture create (const octave_value& data); + + void bind (int mode = GL_TEXTURE_2D) const + { rep->bind (mode); } + + void tex_coord (double q, double r) const + { rep->tex_coord (q, r); } + + bool is_valid (void) const + { return rep->valid; } +}; + +static int +next_power_of_2 (int n) +{ + int m = 1; + + while (m < n && m < std::numeric_limits::max ()) + m <<= 1; + + return m; +} + +opengl_texture +opengl_texture::create (const octave_value& data) +{ + opengl_texture retval; + + dim_vector dv (data.dims ()); + + // Expect RGB data + if (dv.length () == 3 && dv(2) == 3) + { + // FIXME -- dim_vectors hold octave_idx_type values. Should we + // check for dimensions larger than intmax? + int h = dv(0), w = dv(1), tw, th; + GLuint id; + bool ok = true; + + tw = next_power_of_2 (w); + th = next_power_of_2 (w); + + glGenTextures (1, &id); + glBindTexture (GL_TEXTURE_2D, id); + + if (data.is_double_type ()) + { + const NDArray xdata = data.array_value (); + + OCTAVE_LOCAL_BUFFER (float, a, (3*tw*th)); + + for (int i = 0; i < h; i++) + { + for (int j = 0, idx = i*tw*3; j < w; j++, idx += 3) + { + a[idx] = xdata(i,j,0); + a[idx+1] = xdata(i,j,1); + a[idx+2] = xdata(i,j,2); + } + } + + glTexImage2D (GL_TEXTURE_2D, 0, 3, tw, th, 0, + GL_RGB, GL_FLOAT, a); + } + else if (data.is_uint8_type ()) + { + const uint8NDArray xdata = data.uint8_array_value (); + + OCTAVE_LOCAL_BUFFER (octave_uint8, a, (3*tw*th)); + + for (int i = 0; i < h; i++) + { + for (int j = 0, idx = i*tw*3; j < w; j++, idx += 3) + { + a[idx] = xdata(i,j,0); + a[idx+1] = xdata(i,j,1); + a[idx+2] = xdata(i,j,2); + } + } + + glTexImage2D (GL_TEXTURE_2D, 0, 3, tw, th, 0, + GL_RGB, GL_UNSIGNED_BYTE, a); + } + else + { + ok = false; + warning ("opengl_texture::create: invalid texture data type (expected double or uint8)"); + } + + if (ok) + { + glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST); + glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST); + + if (glGetError () != GL_NO_ERROR) + warning ("opengl_texture::create: OpenGL error while generating texture data"); + else + retval = opengl_texture (new texture_rep (id, w, h, tw, th)); + } + } + else + warning ("opengl_texture::create: invalid texture data size"); + + return retval; +} + +class +opengl_tesselator +{ +public: +#if defined (HAVE_FRAMEWORK_OPENGL) && defined (HAVE_GLUTESSCALLBACK_THREEDOTS) + typedef GLvoid (CALLBACK *fcn) (...); +#else + typedef void (CALLBACK *fcn) (void); +#endif + +public: + + opengl_tesselator (void) : glu_tess (0), fill () { init (); } + + virtual ~opengl_tesselator (void) + { if (glu_tess) gluDeleteTess (glu_tess); } + + void begin_polygon (bool filled = true) + { + gluTessProperty (glu_tess, GLU_TESS_BOUNDARY_ONLY, + (filled ? GL_FALSE : GL_TRUE)); + fill = filled; + gluTessBeginPolygon (glu_tess, this); + } + + void end_polygon (void) const + { gluTessEndPolygon (glu_tess); } + + void begin_contour (void) const + { gluTessBeginContour (glu_tess); } + + void end_contour (void) const + { gluTessEndContour (glu_tess); } + + void add_vertex (double *loc, void *data) const + { gluTessVertex (glu_tess, loc, data); } + +protected: + virtual void begin (GLenum /*type*/) { } + + virtual void end (void) { } + + virtual void vertex (void */*data*/) { } + + virtual void combine (GLdouble /*c*/[3], void */*data*/[4], + GLfloat /*w*/[4], void **/*out_data*/) { } + + virtual void edge_flag (GLboolean /*flag*/) { } + + virtual void error (GLenum err) + { ::error ("OpenGL tesselation error (%d)", err); } + + virtual void init (void) + { + glu_tess = gluNewTess (); + + gluTessCallback (glu_tess, GLU_TESS_BEGIN_DATA, + reinterpret_cast (tess_begin)); + gluTessCallback (glu_tess, GLU_TESS_END_DATA, + reinterpret_cast (tess_end)); + gluTessCallback (glu_tess, GLU_TESS_VERTEX_DATA, + reinterpret_cast (tess_vertex)); + gluTessCallback (glu_tess, GLU_TESS_COMBINE_DATA, + reinterpret_cast (tess_combine)); + gluTessCallback (glu_tess, GLU_TESS_EDGE_FLAG_DATA, + reinterpret_cast (tess_edge_flag)); + gluTessCallback (glu_tess, GLU_TESS_ERROR_DATA, + reinterpret_cast (tess_error)); + } + + bool is_filled (void) const { return fill; } + +private: + static void CALLBACK tess_begin (GLenum type, void *t) + { reinterpret_cast (t)->begin (type); } + + static void CALLBACK tess_end (void *t) + { reinterpret_cast (t)->end (); } + + static void CALLBACK tess_vertex (void *v, void *t) + { reinterpret_cast (t)->vertex (v); } + + static void CALLBACK tess_combine (GLdouble c[3], void *v[4], GLfloat w[4], + void **out, void *t) + { reinterpret_cast (t)->combine (c, v, w, out); } + + static void CALLBACK tess_edge_flag (GLboolean flag, void *t) + { reinterpret_cast (t)->edge_flag (flag); } + + static void CALLBACK tess_error (GLenum err, void *t) + { reinterpret_cast (t)->error (err); } + +private: + + // No copying! + + opengl_tesselator (const opengl_tesselator&); + + opengl_tesselator operator = (const opengl_tesselator&); + + GLUtesselator *glu_tess; + bool fill; +}; + +class +vertex_data +{ +public: + class vertex_data_rep + { + public: + Matrix coords; + Matrix color; + Matrix normal; + double alpha; + float ambient; + float diffuse; + float specular; + float specular_exp; + + // reference counter + octave_refcount count; + + vertex_data_rep (void) + : coords (), color (), normal (), alpha (), + ambient (), diffuse (), specular (), specular_exp (),count (1) { } + + vertex_data_rep (const Matrix& c, const Matrix& col, const Matrix& n, + double a, float as, float ds, float ss, float se) + : coords (c), color (col), normal (n), alpha (a), + ambient (as), diffuse (ds), specular (ss), specular_exp (se), + count (1) { } + }; + +private: + vertex_data_rep *rep; + + vertex_data_rep *nil_rep (void) const + { + static vertex_data_rep *nr = new vertex_data_rep (); + + return nr; + } + +public: + vertex_data (void) : rep (nil_rep ()) + { rep->count++; } + + vertex_data (const vertex_data& v) : rep (v.rep) + { rep->count++; } + + vertex_data (const Matrix& c, const Matrix& col, const Matrix& n, + double a, float as, float ds, float ss, float se) + : rep (new vertex_data_rep (c, col, n, a, as, ds, ss, se)) + { } + + vertex_data (vertex_data_rep *new_rep) + : rep (new_rep) { } + + ~vertex_data (void) + { + if (--rep->count == 0) + delete rep; + } + + vertex_data& operator = (const vertex_data& v) + { + if (--rep->count == 0) + delete rep; + + rep = v.rep; + rep->count++; + + return *this; + } + + vertex_data_rep *get_rep (void) const { return rep; } +}; + +class +opengl_renderer::patch_tesselator : public opengl_tesselator +{ +public: + patch_tesselator (opengl_renderer *r, int cmode, int lmode, int idx = 0) + : opengl_tesselator (), renderer (r), + color_mode (cmode), light_mode (lmode), index (idx), + first (true), tmp_vdata () + { } + +protected: + void begin (GLenum type) + { + //printf ("patch_tesselator::begin (%d)\n", type); + first = true; + + if (color_mode == 2 || light_mode == 2) + glShadeModel (GL_SMOOTH); + else + glShadeModel (GL_FLAT); + + if (is_filled ()) + renderer->set_polygon_offset (true, 1+index); + + glBegin (type); + } + + void end (void) + { + //printf ("patch_tesselator::end\n"); + glEnd (); + renderer->set_polygon_offset (false); + } + + void vertex (void *data) + { + vertex_data::vertex_data_rep *v + = reinterpret_cast (data); + //printf ("patch_tesselator::vertex (%g, %g, %g)\n", v->coords(0), v->coords(1), v->coords(2)); + + // FIXME: why did I need to keep the first vertex of the face + // in JHandles? I think it's related to the fact that the + // tessellation process might re-order the vertices, such that + // the first one you get here might not be the first one of the face; + // but I can't figure out the actual reason. + if (color_mode > 0 && (first || color_mode == 2)) + { + Matrix col = v->color; + + if (col.numel () == 3) + { + glColor3dv (col.data ()); + if (light_mode > 0) + { + float buf[4] = { 0, 0, 0, 1 }; + + for (int k = 0; k < 3; k++) + buf[k] = (v->ambient * col(k)); + glMaterialfv (LIGHT_MODE, GL_AMBIENT, buf); + + for (int k = 0; k < 3; k++) + buf[k] = (v->diffuse * col(k)); + glMaterialfv (LIGHT_MODE, GL_AMBIENT, buf); + } + } + } + + if (light_mode > 0 && (first || light_mode == 2)) + glNormal3dv (v->normal.data ()); + + glVertex3dv (v->coords.data ()); + + first = false; + } + + void combine (GLdouble xyz[3], void *data[4], GLfloat w[4], + void **out_data) + { + //printf ("patch_tesselator::combine\n"); + + vertex_data::vertex_data_rep *v[4]; + int vmax = 4; + + for (int i = 0; i < 4; i++) + { + v[i] = reinterpret_cast (data[i]); + + if (vmax == 4 && ! v[i]) + vmax = i; + } + + Matrix vv (1, 3, 0.0); + Matrix cc; + Matrix nn (1, 3, 0.0); + double aa = 0.0; + + vv(0) = xyz[0]; + vv(1) = xyz[1]; + vv(2) = xyz[2]; + + if (v[0]->color.numel ()) + { + cc.resize (1, 3, 0.0); + for (int ic = 0; ic < 3; ic++) + for (int iv = 0; iv < vmax; iv++) + cc(ic) += (w[iv] * v[iv]->color (ic)); + } + + if (v[0]->normal.numel () > 0) + { + for (int in = 0; in < 3; in++) + for (int iv = 0; iv < vmax; iv++) + nn(in) += (w[iv] * v[iv]->normal (in)); + } + + for (int iv = 0; iv < vmax; iv++) + aa += (w[iv] * v[iv]->alpha); + + vertex_data new_v (vv, cc, nn, aa, v[0]->ambient, v[0]->diffuse, + v[0]->specular, v[0]->specular_exp); + tmp_vdata.push_back (new_v); + + *out_data = new_v.get_rep (); + } + +private: + + // No copying! + + patch_tesselator (const patch_tesselator&); + + patch_tesselator& operator = (const patch_tesselator&); + + opengl_renderer *renderer; + int color_mode; // 0: uni, 1: flat, 2: interp + int light_mode; // 0: none, 1: flat, 2: gouraud + int index; + bool first; + std::list tmp_vdata; +}; + +void +opengl_renderer::draw (const graphics_object& go, bool toplevel) +{ + if (! go.valid_object ()) + return; + + const base_properties& props = go.get_properties (); + + if (! toolkit) + toolkit = props.get_toolkit (); + + if (go.isa ("figure")) + draw_figure (dynamic_cast (props)); + else if (go.isa ("axes")) + draw_axes (dynamic_cast (props)); + else if (go.isa ("line")) + draw_line (dynamic_cast (props)); + else if (go.isa ("surface")) + draw_surface (dynamic_cast (props)); + else if (go.isa ("patch")) + draw_patch (dynamic_cast (props)); + else if (go.isa ("hggroup")) + draw_hggroup (dynamic_cast (props)); + else if (go.isa ("text")) + draw_text (dynamic_cast (props)); + else if (go.isa ("image")) + draw_image (dynamic_cast (props)); + else if (go.isa ("uimenu") || go.isa ("uicontrol") + || go.isa ("uicontextmenu") || go.isa ("uitoolbar") + || go.isa ("uipushtool") || go.isa ("uitoggletool")) + /* SKIP */; + else if (go.isa ("uipanel")) + { + if (toplevel) + draw_uipanel (dynamic_cast (props), go); + } + else + { + warning ("opengl_renderer: cannot render object of type '%s'", + props.graphics_object_name ().c_str ()); + } +} + +void +opengl_renderer::draw_figure (const figure::properties& props) +{ + // Initialize OpenGL context + + init_gl_context (props.is___enhanced__ (), props.get_color_rgb ()); + + // Draw children + + draw (props.get_all_children (), false); +} + +void +opengl_renderer::draw_uipanel (const uipanel::properties& props, + const graphics_object& go) +{ + graphics_object fig = go.get_ancestor ("figure"); + const figure::properties& figProps = + dynamic_cast (fig.get_properties ()); + + // Initialize OpenGL context + + init_gl_context (figProps.is___enhanced__ (), + props.get_backgroundcolor_rgb ()); + + // Draw children + + draw (props.get_all_children (), false); +} + +void +opengl_renderer::init_gl_context (bool enhanced, const Matrix& c) +{ + // Initialize OpenGL context + + glEnable (GL_DEPTH_TEST); + glDepthFunc (GL_LEQUAL); + glBlendFunc (GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glAlphaFunc (GL_GREATER, 0.0f); + glEnable (GL_NORMALIZE); + + if (enhanced) + { + glEnable (GL_BLEND); + glEnable (GL_LINE_SMOOTH); + } + else + { + glDisable (GL_BLEND); + glDisable (GL_LINE_SMOOTH); + } + + // Clear background + + if (c.length () >= 3) + { + glClearColor (c(0), c(1), c(2), 1); + glClear (GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT); + } +} + +void +opengl_renderer::render_grid (const std::string& gridstyle, + const Matrix& ticks, double lim1, double lim2, + double p1, double p1N, double p2, double p2N, + int xyz, bool is_3D) +{ + set_linestyle (gridstyle, true); + glBegin (GL_LINES); + for (int i = 0; i < ticks.numel (); i++) + { + double val = ticks(i); + if (lim1 <= val && val <= lim2) + { + if (xyz == 0) // X + { + glVertex3d (val, p1N, p2); + glVertex3d (val, p1, p2); + if (is_3D) + { + glVertex3d (val, p1, p2N); + glVertex3d (val, p1, p2); + } + } + else if (xyz == 1) // Y + { + glVertex3d (p1N, val, p2); + glVertex3d (p1, val, p2); + if (is_3D) + { + glVertex3d (p1, val, p2N); + glVertex3d (p1, val, p2); + } + } + else if (xyz == 2) // Z + { + glVertex3d (p1N, p2, val); + glVertex3d (p1, p2, val); + glVertex3d (p1, p2N, val); + glVertex3d (p1, p2, val); + } + } + } + glEnd (); + set_linestyle ("-", true); +} + +void +opengl_renderer::render_tickmarks (const Matrix& ticks, + double lim1, double lim2, + double p1, double p1N, + double p2, double p2N, + double dx, double dy, double dz, + int xyz, bool mirror) +{ + glBegin (GL_LINES); + + for (int i = 0; i < ticks.numel (); i++) + { + double val = ticks(i); + + if (lim1 <= val && val <= lim2) + { + if (xyz == 0) // X + { + glVertex3d (val, p1, p2); + glVertex3d (val, p1+dy, p2+dz); + if (mirror) + { + glVertex3d (val, p1N, p2N); + glVertex3d (val, p1N-dy, p2N-dz); + } + } + else if (xyz == 1) // Y + { + glVertex3d (p1, val, p2); + glVertex3d (p1+dx, val, p2+dz); + if (mirror) + { + glVertex3d (p1N, val, p2N); + glVertex3d (p1N-dx, val, p2N-dz); + } + } + else if (xyz == 2) // Z + { + glVertex3d (p1, p2, val); + glVertex3d (p1+dx, p2+dy, val); + if (mirror) + { + glVertex3d (p1N, p2N, val); + glVertex3d (p1N-dx, p2N-dy, val); + } + } + } + } + + glEnd (); +} + +void +opengl_renderer::render_ticktexts (const Matrix& ticks, + const string_vector& ticklabels, + double lim1, double lim2, + double p1, double p2, + int xyz, int ha, int va, + int& wmax, int& hmax) +{ + int nticks = ticks.numel (); + int nlabels = ticklabels.numel (); + + if (nlabels == 0) + return; + + for (int i = 0; i < nticks; i++) + { + double val = ticks(i); + + if (lim1 <= val && val <= lim2) + { + Matrix b; + + std::string label (ticklabels(i % nlabels)); + label.erase (0, label.find_first_not_of (" ")); + label = label.substr (0, label.find_last_not_of (" ")+1); + + // FIXME: as tick text is transparent, shouldn't it be + // drawn after axes object, for correct rendering? + if (xyz == 0) // X + { + b = render_text (label, val, p1, p2, ha, va); + } + else if (xyz == 1) // Y + { + b = render_text (label, p1, val, p2, ha, va); + } + else if (xyz == 2) // Z + { + b = render_text (label, p1, p2, val, ha, va); + } + + wmax = std::max (wmax, static_cast (b(2))); + hmax = std::max (hmax, static_cast (b(3))); + } + } +} + +void +opengl_renderer::setup_opengl_transformation (const axes::properties& props) +{ + // setup OpenGL transformation + + Matrix x_zlim = props.get_transform_zlim (); + + xZ1 = x_zlim(0)-(x_zlim(1)-x_zlim(0))/2; + xZ2 = x_zlim(1)+(x_zlim(1)-x_zlim(0))/2; + + Matrix x_mat1 = props.get_opengl_matrix_1 (); + Matrix x_mat2 = props.get_opengl_matrix_2 (); + +#if defined (HAVE_FRAMEWORK_OPENGL) + GLint vw[4]; +#else + int vw[4]; +#endif + + glGetIntegerv (GL_VIEWPORT, vw); + + glMatrixMode (GL_MODELVIEW); + glLoadIdentity (); + glScaled (1, 1, -1); + glMultMatrixd (x_mat1.data ()); + glMatrixMode (GL_PROJECTION); + glLoadIdentity (); + glOrtho (0, vw[2], vw[3], 0, xZ1, xZ2); + glMultMatrixd (x_mat2.data ()); + glMatrixMode (GL_MODELVIEW); + + glClear (GL_DEPTH_BUFFER_BIT); + + glDisable (GL_LINE_SMOOTH); + + // store axes transformation data + + xform = props.get_transform (); +} + +void +opengl_renderer::draw_axes_planes (const axes::properties& props) +{ + double xPlane = props.get_xPlane (); + double yPlane = props.get_yPlane (); + double zPlane = props.get_zPlane (); + double xPlaneN = props.get_xPlaneN (); + double yPlaneN = props.get_yPlaneN (); + double zPlaneN = props.get_zPlaneN (); + + // Axes planes + Matrix axe_color = props.get_color_rgb (); + if (axe_color.numel () > 0 && props.is_visible ()) + { + set_color (axe_color); + set_polygon_offset (true, 2.5); + + glBegin (GL_QUADS); + + // X plane + glVertex3d (xPlane, yPlaneN, zPlaneN); + glVertex3d (xPlane, yPlane, zPlaneN); + glVertex3d (xPlane, yPlane, zPlane); + glVertex3d (xPlane, yPlaneN, zPlane); + + // Y plane + glVertex3d (xPlaneN, yPlane, zPlaneN); + glVertex3d (xPlane, yPlane, zPlaneN); + glVertex3d (xPlane, yPlane, zPlane); + glVertex3d (xPlaneN, yPlane, zPlane); + + // Z plane + glVertex3d (xPlaneN, yPlaneN, zPlane); + glVertex3d (xPlane, yPlaneN, zPlane); + glVertex3d (xPlane, yPlane, zPlane); + glVertex3d (xPlaneN, yPlane, zPlane); + + glEnd (); + + set_polygon_offset (false); + } +} + +void +opengl_renderer::draw_axes_boxes (const axes::properties& props) +{ + bool xySym = props.get_xySym (); + double xPlane = props.get_xPlane (); + double yPlane = props.get_yPlane (); + double zPlane = props.get_zPlane (); + double xPlaneN = props.get_xPlaneN (); + double yPlaneN = props.get_yPlaneN (); + double zPlaneN = props.get_zPlaneN (); + double xpTick = props.get_xpTick (); + double ypTick = props.get_ypTick (); + double zpTick = props.get_zpTick (); + double xpTickN = props.get_xpTickN (); + double ypTickN = props.get_ypTickN (); + double zpTickN = props.get_zpTickN (); + + bool plotyy = (props.has_property ("__plotyy_axes__")); + + // Axes box + + set_linestyle ("-", true); + set_linewidth (props.get_linewidth ()); + + if (props.is_visible ()) + { + glBegin (GL_LINES); + + // X box + set_color (props.get_xcolor_rgb ()); + glVertex3d (xPlaneN, ypTick, zpTick); + glVertex3d (xPlane, ypTick, zpTick); + + if (props.is_box ()) + { + glVertex3d (xPlaneN, ypTickN, zpTick); + glVertex3d (xPlane, ypTickN, zpTick); + glVertex3d (xPlaneN, ypTickN, zpTickN); + glVertex3d (xPlane, ypTickN, zpTickN); + glVertex3d (xPlaneN, ypTick, zpTickN); + glVertex3d (xPlane, ypTick, zpTickN); + } + + // Y box + set_color (props.get_ycolor_rgb ()); + glVertex3d (xpTick, yPlaneN, zpTick); + glVertex3d (xpTick, yPlane, zpTick); + + if (props.is_box () && ! plotyy) + { + glVertex3d (xpTickN, yPlaneN, zpTick); + glVertex3d (xpTickN, yPlane, zpTick); + glVertex3d (xpTickN, yPlaneN, zpTickN); + glVertex3d (xpTickN, yPlane, zpTickN); + glVertex3d (xpTick, yPlaneN, zpTickN); + glVertex3d (xpTick, yPlane, zpTickN); + } + + // Z box + set_color (props.get_zcolor_rgb ()); + + if (xySym) + { + glVertex3d (xPlaneN, yPlane, zPlaneN); + glVertex3d (xPlaneN, yPlane, zPlane); + } + else + { + glVertex3d (xPlane, yPlaneN, zPlaneN); + glVertex3d (xPlane, yPlaneN, zPlane); + } + + if (props.is_box ()) + { + glVertex3d (xPlane, yPlane, zPlaneN); + glVertex3d (xPlane, yPlane, zPlane); + + if (xySym) + { + glVertex3d (xPlane, yPlaneN, zPlaneN); + glVertex3d (xPlane, yPlaneN, zPlane); + } + else + { + glVertex3d (xPlaneN, yPlane, zPlaneN); + glVertex3d (xPlaneN, yPlane, zPlane); + } + + glVertex3d (xPlaneN, yPlaneN, zPlaneN); + glVertex3d (xPlaneN, yPlaneN, zPlane); + } + + glEnd (); + } +} + +void +opengl_renderer::draw_axes_x_grid (const axes::properties& props) +{ + int xstate = props.get_xstate (); + int zstate = props.get_zstate (); + bool x2Dtop = props.get_x2Dtop (); + bool layer2Dtop = props.get_layer2Dtop (); + bool xyzSym = props.get_xyzSym (); + bool nearhoriz = props.get_nearhoriz (); + double xticklen = props.get_xticklen (); + double xtickoffset = props.get_xtickoffset (); + double fy = props.get_fy (); + double fz = props.get_fz (); + double x_min = props.get_x_min (); + double x_max = props.get_x_max (); + double yPlane = props.get_yPlane (); + double yPlaneN = props.get_yPlaneN (); + double ypTick = props.get_ypTick (); + double ypTickN = props.get_ypTickN (); + double zPlane = props.get_zPlane (); + double zPlaneN = props.get_zPlaneN (); + double zpTick = props.get_zpTick (); + double zpTickN = props.get_zpTickN (); + + // X grid + + if (props.is_visible () && xstate != AXE_DEPTH_DIR) + { + std::string gridstyle = props.get_gridlinestyle (); + std::string minorgridstyle = props.get_minorgridlinestyle (); + bool do_xgrid = (props.is_xgrid () && (gridstyle != "none")); + bool do_xminorgrid = (props.is_xminorgrid () && (minorgridstyle != "none")); + bool do_xminortick = props.is_xminortick (); + Matrix xticks = xform.xscale (props.get_xtick ().matrix_value ()); + Matrix xmticks = xform.xscale (props.get_xmtick ().matrix_value ()); + string_vector xticklabels = props.get_xticklabel ().all_strings (); + int wmax = 0, hmax = 0; + bool tick_along_z = nearhoriz || xisinf (fy); + bool mirror = props.is_box () && xstate != AXE_ANY_DIR; + + set_color (props.get_xcolor_rgb ()); + + // grid lines + if (do_xgrid) + render_grid (gridstyle, xticks, x_min, x_max, + yPlane, yPlaneN, layer2Dtop ? zPlaneN : zPlane, + zPlaneN, 0, (zstate != AXE_DEPTH_DIR)); + + // tick marks + if (tick_along_z) + { + render_tickmarks (xticks, x_min, x_max, ypTick, ypTick, + zpTick, zpTickN, 0., 0., + signum (zpTick-zpTickN)*fz*xticklen, + 0, mirror); + } + else + { + render_tickmarks (xticks, x_min, x_max, ypTick, ypTickN, + zpTick, zpTick, 0., + signum (ypTick-ypTickN)*fy*xticklen, + 0., 0, mirror); + } + + // tick texts + if (xticklabels.numel () > 0) + { + int halign = (xstate == AXE_HORZ_DIR ? 1 : (xyzSym ? 0 : 2)); + int valign = (xstate == AXE_VERT_DIR ? 1 : (x2Dtop ? 0 : 2)); + + if (tick_along_z) + render_ticktexts (xticks, xticklabels, x_min, x_max, ypTick, + zpTick+signum (zpTick-zpTickN)*fz*xtickoffset, + 0, halign, valign, wmax, hmax); + else + render_ticktexts (xticks, xticklabels, x_min, x_max, + ypTick+signum (ypTick-ypTickN)*fy*xtickoffset, + zpTick, 0, halign, valign, wmax, hmax); + } + + // minor grid lines + if (do_xminorgrid) + render_grid (minorgridstyle, xmticks, x_min, x_max, + yPlane, yPlaneN, layer2Dtop ? zPlaneN : zPlane, + zPlaneN, 0, (zstate != AXE_DEPTH_DIR)); + + // minor tick marks + if (do_xminortick) + { + if (tick_along_z) + render_tickmarks (xmticks, x_min, x_max, ypTick, ypTick, + zpTick, zpTickN, 0., 0., + signum (zpTick-zpTickN)*fz*xticklen/2, + 0, mirror); + else + render_tickmarks (xmticks, x_min, x_max, ypTick, ypTickN, + zpTick, zpTick, 0., + signum (ypTick-ypTickN)*fy*xticklen/2, + 0., 0, mirror); + } + + gh_manager::get_object (props.get_xlabel ()).set ("visible", "on"); + } + else + gh_manager::get_object (props.get_xlabel ()).set ("visible", "off"); +} + +void +opengl_renderer::draw_axes_y_grid (const axes::properties& props) +{ + int ystate = props.get_ystate (); + int zstate = props.get_zstate (); + bool y2Dright = props.get_y2Dright (); + bool layer2Dtop = props.get_layer2Dtop (); + bool xyzSym = props.get_xyzSym (); + bool nearhoriz = props.get_nearhoriz (); + double yticklen = props.get_yticklen (); + double ytickoffset = props.get_ytickoffset (); + double fx = props.get_fx (); + double fz = props.get_fz (); + double xPlane = props.get_xPlane (); + double xPlaneN = props.get_xPlaneN (); + double xpTick = props.get_xpTick (); + double xpTickN = props.get_xpTickN (); + double y_min = props.get_y_min (); + double y_max = props.get_y_max (); + double zPlane = props.get_zPlane (); + double zPlaneN = props.get_zPlaneN (); + double zpTick = props.get_zpTick (); + double zpTickN = props.get_zpTickN (); + + // Y grid + + if (ystate != AXE_DEPTH_DIR && props.is_visible ()) + { + std::string gridstyle = props.get_gridlinestyle (); + std::string minorgridstyle = props.get_minorgridlinestyle (); + bool do_ygrid = (props.is_ygrid () && (gridstyle != "none")); + bool do_yminorgrid = (props.is_yminorgrid () && (minorgridstyle != "none")); + bool do_yminortick = props.is_yminortick (); + Matrix yticks = xform.yscale (props.get_ytick ().matrix_value ()); + Matrix ymticks = xform.yscale (props.get_ymtick ().matrix_value ()); + string_vector yticklabels = props.get_yticklabel ().all_strings (); + int wmax = 0, hmax = 0; + bool tick_along_z = nearhoriz || xisinf (fx); + bool mirror = props.is_box () && ystate != AXE_ANY_DIR + && (! props.has_property ("__plotyy_axes__")); + + set_color (props.get_ycolor_rgb ()); + + // grid lines + if (do_ygrid) + render_grid (gridstyle, yticks, y_min, y_max, + xPlane, xPlaneN, layer2Dtop ? zPlaneN : zPlane, + zPlaneN, 1, (zstate != AXE_DEPTH_DIR)); + + // tick marks + if (tick_along_z) + render_tickmarks (yticks, y_min, y_max, xpTick, xpTick, + zpTick, zpTickN, 0., 0., + signum (zpTick-zpTickN)*fz*yticklen, + 1, mirror); + else + render_tickmarks (yticks, y_min, y_max, xpTick, xpTickN, + zpTick, zpTick, + signum (xPlaneN-xPlane)*fx*yticklen, + 0., 0., 1, mirror); + + // tick texts + if (yticklabels.numel () > 0) + { + int halign = (ystate == AXE_HORZ_DIR + ? 1 : (!xyzSym || y2Dright ? 0 : 2)); + int valign = (ystate == AXE_VERT_DIR ? 1 : 2); + + if (tick_along_z) + render_ticktexts (yticks, yticklabels, y_min, y_max, xpTick, + zpTick+signum (zpTick-zpTickN)*fz*ytickoffset, + 1, halign, valign, wmax, hmax); + else + render_ticktexts (yticks, yticklabels, y_min, y_max, + xpTick+signum (xpTick-xpTickN)*fx*ytickoffset, + zpTick, 1, halign, valign, wmax, hmax); + } + + // minor grid lines + if (do_yminorgrid) + render_grid (minorgridstyle, ymticks, y_min, y_max, + xPlane, xPlaneN, layer2Dtop ? zPlaneN : zPlane, + zPlaneN, 1, (zstate != AXE_DEPTH_DIR)); + + // minor tick marks + if (do_yminortick) + { + if (tick_along_z) + render_tickmarks (ymticks, y_min, y_max, xpTick, xpTick, + zpTick, zpTickN, 0., 0., + signum (zpTick-zpTickN)*fz*yticklen/2, + 1, mirror); + else + render_tickmarks (ymticks, y_min, y_max, xpTick, xpTickN, + zpTick, zpTick, + signum (xpTick-xpTickN)*fx*yticklen/2, + 0., 0., 1, mirror); + } + + gh_manager::get_object (props.get_ylabel ()).set ("visible", "on"); + } + else + gh_manager::get_object (props.get_ylabel ()).set ("visible", "off"); +} + +void +opengl_renderer::draw_axes_z_grid (const axes::properties& props) +{ + int zstate = props.get_zstate (); + bool xySym = props.get_xySym (); + bool zSign = props.get_zSign (); + double zticklen = props.get_zticklen (); + double ztickoffset = props.get_ztickoffset (); + double fx = props.get_fx (); + double fy = props.get_fy (); + double xPlane = props.get_xPlane (); + double xPlaneN = props.get_xPlaneN (); + double yPlane = props.get_yPlane (); + double yPlaneN = props.get_yPlaneN (); + double z_min = props.get_z_min (); + double z_max = props.get_z_max (); + + // Z Grid + + if (zstate != AXE_DEPTH_DIR && props.is_visible ()) + { + std::string gridstyle = props.get_gridlinestyle (); + std::string minorgridstyle = props.get_minorgridlinestyle (); + bool do_zgrid = (props.is_zgrid () && (gridstyle != "none")); + bool do_zminorgrid = (props.is_zminorgrid () && (minorgridstyle != "none")); + bool do_zminortick = props.is_zminortick (); + Matrix zticks = xform.zscale (props.get_ztick ().matrix_value ()); + Matrix zmticks = xform.zscale (props.get_zmtick ().matrix_value ()); + string_vector zticklabels = props.get_zticklabel ().all_strings (); + int wmax = 0, hmax = 0; + bool mirror = props.is_box () && zstate != AXE_ANY_DIR; + + set_color (props.get_zcolor_rgb ()); + + // grid lines + if (do_zgrid) + render_grid (gridstyle, zticks, z_min, z_max, + xPlane, xPlaneN, yPlane, yPlaneN, 2, true); + + // tick marks + if (xySym) + { + if (xisinf (fy)) + render_tickmarks (zticks, z_min, z_max, xPlaneN, xPlane, + yPlane, yPlane, + signum (xPlaneN-xPlane)*fx*zticklen, + 0., 0., 2, mirror); + else + render_tickmarks (zticks, z_min, z_max, xPlaneN, xPlaneN, + yPlane, yPlane, 0., + signum (yPlane-yPlaneN)*fy*zticklen, + 0., 2, false); + } + else + { + if (xisinf (fx)) + render_tickmarks (zticks, z_min, z_max, xPlaneN, xPlane, + yPlaneN, yPlane, 0., + signum (yPlaneN-yPlane)*fy*zticklen, + 0., 2, mirror); + else + render_tickmarks (zticks, z_min, z_max, xPlane, xPlane, + yPlaneN, yPlane, + signum (xPlane-xPlaneN)*fx*zticklen, + 0., 0., 2, false); + } + + // FIXME: tick texts + if (zticklabels.numel () > 0) + { + int halign = 2; + int valign = (zstate == AXE_VERT_DIR ? 1 : (zSign ? 3 : 2)); + + if (xySym) + { + if (xisinf (fy)) + render_ticktexts (zticks, zticklabels, z_min, z_max, + xPlaneN+signum (xPlaneN-xPlane)*fx*ztickoffset, + yPlane, 2, halign, valign, wmax, hmax); + else + render_ticktexts (zticks, zticklabels, z_min, z_max, xPlaneN, + yPlane+signum (yPlane-yPlaneN)*fy*ztickoffset, + 2, halign, valign, wmax, hmax); + } + else + { + if (xisinf (fx)) + render_ticktexts (zticks, zticklabels, z_min, z_max, xPlane, + yPlaneN+signum (yPlaneN-yPlane)*fy*ztickoffset, + 2, halign, valign, wmax, hmax); + else + render_ticktexts (zticks, zticklabels, z_min, z_max, + xPlane+signum (xPlane-xPlaneN)*fx*ztickoffset, + yPlaneN, 2, halign, valign, wmax, hmax); + } + } + + // minor grid lines + if (do_zminorgrid) + render_grid (minorgridstyle, zmticks, z_min, z_max, + xPlane, xPlaneN, yPlane, yPlaneN, 2, true); + + // minor tick marks + if (do_zminortick) + { + if (xySym) + { + if (xisinf (fy)) + render_tickmarks (zmticks, z_min, z_max, xPlaneN, xPlane, + yPlane, yPlane, + signum (xPlaneN-xPlane)*fx*zticklen/2, + 0., 0., 2, mirror); + else + render_tickmarks (zmticks, z_min, z_max, xPlaneN, xPlaneN, + yPlane, yPlane, 0., + signum (yPlane-yPlaneN)*fy*zticklen/2, + 0., 2, false); + } + else + { + if (xisinf (fx)) + render_tickmarks (zmticks, z_min, z_max, xPlane, xPlane, + yPlaneN, yPlane, 0., + signum (yPlaneN-yPlane)*fy*zticklen/2, + 0., 2, mirror); + else + render_tickmarks (zmticks, z_min, z_max, xPlane, xPlane, + yPlaneN, yPlaneN, + signum (xPlane-xPlaneN)*fx*zticklen/2, + 0., 0., 2, false); + } + } + + gh_manager::get_object (props.get_zlabel ()).set ("visible", "on"); + } + else + gh_manager::get_object (props.get_zlabel ()).set ("visible", "off"); +} + +void +opengl_renderer::draw_axes_children (const axes::properties& props) +{ + // Children + + GLboolean antialias; + glGetBooleanv (GL_LINE_SMOOTH, &antialias); + + if (antialias == GL_TRUE) + glEnable (GL_LINE_SMOOTH); + + Matrix children = props.get_all_children (); + std::list obj_list; + std::list::iterator it; + + // 1st pass: draw light objects + + // Start with the last element of the array of child objects to + // display them in the oder they were added to the array. + + for (octave_idx_type i = children.numel () - 1; i >= 0; i--) + { + graphics_object go = gh_manager::get_object (children (i)); + + if (go.get_properties ().is_visible ()) + { + if (go.isa ("light")) + draw (go); + else + obj_list.push_back (go); + } + } + + // 2nd pass: draw other objects (with units set to "data") + + it = obj_list.begin (); + while (it != obj_list.end ()) + { + graphics_object go = (*it); + + // FIXME: check whether object has "units" property and it is set + // to "data" + if (! go.isa ("text") || go.get ("units").string_value () == "data") + { + set_clipping (go.get_properties ().is_clipping ()); + draw (go); + + it = obj_list.erase (it); + } + else + it++; + } + + // 3rd pass: draw remaining objects + + glDisable (GL_DEPTH_TEST); + + for (it = obj_list.begin (); it != obj_list.end (); it++) + { + graphics_object go = (*it); + + set_clipping (go.get_properties ().is_clipping ()); + draw (go); + } + + glEnable (GL_DEPTH_TEST); + + set_clipping (false); + + // FIXME: finalize rendering (transparency processing) + // FIXME: draw zoom box, if needed +} + +void +opengl_renderer::draw_axes (const axes::properties& props) +{ + double x_min = props.get_x_min (); + double x_max = props.get_x_max (); + double y_min = props.get_y_min (); + double y_max = props.get_y_max (); + double z_min = props.get_z_min (); + double z_max = props.get_z_max (); + + setup_opengl_transformation (props); + + // draw axes object + + draw_axes_planes (props); + draw_axes_boxes (props); + + set_font (props); + + draw_axes_x_grid (props); + draw_axes_y_grid (props); + draw_axes_z_grid (props); + + set_linestyle ("-"); + + set_clipbox (x_min, x_max, y_min, y_max, z_min, z_max); + + draw_axes_children (props); +} + +void +opengl_renderer::draw_line (const line::properties& props) +{ + Matrix x = xform.xscale (props.get_xdata ().matrix_value ()); + Matrix y = xform.yscale (props.get_ydata ().matrix_value ()); + Matrix z = xform.zscale (props.get_zdata ().matrix_value ()); + + bool has_z = (z.numel () > 0); + int n = static_cast (::xmin (::xmin (x.numel (), y.numel ()), (has_z ? z.numel () : std::numeric_limits::max ()))); + octave_uint8 clip_mask = (props.is_clipping () ? 0x7F : 0x40), clip_ok (0x40); + + std::vector clip (n); + + if (has_z) + for (int i = 0; i < n; i++) + clip[i] = (clip_code (x(i), y(i), z(i)) & clip_mask); + else + { + double z_mid = (zmin+zmax)/2; + + for (int i = 0; i < n; i++) + clip[i] = (clip_code (x(i), y(i), z_mid) & clip_mask); + } + + if (! props.linestyle_is ("none")) + { + set_color (props.get_color_rgb ()); + set_linestyle (props.get_linestyle (), false); + set_linewidth (props.get_linewidth ()); + + if (has_z) + { + bool flag = false; + + for (int i = 1; i < n; i++) + { + if ((clip[i-1] & clip[i]) == clip_ok) + { + if (! flag) + { + flag = true; + glBegin (GL_LINE_STRIP); + glVertex3d (x(i-1), y(i-1), z(i-1)); + } + glVertex3d (x(i), y(i), z(i)); + } + else if (flag) + { + flag = false; + glEnd (); + } + } + + if (flag) + glEnd (); + } + else + { + bool flag = false; + + for (int i = 1; i < n; i++) + { + if ((clip[i-1] & clip[i]) == clip_ok) + { + if (! flag) + { + flag = true; + glBegin (GL_LINE_STRIP); + glVertex2d (x(i-1), y(i-1)); + } + glVertex2d (x(i), y(i)); + } + else if (flag) + { + flag = false; + glEnd (); + } + } + + if (flag) + glEnd (); + } + + set_linewidth (0.5); + set_linestyle ("-"); + } + + set_clipping (false); + + if (! props.marker_is ("none") && + ! (props.markeredgecolor_is ("none") + && props.markerfacecolor_is ("none"))) + { + Matrix lc, fc; + + if (props.markeredgecolor_is ("auto")) + lc = props.get_color_rgb (); + else if (! props.markeredgecolor_is ("none")) + lc = props.get_markeredgecolor_rgb (); + + if (props.markerfacecolor_is ("auto")) + fc = props.get_color_rgb (); + else if (! props.markerfacecolor_is ("none")) + fc = props.get_markerfacecolor_rgb (); + + init_marker (props.get_marker (), props.get_markersize (), + props.get_linewidth ()); + + for (int i = 0; i < n; i++) + { + if (clip[i] == clip_ok) + draw_marker (x(i), y(i), + has_z ? z(i) : static_cast (i) / n, + lc, fc); + } + + end_marker (); + } + + set_clipping (props.is_clipping ()); +} + +void +opengl_renderer::draw_surface (const surface::properties& props) +{ + const Matrix x = xform.xscale (props.get_xdata ().matrix_value ()); + const Matrix y = xform.yscale (props.get_ydata ().matrix_value ()); + const Matrix z = xform.zscale (props.get_zdata ().matrix_value ()); + + int zr = z.rows (), zc = z.columns (); + + NDArray c; + const NDArray n = props.get_vertexnormals ().array_value (); + + // FIXME: handle transparency + Matrix a; + + if (props.facelighting_is ("phong") || props.edgelighting_is ("phong")) + warning ("opengl_renderer::draw: phong light model not supported"); + + int fc_mode = (props.facecolor_is_rgb () ? 0 : + (props.facecolor_is ("flat") ? 1 : + (props.facecolor_is ("interp") ? 2 : + (props.facecolor_is ("texturemap") ? 3 : -1)))); + int fl_mode = (props.facelighting_is ("none") ? 0 : + (props.facelighting_is ("flat") ? 1 : 2)); + int fa_mode = (props.facealpha_is_double () ? 0 : + (props.facealpha_is ("flat") ? 1 : 2)); + int ec_mode = (props.edgecolor_is_rgb () ? 0 : + (props.edgecolor_is ("flat") ? 1 : + (props.edgecolor_is ("interp") ? 2 : -1))); + int el_mode = (props.edgelighting_is ("none") ? 0 : + (props.edgelighting_is ("flat") ? 1 : 2)); + int ea_mode = (props.edgealpha_is_double () ? 0 : + (props.edgealpha_is ("flat") ? 1 : 2)); + + Matrix fcolor = (fc_mode == 3 ? Matrix (1, 3, 1.0) : props.get_facecolor_rgb ()); + Matrix ecolor = props.get_edgecolor_rgb (); + + float as = props.get_ambientstrength (); + float ds = props.get_diffusestrength (); + float ss = props.get_specularstrength (); + float se = props.get_specularexponent (); + float cb[4] = { 0.0, 0.0, 0.0, 1.0 }; + double d = 1.0; + + opengl_texture tex; + + int i1, i2, j1, j2; + bool x_mat = (x.rows () == z.rows ()); + bool y_mat = (y.columns () == z.columns ()); + + i1 = i2 = j1 = j2 = 0; + + boolMatrix clip (z.dims (), false); + + for (int i = 0; i < zr; i++) + { + if (x_mat) + i1 = i; + + for (int j = 0; j < zc; j++) + { + if (y_mat) + j1 = j; + + clip(i,j) = is_nan_or_inf (x(i1,j), y(i,j1), z(i,j)); + } + } + + if ((fc_mode > 0 && fc_mode < 3) || ec_mode > 0) + c = props.get_color_data ().array_value (); + + if (fa_mode > 0 || ea_mode > 0) + { + // FIXME: implement alphadata conversion + //a = props.get_alpha_data (); + } + + if (fl_mode > 0 || el_mode > 0) + { + float buf[4] = { ss, ss, ss, 1 }; + + glMaterialfv (LIGHT_MODE, GL_SPECULAR, buf); + glMaterialf (LIGHT_MODE, GL_SHININESS, se); + } + + // FIXME: good candidate for caching, transfering pixel + // data to OpenGL is time consuming. + if (fc_mode == 3) + tex = opengl_texture::create (props.get_color_data ()); + + if (! props.facecolor_is ("none")) + { + if (props.get_facealpha_double () == 1) + { + if (fc_mode == 0 || fc_mode == 3) + { + glColor3dv (fcolor.data ()); + if (fl_mode > 0) + { + for (int i = 0; i < 3; i++) + cb[i] = as * fcolor(i); + glMaterialfv (LIGHT_MODE, GL_AMBIENT, cb); + + for (int i = 0; i < 3; i++) + cb[i] = ds * fcolor(i); + glMaterialfv (LIGHT_MODE, GL_DIFFUSE, cb); + } + } + + if (fl_mode > 0) + glEnable (GL_LIGHTING); + glShadeModel ((fc_mode == 2 || fl_mode == 2) ? GL_SMOOTH : GL_FLAT); + set_polygon_offset (true, 1); + if (fc_mode == 3) + glEnable (GL_TEXTURE_2D); + + for (int i = 1; i < zc; i++) + { + if (y_mat) + { + i1 = i-1; + i2 = i; + } + + for (int j = 1; j < zr; j++) + { + if (clip(j-1, i-1) || clip (j, i-1) + || clip (j-1, i) || clip (j, i)) + continue; + + if (x_mat) + { + j1 = j-1; + j2 = j; + } + + glBegin (GL_QUADS); + + // Vertex 1 + if (fc_mode == 3) + tex.tex_coord (double (i-1) / (zc-1), double (j-1) / (zr-1)); + else if (fc_mode > 0) + { + // FIXME: is there a smarter way to do this? + for (int k = 0; k < 3; k++) + cb[k] = c(j-1, i-1, k); + glColor3fv (cb); + + if (fl_mode > 0) + { + for (int k = 0; k < 3; k++) + cb[k] *= as; + glMaterialfv (LIGHT_MODE, GL_AMBIENT, cb); + + for (int k = 0; k < 3; k++) + cb[k] = ds * c(j-1, i-1, k); + glMaterialfv (LIGHT_MODE, GL_DIFFUSE, cb); + } + } + if (fl_mode > 0) + { + d = sqrt (n(j-1,i-1,0) * n(j-1,i-1,0) + + n(j-1,i-1,1) * n(j-1,i-1,1) + + n(j-1,i-1,2) * n(j-1,i-1,2)); + glNormal3d (n(j-1,i-1,0)/d, n(j-1,i-1,1)/d, n(j-1,i-1,2)/d); + } + glVertex3d (x(j1,i-1), y(j-1,i1), z(j-1,i-1)); + + // Vertex 2 + if (fc_mode == 3) + tex.tex_coord (double (i) / (zc-1), double (j-1) / (zr-1)); + else if (fc_mode == 2) + { + for (int k = 0; k < 3; k++) + cb[k] = c(j-1, i, k); + glColor3fv (cb); + + if (fl_mode > 0) + { + for (int k = 0; k < 3; k++) + cb[k] *= as; + glMaterialfv (LIGHT_MODE, GL_AMBIENT, cb); + + for (int k = 0; k < 3; k++) + cb[k] = ds * c(j-1, i, k); + glMaterialfv (LIGHT_MODE, GL_DIFFUSE, cb); + } + } + + if (fl_mode == 2) + { + d = sqrt (n(j-1,i,0) * n(j-1,i,0) + + n(j-1,i,1) * n(j-1,i,1) + + n(j-1,i,2) * n(j-1,i,2)); + glNormal3d (n(j-1,i,0)/d, n(j-1,i,1)/d, n(j-1,i,2)/d); + } + + glVertex3d (x(j1,i), y(j-1,i2), z(j-1,i)); + + // Vertex 3 + if (fc_mode == 3) + tex.tex_coord (double (i) / (zc-1), double (j) / (zr-1)); + else if (fc_mode == 2) + { + for (int k = 0; k < 3; k++) + cb[k] = c(j, i, k); + glColor3fv (cb); + + if (fl_mode > 0) + { + for (int k = 0; k < 3; k++) + cb[k] *= as; + glMaterialfv (LIGHT_MODE, GL_AMBIENT, cb); + + for (int k = 0; k < 3; k++) + cb[k] = ds * c(j, i, k); + glMaterialfv (LIGHT_MODE, GL_DIFFUSE, cb); + } + } + if (fl_mode == 2) + { + d = sqrt (n(j,i,0) * n(j,i,0) + + n(j,i,1) * n(j,i,1) + + n(j,i,2) * n(j,i,2)); + glNormal3d (n(j,i,0)/d, n(j,i,1)/d, n(j,i,2)/d); + } + glVertex3d (x(j2,i), y(j,i2), z(j,i)); + + // Vertex 4 + if (fc_mode == 3) + tex.tex_coord (double (i-1) / (zc-1), double (j) / (zr-1)); + else if (fc_mode == 2) + { + for (int k = 0; k < 3; k++) + cb[k] = c(j, i-1, k); + glColor3fv (cb); + + if (fl_mode > 0) + { + for (int k = 0; k < 3; k++) + cb[k] *= as; + glMaterialfv (LIGHT_MODE, GL_AMBIENT, cb); + + for (int k = 0; k < 3; k++) + cb[k] = ds * c(j, i-1, k); + glMaterialfv (LIGHT_MODE, GL_DIFFUSE, cb); + } + } + if (fl_mode == 2) + { + d = sqrt (n(j,i-1,0) * n(j,i-1,0) + + n(j,i-1,1) * n(j,i-1,1) + + n(j,i-1,2) * n(j,i-1,2)); + glNormal3d (n(j,i-1,0)/d, n(j,i-1,1)/d, n(j,i-1,2)/d); + } + glVertex3d (x(j2,i-1), y(j,i1), z(j,i-1)); + + glEnd (); + } + } + + set_polygon_offset (false); + if (fc_mode == 3) + glDisable (GL_TEXTURE_2D); + + if (fl_mode > 0) + glDisable (GL_LIGHTING); + } + else + { + // FIXME: implement transparency + } + } + + if (! props.edgecolor_is ("none")) + { + if (props.get_edgealpha_double () == 1) + { + if (ec_mode == 0) + { + glColor3dv (ecolor.data ()); + if (fl_mode > 0) + { + for (int i = 0; i < 3; i++) + cb[i] = as * ecolor(i); + glMaterialfv (LIGHT_MODE, GL_AMBIENT, cb); + + for (int i = 0; i < 3; i++) + cb[i] = ds * ecolor(i); + glMaterialfv (LIGHT_MODE, GL_DIFFUSE, cb); + } + } + + if (el_mode > 0) + glEnable (GL_LIGHTING); + glShadeModel ((ec_mode == 2 || el_mode == 2) ? GL_SMOOTH : GL_FLAT); + + set_linestyle (props.get_linestyle (), false); + set_linewidth (props.get_linewidth ()); + + // Mesh along Y-axis + + if (props.meshstyle_is ("both") || props.meshstyle_is ("column")) + { + for (int i = 0; i < zc; i++) + { + if (y_mat) + { + i1 = i-1; + i2 = i; + } + + for (int j = 1; j < zr; j++) + { + if (clip(j-1,i) || clip(j,i)) + continue; + + if (x_mat) + { + j1 = j-1; + j2 = j; + } + + glBegin (GL_LINES); + + // Vertex 1 + if (ec_mode > 0) + { + for (int k = 0; k < 3; k++) + cb[k] = c(j-1, i, k); + glColor3fv (cb); + + if (fl_mode > 0) + { + for (int k = 0; k < 3; k++) + cb[k] *= as; + glMaterialfv (LIGHT_MODE, GL_AMBIENT, cb); + + for (int k = 0; k < 3; k++) + cb[k] = ds * c(j-1, i, k); + glMaterialfv (LIGHT_MODE, GL_DIFFUSE, cb); + } + } + if (el_mode > 0) + { + d = sqrt (n(j-1,i,0) * n(j-1,i,0) + + n(j-1,i,1) * n(j-1,i,1) + + n(j-1,i,2) * n(j-1,i,2)); + glNormal3d (n(j-1,i,0)/d, n(j-1,i,1)/d, n(j-1,i,2)/d); + } + glVertex3d (x(j1,i), y(j-1,i2), z(j-1,i)); + + // Vertex 2 + if (ec_mode == 2) + { + for (int k = 0; k < 3; k++) + cb[k] = c(j, i, k); + glColor3fv (cb); + + if (fl_mode > 0) + { + for (int k = 0; k < 3; k++) + cb[k] *= as; + glMaterialfv (LIGHT_MODE, GL_AMBIENT, cb); + + for (int k = 0; k < 3; k++) + cb[k] = ds * c(j, i, k); + glMaterialfv (LIGHT_MODE, GL_DIFFUSE, cb); + } + } + if (el_mode == 2) + { + d = sqrt (n(j,i,0) * n(j,i,0) + + n(j,i,1) * n(j,i,1) + + n(j,i,2) * n(j,i,2)); + glNormal3d (n(j,i,0)/d, n(j,i,1)/d, n(j,i,2)/d); + } + glVertex3d (x(j2,i), y(j,i2), z(j,i)); + + glEnd (); + } + } + } + + // Mesh along X-axis + + if (props.meshstyle_is ("both") || props.meshstyle_is ("row")) + { + for (int j = 0; j < zr; j++) + { + if (x_mat) + { + j1 = j-1; + j2 = j; + } + + for (int i = 1; i < zc; i++) + { + if (clip(j,i-1) || clip(j,i)) + continue; + + if (y_mat) + { + i1 = i-1; + i2 = i; + } + + glBegin (GL_LINES); + + // Vertex 1 + if (ec_mode > 0) + { + for (int k = 0; k < 3; k++) + cb[k] = c(j, i-1, k); + glColor3fv (cb); + + if (fl_mode > 0) + { + for (int k = 0; k < 3; k++) + cb[k] *= as; + glMaterialfv (LIGHT_MODE, GL_AMBIENT, cb); + + for (int k = 0; k < 3; k++) + cb[k] = ds * c(j, i-1, k); + glMaterialfv (LIGHT_MODE, GL_DIFFUSE, cb); + } + } + if (el_mode > 0) + { + d = sqrt (n(j,i-1,0) * n(j,i-1,0) + + n(j,i-1,1) * n(j,i-1,1) + + n(j,i-1,2) * n(j,i-1,2)); + glNormal3d (n(j,i-1,0)/d, n(j,i-1,1)/d, n(j,i-1,2)/d); + } + glVertex3d (x(j2,i-1), y(j,i1), z(j,i-1)); + + // Vertex 2 + if (ec_mode == 2) + { + for (int k = 0; k < 3; k++) + cb[k] = c(j, i, k); + glColor3fv (cb); + + if (fl_mode > 0) + { + for (int k = 0; k < 3; k++) + cb[k] *= as; + glMaterialfv (LIGHT_MODE, GL_AMBIENT, cb); + + for (int k = 0; k < 3; k++) + cb[k] = ds * c(j, i, k); + glMaterialfv (LIGHT_MODE, GL_DIFFUSE, cb); + } + } + if (el_mode == 2) + { + d = sqrt (n(j,i,0) * n(j,i,0) + + n(j,i,1) * n(j,i,1) + + n(j,i,2) * n(j,i,2)); + glNormal3d (n(j,i,0)/d, n(j,i,1)/d, n(j,i,2)/d); + } + glVertex3d (x(j2,i), y(j,i2), z(j,i)); + + glEnd (); + } + } + } + + set_linestyle ("-"); + set_linewidth (0.5); + + if (el_mode > 0) + glDisable (GL_LIGHTING); + } + else + { + // FIXME: implement transparency + } + } + + if (! props.marker_is ("none") && + ! (props.markeredgecolor_is ("none") + && props.markerfacecolor_is ("none"))) + { + // FIXME: check how transparency should be handled in markers + // FIXME: check what to do with marker facecolor set to auto + // and facecolor set to none. + + bool do_edge = ! props.markeredgecolor_is ("none"); + bool do_face = ! props.markerfacecolor_is ("none"); + + Matrix mecolor = props.get_markeredgecolor_rgb (); + Matrix mfcolor = props.get_markerfacecolor_rgb (); + Matrix cc (1, 3, 0.0); + + if (mecolor.numel () == 0 && props.markeredgecolor_is ("auto")) + { + mecolor = props.get_edgecolor_rgb (); + do_edge = ! props.edgecolor_is ("none"); + } + + if (mfcolor.numel () == 0 && props.markerfacecolor_is ("auto")) + { + mfcolor = props.get_facecolor_rgb (); + do_face = ! props.facecolor_is ("none"); + } + + if ((mecolor.numel () == 0 || mfcolor.numel () == 0) + && c.numel () == 0) + c = props.get_color_data ().array_value (); + + init_marker (props.get_marker (), props.get_markersize (), + props.get_linewidth ()); + + for (int i = 0; i < zc; i++) + { + if (y_mat) + i1 = i; + + for (int j = 0; j < zr; j++) + { + if (clip(j,i)) + continue; + + if (x_mat) + j1 = j; + + if ((do_edge && mecolor.numel () == 0) + || (do_face && mfcolor.numel () == 0)) + { + for (int k = 0; k < 3; k++) + cc(k) = c(j,i,k); + } + + Matrix lc = (do_edge ? (mecolor.numel () == 0 ? cc : mecolor) : Matrix ()); + Matrix fc = (do_face ? (mfcolor.numel () == 0 ? cc : mfcolor) : Matrix ()); + + draw_marker (x(j1,i), y(j,i1), z(j,i), lc, fc); + } + } + + end_marker (); + } +} + +// FIXME: global optimization (rendering, data structures...), there +// is probably a smarter/faster/less-memory-consuming way to do this. +void +opengl_renderer::draw_patch (const patch::properties &props) +{ + const Matrix f = props.get_faces ().matrix_value (); + const Matrix v = xform.scale (props.get_vertices ().matrix_value ()); + Matrix c; + const Matrix n = props.get_vertexnormals ().matrix_value (); + Matrix a; + + int nv = v.rows (); + // int vmax = v.columns (); + int nf = f.rows (); + int fcmax = f.columns (); + + bool has_z = (v.columns () > 2); + bool has_facecolor = false; + bool has_facealpha = false; + + int fc_mode = ((props.facecolor_is ("none") + || props.facecolor_is_rgb ()) ? 0 : + (props.facecolor_is ("flat") ? 1 : 2)); + int fl_mode = (props.facelighting_is ("none") ? 0 : + (props.facelighting_is ("flat") ? 1 : 2)); + int fa_mode = (props.facealpha_is_double () ? 0 : + (props.facealpha_is ("flat") ? 1 : 2)); + int ec_mode = ((props.edgecolor_is ("none") + || props.edgecolor_is_rgb ()) ? 0 : + (props.edgecolor_is ("flat") ? 1 : 2)); + int el_mode = (props.edgelighting_is ("none") ? 0 : + (props.edgelighting_is ("flat") ? 1 : 2)); + int ea_mode = (props.edgealpha_is_double () ? 0 : + (props.edgealpha_is ("flat") ? 1 : 2)); + + Matrix fcolor = props.get_facecolor_rgb (); + Matrix ecolor = props.get_edgecolor_rgb (); + + float as = props.get_ambientstrength (); + float ds = props.get_diffusestrength (); + float ss = props.get_specularstrength (); + float se = props.get_specularexponent (); + + boolMatrix clip (1, nv, false); + + if (has_z) + for (int i = 0; i < nv; i++) + clip(i) = is_nan_or_inf (v(i,0), v(i,1), v(i,2)); + else + for (int i = 0; i < nv; i++) + clip(i) = is_nan_or_inf (v(i,0), v(i,1), 0); + + boolMatrix clip_f (1, nf, false); + Array count_f (dim_vector (nf, 1), 0); + + for (int i = 0; i < nf; i++) + { + bool fclip = false; + int count = 0; + + for (int j = 0; j < fcmax && ! xisnan (f(i,j)); j++, count++) + fclip = (fclip || clip(int (f(i,j) - 1))); + + clip_f(i) = fclip; + count_f(i) = count; + } + + if (fc_mode > 0 || ec_mode > 0) + { + c = props.get_color_data ().matrix_value (); + + if (c.rows () == 1) + { + // Single color specifications, we can simplify a little bit + + if (fc_mode > 0) + { + fcolor = c; + fc_mode = 0; + } + + if (ec_mode > 0) + { + ecolor = c; + ec_mode = 0; + } + + c = Matrix (); + } + else + has_facecolor = ((c.numel () > 0) && (c.rows () == f.rows ())); + } + + if (fa_mode > 0 || ea_mode > 0) + { + // FIXME: retrieve alpha data from patch object + //a = props.get_alpha_data (); + has_facealpha = ((a.numel () > 0) && (a.rows () == f.rows ())); + } + + octave_idx_type fr = f.rows (); + std::vector vdata (f.numel ()); + + for (int i = 0; i < nf; i++) + for (int j = 0; j < count_f(i); j++) + { + int idx = int (f(i,j) - 1); + + Matrix vv (1, 3, 0.0); + Matrix cc; + Matrix nn(1, 3, 0.0); + double aa = 1.0; + + vv(0) = v(idx,0); vv(1) = v(idx,1); + if (has_z) + vv(2) = v(idx,2); + // FIXME: uncomment when patch object has normal computation + //nn(0) = n(idx,0); nn(1) = n(idx,1); nn(2) = n(idx,2); + if (c.numel () > 0) + { + cc.resize (1, 3); + if (has_facecolor) + cc(0) = c(i,0), cc(1) = c(i,1), cc(2) = c(i,2); + else + cc(0) = c(idx,0), cc(1) = c(idx,1), cc(2) = c(idx,2); + } + if (a.numel () > 0) + { + if (has_facealpha) + aa = a(i); + else + aa = a(idx); + } + + vdata[i+j*fr] = + vertex_data (vv, cc, nn, aa, as, ds, ss, se); + } + + if (fl_mode > 0 || el_mode > 0) + { + float buf[4] = { ss, ss, ss, 1 }; + + glMaterialfv (LIGHT_MODE, GL_SPECULAR, buf); + glMaterialf (LIGHT_MODE, GL_SHININESS, se); + } + + if (! props.facecolor_is ("none")) + { + // FIXME: adapt to double-radio property + if (props.get_facealpha_double () == 1) + { + if (fc_mode == 0) + { + glColor3dv (fcolor.data ()); + if (fl_mode > 0) + { + float cb[4] = { 0, 0, 0, 1 }; + + for (int i = 0; i < 3; i++) + cb[i] = (as * fcolor(i)); + glMaterialfv (LIGHT_MODE, GL_AMBIENT, cb); + + for (int i = 0; i < 3; i++) + cb[i] = ds * fcolor(i); + glMaterialfv (LIGHT_MODE, GL_DIFFUSE, cb); + } + } + + if (fl_mode > 0) + glEnable (GL_LIGHTING); + + // FIXME: use __index__ property from patch object + patch_tesselator tess (this, fc_mode, fl_mode, 0); + + for (int i = 0; i < nf; i++) + { + if (clip_f(i)) + continue; + + tess.begin_polygon (true); + tess.begin_contour (); + + for (int j = 0; j < count_f(i); j++) + { + vertex_data::vertex_data_rep *vv = vdata[i+j*fr].get_rep (); + + tess.add_vertex (vv->coords.fortran_vec (), vv); + } + + tess.end_contour (); + tess.end_polygon (); + } + + if (fl_mode > 0) + glDisable (GL_LIGHTING); + } + else + { + // FIXME: implement transparency + } + } + + if (! props.edgecolor_is ("none")) + { + // FIXME: adapt to double-radio property + if (props.get_edgealpha_double () == 1) + { + if (ec_mode == 0) + { + glColor3dv (ecolor.data ()); + if (el_mode > 0) + { + float cb[4] = { 0, 0, 0, 1 }; + + for (int i = 0; i < 3; i++) + cb[i] = (as * ecolor(i)); + glMaterialfv (LIGHT_MODE, GL_AMBIENT, cb); + + for (int i = 0; i < 3; i++) + cb[i] = ds * ecolor(i); + glMaterialfv (LIGHT_MODE, GL_DIFFUSE, cb); + } + } + + if (el_mode > 0) + glEnable (GL_LIGHTING); + + set_linestyle (props.get_linestyle (), false); + set_linewidth (props.get_linewidth ()); + + + // FIXME: use __index__ property from patch object; should we + // offset patch contour as well? + patch_tesselator tess (this, ec_mode, el_mode); + + for (int i = 0; i < nf; i++) + { + if (clip_f(i)) + { + // This is an unclosed contour. Draw it as a line + bool flag = false; + + for (int j = 0; j < count_f(i); j++) + { + if (! clip(int (f(i,j) - 1))) + { + vertex_data::vertex_data_rep *vv = vdata[i+j*fr].get_rep (); + const Matrix m = vv->coords; + if (! flag) + { + flag = true; + glBegin (GL_LINE_STRIP); + } + glVertex3d (m(0), m(1), m(2)); + } + else if (flag) + { + flag = false; + glEnd (); + } + } + + if (flag) + glEnd (); + } + else + { + tess.begin_polygon (false); + tess.begin_contour (); + + for (int j = 0; j < count_f(i); j++) + { + vertex_data::vertex_data_rep *vv = vdata[i+j*fr].get_rep (); + tess.add_vertex (vv->coords.fortran_vec (), vv); + } + + tess.end_contour (); + tess.end_polygon (); + } + } + + set_linestyle ("-"); + set_linewidth (0.5); + + if (el_mode > 0) + glDisable (GL_LIGHTING); + } + else + { + // FIXME: implement transparency + } + } + + if (! props.marker_is ("none") && + ! (props.markeredgecolor_is ("none") && props.markerfacecolor_is ("none"))) + { + bool do_edge = ! props.markeredgecolor_is ("none"); + bool do_face = ! props.markerfacecolor_is ("none"); + + Matrix mecolor = props.get_markeredgecolor_rgb (); + Matrix mfcolor = props.get_markerfacecolor_rgb (); + + bool has_markerfacecolor = false; + + if ((mecolor.numel () == 0 && ! props.markeredgecolor_is ("none")) + || (mfcolor.numel () == 0 && ! props.markerfacecolor_is ("none"))) + { + Matrix mc = props.get_color_data ().matrix_value (); + + if (mc.rows () == 1) + { + // Single color specifications, we can simplify a little bit + + if (mfcolor.numel () == 0 + && ! props.markerfacecolor_is ("none")) + mfcolor = mc; + + if (mecolor.numel () == 0 + && ! props.markeredgecolor_is ("none")) + mecolor = mc; + } + else + { + if (c.numel () == 0) + c = props.get_color_data ().matrix_value (); + has_markerfacecolor = ((c.numel () > 0) + && (c.rows () == f.rows ())); + } + } + + + init_marker (props.get_marker (), props.get_markersize (), + props.get_linewidth ()); + + for (int i = 0; i < nf; i++) + for (int j = 0; j < count_f(i); j++) + { + int idx = int (f(i,j) - 1); + + if (clip(idx)) + continue; + + Matrix cc; + if (c.numel () > 0) + { + cc.resize (1, 3); + if (has_markerfacecolor) + cc(0) = c(i,0), cc(1) = c(i,1), cc(2) = c(i,2); + else + cc(0) = c(idx,0), cc(1) = c(idx,1), cc(2) = c(idx,2); + } + + Matrix lc = (do_edge ? (mecolor.numel () == 0 ? cc : mecolor) + : Matrix ()); + Matrix fc = (do_face ? (mfcolor.numel () == 0 ? cc : mfcolor) + : Matrix ()); + + draw_marker (v(idx,0), v(idx,1), (has_z ? v(idx,2) : 0), lc, fc); + } + + end_marker (); + } +} + +void +opengl_renderer::draw_hggroup (const hggroup::properties &props) +{ + draw (props.get_children ()); +} + +void +opengl_renderer::draw_text (const text::properties& props) +{ + if (props.get_string ().is_empty ()) + return; + + Matrix pos = xform.scale (props.get_data_position ()); + const Matrix bbox = props.get_extent_matrix (); + + // FIXME: handle margin and surrounding box + bool blend = glIsEnabled (GL_BLEND); + + glEnable (GL_BLEND); + glEnable (GL_ALPHA_TEST); + glRasterPos3d (pos(0), pos(1), pos.numel () > 2 ? pos(2) : 0.0); + glBitmap (0, 0, 0, 0, bbox(0), bbox(1), 0); + glDrawPixels (bbox(2), bbox(3), + GL_RGBA, GL_UNSIGNED_BYTE, props.get_pixels ().data ()); + glDisable (GL_ALPHA_TEST); + if (! blend) + glDisable (GL_BLEND); + +} + +void +opengl_renderer::draw_image (const image::properties& props) +{ + octave_value cdata = props.get_color_data (); + dim_vector dv (cdata.dims ()); + int h = dv(0), w = dv(1); + + Matrix x = props.get_xdata ().matrix_value (); + Matrix y = props.get_ydata ().matrix_value (); + + // Someone wants us to draw an empty image? No way. + if (x.is_empty () || y.is_empty ()) + return; + + if (w > 1 && x(1) == x(0)) + x(1) = x(1) + (w-1); + + if (h > 1 && y(1) == y(0)) + y(1) = y(1) + (h-1); + + const ColumnVector p0 = xform.transform (x(0), y(0), 0); + const ColumnVector p1 = xform.transform (x(1), y(1), 0); + + // image pixel size in screen pixel units + float pix_dx, pix_dy; + // image pixel size in normalized units + float nor_dx, nor_dy; + + if (w > 1) + { + pix_dx = (p1(0) - p0(0))/(w-1); + nor_dx = (x(1) - x(0))/(w-1); + } + else + { + const ColumnVector p1w = xform.transform (x(1) + 1, y(1), 0); + pix_dx = p1w(0) - p0(0); + nor_dx = 1; + } + + if (h > 1) + { + pix_dy = (p1(1) - p0(1))/(h-1); + nor_dy = (y(1) - y(0))/(h-1); + } + else + { + const ColumnVector p1h = xform.transform (x(1), y(1) + 1, 0); + pix_dy = p1h(1) - p0(1); + nor_dy = 1; + } + + + // OpenGL won't draw the image if it's origin is outside the + // viewport/clipping plane so we must do the clipping + // ourselfes - only draw part of the image + + int j0 = 0, j1 = w; + int i0 = 0, i1 = h; + + float im_xmin = x(0) - nor_dx/2; + float im_xmax = x(1) + nor_dx/2; + float im_ymin = y(0) - nor_dy/2; + float im_ymax = y(1) + nor_dy/2; + if (props.is_clipping ()) // clip to axes + { + if (im_xmin < xmin) + j0 += (xmin - im_xmin)/nor_dx + 1; + if (im_xmax > xmax) + j1 -= (im_xmax - xmax)/nor_dx ; + + if (im_ymin < ymin) + i0 += (ymin - im_ymin)/nor_dy + 1; + if (im_ymax > ymax) + i1 -= (im_ymax - ymax)/nor_dy; + } + else // clip to viewport + { + GLfloat vp[4]; + glGetFloatv (GL_VIEWPORT, vp); + // FIXME -- actually add the code to do it! + + } + + if (i0 >= i1 || j0 >= j1) + return; + + glPixelZoom (pix_dx, -pix_dy); + glRasterPos3d (im_xmin + nor_dx*j0, im_ymin + nor_dy*i0, 0); + + // by default this is 4 + glPixelStorei (GL_UNPACK_ALIGNMENT,1); + + // Expect RGB data + if (dv.length () == 3 && dv(2) == 3) + { + if (cdata.is_double_type ()) + { + const NDArray xcdata = cdata.array_value (); + + OCTAVE_LOCAL_BUFFER (GLfloat, a, 3*(j1-j0)*(i1-i0)); + + for (int i = i0; i < i1; i++) + { + for (int j = j0, idx = (i-i0)*(j1-j0)*3; j < j1; j++, idx += 3) + { + a[idx] = xcdata(i,j,0); + a[idx+1] = xcdata(i,j,1); + a[idx+2] = xcdata(i,j,2); + } + } + + draw_pixels (j1-j0, i1-i0, GL_RGB, GL_FLOAT, a); + + } + else if (cdata.is_uint16_type ()) + { + const uint16NDArray xcdata = cdata.uint16_array_value (); + + OCTAVE_LOCAL_BUFFER (GLushort, a, 3*(j1-j0)*(i1-i0)); + + for (int i = i0; i < i1; i++) + { + for (int j = j0, idx = (i-i0)*(j1-j0)*3; j < j1; j++, idx += 3) + { + a[idx] = xcdata(i,j,0); + a[idx+1] = xcdata(i,j,1); + a[idx+2] = xcdata(i,j,2); + } + } + + draw_pixels (j1-j0, i1-i0, GL_RGB, GL_UNSIGNED_SHORT, a); + + } + else if (cdata.is_uint8_type ()) + { + const uint8NDArray xcdata = cdata.uint8_array_value (); + + OCTAVE_LOCAL_BUFFER (GLubyte, a, 3*(j1-j0)*(i1-i0)); + + for (int i = i0; i < i1; i++) + { + for (int j = j0, idx = (i-i0)*(j1-j0)*3; j < j1; j++, idx += 3) + { + a[idx] = xcdata(i,j,0); + a[idx+1] = xcdata(i,j,1); + a[idx+2] = xcdata(i,j,2); + } + } + + draw_pixels (j1-j0, i1-i0, GL_RGB, GL_UNSIGNED_BYTE, a); + } + else + warning ("opengl_texture::draw: invalid image data type (expected double, uint16, or uint8)"); + } + else + warning ("opengl_texture::draw: invalid image size (expected n*m*3 or n*m)"); + + glPixelZoom (1, 1); +} + +void +opengl_renderer::set_viewport (int w, int h) +{ + glViewport (0, 0, w, h); +} + +void +opengl_renderer::draw_pixels (GLsizei width, GLsizei height, GLenum format, + GLenum type, const GLvoid *data) +{ + glDrawPixels (width, height, format, type, data); +} + +void +opengl_renderer::set_color (const Matrix& c) +{ + glColor3dv (c.data ()); +#if HAVE_FREETYPE + text_renderer.set_color (c); +#endif +} + +void +opengl_renderer::set_font (const base_properties& props) +{ +#if HAVE_FREETYPE + text_renderer.set_font (props.get ("fontname").string_value (), + props.get ("fontweight").string_value (), + props.get ("fontangle").string_value (), + props.get ("fontsize").double_value ()); +#endif +} + +void +opengl_renderer::set_polygon_offset (bool on, double offset) +{ + if (on) + { + glPolygonOffset (offset, offset); + glEnable (GL_POLYGON_OFFSET_FILL); + glEnable (GL_POLYGON_OFFSET_LINE); + } + else + { + glDisable (GL_POLYGON_OFFSET_FILL); + glDisable (GL_POLYGON_OFFSET_LINE); + } +} + +void +opengl_renderer::set_linewidth (float w) +{ + glLineWidth (w); +} + +void +opengl_renderer::set_linestyle (const std::string& s, bool use_stipple) +{ + bool solid = false; + + if (s == "-") + { + glLineStipple (1, static_cast (0xFFFF)); + solid = true; + } + else if (s == ":") + glLineStipple (1, static_cast (0x8888)); + else if (s == "--") + glLineStipple (1, static_cast (0x0FFF)); + else if (s == "-.") + glLineStipple (1, static_cast (0x020F)); + else + glLineStipple (1, static_cast (0x0000)); + + if (solid && ! use_stipple) + glDisable (GL_LINE_STIPPLE); + else + glEnable (GL_LINE_STIPPLE); +} + +void +opengl_renderer::set_clipbox (double x1, double x2, double y1, double y2, + double z1, double z2) +{ + double dx = (x2-x1); + double dy = (y2-y1); + double dz = (z2-z1); + + x1 -= 0.001*dx; x2 += 0.001*dx; + y1 -= 0.001*dy; y2 += 0.001*dy; + z1 -= 0.001*dz; z2 += 0.001*dz; + + ColumnVector p (4, 0.0); + + p(0) = -1; p(3) = x2; + glClipPlane (GL_CLIP_PLANE0, p.data ()); + p(0) = 1; p(3) = -x1; + glClipPlane (GL_CLIP_PLANE1, p.data ()); + p(0) = 0; p(1) = -1; p(3) = y2; + glClipPlane (GL_CLIP_PLANE2, p.data ()); + p(1) = 1; p(3) = -y1; + glClipPlane (GL_CLIP_PLANE3, p.data ()); + p(1) = 0; p(2) = -1; p(3) = z2; + glClipPlane (GL_CLIP_PLANE4, p.data ()); + p(2) = 1; p(3) = -z1; + glClipPlane (GL_CLIP_PLANE5, p.data ()); + + xmin = x1; xmax = x2; + ymin = y1; ymax = y2; + zmin = z1; zmax = z2; +} + +void +opengl_renderer::set_clipping (bool enable) +{ + bool has_clipping = (glIsEnabled (GL_CLIP_PLANE0) == GL_TRUE); + + if (enable != has_clipping) + { + if (enable) + for (int i = 0; i < 6; i++) + glEnable (GL_CLIP_PLANE0+i); + else + for (int i = 0; i < 6; i++) + glDisable (GL_CLIP_PLANE0+i); + } +} + +void +opengl_renderer::init_marker (const std::string& m, double size, float width) +{ +#if defined (HAVE_FRAMEWORK_OPENGL) + GLint vw[4]; +#else + int vw[4]; +#endif + + glGetIntegerv (GL_VIEWPORT, vw); + + glMatrixMode (GL_PROJECTION); + glPushMatrix (); + glLoadIdentity (); + glOrtho (0, vw[2], vw[3], 0, xZ1, xZ2); + glMatrixMode (GL_MODELVIEW); + glPushMatrix (); + + set_clipping (false); + set_linewidth (width); + + marker_id = make_marker_list (m, size, false); + filled_marker_id = make_marker_list (m, size, true); +} + +void +opengl_renderer::end_marker (void) +{ + glDeleteLists (marker_id, 1); + glDeleteLists (filled_marker_id, 1); + + glMatrixMode (GL_MODELVIEW); + glPopMatrix (); + glMatrixMode (GL_PROJECTION); + glPopMatrix (); + set_linewidth (0.5f); +} + +void +opengl_renderer::draw_marker (double x, double y, double z, + const Matrix& lc, const Matrix& fc) +{ + ColumnVector tmp = xform.transform (x, y, z, false); + + glLoadIdentity (); + glTranslated (tmp(0), tmp(1), -tmp(2)); + + if (filled_marker_id > 0 && fc.numel () > 0) + { + glColor3dv (fc.data ()); + set_polygon_offset (true, -1.0); + glCallList (filled_marker_id); + if (lc.numel () > 0) + { + glColor3dv (lc.data ()); + glPolygonMode (GL_FRONT_AND_BACK, GL_LINE); + glEdgeFlag (GL_TRUE); + set_polygon_offset (true, -2.0); + glCallList (filled_marker_id); + glPolygonMode (GL_FRONT_AND_BACK, GL_FILL); + } + set_polygon_offset (false); + } + else if (marker_id > 0 && lc.numel () > 0) + { + glColor3dv (lc.data ()); + glCallList (marker_id); + } +} + +unsigned int +opengl_renderer::make_marker_list (const std::string& marker, double size, + bool filled) const +{ + char c = marker[0]; + + if (filled && (c == '+' || c == 'x' || c == '*' || c == '.')) + return 0; + + unsigned int ID = glGenLists (1); + double sz = size * toolkit.get_screen_resolution () / 72.0; + + // constants for the * marker + const double sqrt2d4 = 0.35355339059327; + double tt = sz*sqrt2d4; + + glNewList (ID, GL_COMPILE); + + switch (marker[0]) + { + case '+': + glBegin (GL_LINES); + glVertex2f (-sz/2, 0); + glVertex2f (sz/2, 0); + glVertex2f (0, -sz/2); + glVertex2f (0, sz/2); + glEnd (); + break; + case 'x': + glBegin (GL_LINES); + glVertex2f (-sz/2, -sz/2); + glVertex2f (sz/2, sz/2); + glVertex2f (-sz/2, sz/2); + glVertex2f (sz/2, -sz/2); + glEnd (); + break; + case '*': + glBegin (GL_LINES); + glVertex2f (-sz/2, 0); + glVertex2f (sz/2, 0); + glVertex2f (0, -sz/2); + glVertex2f (0, sz/2); + glVertex2f (-tt, -tt); + glVertex2f (+tt, +tt); + glVertex2f (-tt, +tt); + glVertex2f (+tt, -tt); + glEnd (); + break; + case '.': + { + double ang_step = M_PI / 5; + + glBegin (GL_POLYGON); + for (double ang = 0; ang < (2*M_PI); ang += ang_step) + glVertex2d (sz*cos (ang)/3, sz*sin (ang)/3); + glEnd (); + } + break; + case 's': + glBegin ((filled ? GL_POLYGON : GL_LINE_LOOP)); + glVertex2d (-sz/2, -sz/2); + glVertex2d (-sz/2, sz/2); + glVertex2d (sz/2, sz/2); + glVertex2d (sz/2, -sz/2); + glEnd (); + break; + case 'o': + { + double ang_step = M_PI / 5; + + glBegin ((filled ? GL_POLYGON : GL_LINE_LOOP)); + for (double ang = 0; ang < (2*M_PI); ang += ang_step) + glVertex2d (sz*cos (ang)/2, sz*sin (ang)/2); + glEnd (); + } + break; + case 'd': + glBegin ((filled ? GL_POLYGON : GL_LINE_LOOP)); + glVertex2d (0, -sz/2); + glVertex2d (sz/2, 0); + glVertex2d (0, sz/2); + glVertex2d (-sz/2, 0); + glEnd (); + break; + case 'v': + glBegin ((filled ? GL_POLYGON : GL_LINE_LOOP)); + glVertex2f (0, sz/2); + glVertex2f (sz/2, -sz/2); + glVertex2f (-sz/2, -sz/2); + glEnd (); + break; + case '^': + glBegin ((filled ? GL_POLYGON : GL_LINE_LOOP)); + glVertex2f (0, -sz/2); + glVertex2f (-sz/2, sz/2); + glVertex2f (sz/2, sz/2); + glEnd (); + break; + case '>': + glBegin ((filled ? GL_POLYGON : GL_LINE_LOOP)); + glVertex2f (sz/2, 0); + glVertex2f (-sz/2, sz/2); + glVertex2f (-sz/2, -sz/2); + glEnd (); + break; + case '<': + glBegin ((filled ? GL_POLYGON : GL_LINE_LOOP)); + glVertex2f (-sz/2, 0); + glVertex2f (sz/2, -sz/2); + glVertex2f (sz/2, sz/2); + glEnd (); + break; + case 'p': + { + double ang; + double r; + double dr = 1.0 - sin (M_PI/10)/sin (3*M_PI/10)*1.02; + + glBegin ((filled ? GL_POLYGON : GL_LINE_LOOP)); + for (int i = 0; i < 2*5; i++) + { + ang = (-0.5 + double(i+1)/5) * M_PI; + r = 1.0 - (dr * fmod (double(i+1), 2.0)); + glVertex2d (sz*r*cos (ang)/2, sz*r*sin (ang)/2); + } + glEnd (); + } + break; + case 'h': + { + double ang; + double r; + double dr = 1.0 - 0.5/sin (M_PI/3)*1.02; + + glBegin ((filled ? GL_POLYGON : GL_LINE_LOOP)); + for (int i = 0; i < 2*6; i++) + { + ang = (0.5 + double(i+1)/6.0) * M_PI; + r = 1.0 - (dr * fmod (double(i+1), 2.0)); + glVertex2d (sz*r*cos (ang)/2, sz*r*sin (ang)/2); + } + glEnd (); + } + break; + default: + warning ("opengl_renderer: unsupported marker '%s'", + marker.c_str ()); + break; + } + + glEndList (); + + return ID; +} + +void +opengl_renderer::text_to_pixels (const std::string& txt, + uint8NDArray& pixels, + Matrix& bbox, + int halign, int valign, double rotation) +{ +#if HAVE_FREETYPE + text_renderer.text_to_pixels (txt, pixels, bbox, + halign, valign, rotation); +#endif +} + +Matrix +opengl_renderer::render_text (const std::string& txt, + double x, double y, double z, + int halign, int valign, double rotation) +{ +#if HAVE_FREETYPE + if (txt.empty ()) + return Matrix (1, 4, 0.0); + + uint8NDArray pixels; + Matrix bbox; + text_to_pixels (txt, pixels, bbox, halign, valign, rotation); + + bool blend = glIsEnabled (GL_BLEND); + + glEnable (GL_BLEND); + glEnable (GL_ALPHA_TEST); + glRasterPos3d (x, y, z); + glBitmap(0, 0, 0, 0, bbox(0), bbox(1), 0); + glDrawPixels (bbox(2), bbox(3), + GL_RGBA, GL_UNSIGNED_BYTE, pixels.data ()); + glDisable (GL_ALPHA_TEST); + if (! blend) + glDisable (GL_BLEND); + + return bbox; +#else + ::warning ("render_text: cannot render text, Freetype library not available"); + return Matrix (1, 4, 0.0); +#endif +} + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/gl-render.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/gl-render.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,211 @@ +/* + +Copyright (C) 2008-2012 Michael Goffioul + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (gl_render_h) +#define gl_render_h 1 + +#ifdef HAVE_WINDOWS_H +#define WIN32_LEAN_AND_MEAN +#include +#endif + +#ifdef HAVE_GL_GL_H +#include +#elif defined HAVE_OPENGL_GL_H || defined HAVE_FRAMEWORK_OPENGL +#include +#endif + +#ifdef HAVE_GL_GLU_H +#include +#elif defined HAVE_OPENGL_GLU_H || defined HAVE_FRAMEWORK_OPENGL +#include +#endif + +#include "graphics.h" +#include "txt-eng-ft.h" + +class +OCTINTERP_API +opengl_renderer +{ +public: + opengl_renderer (void) + : toolkit (), xform (), xmin (), xmax (), ymin (), ymax (), + zmin (), zmax (), xZ1 (), xZ2 (), marker_id (), filled_marker_id (), + camera_pos (), camera_dir () +#if HAVE_FREETYPE + , text_renderer () +#endif + { } + + virtual ~opengl_renderer (void) { } + + virtual void draw (const graphics_object& go, bool toplevel = true); + + virtual void draw (const Matrix& hlist, bool toplevel = false) + { + int len = hlist.length (); + + for (int i = len-1; i >= 0; i--) + { + graphics_object obj = gh_manager::get_object (hlist(i)); + + if (obj) + draw (obj, toplevel); + } + } + + virtual void set_viewport (int w, int h); + virtual graphics_xform get_transform (void) const { return xform; } + +protected: + virtual void draw_figure (const figure::properties& props); + virtual void draw_axes (const axes::properties& props); + virtual void draw_line (const line::properties& props); + virtual void draw_surface (const surface::properties& props); + virtual void draw_patch (const patch::properties& props); + virtual void draw_hggroup (const hggroup::properties& props); + virtual void draw_text (const text::properties& props); + virtual void draw_image (const image::properties& props); + virtual void draw_uipanel (const uipanel::properties& props, + const graphics_object& go); + + virtual void init_gl_context (bool enhanced, const Matrix& backgroundColor); + virtual void setup_opengl_transformation (const axes::properties& props); + + virtual void set_color (const Matrix& c); + virtual void set_polygon_offset (bool on, double offset = 0.0); + virtual void set_linewidth (float w); + virtual void set_linestyle (const std::string& s, bool stipple = false); + virtual void set_clipbox (double x1, double x2, double y1, double y2, + double z1, double z2); + virtual void set_clipping (bool on); + virtual void set_font (const base_properties& props); + + virtual void init_marker (const std::string& m, double size, float width); + virtual void end_marker (void); + virtual void draw_marker (double x, double y, double z, + const Matrix& lc, const Matrix& fc); + + virtual void text_to_pixels (const std::string& txt, + uint8NDArray& pixels, + Matrix& bbox, + int halign = 0, int valign = 0, + double rotation = 0.0); + + virtual Matrix render_text (const std::string& txt, + double x, double y, double z, + int halign, int valign, double rotation = 0.0); + + virtual void draw_pixels (GLsizei w, GLsizei h, GLenum format, + GLenum type, const GLvoid *data); + + virtual void render_grid (const std::string& gridstyle, const Matrix& ticks, + double lim1, double lim2, + double p1, double p1N, double p2, double p2N, + int xyz, bool is_3D); + + virtual void render_tickmarks (const Matrix& ticks, double lim1, double lim2, + double p1, double p1N, double p2, double p2N, + double dx, double dy, double dz, + int xyz, bool doubleside); + + virtual void render_ticktexts (const Matrix& ticks, + const string_vector& ticklabels, + double lim1, double lim2, + double p1, double p2, + int xyz, int ha, int va, + int& wmax, int& hmax); + +private: + opengl_renderer (const opengl_renderer&) + : toolkit (), xform (), xmin (), xmax (), ymin (), ymax (), + zmin (), zmax (), xZ1 (), xZ2 (), marker_id (), filled_marker_id (), + camera_pos (), camera_dir () +#if HAVE_FREETYPE + , text_renderer () +#endif + { } + + opengl_renderer& operator = (const opengl_renderer&) + { return *this; } + + bool is_nan_or_inf (double x, double y, double z) const + { + return (xisnan (x) || xisnan (y) || xisnan (z) + || xisinf (x) || xisinf (y) || xisinf (z)); + } + + octave_uint8 clip_code (double x, double y, double z) const + { + return ((x < xmin ? 1 : 0) + | (x > xmax ? 1 : 0) << 1 + | (y < ymin ? 1 : 0) << 2 + | (y > ymax ? 1 : 0) << 3 + | (z < zmin ? 1 : 0) << 4 + | (z > zmax ? 1 : 0) << 5 + | (is_nan_or_inf (x, y, z) ? 0 : 1) << 6); + } + + unsigned int make_marker_list (const std::string& m, double size, + bool filled) const; + + void draw_axes_planes (const axes::properties& props); + void draw_axes_boxes (const axes::properties& props); + + void draw_axes_x_grid (const axes::properties& props); + void draw_axes_y_grid (const axes::properties& props); + void draw_axes_z_grid (const axes::properties& props); + + void draw_axes_children (const axes::properties& props); + +private: + // The graphics toolkit associated with the figure being rendered. + graphics_toolkit toolkit; + + // axes transformation data + graphics_xform xform; + + // axis limits in model scaled coordinate + double xmin, xmax; + double ymin, ymax; + double zmin, zmax; + + // Z projection limits in windows coordinate + double xZ1, xZ2; + + // call lists identifiers for markers + unsigned int marker_id, filled_marker_id; + + // camera information for primitive sorting + ColumnVector camera_pos, camera_dir; + +#if HAVE_FREETYPE + // freetype render, used for text rendering + ft_render text_renderer; +#endif + +private: + class patch_tesselator; +}; + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/gl2ps-renderer.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/gl2ps-renderer.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,251 @@ +/* + +Copyright (C) 2009-2012 Shai Ayal + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#if defined (HAVE_OPENGL) + +#include + +#include "lo-mappers.h" +#include "oct-locbuf.h" + +#include "gl2ps-renderer.h" +#include "gl2ps.h" + +void +glps_renderer::draw (const graphics_object& go, const std::string print_cmd) +{ + static bool in_draw = false; + static std::string old_print_cmd; + + if (!in_draw) + { + in_draw = true; + + GLint buffsize = 0, state = GL2PS_OVERFLOW; + GLint viewport[4]; + + glGetIntegerv (GL_VIEWPORT, viewport); + + GLint gl2ps_term; + if (term.find ("eps") != std::string::npos) gl2ps_term = GL2PS_EPS; + else if (term.find ("pdf") != std::string::npos) gl2ps_term = GL2PS_PDF; + else if (term.find ("svg") != std::string::npos) gl2ps_term = GL2PS_SVG; + else if (term.find ("ps") != std::string::npos) gl2ps_term = GL2PS_PS; + else if (term.find ("pgf") != std::string::npos) gl2ps_term = GL2PS_PGF; + else if (term.find ("tex") != std::string::npos) gl2ps_term = GL2PS_TEX; + else + { + error ("gl2ps-renderer:: Unknown terminal"); + return; + } + + GLint gl2ps_text = 0; + if (term.find ("notxt") != std::string::npos) gl2ps_text = GL2PS_NO_TEXT; + + // Default sort order optimizes for 3D plots + GLint gl2ps_sort = GL2PS_BSP_SORT; + if (term.find ("is2D") != std::string::npos) gl2ps_sort = GL2PS_NO_SORT; + + while (state == GL2PS_OVERFLOW) + { + // For LaTeX output the fltk print process uses two drawnow() commands. + // The first one is for the pdf/ps/eps graph to be included. The print_cmd + // is saved as old_print_cmd. Then the second drawnow() outputs the tex-file + // and the graphic filename to be included is extracted from old_print_cmd. + std::string include_graph; + std::size_t found_redirect = old_print_cmd.find (">"); + if (found_redirect != std::string::npos) + include_graph = old_print_cmd.substr (found_redirect + 1); + else + include_graph = old_print_cmd; + std::size_t n_begin = include_graph.find_first_not_of (" "); + if (n_begin != std::string::npos) + { + std::size_t n_end = include_graph.find_last_not_of (" "); + include_graph = include_graph.substr (n_begin, n_end - n_begin + 1); + } + else + include_graph = "foobar-inc"; + buffsize += 1024*1024; + gl2psBeginPage ("glps_renderer figure", "Octave", viewport, + gl2ps_term, gl2ps_sort, + (GL2PS_SILENT | GL2PS_SIMPLE_LINE_OFFSET + | GL2PS_NO_BLENDING | GL2PS_OCCLUSION_CULL + | GL2PS_BEST_ROOT | gl2ps_text + | GL2PS_NO_PS3_SHADING), + GL_RGBA, 0, NULL, 0, 0, 0, + buffsize, fp, include_graph.c_str ()); + old_print_cmd = print_cmd; + opengl_renderer::draw (go); + state = gl2psEndPage (); + } + + in_draw = 0; + } + else + opengl_renderer::draw (go); +} + +int +glps_renderer::alignment_to_mode (int ha, int va) const +{ + int gl2psa=GL2PS_TEXT_BL; + if (ha == 0) + { + if (va == 0 || va == 3) + gl2psa=GL2PS_TEXT_BL; + else if (va == 2) + gl2psa=GL2PS_TEXT_TL; + else if (va == 1) + gl2psa=GL2PS_TEXT_CL; + } + else if (ha == 2) + { + if (va == 0 || va == 3) + gl2psa=GL2PS_TEXT_BR; + else if (va == 2) + gl2psa=GL2PS_TEXT_TR; + else if (va == 1) + gl2psa=GL2PS_TEXT_CR; + } + else if (ha == 1) + { + if (va == 0 || va == 3) + gl2psa=GL2PS_TEXT_B; + else if (va == 2) + gl2psa=GL2PS_TEXT_T; + else if (va == 1) + gl2psa=GL2PS_TEXT_C; + } + return gl2psa; +} + +Matrix +glps_renderer::render_text (const std::string& txt, + double x, double y, double z, + int ha, int va, double rotation) +{ + if (txt.empty ()) + return Matrix (1, 4, 0.0); + + glRasterPos3d (x, y, z); + gl2psTextOpt (txt.c_str (), fontname.c_str (), fontsize, + alignment_to_mode (ha, va), rotation); + + // FIXME? -- we have no way of getting a bounding box from gl2ps, so + // we use freetype + Matrix bbox; + uint8NDArray pixels; + text_to_pixels (txt, pixels, bbox, 0, 0, rotation); + return bbox; +} + +void +glps_renderer::set_font (const base_properties& props) +{ + opengl_renderer::set_font (props); + + fontsize = props.get ("fontsize").double_value (); + + caseless_str fn = props.get ("fontname").string_value (); + fontname = ""; + if (fn == "times" || fn == "times-roman") + fontname = "Times-Roman"; + else if (fn == "courier") + fontname = "Courier"; + else if (fn == "symbol") + fontname = "Symbol"; + else if (fn == "zapfdingbats") + fontname = "ZapfDingbats"; + else + fontname = "Helvetica"; + + // FIXME -- add support for bold and italic +} + +template +static void +draw_pixels (GLsizei w, GLsizei h, GLenum format, const T *data) +{ + OCTAVE_LOCAL_BUFFER (GLfloat, a, 3*w*h); + + for (int i = 0; i < 3*w*h; i++) + a[i] = data[i]; + + gl2psDrawPixels (w, h, 0, 0, format, GL_FLOAT, a); +} + +void +glps_renderer::draw_pixels (GLsizei w, GLsizei h, GLenum format, + GLenum type, const GLvoid *data) +{ + if (type == GL_UNSIGNED_SHORT) + ::draw_pixels (w, h, format, static_cast (data)); + else if (type == GL_UNSIGNED_BYTE) + ::draw_pixels (w, h, format, static_cast (data)); + else + gl2psDrawPixels (w, h, 0, 0, format, type, data); +} + +void +glps_renderer::draw_text (const text::properties& props) +{ + if (props.get_string ().is_empty ()) + return; + + set_font (props); + set_color (props.get_color_rgb ()); + + const Matrix pos = get_transform ().scale (props.get_data_position ()); + int halign = 0, valign = 0; + + if (props.horizontalalignment_is ("center")) + halign = 1; + else if (props.horizontalalignment_is ("right")) + halign = 2; + + if (props.verticalalignment_is ("top")) + valign = 2; + else if (props.verticalalignment_is ("baseline")) + valign = 3; + else if (props.verticalalignment_is ("middle")) + valign = 1; + + // FIXME: handle margin and surrounding box + + glRasterPos3d (pos(0), pos(1), pos.numel () > 2 ? pos(2) : 0.0); + + octave_value string_prop = props.get_string (); + + string_vector sv = string_prop.all_strings (); + + std::string s = sv.join ("\n"); + + gl2psTextOpt (s.c_str (), fontname.c_str (), fontsize, + alignment_to_mode (halign, valign), props.get_rotation ()); +} + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/gl2ps-renderer.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/gl2ps-renderer.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,87 @@ +/* + +Copyright (C) 2009-2012 Shai Ayal + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (gl2ps_renderer_h) +#define gl2ps_renderer_h 1 + +#include "gl-render.h" +#include "gl2ps.h" + +class +OCTINTERP_API +glps_renderer : public opengl_renderer +{ +public: + glps_renderer (FILE *_fp, const std::string& _term) + : opengl_renderer () , fp (_fp), term (_term), + fontsize (), fontname () { } + + ~glps_renderer (void) { } + + void draw (const graphics_object& go, const std::string print_cmd); + +protected: + + Matrix render_text (const std::string& txt, + double x, double y, double z, + int halign, int valign, double rotation = 0.0); + + + void set_font (const base_properties& props); + + void draw_text (const text::properties& props); + void draw_pixels (GLsizei w, GLsizei h, GLenum format, + GLenum type, const GLvoid *data); + + void set_linestyle (const std::string& s, bool use_stipple = false) + { + opengl_renderer::set_linestyle (s, use_stipple); + + if (s == "-" && ! use_stipple) + gl2psDisable (GL2PS_LINE_STIPPLE); + else + gl2psEnable (GL2PS_LINE_STIPPLE); + } + + void set_polygon_offset (bool on, double offset = 0.0) + { + opengl_renderer::set_polygon_offset (on, offset); + if (on) + gl2psEnable (GL2PS_POLYGON_OFFSET_FILL); + else + gl2psDisable (GL2PS_POLYGON_OFFSET_FILL); + } + + void set_linewidth (float w) + { + gl2psLineWidth (w); + } + +private: + int alignment_to_mode (int ha, int va) const; + FILE *fp; + caseless_str term; + double fontsize; + std::string fontname; +}; + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/gl2ps.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/gl2ps.c Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,6078 @@ +/* + * GL2PS, an OpenGL to PostScript Printing Library + * Copyright (C) 1999-2011 C. Geuzaine + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of either: + * + * a) the GNU Library General Public License as published by the Free + * Software Foundation, either version 2 of the License, or (at your + * option) any later version; or + * + * b) the GL2PS License as published by Christophe Geuzaine, either + * version 2 of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either + * the GNU Library General Public License or the GL2PS License for + * more details. + * + * You should have received a copy of the GNU Library General Public + * License along with this library in the file named "COPYING.LGPL"; + * if not, write to the Free Software Foundation, Inc., 675 Mass Ave, + * Cambridge, MA 02139, USA. + * + * You should have received a copy of the GL2PS License with this + * library in the file named "COPYING.GL2PS"; if not, I will be glad + * to provide one. + * + * For the latest info about gl2ps and a full list of contributors, + * see http://www.geuz.org/gl2ps/. + * + * Please report all bugs and problems to . + */ + +#include "gl2ps.h" + +#include +#include +#include +#include +#include +#include + +#if defined(GL2PS_HAVE_ZLIB) +#include +#endif + +#if defined(GL2PS_HAVE_LIBPNG) +#include +#endif + +/********************************************************************* + * + * Private definitions, data structures and prototypes + * + *********************************************************************/ + +/* Magic numbers (assuming that the order of magnitude of window + coordinates is 10^3) */ + +#define GL2PS_EPSILON 5.0e-3F +#define GL2PS_ZSCALE 1000.0F +#define GL2PS_ZOFFSET 5.0e-2F +#define GL2PS_ZOFFSET_LARGE 20.0F +#define GL2PS_ZERO(arg) (fabs(arg) < 1.e-20) + +/* Primitive types */ + +#define GL2PS_NO_TYPE -1 +#define GL2PS_TEXT 1 +#define GL2PS_POINT 2 +#define GL2PS_LINE 3 +#define GL2PS_QUADRANGLE 4 +#define GL2PS_TRIANGLE 5 +#define GL2PS_PIXMAP 6 +#define GL2PS_IMAGEMAP 7 +#define GL2PS_IMAGEMAP_WRITTEN 8 +#define GL2PS_IMAGEMAP_VISIBLE 9 +#define GL2PS_SPECIAL 10 + +/* BSP tree primitive comparison */ + +#define GL2PS_COINCIDENT 1 +#define GL2PS_IN_FRONT_OF 2 +#define GL2PS_IN_BACK_OF 3 +#define GL2PS_SPANNING 4 + +/* 2D BSP tree primitive comparison */ + +#define GL2PS_POINT_COINCIDENT 0 +#define GL2PS_POINT_INFRONT 1 +#define GL2PS_POINT_BACK 2 + +/* Internal feedback buffer pass-through tokens */ + +#define GL2PS_BEGIN_OFFSET_TOKEN 1 +#define GL2PS_END_OFFSET_TOKEN 2 +#define GL2PS_BEGIN_BOUNDARY_TOKEN 3 +#define GL2PS_END_BOUNDARY_TOKEN 4 +#define GL2PS_BEGIN_STIPPLE_TOKEN 5 +#define GL2PS_END_STIPPLE_TOKEN 6 +#define GL2PS_POINT_SIZE_TOKEN 7 +#define GL2PS_LINE_WIDTH_TOKEN 8 +#define GL2PS_BEGIN_BLEND_TOKEN 9 +#define GL2PS_END_BLEND_TOKEN 10 +#define GL2PS_SRC_BLEND_TOKEN 11 +#define GL2PS_DST_BLEND_TOKEN 12 +#define GL2PS_IMAGEMAP_TOKEN 13 +#define GL2PS_DRAW_PIXELS_TOKEN 14 +#define GL2PS_TEXT_TOKEN 15 + +typedef enum { + T_UNDEFINED = -1, + T_CONST_COLOR = 1, + T_VAR_COLOR = 1<<1, + T_ALPHA_1 = 1<<2, + T_ALPHA_LESS_1 = 1<<3, + T_VAR_ALPHA = 1<<4 +} GL2PS_TRIANGLE_PROPERTY; + +typedef GLfloat GL2PSxyz[3]; +typedef GLfloat GL2PSplane[4]; + +typedef struct _GL2PSbsptree2d GL2PSbsptree2d; + +struct _GL2PSbsptree2d { + GL2PSplane plane; + GL2PSbsptree2d *front, *back; +}; + +typedef struct { + GLint nmax, size, incr, n; + char *array; +} GL2PSlist; + +typedef struct _GL2PSbsptree GL2PSbsptree; + +struct _GL2PSbsptree { + GL2PSplane plane; + GL2PSlist *primitives; + GL2PSbsptree *front, *back; +}; + +typedef struct { + GL2PSxyz xyz; + GL2PSrgba rgba; +} GL2PSvertex; + +typedef struct { + GL2PSvertex vertex[3]; + int prop; +} GL2PStriangle; + +typedef struct { + GLshort fontsize; + char *str, *fontname; + /* Note: for a 'special' string, 'alignment' holds the format + (PostScript, PDF, etc.) of the special string */ + GLint alignment; + GLfloat angle; +} GL2PSstring; + +typedef struct { + GLsizei width, height; + /* Note: for an imagemap, 'type' indicates if it has already been + written to the file or not, and 'format' indicates if it is + visible or not */ + GLenum format, type; + GLfloat zoom_x, zoom_y; + GLfloat *pixels; +} GL2PSimage; + +typedef struct _GL2PSimagemap GL2PSimagemap; + +struct _GL2PSimagemap { + GL2PSimage *image; + GL2PSimagemap *next; +}; + +typedef struct { + GLshort type, numverts; + GLushort pattern; + char boundary, offset, culled; + GLint factor; + GLfloat width; + GL2PSvertex *verts; + union { + GL2PSstring *text; + GL2PSimage *image; + } data; +} GL2PSprimitive; + +typedef struct { +#if defined(GL2PS_HAVE_ZLIB) + Bytef *dest, *src, *start; + uLongf destLen, srcLen; +#else + int dummy; +#endif +} GL2PScompress; + +typedef struct{ + GL2PSlist* ptrlist; + int gsno, fontno, imno, shno, maskshno, trgroupno; + int gsobjno, fontobjno, imobjno, shobjno, maskshobjno, trgroupobjno; +} GL2PSpdfgroup; + +typedef struct { + /* General */ + GLint format, sort, options, colorsize, colormode, buffersize; + char *title, *producer, *filename; + GLboolean boundary, blending; + GLfloat *feedback, offset[2], lastlinewidth; + GLint viewport[4], blendfunc[2], lastfactor; + GL2PSrgba *colormap, lastrgba, threshold, bgcolor; + GLushort lastpattern; + GL2PSvertex lastvertex; + GL2PSlist *primitives, *auxprimitives; + FILE *stream; + GL2PScompress *compress; + GLboolean header; + + /* BSP-specific */ + GLint maxbestroot; + + /* Occlusion culling-specific */ + GLboolean zerosurfacearea; + GL2PSbsptree2d *imagetree; + GL2PSprimitive *primitivetoadd; + + /* PDF-specific */ + int streamlength; + GL2PSlist *pdfprimlist, *pdfgrouplist; + int *xreflist; + int objects_stack; /* available objects */ + int extgs_stack; /* graphics state object number */ + int font_stack; /* font object number */ + int im_stack; /* image object number */ + int trgroupobjects_stack; /* xobject numbers */ + int shader_stack; /* shader object numbers */ + int mshader_stack; /* mask shader object numbers */ + + /* for image map list */ + GL2PSimagemap *imagemap_head; + GL2PSimagemap *imagemap_tail; +} GL2PScontext; + +typedef struct { + void (*printHeader)(void); + void (*printFooter)(void); + void (*beginViewport)(GLint viewport[4]); + GLint (*endViewport)(void); + void (*printPrimitive)(void *data); + void (*printFinalPrimitive)(void); + const char *file_extension; + const char *description; +} GL2PSbackend; + +/* The gl2ps context. gl2ps is not thread safe (we should create a + local GL2PScontext during gl2psBeginPage) */ + +static GL2PScontext *gl2ps = NULL; + +/* Need to forward-declare this one */ + +static GLint gl2psPrintPrimitives(void); + +/********************************************************************* + * + * Utility routines + * + *********************************************************************/ + +static void gl2psMsg(GLint level, const char *fmt, ...) +{ + va_list args; + + if(!(gl2ps->options & GL2PS_SILENT)){ + switch(level){ + case GL2PS_INFO : fprintf(stderr, "GL2PS info: "); break; + case GL2PS_WARNING : fprintf(stderr, "GL2PS warning: "); break; + case GL2PS_ERROR : fprintf(stderr, "GL2PS error: "); break; + } + va_start(args, fmt); + vfprintf(stderr, fmt, args); + va_end(args); + fprintf(stderr, "\n"); + } + /* if(level == GL2PS_ERROR) exit(1); */ +} + +static void *gl2psMalloc(size_t size) +{ + void *ptr; + + if(!size) return NULL; + ptr = malloc(size); + if(!ptr){ + gl2psMsg(GL2PS_ERROR, "Couldn't allocate requested memory"); + return NULL; + } + return ptr; +} + +static void *gl2psRealloc(void *ptr, size_t size) +{ + void *orig = ptr; + if(!size) return NULL; + ptr = realloc(orig, size); + if(!ptr){ + gl2psMsg(GL2PS_ERROR, "Couldn't reallocate requested memory"); + free(orig); + return NULL; + } + return ptr; +} + +static void gl2psFree(void *ptr) +{ + if(!ptr) return; + free(ptr); +} + +static int gl2psWriteBigEndian(unsigned long data, int bytes) +{ + int i; + int size = sizeof(unsigned long); + for(i = 1; i <= bytes; ++i){ + fputc(0xff & (data >> (size - i) * 8), gl2ps->stream); + } + return bytes; +} + +/* zlib compression helper routines */ + +#if defined(GL2PS_HAVE_ZLIB) + +static void gl2psSetupCompress(void) +{ + gl2ps->compress = (GL2PScompress*)gl2psMalloc(sizeof(GL2PScompress)); + gl2ps->compress->src = NULL; + gl2ps->compress->start = NULL; + gl2ps->compress->dest = NULL; + gl2ps->compress->srcLen = 0; + gl2ps->compress->destLen = 0; +} + +static void gl2psFreeCompress(void) +{ + if(!gl2ps->compress) + return; + gl2psFree(gl2ps->compress->start); + gl2psFree(gl2ps->compress->dest); + gl2ps->compress->src = NULL; + gl2ps->compress->start = NULL; + gl2ps->compress->dest = NULL; + gl2ps->compress->srcLen = 0; + gl2ps->compress->destLen = 0; +} + +static int gl2psAllocCompress(unsigned int srcsize) +{ + gl2psFreeCompress(); + + if(!gl2ps->compress || !srcsize) + return GL2PS_ERROR; + + gl2ps->compress->srcLen = srcsize; + gl2ps->compress->destLen = (int)ceil(1.001 * gl2ps->compress->srcLen + 12); + gl2ps->compress->src = (Bytef*)gl2psMalloc(gl2ps->compress->srcLen); + gl2ps->compress->start = gl2ps->compress->src; + gl2ps->compress->dest = (Bytef*)gl2psMalloc(gl2ps->compress->destLen); + + return GL2PS_SUCCESS; +} + +static void *gl2psReallocCompress(unsigned int srcsize) +{ + if(!gl2ps->compress || !srcsize) + return NULL; + + if(srcsize < gl2ps->compress->srcLen) + return gl2ps->compress->start; + + gl2ps->compress->srcLen = srcsize; + gl2ps->compress->destLen = (int)ceil(1.001 * gl2ps->compress->srcLen + 12); + gl2ps->compress->src = (Bytef*)gl2psRealloc(gl2ps->compress->src, + gl2ps->compress->srcLen); + gl2ps->compress->start = gl2ps->compress->src; + gl2ps->compress->dest = (Bytef*)gl2psRealloc(gl2ps->compress->dest, + gl2ps->compress->destLen); + + return gl2ps->compress->start; +} + +static int gl2psWriteBigEndianCompress(unsigned long data, int bytes) +{ + int i; + int size = sizeof(unsigned long); + for(i = 1; i <= bytes; ++i){ + *gl2ps->compress->src = (Bytef)(0xff & (data >> (size-i) * 8)); + ++gl2ps->compress->src; + } + return bytes; +} + +static int gl2psDeflate(void) +{ + /* For compatibility with older zlib versions, we use compress(...) + instead of compress2(..., Z_BEST_COMPRESSION) */ + return compress(gl2ps->compress->dest, &gl2ps->compress->destLen, + gl2ps->compress->start, gl2ps->compress->srcLen); +} + +#endif + +static int gl2psPrintf(const char* fmt, ...) +{ + int ret; + va_list args; + +#if defined(GL2PS_HAVE_ZLIB) + unsigned int oldsize = 0; + static char buf[1000]; + if(gl2ps->options & GL2PS_COMPRESS){ + va_start(args, fmt); + ret = vsprintf(buf, fmt, args); + va_end(args); + oldsize = gl2ps->compress->srcLen; + gl2ps->compress->start = (Bytef*)gl2psReallocCompress(oldsize + ret); + memcpy(gl2ps->compress->start+oldsize, buf, ret); + ret = 0; + } + else{ +#endif + va_start(args, fmt); + ret = vfprintf(gl2ps->stream, fmt, args); + va_end(args); +#if defined(GL2PS_HAVE_ZLIB) + } +#endif + return ret; +} + +static void gl2psPrintGzipHeader(void) +{ +#if defined(GL2PS_HAVE_ZLIB) + char tmp[10] = {'\x1f', '\x8b', /* magic numbers: 0x1f, 0x8b */ + 8, /* compression method: Z_DEFLATED */ + 0, /* flags */ + 0, 0, 0, 0, /* time */ + 2, /* extra flags: max compression */ + '\x03'}; /* OS code: 0x03 (Unix) */ + + if(gl2ps->options & GL2PS_COMPRESS){ + gl2psSetupCompress(); + /* add the gzip file header */ + fwrite(tmp, 10, 1, gl2ps->stream); + } +#endif +} + +static void gl2psPrintGzipFooter(void) +{ +#if defined(GL2PS_HAVE_ZLIB) + int n; + uLong crc, len; + char tmp[8]; + + if(gl2ps->options & GL2PS_COMPRESS){ + if(Z_OK != gl2psDeflate()){ + gl2psMsg(GL2PS_ERROR, "Zlib deflate error"); + } + else{ + /* determine the length of the header in the zlib stream */ + n = 2; /* CMF+FLG */ + if(gl2ps->compress->dest[1] & (1<<5)){ + n += 4; /* DICTID */ + } + /* write the data, without the zlib header and footer */ + fwrite(gl2ps->compress->dest+n, gl2ps->compress->destLen-(n+4), + 1, gl2ps->stream); + /* add the gzip file footer */ + crc = crc32(0L, gl2ps->compress->start, gl2ps->compress->srcLen); + for(n = 0; n < 4; ++n){ + tmp[n] = (char)(crc & 0xff); + crc >>= 8; + } + len = gl2ps->compress->srcLen; + for(n = 4; n < 8; ++n){ + tmp[n] = (char)(len & 0xff); + len >>= 8; + } + fwrite(tmp, 8, 1, gl2ps->stream); + } + gl2psFreeCompress(); + gl2psFree(gl2ps->compress); + gl2ps->compress = NULL; + } +#endif +} + +/* The list handling routines */ + +static void gl2psListRealloc(GL2PSlist *list, GLint n) +{ + if(!list){ + gl2psMsg(GL2PS_ERROR, "Cannot reallocate NULL list"); + return; + } + if(n <= 0) return; + if(!list->array){ + list->nmax = n; + list->array = (char*)gl2psMalloc(list->nmax * list->size); + } + else{ + if(n > list->nmax){ + list->nmax = ((n - 1) / list->incr + 1) * list->incr; + list->array = (char*)gl2psRealloc(list->array, + list->nmax * list->size); + } + } +} + +static GL2PSlist *gl2psListCreate(GLint n, GLint incr, GLint size) +{ + GL2PSlist *list; + + if(n < 0) n = 0; + if(incr <= 0) incr = 1; + list = (GL2PSlist*)gl2psMalloc(sizeof(GL2PSlist)); + list->nmax = 0; + list->incr = incr; + list->size = size; + list->n = 0; + list->array = NULL; + gl2psListRealloc(list, n); + return list; +} + +static void gl2psListReset(GL2PSlist *list) +{ + if(!list) return; + list->n = 0; +} + +static void gl2psListDelete(GL2PSlist *list) +{ + if(!list) return; + gl2psFree(list->array); + gl2psFree(list); +} + +static void gl2psListAdd(GL2PSlist *list, void *data) +{ + if(!list){ + gl2psMsg(GL2PS_ERROR, "Cannot add into unallocated list"); + return; + } + list->n++; + gl2psListRealloc(list, list->n); + memcpy(&list->array[(list->n - 1) * list->size], data, list->size); +} + +static int gl2psListNbr(GL2PSlist *list) +{ + if(!list) + return 0; + return list->n; +} + +static void *gl2psListPointer(GL2PSlist *list, GLint index) +{ + if(!list){ + gl2psMsg(GL2PS_ERROR, "Cannot point into unallocated list"); + return NULL; + } + if((index < 0) || (index >= list->n)){ + gl2psMsg(GL2PS_ERROR, "Wrong list index in gl2psListPointer"); + return NULL; + } + return &list->array[index * list->size]; +} + +static void gl2psListSort(GL2PSlist *list, + int (*fcmp)(const void *a, const void *b)) +{ + if(!list) + return; + qsort(list->array, list->n, list->size, fcmp); +} + +static void gl2psListAction(GL2PSlist *list, void (*action)(void *data)) +{ + GLint i; + + for(i = 0; i < gl2psListNbr(list); i++){ + (*action)(gl2psListPointer(list, i)); + } +} + +static void gl2psListActionInverse(GL2PSlist *list, void (*action)(void *data)) +{ + GLint i; + + for(i = gl2psListNbr(list); i > 0; i--){ + (*action)(gl2psListPointer(list, i-1)); + } +} + +#if defined(GL2PS_HAVE_LIBPNG) + +static void gl2psListRead(GL2PSlist *list, int index, void *data) +{ + if((index < 0) || (index >= list->n)) + gl2psMsg(GL2PS_ERROR, "Wrong list index in gl2psListRead"); + memcpy(data, &list->array[index * list->size], list->size); +} + +static void gl2psEncodeBase64Block(unsigned char in[3], unsigned char out[4], int len) +{ + static const char cb64[] = + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"; + + out[0] = cb64[ in[0] >> 2 ]; + out[1] = cb64[ ((in[0] & 0x03) << 4) | ((in[1] & 0xf0) >> 4) ]; + out[2] = (len > 1) ? cb64[ ((in[1] & 0x0f) << 2) | ((in[2] & 0xc0) >> 6) ] : '='; + out[3] = (len > 2) ? cb64[ in[2] & 0x3f ] : '='; +} + +static void gl2psListEncodeBase64(GL2PSlist *list) +{ + unsigned char *buffer, in[3], out[4]; + int i, n, index, len; + + n = list->n * list->size; + buffer = (unsigned char*)gl2psMalloc(n * sizeof(unsigned char)); + memcpy(buffer, list->array, n * sizeof(unsigned char)); + gl2psListReset(list); + + index = 0; + while(index < n) { + len = 0; + for(i = 0; i < 3; i++) { + if(index < n){ + in[i] = buffer[index]; + len++; + } + else{ + in[i] = 0; + } + index++; + } + if(len) { + gl2psEncodeBase64Block(in, out, len); + for(i = 0; i < 4; i++) + gl2psListAdd(list, &out[i]); + } + } + gl2psFree(buffer); +} + +#endif + +/* Helpers for rgba colors */ + +static GLboolean gl2psSameColor(GL2PSrgba rgba1, GL2PSrgba rgba2) +{ + if(!GL2PS_ZERO(rgba1[0] - rgba2[0]) || + !GL2PS_ZERO(rgba1[1] - rgba2[1]) || + !GL2PS_ZERO(rgba1[2] - rgba2[2])) + return GL_FALSE; + return GL_TRUE; +} + +static GLboolean gl2psVertsSameColor(const GL2PSprimitive *prim) +{ + int i; + + for(i = 1; i < prim->numverts; i++){ + if(!gl2psSameColor(prim->verts[0].rgba, prim->verts[i].rgba)){ + return GL_FALSE; + } + } + return GL_TRUE; +} + +static GLboolean gl2psSameColorThreshold(int n, GL2PSrgba rgba[], + GL2PSrgba threshold) +{ + int i; + + if(n < 2) return GL_TRUE; + + for(i = 1; i < n; i++){ + if(fabs(rgba[0][0] - rgba[i][0]) > threshold[0] || + fabs(rgba[0][1] - rgba[i][1]) > threshold[1] || + fabs(rgba[0][2] - rgba[i][2]) > threshold[2]) + return GL_FALSE; + } + + return GL_TRUE; +} + +static void gl2psSetLastColor(GL2PSrgba rgba) +{ + int i; + for(i = 0; i < 3; ++i){ + gl2ps->lastrgba[i] = rgba[i]; + } +} + +static GLfloat gl2psGetRGB(GL2PSimage *im, GLuint x, GLuint y, + GLfloat *red, GLfloat *green, GLfloat *blue) +{ + + GLsizei width = im->width; + GLsizei height = im->height; + GLfloat *pixels = im->pixels; + GLfloat *pimag; + + /* OpenGL image is from down to up, PS image is up to down */ + switch(im->format){ + case GL_RGBA: + pimag = pixels + 4 * (width * (height - 1 - y) + x); + break; + case GL_RGB: + default: + pimag = pixels + 3 * (width * (height - 1 - y) + x); + break; + } + *red = *pimag; pimag++; + *green = *pimag; pimag++; + *blue = *pimag; pimag++; + + return (im->format == GL_RGBA) ? *pimag : 1.0F; +} + +/* Helper routines for pixmaps */ + +static GL2PSimage *gl2psCopyPixmap(GL2PSimage *im) +{ + int size; + GL2PSimage *image = (GL2PSimage*)gl2psMalloc(sizeof(GL2PSimage)); + + image->width = im->width; + image->height = im->height; + image->format = im->format; + image->type = im->type; + image->zoom_x = im->zoom_x; + image->zoom_y = im->zoom_y; + + switch(image->format){ + case GL_RGBA: + size = image->height * image->width * 4 * sizeof(GLfloat); + break; + case GL_RGB: + default: + size = image->height * image->width * 3 * sizeof(GLfloat); + break; + } + + image->pixels = (GLfloat*)gl2psMalloc(size); + memcpy(image->pixels, im->pixels, size); + + return image; +} + +static void gl2psFreePixmap(GL2PSimage *im) +{ + if(!im) + return; + gl2psFree(im->pixels); + gl2psFree(im); +} + +#if defined(GL2PS_HAVE_LIBPNG) + +#if !defined(png_jmpbuf) +# define png_jmpbuf(png_ptr) ((png_ptr)->jmpbuf) +#endif + +static void gl2psUserWritePNG(png_structp png_ptr, png_bytep data, png_size_t length) +{ + unsigned int i; + GL2PSlist *png = (GL2PSlist*)png_get_io_ptr(png_ptr); + for(i = 0; i < length; i++) + gl2psListAdd(png, &data[i]); +} + +static void gl2psUserFlushPNG(png_structp png_ptr) +{ + (void) png_ptr; /* not used */ +} + +static void gl2psConvertPixmapToPNG(GL2PSimage *pixmap, GL2PSlist *png) +{ + png_structp png_ptr; + png_infop info_ptr; + unsigned char *row_data; + GLfloat dr, dg, db; + int row, col; + + if(!(png_ptr = png_create_write_struct(PNG_LIBPNG_VER_STRING, NULL, NULL, NULL))) + return; + + if(!(info_ptr = png_create_info_struct(png_ptr))){ + png_destroy_write_struct(&png_ptr, NULL); + return; + } + + if(setjmp(png_jmpbuf(png_ptr))) { + png_destroy_write_struct(&png_ptr, &info_ptr); + return; + } + + png_set_write_fn(png_ptr, (void *)png, gl2psUserWritePNG, gl2psUserFlushPNG); + png_set_compression_level(png_ptr, Z_DEFAULT_COMPRESSION); + png_set_IHDR(png_ptr, info_ptr, pixmap->width, pixmap->height, 8, + PNG_COLOR_TYPE_RGB, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_BASE, + PNG_FILTER_TYPE_BASE); + png_write_info(png_ptr, info_ptr); + + row_data = (unsigned char*)gl2psMalloc(3 * pixmap->width * sizeof(unsigned char)); + for(row = 0; row < pixmap->height; row++){ + for(col = 0; col < pixmap->width; col++){ + gl2psGetRGB(pixmap, col, row, &dr, &dg, &db); + row_data[3*col] = (unsigned char)(255. * dr); + row_data[3*col+1] = (unsigned char)(255. * dg); + row_data[3*col+2] = (unsigned char)(255. * db); + } + png_write_row(png_ptr, (png_bytep)row_data); + } + gl2psFree(row_data); + + png_write_end(png_ptr, info_ptr); + png_destroy_write_struct(&png_ptr, &info_ptr); +} + +#endif + +/* Helper routines for text strings */ + +static GLint gl2psAddText(GLint type, const char *str, const char *fontname, + GLshort fontsize, GLint alignment, GLfloat angle) +{ + GLfloat pos[4]; + GL2PSprimitive *prim; + GLboolean valid; + + if(!gl2ps || !str || !fontname) return GL2PS_UNINITIALIZED; + + if(gl2ps->options & GL2PS_NO_TEXT) return GL2PS_SUCCESS; + + glGetBooleanv(GL_CURRENT_RASTER_POSITION_VALID, &valid); + if(GL_FALSE == valid) return GL2PS_SUCCESS; /* the primitive is culled */ + + glGetFloatv(GL_CURRENT_RASTER_POSITION, pos); + + prim = (GL2PSprimitive*)gl2psMalloc(sizeof(GL2PSprimitive)); + prim->type = type; + prim->boundary = 0; + prim->numverts = 1; + prim->verts = (GL2PSvertex*)gl2psMalloc(sizeof(GL2PSvertex)); + prim->verts[0].xyz[0] = pos[0]; + prim->verts[0].xyz[1] = pos[1]; + prim->verts[0].xyz[2] = pos[2]; + prim->culled = 0; + prim->offset = 0; + prim->pattern = 0; + prim->factor = 0; + prim->width = 1; + glGetFloatv(GL_CURRENT_RASTER_COLOR, prim->verts[0].rgba); + prim->data.text = (GL2PSstring*)gl2psMalloc(sizeof(GL2PSstring)); + prim->data.text->str = (char*)gl2psMalloc((strlen(str)+1)*sizeof(char)); + strcpy(prim->data.text->str, str); + prim->data.text->fontname = (char*)gl2psMalloc((strlen(fontname)+1)*sizeof(char)); + strcpy(prim->data.text->fontname, fontname); + prim->data.text->fontsize = fontsize; + prim->data.text->alignment = alignment; + prim->data.text->angle = angle; + + gl2psListAdd(gl2ps->auxprimitives, &prim); + glPassThrough(GL2PS_TEXT_TOKEN); + + return GL2PS_SUCCESS; +} + +static GL2PSstring *gl2psCopyText(GL2PSstring *t) +{ + GL2PSstring *text = (GL2PSstring*)gl2psMalloc(sizeof(GL2PSstring)); + text->str = (char*)gl2psMalloc((strlen(t->str)+1)*sizeof(char)); + strcpy(text->str, t->str); + text->fontname = (char*)gl2psMalloc((strlen(t->fontname)+1)*sizeof(char)); + strcpy(text->fontname, t->fontname); + text->fontsize = t->fontsize; + text->alignment = t->alignment; + text->angle = t->angle; + + return text; +} + +static void gl2psFreeText(GL2PSstring *text) +{ + if(!text) + return; + gl2psFree(text->str); + gl2psFree(text->fontname); + gl2psFree(text); +} + +/* Helpers for blending modes */ + +static GLboolean gl2psSupportedBlendMode(GLenum sfactor, GLenum dfactor) +{ + /* returns TRUE if gl2ps supports the argument combination: only two + blending modes have been implemented so far */ + + if( (sfactor == GL_SRC_ALPHA && dfactor == GL_ONE_MINUS_SRC_ALPHA) || + (sfactor == GL_ONE && dfactor == GL_ZERO) ) + return GL_TRUE; + return GL_FALSE; +} + +static void gl2psAdaptVertexForBlending(GL2PSvertex *v) +{ + /* Transforms vertex depending on the actual blending function - + currently the vertex v is considered as source vertex and his + alpha value is changed to 1.0 if source blending GL_ONE is + active. This might be extended in the future */ + + if(!v || !gl2ps) + return; + + if(gl2ps->options & GL2PS_NO_BLENDING || !gl2ps->blending){ + v->rgba[3] = 1.0F; + return; + } + + switch(gl2ps->blendfunc[0]){ + case GL_ONE: + v->rgba[3] = 1.0F; + break; + default: + break; + } +} + +static void gl2psAssignTriangleProperties(GL2PStriangle *t) +{ + /* int i; */ + + t->prop = T_VAR_COLOR; + + /* Uncommenting the following lines activates an even more fine + grained distinction between triangle types - please don't delete, + a remarkable amount of PDF handling code inside this file depends + on it if activated */ + /* + t->prop = T_CONST_COLOR; + for(i = 0; i < 3; ++i){ + if(!GL2PS_ZERO(t->vertex[0].rgba[i] - t->vertex[1].rgba[i]) || + !GL2PS_ZERO(t->vertex[1].rgba[i] - t->vertex[2].rgba[i])){ + t->prop = T_VAR_COLOR; + break; + } + } + */ + + if(!GL2PS_ZERO(t->vertex[0].rgba[3] - t->vertex[1].rgba[3]) || + !GL2PS_ZERO(t->vertex[1].rgba[3] - t->vertex[2].rgba[3])){ + t->prop |= T_VAR_ALPHA; + } + else{ + if(t->vertex[0].rgba[3] < 1) + t->prop |= T_ALPHA_LESS_1; + else + t->prop |= T_ALPHA_1; + } +} + +static void gl2psFillTriangleFromPrimitive(GL2PStriangle *t, GL2PSprimitive *p, + GLboolean assignprops) +{ + t->vertex[0] = p->verts[0]; + t->vertex[1] = p->verts[1]; + t->vertex[2] = p->verts[2]; + if(GL_TRUE == assignprops) + gl2psAssignTriangleProperties(t); +} + +static void gl2psInitTriangle(GL2PStriangle *t) +{ + int i; + GL2PSvertex vertex = { {-1.0F, -1.0F, -1.0F}, {-1.0F, -1.0F, -1.0F, -1.0F} }; + for(i = 0; i < 3; i++) + t->vertex[i] = vertex; + t->prop = T_UNDEFINED; +} + +/* Miscellaneous helper routines */ + +static GL2PSprimitive *gl2psCopyPrimitive(GL2PSprimitive *p) +{ + GL2PSprimitive *prim; + + if(!p){ + gl2psMsg(GL2PS_ERROR, "Trying to copy an empty primitive"); + return NULL; + } + + prim = (GL2PSprimitive*)gl2psMalloc(sizeof(GL2PSprimitive)); + + prim->type = p->type; + prim->numverts = p->numverts; + prim->boundary = p->boundary; + prim->offset = p->offset; + prim->pattern = p->pattern; + prim->factor = p->factor; + prim->culled = p->culled; + prim->width = p->width; + prim->verts = (GL2PSvertex*)gl2psMalloc(p->numverts*sizeof(GL2PSvertex)); + memcpy(prim->verts, p->verts, p->numverts * sizeof(GL2PSvertex)); + + switch(prim->type){ + case GL2PS_PIXMAP : + prim->data.image = gl2psCopyPixmap(p->data.image); + break; + case GL2PS_TEXT : + case GL2PS_SPECIAL : + prim->data.text = gl2psCopyText(p->data.text); + break; + default: + break; + } + + return prim; +} + +static GLboolean gl2psSamePosition(GL2PSxyz p1, GL2PSxyz p2) +{ + if(!GL2PS_ZERO(p1[0] - p2[0]) || + !GL2PS_ZERO(p1[1] - p2[1]) || + !GL2PS_ZERO(p1[2] - p2[2])) + return GL_FALSE; + return GL_TRUE; +} + +/********************************************************************* + * + * 3D sorting routines + * + *********************************************************************/ + +static GLfloat gl2psComparePointPlane(GL2PSxyz point, GL2PSplane plane) +{ + return (plane[0] * point[0] + + plane[1] * point[1] + + plane[2] * point[2] + + plane[3]); +} + +static GLfloat gl2psPsca(GLfloat *a, GLfloat *b) +{ + return (a[0]*b[0] + a[1]*b[1] + a[2]*b[2]); +} + +static void gl2psPvec(GLfloat *a, GLfloat *b, GLfloat *c) +{ + c[0] = a[1]*b[2] - a[2]*b[1]; + c[1] = a[2]*b[0] - a[0]*b[2]; + c[2] = a[0]*b[1] - a[1]*b[0]; +} + +static GLfloat gl2psNorm(GLfloat *a) +{ + return (GLfloat)sqrt(a[0]*a[0] + a[1]*a[1] + a[2]*a[2]); +} + +static void gl2psGetNormal(GLfloat *a, GLfloat *b, GLfloat *c) +{ + GLfloat norm; + + gl2psPvec(a, b, c); + if(!GL2PS_ZERO(norm = gl2psNorm(c))){ + c[0] = c[0] / norm; + c[1] = c[1] / norm; + c[2] = c[2] / norm; + } + else{ + /* The plane is still wrong despite our tests in gl2psGetPlane. + Let's return a dummy value for now (this is a hack: we should + do more intelligent tests in GetPlane) */ + c[0] = c[1] = 0.0F; + c[2] = 1.0F; + } +} + +static void gl2psGetPlane(GL2PSprimitive *prim, GL2PSplane plane) +{ + GL2PSxyz v = {0.0F, 0.0F, 0.0F}, w = {0.0F, 0.0F, 0.0F}; + + switch(prim->type){ + case GL2PS_TRIANGLE : + case GL2PS_QUADRANGLE : + v[0] = prim->verts[1].xyz[0] - prim->verts[0].xyz[0]; + v[1] = prim->verts[1].xyz[1] - prim->verts[0].xyz[1]; + v[2] = prim->verts[1].xyz[2] - prim->verts[0].xyz[2]; + w[0] = prim->verts[2].xyz[0] - prim->verts[0].xyz[0]; + w[1] = prim->verts[2].xyz[1] - prim->verts[0].xyz[1]; + w[2] = prim->verts[2].xyz[2] - prim->verts[0].xyz[2]; + if((GL2PS_ZERO(v[0]) && GL2PS_ZERO(v[1]) && GL2PS_ZERO(v[2])) || + (GL2PS_ZERO(w[0]) && GL2PS_ZERO(w[1]) && GL2PS_ZERO(w[2]))){ + plane[0] = plane[1] = 0.0F; + plane[2] = 1.0F; + plane[3] = -prim->verts[0].xyz[2]; + } + else{ + gl2psGetNormal(v, w, plane); + plane[3] = + - plane[0] * prim->verts[0].xyz[0] + - plane[1] * prim->verts[0].xyz[1] + - plane[2] * prim->verts[0].xyz[2]; + } + break; + case GL2PS_LINE : + v[0] = prim->verts[1].xyz[0] - prim->verts[0].xyz[0]; + v[1] = prim->verts[1].xyz[1] - prim->verts[0].xyz[1]; + v[2] = prim->verts[1].xyz[2] - prim->verts[0].xyz[2]; + if(GL2PS_ZERO(v[0]) && GL2PS_ZERO(v[1]) && GL2PS_ZERO(v[2])){ + plane[0] = plane[1] = 0.0F; + plane[2] = 1.0F; + plane[3] = -prim->verts[0].xyz[2]; + } + else{ + if(GL2PS_ZERO(v[0])) w[0] = 1.0F; + else if(GL2PS_ZERO(v[1])) w[1] = 1.0F; + else w[2] = 1.0F; + gl2psGetNormal(v, w, plane); + plane[3] = + - plane[0] * prim->verts[0].xyz[0] + - plane[1] * prim->verts[0].xyz[1] + - plane[2] * prim->verts[0].xyz[2]; + } + break; + case GL2PS_POINT : + case GL2PS_PIXMAP : + case GL2PS_TEXT : + case GL2PS_SPECIAL : + case GL2PS_IMAGEMAP: + plane[0] = plane[1] = 0.0F; + plane[2] = 1.0F; + plane[3] = -prim->verts[0].xyz[2]; + break; + default : + gl2psMsg(GL2PS_ERROR, "Unknown primitive type in BSP tree"); + plane[0] = plane[1] = plane[3] = 0.0F; + plane[2] = 1.0F; + break; + } +} + +static void gl2psCutEdge(GL2PSvertex *a, GL2PSvertex *b, GL2PSplane plane, + GL2PSvertex *c) +{ + GL2PSxyz v; + GLfloat sect, psca; + + v[0] = b->xyz[0] - a->xyz[0]; + v[1] = b->xyz[1] - a->xyz[1]; + v[2] = b->xyz[2] - a->xyz[2]; + + if(!GL2PS_ZERO(psca = gl2psPsca(plane, v))) + sect = -gl2psComparePointPlane(a->xyz, plane) / psca; + else + sect = 0.0F; + + c->xyz[0] = a->xyz[0] + v[0] * sect; + c->xyz[1] = a->xyz[1] + v[1] * sect; + c->xyz[2] = a->xyz[2] + v[2] * sect; + + c->rgba[0] = (1 - sect) * a->rgba[0] + sect * b->rgba[0]; + c->rgba[1] = (1 - sect) * a->rgba[1] + sect * b->rgba[1]; + c->rgba[2] = (1 - sect) * a->rgba[2] + sect * b->rgba[2]; + c->rgba[3] = (1 - sect) * a->rgba[3] + sect * b->rgba[3]; +} + +static void gl2psCreateSplitPrimitive(GL2PSprimitive *parent, GL2PSplane plane, + GL2PSprimitive *child, GLshort numverts, + GLshort *index0, GLshort *index1) +{ + GLshort i; + + if(parent->type == GL2PS_IMAGEMAP){ + child->type = GL2PS_IMAGEMAP; + child->data.image = parent->data.image; + } + else{ + if(numverts > 4){ + gl2psMsg(GL2PS_WARNING, "%d vertices in polygon", numverts); + numverts = 4; + } + switch(numverts){ + case 1 : child->type = GL2PS_POINT; break; + case 2 : child->type = GL2PS_LINE; break; + case 3 : child->type = GL2PS_TRIANGLE; break; + case 4 : child->type = GL2PS_QUADRANGLE; break; + default: child->type = GL2PS_NO_TYPE; break; + } + } + + child->boundary = 0; /* FIXME: not done! */ + child->culled = parent->culled; + child->offset = parent->offset; + child->pattern = parent->pattern; + child->factor = parent->factor; + child->width = parent->width; + child->numverts = numverts; + child->verts = (GL2PSvertex*)gl2psMalloc(numverts * sizeof(GL2PSvertex)); + + for(i = 0; i < numverts; i++){ + if(index1[i] < 0){ + child->verts[i] = parent->verts[index0[i]]; + } + else{ + gl2psCutEdge(&parent->verts[index0[i]], &parent->verts[index1[i]], + plane, &child->verts[i]); + } + } +} + +static void gl2psAddIndex(GLshort *index0, GLshort *index1, GLshort *nb, + GLshort i, GLshort j) +{ + GLint k; + + for(k = 0; k < *nb; k++){ + if((index0[k] == i && index1[k] == j) || + (index1[k] == i && index0[k] == j)) return; + } + index0[*nb] = i; + index1[*nb] = j; + (*nb)++; +} + +static GLshort gl2psGetIndex(GLshort i, GLshort num) +{ + return (i < num - 1) ? i + 1 : 0; +} + +static GLint gl2psTestSplitPrimitive(GL2PSprimitive *prim, GL2PSplane plane) +{ + GLint type = GL2PS_COINCIDENT; + GLshort i, j; + GLfloat d[5]; + + for(i = 0; i < prim->numverts; i++){ + d[i] = gl2psComparePointPlane(prim->verts[i].xyz, plane); + } + + if(prim->numverts < 2){ + return 0; + } + else{ + for(i = 0; i < prim->numverts; i++){ + j = gl2psGetIndex(i, prim->numverts); + if(d[j] > GL2PS_EPSILON){ + if(type == GL2PS_COINCIDENT) type = GL2PS_IN_BACK_OF; + else if(type != GL2PS_IN_BACK_OF) return 1; + if(d[i] < -GL2PS_EPSILON) return 1; + } + else if(d[j] < -GL2PS_EPSILON){ + if(type == GL2PS_COINCIDENT) type = GL2PS_IN_FRONT_OF; + else if(type != GL2PS_IN_FRONT_OF) return 1; + if(d[i] > GL2PS_EPSILON) return 1; + } + } + } + return 0; +} + +static GLint gl2psSplitPrimitive(GL2PSprimitive *prim, GL2PSplane plane, + GL2PSprimitive **front, GL2PSprimitive **back) +{ + GLshort i, j, in = 0, out = 0, in0[5], in1[5], out0[5], out1[5]; + GLint type; + GLfloat d[5]; + + type = GL2PS_COINCIDENT; + + for(i = 0; i < prim->numverts; i++){ + d[i] = gl2psComparePointPlane(prim->verts[i].xyz, plane); + } + + switch(prim->type){ + case GL2PS_POINT : + if(d[0] > GL2PS_EPSILON) type = GL2PS_IN_BACK_OF; + else if(d[0] < -GL2PS_EPSILON) type = GL2PS_IN_FRONT_OF; + else type = GL2PS_COINCIDENT; + break; + default : + for(i = 0; i < prim->numverts; i++){ + j = gl2psGetIndex(i, prim->numverts); + if(d[j] > GL2PS_EPSILON){ + if(type == GL2PS_COINCIDENT) type = GL2PS_IN_BACK_OF; + else if(type != GL2PS_IN_BACK_OF) type = GL2PS_SPANNING; + if(d[i] < -GL2PS_EPSILON){ + gl2psAddIndex(in0, in1, &in, i, j); + gl2psAddIndex(out0, out1, &out, i, j); + type = GL2PS_SPANNING; + } + gl2psAddIndex(out0, out1, &out, j, -1); + } + else if(d[j] < -GL2PS_EPSILON){ + if(type == GL2PS_COINCIDENT) type = GL2PS_IN_FRONT_OF; + else if(type != GL2PS_IN_FRONT_OF) type = GL2PS_SPANNING; + if(d[i] > GL2PS_EPSILON){ + gl2psAddIndex(in0, in1, &in, i, j); + gl2psAddIndex(out0, out1, &out, i, j); + type = GL2PS_SPANNING; + } + gl2psAddIndex(in0, in1, &in, j, -1); + } + else{ + gl2psAddIndex(in0, in1, &in, j, -1); + gl2psAddIndex(out0, out1, &out, j, -1); + } + } + break; + } + + if(type == GL2PS_SPANNING){ + *back = (GL2PSprimitive*)gl2psMalloc(sizeof(GL2PSprimitive)); + *front = (GL2PSprimitive*)gl2psMalloc(sizeof(GL2PSprimitive)); + gl2psCreateSplitPrimitive(prim, plane, *back, out, out0, out1); + gl2psCreateSplitPrimitive(prim, plane, *front, in, in0, in1); + } + + return type; +} + +static void gl2psDivideQuad(GL2PSprimitive *quad, + GL2PSprimitive **t1, GL2PSprimitive **t2) +{ + *t1 = (GL2PSprimitive*)gl2psMalloc(sizeof(GL2PSprimitive)); + *t2 = (GL2PSprimitive*)gl2psMalloc(sizeof(GL2PSprimitive)); + (*t1)->type = (*t2)->type = GL2PS_TRIANGLE; + (*t1)->numverts = (*t2)->numverts = 3; + (*t1)->culled = (*t2)->culled = quad->culled; + (*t1)->offset = (*t2)->offset = quad->offset; + (*t1)->pattern = (*t2)->pattern = quad->pattern; + (*t1)->factor = (*t2)->factor = quad->factor; + (*t1)->width = (*t2)->width = quad->width; + (*t1)->verts = (GL2PSvertex*)gl2psMalloc(3 * sizeof(GL2PSvertex)); + (*t2)->verts = (GL2PSvertex*)gl2psMalloc(3 * sizeof(GL2PSvertex)); + (*t1)->verts[0] = quad->verts[0]; + (*t1)->verts[1] = quad->verts[1]; + (*t1)->verts[2] = quad->verts[2]; + (*t1)->boundary = ((quad->boundary & 1) ? 1 : 0) | ((quad->boundary & 2) ? 2 : 0); + (*t2)->verts[0] = quad->verts[0]; + (*t2)->verts[1] = quad->verts[2]; + (*t2)->verts[2] = quad->verts[3]; + (*t2)->boundary = ((quad->boundary & 4) ? 2 : 0) | ((quad->boundary & 8) ? 4 : 0); +} + +static int gl2psCompareDepth(const void *a, const void *b) +{ + const GL2PSprimitive *q, *w; + GLfloat dq = 0.0F, dw = 0.0F, diff; + int i; + + q = *(const GL2PSprimitive* const*)a; + w = *(const GL2PSprimitive* const*)b; + + for(i = 0; i < q->numverts; i++){ + dq += q->verts[i].xyz[2]; + } + dq /= (GLfloat)q->numverts; + + for(i = 0; i < w->numverts; i++){ + dw += w->verts[i].xyz[2]; + } + dw /= (GLfloat)w->numverts; + + diff = dq - dw; + if(diff > 0.){ + return -1; + } + else if(diff < 0.){ + return 1; + } + else{ + return 0; + } +} + +static int gl2psTrianglesFirst(const void *a, const void *b) +{ + const GL2PSprimitive *q, *w; + + q = *(const GL2PSprimitive* const*)a; + w = *(const GL2PSprimitive* const*)b; + return (q->type < w->type ? 1 : -1); +} + +static GLint gl2psFindRoot(GL2PSlist *primitives, GL2PSprimitive **root) +{ + GLint i, j, count, best = 1000000, index = 0; + GL2PSprimitive *prim1, *prim2; + GL2PSplane plane; + GLint maxp; + + if(!gl2psListNbr(primitives)){ + gl2psMsg(GL2PS_ERROR, "Cannot fint root in empty primitive list"); + return 0; + } + + *root = *(GL2PSprimitive**)gl2psListPointer(primitives, 0); + + if(gl2ps->options & GL2PS_BEST_ROOT){ + maxp = gl2psListNbr(primitives); + if(maxp > gl2ps->maxbestroot){ + maxp = gl2ps->maxbestroot; + } + for(i = 0; i < maxp; i++){ + prim1 = *(GL2PSprimitive**)gl2psListPointer(primitives, i); + gl2psGetPlane(prim1, plane); + count = 0; + for(j = 0; j < gl2psListNbr(primitives); j++){ + if(j != i){ + prim2 = *(GL2PSprimitive**)gl2psListPointer(primitives, j); + count += gl2psTestSplitPrimitive(prim2, plane); + } + if(count > best) break; + } + if(count < best){ + best = count; + index = i; + *root = prim1; + if(!count) return index; + } + } + /* if(index) gl2psMsg(GL2PS_INFO, "GL2PS_BEST_ROOT was worth it: %d", index); */ + return index; + } + else{ + return 0; + } +} + +static void gl2psFreeImagemap(GL2PSimagemap *list) +{ + GL2PSimagemap *next; + while(list != NULL){ + next = list->next; + gl2psFree(list->image->pixels); + gl2psFree(list->image); + gl2psFree(list); + list = next; + } +} + +static void gl2psFreePrimitive(void *data) +{ + GL2PSprimitive *q; + + q = *(GL2PSprimitive**)data; + gl2psFree(q->verts); + if(q->type == GL2PS_TEXT || q->type == GL2PS_SPECIAL){ + gl2psFreeText(q->data.text); + } + else if(q->type == GL2PS_PIXMAP){ + gl2psFreePixmap(q->data.image); + } + gl2psFree(q); +} + +static void gl2psAddPrimitiveInList(GL2PSprimitive *prim, GL2PSlist *list) +{ + GL2PSprimitive *t1, *t2; + + if(prim->type != GL2PS_QUADRANGLE){ + gl2psListAdd(list, &prim); + } + else{ + gl2psDivideQuad(prim, &t1, &t2); + gl2psListAdd(list, &t1); + gl2psListAdd(list, &t2); + gl2psFreePrimitive(&prim); + } + +} + +static void gl2psFreeBspTree(GL2PSbsptree **tree) +{ + if(*tree){ + if((*tree)->back) gl2psFreeBspTree(&(*tree)->back); + if((*tree)->primitives){ + gl2psListAction((*tree)->primitives, gl2psFreePrimitive); + gl2psListDelete((*tree)->primitives); + } + if((*tree)->front) gl2psFreeBspTree(&(*tree)->front); + gl2psFree(*tree); + *tree = NULL; + } +} + +static GLboolean gl2psGreater(GLfloat f1, GLfloat f2) +{ + if(f1 > f2) return GL_TRUE; + else return GL_FALSE; +} + +static GLboolean gl2psLess(GLfloat f1, GLfloat f2) +{ + if(f1 < f2) return GL_TRUE; + else return GL_FALSE; +} + +static void gl2psBuildBspTree(GL2PSbsptree *tree, GL2PSlist *primitives) +{ + GL2PSprimitive *prim, *frontprim = NULL, *backprim = NULL; + GL2PSlist *frontlist, *backlist; + GLint i, index; + + tree->front = NULL; + tree->back = NULL; + tree->primitives = gl2psListCreate(1, 2, sizeof(GL2PSprimitive*)); + index = gl2psFindRoot(primitives, &prim); + gl2psGetPlane(prim, tree->plane); + gl2psAddPrimitiveInList(prim, tree->primitives); + + frontlist = gl2psListCreate(1, 2, sizeof(GL2PSprimitive*)); + backlist = gl2psListCreate(1, 2, sizeof(GL2PSprimitive*)); + + for(i = 0; i < gl2psListNbr(primitives); i++){ + if(i != index){ + prim = *(GL2PSprimitive**)gl2psListPointer(primitives,i); + switch(gl2psSplitPrimitive(prim, tree->plane, &frontprim, &backprim)){ + case GL2PS_COINCIDENT: + gl2psAddPrimitiveInList(prim, tree->primitives); + break; + case GL2PS_IN_BACK_OF: + gl2psAddPrimitiveInList(prim, backlist); + break; + case GL2PS_IN_FRONT_OF: + gl2psAddPrimitiveInList(prim, frontlist); + break; + case GL2PS_SPANNING: + gl2psAddPrimitiveInList(backprim, backlist); + gl2psAddPrimitiveInList(frontprim, frontlist); + gl2psFreePrimitive(&prim); + break; + } + } + } + + if(gl2psListNbr(tree->primitives)){ + gl2psListSort(tree->primitives, gl2psTrianglesFirst); + } + + if(gl2psListNbr(frontlist)){ + gl2psListSort(frontlist, gl2psTrianglesFirst); + tree->front = (GL2PSbsptree*)gl2psMalloc(sizeof(GL2PSbsptree)); + gl2psBuildBspTree(tree->front, frontlist); + } + else{ + gl2psListDelete(frontlist); + } + + if(gl2psListNbr(backlist)){ + gl2psListSort(backlist, gl2psTrianglesFirst); + tree->back = (GL2PSbsptree*)gl2psMalloc(sizeof(GL2PSbsptree)); + gl2psBuildBspTree(tree->back, backlist); + } + else{ + gl2psListDelete(backlist); + } + + gl2psListDelete(primitives); +} + +static void gl2psTraverseBspTree(GL2PSbsptree *tree, GL2PSxyz eye, GLfloat epsilon, + GLboolean (*compare)(GLfloat f1, GLfloat f2), + void (*action)(void *data), int inverse) +{ + GLfloat result; + + if(!tree) return; + + result = gl2psComparePointPlane(eye, tree->plane); + + if(GL_TRUE == compare(result, epsilon)){ + gl2psTraverseBspTree(tree->back, eye, epsilon, compare, action, inverse); + if(inverse){ + gl2psListActionInverse(tree->primitives, action); + } + else{ + gl2psListAction(tree->primitives, action); + } + gl2psTraverseBspTree(tree->front, eye, epsilon, compare, action, inverse); + } + else if(GL_TRUE == compare(-epsilon, result)){ + gl2psTraverseBspTree(tree->front, eye, epsilon, compare, action, inverse); + if(inverse){ + gl2psListActionInverse(tree->primitives, action); + } + else{ + gl2psListAction(tree->primitives, action); + } + gl2psTraverseBspTree(tree->back, eye, epsilon, compare, action, inverse); + } + else{ + gl2psTraverseBspTree(tree->front, eye, epsilon, compare, action, inverse); + gl2psTraverseBspTree(tree->back, eye, epsilon, compare, action, inverse); + } +} + +static void gl2psRescaleAndOffset(void) +{ + GL2PSprimitive *prim; + GLfloat minZ, maxZ, rangeZ, scaleZ; + GLfloat factor, units, area, dZ, dZdX, dZdY, maxdZ; + int i, j; + + if(!gl2psListNbr(gl2ps->primitives)) + return; + + /* get z-buffer range */ + prim = *(GL2PSprimitive**)gl2psListPointer(gl2ps->primitives, 0); + minZ = maxZ = prim->verts[0].xyz[2]; + for(i = 1; i < prim->numverts; i++){ + if(prim->verts[i].xyz[2] < minZ) minZ = prim->verts[i].xyz[2]; + if(prim->verts[i].xyz[2] > maxZ) maxZ = prim->verts[i].xyz[2]; + } + for(i = 1; i < gl2psListNbr(gl2ps->primitives); i++){ + prim = *(GL2PSprimitive**)gl2psListPointer(gl2ps->primitives, i); + for(j = 0; j < prim->numverts; j++){ + if(prim->verts[j].xyz[2] < minZ) minZ = prim->verts[j].xyz[2]; + if(prim->verts[j].xyz[2] > maxZ) maxZ = prim->verts[j].xyz[2]; + } + } + rangeZ = (maxZ - minZ); + + /* rescale z-buffer coordinate in [0,GL2PS_ZSCALE], to make it of + the same order of magnitude as the x and y coordinates */ + scaleZ = GL2PS_ZERO(rangeZ) ? GL2PS_ZSCALE : (GL2PS_ZSCALE / rangeZ); + /* avoid precision loss (we use floats!) */ + if(scaleZ > 100000.F) scaleZ = 100000.F; + + /* apply offsets */ + for(i = 0; i < gl2psListNbr(gl2ps->primitives); i++){ + prim = *(GL2PSprimitive**)gl2psListPointer(gl2ps->primitives, i); + for(j = 0; j < prim->numverts; j++){ + prim->verts[j].xyz[2] = (prim->verts[j].xyz[2] - minZ) * scaleZ; + } + if((gl2ps->options & GL2PS_SIMPLE_LINE_OFFSET) && + (prim->type == GL2PS_LINE)){ + if(gl2ps->sort == GL2PS_SIMPLE_SORT){ + prim->verts[0].xyz[2] -= GL2PS_ZOFFSET_LARGE; + prim->verts[1].xyz[2] -= GL2PS_ZOFFSET_LARGE; + } + else{ + prim->verts[0].xyz[2] -= GL2PS_ZOFFSET; + prim->verts[1].xyz[2] -= GL2PS_ZOFFSET; + } + } + else if(prim->offset && (prim->type == GL2PS_TRIANGLE)){ + factor = gl2ps->offset[0]; + units = gl2ps->offset[1]; + area = + (prim->verts[1].xyz[0] - prim->verts[0].xyz[0]) * + (prim->verts[2].xyz[1] - prim->verts[1].xyz[1]) - + (prim->verts[2].xyz[0] - prim->verts[1].xyz[0]) * + (prim->verts[1].xyz[1] - prim->verts[0].xyz[1]); + if(!GL2PS_ZERO(area)){ + dZdX = + ((prim->verts[2].xyz[1] - prim->verts[1].xyz[1]) * + (prim->verts[1].xyz[2] - prim->verts[0].xyz[2]) - + (prim->verts[1].xyz[1] - prim->verts[0].xyz[1]) * + (prim->verts[2].xyz[2] - prim->verts[1].xyz[2])) / area; + dZdY = + ((prim->verts[1].xyz[0] - prim->verts[0].xyz[0]) * + (prim->verts[2].xyz[2] - prim->verts[1].xyz[2]) - + (prim->verts[2].xyz[0] - prim->verts[1].xyz[0]) * + (prim->verts[1].xyz[2] - prim->verts[0].xyz[2])) / area; + maxdZ = (GLfloat)sqrt(dZdX * dZdX + dZdY * dZdY); + } + else{ + maxdZ = 0.0F; + } + dZ = factor * maxdZ + units; + prim->verts[0].xyz[2] += dZ; + prim->verts[1].xyz[2] += dZ; + prim->verts[2].xyz[2] += dZ; + } + } +} + +/********************************************************************* + * + * 2D sorting routines (for occlusion culling) + * + *********************************************************************/ + +static GLint gl2psGetPlaneFromPoints(GL2PSxyz a, GL2PSxyz b, GL2PSplane plane) +{ + GLfloat n; + + plane[0] = b[1] - a[1]; + plane[1] = a[0] - b[0]; + n = (GLfloat)sqrt(plane[0]*plane[0] + plane[1]*plane[1]); + plane[2] = 0.0F; + if(!GL2PS_ZERO(n)){ + plane[0] /= n; + plane[1] /= n; + plane[3] = -plane[0]*a[0]-plane[1]*a[1]; + return 1; + } + else{ + plane[0] = -1.0F; + plane[1] = 0.0F; + plane[3] = a[0]; + return 0; + } +} + +static void gl2psFreeBspImageTree(GL2PSbsptree2d **tree) +{ + if(*tree){ + if((*tree)->back) gl2psFreeBspImageTree(&(*tree)->back); + if((*tree)->front) gl2psFreeBspImageTree(&(*tree)->front); + gl2psFree(*tree); + *tree = NULL; + } +} + +static GLint gl2psCheckPoint(GL2PSxyz point, GL2PSplane plane) +{ + GLfloat pt_dis; + + pt_dis = gl2psComparePointPlane(point, plane); + if(pt_dis > GL2PS_EPSILON) return GL2PS_POINT_INFRONT; + else if(pt_dis < -GL2PS_EPSILON) return GL2PS_POINT_BACK; + else return GL2PS_POINT_COINCIDENT; +} + +static void gl2psAddPlanesInBspTreeImage(GL2PSprimitive *prim, + GL2PSbsptree2d **tree) +{ + GLint ret = 0; + GLint i; + GLint offset = 0; + GL2PSbsptree2d *head = NULL, *cur = NULL; + + if((*tree == NULL) && (prim->numverts > 2)){ + /* don't cull if transparent + for(i = 0; i < prim->numverts - 1; i++) + if(prim->verts[i].rgba[3] < 1.0F) return; + */ + head = (GL2PSbsptree2d*)gl2psMalloc(sizeof(GL2PSbsptree2d)); + for(i = 0; i < prim->numverts-1; i++){ + if(!gl2psGetPlaneFromPoints(prim->verts[i].xyz, + prim->verts[i+1].xyz, + head->plane)){ + if(prim->numverts-i > 3){ + offset++; + } + else{ + gl2psFree(head); + return; + } + } + else{ + break; + } + } + head->back = NULL; + head->front = NULL; + for(i = 2+offset; i < prim->numverts; i++){ + ret = gl2psCheckPoint(prim->verts[i].xyz, head->plane); + if(ret != GL2PS_POINT_COINCIDENT) break; + } + switch(ret){ + case GL2PS_POINT_INFRONT : + cur = head; + for(i = 1+offset; i < prim->numverts-1; i++){ + if(cur->front == NULL){ + cur->front = (GL2PSbsptree2d*)gl2psMalloc(sizeof(GL2PSbsptree2d)); + } + if(gl2psGetPlaneFromPoints(prim->verts[i].xyz, + prim->verts[i+1].xyz, + cur->front->plane)){ + cur = cur->front; + cur->front = NULL; + cur->back = NULL; + } + } + if(cur->front == NULL){ + cur->front = (GL2PSbsptree2d*)gl2psMalloc(sizeof(GL2PSbsptree2d)); + } + if(gl2psGetPlaneFromPoints(prim->verts[i].xyz, + prim->verts[offset].xyz, + cur->front->plane)){ + cur->front->front = NULL; + cur->front->back = NULL; + } + else{ + gl2psFree(cur->front); + cur->front = NULL; + } + break; + case GL2PS_POINT_BACK : + for(i = 0; i < 4; i++){ + head->plane[i] = -head->plane[i]; + } + cur = head; + for(i = 1+offset; i < prim->numverts-1; i++){ + if(cur->front == NULL){ + cur->front = (GL2PSbsptree2d*)gl2psMalloc(sizeof(GL2PSbsptree2d)); + } + if(gl2psGetPlaneFromPoints(prim->verts[i+1].xyz, + prim->verts[i].xyz, + cur->front->plane)){ + cur = cur->front; + cur->front = NULL; + cur->back = NULL; + } + } + if(cur->front == NULL){ + cur->front = (GL2PSbsptree2d*)gl2psMalloc(sizeof(GL2PSbsptree2d)); + } + if(gl2psGetPlaneFromPoints(prim->verts[offset].xyz, + prim->verts[i].xyz, + cur->front->plane)){ + cur->front->front = NULL; + cur->front->back = NULL; + } + else{ + gl2psFree(cur->front); + cur->front = NULL; + } + break; + default: + gl2psFree(head); + return; + } + (*tree) = head; + } +} + +static GLint gl2psCheckPrimitive(GL2PSprimitive *prim, GL2PSplane plane) +{ + GLint i; + GLint pos; + + pos = gl2psCheckPoint(prim->verts[0].xyz, plane); + for(i = 1; i < prim->numverts; i++){ + pos |= gl2psCheckPoint(prim->verts[i].xyz, plane); + if(pos == (GL2PS_POINT_INFRONT | GL2PS_POINT_BACK)) return GL2PS_SPANNING; + } + if(pos & GL2PS_POINT_INFRONT) return GL2PS_IN_FRONT_OF; + else if(pos & GL2PS_POINT_BACK) return GL2PS_IN_BACK_OF; + else return GL2PS_COINCIDENT; +} + +static GL2PSprimitive *gl2psCreateSplitPrimitive2D(GL2PSprimitive *parent, + GLshort numverts, + GL2PSvertex *vertx) +{ + GLint i; + GL2PSprimitive *child = (GL2PSprimitive*)gl2psMalloc(sizeof(GL2PSprimitive)); + + if(parent->type == GL2PS_IMAGEMAP){ + child->type = GL2PS_IMAGEMAP; + child->data.image = parent->data.image; + } + else { + switch(numverts){ + case 1 : child->type = GL2PS_POINT; break; + case 2 : child->type = GL2PS_LINE; break; + case 3 : child->type = GL2PS_TRIANGLE; break; + case 4 : child->type = GL2PS_QUADRANGLE; break; + default: child->type = GL2PS_NO_TYPE; break; /* FIXME */ + } + } + child->boundary = 0; /* FIXME: not done! */ + child->culled = parent->culled; + child->offset = parent->offset; + child->pattern = parent->pattern; + child->factor = parent->factor; + child->width = parent->width; + child->numverts = numverts; + child->verts = (GL2PSvertex*)gl2psMalloc(numverts * sizeof(GL2PSvertex)); + for(i = 0; i < numverts; i++){ + child->verts[i] = vertx[i]; + } + return child; +} + +static void gl2psSplitPrimitive2D(GL2PSprimitive *prim, + GL2PSplane plane, + GL2PSprimitive **front, + GL2PSprimitive **back) +{ + /* cur will hold the position of the current vertex + prev will hold the position of the previous vertex + prev0 will hold the position of the vertex number 0 + v1 and v2 represent the current and previous vertices, respectively + flag is set if the current vertex should be checked against the plane */ + GLint cur = -1, prev = -1, i, v1 = 0, v2 = 0, flag = 1, prev0 = -1; + + /* list of vertices that will go in front and back primitive */ + GL2PSvertex *front_list = NULL, *back_list = NULL; + + /* number of vertices in front and back list */ + GLshort front_count = 0, back_count = 0; + + for(i = 0; i <= prim->numverts; i++){ + v1 = i; + if(v1 == prim->numverts){ + if(prim->numverts < 3) break; + v1 = 0; + v2 = prim->numverts - 1; + cur = prev0; + } + else if(flag){ + cur = gl2psCheckPoint(prim->verts[v1].xyz, plane); + if(i == 0){ + prev0 = cur; + } + } + if(((prev == -1) || (prev == cur) || (prev == 0) || (cur == 0)) && + (i < prim->numverts)){ + if(cur == GL2PS_POINT_INFRONT){ + front_count++; + front_list = (GL2PSvertex*)gl2psRealloc(front_list, + sizeof(GL2PSvertex)*front_count); + front_list[front_count-1] = prim->verts[v1]; + } + else if(cur == GL2PS_POINT_BACK){ + back_count++; + back_list = (GL2PSvertex*)gl2psRealloc(back_list, + sizeof(GL2PSvertex)*back_count); + back_list[back_count-1] = prim->verts[v1]; + } + else{ + front_count++; + front_list = (GL2PSvertex*)gl2psRealloc(front_list, + sizeof(GL2PSvertex)*front_count); + front_list[front_count-1] = prim->verts[v1]; + back_count++; + back_list = (GL2PSvertex*)gl2psRealloc(back_list, + sizeof(GL2PSvertex)*back_count); + back_list[back_count-1] = prim->verts[v1]; + } + flag = 1; + } + else if((prev != cur) && (cur != 0) && (prev != 0)){ + if(v1 != 0){ + v2 = v1-1; + i--; + } + front_count++; + front_list = (GL2PSvertex*)gl2psRealloc(front_list, + sizeof(GL2PSvertex)*front_count); + gl2psCutEdge(&prim->verts[v2], &prim->verts[v1], + plane, &front_list[front_count-1]); + back_count++; + back_list = (GL2PSvertex*)gl2psRealloc(back_list, + sizeof(GL2PSvertex)*back_count); + back_list[back_count-1] = front_list[front_count-1]; + flag = 0; + } + prev = cur; + } + *front = gl2psCreateSplitPrimitive2D(prim, front_count, front_list); + *back = gl2psCreateSplitPrimitive2D(prim, back_count, back_list); + gl2psFree(front_list); + gl2psFree(back_list); +} + +static GLint gl2psAddInBspImageTree(GL2PSprimitive *prim, GL2PSbsptree2d **tree) +{ + GLint ret = 0; + GL2PSprimitive *frontprim = NULL, *backprim = NULL; + + /* FIXME: until we consider the actual extent of text strings and + pixmaps, never cull them. Otherwise the whole string/pixmap gets + culled as soon as the reference point is hidden */ + if(prim->type == GL2PS_PIXMAP || + prim->type == GL2PS_TEXT || + prim->type == GL2PS_SPECIAL){ + return 1; + } + + if(*tree == NULL){ + if((prim->type != GL2PS_IMAGEMAP) && (GL_FALSE == gl2ps->zerosurfacearea)){ + gl2psAddPlanesInBspTreeImage(gl2ps->primitivetoadd, tree); + } + return 1; + } + else{ + switch(gl2psCheckPrimitive(prim, (*tree)->plane)){ + case GL2PS_IN_BACK_OF: return gl2psAddInBspImageTree(prim, &(*tree)->back); + case GL2PS_IN_FRONT_OF: + if((*tree)->front != NULL) return gl2psAddInBspImageTree(prim, &(*tree)->front); + else return 0; + case GL2PS_SPANNING: + gl2psSplitPrimitive2D(prim, (*tree)->plane, &frontprim, &backprim); + ret = gl2psAddInBspImageTree(backprim, &(*tree)->back); + if((*tree)->front != NULL){ + if(gl2psAddInBspImageTree(frontprim, &(*tree)->front)){ + ret = 1; + } + } + gl2psFree(frontprim->verts); + gl2psFree(frontprim); + gl2psFree(backprim->verts); + gl2psFree(backprim); + return ret; + case GL2PS_COINCIDENT: + if((*tree)->back != NULL){ + gl2ps->zerosurfacearea = GL_TRUE; + ret = gl2psAddInBspImageTree(prim, &(*tree)->back); + gl2ps->zerosurfacearea = GL_FALSE; + if(ret) return ret; + } + if((*tree)->front != NULL){ + gl2ps->zerosurfacearea = GL_TRUE; + ret = gl2psAddInBspImageTree(prim, &(*tree)->front); + gl2ps->zerosurfacearea = GL_FALSE; + if(ret) return ret; + } + if(prim->type == GL2PS_LINE) return 1; + else return 0; + } + } + return 0; +} + +static void gl2psAddInImageTree(void *data) +{ + GL2PSprimitive *prim = *(GL2PSprimitive **)data; + gl2ps->primitivetoadd = prim; + if(prim->type == GL2PS_IMAGEMAP && prim->data.image->format == GL2PS_IMAGEMAP_VISIBLE){ + prim->culled = 1; + } + else if(!gl2psAddInBspImageTree(prim, &gl2ps->imagetree)){ + prim->culled = 1; + } + else if(prim->type == GL2PS_IMAGEMAP){ + prim->data.image->format = GL2PS_IMAGEMAP_VISIBLE; + } +} + +/* Boundary construction */ + +static void gl2psAddBoundaryInList(GL2PSprimitive *prim, GL2PSlist *list) +{ + GL2PSprimitive *b; + GLshort i; + GL2PSxyz c; + + c[0] = c[1] = c[2] = 0.0F; + for(i = 0; i < prim->numverts; i++){ + c[0] += prim->verts[i].xyz[0]; + c[1] += prim->verts[i].xyz[1]; + } + c[0] /= prim->numverts; + c[1] /= prim->numverts; + + for(i = 0; i < prim->numverts; i++){ + if(prim->boundary & (GLint)pow(2., i)){ + b = (GL2PSprimitive*)gl2psMalloc(sizeof(GL2PSprimitive)); + b->type = GL2PS_LINE; + b->offset = prim->offset; + b->pattern = prim->pattern; + b->factor = prim->factor; + b->culled = prim->culled; + b->width = prim->width; + b->boundary = 0; + b->numverts = 2; + b->verts = (GL2PSvertex*)gl2psMalloc(2 * sizeof(GL2PSvertex)); + +#if 0 /* FIXME: need to work on boundary offset... */ + v[0] = c[0] - prim->verts[i].xyz[0]; + v[1] = c[1] - prim->verts[i].xyz[1]; + v[2] = 0.0F; + norm = gl2psNorm(v); + v[0] /= norm; + v[1] /= norm; + b->verts[0].xyz[0] = prim->verts[i].xyz[0] +0.1*v[0]; + b->verts[0].xyz[1] = prim->verts[i].xyz[1] +0.1*v[1]; + b->verts[0].xyz[2] = prim->verts[i].xyz[2]; + v[0] = c[0] - prim->verts[gl2psGetIndex(i, prim->numverts)].xyz[0]; + v[1] = c[1] - prim->verts[gl2psGetIndex(i, prim->numverts)].xyz[1]; + norm = gl2psNorm(v); + v[0] /= norm; + v[1] /= norm; + b->verts[1].xyz[0] = prim->verts[gl2psGetIndex(i, prim->numverts)].xyz[0] +0.1*v[0]; + b->verts[1].xyz[1] = prim->verts[gl2psGetIndex(i, prim->numverts)].xyz[1] +0.1*v[1]; + b->verts[1].xyz[2] = prim->verts[gl2psGetIndex(i, prim->numverts)].xyz[2]; +#else + b->verts[0].xyz[0] = prim->verts[i].xyz[0]; + b->verts[0].xyz[1] = prim->verts[i].xyz[1]; + b->verts[0].xyz[2] = prim->verts[i].xyz[2]; + b->verts[1].xyz[0] = prim->verts[gl2psGetIndex(i, prim->numverts)].xyz[0]; + b->verts[1].xyz[1] = prim->verts[gl2psGetIndex(i, prim->numverts)].xyz[1]; + b->verts[1].xyz[2] = prim->verts[gl2psGetIndex(i, prim->numverts)].xyz[2]; +#endif + + b->verts[0].rgba[0] = 0.0F; + b->verts[0].rgba[1] = 0.0F; + b->verts[0].rgba[2] = 0.0F; + b->verts[0].rgba[3] = 0.0F; + b->verts[1].rgba[0] = 0.0F; + b->verts[1].rgba[1] = 0.0F; + b->verts[1].rgba[2] = 0.0F; + b->verts[1].rgba[3] = 0.0F; + gl2psListAdd(list, &b); + } + } + +} + +static void gl2psBuildPolygonBoundary(GL2PSbsptree *tree) +{ + GLint i; + GL2PSprimitive *prim; + + if(!tree) return; + gl2psBuildPolygonBoundary(tree->back); + for(i = 0; i < gl2psListNbr(tree->primitives); i++){ + prim = *(GL2PSprimitive**)gl2psListPointer(tree->primitives, i); + if(prim->boundary) gl2psAddBoundaryInList(prim, tree->primitives); + } + gl2psBuildPolygonBoundary(tree->front); +} + +/********************************************************************* + * + * Feedback buffer parser + * + *********************************************************************/ + +static void gl2psAddPolyPrimitive(GLshort type, GLshort numverts, + GL2PSvertex *verts, GLint offset, + GLushort pattern, GLint factor, + GLfloat width, char boundary) +{ + GL2PSprimitive *prim; + + prim = (GL2PSprimitive*)gl2psMalloc(sizeof(GL2PSprimitive)); + prim->type = type; + prim->numverts = numverts; + prim->verts = (GL2PSvertex*)gl2psMalloc(numverts * sizeof(GL2PSvertex)); + memcpy(prim->verts, verts, numverts * sizeof(GL2PSvertex)); + prim->boundary = boundary; + prim->offset = offset; + prim->pattern = pattern; + prim->factor = factor; + prim->width = width; + prim->culled = 0; + + /* FIXME: here we should have an option to split stretched + tris/quads to enhance SIMPLE_SORT */ + + gl2psListAdd(gl2ps->primitives, &prim); +} + +static GLint gl2psGetVertex(GL2PSvertex *v, GLfloat *p) +{ + GLint i; + + v->xyz[0] = p[0]; + v->xyz[1] = p[1]; + v->xyz[2] = p[2]; + + if(gl2ps->colormode == GL_COLOR_INDEX && gl2ps->colorsize > 0){ + i = (GLint)(p[3] + 0.5); + v->rgba[0] = gl2ps->colormap[i][0]; + v->rgba[1] = gl2ps->colormap[i][1]; + v->rgba[2] = gl2ps->colormap[i][2]; + v->rgba[3] = gl2ps->colormap[i][3]; + return 4; + } + else{ + v->rgba[0] = p[3]; + v->rgba[1] = p[4]; + v->rgba[2] = p[5]; + v->rgba[3] = p[6]; + return 7; + } +} + +static void gl2psParseFeedbackBuffer(GLint used) +{ + char flag; + GLushort pattern = 0; + GLboolean boundary; + GLint i, sizeoffloat, count, v, vtot, offset = 0, factor = 0, auxindex = 0; + GLfloat lwidth = 1.0F, psize = 1.0F; + GLfloat *current; + GL2PSvertex vertices[3]; + GL2PSprimitive *prim; + GL2PSimagemap *node; + + current = gl2ps->feedback; + boundary = gl2ps->boundary = GL_FALSE; + + while(used > 0){ + + if(GL_TRUE == boundary) gl2ps->boundary = GL_TRUE; + + switch((GLint)*current){ + case GL_POINT_TOKEN : + current ++; + used --; + i = gl2psGetVertex(&vertices[0], current); + current += i; + used -= i; + gl2psAddPolyPrimitive(GL2PS_POINT, 1, vertices, 0, + pattern, factor, psize, 0); + break; + case GL_LINE_TOKEN : + case GL_LINE_RESET_TOKEN : + current ++; + used --; + i = gl2psGetVertex(&vertices[0], current); + current += i; + used -= i; + i = gl2psGetVertex(&vertices[1], current); + current += i; + used -= i; + gl2psAddPolyPrimitive(GL2PS_LINE, 2, vertices, 0, + pattern, factor, lwidth, 0); + break; + case GL_POLYGON_TOKEN : + count = (GLint)current[1]; + current += 2; + used -= 2; + v = vtot = 0; + while(count > 0 && used > 0){ + i = gl2psGetVertex(&vertices[v], current); + gl2psAdaptVertexForBlending(&vertices[v]); + current += i; + used -= i; + count --; + vtot++; + if(v == 2){ + if(GL_TRUE == boundary){ + if(!count && vtot == 2) flag = 1|2|4; + else if(!count) flag = 2|4; + else if(vtot == 2) flag = 1|2; + else flag = 2; + } + else + flag = 0; + gl2psAddPolyPrimitive(GL2PS_TRIANGLE, 3, vertices, offset, + pattern, factor, 1, flag); + vertices[1] = vertices[2]; + } + else + v ++; + } + break; + case GL_BITMAP_TOKEN : + case GL_DRAW_PIXEL_TOKEN : + case GL_COPY_PIXEL_TOKEN : + current ++; + used --; + i = gl2psGetVertex(&vertices[0], current); + current += i; + used -= i; + break; + case GL_PASS_THROUGH_TOKEN : + switch((GLint)current[1]){ + case GL2PS_BEGIN_OFFSET_TOKEN : offset = 1; break; + case GL2PS_END_OFFSET_TOKEN : offset = 0; break; + case GL2PS_BEGIN_BOUNDARY_TOKEN : boundary = GL_TRUE; break; + case GL2PS_END_BOUNDARY_TOKEN : boundary = GL_FALSE; break; + case GL2PS_END_STIPPLE_TOKEN : pattern = factor = 0; break; + case GL2PS_BEGIN_BLEND_TOKEN : gl2ps->blending = GL_TRUE; break; + case GL2PS_END_BLEND_TOKEN : gl2ps->blending = GL_FALSE; break; + case GL2PS_BEGIN_STIPPLE_TOKEN : + current += 2; + used -= 2; + pattern = (GLushort)current[1]; + current += 2; + used -= 2; + factor = (GLint)current[1]; + break; + case GL2PS_SRC_BLEND_TOKEN : + current += 2; + used -= 2; + gl2ps->blendfunc[0] = (GLint)current[1]; + break; + case GL2PS_DST_BLEND_TOKEN : + current += 2; + used -= 2; + gl2ps->blendfunc[1] = (GLint)current[1]; + break; + case GL2PS_POINT_SIZE_TOKEN : + current += 2; + used -= 2; + psize = current[1]; + break; + case GL2PS_LINE_WIDTH_TOKEN : + current += 2; + used -= 2; + lwidth = current[1]; + break; + case GL2PS_IMAGEMAP_TOKEN : + prim = (GL2PSprimitive *)gl2psMalloc(sizeof(GL2PSprimitive)); + prim->type = GL2PS_IMAGEMAP; + prim->boundary = 0; + prim->numverts = 4; + prim->verts = (GL2PSvertex *)gl2psMalloc(4 * sizeof(GL2PSvertex)); + prim->culled = 0; + prim->offset = 0; + prim->pattern = 0; + prim->factor = 0; + prim->width = 1; + + node = (GL2PSimagemap*)gl2psMalloc(sizeof(GL2PSimagemap)); + node->image = (GL2PSimage*)gl2psMalloc(sizeof(GL2PSimage)); + node->image->type = 0; + node->image->format = 0; + node->image->zoom_x = 1.0F; + node->image->zoom_y = 1.0F; + node->next = NULL; + + if(gl2ps->imagemap_head == NULL) + gl2ps->imagemap_head = node; + else + gl2ps->imagemap_tail->next = node; + gl2ps->imagemap_tail = node; + prim->data.image = node->image; + + current += 2; used -= 2; + i = gl2psGetVertex(&prim->verts[0], ¤t[1]); + current += i; used -= i; + + node->image->width = (GLint)current[2]; + current += 2; used -= 2; + node->image->height = (GLint)current[2]; + prim->verts[0].xyz[0] = prim->verts[0].xyz[0] - (int)(node->image->width / 2) + 0.5F; + prim->verts[0].xyz[1] = prim->verts[0].xyz[1] - (int)(node->image->height / 2) + 0.5F; + for(i = 1; i < 4; i++){ + for(v = 0; v < 3; v++){ + prim->verts[i].xyz[v] = prim->verts[0].xyz[v]; + prim->verts[i].rgba[v] = prim->verts[0].rgba[v]; + } + prim->verts[i].rgba[v] = prim->verts[0].rgba[v]; + } + prim->verts[1].xyz[0] = prim->verts[1].xyz[0] + node->image->width; + prim->verts[2].xyz[0] = prim->verts[1].xyz[0]; + prim->verts[2].xyz[1] = prim->verts[2].xyz[1] + node->image->height; + prim->verts[3].xyz[1] = prim->verts[2].xyz[1]; + + sizeoffloat = sizeof(GLfloat); + v = 2 * sizeoffloat; + vtot = node->image->height + node->image->height * + ((node->image->width - 1) / 8); + node->image->pixels = (GLfloat*)gl2psMalloc(v + vtot); + node->image->pixels[0] = prim->verts[0].xyz[0]; + node->image->pixels[1] = prim->verts[0].xyz[1]; + + for(i = 0; i < vtot; i += sizeoffloat){ + current += 2; used -= 2; + if((vtot - i) >= 4) + memcpy(&(((char*)(node->image->pixels))[i + v]), &(current[2]), sizeoffloat); + else + memcpy(&(((char*)(node->image->pixels))[i + v]), &(current[2]), vtot - i); + } + current++; used--; + gl2psListAdd(gl2ps->primitives, &prim); + break; + case GL2PS_DRAW_PIXELS_TOKEN : + case GL2PS_TEXT_TOKEN : + if(auxindex < gl2psListNbr(gl2ps->auxprimitives)) + gl2psListAdd(gl2ps->primitives, + gl2psListPointer(gl2ps->auxprimitives, auxindex++)); + else + gl2psMsg(GL2PS_ERROR, "Wrong number of auxiliary tokens in buffer"); + break; + } + current += 2; + used -= 2; + break; + default : + gl2psMsg(GL2PS_WARNING, "Unknown token in buffer"); + current ++; + used --; + break; + } + } + + gl2psListReset(gl2ps->auxprimitives); +} + +/********************************************************************* + * + * PostScript routines + * + *********************************************************************/ + +static void gl2psWriteByte(unsigned char byte) +{ + unsigned char h = byte / 16; + unsigned char l = byte % 16; + gl2psPrintf("%x%x", h, l); +} + +static void gl2psPrintPostScriptPixmap(GLfloat x, GLfloat y, GL2PSimage *im) +{ + GLuint nbhex, nbyte, nrgb, nbits; + GLuint row, col, ibyte, icase; + GLfloat dr, dg, db, fgrey; + unsigned char red = 0, green = 0, blue = 0, b, grey; + GLuint width = (GLuint)im->width; + GLuint height = (GLuint)im->height; + + /* FIXME: should we define an option for these? Or just keep the + 8-bit per component case? */ + int greyscale = 0; /* set to 1 to output greyscale image */ + int nbit = 8; /* number of bits per color compoment (2, 4 or 8) */ + + if((width <= 0) || (height <= 0)) return; + + gl2psPrintf("gsave\n"); + gl2psPrintf("%.2f %.2f translate\n", x, y); + gl2psPrintf("%.2f %.2f scale\n", width * im->zoom_x, height * im->zoom_y); + + if(greyscale){ /* greyscale */ + gl2psPrintf("/picstr %d string def\n", width); + gl2psPrintf("%d %d %d\n", width, height, 8); + gl2psPrintf("[ %d 0 0 -%d 0 %d ]\n", width, height, height); + gl2psPrintf("{ currentfile picstr readhexstring pop }\n"); + gl2psPrintf("image\n"); + for(row = 0; row < height; row++){ + for(col = 0; col < width; col++){ + gl2psGetRGB(im, col, row, &dr, &dg, &db); + fgrey = (0.30F * dr + 0.59F * dg + 0.11F * db); + grey = (unsigned char)(255. * fgrey); + gl2psWriteByte(grey); + } + gl2psPrintf("\n"); + } + nbhex = width * height * 2; + gl2psPrintf("%%%% nbhex digit :%d\n", nbhex); + } + else if(nbit == 2){ /* color, 2 bits for r and g and b; rgbs following each other */ + nrgb = width * 3; + nbits = nrgb * nbit; + nbyte = nbits / 8; + if((nbyte * 8) != nbits) nbyte++; + gl2psPrintf("/rgbstr %d string def\n", nbyte); + gl2psPrintf("%d %d %d\n", width, height, nbit); + gl2psPrintf("[ %d 0 0 -%d 0 %d ]\n", width, height, height); + gl2psPrintf("{ currentfile rgbstr readhexstring pop }\n"); + gl2psPrintf("false 3\n"); + gl2psPrintf("colorimage\n"); + for(row = 0; row < height; row++){ + icase = 1; + col = 0; + b = 0; + for(ibyte = 0; ibyte < nbyte; ibyte++){ + if(icase == 1) { + if(col < width) { + gl2psGetRGB(im, col, row, &dr, &dg, &db); + } + else { + dr = dg = db = 0; + } + col++; + red = (unsigned char)(3. * dr); + green = (unsigned char)(3. * dg); + blue = (unsigned char)(3. * db); + b = red; + b = (b<<2) + green; + b = (b<<2) + blue; + if(col < width) { + gl2psGetRGB(im, col, row, &dr, &dg, &db); + } + else { + dr = dg = db = 0; + } + col++; + red = (unsigned char)(3. * dr); + green = (unsigned char)(3. * dg); + blue = (unsigned char)(3. * db); + b = (b<<2) + red; + gl2psWriteByte(b); + b = 0; + icase++; + } + else if(icase == 2) { + b = green; + b = (b<<2) + blue; + if(col < width) { + gl2psGetRGB(im, col, row, &dr, &dg, &db); + } + else { + dr = dg = db = 0; + } + col++; + red = (unsigned char)(3. * dr); + green = (unsigned char)(3. * dg); + blue = (unsigned char)(3. * db); + b = (b<<2) + red; + b = (b<<2) + green; + gl2psWriteByte(b); + b = 0; + icase++; + } + else if(icase == 3) { + b = blue; + if(col < width) { + gl2psGetRGB(im, col, row, &dr, &dg, &db); + } + else { + dr = dg = db = 0; + } + col++; + red = (unsigned char)(3. * dr); + green = (unsigned char)(3. * dg); + blue = (unsigned char)(3. * db); + b = (b<<2) + red; + b = (b<<2) + green; + b = (b<<2) + blue; + gl2psWriteByte(b); + b = 0; + icase = 1; + } + } + gl2psPrintf("\n"); + } + } + else if(nbit == 4){ /* color, 4 bits for r and g and b; rgbs following each other */ + nrgb = width * 3; + nbits = nrgb * nbit; + nbyte = nbits / 8; + if((nbyte * 8) != nbits) nbyte++; + gl2psPrintf("/rgbstr %d string def\n", nbyte); + gl2psPrintf("%d %d %d\n", width, height, nbit); + gl2psPrintf("[ %d 0 0 -%d 0 %d ]\n", width, height, height); + gl2psPrintf("{ currentfile rgbstr readhexstring pop }\n"); + gl2psPrintf("false 3\n"); + gl2psPrintf("colorimage\n"); + for(row = 0; row < height; row++){ + col = 0; + icase = 1; + for(ibyte = 0; ibyte < nbyte; ibyte++){ + if(icase == 1) { + if(col < width) { + gl2psGetRGB(im, col, row, &dr, &dg, &db); + } + else { + dr = dg = db = 0; + } + col++; + red = (unsigned char)(15. * dr); + green = (unsigned char)(15. * dg); + gl2psPrintf("%x%x", red, green); + icase++; + } + else if(icase == 2) { + blue = (unsigned char)(15. * db); + if(col < width) { + gl2psGetRGB(im, col, row, &dr, &dg, &db); + } + else { + dr = dg = db = 0; + } + col++; + red = (unsigned char)(15. * dr); + gl2psPrintf("%x%x", blue, red); + icase++; + } + else if(icase == 3) { + green = (unsigned char)(15. * dg); + blue = (unsigned char)(15. * db); + gl2psPrintf("%x%x", green, blue); + icase = 1; + } + } + gl2psPrintf("\n"); + } + } + else{ /* 8 bit for r and g and b */ + nbyte = width * 3; + gl2psPrintf("/rgbstr %d string def\n", nbyte); + gl2psPrintf("%d %d %d\n", width, height, 8); + gl2psPrintf("[ %d 0 0 -%d 0 %d ]\n", width, height, height); + gl2psPrintf("{ currentfile rgbstr readhexstring pop }\n"); + gl2psPrintf("false 3\n"); + gl2psPrintf("colorimage\n"); + for(row = 0; row < height; row++){ + for(col = 0; col < width; col++){ + gl2psGetRGB(im, col, row, &dr, &dg, &db); + red = (unsigned char)(255. * dr); + gl2psWriteByte(red); + green = (unsigned char)(255. * dg); + gl2psWriteByte(green); + blue = (unsigned char)(255. * db); + gl2psWriteByte(blue); + } + gl2psPrintf("\n"); + } + } + + gl2psPrintf("grestore\n"); +} + +static void gl2psPrintPostScriptImagemap(GLfloat x, GLfloat y, + GLsizei width, GLsizei height, + const unsigned char *imagemap){ + int i, size; + + if((width <= 0) || (height <= 0)) return; + + size = height + height * (width - 1) / 8; + + gl2psPrintf("gsave\n"); + gl2psPrintf("%.2f %.2f translate\n", x, y); + gl2psPrintf("%d %d scale\n%d %d\ntrue\n", width, height,width, height); + gl2psPrintf("[ %d 0 0 -%d 0 %d ] {<", width, height); + for(i = 0; i < size; i++){ + gl2psWriteByte(*imagemap); + imagemap++; + } + gl2psPrintf(">} imagemask\ngrestore\n"); +} + +static void gl2psPrintPostScriptHeader(void) +{ + time_t now; + + /* Since compression is not part of the PostScript standard, + compressed PostScript files are just gzipped PostScript files + ("ps.gz" or "eps.gz") */ + gl2psPrintGzipHeader(); + + time(&now); + + if(gl2ps->format == GL2PS_PS){ + gl2psPrintf("%%!PS-Adobe-3.0\n"); + } + else{ + gl2psPrintf("%%!PS-Adobe-3.0 EPSF-3.0\n"); + } + + gl2psPrintf("%%%%Title: %s\n" + "%%%%Creator: GL2PS %d.%d.%d%s, %s\n" + "%%%%For: %s\n" + "%%%%CreationDate: %s" + "%%%%LanguageLevel: 3\n" + "%%%%DocumentData: Clean7Bit\n" + "%%%%Pages: 1\n", + gl2ps->title, GL2PS_MAJOR_VERSION, GL2PS_MINOR_VERSION, + GL2PS_PATCH_VERSION, GL2PS_EXTRA_VERSION, GL2PS_COPYRIGHT, + gl2ps->producer, ctime(&now)); + + if(gl2ps->format == GL2PS_PS){ + gl2psPrintf("%%%%Orientation: %s\n" + "%%%%DocumentMedia: Default %d %d 0 () ()\n", + (gl2ps->options & GL2PS_LANDSCAPE) ? "Landscape" : "Portrait", + (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[3] : + (int)gl2ps->viewport[2], + (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[2] : + (int)gl2ps->viewport[3]); + } + + gl2psPrintf("%%%%BoundingBox: %d %d %d %d\n" + "%%%%EndComments\n", + (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[1] : + (int)gl2ps->viewport[0], + (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[0] : + (int)gl2ps->viewport[1], + (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[3] : + (int)gl2ps->viewport[2], + (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[2] : + (int)gl2ps->viewport[3]); + + /* RGB color: r g b C (replace C by G in output to change from rgb to gray) + Grayscale: r g b G + Font choose: size fontname FC + Text string: (string) x y size fontname S?? + Rotated text string: (string) angle x y size fontname S??R + Point primitive: x y size P + Line width: width W + Line start: x y LS + Line joining last point: x y L + Line end: x y LE + Flat-shaded triangle: x3 y3 x2 y2 x1 y1 T + Smooth-shaded triangle: x3 y3 r3 g3 b3 x2 y2 r2 g2 b2 x1 y1 r1 g1 b1 ST */ + + gl2psPrintf("%%%%BeginProlog\n" + "/gl2psdict 64 dict def gl2psdict begin\n" + "0 setlinecap 0 setlinejoin\n" + "/tryPS3shading %s def %% set to false to force subdivision\n" + "/rThreshold %g def %% red component subdivision threshold\n" + "/gThreshold %g def %% green component subdivision threshold\n" + "/bThreshold %g def %% blue component subdivision threshold\n", + (gl2ps->options & GL2PS_NO_PS3_SHADING) ? "false" : "true", + gl2ps->threshold[0], gl2ps->threshold[1], gl2ps->threshold[2]); + + gl2psPrintf("/BD { bind def } bind def\n" + "/C { setrgbcolor } BD\n" + "/G { 0.082 mul exch 0.6094 mul add exch 0.3086 mul add neg 1.0 add setgray } BD\n" + "/W { setlinewidth } BD\n"); + + gl2psPrintf("/FC { findfont exch /SH exch def SH scalefont setfont } BD\n" + "/SW { dup stringwidth pop } BD\n" + "/S { FC moveto show } BD\n" + "/SBC{ FC moveto SW -2 div 0 rmoveto show } BD\n" + "/SBR{ FC moveto SW neg 0 rmoveto show } BD\n" + "/SCL{ FC moveto 0 SH -2 div rmoveto show } BD\n" + "/SCC{ FC moveto SW -2 div SH -2 div rmoveto show } BD\n" + "/SCR{ FC moveto SW neg SH -2 div rmoveto show } BD\n" + "/STL{ FC moveto 0 SH neg rmoveto show } BD\n" + "/STC{ FC moveto SW -2 div SH neg rmoveto show } BD\n" + "/STR{ FC moveto SW neg SH neg rmoveto show } BD\n"); + + /* rotated text routines: same nameanem with R appended */ + + gl2psPrintf("/FCT { FC translate 0 0 } BD\n" + "/SR { gsave FCT moveto rotate show grestore } BD\n" + "/SBCR{ gsave FCT moveto rotate SW -2 div 0 rmoveto show grestore } BD\n" + "/SBRR{ gsave FCT moveto rotate SW neg 0 rmoveto show grestore } BD\n" + "/SCLR{ gsave FCT moveto rotate 0 SH -2 div rmoveto show grestore} BD\n"); + gl2psPrintf("/SCCR{ gsave FCT moveto rotate SW -2 div SH -2 div rmoveto show grestore} BD\n" + "/SCRR{ gsave FCT moveto rotate SW neg SH -2 div rmoveto show grestore} BD\n" + "/STLR{ gsave FCT moveto rotate 0 SH neg rmoveto show grestore } BD\n" + "/STCR{ gsave FCT moveto rotate SW -2 div SH neg rmoveto show grestore } BD\n" + "/STRR{ gsave FCT moveto rotate SW neg SH neg rmoveto show grestore } BD\n"); + + gl2psPrintf("/P { newpath 0.0 360.0 arc closepath fill } BD\n" + "/LS { newpath moveto } BD\n" + "/L { lineto } BD\n" + "/LE { lineto stroke } BD\n" + "/T { newpath moveto lineto lineto closepath fill } BD\n"); + + /* Smooth-shaded triangle with PostScript level 3 shfill operator: + x3 y3 r3 g3 b3 x2 y2 r2 g2 b2 x1 y1 r1 g1 b1 STshfill */ + + gl2psPrintf("/STshfill {\n" + " /b1 exch def /g1 exch def /r1 exch def /y1 exch def /x1 exch def\n" + " /b2 exch def /g2 exch def /r2 exch def /y2 exch def /x2 exch def\n" + " /b3 exch def /g3 exch def /r3 exch def /y3 exch def /x3 exch def\n" + " gsave << /ShadingType 4 /ColorSpace [/DeviceRGB]\n" + " /DataSource [ 0 x1 y1 r1 g1 b1 0 x2 y2 r2 g2 b2 0 x3 y3 r3 g3 b3 ] >>\n" + " shfill grestore } BD\n"); + + /* Flat-shaded triangle with middle color: + x3 y3 r3 g3 b3 x2 y2 r2 g2 b2 x1 y1 r1 g1 b1 Tm */ + + gl2psPrintf(/* stack : x3 y3 r3 g3 b3 x2 y2 r2 g2 b2 x1 y1 r1 g1 b1 */ + "/Tm { 3 -1 roll 8 -1 roll 13 -1 roll add add 3 div\n" /* r = (r1+r2+r3)/3 */ + /* stack : x3 y3 g3 b3 x2 y2 g2 b2 x1 y1 g1 b1 r */ + " 3 -1 roll 7 -1 roll 11 -1 roll add add 3 div\n" /* g = (g1+g2+g3)/3 */ + /* stack : x3 y3 b3 x2 y2 b2 x1 y1 b1 r g b */ + " 3 -1 roll 6 -1 roll 9 -1 roll add add 3 div" /* b = (b1+b2+b3)/3 */ + /* stack : x3 y3 x2 y2 x1 y1 r g b */ + " C T } BD\n"); + + /* Split triangle in four sub-triangles (at sides middle points) and call the + STnoshfill procedure on each, interpolating the colors in RGB space: + x3 y3 r3 g3 b3 x2 y2 r2 g2 b2 x1 y1 r1 g1 b1 STsplit + (in procedure comments key: (Vi) = xi yi ri gi bi) */ + + gl2psPrintf("/STsplit {\n" + " 4 index 15 index add 0.5 mul\n" /* x13 = (x1+x3)/2 */ + " 4 index 15 index add 0.5 mul\n" /* y13 = (y1+y3)/2 */ + " 4 index 15 index add 0.5 mul\n" /* r13 = (r1+r3)/2 */ + " 4 index 15 index add 0.5 mul\n" /* g13 = (g1+g3)/2 */ + " 4 index 15 index add 0.5 mul\n" /* b13 = (b1+b3)/2 */ + " 5 copy 5 copy 25 15 roll\n"); + + /* at his point, stack = (V3) (V13) (V13) (V13) (V2) (V1) */ + + gl2psPrintf(" 9 index 30 index add 0.5 mul\n" /* x23 = (x2+x3)/2 */ + " 9 index 30 index add 0.5 mul\n" /* y23 = (y2+y3)/2 */ + " 9 index 30 index add 0.5 mul\n" /* r23 = (r2+r3)/2 */ + " 9 index 30 index add 0.5 mul\n" /* g23 = (g2+g3)/2 */ + " 9 index 30 index add 0.5 mul\n" /* b23 = (b2+b3)/2 */ + " 5 copy 5 copy 35 5 roll 25 5 roll 15 5 roll\n"); + + /* stack = (V3) (V13) (V23) (V13) (V23) (V13) (V23) (V2) (V1) */ + + gl2psPrintf(" 4 index 10 index add 0.5 mul\n" /* x12 = (x1+x2)/2 */ + " 4 index 10 index add 0.5 mul\n" /* y12 = (y1+y2)/2 */ + " 4 index 10 index add 0.5 mul\n" /* r12 = (r1+r2)/2 */ + " 4 index 10 index add 0.5 mul\n" /* g12 = (g1+g2)/2 */ + " 4 index 10 index add 0.5 mul\n" /* b12 = (b1+b2)/2 */ + " 5 copy 5 copy 40 5 roll 25 5 roll 15 5 roll 25 5 roll\n"); + + /* stack = (V3) (V13) (V23) (V13) (V12) (V23) (V13) (V1) (V12) (V23) (V12) (V2) */ + + gl2psPrintf(" STnoshfill STnoshfill STnoshfill STnoshfill } BD\n"); + + /* Gouraud shaded triangle using recursive subdivision until the difference + between corner colors does not exceed the thresholds: + x3 y3 r3 g3 b3 x2 y2 r2 g2 b2 x1 y1 r1 g1 b1 STnoshfill */ + + gl2psPrintf("/STnoshfill {\n" + " 2 index 8 index sub abs rThreshold gt\n" /* |r1-r2|>rth */ + " { STsplit }\n" + " { 1 index 7 index sub abs gThreshold gt\n" /* |g1-g2|>gth */ + " { STsplit }\n" + " { dup 6 index sub abs bThreshold gt\n" /* |b1-b2|>bth */ + " { STsplit }\n" + " { 2 index 13 index sub abs rThreshold gt\n" /* |r1-r3|>rht */ + " { STsplit }\n" + " { 1 index 12 index sub abs gThreshold gt\n" /* |g1-g3|>gth */ + " { STsplit }\n" + " { dup 11 index sub abs bThreshold gt\n" /* |b1-b3|>bth */ + " { STsplit }\n" + " { 7 index 13 index sub abs rThreshold gt\n"); /* |r2-r3|>rht */ + gl2psPrintf(" { STsplit }\n" + " { 6 index 12 index sub abs gThreshold gt\n" /* |g2-g3|>gth */ + " { STsplit }\n" + " { 5 index 11 index sub abs bThreshold gt\n" /* |b2-b3|>bth */ + " { STsplit }\n" + " { Tm }\n" /* all colors sufficiently similar */ + " ifelse }\n" + " ifelse }\n" + " ifelse }\n" + " ifelse }\n" + " ifelse }\n" + " ifelse }\n" + " ifelse }\n" + " ifelse }\n" + " ifelse } BD\n"); + + gl2psPrintf("tryPS3shading\n" + "{ /shfill where\n" + " { /ST { STshfill } BD }\n" + " { /ST { STnoshfill } BD }\n" + " ifelse }\n" + "{ /ST { STnoshfill } BD }\n" + "ifelse\n"); + + gl2psPrintf("end\n" + "%%%%EndProlog\n" + "%%%%BeginSetup\n" + "/DeviceRGB setcolorspace\n" + "gl2psdict begin\n" + "%%%%EndSetup\n" + "%%%%Page: 1 1\n" + "%%%%BeginPageSetup\n"); + + if(gl2ps->options & GL2PS_LANDSCAPE){ + gl2psPrintf("%d 0 translate 90 rotate\n", + (int)gl2ps->viewport[3]); + } + + gl2psPrintf("%%%%EndPageSetup\n" + "mark\n" + "gsave\n" + "1.0 1.0 scale\n"); + + if(gl2ps->options & GL2PS_DRAW_BACKGROUND){ + gl2psPrintf("%g %g %g C\n" + "newpath %d %d moveto %d %d lineto %d %d lineto %d %d lineto\n" + "closepath fill\n", + gl2ps->bgcolor[0], gl2ps->bgcolor[1], gl2ps->bgcolor[2], + (int)gl2ps->viewport[0], (int)gl2ps->viewport[1], (int)gl2ps->viewport[2], + (int)gl2ps->viewport[1], (int)gl2ps->viewport[2], (int)gl2ps->viewport[3], + (int)gl2ps->viewport[0], (int)gl2ps->viewport[3]); + } +} + +static void gl2psPrintPostScriptColor(GL2PSrgba rgba) +{ + if(!gl2psSameColor(gl2ps->lastrgba, rgba)){ + gl2psSetLastColor(rgba); + gl2psPrintf("%g %g %g C\n", rgba[0], rgba[1], rgba[2]); + } +} + +static void gl2psResetPostScriptColor(void) +{ + gl2ps->lastrgba[0] = gl2ps->lastrgba[1] = gl2ps->lastrgba[2] = -1.; +} + +static void gl2psEndPostScriptLine(void) +{ + int i; + if(gl2ps->lastvertex.rgba[0] >= 0.){ + gl2psPrintf("%g %g LE\n", gl2ps->lastvertex.xyz[0], gl2ps->lastvertex.xyz[1]); + for(i = 0; i < 3; i++) + gl2ps->lastvertex.xyz[i] = -1.; + for(i = 0; i < 4; i++) + gl2ps->lastvertex.rgba[i] = -1.; + } +} + +static void gl2psParseStipplePattern(GLushort pattern, GLint factor, + int *nb, int array[10]) +{ + int i, n; + int on[8] = {0, 0, 0, 0, 0, 0, 0, 0}; + int off[8] = {0, 0, 0, 0, 0, 0, 0, 0}; + char tmp[16]; + + /* extract the 16 bits from the OpenGL stipple pattern */ + for(n = 15; n >= 0; n--){ + tmp[n] = (char)(pattern & 0x01); + pattern >>= 1; + } + /* compute the on/off pixel sequence */ + n = 0; + for(i = 0; i < 8; i++){ + while(n < 16 && !tmp[n]){ off[i]++; n++; } + while(n < 16 && tmp[n]){ on[i]++; n++; } + if(n >= 15){ i++; break; } + } + + /* store the on/off array from right to left, starting with off + pixels. The PostScript specification allows for at most 11 + elements in the on/off array, so we limit ourselves to 5 on/off + couples (our longest possible array is thus [on4 off4 on3 off3 + on2 off2 on1 off1 on0 off0]) */ + *nb = 0; + for(n = i - 1; n >= 0; n--){ + array[(*nb)++] = factor * on[n]; + array[(*nb)++] = factor * off[n]; + if(*nb == 10) break; + } +} + +static int gl2psPrintPostScriptDash(GLushort pattern, GLint factor, const char *str) +{ + int len = 0, i, n, array[10]; + + if(pattern == gl2ps->lastpattern && factor == gl2ps->lastfactor) + return 0; + + gl2ps->lastpattern = pattern; + gl2ps->lastfactor = factor; + + if(!pattern || !factor){ + /* solid line */ + len += gl2psPrintf("[] 0 %s\n", str); + } + else{ + gl2psParseStipplePattern(pattern, factor, &n, array); + len += gl2psPrintf("["); + for(i = 0; i < n; i++){ + if(i) len += gl2psPrintf(" "); + len += gl2psPrintf("%d", array[i]); + } + len += gl2psPrintf("] 0 %s\n", str); + } + + return len; +} + +static void gl2psPrintPostScriptPrimitive(void *data) +{ + int newline; + GL2PSprimitive *prim; + + prim = *(GL2PSprimitive**)data; + + if((gl2ps->options & GL2PS_OCCLUSION_CULL) && prim->culled) return; + + /* Every effort is made to draw lines as connected segments (i.e., + using a single PostScript path): this is the only way to get nice + line joins and to not restart the stippling for every line + segment. So if the primitive to print is not a line we must first + finish the current line (if any): */ + if(prim->type != GL2PS_LINE) gl2psEndPostScriptLine(); + + switch(prim->type){ + case GL2PS_POINT : + gl2psPrintPostScriptColor(prim->verts[0].rgba); + gl2psPrintf("%g %g %g P\n", + prim->verts[0].xyz[0], prim->verts[0].xyz[1], 0.5 * prim->width); + break; + case GL2PS_LINE : + if(!gl2psSamePosition(gl2ps->lastvertex.xyz, prim->verts[0].xyz) || + !gl2psSameColor(gl2ps->lastrgba, prim->verts[0].rgba) || + gl2ps->lastlinewidth != prim->width || + gl2ps->lastpattern != prim->pattern || + gl2ps->lastfactor != prim->factor){ + /* End the current line if the new segment does not start where + the last one ended, or if the color, the width or the + stippling have changed (multi-stroking lines with changing + colors is necessary until we use /shfill for lines; + unfortunately this means that at the moment we can screw up + line stippling for smooth-shaded lines) */ + gl2psEndPostScriptLine(); + newline = 1; + } + else{ + newline = 0; + } + if(gl2ps->lastlinewidth != prim->width){ + gl2ps->lastlinewidth = prim->width; + gl2psPrintf("%g W\n", gl2ps->lastlinewidth); + } + gl2psPrintPostScriptDash(prim->pattern, prim->factor, "setdash"); + gl2psPrintPostScriptColor(prim->verts[0].rgba); + gl2psPrintf("%g %g %s\n", prim->verts[0].xyz[0], prim->verts[0].xyz[1], + newline ? "LS" : "L"); + gl2ps->lastvertex = prim->verts[1]; + break; + case GL2PS_TRIANGLE : + if(!gl2psVertsSameColor(prim)){ + gl2psResetPostScriptColor(); + gl2psPrintf("%g %g %g %g %g %g %g %g %g %g %g %g %g %g %g ST\n", + prim->verts[2].xyz[0], prim->verts[2].xyz[1], + prim->verts[2].rgba[0], prim->verts[2].rgba[1], + prim->verts[2].rgba[2], prim->verts[1].xyz[0], + prim->verts[1].xyz[1], prim->verts[1].rgba[0], + prim->verts[1].rgba[1], prim->verts[1].rgba[2], + prim->verts[0].xyz[0], prim->verts[0].xyz[1], + prim->verts[0].rgba[0], prim->verts[0].rgba[1], + prim->verts[0].rgba[2]); + } + else{ + gl2psPrintPostScriptColor(prim->verts[0].rgba); + gl2psPrintf("%g %g %g %g %g %g T\n", + prim->verts[2].xyz[0], prim->verts[2].xyz[1], + prim->verts[1].xyz[0], prim->verts[1].xyz[1], + prim->verts[0].xyz[0], prim->verts[0].xyz[1]); + } + break; + case GL2PS_QUADRANGLE : + gl2psMsg(GL2PS_WARNING, "There should not be any quad left to print"); + break; + case GL2PS_PIXMAP : + gl2psPrintPostScriptPixmap(prim->verts[0].xyz[0], prim->verts[0].xyz[1], + prim->data.image); + break; + case GL2PS_IMAGEMAP : + if(prim->data.image->type != GL2PS_IMAGEMAP_WRITTEN){ + gl2psPrintPostScriptColor(prim->verts[0].rgba); + gl2psPrintPostScriptImagemap(prim->data.image->pixels[0], + prim->data.image->pixels[1], + prim->data.image->width, prim->data.image->height, + (const unsigned char*)(&(prim->data.image->pixels[2]))); + prim->data.image->type = GL2PS_IMAGEMAP_WRITTEN; + } + break; + case GL2PS_TEXT : + gl2psPrintPostScriptColor(prim->verts[0].rgba); + gl2psPrintf("(%s) ", prim->data.text->str); + if(prim->data.text->angle) + gl2psPrintf("%g ", prim->data.text->angle); + gl2psPrintf("%g %g %d /%s ", + prim->verts[0].xyz[0], prim->verts[0].xyz[1], + prim->data.text->fontsize, prim->data.text->fontname); + switch(prim->data.text->alignment){ + case GL2PS_TEXT_C: + gl2psPrintf(prim->data.text->angle ? "SCCR\n" : "SCC\n"); + break; + case GL2PS_TEXT_CL: + gl2psPrintf(prim->data.text->angle ? "SCLR\n" : "SCL\n"); + break; + case GL2PS_TEXT_CR: + gl2psPrintf(prim->data.text->angle ? "SCRR\n" : "SCR\n"); + break; + case GL2PS_TEXT_B: + gl2psPrintf(prim->data.text->angle ? "SBCR\n" : "SBC\n"); + break; + case GL2PS_TEXT_BR: + gl2psPrintf(prim->data.text->angle ? "SBRR\n" : "SBR\n"); + break; + case GL2PS_TEXT_T: + gl2psPrintf(prim->data.text->angle ? "STCR\n" : "STC\n"); + break; + case GL2PS_TEXT_TL: + gl2psPrintf(prim->data.text->angle ? "STLR\n" : "STL\n"); + break; + case GL2PS_TEXT_TR: + gl2psPrintf(prim->data.text->angle ? "STRR\n" : "STR\n"); + break; + case GL2PS_TEXT_BL: + default: + gl2psPrintf(prim->data.text->angle ? "SR\n" : "S\n"); + break; + } + break; + case GL2PS_SPECIAL : + /* alignment contains the format for which the special output text + is intended */ + if(prim->data.text->alignment == GL2PS_PS || + prim->data.text->alignment == GL2PS_EPS) + gl2psPrintf("%s\n", prim->data.text->str); + break; + default : + break; + } +} + +static void gl2psPrintPostScriptFooter(void) +{ + gl2psPrintf("grestore\n" + "showpage\n" + "cleartomark\n" + "%%%%PageTrailer\n" + "%%%%Trailer\n" + "end\n" + "%%%%EOF\n"); + + gl2psPrintGzipFooter(); +} + +static void gl2psPrintPostScriptBeginViewport(GLint viewport[4]) +{ + GLint index; + GLfloat rgba[4]; + int x = viewport[0], y = viewport[1], w = viewport[2], h = viewport[3]; + + glRenderMode(GL_FEEDBACK); + + if(gl2ps->header){ + gl2psPrintPostScriptHeader(); + gl2ps->header = GL_FALSE; + } + + gl2psPrintf("gsave\n" + "1.0 1.0 scale\n"); + + if(gl2ps->options & GL2PS_DRAW_BACKGROUND){ + if(gl2ps->colormode == GL_RGBA || gl2ps->colorsize == 0){ + glGetFloatv(GL_COLOR_CLEAR_VALUE, rgba); + } + else{ + glGetIntegerv(GL_INDEX_CLEAR_VALUE, &index); + rgba[0] = gl2ps->colormap[index][0]; + rgba[1] = gl2ps->colormap[index][1]; + rgba[2] = gl2ps->colormap[index][2]; + rgba[3] = 1.0F; + } + gl2psPrintf("%g %g %g C\n" + "newpath %d %d moveto %d %d lineto %d %d lineto %d %d lineto\n" + "closepath fill\n", + rgba[0], rgba[1], rgba[2], + x, y, x+w, y, x+w, y+h, x, y+h); + } + + gl2psPrintf("newpath %d %d moveto %d %d lineto %d %d lineto %d %d lineto\n" + "closepath clip\n", + x, y, x+w, y, x+w, y+h, x, y+h); + +} + +static GLint gl2psPrintPostScriptEndViewport(void) +{ + GLint res; + + res = gl2psPrintPrimitives(); + gl2psPrintf("grestore\n"); + return res; +} + +static void gl2psPrintPostScriptFinalPrimitive(void) +{ + /* End any remaining line, if any */ + gl2psEndPostScriptLine(); +} + +/* definition of the PostScript and Encapsulated PostScript backends */ + +static GL2PSbackend gl2psPS = { + gl2psPrintPostScriptHeader, + gl2psPrintPostScriptFooter, + gl2psPrintPostScriptBeginViewport, + gl2psPrintPostScriptEndViewport, + gl2psPrintPostScriptPrimitive, + gl2psPrintPostScriptFinalPrimitive, + "ps", + "Postscript" +}; + +static GL2PSbackend gl2psEPS = { + gl2psPrintPostScriptHeader, + gl2psPrintPostScriptFooter, + gl2psPrintPostScriptBeginViewport, + gl2psPrintPostScriptEndViewport, + gl2psPrintPostScriptPrimitive, + gl2psPrintPostScriptFinalPrimitive, + "eps", + "Encapsulated Postscript" +}; + +/********************************************************************* + * + * LaTeX routines + * + *********************************************************************/ + +static void gl2psPrintTeXHeader(void) +{ + char name[256]; + time_t now; + int i; + + if(gl2ps->filename && strlen(gl2ps->filename) < 256){ + for(i = (int)strlen(gl2ps->filename) - 1; i >= 0; i--){ + if(gl2ps->filename[i] == '.'){ + strncpy(name, gl2ps->filename, i); + name[i] = '\0'; + break; + } + } + if(i <= 0) strcpy(name, gl2ps->filename); + } + else{ + strcpy(name, "untitled"); + } + + time(&now); + + fprintf(gl2ps->stream, + "%% Title: %s\n" + "%% Creator: GL2PS %d.%d.%d%s, %s\n" + "%% For: %s\n" + "%% CreationDate: %s", + gl2ps->title, GL2PS_MAJOR_VERSION, GL2PS_MINOR_VERSION, + GL2PS_PATCH_VERSION, GL2PS_EXTRA_VERSION, GL2PS_COPYRIGHT, + gl2ps->producer, ctime(&now)); + + fprintf(gl2ps->stream, + "\\setlength{\\unitlength}{1pt}\n" + "\\begin{picture}(0,0)\n" + "\\includegraphics{%s}\n" + "\\end{picture}%%\n" + "%s\\begin{picture}(%d,%d)(0,0)\n", + name, (gl2ps->options & GL2PS_LANDSCAPE) ? "\\rotatebox{90}{" : "", + (int)gl2ps->viewport[2], (int)gl2ps->viewport[3]); +} + +static void gl2psPrintTeXPrimitive(void *data) +{ + GL2PSprimitive *prim; + + prim = *(GL2PSprimitive**)data; + + switch(prim->type){ + case GL2PS_TEXT : + fprintf(gl2ps->stream, "\\fontsize{%d}{0}\n\\selectfont", + prim->data.text->fontsize); + fprintf(gl2ps->stream, "\\put(%g,%g)", + prim->verts[0].xyz[0], prim->verts[0].xyz[1]); + if(prim->data.text->angle) + fprintf(gl2ps->stream, "{\\rotatebox{%g}", prim->data.text->angle); + fprintf(gl2ps->stream, "{\\makebox(0,0)"); + switch(prim->data.text->alignment){ + case GL2PS_TEXT_C: + fprintf(gl2ps->stream, "{"); + break; + case GL2PS_TEXT_CL: + fprintf(gl2ps->stream, "[l]{"); + break; + case GL2PS_TEXT_CR: + fprintf(gl2ps->stream, "[r]{"); + break; + case GL2PS_TEXT_B: + fprintf(gl2ps->stream, "[b]{"); + break; + case GL2PS_TEXT_BR: + fprintf(gl2ps->stream, "[br]{"); + break; + case GL2PS_TEXT_T: + fprintf(gl2ps->stream, "[t]{"); + break; + case GL2PS_TEXT_TL: + fprintf(gl2ps->stream, "[tl]{"); + break; + case GL2PS_TEXT_TR: + fprintf(gl2ps->stream, "[tr]{"); + break; + case GL2PS_TEXT_BL: + default: + fprintf(gl2ps->stream, "[bl]{"); + break; + } + fprintf(gl2ps->stream, "\\textcolor[rgb]{%g,%g,%g}{{%s}}", + prim->verts[0].rgba[0], prim->verts[0].rgba[1], prim->verts[0].rgba[2], + prim->data.text->str); + if(prim->data.text->angle) + fprintf(gl2ps->stream, "}"); + fprintf(gl2ps->stream, "}}\n"); + break; + case GL2PS_SPECIAL : + /* alignment contains the format for which the special output text + is intended */ + if (prim->data.text->alignment == GL2PS_TEX) + fprintf(gl2ps->stream, "%s\n", prim->data.text->str); + break; + default : + break; + } +} + +static void gl2psPrintTeXFooter(void) +{ + fprintf(gl2ps->stream, "\\end{picture}%s\n", + (gl2ps->options & GL2PS_LANDSCAPE) ? "}" : ""); +} + +static void gl2psPrintTeXBeginViewport(GLint viewport[4]) +{ + (void) viewport; /* not used */ + glRenderMode(GL_FEEDBACK); + + if(gl2ps->header){ + gl2psPrintTeXHeader(); + gl2ps->header = GL_FALSE; + } +} + +static GLint gl2psPrintTeXEndViewport(void) +{ + return gl2psPrintPrimitives(); +} + +static void gl2psPrintTeXFinalPrimitive(void) +{ +} + +/* definition of the LaTeX backend */ + +static GL2PSbackend gl2psTEX = { + gl2psPrintTeXHeader, + gl2psPrintTeXFooter, + gl2psPrintTeXBeginViewport, + gl2psPrintTeXEndViewport, + gl2psPrintTeXPrimitive, + gl2psPrintTeXFinalPrimitive, + "tex", + "LaTeX text" +}; + +/********************************************************************* + * + * PDF routines + * + *********************************************************************/ + +static int gl2psPrintPDFCompressorType(void) +{ +#if defined(GL2PS_HAVE_ZLIB) + if(gl2ps->options & GL2PS_COMPRESS){ + return fprintf(gl2ps->stream, "/Filter [/FlateDecode]\n"); + } +#endif + return 0; +} + +static int gl2psPrintPDFStrokeColor(GL2PSrgba rgba) +{ + int i, offs = 0; + + gl2psSetLastColor(rgba); + for(i = 0; i < 3; ++i){ + if(GL2PS_ZERO(rgba[i])) + offs += gl2psPrintf("%.0f ", 0.); + else if(rgba[i] < 1e-4 || rgba[i] > 1e6) /* avoid %e formatting */ + offs += gl2psPrintf("%f ", rgba[i]); + else + offs += gl2psPrintf("%g ", rgba[i]); + } + offs += gl2psPrintf("RG\n"); + return offs; +} + +static int gl2psPrintPDFFillColor(GL2PSrgba rgba) +{ + int i, offs = 0; + + for(i = 0; i < 3; ++i){ + if(GL2PS_ZERO(rgba[i])) + offs += gl2psPrintf("%.0f ", 0.); + else if(rgba[i] < 1e-4 || rgba[i] > 1e6) /* avoid %e formatting */ + offs += gl2psPrintf("%f ", rgba[i]); + else + offs += gl2psPrintf("%g ", rgba[i]); + } + offs += gl2psPrintf("rg\n"); + return offs; +} + +static int gl2psPrintPDFLineWidth(GLfloat lw) +{ + if(GL2PS_ZERO(lw)) + return gl2psPrintf("%.0f w\n", 0.); + else if(lw < 1e-4 || lw > 1e6) /* avoid %e formatting */ + return gl2psPrintf("%f w\n", lw); + else + return gl2psPrintf("%g w\n", lw); +} + +static void gl2psPutPDFText(GL2PSstring *text, int cnt, GLfloat x, GLfloat y) +{ + GLfloat rad, crad, srad; + + if(text->angle == 0.0F){ + gl2ps->streamlength += gl2psPrintf + ("BT\n" + "/F%d %d Tf\n" + "%f %f Td\n" + "(%s) Tj\n" + "ET\n", + cnt, text->fontsize, x, y, text->str); + } + else{ + rad = (GLfloat)(M_PI * text->angle / 180.0F); + srad = (GLfloat)sin(rad); + crad = (GLfloat)cos(rad); + gl2ps->streamlength += gl2psPrintf + ("BT\n" + "/F%d %d Tf\n" + "%f %f %f %f %f %f Tm\n" + "(%s) Tj\n" + "ET\n", + cnt, text->fontsize, crad, srad, -srad, crad, x, y, text->str); + } +} + +static void gl2psPutPDFImage(GL2PSimage *image, int cnt, GLfloat x, GLfloat y) +{ + gl2ps->streamlength += gl2psPrintf + ("q\n" + "%d 0 0 %d %f %f cm\n" + "/Im%d Do\n" + "Q\n", + (int)image->width, (int)image->height, x, y, cnt); +} + +static void gl2psPDFstacksInit(void) +{ + gl2ps->objects_stack = 7 /* FIXED_XREF_ENTRIES */ + 1; + gl2ps->extgs_stack = 0; + gl2ps->font_stack = 0; + gl2ps->im_stack = 0; + gl2ps->trgroupobjects_stack = 0; + gl2ps->shader_stack = 0; + gl2ps->mshader_stack = 0; +} + +static void gl2psPDFgroupObjectInit(GL2PSpdfgroup *gro) +{ + if(!gro) + return; + + gro->ptrlist = NULL; + gro->fontno = gro->gsno = gro->imno = gro->maskshno = gro->shno + = gro->trgroupno = gro->fontobjno = gro->imobjno = gro->shobjno + = gro->maskshobjno = gro->gsobjno = gro->trgroupobjno = -1; +} + +/* Build up group objects and assign name and object numbers */ + +static void gl2psPDFgroupListInit(void) +{ + int i; + GL2PSprimitive *p = NULL; + GL2PSpdfgroup gro; + int lasttype = GL2PS_NO_TYPE; + GL2PSrgba lastrgba = {-1.0F, -1.0F, -1.0F, -1.0F}; + GLushort lastpattern = 0; + GLint lastfactor = 0; + GLfloat lastwidth = 1; + GL2PStriangle lastt, tmpt; + int lastTriangleWasNotSimpleWithSameColor = 0; + + if(!gl2ps->pdfprimlist) + return; + + gl2ps->pdfgrouplist = gl2psListCreate(500, 500, sizeof(GL2PSpdfgroup)); + gl2psInitTriangle(&lastt); + + for(i = 0; i < gl2psListNbr(gl2ps->pdfprimlist); ++i){ + p = *(GL2PSprimitive**)gl2psListPointer(gl2ps->pdfprimlist, i); + switch(p->type){ + case GL2PS_PIXMAP: + gl2psPDFgroupObjectInit(&gro); + gro.ptrlist = gl2psListCreate(1, 2, sizeof(GL2PSprimitive*)); + gro.imno = gl2ps->im_stack++; + gl2psListAdd(gro.ptrlist, &p); + gl2psListAdd(gl2ps->pdfgrouplist, &gro); + break; + case GL2PS_TEXT: + gl2psPDFgroupObjectInit(&gro); + gro.ptrlist = gl2psListCreate(1, 2, sizeof(GL2PSprimitive*)); + gro.fontno = gl2ps->font_stack++; + gl2psListAdd(gro.ptrlist, &p); + gl2psListAdd(gl2ps->pdfgrouplist, &gro); + break; + case GL2PS_LINE: + if(lasttype != p->type || lastwidth != p->width || + lastpattern != p->pattern || lastfactor != p->factor || + !gl2psSameColor(p->verts[0].rgba, lastrgba)){ + gl2psPDFgroupObjectInit(&gro); + gro.ptrlist = gl2psListCreate(1, 2, sizeof(GL2PSprimitive*)); + gl2psListAdd(gro.ptrlist, &p); + gl2psListAdd(gl2ps->pdfgrouplist, &gro); + } + else{ + gl2psListAdd(gro.ptrlist, &p); + } + lastpattern = p->pattern; + lastfactor = p->factor; + lastwidth = p->width; + lastrgba[0] = p->verts[0].rgba[0]; + lastrgba[1] = p->verts[0].rgba[1]; + lastrgba[2] = p->verts[0].rgba[2]; + break; + case GL2PS_POINT: + if(lasttype != p->type || lastwidth != p->width || + !gl2psSameColor(p->verts[0].rgba, lastrgba)){ + gl2psPDFgroupObjectInit(&gro); + gro.ptrlist = gl2psListCreate(1,2,sizeof(GL2PSprimitive*)); + gl2psListAdd(gro.ptrlist, &p); + gl2psListAdd(gl2ps->pdfgrouplist, &gro); + } + else{ + gl2psListAdd(gro.ptrlist, &p); + } + lastwidth = p->width; + lastrgba[0] = p->verts[0].rgba[0]; + lastrgba[1] = p->verts[0].rgba[1]; + lastrgba[2] = p->verts[0].rgba[2]; + break; + case GL2PS_TRIANGLE: + gl2psFillTriangleFromPrimitive(&tmpt, p, GL_TRUE); + lastTriangleWasNotSimpleWithSameColor = + !(tmpt.prop & T_CONST_COLOR && tmpt.prop & T_ALPHA_1) || + !gl2psSameColor(tmpt.vertex[0].rgba, lastt.vertex[0].rgba); + if(lasttype == p->type && tmpt.prop == lastt.prop && + lastTriangleWasNotSimpleWithSameColor){ + /* TODO Check here for last alpha */ + gl2psListAdd(gro.ptrlist, &p); + } + else{ + gl2psPDFgroupObjectInit(&gro); + gro.ptrlist = gl2psListCreate(1, 2, sizeof(GL2PSprimitive*)); + gl2psListAdd(gro.ptrlist, &p); + gl2psListAdd(gl2ps->pdfgrouplist, &gro); + } + lastt = tmpt; + break; + default: + break; + } + lasttype = p->type; + } +} + +static void gl2psSortOutTrianglePDFgroup(GL2PSpdfgroup *gro) +{ + GL2PStriangle t; + GL2PSprimitive *prim = NULL; + + if(!gro) + return; + + if(!gl2psListNbr(gro->ptrlist)) + return; + + prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, 0); + + if(prim->type != GL2PS_TRIANGLE) + return; + + gl2psFillTriangleFromPrimitive(&t, prim, GL_TRUE); + + if(t.prop & T_CONST_COLOR && t.prop & T_ALPHA_LESS_1){ + gro->gsno = gl2ps->extgs_stack++; + gro->gsobjno = gl2ps->objects_stack ++; + } + else if(t.prop & T_CONST_COLOR && t.prop & T_VAR_ALPHA){ + gro->gsno = gl2ps->extgs_stack++; + gro->gsobjno = gl2ps->objects_stack++; + gro->trgroupno = gl2ps->trgroupobjects_stack++; + gro->trgroupobjno = gl2ps->objects_stack++; + gro->maskshno = gl2ps->mshader_stack++; + gro->maskshobjno = gl2ps->objects_stack++; + } + else if(t.prop & T_VAR_COLOR && t.prop & T_ALPHA_1){ + gro->shno = gl2ps->shader_stack++; + gro->shobjno = gl2ps->objects_stack++; + } + else if(t.prop & T_VAR_COLOR && t.prop & T_ALPHA_LESS_1){ + gro->gsno = gl2ps->extgs_stack++; + gro->gsobjno = gl2ps->objects_stack++; + gro->shno = gl2ps->shader_stack++; + gro->shobjno = gl2ps->objects_stack++; + } + else if(t.prop & T_VAR_COLOR && t.prop & T_VAR_ALPHA){ + gro->gsno = gl2ps->extgs_stack++; + gro->gsobjno = gl2ps->objects_stack++; + gro->shno = gl2ps->shader_stack++; + gro->shobjno = gl2ps->objects_stack++; + gro->trgroupno = gl2ps->trgroupobjects_stack++; + gro->trgroupobjno = gl2ps->objects_stack++; + gro->maskshno = gl2ps->mshader_stack++; + gro->maskshobjno = gl2ps->objects_stack++; + } +} + +/* Main stream data */ + +static void gl2psPDFgroupListWriteMainStream(void) +{ + int i, j, lastel; + GL2PSprimitive *prim = NULL, *prev = NULL; + GL2PSpdfgroup *gro; + GL2PStriangle t; + + if(!gl2ps->pdfgrouplist) + return; + + for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){ + gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i); + + lastel = gl2psListNbr(gro->ptrlist) - 1; + if(lastel < 0) + continue; + + prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, 0); + + switch(prim->type){ + case GL2PS_POINT: + gl2ps->streamlength += gl2psPrintf("1 J\n"); + gl2ps->streamlength += gl2psPrintPDFLineWidth(prim->width); + gl2ps->streamlength += gl2psPrintPDFStrokeColor(prim->verts[0].rgba); + for(j = 0; j <= lastel; ++j){ + prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j); + gl2ps->streamlength += + gl2psPrintf("%f %f m %f %f l\n", + prim->verts[0].xyz[0], prim->verts[0].xyz[1], + prim->verts[0].xyz[0], prim->verts[0].xyz[1]); + } + gl2ps->streamlength += gl2psPrintf("S\n"); + gl2ps->streamlength += gl2psPrintf("0 J\n"); + break; + case GL2PS_LINE: + /* We try to use as few paths as possible to draw lines, in + order to get nice stippling even when the individual segments + are smaller than the stipple */ + gl2ps->streamlength += gl2psPrintPDFLineWidth(prim->width); + gl2ps->streamlength += gl2psPrintPDFStrokeColor(prim->verts[0].rgba); + gl2ps->streamlength += gl2psPrintPostScriptDash(prim->pattern, prim->factor, "d"); + /* start new path */ + gl2ps->streamlength += + gl2psPrintf("%f %f m\n", + prim->verts[0].xyz[0], prim->verts[0].xyz[1]); + + for(j = 1; j <= lastel; ++j){ + prev = prim; + prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j); + if(!gl2psSamePosition(prim->verts[0].xyz, prev->verts[1].xyz)){ + /* the starting point of the new segment does not match the + end point of the previous line, so we end the current + path and start a new one */ + gl2ps->streamlength += + gl2psPrintf("%f %f l\n", + prev->verts[1].xyz[0], prev->verts[1].xyz[1]); + gl2ps->streamlength += + gl2psPrintf("%f %f m\n", + prim->verts[0].xyz[0], prim->verts[0].xyz[1]); + } + else{ + /* the two segements are connected, so we just append to the + current path */ + gl2ps->streamlength += + gl2psPrintf("%f %f l\n", + prim->verts[0].xyz[0], prim->verts[0].xyz[1]); + } + } + /* end last path */ + gl2ps->streamlength += + gl2psPrintf("%f %f l\n", + prim->verts[1].xyz[0], prim->verts[1].xyz[1]); + gl2ps->streamlength += gl2psPrintf("S\n"); + break; + case GL2PS_TRIANGLE: + gl2psFillTriangleFromPrimitive(&t, prim, GL_TRUE); + gl2psSortOutTrianglePDFgroup(gro); + + /* No alpha and const color: Simple PDF draw orders */ + if(t.prop & T_CONST_COLOR && t.prop & T_ALPHA_1){ + gl2ps->streamlength += gl2psPrintPDFFillColor(t.vertex[0].rgba); + for(j = 0; j <= lastel; ++j){ + prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j); + gl2psFillTriangleFromPrimitive(&t, prim, GL_FALSE); + gl2ps->streamlength + += gl2psPrintf("%f %f m\n" + "%f %f l\n" + "%f %f l\n" + "h f\n", + t.vertex[0].xyz[0], t.vertex[0].xyz[1], + t.vertex[1].xyz[0], t.vertex[1].xyz[1], + t.vertex[2].xyz[0], t.vertex[2].xyz[1]); + } + } + /* Const alpha < 1 and const color: Simple PDF draw orders + and an extra extended Graphics State for the alpha const */ + else if(t.prop & T_CONST_COLOR && t.prop & T_ALPHA_LESS_1){ + gl2ps->streamlength += gl2psPrintf("q\n" + "/GS%d gs\n", + gro->gsno); + gl2ps->streamlength += gl2psPrintPDFFillColor(prim->verts[0].rgba); + for(j = 0; j <= lastel; ++j){ + prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j); + gl2psFillTriangleFromPrimitive(&t, prim, GL_FALSE); + gl2ps->streamlength + += gl2psPrintf("%f %f m\n" + "%f %f l\n" + "%f %f l\n" + "h f\n", + t.vertex[0].xyz[0], t.vertex[0].xyz[1], + t.vertex[1].xyz[0], t.vertex[1].xyz[1], + t.vertex[2].xyz[0], t.vertex[2].xyz[1]); + } + gl2ps->streamlength += gl2psPrintf("Q\n"); + } + /* Variable alpha and const color: Simple PDF draw orders + and an extra extended Graphics State + Xobject + Shader + object for the alpha mask */ + else if(t.prop & T_CONST_COLOR && t.prop & T_VAR_ALPHA){ + gl2ps->streamlength += gl2psPrintf("q\n" + "/GS%d gs\n" + "/TrG%d Do\n", + gro->gsno, gro->trgroupno); + gl2ps->streamlength += gl2psPrintPDFFillColor(prim->verts[0].rgba); + for(j = 0; j <= lastel; ++j){ + prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j); + gl2psFillTriangleFromPrimitive(&t, prim, GL_FALSE); + gl2ps->streamlength + += gl2psPrintf("%f %f m\n" + "%f %f l\n" + "%f %f l\n" + "h f\n", + t.vertex[0].xyz[0], t.vertex[0].xyz[1], + t.vertex[1].xyz[0], t.vertex[1].xyz[1], + t.vertex[2].xyz[0], t.vertex[2].xyz[1]); + } + gl2ps->streamlength += gl2psPrintf("Q\n"); + } + /* Variable color and no alpha: Shader Object for the colored + triangle(s) */ + else if(t.prop & T_VAR_COLOR && t.prop & T_ALPHA_1){ + gl2ps->streamlength += gl2psPrintf("/Sh%d sh\n", gro->shno); + } + /* Variable color and const alpha < 1: Shader Object for the + colored triangle(s) and an extra extended Graphics State + for the alpha const */ + else if(t.prop & T_VAR_COLOR && t.prop & T_ALPHA_LESS_1){ + gl2ps->streamlength += gl2psPrintf("q\n" + "/GS%d gs\n" + "/Sh%d sh\n" + "Q\n", + gro->gsno, gro->shno); + } + /* Variable alpha and color: Shader Object for the colored + triangle(s) and an extra extended Graphics State + + Xobject + Shader object for the alpha mask */ + else if(t.prop & T_VAR_COLOR && t.prop & T_VAR_ALPHA){ + gl2ps->streamlength += gl2psPrintf("q\n" + "/GS%d gs\n" + "/TrG%d Do\n" + "/Sh%d sh\n" + "Q\n", + gro->gsno, gro->trgroupno, gro->shno); + } + break; + case GL2PS_PIXMAP: + for(j = 0; j <= lastel; ++j){ + prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j); + gl2psPutPDFImage(prim->data.image, gro->imno, prim->verts[0].xyz[0], + prim->verts[0].xyz[1]); + } + break; + case GL2PS_TEXT: + for(j = 0; j <= lastel; ++j){ + prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j); + gl2ps->streamlength += gl2psPrintPDFFillColor(prim->verts[0].rgba); + gl2psPutPDFText(prim->data.text, gro->fontno, prim->verts[0].xyz[0], + prim->verts[0].xyz[1]); + } + break; + default: + break; + } + } +} + +/* Graphics State names */ + +static int gl2psPDFgroupListWriteGStateResources(void) +{ + GL2PSpdfgroup *gro; + int offs = 0; + int i; + + offs += fprintf(gl2ps->stream, + "/ExtGState\n" + "<<\n" + "/GSa 7 0 R\n"); + for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){ + gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i); + if(gro->gsno >= 0) + offs += fprintf(gl2ps->stream, "/GS%d %d 0 R\n", gro->gsno, gro->gsobjno); + } + offs += fprintf(gl2ps->stream, ">>\n"); + return offs; +} + +/* Main Shader names */ + +static int gl2psPDFgroupListWriteShaderResources(void) +{ + GL2PSpdfgroup *gro; + int offs = 0; + int i; + + offs += fprintf(gl2ps->stream, + "/Shading\n" + "<<\n"); + for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){ + gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i); + if(gro->shno >= 0) + offs += fprintf(gl2ps->stream, "/Sh%d %d 0 R\n", gro->shno, gro->shobjno); + if(gro->maskshno >= 0) + offs += fprintf(gl2ps->stream, "/TrSh%d %d 0 R\n", gro->maskshno, gro->maskshobjno); + } + offs += fprintf(gl2ps->stream,">>\n"); + return offs; +} + +/* Images & Mask Shader XObject names */ + +static int gl2psPDFgroupListWriteXObjectResources(void) +{ + int i; + GL2PSprimitive *p = NULL; + GL2PSpdfgroup *gro; + int offs = 0; + + offs += fprintf(gl2ps->stream, + "/XObject\n" + "<<\n"); + + for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){ + gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i); + if(!gl2psListNbr(gro->ptrlist)) + continue; + p = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, 0); + switch(p->type){ + case GL2PS_PIXMAP: + gro->imobjno = gl2ps->objects_stack++; + if(GL_RGBA == p->data.image->format) /* reserve one object for image mask */ + gl2ps->objects_stack++; + offs += fprintf(gl2ps->stream, "/Im%d %d 0 R\n", gro->imno, gro->imobjno); + case GL2PS_TRIANGLE: + if(gro->trgroupno >=0) + offs += fprintf(gl2ps->stream, "/TrG%d %d 0 R\n", gro->trgroupno, gro->trgroupobjno); + break; + default: + break; + } + } + offs += fprintf(gl2ps->stream,">>\n"); + return offs; +} + +/* Font names */ + +static int gl2psPDFgroupListWriteFontResources(void) +{ + int i; + GL2PSpdfgroup *gro; + int offs = 0; + + offs += fprintf(gl2ps->stream, "/Font\n<<\n"); + + for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){ + gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i); + if(gro->fontno < 0) + continue; + gro->fontobjno = gl2ps->objects_stack++; + offs += fprintf(gl2ps->stream, "/F%d %d 0 R\n", gro->fontno, gro->fontobjno); + } + offs += fprintf(gl2ps->stream, ">>\n"); + + return offs; +} + +static void gl2psPDFgroupListDelete(void) +{ + int i; + GL2PSpdfgroup *gro = NULL; + + if(!gl2ps->pdfgrouplist) + return; + + for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){ + gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist,i); + gl2psListDelete(gro->ptrlist); + } + + gl2psListDelete(gl2ps->pdfgrouplist); + gl2ps->pdfgrouplist = NULL; +} + +/* Print 1st PDF object - file info */ + +static int gl2psPrintPDFInfo(void) +{ + int offs; + time_t now; + struct tm *newtime; + + time(&now); + newtime = gmtime(&now); + + offs = fprintf(gl2ps->stream, + "1 0 obj\n" + "<<\n" + "/Title (%s)\n" + "/Creator (GL2PS %d.%d.%d%s, %s)\n" + "/Producer (%s)\n", + gl2ps->title, GL2PS_MAJOR_VERSION, GL2PS_MINOR_VERSION, + GL2PS_PATCH_VERSION, GL2PS_EXTRA_VERSION, GL2PS_COPYRIGHT, + gl2ps->producer); + + if(!newtime){ + offs += fprintf(gl2ps->stream, + ">>\n" + "endobj\n"); + return offs; + } + + offs += fprintf(gl2ps->stream, + "/CreationDate (D:%d%02d%02d%02d%02d%02d)\n" + ">>\n" + "endobj\n", + newtime->tm_year+1900, + newtime->tm_mon+1, + newtime->tm_mday, + newtime->tm_hour, + newtime->tm_min, + newtime->tm_sec); + return offs; +} + +/* Create catalog and page structure - 2nd and 3th PDF object */ + +static int gl2psPrintPDFCatalog(void) +{ + return fprintf(gl2ps->stream, + "2 0 obj\n" + "<<\n" + "/Type /Catalog\n" + "/Pages 3 0 R\n" + ">>\n" + "endobj\n"); +} + +static int gl2psPrintPDFPages(void) +{ + return fprintf(gl2ps->stream, + "3 0 obj\n" + "<<\n" + "/Type /Pages\n" + "/Kids [6 0 R]\n" + "/Count 1\n" + ">>\n" + "endobj\n"); +} + +/* Open stream for data - graphical objects, fonts etc. PDF object 4 */ + +static int gl2psOpenPDFDataStream(void) +{ + int offs = 0; + + offs += fprintf(gl2ps->stream, + "4 0 obj\n" + "<<\n" + "/Length 5 0 R\n" ); + offs += gl2psPrintPDFCompressorType(); + offs += fprintf(gl2ps->stream, + ">>\n" + "stream\n"); + return offs; +} + +/* Stream setup - Graphics state, fill background if allowed */ + +static int gl2psOpenPDFDataStreamWritePreface(void) +{ + int offs; + + offs = gl2psPrintf("/GSa gs\n"); + + if(gl2ps->options & GL2PS_DRAW_BACKGROUND){ + offs += gl2psPrintPDFFillColor(gl2ps->bgcolor); + offs += gl2psPrintf("%d %d %d %d re\n", + (int)gl2ps->viewport[0], (int)gl2ps->viewport[1], + (int)gl2ps->viewport[2], (int)gl2ps->viewport[3]); + offs += gl2psPrintf("f\n"); + } + return offs; +} + +/* Use the functions above to create the first part of the PDF*/ + +static void gl2psPrintPDFHeader(void) +{ + int offs = 0; + gl2ps->pdfprimlist = gl2psListCreate(500, 500, sizeof(GL2PSprimitive*)); + gl2psPDFstacksInit(); + + gl2ps->xreflist = (int*)gl2psMalloc(sizeof(int) * gl2ps->objects_stack); + +#if defined(GL2PS_HAVE_ZLIB) + if(gl2ps->options & GL2PS_COMPRESS){ + gl2psSetupCompress(); + } +#endif + gl2ps->xreflist[0] = 0; + offs += fprintf(gl2ps->stream, "%%PDF-1.4\n"); + gl2ps->xreflist[1] = offs; + + offs += gl2psPrintPDFInfo(); + gl2ps->xreflist[2] = offs; + + offs += gl2psPrintPDFCatalog(); + gl2ps->xreflist[3] = offs; + + offs += gl2psPrintPDFPages(); + gl2ps->xreflist[4] = offs; + + offs += gl2psOpenPDFDataStream(); + gl2ps->xreflist[5] = offs; /* finished in gl2psPrintPDFFooter */ + gl2ps->streamlength = gl2psOpenPDFDataStreamWritePreface(); +} + +/* The central primitive drawing */ + +static void gl2psPrintPDFPrimitive(void *data) +{ + GL2PSprimitive *prim = *(GL2PSprimitive**)data; + + if((gl2ps->options & GL2PS_OCCLUSION_CULL) && prim->culled) + return; + + prim = gl2psCopyPrimitive(prim); /* deep copy */ + gl2psListAdd(gl2ps->pdfprimlist, &prim); +} + +/* close stream and ... */ + +static int gl2psClosePDFDataStream(void) +{ + int offs = 0; + +#if defined(GL2PS_HAVE_ZLIB) + if(gl2ps->options & GL2PS_COMPRESS){ + if(Z_OK != gl2psDeflate()) + gl2psMsg(GL2PS_ERROR, "Zlib deflate error"); + else + fwrite(gl2ps->compress->dest, gl2ps->compress->destLen, 1, gl2ps->stream); + gl2ps->streamlength += gl2ps->compress->destLen; + + offs += gl2ps->streamlength; + gl2psFreeCompress(); + } +#endif + + offs += fprintf(gl2ps->stream, + "endstream\n" + "endobj\n"); + return offs; +} + +/* ... write the now known length object */ + +static int gl2psPrintPDFDataStreamLength(int val) +{ + return fprintf(gl2ps->stream, + "5 0 obj\n" + "%d\n" + "endobj\n", val); +} + +/* Put the info created before in PDF objects */ + +static int gl2psPrintPDFOpenPage(void) +{ + int offs; + + /* Write fixed part */ + + offs = fprintf(gl2ps->stream, + "6 0 obj\n" + "<<\n" + "/Type /Page\n" + "/Parent 3 0 R\n" + "/MediaBox [%d %d %d %d]\n", + (int)gl2ps->viewport[0], (int)gl2ps->viewport[1], + (int)gl2ps->viewport[2], (int)gl2ps->viewport[3]); + + if(gl2ps->options & GL2PS_LANDSCAPE) + offs += fprintf(gl2ps->stream, "/Rotate -90\n"); + + offs += fprintf(gl2ps->stream, + "/Contents 4 0 R\n" + "/Resources\n" + "<<\n" + "/ProcSet [/PDF /Text /ImageB /ImageC] %%/ImageI\n"); + + return offs; + + /* End fixed part, proceeds in gl2psPDFgroupListWriteVariableResources() */ +} + +static int gl2psPDFgroupListWriteVariableResources(void) +{ + int offs = 0; + + /* a) Graphics States for shader alpha masks*/ + offs += gl2psPDFgroupListWriteGStateResources(); + + /* b) Shader and shader masks */ + offs += gl2psPDFgroupListWriteShaderResources(); + + /* c) XObjects (Images & Shader Masks) */ + offs += gl2psPDFgroupListWriteXObjectResources(); + + /* d) Fonts */ + offs += gl2psPDFgroupListWriteFontResources(); + + /* End resources and page */ + offs += fprintf(gl2ps->stream, + ">>\n" + ">>\n" + "endobj\n"); + return offs; +} + +/* Standard Graphics State */ + +static int gl2psPrintPDFGSObject(void) +{ + return fprintf(gl2ps->stream, + "7 0 obj\n" + "<<\n" + "/Type /ExtGState\n" + "/SA false\n" + "/SM 0.02\n" + "/OP false\n" + "/op false\n" + "/OPM 0\n" + "/BG2 /Default\n" + "/UCR2 /Default\n" + "/TR2 /Default\n" + ">>\n" + "endobj\n"); +} + +/* Put vertex' edge flag (8bit) and coordinates (32bit) in shader stream */ + +static int gl2psPrintPDFShaderStreamDataCoord(GL2PSvertex *vertex, + int (*action)(unsigned long data, int size), + GLfloat dx, GLfloat dy, + GLfloat xmin, GLfloat ymin) +{ + int offs = 0; + unsigned long imap; + GLfloat diff; + double dmax = ~1UL; + char edgeflag = 0; + + /* FIXME: temp bux fix for 64 bit archs: */ + if(sizeof(unsigned long) == 8) dmax = dmax - 2048.; + + offs += (*action)(edgeflag, 1); + + /* The Shader stream in PDF requires to be in a 'big-endian' + order */ + + if(GL2PS_ZERO(dx * dy)){ + offs += (*action)(0, 4); + offs += (*action)(0, 4); + } + else{ + diff = (vertex->xyz[0] - xmin) / dx; + if(diff > 1) + diff = 1.0F; + else if(diff < 0) + diff = 0.0F; + imap = (unsigned long)(diff * dmax); + offs += (*action)(imap, 4); + + diff = (vertex->xyz[1] - ymin) / dy; + if(diff > 1) + diff = 1.0F; + else if(diff < 0) + diff = 0.0F; + imap = (unsigned long)(diff * dmax); + offs += (*action)(imap, 4); + } + + return offs; +} + +/* Put vertex' rgb value (8bit for every component) in shader stream */ + +static int gl2psPrintPDFShaderStreamDataRGB(GL2PSvertex *vertex, + int (*action)(unsigned long data, int size)) +{ + int offs = 0; + unsigned long imap; + double dmax = ~1UL; + + /* FIXME: temp bux fix for 64 bit archs: */ + if(sizeof(unsigned long) == 8) dmax = dmax - 2048.; + + imap = (unsigned long)((vertex->rgba[0]) * dmax); + offs += (*action)(imap, 1); + + imap = (unsigned long)((vertex->rgba[1]) * dmax); + offs += (*action)(imap, 1); + + imap = (unsigned long)((vertex->rgba[2]) * dmax); + offs += (*action)(imap, 1); + + return offs; +} + +/* Put vertex' alpha (8/16bit) in shader stream */ + +static int gl2psPrintPDFShaderStreamDataAlpha(GL2PSvertex *vertex, + int (*action)(unsigned long data, int size), + int sigbyte) +{ + int offs = 0; + unsigned long imap; + double dmax = ~1UL; + + /* FIXME: temp bux fix for 64 bit archs: */ + if(sizeof(unsigned long) == 8) dmax = dmax - 2048.; + + if(sigbyte != 8 && sigbyte != 16) + sigbyte = 8; + + sigbyte /= 8; + + imap = (unsigned long)((vertex->rgba[3]) * dmax); + + offs += (*action)(imap, sigbyte); + + return offs; +} + +/* Put a triangles raw data in shader stream */ + +static int gl2psPrintPDFShaderStreamData(GL2PStriangle *triangle, + GLfloat dx, GLfloat dy, + GLfloat xmin, GLfloat ymin, + int (*action)(unsigned long data, int size), + int gray) +{ + int i, offs = 0; + GL2PSvertex v; + + if(gray && gray != 8 && gray != 16) + gray = 8; + + for(i = 0; i < 3; ++i){ + offs += gl2psPrintPDFShaderStreamDataCoord(&triangle->vertex[i], action, + dx, dy, xmin, ymin); + if(gray){ + v = triangle->vertex[i]; + offs += gl2psPrintPDFShaderStreamDataAlpha(&v, action, gray); + } + else{ + offs += gl2psPrintPDFShaderStreamDataRGB(&triangle->vertex[i], action); + } + } + + return offs; +} + +static void gl2psPDFRectHull(GLfloat *xmin, GLfloat *xmax, + GLfloat *ymin, GLfloat *ymax, + GL2PStriangle *triangles, int cnt) +{ + int i, j; + + *xmin = triangles[0].vertex[0].xyz[0]; + *xmax = triangles[0].vertex[0].xyz[0]; + *ymin = triangles[0].vertex[0].xyz[1]; + *ymax = triangles[0].vertex[0].xyz[1]; + + for(i = 0; i < cnt; ++i){ + for(j = 0; j < 3; ++j){ + if(*xmin > triangles[i].vertex[j].xyz[0]) + *xmin = triangles[i].vertex[j].xyz[0]; + if(*xmax < triangles[i].vertex[j].xyz[0]) + *xmax = triangles[i].vertex[j].xyz[0]; + if(*ymin > triangles[i].vertex[j].xyz[1]) + *ymin = triangles[i].vertex[j].xyz[1]; + if(*ymax < triangles[i].vertex[j].xyz[1]) + *ymax = triangles[i].vertex[j].xyz[1]; + } + } +} + +/* Writes shaded triangle + gray == 0 means write RGB triangles + gray == 8 8bit-grayscale (for alpha masks) + gray == 16 16bit-grayscale (for alpha masks) */ + +static int gl2psPrintPDFShader(int obj, GL2PStriangle *triangles, + int size, int gray) +{ + int i, offs = 0, vertexbytes, done = 0; + GLfloat xmin, xmax, ymin, ymax; + + switch(gray){ + case 0: + vertexbytes = 1+4+4+1+1+1; + break; + case 8: + vertexbytes = 1+4+4+1; + break; + case 16: + vertexbytes = 1+4+4+2; + break; + default: + gray = 8; + vertexbytes = 1+4+4+1; + break; + } + + gl2psPDFRectHull(&xmin, &xmax, &ymin, &ymax, triangles, size); + + offs += fprintf(gl2ps->stream, + "%d 0 obj\n" + "<< " + "/ShadingType 4 " + "/ColorSpace %s " + "/BitsPerCoordinate 32 " + "/BitsPerComponent %d " + "/BitsPerFlag 8 " + "/Decode [%f %f %f %f 0 1 %s] ", + obj, + (gray) ? "/DeviceGray" : "/DeviceRGB", + (gray) ? gray : 8, + xmin, xmax, ymin, ymax, + (gray) ? "" : "0 1 0 1"); + +#if defined(GL2PS_HAVE_ZLIB) + if(gl2ps->options & GL2PS_COMPRESS){ + gl2psAllocCompress(vertexbytes * size * 3); + + for(i = 0; i < size; ++i) + gl2psPrintPDFShaderStreamData(&triangles[i], + xmax-xmin, ymax-ymin, xmin, ymin, + gl2psWriteBigEndianCompress, gray); + + if(Z_OK == gl2psDeflate() && 23 + gl2ps->compress->destLen < gl2ps->compress->srcLen){ + offs += gl2psPrintPDFCompressorType(); + offs += fprintf(gl2ps->stream, + "/Length %d " + ">>\n" + "stream\n", + (int)gl2ps->compress->destLen); + offs += gl2ps->compress->destLen * fwrite(gl2ps->compress->dest, + gl2ps->compress->destLen, + 1, gl2ps->stream); + done = 1; + } + gl2psFreeCompress(); + } +#endif + + if(!done){ + /* no compression, or too long after compression, or compress error + -> write non-compressed entry */ + offs += fprintf(gl2ps->stream, + "/Length %d " + ">>\n" + "stream\n", + vertexbytes * 3 * size); + for(i = 0; i < size; ++i) + offs += gl2psPrintPDFShaderStreamData(&triangles[i], + xmax-xmin, ymax-ymin, xmin, ymin, + gl2psWriteBigEndian, gray); + } + + offs += fprintf(gl2ps->stream, + "\nendstream\n" + "endobj\n"); + + return offs; +} + +/* Writes a XObject for a shaded triangle mask */ + +static int gl2psPrintPDFShaderMask(int obj, int childobj) +{ + int offs = 0, len; + + offs += fprintf(gl2ps->stream, + "%d 0 obj\n" + "<<\n" + "/Type /XObject\n" + "/Subtype /Form\n" + "/BBox [ %d %d %d %d ]\n" + "/Group \n<<\n/S /Transparency /CS /DeviceRGB\n" + ">>\n", + obj, + (int)gl2ps->viewport[0], (int)gl2ps->viewport[1], + (int)gl2ps->viewport[2], (int)gl2ps->viewport[3]); + + len = (childobj>0) + ? strlen("/TrSh sh\n") + (int)log10((double)childobj)+1 + : strlen("/TrSh0 sh\n"); + + offs += fprintf(gl2ps->stream, + "/Length %d\n" + ">>\n" + "stream\n", + len); + offs += fprintf(gl2ps->stream, + "/TrSh%d sh\n", + childobj); + offs += fprintf(gl2ps->stream, + "endstream\n" + "endobj\n"); + + return offs; +} + +/* Writes a Extended graphics state for a shaded triangle mask if + simplealpha ist true the childobj argument is ignored and a /ca + statement will be written instead */ + +static int gl2psPrintPDFShaderExtGS(int obj, int childobj) +{ + int offs = 0; + + offs += fprintf(gl2ps->stream, + "%d 0 obj\n" + "<<\n", + obj); + + offs += fprintf(gl2ps->stream, + "/SMask << /S /Alpha /G %d 0 R >> ", + childobj); + + offs += fprintf(gl2ps->stream, + ">>\n" + "endobj\n"); + return offs; +} + +/* a simple graphics state */ + +static int gl2psPrintPDFShaderSimpleExtGS(int obj, GLfloat alpha) +{ + int offs = 0; + + offs += fprintf(gl2ps->stream, + "%d 0 obj\n" + "<<\n" + "/ca %g" + ">>\n" + "endobj\n", + obj, alpha); + return offs; +} + +/* Similar groups of functions for pixmaps and text */ + +static int gl2psPrintPDFPixmapStreamData(GL2PSimage *im, + int (*action)(unsigned long data, int size), + int gray) +{ + int x, y, shift; + GLfloat r, g, b, a; + + if(im->format != GL_RGBA && gray) + return 0; + + if(gray && gray != 8 && gray != 16) + gray = 8; + + gray /= 8; + + shift = (sizeof(unsigned long) - 1) * 8; + + for(y = 0; y < im->height; ++y){ + for(x = 0; x < im->width; ++x){ + a = gl2psGetRGB(im, x, y, &r, &g, &b); + if(im->format == GL_RGBA && gray){ + (*action)((unsigned long)(a * 255) << shift, gray); + } + else{ + (*action)((unsigned long)(r * 255) << shift, 1); + (*action)((unsigned long)(g * 255) << shift, 1); + (*action)((unsigned long)(b * 255) << shift, 1); + } + } + } + + switch(gray){ + case 0: return 3 * im->width * im->height; + case 1: return im->width * im->height; + case 2: return 2 * im->width * im->height; + default: return 3 * im->width * im->height; + } +} + +static int gl2psPrintPDFPixmap(int obj, int childobj, GL2PSimage *im, int gray) +{ + int offs = 0, done = 0, sigbytes = 3; + + if(gray && gray !=8 && gray != 16) + gray = 8; + + if(gray) + sigbytes = gray / 8; + + offs += fprintf(gl2ps->stream, + "%d 0 obj\n" + "<<\n" + "/Type /XObject\n" + "/Subtype /Image\n" + "/Width %d\n" + "/Height %d\n" + "/ColorSpace %s \n" + "/BitsPerComponent 8\n", + obj, + (int)im->width, (int)im->height, + (gray) ? "/DeviceGray" : "/DeviceRGB" ); + if(GL_RGBA == im->format && gray == 0){ + offs += fprintf(gl2ps->stream, + "/SMask %d 0 R\n", + childobj); + } + +#if defined(GL2PS_HAVE_ZLIB) + if(gl2ps->options & GL2PS_COMPRESS){ + gl2psAllocCompress((int)(im->width * im->height * sigbytes)); + + gl2psPrintPDFPixmapStreamData(im, gl2psWriteBigEndianCompress, gray); + + if(Z_OK == gl2psDeflate() && 23 + gl2ps->compress->destLen < gl2ps->compress->srcLen){ + offs += gl2psPrintPDFCompressorType(); + offs += fprintf(gl2ps->stream, + "/Length %d " + ">>\n" + "stream\n", + (int)gl2ps->compress->destLen); + offs += gl2ps->compress->destLen * fwrite(gl2ps->compress->dest, gl2ps->compress->destLen, + 1, gl2ps->stream); + done = 1; + } + gl2psFreeCompress(); + } +#endif + + if(!done){ + /* no compression, or too long after compression, or compress error + -> write non-compressed entry */ + offs += fprintf(gl2ps->stream, + "/Length %d " + ">>\n" + "stream\n", + (int)(im->width * im->height * sigbytes)); + offs += gl2psPrintPDFPixmapStreamData(im, gl2psWriteBigEndian, gray); + } + + offs += fprintf(gl2ps->stream, + "\nendstream\n" + "endobj\n"); + + return offs; +} + +static int gl2psPrintPDFText(int obj, GL2PSstring *s, int fontnumber) +{ + int offs = 0; + + offs += fprintf(gl2ps->stream, + "%d 0 obj\n" + "<<\n" + "/Type /Font\n" + "/Subtype /Type1\n" + "/Name /F%d\n" + "/BaseFont /%s\n" + "/Encoding /MacRomanEncoding\n" + ">>\n" + "endobj\n", + obj, fontnumber, s->fontname); + return offs; +} + +/* Write the physical objects */ + +static int gl2psPDFgroupListWriteObjects(int entryoffs) +{ + int i,j; + GL2PSprimitive *p = NULL; + GL2PSpdfgroup *gro; + int offs = entryoffs; + GL2PStriangle *triangles; + int size = 0; + + if(!gl2ps->pdfgrouplist) + return offs; + + for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){ + gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i); + if(!gl2psListNbr(gro->ptrlist)) + continue; + p = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, 0); + switch(p->type){ + case GL2PS_POINT: + break; + case GL2PS_LINE: + break; + case GL2PS_TRIANGLE: + size = gl2psListNbr(gro->ptrlist); + triangles = (GL2PStriangle*)gl2psMalloc(sizeof(GL2PStriangle) * size); + for(j = 0; j < size; ++j){ + p = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j); + gl2psFillTriangleFromPrimitive(&triangles[j], p, GL_TRUE); + } + if(triangles[0].prop & T_VAR_COLOR){ + gl2ps->xreflist[gro->shobjno] = offs; + offs += gl2psPrintPDFShader(gro->shobjno, triangles, size, 0); + } + if(triangles[0].prop & T_ALPHA_LESS_1){ + gl2ps->xreflist[gro->gsobjno] = offs; + offs += gl2psPrintPDFShaderSimpleExtGS(gro->gsobjno, triangles[0].vertex[0].rgba[3]); + } + if(triangles[0].prop & T_VAR_ALPHA){ + gl2ps->xreflist[gro->gsobjno] = offs; + offs += gl2psPrintPDFShaderExtGS(gro->gsobjno, gro->trgroupobjno); + gl2ps->xreflist[gro->trgroupobjno] = offs; + offs += gl2psPrintPDFShaderMask(gro->trgroupobjno, gro->maskshno); + gl2ps->xreflist[gro->maskshobjno] = offs; + offs += gl2psPrintPDFShader(gro->maskshobjno, triangles, size, 8); + } + gl2psFree(triangles); + break; + case GL2PS_PIXMAP: + gl2ps->xreflist[gro->imobjno] = offs; + offs += gl2psPrintPDFPixmap(gro->imobjno, gro->imobjno+1, p->data.image, 0); + if(p->data.image->format == GL_RGBA){ + gl2ps->xreflist[gro->imobjno+1] = offs; + offs += gl2psPrintPDFPixmap(gro->imobjno+1, -1, p->data.image, 8); + } + break; + case GL2PS_TEXT: + gl2ps->xreflist[gro->fontobjno] = offs; + offs += gl2psPrintPDFText(gro->fontobjno,p->data.text,gro->fontno); + break; + case GL2PS_SPECIAL : + /* alignment contains the format for which the special output text + is intended */ + if(p->data.text->alignment == GL2PS_PDF) + offs += fprintf(gl2ps->stream, "%s\n", p->data.text->str); + break; + default: + break; + } + } + return offs; +} + +/* All variable data has been written at this point and all required + functioninality has been gathered, so we can write now file footer + with cross reference table and trailer */ + +static void gl2psPrintPDFFooter(void) +{ + int i, offs; + + gl2psPDFgroupListInit(); + gl2psPDFgroupListWriteMainStream(); + + offs = gl2ps->xreflist[5] + gl2ps->streamlength; + offs += gl2psClosePDFDataStream(); + gl2ps->xreflist[5] = offs; + + offs += gl2psPrintPDFDataStreamLength(gl2ps->streamlength); + gl2ps->xreflist[6] = offs; + gl2ps->streamlength = 0; + + offs += gl2psPrintPDFOpenPage(); + offs += gl2psPDFgroupListWriteVariableResources(); + gl2ps->xreflist = (int*)gl2psRealloc(gl2ps->xreflist, + sizeof(int) * (gl2ps->objects_stack + 1)); + gl2ps->xreflist[7] = offs; + + offs += gl2psPrintPDFGSObject(); + gl2ps->xreflist[8] = offs; + + gl2ps->xreflist[gl2ps->objects_stack] = + gl2psPDFgroupListWriteObjects(gl2ps->xreflist[8]); + + /* Start cross reference table. The file has to been opened in + binary mode to preserve the 20 digit string length! */ + fprintf(gl2ps->stream, + "xref\n" + "0 %d\n" + "%010d 65535 f \n", gl2ps->objects_stack, 0); + + for(i = 1; i < gl2ps->objects_stack; ++i) + fprintf(gl2ps->stream, "%010d 00000 n \n", gl2ps->xreflist[i]); + + fprintf(gl2ps->stream, + "trailer\n" + "<<\n" + "/Size %d\n" + "/Info 1 0 R\n" + "/Root 2 0 R\n" + ">>\n" + "startxref\n%d\n" + "%%%%EOF\n", + gl2ps->objects_stack, gl2ps->xreflist[gl2ps->objects_stack]); + + /* Free auxiliary lists and arrays */ + gl2psFree(gl2ps->xreflist); + gl2psListAction(gl2ps->pdfprimlist, gl2psFreePrimitive); + gl2psListDelete(gl2ps->pdfprimlist); + gl2psPDFgroupListDelete(); + +#if defined(GL2PS_HAVE_ZLIB) + if(gl2ps->options & GL2PS_COMPRESS){ + gl2psFreeCompress(); + gl2psFree(gl2ps->compress); + gl2ps->compress = NULL; + } +#endif +} + +/* PDF begin viewport */ + +static void gl2psPrintPDFBeginViewport(GLint viewport[4]) +{ + int offs = 0; + GLint index; + GLfloat rgba[4]; + int x = viewport[0], y = viewport[1], w = viewport[2], h = viewport[3]; + + glRenderMode(GL_FEEDBACK); + + if(gl2ps->header){ + gl2psPrintPDFHeader(); + gl2ps->header = GL_FALSE; + } + + offs += gl2psPrintf("q\n"); + + if(gl2ps->options & GL2PS_DRAW_BACKGROUND){ + if(gl2ps->colormode == GL_RGBA || gl2ps->colorsize == 0){ + glGetFloatv(GL_COLOR_CLEAR_VALUE, rgba); + } + else{ + glGetIntegerv(GL_INDEX_CLEAR_VALUE, &index); + rgba[0] = gl2ps->colormap[index][0]; + rgba[1] = gl2ps->colormap[index][1]; + rgba[2] = gl2ps->colormap[index][2]; + rgba[3] = 1.0F; + } + offs += gl2psPrintPDFFillColor(rgba); + offs += gl2psPrintf("%d %d %d %d re\n" + "W\n" + "f\n", + x, y, w, h); + } + else{ + offs += gl2psPrintf("%d %d %d %d re\n" + "W\n" + "n\n", + x, y, w, h); + } + + gl2ps->streamlength += offs; +} + +static GLint gl2psPrintPDFEndViewport(void) +{ + GLint res; + + res = gl2psPrintPrimitives(); + gl2ps->streamlength += gl2psPrintf("Q\n"); + return res; +} + +static void gl2psPrintPDFFinalPrimitive(void) +{ +} + +/* definition of the PDF backend */ + +static GL2PSbackend gl2psPDF = { + gl2psPrintPDFHeader, + gl2psPrintPDFFooter, + gl2psPrintPDFBeginViewport, + gl2psPrintPDFEndViewport, + gl2psPrintPDFPrimitive, + gl2psPrintPDFFinalPrimitive, + "pdf", + "Portable Document Format" +}; + +/********************************************************************* + * + * SVG routines + * + *********************************************************************/ + +static void gl2psSVGGetCoordsAndColors(int n, GL2PSvertex *verts, + GL2PSxyz *xyz, GL2PSrgba *rgba) +{ + int i, j; + + for(i = 0; i < n; i++){ + xyz[i][0] = verts[i].xyz[0]; + xyz[i][1] = gl2ps->viewport[3] - verts[i].xyz[1]; + xyz[i][2] = 0.0F; + for(j = 0; j < 4; j++) + rgba[i][j] = verts[i].rgba[j]; + } +} + +static void gl2psSVGGetColorString(GL2PSrgba rgba, char str[32]) +{ + int r = (int)(255. * rgba[0]); + int g = (int)(255. * rgba[1]); + int b = (int)(255. * rgba[2]); + int rc = (r < 0) ? 0 : (r > 255) ? 255 : r; + int gc = (g < 0) ? 0 : (g > 255) ? 255 : g; + int bc = (b < 0) ? 0 : (b > 255) ? 255 : b; + sprintf(str, "#%2.2x%2.2x%2.2x", rc, gc, bc); +} + +static void gl2psPrintSVGHeader(void) +{ + int x, y, width, height; + char col[32]; + time_t now; + + time(&now); + + if (gl2ps->options & GL2PS_LANDSCAPE){ + x = (int)gl2ps->viewport[1]; + y = (int)gl2ps->viewport[0]; + width = (int)gl2ps->viewport[3]; + height = (int)gl2ps->viewport[2]; + } + else{ + x = (int)gl2ps->viewport[0]; + y = (int)gl2ps->viewport[1]; + width = (int)gl2ps->viewport[2]; + height = (int)gl2ps->viewport[3]; + } + + /* Compressed SVG files (.svgz) are simply gzipped SVG files */ + gl2psPrintGzipHeader(); + + gl2psPrintf("\n"); + gl2psPrintf("\n", + width, height, x, y, width, height); + gl2psPrintf("%s\n", gl2ps->title); + gl2psPrintf("\n"); + gl2psPrintf("Creator: GL2PS %d.%d.%d%s, %s\n" + "For: %s\n" + "CreationDate: %s", + GL2PS_MAJOR_VERSION, GL2PS_MINOR_VERSION, GL2PS_PATCH_VERSION, + GL2PS_EXTRA_VERSION, GL2PS_COPYRIGHT, gl2ps->producer, ctime(&now)); + gl2psPrintf("\n"); + gl2psPrintf("\n"); + gl2psPrintf("\n"); + + if(gl2ps->options & GL2PS_DRAW_BACKGROUND){ + gl2psSVGGetColorString(gl2ps->bgcolor, col); + gl2psPrintf("\n", col, + (int)gl2ps->viewport[0], (int)gl2ps->viewport[1], + (int)gl2ps->viewport[2], (int)gl2ps->viewport[1], + (int)gl2ps->viewport[2], (int)gl2ps->viewport[3], + (int)gl2ps->viewport[0], (int)gl2ps->viewport[3]); + } + + /* group all the primitives and disable antialiasing */ + gl2psPrintf("\n"); +} + +static void gl2psPrintSVGSmoothTriangle(GL2PSxyz xyz[3], GL2PSrgba rgba[3]) +{ + int i; + GL2PSxyz xyz2[3]; + GL2PSrgba rgba2[3]; + char col[32]; + + /* Apparently there is no easy way to do Gouraud shading in SVG + without explicitly pre-defining gradients, so for now we just do + recursive subdivision */ + + if(gl2psSameColorThreshold(3, rgba, gl2ps->threshold)){ + gl2psSVGGetColorString(rgba[0], col); + gl2psPrintf("\n", xyz[0][0], xyz[0][1], + xyz[1][0], xyz[1][1], xyz[2][0], xyz[2][1]); + } + else{ + /* subdivide into 4 subtriangles */ + for(i = 0; i < 3; i++){ + xyz2[0][i] = xyz[0][i]; + xyz2[1][i] = 0.5F * (xyz[0][i] + xyz[1][i]); + xyz2[2][i] = 0.5F * (xyz[0][i] + xyz[2][i]); + } + for(i = 0; i < 4; i++){ + rgba2[0][i] = rgba[0][i]; + rgba2[1][i] = 0.5F * (rgba[0][i] + rgba[1][i]); + rgba2[2][i] = 0.5F * (rgba[0][i] + rgba[2][i]); + } + gl2psPrintSVGSmoothTriangle(xyz2, rgba2); + for(i = 0; i < 3; i++){ + xyz2[0][i] = 0.5F * (xyz[0][i] + xyz[1][i]); + xyz2[1][i] = xyz[1][i]; + xyz2[2][i] = 0.5F * (xyz[1][i] + xyz[2][i]); + } + for(i = 0; i < 4; i++){ + rgba2[0][i] = 0.5F * (rgba[0][i] + rgba[1][i]); + rgba2[1][i] = rgba[1][i]; + rgba2[2][i] = 0.5F * (rgba[1][i] + rgba[2][i]); + } + gl2psPrintSVGSmoothTriangle(xyz2, rgba2); + for(i = 0; i < 3; i++){ + xyz2[0][i] = 0.5F * (xyz[0][i] + xyz[2][i]); + xyz2[1][i] = xyz[2][i]; + xyz2[2][i] = 0.5F * (xyz[1][i] + xyz[2][i]); + } + for(i = 0; i < 4; i++){ + rgba2[0][i] = 0.5F * (rgba[0][i] + rgba[2][i]); + rgba2[1][i] = rgba[2][i]; + rgba2[2][i] = 0.5F * (rgba[1][i] + rgba[2][i]); + } + gl2psPrintSVGSmoothTriangle(xyz2, rgba2); + for(i = 0; i < 3; i++){ + xyz2[0][i] = 0.5F * (xyz[0][i] + xyz[1][i]); + xyz2[1][i] = 0.5F * (xyz[1][i] + xyz[2][i]); + xyz2[2][i] = 0.5F * (xyz[0][i] + xyz[2][i]); + } + for(i = 0; i < 4; i++){ + rgba2[0][i] = 0.5F * (rgba[0][i] + rgba[1][i]); + rgba2[1][i] = 0.5F * (rgba[1][i] + rgba[2][i]); + rgba2[2][i] = 0.5F * (rgba[0][i] + rgba[2][i]); + } + gl2psPrintSVGSmoothTriangle(xyz2, rgba2); + } +} + +static void gl2psPrintSVGDash(GLushort pattern, GLint factor) +{ + int i, n, array[10]; + + if(!pattern || !factor) return; /* solid line */ + + gl2psParseStipplePattern(pattern, factor, &n, array); + gl2psPrintf("stroke-dasharray=\""); + for(i = 0; i < n; i++){ + if(i) gl2psPrintf(","); + gl2psPrintf("%d", array[i]); + } + gl2psPrintf("\" "); +} + +static void gl2psEndSVGLine(void) +{ + int i; + if(gl2ps->lastvertex.rgba[0] >= 0.){ + gl2psPrintf("%g,%g\"/>\n", gl2ps->lastvertex.xyz[0], + gl2ps->viewport[3] - gl2ps->lastvertex.xyz[1]); + for(i = 0; i < 3; i++) + gl2ps->lastvertex.xyz[i] = -1.; + for(i = 0; i < 4; i++) + gl2ps->lastvertex.rgba[i] = -1.; + } +} + +static void gl2psPrintSVGPixmap(GLfloat x, GLfloat y, GL2PSimage *pixmap) +{ +#if defined(GL2PS_HAVE_LIBPNG) + GL2PSlist *png; + unsigned char c; + int i; + + /* The only image types supported by the SVG standard are JPEG, PNG + and SVG. Here we choose PNG, and since we want to embed the image + directly in the SVG stream (and not link to an external image + file), we need to encode the pixmap into PNG in memory, then + encode it into base64. */ + + png = gl2psListCreate(pixmap->width * pixmap->height * 3, 1000, + sizeof(unsigned char)); + gl2psConvertPixmapToPNG(pixmap, png); + gl2psListEncodeBase64(png); + gl2psPrintf("height, pixmap->width, pixmap->height); + gl2psPrintf("xlink:href=\"data:image/png;base64,"); + for(i = 0; i < gl2psListNbr(png); i++){ + gl2psListRead(png, i, &c); + gl2psPrintf("%c", c); + } + gl2psPrintf("\"/>\n"); + gl2psListDelete(png); +#else + (void) x; (void) y; (void) pixmap; /* not used */ + gl2psMsg(GL2PS_WARNING, "GL2PS must be compiled with PNG support in " + "order to embed images in SVG streams"); +#endif +} + +static void gl2psPrintSVGPrimitive(void *data) +{ + GL2PSprimitive *prim; + GL2PSxyz xyz[4]; + GL2PSrgba rgba[4]; + char col[32]; + int newline; + + prim = *(GL2PSprimitive**)data; + + if((gl2ps->options & GL2PS_OCCLUSION_CULL) && prim->culled) return; + + /* We try to draw connected lines as a single path to get nice line + joins and correct stippling. So if the primitive to print is not + a line we must first finish the current line (if any): */ + if(prim->type != GL2PS_LINE) gl2psEndSVGLine(); + + gl2psSVGGetCoordsAndColors(prim->numverts, prim->verts, xyz, rgba); + + switch(prim->type){ + case GL2PS_POINT : + gl2psSVGGetColorString(rgba[0], col); + gl2psPrintf("\n", + xyz[0][0], xyz[0][1], 0.5 * prim->width); + break; + case GL2PS_LINE : + if(!gl2psSamePosition(gl2ps->lastvertex.xyz, prim->verts[0].xyz) || + !gl2psSameColor(gl2ps->lastrgba, prim->verts[0].rgba) || + gl2ps->lastlinewidth != prim->width || + gl2ps->lastpattern != prim->pattern || + gl2ps->lastfactor != prim->factor){ + /* End the current line if the new segment does not start where + the last one ended, or if the color, the width or the + stippling have changed (we will need to use multi-point + gradients for smooth-shaded lines) */ + gl2psEndSVGLine(); + newline = 1; + } + else{ + newline = 0; + } + gl2ps->lastvertex = prim->verts[1]; + gl2psSetLastColor(prim->verts[0].rgba); + gl2ps->lastlinewidth = prim->width; + gl2ps->lastpattern = prim->pattern; + gl2ps->lastfactor = prim->factor; + if(newline){ + gl2psSVGGetColorString(rgba[0], col); + gl2psPrintf("width); + if(rgba[0][3] < 1.0F) gl2psPrintf("stroke-opacity=\"%g\" ", rgba[0][3]); + gl2psPrintSVGDash(prim->pattern, prim->factor); + gl2psPrintf("points=\"%g,%g ", xyz[0][0], xyz[0][1]); + } + else{ + gl2psPrintf("%g,%g ", xyz[0][0], xyz[0][1]); + } + break; + case GL2PS_TRIANGLE : + gl2psPrintSVGSmoothTriangle(xyz, rgba); + break; + case GL2PS_QUADRANGLE : + gl2psMsg(GL2PS_WARNING, "There should not be any quad left to print"); + break; + case GL2PS_PIXMAP : + gl2psPrintSVGPixmap(xyz[0][0], xyz[0][1], prim->data.image); + break; + case GL2PS_TEXT : + gl2psSVGGetColorString(prim->verts[0].rgba, col); + gl2psPrintf("data.text->fontsize); + if(prim->data.text->angle) + gl2psPrintf("transform=\"rotate(%g, %g, %g)\" ", + -prim->data.text->angle, xyz[0][0], xyz[0][1]); + switch(prim->data.text->alignment){ + case GL2PS_TEXT_C: + gl2psPrintf("text-anchor=\"middle\" baseline-shift=\"%d\" ", + -prim->data.text->fontsize / 2); + break; + case GL2PS_TEXT_CL: + gl2psPrintf("text-anchor=\"start\" baseline-shift=\"%d\" ", + -prim->data.text->fontsize / 2); + break; + case GL2PS_TEXT_CR: + gl2psPrintf("text-anchor=\"end\" baseline-shift=\"%d\" ", + -prim->data.text->fontsize / 2); + break; + case GL2PS_TEXT_B: + gl2psPrintf("text-anchor=\"middle\" baseline-shift=\"0\" "); + break; + case GL2PS_TEXT_BR: + gl2psPrintf("text-anchor=\"end\" baseline-shift=\"0\" "); + break; + case GL2PS_TEXT_T: + gl2psPrintf("text-anchor=\"middle\" baseline-shift=\"%d\" ", + -prim->data.text->fontsize); + break; + case GL2PS_TEXT_TL: + gl2psPrintf("text-anchor=\"start\" baseline-shift=\"%d\" ", + -prim->data.text->fontsize); + break; + case GL2PS_TEXT_TR: + gl2psPrintf("text-anchor=\"end\" baseline-shift=\"%d\" ", + -prim->data.text->fontsize); + break; + case GL2PS_TEXT_BL: + default: /* same as GL2PS_TEXT_BL */ + gl2psPrintf("text-anchor=\"start\" baseline-shift=\"0\" "); + break; + } + if(!strcmp(prim->data.text->fontname, "Times-Roman")) + gl2psPrintf("font-family=\"Times\">"); + else if(!strcmp(prim->data.text->fontname, "Times-Bold")) + gl2psPrintf("font-family=\"Times\" font-weight=\"bold\">"); + else if(!strcmp(prim->data.text->fontname, "Times-Italic")) + gl2psPrintf("font-family=\"Times\" font-style=\"italic\">"); + else if(!strcmp(prim->data.text->fontname, "Times-BoldItalic")) + gl2psPrintf("font-family=\"Times\" font-style=\"italic\" font-weight=\"bold\">"); + else if(!strcmp(prim->data.text->fontname, "Helvetica-Bold")) + gl2psPrintf("font-family=\"Helvetica\" font-weight=\"bold\">"); + else if(!strcmp(prim->data.text->fontname, "Helvetica-Oblique")) + gl2psPrintf("font-family=\"Helvetica\" font-style=\"oblique\">"); + else if(!strcmp(prim->data.text->fontname, "Helvetica-BoldOblique")) + gl2psPrintf("font-family=\"Helvetica\" font-style=\"oblique\" font-weight=\"bold\">"); + else if(!strcmp(prim->data.text->fontname, "Courier-Bold")) + gl2psPrintf("font-family=\"Courier\" font-weight=\"bold\">"); + else if(!strcmp(prim->data.text->fontname, "Courier-Oblique")) + gl2psPrintf("font-family=\"Courier\" font-style=\"oblique\">"); + else if(!strcmp(prim->data.text->fontname, "Courier-BoldOblique")) + gl2psPrintf("font-family=\"Courier\" font-style=\"oblique\" font-weight=\"bold\">"); + else + gl2psPrintf("font-family=\"%s\">", prim->data.text->fontname); + gl2psPrintf("%s\n", prim->data.text->str); + break; + case GL2PS_SPECIAL : + /* alignment contains the format for which the special output text + is intended */ + if(prim->data.text->alignment == GL2PS_SVG) + gl2psPrintf("%s\n", prim->data.text->str); + break; + default : + break; + } +} + +static void gl2psPrintSVGFooter(void) +{ + gl2psPrintf("\n"); + gl2psPrintf("\n"); + + gl2psPrintGzipFooter(); +} + +static void gl2psPrintSVGBeginViewport(GLint viewport[4]) +{ + GLint index; + char col[32]; + GLfloat rgba[4]; + int x = viewport[0], y = viewport[1], w = viewport[2], h = viewport[3]; + + glRenderMode(GL_FEEDBACK); + + if(gl2ps->header){ + gl2psPrintSVGHeader(); + gl2ps->header = GL_FALSE; + } + + if(gl2ps->options & GL2PS_DRAW_BACKGROUND){ + if(gl2ps->colormode == GL_RGBA || gl2ps->colorsize == 0){ + glGetFloatv(GL_COLOR_CLEAR_VALUE, rgba); + } + else{ + glGetIntegerv(GL_INDEX_CLEAR_VALUE, &index); + rgba[0] = gl2ps->colormap[index][0]; + rgba[1] = gl2ps->colormap[index][1]; + rgba[2] = gl2ps->colormap[index][2]; + rgba[3] = 1.0F; + } + gl2psSVGGetColorString(rgba, col); + gl2psPrintf("\n", col, + x, gl2ps->viewport[3] - y, + x + w, gl2ps->viewport[3] - y, + x + w, gl2ps->viewport[3] - (y + h), + x, gl2ps->viewport[3] - (y + h)); + } + + gl2psPrintf("\n", x, y, w, h); + gl2psPrintf(" \n", + x, gl2ps->viewport[3] - y, + x + w, gl2ps->viewport[3] - y, + x + w, gl2ps->viewport[3] - (y + h), + x, gl2ps->viewport[3] - (y + h)); + gl2psPrintf("\n"); + gl2psPrintf("\n", x, y, w, h); +} + +static GLint gl2psPrintSVGEndViewport(void) +{ + GLint res; + + res = gl2psPrintPrimitives(); + gl2psPrintf("\n"); + return res; +} + +static void gl2psPrintSVGFinalPrimitive(void) +{ + /* End any remaining line, if any */ + gl2psEndSVGLine(); +} + +/* definition of the SVG backend */ + +static GL2PSbackend gl2psSVG = { + gl2psPrintSVGHeader, + gl2psPrintSVGFooter, + gl2psPrintSVGBeginViewport, + gl2psPrintSVGEndViewport, + gl2psPrintSVGPrimitive, + gl2psPrintSVGFinalPrimitive, + "svg", + "Scalable Vector Graphics" +}; + +/********************************************************************* + * + * PGF routines + * + *********************************************************************/ + +static void gl2psPrintPGFColor(GL2PSrgba rgba) +{ + if(!gl2psSameColor(gl2ps->lastrgba, rgba)){ + gl2psSetLastColor(rgba); + fprintf(gl2ps->stream, "\\color[rgb]{%f,%f,%f}\n", rgba[0], rgba[1], rgba[2]); + } +} + +static void gl2psPrintPGFHeader(void) +{ + time_t now; + + time(&now); + + fprintf(gl2ps->stream, + "%% Title: %s\n" + "%% Creator: GL2PS %d.%d.%d%s, %s\n" + "%% For: %s\n" + "%% CreationDate: %s", + gl2ps->title, GL2PS_MAJOR_VERSION, GL2PS_MINOR_VERSION, + GL2PS_PATCH_VERSION, GL2PS_EXTRA_VERSION, GL2PS_COPYRIGHT, + gl2ps->producer, ctime(&now)); + + fprintf(gl2ps->stream, "\\begin{pgfpicture}\n"); + if(gl2ps->options & GL2PS_DRAW_BACKGROUND){ + gl2psPrintPGFColor(gl2ps->bgcolor); + fprintf(gl2ps->stream, + "\\pgfpathrectanglecorners{" + "\\pgfpoint{%dpt}{%dpt}}{\\pgfpoint{%dpt}{%dpt}}\n" + "\\pgfusepath{fill}\n", + (int)gl2ps->viewport[0], (int)gl2ps->viewport[1], + (int)gl2ps->viewport[2], (int)gl2ps->viewport[3]); + } +} + +static void gl2psPrintPGFDash(GLushort pattern, GLint factor) +{ + int i, n, array[10]; + + if(pattern == gl2ps->lastpattern && factor == gl2ps->lastfactor) + return; + + gl2ps->lastpattern = pattern; + gl2ps->lastfactor = factor; + + if(!pattern || !factor){ + /* solid line */ + fprintf(gl2ps->stream, "\\pgfsetdash{}{0pt}\n"); + } + else{ + gl2psParseStipplePattern(pattern, factor, &n, array); + fprintf(gl2ps->stream, "\\pgfsetdash{"); + for(i = 0; i < n; i++) fprintf(gl2ps->stream, "{%dpt}", array[i]); + fprintf(gl2ps->stream, "}{0pt}\n"); + } +} + +static const char *gl2psPGFTextAlignment(int align) +{ + switch(align){ + case GL2PS_TEXT_C : return "center"; + case GL2PS_TEXT_CL : return "west"; + case GL2PS_TEXT_CR : return "east"; + case GL2PS_TEXT_B : return "south"; + case GL2PS_TEXT_BR : return "south east"; + case GL2PS_TEXT_T : return "north"; + case GL2PS_TEXT_TL : return "north west"; + case GL2PS_TEXT_TR : return "north east"; + case GL2PS_TEXT_BL : + default : return "south west"; + } +} + +static void gl2psPrintPGFPrimitive(void *data) +{ + GL2PSprimitive *prim; + + prim = *(GL2PSprimitive**)data; + + switch(prim->type){ + case GL2PS_POINT : + /* Points in openGL are rectangular */ + gl2psPrintPGFColor(prim->verts[0].rgba); + fprintf(gl2ps->stream, + "\\pgfpathrectangle{\\pgfpoint{%fpt}{%fpt}}" + "{\\pgfpoint{%fpt}{%fpt}}\n\\pgfusepath{fill}\n", + prim->verts[0].xyz[0]-0.5*prim->width, + prim->verts[0].xyz[1]-0.5*prim->width, + prim->width,prim->width); + break; + case GL2PS_LINE : + gl2psPrintPGFColor(prim->verts[0].rgba); + if(gl2ps->lastlinewidth != prim->width){ + gl2ps->lastlinewidth = prim->width; + fprintf(gl2ps->stream, "\\pgfsetlinewidth{%fpt}\n", gl2ps->lastlinewidth); + } + gl2psPrintPGFDash(prim->pattern, prim->factor); + fprintf(gl2ps->stream, + "\\pgfpathmoveto{\\pgfpoint{%fpt}{%fpt}}\n" + "\\pgflineto{\\pgfpoint{%fpt}{%fpt}}\n" + "\\pgfusepath{stroke}\n", + prim->verts[1].xyz[0], prim->verts[1].xyz[1], + prim->verts[0].xyz[0], prim->verts[0].xyz[1]); + break; + case GL2PS_TRIANGLE : + if(gl2ps->lastlinewidth != 0){ + gl2ps->lastlinewidth = 0; + fprintf(gl2ps->stream, "\\pgfsetlinewidth{0.01pt}\n"); + } + gl2psPrintPGFColor(prim->verts[0].rgba); + fprintf(gl2ps->stream, + "\\pgfpathmoveto{\\pgfpoint{%fpt}{%fpt}}\n" + "\\pgflineto{\\pgfpoint{%fpt}{%fpt}}\n" + "\\pgflineto{\\pgfpoint{%fpt}{%fpt}}\n" + "\\pgfpathclose\n" + "\\pgfusepath{fill,stroke}\n", + prim->verts[2].xyz[0], prim->verts[2].xyz[1], + prim->verts[1].xyz[0], prim->verts[1].xyz[1], + prim->verts[0].xyz[0], prim->verts[0].xyz[1]); + break; + case GL2PS_TEXT : + fprintf(gl2ps->stream, "{\n\\pgftransformshift{\\pgfpoint{%fpt}{%fpt}}\n", + prim->verts[0].xyz[0], prim->verts[0].xyz[1]); + + if(prim->data.text->angle) + fprintf(gl2ps->stream, "\\pgftransformrotate{%f}{", prim->data.text->angle); + + fprintf(gl2ps->stream, "\\pgfnode{rectangle}{%s}{\\fontsize{%d}{0}\\selectfont", + gl2psPGFTextAlignment(prim->data.text->alignment), + prim->data.text->fontsize); + + fprintf(gl2ps->stream, "\\textcolor[rgb]{%g,%g,%g}{{%s}}", + prim->verts[0].rgba[0], prim->verts[0].rgba[1], + prim->verts[0].rgba[2], prim->data.text->str); + + fprintf(gl2ps->stream, "}{}{\\pgfusepath{discard}}}\n"); + break; + case GL2PS_SPECIAL : + /* alignment contains the format for which the special output text + is intended */ + if (prim->data.text->alignment == GL2PS_PGF) + fprintf(gl2ps->stream, "%s\n", prim->data.text->str); + break; + default : + break; + } +} + +static void gl2psPrintPGFFooter(void) +{ + fprintf(gl2ps->stream, "\\end{pgfpicture}\n"); +} + +static void gl2psPrintPGFBeginViewport(GLint viewport[4]) +{ + GLint index; + GLfloat rgba[4]; + int x = viewport[0], y = viewport[1], w = viewport[2], h = viewport[3]; + + glRenderMode(GL_FEEDBACK); + + if(gl2ps->header){ + gl2psPrintPGFHeader(); + gl2ps->header = GL_FALSE; + } + + fprintf(gl2ps->stream, "\\begin{pgfscope}\n"); + if(gl2ps->options & GL2PS_DRAW_BACKGROUND){ + if(gl2ps->colormode == GL_RGBA || gl2ps->colorsize == 0){ + glGetFloatv(GL_COLOR_CLEAR_VALUE, rgba); + } + else{ + glGetIntegerv(GL_INDEX_CLEAR_VALUE, &index); + rgba[0] = gl2ps->colormap[index][0]; + rgba[1] = gl2ps->colormap[index][1]; + rgba[2] = gl2ps->colormap[index][2]; + rgba[3] = 1.0F; + } + gl2psPrintPGFColor(rgba); + fprintf(gl2ps->stream, + "\\pgfpathrectangle{\\pgfpoint{%dpt}{%dpt}}" + "{\\pgfpoint{%dpt}{%dpt}}\n" + "\\pgfusepath{fill}\n", + x, y, w, h); + } + + fprintf(gl2ps->stream, + "\\pgfpathrectangle{\\pgfpoint{%dpt}{%dpt}}" + "{\\pgfpoint{%dpt}{%dpt}}\n" + "\\pgfusepath{clip}\n", + x, y, w, h); +} + +static GLint gl2psPrintPGFEndViewport(void) +{ + GLint res; + res = gl2psPrintPrimitives(); + fprintf(gl2ps->stream, "\\end{pgfscope}\n"); + return res; +} + +static void gl2psPrintPGFFinalPrimitive(void) +{ +} + +/* definition of the PGF backend */ + +static GL2PSbackend gl2psPGF = { + gl2psPrintPGFHeader, + gl2psPrintPGFFooter, + gl2psPrintPGFBeginViewport, + gl2psPrintPGFEndViewport, + gl2psPrintPGFPrimitive, + gl2psPrintPGFFinalPrimitive, + "tex", + "PGF Latex Graphics" +}; + +/********************************************************************* + * + * General primitive printing routine + * + *********************************************************************/ + +/* Warning: the ordering of the backends must match the format + #defines in gl2ps.h */ + +static GL2PSbackend *gl2psbackends[] = { + &gl2psPS, /* 0 */ + &gl2psEPS, /* 1 */ + &gl2psTEX, /* 2 */ + &gl2psPDF, /* 3 */ + &gl2psSVG, /* 4 */ + &gl2psPGF /* 5 */ +}; + +static void gl2psComputeTightBoundingBox(void *data) +{ + GL2PSprimitive *prim; + int i; + + prim = *(GL2PSprimitive**)data; + + for(i = 0; i < prim->numverts; i++){ + if(prim->verts[i].xyz[0] < gl2ps->viewport[0]) + gl2ps->viewport[0] = (GLint)prim->verts[i].xyz[0]; + if(prim->verts[i].xyz[0] > gl2ps->viewport[2]) + gl2ps->viewport[2] = (GLint)(prim->verts[i].xyz[0] + 0.5F); + if(prim->verts[i].xyz[1] < gl2ps->viewport[1]) + gl2ps->viewport[1] = (GLint)prim->verts[i].xyz[1]; + if(prim->verts[i].xyz[1] > gl2ps->viewport[3]) + gl2ps->viewport[3] = (GLint)(prim->verts[i].xyz[1] + 0.5F); + } +} + +static GLint gl2psPrintPrimitives(void) +{ + GL2PSbsptree *root; + GL2PSxyz eye = {0.0F, 0.0F, 100.0F * GL2PS_ZSCALE}; + GLint used; + + used = glRenderMode(GL_RENDER); + + if(used < 0){ + gl2psMsg(GL2PS_INFO, "OpenGL feedback buffer overflow"); + return GL2PS_OVERFLOW; + } + + if(used > 0) + gl2psParseFeedbackBuffer(used); + + gl2psRescaleAndOffset(); + + if(gl2ps->header){ + if(gl2psListNbr(gl2ps->primitives) && + (gl2ps->options & GL2PS_TIGHT_BOUNDING_BOX)){ + gl2ps->viewport[0] = gl2ps->viewport[1] = 100000; + gl2ps->viewport[2] = gl2ps->viewport[3] = -100000; + gl2psListAction(gl2ps->primitives, gl2psComputeTightBoundingBox); + } + (gl2psbackends[gl2ps->format]->printHeader)(); + gl2ps->header = GL_FALSE; + } + + if(!gl2psListNbr(gl2ps->primitives)){ + /* empty feedback buffer and/or nothing else to print */ + return GL2PS_NO_FEEDBACK; + } + + switch(gl2ps->sort){ + case GL2PS_NO_SORT : + gl2psListAction(gl2ps->primitives, gl2psbackends[gl2ps->format]->printPrimitive); + gl2psListAction(gl2ps->primitives, gl2psFreePrimitive); + /* reset the primitive list, waiting for the next viewport */ + gl2psListReset(gl2ps->primitives); + break; + case GL2PS_SIMPLE_SORT : + gl2psListSort(gl2ps->primitives, gl2psCompareDepth); + if(gl2ps->options & GL2PS_OCCLUSION_CULL){ + gl2psListActionInverse(gl2ps->primitives, gl2psAddInImageTree); + gl2psFreeBspImageTree(&gl2ps->imagetree); + } + gl2psListAction(gl2ps->primitives, gl2psbackends[gl2ps->format]->printPrimitive); + gl2psListAction(gl2ps->primitives, gl2psFreePrimitive); + /* reset the primitive list, waiting for the next viewport */ + gl2psListReset(gl2ps->primitives); + break; + case GL2PS_BSP_SORT : + root = (GL2PSbsptree*)gl2psMalloc(sizeof(GL2PSbsptree)); + gl2psBuildBspTree(root, gl2ps->primitives); + if(GL_TRUE == gl2ps->boundary) gl2psBuildPolygonBoundary(root); + if(gl2ps->options & GL2PS_OCCLUSION_CULL){ + gl2psTraverseBspTree(root, eye, -GL2PS_EPSILON, gl2psLess, + gl2psAddInImageTree, 1); + gl2psFreeBspImageTree(&gl2ps->imagetree); + } + gl2psTraverseBspTree(root, eye, GL2PS_EPSILON, gl2psGreater, + gl2psbackends[gl2ps->format]->printPrimitive, 0); + gl2psFreeBspTree(&root); + /* reallocate the primitive list (it's been deleted by + gl2psBuildBspTree) in case there is another viewport */ + gl2ps->primitives = gl2psListCreate(500, 500, sizeof(GL2PSprimitive*)); + break; + } + gl2psbackends[gl2ps->format]->printFinalPrimitive(); + + return GL2PS_SUCCESS; +} + +/********************************************************************* + * + * Public routines + * + *********************************************************************/ + +GL2PSDLL_API GLint gl2psBeginPage(const char *title, const char *producer, + GLint viewport[4], GLint format, GLint sort, + GLint options, GLint colormode, + GLint colorsize, GL2PSrgba *colormap, + GLint nr, GLint ng, GLint nb, GLint buffersize, + FILE *stream, const char *filename) +{ + GLint index; + int i; + + if(gl2ps){ + gl2psMsg(GL2PS_ERROR, "gl2psBeginPage called in wrong program state"); + return GL2PS_ERROR; + } + + gl2ps = (GL2PScontext*)gl2psMalloc(sizeof(GL2PScontext)); + + if(format >= 0 && format < (GLint)(sizeof(gl2psbackends) / sizeof(gl2psbackends[0]))){ + gl2ps->format = format; + } + else { + gl2psMsg(GL2PS_ERROR, "Unknown output format: %d", format); + gl2psFree(gl2ps); + gl2ps = NULL; + return GL2PS_ERROR; + } + + switch(sort){ + case GL2PS_NO_SORT : + case GL2PS_SIMPLE_SORT : + case GL2PS_BSP_SORT : + gl2ps->sort = sort; + break; + default : + gl2psMsg(GL2PS_ERROR, "Unknown sorting algorithm: %d", sort); + gl2psFree(gl2ps); + gl2ps = NULL; + return GL2PS_ERROR; + } + + if(stream){ + gl2ps->stream = stream; + } + else{ + gl2psMsg(GL2PS_ERROR, "Bad file pointer"); + gl2psFree(gl2ps); + gl2ps = NULL; + return GL2PS_ERROR; + } + + gl2ps->header = GL_TRUE; + gl2ps->maxbestroot = 10; + gl2ps->options = options; + gl2ps->compress = NULL; + gl2ps->imagemap_head = NULL; + gl2ps->imagemap_tail = NULL; + + if(gl2ps->options & GL2PS_USE_CURRENT_VIEWPORT){ + glGetIntegerv(GL_VIEWPORT, gl2ps->viewport); + } + else{ + for(i = 0; i < 4; i++){ + gl2ps->viewport[i] = viewport[i]; + } + } + + if(!gl2ps->viewport[2] || !gl2ps->viewport[3]){ + gl2psMsg(GL2PS_ERROR, "Incorrect viewport (x=%d, y=%d, width=%d, height=%d)", + gl2ps->viewport[0], gl2ps->viewport[1], + gl2ps->viewport[2], gl2ps->viewport[3]); + gl2psFree(gl2ps); + gl2ps = NULL; + return GL2PS_ERROR; + } + + gl2ps->threshold[0] = nr ? 1.0F / (GLfloat)nr : 0.064F; + gl2ps->threshold[1] = ng ? 1.0F / (GLfloat)ng : 0.034F; + gl2ps->threshold[2] = nb ? 1.0F / (GLfloat)nb : 0.100F; + gl2ps->colormode = colormode; + gl2ps->buffersize = buffersize > 0 ? buffersize : 2048 * 2048; + for(i = 0; i < 3; i++){ + gl2ps->lastvertex.xyz[i] = -1.0F; + } + for(i = 0; i < 4; i++){ + gl2ps->lastvertex.rgba[i] = -1.0F; + gl2ps->lastrgba[i] = -1.0F; + } + gl2ps->lastlinewidth = -1.0F; + gl2ps->lastpattern = 0; + gl2ps->lastfactor = 0; + gl2ps->imagetree = NULL; + gl2ps->primitivetoadd = NULL; + gl2ps->zerosurfacearea = GL_FALSE; + gl2ps->pdfprimlist = NULL; + gl2ps->pdfgrouplist = NULL; + gl2ps->xreflist = NULL; + + /* get default blending mode from current OpenGL state (enabled by + default for SVG) */ + gl2ps->blending = (gl2ps->format == GL2PS_SVG) ? GL_TRUE : glIsEnabled(GL_BLEND); + glGetIntegerv(GL_BLEND_SRC, &gl2ps->blendfunc[0]); + glGetIntegerv(GL_BLEND_DST, &gl2ps->blendfunc[1]); + + if(gl2ps->colormode == GL_RGBA){ + gl2ps->colorsize = 0; + gl2ps->colormap = NULL; + glGetFloatv(GL_COLOR_CLEAR_VALUE, gl2ps->bgcolor); + } + else if(gl2ps->colormode == GL_COLOR_INDEX){ + if(!colorsize || !colormap){ + gl2psMsg(GL2PS_ERROR, "Missing colormap for GL_COLOR_INDEX rendering"); + gl2psFree(gl2ps); + gl2ps = NULL; + return GL2PS_ERROR; + } + gl2ps->colorsize = colorsize; + gl2ps->colormap = (GL2PSrgba*)gl2psMalloc(gl2ps->colorsize * sizeof(GL2PSrgba)); + memcpy(gl2ps->colormap, colormap, gl2ps->colorsize * sizeof(GL2PSrgba)); + glGetIntegerv(GL_INDEX_CLEAR_VALUE, &index); + gl2ps->bgcolor[0] = gl2ps->colormap[index][0]; + gl2ps->bgcolor[1] = gl2ps->colormap[index][1]; + gl2ps->bgcolor[2] = gl2ps->colormap[index][2]; + gl2ps->bgcolor[3] = 1.0F; + } + else{ + gl2psMsg(GL2PS_ERROR, "Unknown color mode in gl2psBeginPage"); + gl2psFree(gl2ps); + gl2ps = NULL; + return GL2PS_ERROR; + } + + if(!title){ + gl2ps->title = (char*)gl2psMalloc(sizeof(char)); + gl2ps->title[0] = '\0'; + } + else{ + gl2ps->title = (char*)gl2psMalloc((strlen(title)+1)*sizeof(char)); + strcpy(gl2ps->title, title); + } + + if(!producer){ + gl2ps->producer = (char*)gl2psMalloc(sizeof(char)); + gl2ps->producer[0] = '\0'; + } + else{ + gl2ps->producer = (char*)gl2psMalloc((strlen(producer)+1)*sizeof(char)); + strcpy(gl2ps->producer, producer); + } + + if(!filename){ + gl2ps->filename = (char*)gl2psMalloc(sizeof(char)); + gl2ps->filename[0] = '\0'; + } + else{ + gl2ps->filename = (char*)gl2psMalloc((strlen(filename)+1)*sizeof(char)); + strcpy(gl2ps->filename, filename); + } + + gl2ps->primitives = gl2psListCreate(500, 500, sizeof(GL2PSprimitive*)); + gl2ps->auxprimitives = gl2psListCreate(100, 100, sizeof(GL2PSprimitive*)); + gl2ps->feedback = (GLfloat*)gl2psMalloc(gl2ps->buffersize * sizeof(GLfloat)); + glFeedbackBuffer(gl2ps->buffersize, GL_3D_COLOR, gl2ps->feedback); + glRenderMode(GL_FEEDBACK); + + return GL2PS_SUCCESS; +} + +GL2PSDLL_API GLint gl2psEndPage(void) +{ + GLint res; + + if(!gl2ps) return GL2PS_UNINITIALIZED; + + res = gl2psPrintPrimitives(); + + if(res != GL2PS_OVERFLOW) + (gl2psbackends[gl2ps->format]->printFooter)(); + + fflush(gl2ps->stream); + + gl2psListDelete(gl2ps->primitives); + gl2psListDelete(gl2ps->auxprimitives); + gl2psFreeImagemap(gl2ps->imagemap_head); + gl2psFree(gl2ps->colormap); + gl2psFree(gl2ps->title); + gl2psFree(gl2ps->producer); + gl2psFree(gl2ps->filename); + gl2psFree(gl2ps->feedback); + gl2psFree(gl2ps); + gl2ps = NULL; + + return res; +} + +GL2PSDLL_API GLint gl2psBeginViewport(GLint viewport[4]) +{ + if(!gl2ps) return GL2PS_UNINITIALIZED; + + (gl2psbackends[gl2ps->format]->beginViewport)(viewport); + + return GL2PS_SUCCESS; +} + +GL2PSDLL_API GLint gl2psEndViewport(void) +{ + GLint res; + + if(!gl2ps) return GL2PS_UNINITIALIZED; + + res = (gl2psbackends[gl2ps->format]->endViewport)(); + + /* reset last used colors, line widths */ + gl2ps->lastlinewidth = -1.0F; + + return res; +} + +GL2PSDLL_API GLint gl2psTextOpt(const char *str, const char *fontname, + GLshort fontsize, GLint alignment, GLfloat angle) +{ + return gl2psAddText(GL2PS_TEXT, str, fontname, fontsize, alignment, angle); +} + +GL2PSDLL_API GLint gl2psText(const char *str, const char *fontname, GLshort fontsize) +{ + return gl2psAddText(GL2PS_TEXT, str, fontname, fontsize, GL2PS_TEXT_BL, 0.0F); +} + +GL2PSDLL_API GLint gl2psSpecial(GLint format, const char *str) +{ + return gl2psAddText(GL2PS_SPECIAL, str, "", 0, format, 0.0F); +} + +GL2PSDLL_API GLint gl2psDrawPixels(GLsizei width, GLsizei height, + GLint xorig, GLint yorig, + GLenum format, GLenum type, + const void *pixels) +{ + int size, i; + const GLfloat *piv; + GLfloat pos[4], zoom_x, zoom_y; + GL2PSprimitive *prim; + GLboolean valid; + + if(!gl2ps || !pixels) return GL2PS_UNINITIALIZED; + + if((width <= 0) || (height <= 0)) return GL2PS_ERROR; + + if(gl2ps->options & GL2PS_NO_PIXMAP) return GL2PS_SUCCESS; + + if((format != GL_RGB && format != GL_RGBA) || type != GL_FLOAT){ + gl2psMsg(GL2PS_ERROR, "gl2psDrawPixels only implemented for " + "GL_RGB/GL_RGBA, GL_FLOAT pixels"); + return GL2PS_ERROR; + } + + glGetBooleanv(GL_CURRENT_RASTER_POSITION_VALID, &valid); + if(GL_FALSE == valid) return GL2PS_SUCCESS; /* the primitive is culled */ + + glGetFloatv(GL_CURRENT_RASTER_POSITION, pos); + glGetFloatv(GL_ZOOM_X, &zoom_x); + glGetFloatv(GL_ZOOM_Y, &zoom_y); + + prim = (GL2PSprimitive*)gl2psMalloc(sizeof(GL2PSprimitive)); + prim->type = GL2PS_PIXMAP; + prim->boundary = 0; + prim->numverts = 1; + prim->verts = (GL2PSvertex*)gl2psMalloc(sizeof(GL2PSvertex)); + prim->verts[0].xyz[0] = pos[0] + xorig; + prim->verts[0].xyz[1] = pos[1] + yorig; + prim->verts[0].xyz[2] = pos[2]; + prim->culled = 0; + prim->offset = 0; + prim->pattern = 0; + prim->factor = 0; + prim->width = 1; + glGetFloatv(GL_CURRENT_RASTER_COLOR, prim->verts[0].rgba); + prim->data.image = (GL2PSimage*)gl2psMalloc(sizeof(GL2PSimage)); + prim->data.image->width = width; + prim->data.image->height = height; + prim->data.image->zoom_x = zoom_x; + prim->data.image->zoom_y = zoom_y; + prim->data.image->format = format; + prim->data.image->type = type; + + switch(format){ + case GL_RGBA: + if(gl2ps->options & GL2PS_NO_BLENDING || !gl2ps->blending){ + /* special case: blending turned off */ + prim->data.image->format = GL_RGB; + size = height * width * 3; + prim->data.image->pixels = (GLfloat*)gl2psMalloc(size * sizeof(GLfloat)); + piv = (const GLfloat*)pixels; + for(i = 0; i < size; ++i, ++piv){ + prim->data.image->pixels[i] = *piv; + if(!((i + 1) % 3)) + ++piv; + } + } + else{ + size = height * width * 4; + prim->data.image->pixels = (GLfloat*)gl2psMalloc(size * sizeof(GLfloat)); + memcpy(prim->data.image->pixels, pixels, size * sizeof(GLfloat)); + } + break; + case GL_RGB: + default: + size = height * width * 3; + prim->data.image->pixels = (GLfloat*)gl2psMalloc(size * sizeof(GLfloat)); + memcpy(prim->data.image->pixels, pixels, size * sizeof(GLfloat)); + break; + } + + gl2psListAdd(gl2ps->auxprimitives, &prim); + glPassThrough(GL2PS_DRAW_PIXELS_TOKEN); + + return GL2PS_SUCCESS; +} + +GL2PSDLL_API GLint gl2psDrawImageMap(GLsizei width, GLsizei height, + const GLfloat position[3], + const unsigned char *imagemap){ + int size, i; + int sizeoffloat = sizeof(GLfloat); + + if(!gl2ps || !imagemap) return GL2PS_UNINITIALIZED; + + if((width <= 0) || (height <= 0)) return GL2PS_ERROR; + + size = height + height * ((width - 1) / 8); + glPassThrough(GL2PS_IMAGEMAP_TOKEN); + glBegin(GL_POINTS); + glVertex3f(position[0], position[1],position[2]); + glEnd(); + glPassThrough((GLfloat)width); + glPassThrough((GLfloat)height); + for(i = 0; i < size; i += sizeoffloat){ + const float *value = (const float*)imagemap; + glPassThrough(*value); + imagemap += sizeoffloat; + } + return GL2PS_SUCCESS; +} + +GL2PSDLL_API GLint gl2psEnable(GLint mode) +{ + GLint tmp; + + if(!gl2ps) return GL2PS_UNINITIALIZED; + + switch(mode){ + case GL2PS_POLYGON_OFFSET_FILL : + glPassThrough(GL2PS_BEGIN_OFFSET_TOKEN); + glGetFloatv(GL_POLYGON_OFFSET_FACTOR, &gl2ps->offset[0]); + glGetFloatv(GL_POLYGON_OFFSET_UNITS, &gl2ps->offset[1]); + break; + case GL2PS_POLYGON_BOUNDARY : + glPassThrough(GL2PS_BEGIN_BOUNDARY_TOKEN); + break; + case GL2PS_LINE_STIPPLE : + glPassThrough(GL2PS_BEGIN_STIPPLE_TOKEN); + glGetIntegerv(GL_LINE_STIPPLE_PATTERN, &tmp); + glPassThrough((GLfloat)tmp); + glGetIntegerv(GL_LINE_STIPPLE_REPEAT, &tmp); + glPassThrough((GLfloat)tmp); + break; + case GL2PS_BLEND : + glPassThrough(GL2PS_BEGIN_BLEND_TOKEN); + break; + default : + gl2psMsg(GL2PS_WARNING, "Unknown mode in gl2psEnable: %d", mode); + return GL2PS_WARNING; + } + + return GL2PS_SUCCESS; +} + +GL2PSDLL_API GLint gl2psDisable(GLint mode) +{ + if(!gl2ps) return GL2PS_UNINITIALIZED; + + switch(mode){ + case GL2PS_POLYGON_OFFSET_FILL : + glPassThrough(GL2PS_END_OFFSET_TOKEN); + break; + case GL2PS_POLYGON_BOUNDARY : + glPassThrough(GL2PS_END_BOUNDARY_TOKEN); + break; + case GL2PS_LINE_STIPPLE : + glPassThrough(GL2PS_END_STIPPLE_TOKEN); + break; + case GL2PS_BLEND : + glPassThrough(GL2PS_END_BLEND_TOKEN); + break; + default : + gl2psMsg(GL2PS_WARNING, "Unknown mode in gl2psDisable: %d", mode); + return GL2PS_WARNING; + } + + return GL2PS_SUCCESS; +} + +GL2PSDLL_API GLint gl2psPointSize(GLfloat value) +{ + if(!gl2ps) return GL2PS_UNINITIALIZED; + + glPassThrough(GL2PS_POINT_SIZE_TOKEN); + glPassThrough(value); + + return GL2PS_SUCCESS; +} + +GL2PSDLL_API GLint gl2psLineWidth(GLfloat value) +{ + if(!gl2ps) return GL2PS_UNINITIALIZED; + + glPassThrough(GL2PS_LINE_WIDTH_TOKEN); + glPassThrough(value); + + return GL2PS_SUCCESS; +} + +GL2PSDLL_API GLint gl2psBlendFunc(GLenum sfactor, GLenum dfactor) +{ + if(!gl2ps) return GL2PS_UNINITIALIZED; + + if(GL_FALSE == gl2psSupportedBlendMode(sfactor, dfactor)) + return GL2PS_WARNING; + + glPassThrough(GL2PS_SRC_BLEND_TOKEN); + glPassThrough((GLfloat)sfactor); + glPassThrough(GL2PS_DST_BLEND_TOKEN); + glPassThrough((GLfloat)dfactor); + + return GL2PS_SUCCESS; +} + +GL2PSDLL_API GLint gl2psSetOptions(GLint options) +{ + if(!gl2ps) return GL2PS_UNINITIALIZED; + + gl2ps->options = options; + + return GL2PS_SUCCESS; +} + +GL2PSDLL_API GLint gl2psGetOptions(GLint *options) +{ + if(!gl2ps) { + *options = 0; + return GL2PS_UNINITIALIZED; + } + + *options = gl2ps->options; + + return GL2PS_SUCCESS; +} + +GL2PSDLL_API const char *gl2psGetFileExtension(GLint format) +{ + if(format >= 0 && format < (GLint)(sizeof(gl2psbackends) / sizeof(gl2psbackends[0]))) + return gl2psbackends[format]->file_extension; + else + return "Unknown format"; +} + +GL2PSDLL_API const char *gl2psGetFormatDescription(GLint format) +{ + if(format >= 0 && format < (GLint)(sizeof(gl2psbackends) / sizeof(gl2psbackends[0]))) + return gl2psbackends[format]->description; + else + return "Unknown format"; +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/gl2ps.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/gl2ps.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,200 @@ +/* + * GL2PS, an OpenGL to PostScript Printing Library + * Copyright (C) 1999-2011 C. Geuzaine + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of either: + * + * a) the GNU Library General Public License as published by the Free + * Software Foundation, either version 2 of the License, or (at your + * option) any later version; or + * + * b) the GL2PS License as published by Christophe Geuzaine, either + * version 2 of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either + * the GNU Library General Public License or the GL2PS License for + * more details. + * + * You should have received a copy of the GNU Library General Public + * License along with this library in the file named "COPYING.LGPL"; + * if not, write to the Free Software Foundation, Inc., 675 Mass Ave, + * Cambridge, MA 02139, USA. + * + * You should have received a copy of the GL2PS License with this + * library in the file named "COPYING.GL2PS"; if not, I will be glad + * to provide one. + * + * For the latest info about gl2ps and a full list of contributors, + * see http://www.geuz.org/gl2ps/. + * + * Please report all bugs and problems to . + */ + +#ifndef __GL2PS_H__ +#define __GL2PS_H__ + +#include +#include + +/* Define GL2PSDLL at compile time to build a Windows DLL */ + +#if defined(WIN32) || defined(_WIN32) || defined(__WIN32__) || defined(__NT__) +# if defined(_MSC_VER) +# pragma warning(disable:4115) +# pragma warning(disable:4996) +# endif +# define WIN32_LEAN_AND_MEAN +# include +# if defined(GL2PSDLL) +# if defined(GL2PSDLL_EXPORTS) +# define GL2PSDLL_API __declspec(dllexport) +# else +# define GL2PSDLL_API __declspec(dllimport) +# endif +# else +# define GL2PSDLL_API +# endif +#else +# define GL2PSDLL_API +#endif + +#if defined(__APPLE__) || defined(HAVE_OPENGL_GL_H) +# include +#else +# include +#endif + +/* Support for compressed PostScript/PDF/SVG and for embedded PNG + images in SVG */ + +#if defined(HAVE_ZLIB) || defined(HAVE_LIBZ) +# define GL2PS_HAVE_ZLIB +# if defined(HAVE_LIBPNG) || defined(HAVE_PNG) +# define GL2PS_HAVE_LIBPNG +# endif +#endif + +/* Version number */ + +#define GL2PS_MAJOR_VERSION 1 +#define GL2PS_MINOR_VERSION 3 +#define GL2PS_PATCH_VERSION 6 +#define GL2PS_EXTRA_VERSION "" + +#define GL2PS_VERSION (GL2PS_MAJOR_VERSION + \ + 0.01 * GL2PS_MINOR_VERSION + \ + 0.0001 * GL2PS_PATCH_VERSION) + +#define GL2PS_COPYRIGHT "(C) 1999-2011 C. Geuzaine" + +/* Output file formats (the values and the ordering are important!) */ + +#define GL2PS_PS 0 +#define GL2PS_EPS 1 +#define GL2PS_TEX 2 +#define GL2PS_PDF 3 +#define GL2PS_SVG 4 +#define GL2PS_PGF 5 + +/* Sorting algorithms */ + +#define GL2PS_NO_SORT 1 +#define GL2PS_SIMPLE_SORT 2 +#define GL2PS_BSP_SORT 3 + +/* Message levels and error codes */ + +#define GL2PS_SUCCESS 0 +#define GL2PS_INFO 1 +#define GL2PS_WARNING 2 +#define GL2PS_ERROR 3 +#define GL2PS_NO_FEEDBACK 4 +#define GL2PS_OVERFLOW 5 +#define GL2PS_UNINITIALIZED 6 + +/* Options for gl2psBeginPage */ + +#define GL2PS_NONE 0 +#define GL2PS_DRAW_BACKGROUND (1<<0) +#define GL2PS_SIMPLE_LINE_OFFSET (1<<1) +#define GL2PS_SILENT (1<<2) +#define GL2PS_BEST_ROOT (1<<3) +#define GL2PS_OCCLUSION_CULL (1<<4) +#define GL2PS_NO_TEXT (1<<5) +#define GL2PS_LANDSCAPE (1<<6) +#define GL2PS_NO_PS3_SHADING (1<<7) +#define GL2PS_NO_PIXMAP (1<<8) +#define GL2PS_USE_CURRENT_VIEWPORT (1<<9) +#define GL2PS_COMPRESS (1<<10) +#define GL2PS_NO_BLENDING (1<<11) +#define GL2PS_TIGHT_BOUNDING_BOX (1<<12) + +/* Arguments for gl2psEnable/gl2psDisable */ + +#define GL2PS_POLYGON_OFFSET_FILL 1 +#define GL2PS_POLYGON_BOUNDARY 2 +#define GL2PS_LINE_STIPPLE 3 +#define GL2PS_BLEND 4 + +/* Text alignment (o=raster position; default mode is BL): + +---+ +---+ +---+ +---+ +---+ +---+ +-o-+ o---+ +---o + | o | o | | o | | | | | | | | | | | | + +---+ +---+ +---+ +-o-+ o---+ +---o +---+ +---+ +---+ + C CL CR B BL BR T TL TR */ + +#define GL2PS_TEXT_C 1 +#define GL2PS_TEXT_CL 2 +#define GL2PS_TEXT_CR 3 +#define GL2PS_TEXT_B 4 +#define GL2PS_TEXT_BL 5 +#define GL2PS_TEXT_BR 6 +#define GL2PS_TEXT_T 7 +#define GL2PS_TEXT_TL 8 +#define GL2PS_TEXT_TR 9 + +typedef GLfloat GL2PSrgba[4]; + +#if defined(__cplusplus) +extern "C" { +#endif + +GL2PSDLL_API GLint gl2psBeginPage(const char *title, const char *producer, + GLint viewport[4], GLint format, GLint sort, + GLint options, GLint colormode, + GLint colorsize, GL2PSrgba *colormap, + GLint nr, GLint ng, GLint nb, GLint buffersize, + FILE *stream, const char *filename); +GL2PSDLL_API GLint gl2psEndPage(void); +GL2PSDLL_API GLint gl2psSetOptions(GLint options); +GL2PSDLL_API GLint gl2psGetOptions(GLint *options); +GL2PSDLL_API GLint gl2psBeginViewport(GLint viewport[4]); +GL2PSDLL_API GLint gl2psEndViewport(void); +GL2PSDLL_API GLint gl2psText(const char *str, const char *fontname, + GLshort fontsize); +GL2PSDLL_API GLint gl2psTextOpt(const char *str, const char *fontname, + GLshort fontsize, GLint align, GLfloat angle); +GL2PSDLL_API GLint gl2psSpecial(GLint format, const char *str); +GL2PSDLL_API GLint gl2psDrawPixels(GLsizei width, GLsizei height, + GLint xorig, GLint yorig, + GLenum format, GLenum type, const void *pixels); +GL2PSDLL_API GLint gl2psEnable(GLint mode); +GL2PSDLL_API GLint gl2psDisable(GLint mode); +GL2PSDLL_API GLint gl2psPointSize(GLfloat value); +GL2PSDLL_API GLint gl2psLineWidth(GLfloat value); +GL2PSDLL_API GLint gl2psBlendFunc(GLenum sfactor, GLenum dfactor); + +/* undocumented */ +GL2PSDLL_API GLint gl2psDrawImageMap(GLsizei width, GLsizei height, + const GLfloat position[3], + const unsigned char *imagemap); +GL2PSDLL_API const char *gl2psGetFileExtension(GLint format); +GL2PSDLL_API const char *gl2psGetFormatDescription(GLint format); + +#if defined(__cplusplus) +} +#endif + +#endif /* __GL2PS_H__ */ diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/graphics.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/graphics.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,10468 @@ +/* + +Copyright (C) 2007-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include +#include + +#include +#include +#include +#include +#include +#include + +#include "cmd-edit.h" +#include "file-ops.h" +#include "file-stat.h" +#include "oct-locbuf.h" +#include "singleton-cleanup.h" + +#include "builtins.h" +#include "cutils.h" +#include "defun.h" +#include "display.h" +#include "error.h" +#include "graphics.h" +#include "input.h" +#include "ov.h" +#include "oct-obj.h" +#include "oct-map.h" +#include "ov-fcn-handle.h" +#include "pager.h" +#include "parse.h" +#include "toplev.h" +#include "txt-eng-ft.h" +#include "unwind-prot.h" + +// forward declarations +static octave_value xget (const graphics_handle& h, const caseless_str& name); + +static void +gripe_set_invalid (const std::string& pname) +{ + error ("set: invalid value for %s property", pname.c_str ()); +} + +// Check to see that PNAME matches just one of PNAMES uniquely. +// Return the full name of the match, or an empty caseless_str object +// if there is no match, or the match is ambiguous. + +static caseless_str +validate_property_name (const std::string& who, const std::string& what, + const std::set& pnames, + const caseless_str& pname) +{ + size_t len = pname.length (); + std::set matches; + + for (std::set::const_iterator p = pnames.begin (); + p != pnames.end (); p++) + { + if (pname.compare (*p, len)) + { + if (len == p->length ()) + { + // Exact match. + return pname; + } + + matches.insert (*p); + } + } + + size_t num_matches = matches.size (); + + if (num_matches == 0) + { + error ("%s: unknown %s property %s", + who.c_str (), what.c_str (), pname.c_str ()); + } + else if (num_matches > 1) + { + string_vector sv (matches); + + std::ostringstream os; + + sv.list_in_columns (os); + + std::string match_list = os.str (); + + error ("%s: ambiguous %s property name %s; possible matches:\n\n%s", + who.c_str (), what.c_str (), pname.c_str (), match_list.c_str ()); + } + else if (num_matches == 1) + { + // Exact match was handled above. + + std::string possible_match = *(matches.begin ()); + + warning_with_id ("Octave:abbreviated-property-match", + "%s: allowing %s to match %s property %s", + who.c_str (), pname.c_str (), what.c_str (), + possible_match.c_str ()); + + return possible_match; + } + + return caseless_str (); +} + +static Matrix +jet_colormap (void) +{ + Matrix cmap (64, 3, 0.0); + + // Produce X in the same manner as linspace so that + // jet_colormap and jet.m produce *exactly* the same result. + double delta = 1.0 / 63.0; + + for (octave_idx_type i = 0; i < 64; i++) + { + // This is the jet colormap. It would be nice to be able + // to feval the jet function but since there is a static + // property object that includes a colormap_property + // object, we need to initialize this before main is even + // called, so calling an interpreted function is not + // possible. + + double x = i*delta; + + if (x >= 3.0/8.0 && x < 5.0/8.0) + cmap(i,0) = 4.0 * x - 3.0/2.0; + else if (x >= 5.0/8.0 && x < 7.0/8.0) + cmap(i,0) = 1.0; + else if (x >= 7.0/8.0) + cmap(i,0) = -4.0 * x + 9.0/2.0; + + if (x >= 1.0/8.0 && x < 3.0/8.0) + cmap(i,1) = 4.0 * x - 1.0/2.0; + else if (x >= 3.0/8.0 && x < 5.0/8.0) + cmap(i,1) = 1.0; + else if (x >= 5.0/8.0 && x < 7.0/8.0) + cmap(i,1) = -4.0 * x + 7.0/2.0; + + if (x < 1.0/8.0) + cmap(i,2) = 4.0 * x + 1.0/2.0; + else if (x >= 1.0/8.0 && x < 3.0/8.0) + cmap(i,2) = 1.0; + else if (x >= 3.0/8.0 && x < 5.0/8.0) + cmap(i,2) = -4.0 * x + 5.0/2.0; + } + + return cmap; +} + +static double +default_screendepth (void) +{ + return display_info::depth (); +} + +static Matrix +default_screensize (void) +{ + Matrix retval (1, 4, 1.0); + + retval(2) = display_info::width (); + retval(3) = display_info::height (); + + return retval; +} + +static double +default_screenpixelsperinch (void) +{ + return (display_info::x_dpi () + display_info::y_dpi ()) / 2; +} + +static Matrix +default_colororder (void) +{ + Matrix retval (7, 3, 0.0); + + retval(0,2) = 1.0; + + retval(1,1) = 0.5; + + retval(2,0) = 1.0; + + retval(3,1) = 0.75; + retval(3,2) = 0.75; + + retval(4,0) = 0.75; + retval(4,2) = 0.75; + + retval(5,0) = 0.75; + retval(5,1) = 0.75; + + retval(6,0) = 0.25; + retval(6,1) = 0.25; + retval(6,2) = 0.25; + + return retval; +} + +static Matrix +default_lim (bool logscale = false) +{ + Matrix m (1, 2, 0); + + if (logscale) + { + m(0) = 0.1; + m(1) = 1.0; + } + else + m(1) = 1; + + return m; +} + +static Matrix +default_data (void) +{ + Matrix retval (1, 2); + + retval(0) = 0; + retval(1) = 1; + + return retval; +} + +static Matrix +default_axes_position (void) +{ + Matrix m (1, 4, 0.0); + m(0) = 0.13; + m(1) = 0.11; + m(2) = 0.775; + m(3) = 0.815; + return m; +} + +static Matrix +default_axes_outerposition (void) +{ + Matrix m (1, 4, 0.0); + m(2) = m(3) = 1.0; + return m; +} + +static Matrix +default_axes_tick (void) +{ + Matrix m (1, 6, 0.0); + m(0) = 0.0; + m(1) = 0.2; + m(2) = 0.4; + m(3) = 0.6; + m(4) = 0.8; + m(5) = 1.0; + return m; +} + +static Matrix +default_axes_ticklength (void) +{ + Matrix m (1, 2, 0.0); + m(0) = 0.01; + m(1) = 0.025; + return m; +} + +static Matrix +default_figure_position (void) +{ + Matrix m (1, 4, 0.0); + m(0) = 300; + m(1) = 200; + m(2) = 560; + m(3) = 420; + return m; +} + +static Matrix +default_figure_papersize (void) +{ + Matrix m (1, 2, 0.0); + m(0) = 8.5; + m(1) = 11.0; + return m; +} + +static Matrix +default_figure_paperposition (void) +{ + Matrix m (1, 4, 0.0); + m(0) = 0.25; + m(1) = 2.50; + m(2) = 8.00; + m(3) = 6.00; + return m; +} + +static Matrix +default_control_position (void) +{ + Matrix retval (1, 4, 0.0); + + retval(0) = 0; + retval(1) = 0; + retval(2) = 80; + retval(3) = 30; + + return retval; +} + +static Matrix +default_control_sliderstep (void) +{ + Matrix retval (1, 2, 0.0); + + retval(0) = 0.01; + retval(1) = 0.1; + + return retval; +} + +static Matrix +default_panel_position (void) +{ + Matrix retval (1, 4, 0.0); + + retval(0) = 0; + retval(1) = 0; + retval(2) = 0.5; + retval(3) = 0.5; + + return retval; +} + +static double +convert_font_size (double font_size, const caseless_str& from_units, + const caseless_str& to_units, double parent_height = 0) +{ + // Simple case where from_units == to_units + + if (from_units.compare (to_units)) + return font_size; + + // Converts the given fontsize using the following transformation: + // => points => + + double points_size = 0; + double res = 0; + + if (from_units.compare ("points")) + points_size = font_size; + else + { + res = xget (0, "screenpixelsperinch").double_value (); + + if (from_units.compare ("pixels")) + points_size = font_size * 72.0 / res; + else if (from_units.compare ("inches")) + points_size = font_size * 72.0; + else if (from_units.compare ("centimeters")) + points_size = font_size * 72.0 / 2.54; + else if (from_units.compare ("normalized")) + points_size = font_size * parent_height * 72.0 / res; + } + + double new_font_size = 0; + + if (to_units.compare ("points")) + new_font_size = points_size; + else + { + if (res <= 0) + res = xget (0, "screenpixelsperinch").double_value (); + + if (to_units.compare ("pixels")) + new_font_size = points_size * res / 72.0; + else if (to_units.compare ("inches")) + new_font_size = points_size / 72.0; + else if (to_units.compare ("centimeters")) + new_font_size = points_size * 2.54 / 72.0; + else if (to_units.compare ("normalized")) + { + // Avoid setting font size to (0/0) = NaN + + if (parent_height > 0) + new_font_size = points_size * res / (parent_height * 72.0); + } + } + + return new_font_size; +} + +static Matrix +convert_position (const Matrix& pos, const caseless_str& from_units, + const caseless_str& to_units, const Matrix& parent_dim) +{ + Matrix retval (1, pos.numel ()); + double res = 0; + bool is_rectangle = (pos.numel () == 4); + bool is_2d = (pos.numel () == 2); + + if (from_units.compare ("pixels")) + retval = pos; + else if (from_units.compare ("normalized")) + { + retval(0) = pos(0) * parent_dim(0) + 1; + retval(1) = pos(1) * parent_dim(1) + 1; + if (is_rectangle) + { + retval(2) = pos(2) * parent_dim(0); + retval(3) = pos(3) * parent_dim(1); + } + else if (! is_2d) + retval(2) = 0; + } + else if (from_units.compare ("characters")) + { + if (res <= 0) + res = xget (0, "screenpixelsperinch").double_value (); + + double f = 0.0; + + // FIXME -- this assumes the system font is Helvetica 10pt + // (for which "x" requires 6x12 pixels at 74.951 pixels/inch) + f = 12.0 * res / 74.951; + + if (f > 0) + { + retval(0) = 0.5 * pos(0) * f; + retval(1) = pos(1) * f; + if (is_rectangle) + { + retval(2) = 0.5 * pos(2) * f; + retval(3) = pos(3) * f; + } + else if (! is_2d) + retval(2) = 0; + } + } + else + { + if (res <= 0) + res = xget (0, "screenpixelsperinch").double_value (); + + double f = 0.0; + + if (from_units.compare ("points")) + f = res / 72.0; + else if (from_units.compare ("inches")) + f = res; + else if (from_units.compare ("centimeters")) + f = res / 2.54; + + if (f > 0) + { + retval(0) = pos(0) * f + 1; + retval(1) = pos(1) * f + 1; + if (is_rectangle) + { + retval(2) = pos(2) * f; + retval(3) = pos(3) * f; + } + else if (! is_2d) + retval(2) = 0; + } + } + + if (! to_units.compare ("pixels")) + { + if (to_units.compare ("normalized")) + { + retval(0) = (retval(0) - 1) / parent_dim(0); + retval(1) = (retval(1) - 1) / parent_dim(1); + if (is_rectangle) + { + retval(2) /= parent_dim(0); + retval(3) /= parent_dim(1); + } + else if (! is_2d) + retval(2) = 0; + } + else if (to_units.compare ("characters")) + { + if (res <= 0) + res = xget (0, "screenpixelsperinch").double_value (); + + double f = 0.0; + + f = 12.0 * res / 74.951; + + if (f > 0) + { + retval(0) = 2 * retval(0) / f; + retval(1) = retval(1) / f; + if (is_rectangle) + { + retval(2) = 2 * retval(2) / f; + retval(3) = retval(3) / f; + } + else if (! is_2d) + retval(2) = 0; + } + } + else + { + if (res <= 0) + res = xget (0, "screenpixelsperinch").double_value (); + + double f = 0.0; + + if (to_units.compare ("points")) + f = res / 72.0; + else if (to_units.compare ("inches")) + f = res; + else if (to_units.compare ("centimeters")) + f = res / 2.54; + + if (f > 0) + { + retval(0) = (retval(0) - 1) / f; + retval(1) = (retval(1) - 1) / f; + if (is_rectangle) + { + retval(2) /= f; + retval(3) /= f; + } + else if (! is_2d) + retval(2) = 0; + } + } + } + else if (! is_rectangle && ! is_2d) + retval(2) = 0; + + return retval; +} + +static Matrix +convert_text_position (const Matrix& pos, const text::properties& props, + const caseless_str& from_units, + const caseless_str& to_units) +{ + graphics_object go = gh_manager::get_object (props.get___myhandle__ ()); + graphics_object ax = go.get_ancestor ("axes"); + + Matrix retval; + + if (ax.valid_object ()) + { + const axes::properties& ax_props = + dynamic_cast (ax.get_properties ()); + graphics_xform ax_xform = ax_props.get_transform (); + bool is_rectangle = (pos.numel () == 4); + Matrix ax_bbox = ax_props.get_boundingbox (true), + ax_size = ax_bbox.extract_n (0, 2, 1, 2); + + if (from_units.compare ("data")) + { + if (is_rectangle) + { + ColumnVector v1 = ax_xform.transform (pos(0), pos(1), 0), + v2 = ax_xform.transform (pos(0) + pos(2), + pos(1) + pos(3), 0); + + retval.resize (1, 4); + + retval(0) = v1(0) - ax_bbox(0) + 1; + retval(1) = ax_bbox(1) + ax_bbox(3) - v1(1) + 1; + retval(2) = v2(0) - v1(0); + retval(3) = v1(1) - v2(1); + } + else + { + ColumnVector v = ax_xform.transform (pos(0), pos(1), pos(2)); + + retval.resize (1, 3); + + retval(0) = v(0) - ax_bbox(0) + 1; + retval(1) = ax_bbox(1) + ax_bbox(3) - v(1) + 1; + retval(2) = 0; + } + } + else + retval = convert_position (pos, from_units, "pixels", ax_size); + + if (! to_units.compare ("pixels")) + { + if (to_units.compare ("data")) + { + if (is_rectangle) + { + ColumnVector v1 = ax_xform.untransform (retval(0) + ax_bbox(0) - 1, + ax_bbox(1) + ax_bbox(3) - retval(1) + 1), + v2 = ax_xform.untransform (retval(0) + retval(2) + ax_bbox(0) - 1, + ax_bbox(1) + ax_bbox(3) - (retval(1) + retval(3)) + 1); + + retval.resize (1, 4); + + retval(0) = v1(0); + retval(1) = v1(1); + retval(2) = v2(0) - v1(0); + retval(3) = v2(1) - v1(1); + } + else + { + ColumnVector v = ax_xform.untransform (retval(0) + ax_bbox(0) - 1, + ax_bbox(1) + ax_bbox(3) - retval(1) + 1); + + retval.resize (1, 3); + + retval(0) = v(0); + retval(1) = v(1); + retval(2) = v(2); + } + } + else + retval = convert_position (retval, "pixels", to_units, ax_size); + } + } + + return retval; +} + +// This function always returns the screensize in pixels +static Matrix +screen_size_pixels (void) +{ + graphics_object obj = gh_manager::get_object (0); + Matrix sz = obj.get ("screensize").matrix_value (); + return convert_position (sz, obj.get ("units").string_value (), "pixels", sz.extract_n (0, 2, 1, 2)).extract_n (0, 2, 1, 2); +} + +static void +convert_cdata_2 (bool is_scaled, double clim_0, double clim_1, + const double *cmapv, double x, octave_idx_type lda, + octave_idx_type nc, octave_idx_type i, double *av) +{ + if (is_scaled) + x = xround ((nc - 1) * (x - clim_0) / (clim_1 - clim_0)); + else + x = xround (x - 1); + + if (xisnan (x)) + { + av[i] = x; + av[i+lda] = x; + av[i+2*lda] = x; + } + else + { + if (x < 0) + x = 0; + else if (x >= nc) + x = (nc - 1); + + octave_idx_type idx = static_cast (x); + + av[i] = cmapv[idx]; + av[i+lda] = cmapv[idx+nc]; + av[i+2*lda] = cmapv[idx+2*nc]; + } +} + +template +void +convert_cdata_1 (bool is_scaled, double clim_0, double clim_1, + const double *cmapv, const T *cv, octave_idx_type lda, + octave_idx_type nc, double *av) +{ + for (octave_idx_type i = 0; i < lda; i++) + convert_cdata_2 (is_scaled, clim_0, clim_1, cmapv, cv[i], lda, nc, i, av); +} + +static octave_value +convert_cdata (const base_properties& props, const octave_value& cdata, + bool is_scaled, int cdim) +{ + dim_vector dv (cdata.dims ()); + + if (dv.length () == cdim && dv(cdim-1) == 3) + return cdata; + + Matrix cmap (1, 3, 0.0); + Matrix clim (1, 2, 0.0); + + graphics_object go = gh_manager::get_object (props.get___myhandle__ ()); + graphics_object fig = go.get_ancestor ("figure"); + + if (fig.valid_object ()) + { + Matrix _cmap = fig.get (caseless_str ("colormap")).matrix_value (); + + if (! error_state) + cmap = _cmap; + } + + if (is_scaled) + { + graphics_object ax = go.get_ancestor ("axes"); + + if (ax.valid_object ()) + { + Matrix _clim = ax.get (caseless_str ("clim")).matrix_value (); + + if (! error_state) + clim = _clim; + } + } + + dv.resize (cdim); + dv(cdim-1) = 3; + + NDArray a (dv); + + octave_idx_type lda = a.numel () / static_cast (3); + octave_idx_type nc = cmap.rows (); + + double *av = a.fortran_vec (); + const double *cmapv = cmap.data (); + + double clim_0 = clim(0); + double clim_1 = clim(1); + +#define CONVERT_CDATA_1(ARRAY_T, VAL_FN) \ + do \ + { \ + ARRAY_T tmp = cdata. VAL_FN ## array_value (); \ + \ + convert_cdata_1 (is_scaled, clim_0, clim_1, cmapv, \ + tmp.data (), lda, nc, av); \ + } \ + while (0) + + if (cdata.is_uint8_type ()) + CONVERT_CDATA_1 (uint8NDArray, uint8_); + else if (cdata.is_single_type ()) + CONVERT_CDATA_1 (FloatNDArray, float_); + else if (cdata.is_double_type ()) + CONVERT_CDATA_1 (NDArray, ); + else + error ("unsupported type for cdata (= %s)", cdata.type_name ().c_str ()); + +#undef CONVERT_CDATA_1 + + return octave_value (a); +} + +template +static void +get_array_limits (const Array& m, double& emin, double& emax, + double& eminp, double& emaxp) +{ + const T *data = m.data (); + octave_idx_type n = m.numel (); + + for (octave_idx_type i = 0; i < n; i++) + { + double e = double (data[i]); + + // Don't need to test for NaN here as NaN>x and NaN emax) + emax = e; + + if (e > 0 && e < eminp) + eminp = e; + + if (e < 0 && e > emaxp) + emaxp = e; + } + } +} + +static bool +lookup_object_name (const caseless_str& name, caseless_str& go_name, + caseless_str& rest) +{ + int len = name.length (); + int offset = 0; + bool result = false; + + if (len >= 4) + { + caseless_str pfx = name.substr (0, 4); + + if (pfx.compare ("axes") || pfx.compare ("line") + || pfx.compare ("text")) + offset = 4; + else if (len >= 5) + { + pfx = name.substr (0, 5); + + if (pfx.compare ("image") || pfx.compare ("patch")) + offset = 5; + else if (len >= 6) + { + pfx = name.substr (0, 6); + + if (pfx.compare ("figure") || pfx.compare ("uimenu")) + offset = 6; + else if (len >= 7) + { + pfx = name.substr (0, 7); + + if (pfx.compare ("surface") || pfx.compare ("hggroup") + || pfx.compare ("uipanel")) + offset = 7; + else if (len >= 9) + { + pfx = name.substr (0, 9); + + if (pfx.compare ("uicontrol") + || pfx.compare ("uitoolbar")) + offset = 9; + else if (len >= 10) + { + pfx = name.substr (0, 10); + + if (pfx.compare ("uipushtool")) + offset = 10; + else if (len >= 12) + { + pfx = name.substr (0, 12); + + if (pfx.compare ("uitoggletool")) + offset = 12; + else if (len >= 13) + { + pfx = name.substr (0, 13); + + if (pfx.compare ("uicontextmenu")) + offset = 13; + } + } + } + } + } + } + } + + if (offset > 0) + { + go_name = pfx; + rest = name.substr (offset); + result = true; + } + } + + return result; +} + +static base_graphics_object* +make_graphics_object_from_type (const caseless_str& type, + const graphics_handle& h = graphics_handle (), + const graphics_handle& p = graphics_handle ()) +{ + base_graphics_object *go = 0; + + if (type.compare ("figure")) + go = new figure (h, p); + else if (type.compare ("axes")) + go = new axes (h, p); + else if (type.compare ("line")) + go = new line (h, p); + else if (type.compare ("text")) + go = new text (h, p); + else if (type.compare ("image")) + go = new image (h, p); + else if (type.compare ("patch")) + go = new patch (h, p); + else if (type.compare ("surface")) + go = new surface (h, p); + else if (type.compare ("hggroup")) + go = new hggroup (h, p); + else if (type.compare ("uimenu")) + go = new uimenu (h, p); + else if (type.compare ("uicontrol")) + go = new uicontrol (h, p); + else if (type.compare ("uipanel")) + go = new uipanel (h, p); + else if (type.compare ("uicontextmenu")) + go = new uicontextmenu (h, p); + else if (type.compare ("uitoolbar")) + go = new uitoolbar (h, p); + else if (type.compare ("uipushtool")) + go = new uipushtool (h, p); + else if (type.compare ("uitoggletool")) + go = new uitoggletool (h, p); + return go; +} + +// --------------------------------------------------------------------- + +bool +base_property::set (const octave_value& v, bool do_run, bool do_notify_toolkit) +{ + if (do_set (v)) + { + + // Notify graphics toolkit. + if (id >= 0 && do_notify_toolkit) + { + graphics_object go = gh_manager::get_object (parent); + if (go) + go.update (id); + } + + // run listeners + if (do_run && ! error_state) + run_listeners (POSTSET); + + return true; + } + + return false; +} + + +void +base_property::run_listeners (listener_mode mode) +{ + const octave_value_list& l = listeners[mode]; + + for (int i = 0; i < l.length (); i++) + { + gh_manager::execute_listener (parent, l(i)); + + if (error_state) + break; + } +} + +radio_values::radio_values (const std::string& opt_string) + : default_val (), possible_vals () +{ + size_t beg = 0; + size_t len = opt_string.length (); + bool done = len == 0; + + while (! done) + { + size_t end = opt_string.find ('|', beg); + + if (end == std::string::npos) + { + end = len; + done = true; + } + + std::string t = opt_string.substr (beg, end-beg); + + // Might want more error checking here... + if (t[0] == '{') + { + t = t.substr (1, t.length () - 2); + default_val = t; + } + else if (beg == 0) // ensure default value + default_val = t; + + possible_vals.insert (t); + + beg = end + 1; + } +} + +std::string +radio_values::values_as_string (void) const +{ + std::string retval; + for (std::set::const_iterator it = possible_vals.begin (); + it != possible_vals.end (); it++) + { + if (retval == "") + { + if (*it == default_value ()) + retval = "{" + *it + "}"; + else + retval = *it; + } + else + { + if (*it == default_value ()) + retval += " | {" + *it + "}"; + else + retval += " | " + *it; + } + } + if (retval != "") + retval = "[ " + retval + " ]"; + return retval; +} + +Cell +radio_values::values_as_cell (void) const +{ + octave_idx_type i = 0; + Cell retval (nelem (), 1); + for (std::set::const_iterator it = possible_vals.begin (); + it != possible_vals.end (); it++) + retval(i++) = std::string (*it); + return retval; +} + +bool +color_values::str2rgb (std::string str) +{ + double tmp_rgb[3] = {0, 0, 0}; + bool retval = true; + unsigned int len = str.length (); + + std::transform (str.begin (), str.end (), str.begin (), tolower); + + if (str.compare (0, len, "blue", 0, len) == 0) + tmp_rgb[2] = 1; + else if (str.compare (0, len, "black", 0, len) == 0 + || str.compare (0, len, "k", 0, len) == 0) + tmp_rgb[0] = tmp_rgb[1] = tmp_rgb[2] = 0; + else if (str.compare (0, len, "red", 0, len) == 0) + tmp_rgb[0] = 1; + else if (str.compare (0, len, "green", 0, len) == 0) + tmp_rgb[1] = 1; + else if (str.compare (0, len, "yellow", 0, len) == 0) + tmp_rgb[0] = tmp_rgb[1] = 1; + else if (str.compare (0, len, "magenta", 0, len) == 0) + tmp_rgb[0] = tmp_rgb[2] = 1; + else if (str.compare (0, len, "cyan", 0, len) == 0) + tmp_rgb[1] = tmp_rgb[2] = 1; + else if (str.compare (0, len, "white", 0, len) == 0 + || str.compare (0, len, "w", 0, len) == 0) + tmp_rgb[0] = tmp_rgb[1] = tmp_rgb[2] = 1; + else + retval = false; + + if (retval) + { + for (int i = 0; i < 3; i++) + xrgb(i) = tmp_rgb[i]; + } + + return retval; +} + +bool +color_property::do_set (const octave_value& val) +{ + if (val.is_string ()) + { + std::string s = val.string_value (); + + if (! s.empty ()) + { + std::string match; + + if (radio_val.contains (s, match)) + { + if (current_type != radio_t || match != current_val) + { + if (s.length () != match.length ()) + warning_with_id ("Octave:abbreviated-property-match", + "%s: allowing %s to match %s value %s", + "set", s.c_str (), get_name ().c_str (), + match.c_str ()); + current_val = match; + current_type = radio_t; + return true; + } + } + else + { + color_values col (s); + if (! error_state) + { + if (current_type != color_t || col != color_val) + { + color_val = col; + current_type = color_t; + return true; + } + } + else + error ("invalid value for color property \"%s\" (value = %s)", + get_name ().c_str (), s.c_str ()); + } + } + else + error ("invalid value for color property \"%s\"", + get_name ().c_str ()); + } + else if (val.is_numeric_type ()) + { + Matrix m = val.matrix_value (); + + if (m.numel () == 3) + { + color_values col (m(0), m(1), m(2)); + if (! error_state) + { + if (current_type != color_t || col != color_val) + { + color_val = col; + current_type = color_t; + return true; + } + } + } + else + error ("invalid value for color property \"%s\"", + get_name ().c_str ()); + } + else + error ("invalid value for color property \"%s\"", + get_name ().c_str ()); + + return false; +} + +bool +double_radio_property::do_set (const octave_value& val) +{ + if (val.is_string ()) + { + std::string s = val.string_value (); + std::string match; + + if (! s.empty () && radio_val.contains (s, match)) + { + if (current_type != radio_t || match != current_val) + { + if (s.length () != match.length ()) + warning_with_id ("Octave:abbreviated-property-match", + "%s: allowing %s to match %s value %s", + "set", s.c_str (), get_name ().c_str (), + match.c_str ()); + current_val = match; + current_type = radio_t; + return true; + } + } + else + error ("invalid value for double_radio property \"%s\"", + get_name ().c_str ()); + } + else if (val.is_scalar_type () && val.is_real_type ()) + { + double new_dval = val.double_value (); + + if (current_type != double_t || new_dval != dval) + { + dval = new_dval; + current_type = double_t; + return true; + } + } + else + error ("invalid value for double_radio property \"%s\"", + get_name ().c_str ()); + + return false; +} + +bool +array_property::validate (const octave_value& v) +{ + bool xok = false; + + // FIXME -- should we always support []? + if (v.is_empty () && v.is_numeric_type ()) + return true; + + // check value type + if (type_constraints.size () > 0) + { + if(type_constraints.find (v.class_name()) != type_constraints.end()) + xok = true; + + // check if complex is allowed (it's also of class "double", so + // checking that alone is not enough to ensure real type) + if (type_constraints.find ("real") != type_constraints.end () + && v.is_complex_type ()) + xok = false; + } + else + xok = v.is_numeric_type (); + + if (xok) + { + dim_vector vdims = v.dims (); + int vlen = vdims.length (); + + xok = false; + + // check value size + if (size_constraints.size () > 0) + for (std::list::const_iterator it = size_constraints.begin (); + ! xok && it != size_constraints.end (); ++it) + { + dim_vector itdims = (*it); + + if (itdims.length () == vlen) + { + xok = true; + + for (int i = 0; xok && i < vlen; i++) + if (itdims(i) >= 0 && itdims(i) != vdims(i)) + xok = false; + } + } + else + return true; + } + + return xok; +} + +bool +array_property::is_equal (const octave_value& v) const +{ + if (data.type_name () == v.type_name ()) + { + if (data.dims () == v.dims ()) + { + +#define CHECK_ARRAY_EQUAL(T,F,A) \ + { \ + if (data.numel () == 1) \ + return data.F ## scalar_value () == \ + v.F ## scalar_value (); \ + else \ + { \ + /* Keep copy of array_value to allow sparse/bool arrays */ \ + /* that are converted, to not be deallocated early */ \ + const A m1 = data.F ## array_value (); \ + const T* d1 = m1.data (); \ + const A m2 = v.F ## array_value (); \ + const T* d2 = m2.data ();\ + \ + bool flag = true; \ + \ + for (int i = 0; flag && i < data.numel (); i++) \ + if (d1[i] != d2[i]) \ + flag = false; \ + \ + return flag; \ + } \ + } + + if (data.is_double_type () || data.is_bool_type ()) + CHECK_ARRAY_EQUAL (double, , NDArray) + else if (data.is_single_type ()) + CHECK_ARRAY_EQUAL (float, float_, FloatNDArray) + else if (data.is_int8_type ()) + CHECK_ARRAY_EQUAL (octave_int8, int8_, int8NDArray) + else if (data.is_int16_type ()) + CHECK_ARRAY_EQUAL (octave_int16, int16_, int16NDArray) + else if (data.is_int32_type ()) + CHECK_ARRAY_EQUAL (octave_int32, int32_, int32NDArray) + else if (data.is_int64_type ()) + CHECK_ARRAY_EQUAL (octave_int64, int64_, int64NDArray) + else if (data.is_uint8_type ()) + CHECK_ARRAY_EQUAL (octave_uint8, uint8_, uint8NDArray) + else if (data.is_uint16_type ()) + CHECK_ARRAY_EQUAL (octave_uint16, uint16_, uint16NDArray) + else if (data.is_uint32_type ()) + CHECK_ARRAY_EQUAL (octave_uint32, uint32_, uint32NDArray) + else if (data.is_uint64_type ()) + CHECK_ARRAY_EQUAL (octave_uint64, uint64_, uint64NDArray) + } + } + + return false; +} + +void +array_property::get_data_limits (void) +{ + xmin = xminp = octave_Inf; + xmax = xmaxp = -octave_Inf; + + if (! data.is_empty ()) + { + if (data.is_integer_type ()) + { + if (data.is_int8_type ()) + get_array_limits (data.int8_array_value (), xmin, xmax, xminp, xmaxp); + else if (data.is_uint8_type ()) + get_array_limits (data.uint8_array_value (), xmin, xmax, xminp, xmaxp); + else if (data.is_int16_type ()) + get_array_limits (data.int16_array_value (), xmin, xmax, xminp, xmaxp); + else if (data.is_uint16_type ()) + get_array_limits (data.uint16_array_value (), xmin, xmax, xminp, xmaxp); + else if (data.is_int32_type ()) + get_array_limits (data.int32_array_value (), xmin, xmax, xminp, xmaxp); + else if (data.is_uint32_type ()) + get_array_limits (data.uint32_array_value (), xmin, xmax, xminp, xmaxp); + else if (data.is_int64_type ()) + get_array_limits (data.int64_array_value (), xmin, xmax, xminp, xmaxp); + else if (data.is_uint64_type ()) + get_array_limits (data.uint64_array_value (), xmin, xmax, xminp, xmaxp); + } + else + get_array_limits (data.array_value (), xmin, xmax, xminp, xmaxp); + } +} + +bool +handle_property::do_set (const octave_value& v) +{ + double dv = v.double_value (); + + if (! error_state) + { + graphics_handle gh = gh_manager::lookup (dv); + + if (xisnan (gh.value ()) || gh.ok ()) + { + if (current_val != gh) + { + current_val = gh; + return true; + } + } + else + error ("set: invalid graphics handle (= %g) for property \"%s\"", + dv, get_name ().c_str ()); + } + else + error ("set: invalid graphics handle for property \"%s\"", + get_name ().c_str ()); + + return false; +} + +Matrix +children_property::do_get_children (bool return_hidden) const +{ + Matrix retval (children_list.size (), 1); + octave_idx_type k = 0; + + graphics_object go = gh_manager::get_object (0); + + root_figure::properties& props = + dynamic_cast (go.get_properties ()); + + if (! props.is_showhiddenhandles ()) + { + for (const_children_list_iterator p = children_list.begin (); + p != children_list.end (); p++) + { + graphics_handle kid = *p; + + if (gh_manager::is_handle_visible (kid)) + { + if (! return_hidden) + retval(k++) = *p; + } + else if (return_hidden) + retval(k++) = *p; + } + + retval.resize (k, 1); + } + else + { + for (const_children_list_iterator p = children_list.begin (); + p != children_list.end (); p++) + retval(k++) = *p; + } + + return retval; +} + +void +children_property::do_delete_children (bool clear) +{ + for (children_list_iterator p = children_list.begin (); + p != children_list.end (); p++) + { + graphics_object go = gh_manager::get_object (*p); + + if (go.valid_object ()) + gh_manager::free (*p); + + } + + if (clear) + children_list.clear (); +} + +bool +callback_property::validate (const octave_value& v) const +{ + // case 1: function handle + // case 2: cell array with first element being a function handle + // case 3: string corresponding to known function name + // case 4: evaluatable string + // case 5: empty matrix + + if (v.is_function_handle ()) + return true; + else if (v.is_string ()) + // complete validation will be done at execution-time + return true; + else if (v.is_cell () && v.length () > 0 + && (v.rows () == 1 || v.columns () == 1) + && v.cell_value ()(0).is_function_handle ()) + return true; + else if (v.is_empty ()) + return true; + + return false; +} + +// If TRUE, we are executing any callback function, or the functions it +// calls. Used to determine handle visibility inside callback +// functions. +static bool executing_callback = false; + +void +callback_property::execute (const octave_value& data) const +{ + unwind_protect frame; + + // We are executing the callback function associated with this + // callback property. When set to true, we avoid recursive calls to + // callback routines. + frame.protect_var (executing); + + // We are executing a callback function, so allow handles that have + // their handlevisibility property set to "callback" to be visible. + frame.protect_var (executing_callback); + + if (! executing) + { + executing = true; + executing_callback = true; + + if (callback.is_defined () && ! callback.is_empty ()) + gh_manager::execute_callback (get_parent (), callback, data); + } +} + +// Used to cache dummy graphics objects from which dynamic +// properties can be cloned. +static std::map dprop_obj_map; + +property +property::create (const std::string& name, const graphics_handle& h, + const caseless_str& type, const octave_value_list& args) +{ + property retval; + + if (type.compare ("string")) + { + std::string val = (args.length () > 0 ? args(0).string_value () : ""); + + if (! error_state) + retval = property (new string_property (name, h, val)); + } + else if (type.compare ("any")) + { + octave_value val = + (args.length () > 0 ? args(0) : octave_value (Matrix ())); + + retval = property (new any_property (name, h, val)); + } + else if (type.compare ("radio")) + { + if (args.length () > 0) + { + std::string vals = args(0).string_value (); + + if (! error_state) + { + retval = property (new radio_property (name, h, vals)); + + if (args.length () > 1) + retval.set (args(1)); + } + else + error ("addproperty: invalid argument for radio property, expected a string value"); + } + else + error ("addproperty: missing possible values for radio property"); + } + else if (type.compare ("double")) + { + double d = (args.length () > 0 ? args(0).double_value () : 0); + + if (! error_state) + retval = property (new double_property (name, h, d)); + } + else if (type.compare ("handle")) + { + double hh = (args.length () > 0 ? args(0).double_value () : octave_NaN); + + if (! error_state) + { + graphics_handle gh (hh); + + retval = property (new handle_property (name, h, gh)); + } + } + else if (type.compare ("boolean")) + { + retval = property (new bool_property (name, h, false)); + + if (args.length () > 0) + retval.set (args(0)); + } + else if (type.compare ("data")) + { + retval = property (new array_property (name, h, Matrix ())); + + if (args.length () > 0) + { + retval.set (args(0)); + + // FIXME -- additional argument could define constraints, + // but is this really useful? + } + } + else if (type.compare ("color")) + { + color_values cv (0, 0, 0); + radio_values rv; + + if (args.length () > 1) + rv = radio_values (args(1).string_value ()); + + if (! error_state) + { + retval = property (new color_property (name, h, cv, rv)); + + if (! error_state) + { + if (args.length () > 0 && ! args(0).is_empty ()) + retval.set (args(0)); + else + retval.set (rv.default_value ()); + } + } + } + else + { + caseless_str go_name, go_rest; + + if (lookup_object_name (type, go_name, go_rest)) + { + graphics_object go; + + std::map::const_iterator it = + dprop_obj_map.find (go_name); + + if (it == dprop_obj_map.end ()) + { + base_graphics_object *bgo = + make_graphics_object_from_type (go_name); + + if (bgo) + { + go = graphics_object (bgo); + + dprop_obj_map[go_name] = go; + } + } + else + go = it->second; + + if (go.valid_object ()) + { + property prop = go.get_properties ().get_property (go_rest); + + if (! error_state) + { + retval = prop.clone (); + + retval.set_parent (h); + retval.set_name (name); + + if (args.length () > 0) + retval.set (args(0)); + } + } + else + error ("addproperty: invalid object type (= %s)", + go_name.c_str ()); + } + else + error ("addproperty: unsupported type for dynamic property (= %s)", + type.c_str ()); + } + + return retval; +} + +static void +finalize_r (const graphics_handle& h) +{ + graphics_object go = gh_manager::get_object (h); + + if (go) + { + Matrix children = go.get_properties ().get_all_children (); + + for (int k = 0; k < children.numel (); k++) + finalize_r (children(k)); + + go.finalize (); + } +} + +static void +initialize_r (const graphics_handle& h) +{ + graphics_object go = gh_manager::get_object (h); + + if (go) + { + Matrix children = go.get_properties ().get_all_children (); + + go.initialize (); + + for (int k = 0; k < children.numel (); k++) + initialize_r (children(k)); + } +} + +void +figure::properties::set_toolkit (const graphics_toolkit& b) +{ + if (toolkit) + finalize_r (get___myhandle__ ()); + + toolkit = b; + __graphics_toolkit__ = b.get_name (); + __plot_stream__ = Matrix (); + + if (toolkit) + initialize_r (get___myhandle__ ()); + + mark_modified (); +} + +// --------------------------------------------------------------------- + +void +property_list::set (const caseless_str& name, const octave_value& val) +{ + size_t offset = 0; + + size_t len = name.length (); + + if (len > 4) + { + caseless_str pfx = name.substr (0, 4); + + if (pfx.compare ("axes") || pfx.compare ("line") + || pfx.compare ("text")) + offset = 4; + else if (len > 5) + { + pfx = name.substr (0, 5); + + if (pfx.compare ("image") || pfx.compare ("patch")) + offset = 5; + else if (len > 6) + { + pfx = name.substr (0, 6); + + if (pfx.compare ("figure") || pfx.compare ("uimenu")) + offset = 6; + else if (len > 7) + { + pfx = name.substr (0, 7); + + if (pfx.compare ("surface") || pfx.compare ("hggroup") + || pfx.compare ("uipanel")) + offset = 7; + else if (len > 9) + { + pfx = name.substr (0, 9); + + if (pfx.compare ("uicontrol") + || pfx.compare ("uitoolbar")) + offset = 9; + else if (len > 10) + { + pfx = name.substr (0, 10); + + if (pfx.compare ("uipushtool")) + offset = 10; + else if (len > 12) + { + pfx = name.substr (0, 12); + + if (pfx.compare ("uitoogletool")) + offset = 12; + else if (len > 13) + { + pfx = name.substr (0, 13); + + if (pfx.compare ("uicontextmenu")) + offset = 13; + } + } + } + } + } + } + } + + if (offset > 0) + { + // FIXME -- should we validate property names and values here? + + std::string pname = name.substr (offset); + + std::transform (pfx.begin (), pfx.end (), pfx.begin (), tolower); + std::transform (pname.begin (), pname.end (), pname.begin (), tolower); + + bool has_property = false; + if (pfx == "axes") + has_property = axes::properties::has_core_property (pname); + else if (pfx == "line") + has_property = line::properties::has_core_property (pname); + else if (pfx == "text") + has_property = text::properties::has_core_property (pname); + else if (pfx == "image") + has_property = image::properties::has_core_property (pname); + else if (pfx == "patch") + has_property = patch::properties::has_core_property (pname); + else if (pfx == "figure") + has_property = figure::properties::has_core_property (pname); + else if (pfx == "surface") + has_property = surface::properties::has_core_property (pname); + else if (pfx == "hggroup") + has_property = hggroup::properties::has_core_property (pname); + else if (pfx == "uimenu") + has_property = uimenu::properties::has_core_property (pname); + else if (pfx == "uicontrol") + has_property = uicontrol::properties::has_core_property (pname); + else if (pfx == "uipanel") + has_property = uipanel::properties::has_core_property (pname); + else if (pfx == "uicontextmenu") + has_property = uicontextmenu::properties::has_core_property (pname); + else if (pfx == "uitoolbar") + has_property = uitoolbar::properties::has_core_property (pname); + else if (pfx == "uipushtool") + has_property = uipushtool::properties::has_core_property (pname); + + if (has_property) + { + bool remove = false; + if (val.is_string ()) + { + std::string tval = val.string_value (); + + remove = (tval.compare ("remove") == 0); + } + + pval_map_type& pval_map = plist_map[pfx]; + + if (remove) + { + pval_map_iterator p = pval_map.find (pname); + + if (p != pval_map.end ()) + pval_map.erase (p); + } + else + pval_map[pname] = val; + } + else + error ("invalid %s property '%s'", pfx.c_str (), pname.c_str ()); + } + } + + if (! error_state && offset == 0) + error ("invalid default property specification"); +} + +octave_value +property_list::lookup (const caseless_str& name) const +{ + octave_value retval; + + size_t offset = 0; + + size_t len = name.length (); + + if (len > 4) + { + caseless_str pfx = name.substr (0, 4); + + if (pfx.compare ("axes") || pfx.compare ("line") + || pfx.compare ("text")) + offset = 4; + else if (len > 5) + { + pfx = name.substr (0, 5); + + if (pfx.compare ("image") || pfx.compare ("patch")) + offset = 5; + else if (len > 6) + { + pfx = name.substr (0, 6); + + if (pfx.compare ("figure") || pfx.compare ("uimenu")) + offset = 6; + else if (len > 7) + { + pfx = name.substr (0, 7); + + if (pfx.compare ("surface") || pfx.compare ("hggroup") + || pfx.compare ("uipanel")) + offset = 7; + else if (len > 9) + { + pfx = name.substr (0, 9); + + if (pfx.compare ("uicontrol") + || pfx.compare ("uitoolbar")) + offset = 9; + else if (len > 10) + { + pfx = name.substr (0, 10); + + if (pfx.compare ("uipushtool")) + offset = 10; + else if (len > 12) + { + pfx = name.substr (0, 12); + + if (pfx.compare ("uitoggletool")) + offset = 12; + else if (len > 13) + { + pfx = name.substr (0, 13); + + if (pfx.compare ("uicontextmenu")) + offset = 13; + } + } + } + } + } + } + } + + if (offset > 0) + { + std::string pname = name.substr (offset); + + std::transform (pfx.begin (), pfx.end (), pfx.begin (), tolower); + std::transform (pname.begin (), pname.end (), pname.begin (), tolower); + + plist_map_const_iterator p = find (pfx); + + if (p != end ()) + { + const pval_map_type& pval_map = p->second; + + pval_map_const_iterator q = pval_map.find (pname); + + if (q != pval_map.end ()) + retval = q->second; + } + } + } + + return retval; +} + +octave_scalar_map +property_list::as_struct (const std::string& prefix_arg) const +{ + octave_scalar_map m; + + for (plist_map_const_iterator p = begin (); p != end (); p++) + { + std::string prefix = prefix_arg + p->first; + + const pval_map_type pval_map = p->second; + + for (pval_map_const_iterator q = pval_map.begin (); + q != pval_map.end (); + q++) + m.assign (prefix + q->first, q->second); + } + + return m; +} + +graphics_handle::graphics_handle (const octave_value& a) + : val (octave_NaN) +{ + if (a.is_empty ()) + /* do nothing */; + else + { + double tval = a.double_value (); + + if (! error_state) + val = tval; + else + error ("invalid graphics handle"); + } +} + +// Set properties given as a cs-list of name, value pairs. + +void +graphics_object::set (const octave_value_list& args) +{ + int nargin = args.length (); + + if (nargin == 0) + error ("graphics_object::set: Nothing to set"); + else if (nargin % 2 == 0) + { + for (int i = 0; i < nargin; i += 2) + { + caseless_str name = args(i).string_value (); + + if (! error_state) + { + octave_value val = args(i+1); + + set_value_or_default (name, val); + + if (error_state) + break; + } + else + error ("set: expecting argument %d to be a property name", i); + } + } + else + error ("set: invalid number of arguments"); +} + +/* +## test set with name, value pairs +%!test +%! set (gcf, "visible", "off"); +%! h = plot (1:10, 10:-1:1); +%! set (h, "linewidth", 10, "marker", "x"); +%! assert (get (h, "linewidth"), 10); +%! assert (get (h, "marker"), "x"); +*/ + +// Set properties given in two cell arrays containing names and values. +void +graphics_object::set (const Array& names, + const Cell& values, octave_idx_type row) +{ + if (names.numel () != values.columns ()) + { + error ("set: number of names must match number of value columns (%d != %d)", + names.numel (), values.columns ()); + } + + octave_idx_type k = names.columns (); + + for (octave_idx_type column = 0; column < k; column++) + { + caseless_str name = names(column); + octave_value val = values(row, column); + + set_value_or_default (name, val); + + if (error_state) + break; + } +} + +/* +## test set with cell array arguments +%!test +%! set (gcf, "visible", "off"); +%! h = plot (1:10, 10:-1:1); +%! set (h, {"linewidth", "marker"}, {10, "x"}); +%! assert (get (h, "linewidth"), 10); +%! assert (get (h, "marker"), "x"); + +## test set with multiple handles and cell array arguments +%!test +%! set (gcf, "visible", "off"); +%! h = plot (1:10, 10:-1:1, 1:10, 1:10); +%! set (h, {"linewidth", "marker"}, {10, "x"; 5, "o"}); +%! assert (get (h, "linewidth"), {10; 5}); +%! assert (get (h, "marker"), {"x"; "o"}); +%! set (h, {"linewidth", "marker"}, {10, "x"}); +%! assert (get (h, "linewidth"), {10; 10}); +%! assert (get (h, "marker"), {"x"; "x"}); + +%!error +%! set (gcf, "visible", "off"); +%! h = plot (1:10, 10:-1:1, 1:10, 1:10); +%! set (h, {"linewidth", "marker"}, {10, "x"; 5, "o"; 7, "."}); + +%!error +%! set (gcf, "visible", "off"); +%! h = plot (1:10, 10:-1:1, 1:10, 1:10); +%! set (h, {"linewidth"}, {10, "x"; 5, "o"}); +*/ + +// Set properties given in a struct array +void +graphics_object::set (const octave_map& m) +{ + for (octave_idx_type p = 0; p < m.nfields (); p++) + { + caseless_str name = m.keys ()[p]; + + octave_value val = octave_value (m.contents (name).elem (m.numel () - 1)); + + set_value_or_default (name, val); + + if (error_state) + break; + } +} + +/* +## test set ticklabels for compatibility +%!test +%! set (gcf (), "visible", "off"); +%! set (gca (), "xticklabel", [0, 0.2, 0.4, 0.6, 0.8, 1]); +%! xticklabel = get (gca (), "xticklabel"); +%! assert (class (xticklabel), "char"); +%! assert (size (xticklabel), [6, 3]); +%!test +%! set (gcf (), "visible", "off"); +%! set (gca (), "xticklabel", "0|0.2|0.4|0.6|0.8|1"); +%! xticklabel = get (gca (), "xticklabel"); +%! assert (class (xticklabel), "char"); +%! assert (size (xticklabel), [6, 3]); +%!test +%! set (gcf (), "visible", "off"); +%! set (gca (), "xticklabel", ["0 "; "0.2"; "0.4"; "0.6"; "0.8"; "1 "]); +%! xticklabel = get (gca (), "xticklabel"); +%! assert (class (xticklabel), "char"); +%! assert (size (xticklabel), [6, 3]); +%!test +%! set (gcf (), "visible", "off"); +%! set (gca (), "xticklabel", {"0", "0.2", "0.4", "0.6", "0.8", "1"}); +%! xticklabel = get (gca (), "xticklabel"); +%! assert (class (xticklabel), "cell"); +%! assert (size (xticklabel), [6, 1]); +*/ + +/* +## test set with struct arguments +%!test +%! set (gcf, "visible", "off"); +%! h = plot (1:10, 10:-1:1); +%! set (h, struct ("linewidth", 10, "marker", "x")); +%! assert (get (h, "linewidth"), 10); +%! assert (get (h, "marker"), "x"); +%! h = plot (1:10, 10:-1:1, 1:10, 1:10); +%! set (h, struct ("linewidth", {5, 10})); +%! assert (get (h, "linewidth"), {10; 10}); +## test ordering +%!test +%! markchanged = @(h, foobar, name) set (h, "userdata", [get(h,"userdata"); {name}]); +%! figure (1, "visible", "off") +%! clf (); +%! h = line (); +%! set (h, "userdata", {}); +%! addlistener (h, "color", {markchanged, "color"}); +%! addlistener (h, "linewidth", {markchanged, "linewidth"}); +%! # "linewidth" first +%! props.linewidth = 2; +%! props.color = "r"; +%! set (h, props); +%! assert (get (h, "userdata"), fieldnames (props)); +%! clear props +%! clf (); +%! h = line (); +%! set (h, "userdata", {}); +%! addlistener (h, "color", {markchanged, "color"}); +%! addlistener (h, "linewidth", {markchanged, "linewidth"}); +%! # "color" first +%! props.color = "r"; +%! props.linewidth = 2; +%! set (h, props); +%! assert (get (h, "userdata"), fieldnames (props)); +%! close (1); +*/ + +// Set a property to a value or to its (factory) default value. + +void +graphics_object::set_value_or_default (const caseless_str& name, + const octave_value& val) +{ + if (val.is_string ()) + { + std::string tval = val.string_value (); + + octave_value default_val; + + if (tval.compare ("default") == 0) + { + default_val = get_default (name); + + if (error_state) + return; + + rep->set (name, default_val); + } + else if (tval.compare ("factory") == 0) + { + default_val = get_factory_default (name); + + if (error_state) + return; + + rep->set (name, default_val); + } + else + { + // Matlab specifically uses "\default" to escape string setting + if (tval.compare ("\\default") == 0) + rep->set (name, "default"); + else if (tval.compare ("\\factory") == 0) + rep->set (name, "factory"); + else + rep->set (name, val); + } + } + else + rep->set (name, val); +} + +/* +## test setting of default values +%!test +%! set (gcf, "visible", "off"); +%! h = plot (1:10, 10:-1:1); +%! set (0, "defaultlinelinewidth", 20); +%! set (h, "linewidth", "default"); +%! assert (get (h, "linewidth"), 20); +%! set (h, "linewidth", "factory"); +%! assert (get (h, "linewidth"), 0.5); +*/ + +static double +make_handle_fraction (void) +{ + static double maxrand = RAND_MAX + 2.0; + + return (rand () + 1.0) / maxrand; +} + +graphics_handle +gh_manager::do_get_handle (bool integer_figure_handle) +{ + graphics_handle retval; + + if (integer_figure_handle) + { + // Figure handles are positive integers corresponding to the + // figure number. + + // We always want the lowest unused figure number. + + retval = 1; + + while (handle_map.find (retval) != handle_map.end ()) + retval++; + } + else + { + // Other graphics handles are negative integers plus some random + // fractional part. To avoid running out of integers, we + // recycle the integer part but tack on a new random part each + // time. + + free_list_iterator p = handle_free_list.begin (); + + if (p != handle_free_list.end ()) + { + retval = *p; + handle_free_list.erase (p); + } + else + { + retval = graphics_handle (next_handle); + + next_handle = std::ceil (next_handle) - 1.0 - make_handle_fraction (); + } + } + + return retval; +} + +void +gh_manager::do_free (const graphics_handle& h) +{ + if (h.ok ()) + { + if (h.value () != 0) + { + iterator p = handle_map.find (h); + + if (p != handle_map.end ()) + { + base_properties& bp = p->second.get_properties (); + + bp.set_beingdeleted (true); + + bp.delete_children (); + + octave_value val = bp.get_deletefcn (); + + bp.execute_deletefcn (); + + // Notify graphics toolkit. + p->second.finalize (); + + // Note: this will be valid only for first explicitly + // deleted object. All its children will then have an + // unknown graphics toolkit. + + // Graphics handles for non-figure objects are negative + // integers plus some random fractional part. To avoid + // running out of integers, we recycle the integer part + // but tack on a new random part each time. + + handle_map.erase (p); + + if (h.value () < 0) + handle_free_list.insert (std::ceil (h.value ()) - make_handle_fraction ()); + } + else + error ("graphics_handle::free: invalid object %g", h.value ()); + } + else + error ("graphics_handle::free: can't delete root figure"); + } +} + +void +gh_manager::do_renumber_figure (const graphics_handle& old_gh, + const graphics_handle& new_gh) +{ + iterator p = handle_map.find (old_gh); + + if (p != handle_map.end ()) + { + graphics_object go = p->second; + + handle_map.erase (p); + + handle_map[new_gh] = go; + + if (old_gh.value () < 0) + handle_free_list.insert (std::ceil (old_gh.value ()) + - make_handle_fraction ()); + } + else + error ("graphics_handle::free: invalid object %g", old_gh.value ()); + + for (figure_list_iterator q = figure_list.begin (); + q != figure_list.end (); q++) + { + if (*q == old_gh) + { + *q = new_gh; + break; + } + } +} + +gh_manager *gh_manager::instance = 0; + +static void +xset (const graphics_handle& h, const caseless_str& name, + const octave_value& val) +{ + graphics_object obj = gh_manager::get_object (h); + obj.set (name, val); +} + +static void +xset (const graphics_handle& h, const octave_value_list& args) +{ + if (args.length () > 0) + { + graphics_object obj = gh_manager::get_object (h); + obj.set (args); + } +} + +static octave_value +xget (const graphics_handle& h, const caseless_str& name) +{ + graphics_object obj = gh_manager::get_object (h); + return obj.get (name); +} + +static graphics_handle +reparent (const octave_value& ov, const std::string& who, + const std::string& property, const graphics_handle& new_parent, + bool adopt = true) +{ + graphics_handle h = octave_NaN; + + double val = ov.double_value (); + + if (! error_state) + { + h = gh_manager::lookup (val); + + if (h.ok ()) + { + graphics_object obj = gh_manager::get_object (h); + + graphics_handle parent_h = obj.get_parent (); + + graphics_object parent_obj = gh_manager::get_object (parent_h); + + parent_obj.remove_child (h); + + if (adopt) + obj.set ("parent", new_parent.value ()); + else + obj.reparent (new_parent); + } + else + error ("%s: invalid graphics handle (= %g) for %s", + who.c_str (), val, property.c_str ()); + } + else + error ("%s: expecting %s to be a graphics handle", + who.c_str (), property.c_str ()); + + return h; +} + +// This function is NOT equivalent to the scripting language function gcf. +graphics_handle +gcf (void) +{ + octave_value val = xget (0, "currentfigure"); + + return val.is_empty () ? octave_NaN : val.double_value (); +} + +// This function is NOT equivalent to the scripting language function gca. +graphics_handle +gca (void) +{ + octave_value val = xget (gcf (), "currentaxes"); + + return val.is_empty () ? octave_NaN : val.double_value (); +} + +static void +delete_graphics_object (const graphics_handle& h) +{ + if (h.ok ()) + { + graphics_object obj = gh_manager::get_object (h); + + // Don't do recursive deleting, due to callbacks + if (! obj.get_properties ().is_beingdeleted ()) + { + graphics_handle parent_h = obj.get_parent (); + + graphics_object parent_obj = + gh_manager::get_object (parent_h); + + // NOTE: free the handle before removing it from its + // parent's children, such that the object's + // state is correct when the deletefcn callback + // is executed + + gh_manager::free (h); + + // A callback function might have already deleted + // the parent + if (parent_obj.valid_object ()) + parent_obj.remove_child (h); + + Vdrawnow_requested = true; + } + } +} + +static void +delete_graphics_object (double val) +{ + delete_graphics_object (gh_manager::lookup (val)); +} + +static void +delete_graphics_objects (const NDArray vals) +{ + for (octave_idx_type i = 0; i < vals.numel (); i++) + delete_graphics_object (vals.elem (i)); +} + +static void +close_figure (const graphics_handle& handle) +{ + octave_value closerequestfcn = xget (handle, "closerequestfcn"); + + OCTAVE_SAFE_CALL (gh_manager::execute_callback, (handle, closerequestfcn)); +} + +static void +force_close_figure (const graphics_handle& handle) +{ + // Remove the deletefcn and closerequestfcn callbacks and delete the + // object directly. + + xset (handle, "deletefcn", Matrix ()); + xset (handle, "closerequestfcn", Matrix ()); + + delete_graphics_object (handle); +} + +void +gh_manager::do_close_all_figures (void) +{ + // FIXME -- should we process or discard pending events? + + event_queue.clear (); + + // Don't use figure_list_iterator because we'll be removing elements + // from the list elsewhere. + + Matrix hlist = do_figure_handle_list (true); + + for (octave_idx_type i = 0; i < hlist.numel (); i++) + { + graphics_handle h = gh_manager::lookup (hlist(i)); + + if (h.ok ()) + close_figure (h); + } + + // They should all be closed now. If not, force them to close. + + hlist = do_figure_handle_list (true); + + for (octave_idx_type i = 0; i < hlist.numel (); i++) + { + graphics_handle h = gh_manager::lookup (hlist(i)); + + if (h.ok ()) + force_close_figure (h); + } + + // None left now, right? + + hlist = do_figure_handle_list (true); + + assert (hlist.numel () == 0); + + // Clear all callback objects from our list. + + callback_objects.clear (); +} + +static void +adopt (const graphics_handle& p, const graphics_handle& h) +{ + graphics_object parent_obj = gh_manager::get_object (p); + parent_obj.adopt (h); +} + +static bool +is_handle (const graphics_handle& h) +{ + return h.ok (); +} + +static bool +is_handle (double val) +{ + graphics_handle h = gh_manager::lookup (val); + + return h.ok (); +} + +static octave_value +is_handle (const octave_value& val) +{ + octave_value retval = false; + + if (val.is_real_scalar () && is_handle (val.double_value ())) + retval = true; + else if (val.is_numeric_type () && val.is_real_type ()) + { + const NDArray handles = val.array_value (); + + if (! error_state) + { + boolNDArray result (handles.dims ()); + + for (octave_idx_type i = 0; i < handles.numel (); i++) + result.xelem (i) = is_handle (handles (i)); + + retval = result; + } + } + + return retval; +} + +static bool +is_figure (double val) +{ + graphics_object obj = gh_manager::get_object (val); + + return obj && obj.isa ("figure"); +} + +static void +xcreatefcn (const graphics_handle& h) +{ + graphics_object obj = gh_manager::get_object (h); + obj.get_properties ().execute_createfcn (); +} + +static void +xinitialize (const graphics_handle& h) +{ + graphics_object go = gh_manager::get_object (h); + + if (go) + go.initialize (); +} + +// --------------------------------------------------------------------- + +void +base_graphics_toolkit::update (const graphics_handle& h, int id) +{ + graphics_object go = gh_manager::get_object (h); + + update (go, id); +} + +bool +base_graphics_toolkit::initialize (const graphics_handle& h) +{ + graphics_object go = gh_manager::get_object (h); + + return initialize (go); +} + +void +base_graphics_toolkit::finalize (const graphics_handle& h) +{ + graphics_object go = gh_manager::get_object (h); + + finalize (go); +} + +// --------------------------------------------------------------------- + +void +base_properties::set_from_list (base_graphics_object& obj, + property_list& defaults) +{ + std::string go_name = graphics_object_name (); + + property_list::plist_map_const_iterator p = defaults.find (go_name); + + if (p != defaults.end ()) + { + const property_list::pval_map_type pval_map = p->second; + + for (property_list::pval_map_const_iterator q = pval_map.begin (); + q != pval_map.end (); + q++) + { + std::string pname = q->first; + + obj.set (pname, q->second); + + if (error_state) + { + error ("error setting default property %s", pname.c_str ()); + break; + } + } + } +} + +octave_value +base_properties::get_dynamic (const caseless_str& name) const +{ + octave_value retval; + + std::map::const_iterator it = all_props.find (name); + + if (it != all_props.end ()) + retval = it->second.get (); + else + error ("get: unknown property \"%s\"", name.c_str ()); + + return retval; +} + +octave_value +base_properties::get_dynamic (bool all) const +{ + octave_scalar_map m; + + for (std::map::const_iterator it = all_props.begin (); + it != all_props.end (); ++it) + if (all || ! it->second.is_hidden ()) + m.assign (it->second.get_name (), it->second.get ()); + + return m; +} + +std::set +base_properties::dynamic_property_names (void) const +{ + return dynamic_properties; +} + +bool +base_properties::has_dynamic_property (const std::string& pname) +{ + const std::set& dynprops = dynamic_property_names (); + + if (dynprops.find (pname) != dynprops.end ()) + return true; + else + return all_props.find (pname) != all_props.end (); +} + +void +base_properties::set_dynamic (const caseless_str& pname, + const octave_value& val) +{ + std::map::iterator it = all_props.find (pname); + + if (it != all_props.end ()) + it->second.set (val); + else + error ("set: unknown property \"%s\"", pname.c_str ()); + + if (! error_state) + { + dynamic_properties.insert (pname); + + mark_modified (); + } +} + +property +base_properties::get_property_dynamic (const caseless_str& name) +{ + std::map::const_iterator it = all_props.find (name); + + if (it == all_props.end ()) + { + error ("get_property: unknown property \"%s\"", name.c_str ()); + return property (); + } + else + return it->second; +} + +void +base_properties::set_parent (const octave_value& val) +{ + double tmp = val.double_value (); + + graphics_handle new_parent = octave_NaN; + + if (! error_state) + { + new_parent = gh_manager::lookup (tmp); + + if (new_parent.ok ()) + { + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + + parent_obj.remove_child (__myhandle__); + + parent = new_parent.as_octave_value (); + + ::adopt (parent.handle_value (), __myhandle__); + } + else + error ("set: invalid graphics handle (= %g) for parent", tmp); + } + else + error ("set: expecting parent to be a graphics handle"); +} + +void +base_properties::mark_modified (void) +{ + __modified__ = "on"; + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + if (parent_obj) + parent_obj.mark_modified (); +} + +void +base_properties::override_defaults (base_graphics_object& obj) +{ + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + + if (parent_obj) + parent_obj.override_defaults (obj); +} + +void +base_properties::update_axis_limits (const std::string& axis_type) const +{ + graphics_object obj = gh_manager::get_object (__myhandle__); + + if (obj) + obj.update_axis_limits (axis_type); +} + +void +base_properties::update_axis_limits (const std::string& axis_type, + const graphics_handle& h) const +{ + graphics_object obj = gh_manager::get_object (__myhandle__); + + if (obj) + obj.update_axis_limits (axis_type, h); +} + +bool +base_properties::is_handle_visible (void) const +{ + return (handlevisibility.is ("on") + || (executing_callback && ! handlevisibility.is ("off"))); +} + +graphics_toolkit +base_properties::get_toolkit (void) const +{ + graphics_object go = gh_manager::get_object (get_parent ()); + + if (go) + return go.get_toolkit (); + else + return graphics_toolkit (); +} + +void +base_properties::update_boundingbox (void) +{ + Matrix kids = get_children (); + + for (int i = 0; i < kids.numel (); i++) + { + graphics_object go = gh_manager::get_object (kids(i)); + + if (go.valid_object ()) + go.get_properties ().update_boundingbox (); + } +} + +void +base_properties::update_autopos (const std::string& elem_type) +{ + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + + if (parent_obj.valid_object ()) + parent_obj.get_properties ().update_autopos (elem_type); +} + +void +base_properties::add_listener (const caseless_str& nm, const octave_value& v, + listener_mode mode) +{ + property p = get_property (nm); + + if (! error_state && p.ok ()) + p.add_listener (v, mode); +} + +void +base_properties::delete_listener (const caseless_str& nm, + const octave_value& v, listener_mode mode) +{ + property p = get_property (nm); + + if (! error_state && p.ok ()) + p.delete_listener (v, mode); +} + +// --------------------------------------------------------------------- + +void +base_graphics_object::update_axis_limits (const std::string& axis_type) +{ + if (valid_object ()) + { + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + + if (parent_obj) + parent_obj.update_axis_limits (axis_type); + } + else + error ("base_graphics_object::update_axis_limits: invalid graphics object"); +} + +void +base_graphics_object::update_axis_limits (const std::string& axis_type, + const graphics_handle& h) +{ + if (valid_object ()) + { + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + + if (parent_obj) + parent_obj.update_axis_limits (axis_type, h); + } + else + error ("base_graphics_object::update_axis_limits: invalid graphics object"); +} + +void +base_graphics_object::remove_all_listeners (void) +{ + octave_map m = get (true).map_value (); + + for (octave_map::const_iterator pa = m.begin (); pa != m.end (); pa++) + { + // FIXME -- there has to be a better way. I think we want to + // ask whether it is OK to delete the listener for the given + // property. How can we know in advance that it will be OK? + + unwind_protect frame; + + frame.protect_var (error_state); + frame.protect_var (discard_error_messages); + frame.protect_var (Vdebug_on_error); + frame.protect_var (Vdebug_on_warning); + + discard_error_messages = true; + Vdebug_on_error = false; + Vdebug_on_warning = false; + + property p = get_properties ().get_property (pa->first); + + if (! error_state && p.ok ()) + p.delete_listener (); + } +} + +std::string +base_graphics_object::values_as_string (void) +{ + std::string retval; + + if (valid_object ()) + { + octave_map m = get ().map_value (); + + for (octave_map::const_iterator pa = m.begin (); pa != m.end (); pa++) + { + if (pa->first != "children") + { + property p = get_properties ().get_property (pa->first); + + if (p.ok () && ! p.is_hidden ()) + { + retval += "\n\t" + std::string (pa->first) + ": "; + if (p.is_radio ()) + retval += p.values_as_string (); + } + } + } + if (retval != "") + retval += "\n"; + } + else + error ("base_graphics_object::values_as_string: invalid graphics object"); + + return retval; +} + +octave_scalar_map +base_graphics_object::values_as_struct (void) +{ + octave_scalar_map retval; + + if (valid_object ()) + { + octave_scalar_map m = get ().scalar_map_value (); + + for (octave_scalar_map::const_iterator pa = m.begin (); + pa != m.end (); pa++) + { + if (pa->first != "children") + { + property p = get_properties ().get_property (pa->first); + + if (p.ok () && ! p.is_hidden ()) + { + if (p.is_radio ()) + retval.assign (p.get_name (), p.values_as_cell ()); + else + retval.assign (p.get_name (), Cell ()); + } + } + } + } + else + error ("base_graphics_object::values_as_struct: invalid graphics object"); + + return retval; +} + +graphics_object +graphics_object::get_ancestor (const std::string& obj_type) const +{ + if (valid_object ()) + { + if (isa (obj_type)) + return *this; + else + return gh_manager::get_object (get_parent ()).get_ancestor (obj_type); + } + else + return graphics_object (); +} + +// --------------------------------------------------------------------- + +#include "graphics-props.cc" + +// --------------------------------------------------------------------- + +void +root_figure::properties::set_currentfigure (const octave_value& v) +{ + graphics_handle val (v); + + if (error_state) + return; + + if (xisnan (val.value ()) || is_handle (val)) + { + currentfigure = val; + + if (val.ok ()) + gh_manager::push_figure (val); + } + else + gripe_set_invalid ("currentfigure"); +} + +void +root_figure::properties::set_callbackobject (const octave_value& v) +{ + graphics_handle val (v); + + if (error_state) + return; + + if (xisnan (val.value ())) + { + if (! cbo_stack.empty ()) + { + val = cbo_stack.front (); + + cbo_stack.pop_front (); + } + + callbackobject = val; + } + else if (is_handle (val)) + { + if (get_callbackobject ().ok ()) + cbo_stack.push_front (get_callbackobject ()); + + callbackobject = val; + } + else + gripe_set_invalid ("callbackobject"); +} + +void +figure::properties::set_integerhandle (const octave_value& val) +{ + if (! error_state) + { + if (integerhandle.set (val, true)) + { + bool int_fig_handle = integerhandle.is_on (); + + graphics_object this_go = gh_manager::get_object (__myhandle__); + + graphics_handle old_myhandle = __myhandle__; + + __myhandle__ = gh_manager::get_handle (int_fig_handle); + + gh_manager::renumber_figure (old_myhandle, __myhandle__); + + graphics_object parent_go = gh_manager::get_object (get_parent ()); + + base_properties& props = parent_go.get_properties (); + + props.renumber_child (old_myhandle, __myhandle__); + + Matrix kids = get_children (); + + for (octave_idx_type i = 0; i < kids.numel (); i++) + { + graphics_object kid = gh_manager::get_object (kids(i)); + + kid.get_properties ().renumber_parent (__myhandle__); + } + + graphics_handle cf = gh_manager::current_figure (); + + if (__myhandle__ == cf) + xset (0, "currentfigure", __myhandle__.value ()); + + this_go.update (integerhandle.get_id ()); + + mark_modified (); + } + } +} + +// FIXME This should update monitorpositions and pointerlocation, but +// as these properties are yet used, and so it doesn't matter that they +// aren't set yet. +void +root_figure::properties::update_units (void) +{ + caseless_str xunits = get_units (); + + Matrix ss = default_screensize (); + + double dpi = get_screenpixelsperinch (); + + if (xunits.compare ("inches")) + { + ss(0) = 0; + ss(1) = 0; + ss(2) /= dpi; + ss(3) /= dpi; + } + else if (xunits.compare ("centimeters")) + { + ss(0) = 0; + ss(1) = 0; + ss(2) *= 2.54 / dpi; + ss(3) *= 2.54 / dpi; + } + else if (xunits.compare ("normalized")) + { + ss = Matrix (1, 4, 1.0); + ss(0) = 0; + ss(1) = 0; + } + else if (xunits.compare ("points")) + { + ss(0) = 0; + ss(1) = 0; + ss(2) *= 72 / dpi; + ss(3) *= 72 / dpi; + } + + set_screensize (ss); +} + +Matrix +root_figure::properties::get_boundingbox (bool, const Matrix&) const +{ + Matrix screen_size = screen_size_pixels (); + Matrix pos = Matrix (1, 4, 0); + pos(2) = screen_size(0); + pos(3) = screen_size(1); + return pos; +} + +/* +%!test +%! set (0, "units", "pixels"); +%! sz = get (0, "screensize") - [1, 1, 0, 0]; +%! dpi = get (0, "screenpixelsperinch"); +%! set (0, "units", "inches"); +%! assert (get (0, "screensize"), sz / dpi, 0.5 / dpi); +%! set (0, "units", "centimeters"); +%! assert (get (0, "screensize"), sz / dpi * 2.54, 0.5 / dpi * 2.54); +%! set (0, "units", "points"); +%! assert (get (0, "screensize"), sz / dpi * 72, 0.5 / dpi * 72); +%! set (0, "units", "normalized"); +%! assert (get (0, "screensize"), [0.0, 0.0, 1.0, 1.0]); +%! set (0, "units", "pixels"); +%! assert (get (0, "screensize"), sz + [1, 1, 0, 0]); +*/ + +void +root_figure::properties::remove_child (const graphics_handle& gh) +{ + gh_manager::pop_figure (gh); + + graphics_handle cf = gh_manager::current_figure (); + + xset (0, "currentfigure", cf.value ()); + + base_properties::remove_child (gh); +} + +property_list +root_figure::factory_properties = root_figure::init_factory_properties (); + +static void +reset_default_properties (property_list& default_properties) +{ + property_list new_defaults; + + for (property_list::plist_map_const_iterator p = default_properties.begin (); + p != default_properties.end (); p++) + { + const property_list::pval_map_type pval_map = p->second; + std::string prefix = p->first; + + for (property_list::pval_map_const_iterator q = pval_map.begin (); + q != pval_map.end (); + q++) + { + std::string s = q->first; + + if (prefix == "axes" && (s == "position" || s == "units")) + new_defaults.set (prefix + s, q->second); + else if (prefix == "figure" && (s == "position" || s == "units" + || s == "windowstyle" + || s == "paperunits")) + new_defaults.set (prefix + s, q->second); + } + } + + default_properties = new_defaults; +} + +void +root_figure::reset_default_properties (void) +{ + ::reset_default_properties (default_properties); +} + +// --------------------------------------------------------------------- + +void +figure::properties::set_currentaxes (const octave_value& v) +{ + graphics_handle val (v); + + if (error_state) + return; + + if (xisnan (val.value ()) || is_handle (val)) + currentaxes = val; + else + gripe_set_invalid ("currentaxes"); +} + +void +figure::properties::remove_child (const graphics_handle& gh) +{ + base_properties::remove_child (gh); + + if (gh == currentaxes.handle_value ()) + { + graphics_handle new_currentaxes; + + Matrix kids = get_children (); + + for (octave_idx_type i = 0; i < kids.numel (); i++) + { + graphics_handle kid = kids(i); + + graphics_object go = gh_manager::get_object (kid); + + if (go.isa ("axes")) + { + new_currentaxes = kid; + break; + } + } + + currentaxes = new_currentaxes; + } +} + +void +figure::properties::set_visible (const octave_value& val) +{ + std::string s = val.string_value (); + + if (! error_state) + { + if (s == "on") + xset (0, "currentfigure", __myhandle__.value ()); + + visible = val; + } +} + +Matrix +figure::properties::get_boundingbox (bool internal, const Matrix&) const +{ + Matrix screen_size = screen_size_pixels (); + Matrix pos = (internal ? + get_position ().matrix_value () : + get_outerposition ().matrix_value ()); + + pos = convert_position (pos, get_units (), "pixels", screen_size); + + pos(0)--; + pos(1)--; + pos(1) = screen_size(1) - pos(1) - pos(3); + + return pos; +} + +void +figure::properties::set_boundingbox (const Matrix& bb, bool internal, + bool do_notify_toolkit) +{ + Matrix screen_size = screen_size_pixels (); + Matrix pos = bb; + + pos(1) = screen_size(1) - pos(1) - pos(3); + pos(1)++; + pos(0)++; + pos = convert_position (pos, "pixels", get_units (), screen_size); + + if (internal) + set_position (pos, do_notify_toolkit); + else + set_outerposition (pos, do_notify_toolkit); +} + +Matrix +figure::properties::map_from_boundingbox (double x, double y) const +{ + Matrix bb = get_boundingbox (true); + Matrix pos (1, 2, 0); + + pos(0) = x; + pos(1) = y; + + pos(1) = bb(3) - pos(1); + pos(0)++; + pos = convert_position (pos, "pixels", get_units (), + bb.extract_n (0, 2, 1, 2)); + + return pos; +} + +Matrix +figure::properties::map_to_boundingbox (double x, double y) const +{ + Matrix bb = get_boundingbox (true); + Matrix pos (1, 2, 0); + + pos(0) = x; + pos(1) = y; + + pos = convert_position (pos, get_units (), "pixels", + bb.extract_n (0, 2, 1, 2)); + pos(0)--; + pos(1) = bb(3) - pos(1); + + return pos; +} + +void +figure::properties::set_position (const octave_value& v, + bool do_notify_toolkit) +{ + if (! error_state) + { + Matrix old_bb, new_bb; + bool modified = false; + + old_bb = get_boundingbox (true); + modified = position.set (v, false, do_notify_toolkit); + new_bb = get_boundingbox (true); + + if (old_bb != new_bb) + { + if (old_bb(2) != new_bb(2) || old_bb(3) != new_bb(3)) + { + execute_resizefcn (); + update_boundingbox (); + } + } + + if (modified) + { + position.run_listeners (POSTSET); + mark_modified (); + } + } +} + +void +figure::properties::set_outerposition (const octave_value& v, + bool do_notify_toolkit) +{ + if (! error_state) + { + if (outerposition.set (v, true, do_notify_toolkit)) + { + mark_modified (); + } + } +} + +void +figure::properties::set_paperunits (const octave_value& v) +{ + if (! error_state) + { + caseless_str typ = get_papertype (); + caseless_str punits = v.string_value (); + if (! error_state) + { + if (punits.compare ("normalized") && typ.compare ("")) + error ("set: can't set the paperunits to normalized when the papertype is custom"); + else + { + caseless_str old_paperunits = get_paperunits (); + if (paperunits.set (v, true)) + { + update_paperunits (old_paperunits); + mark_modified (); + } + } + } + } +} + +void +figure::properties::set_papertype (const octave_value& v) +{ + if (! error_state) + { + caseless_str typ = v.string_value (); + caseless_str punits = get_paperunits (); + if (! error_state) + { + if (punits.compare ("normalized") && typ.compare ("")) + error ("set: can't set the paperunits to normalized when the papertype is custom"); + else + { + if (papertype.set (v, true)) + { + update_papertype (); + mark_modified (); + } + } + } + } +} + +static Matrix +papersize_from_type (const caseless_str punits, const caseless_str typ) +{ + Matrix ret (1, 2, 1.0); + + if (! punits.compare ("normalized")) + { + double in2units; + double mm2units; + + if (punits.compare ("inches")) + { + in2units = 1.0; + mm2units = 1 / 25.4 ; + } + else if (punits.compare ("centimeters")) + { + in2units = 2.54; + mm2units = 1 / 10.0; + } + else // points + { + in2units = 72.0; + mm2units = 72.0 / 25.4; + } + + if (typ.compare ("usletter")) + { + ret (0) = 8.5 * in2units; + ret (1) = 11.0 * in2units; + } + else if (typ.compare ("uslegal")) + { + ret (0) = 8.5 * in2units; + ret (1) = 14.0 * in2units; + } + else if (typ.compare ("tabloid")) + { + ret (0) = 11.0 * in2units; + ret (1) = 17.0 * in2units; + } + else if (typ.compare ("a0")) + { + ret (0) = 841.0 * mm2units; + ret (1) = 1189.0 * mm2units; + } + else if (typ.compare ("a1")) + { + ret (0) = 594.0 * mm2units; + ret (1) = 841.0 * mm2units; + } + else if (typ.compare ("a2")) + { + ret (0) = 420.0 * mm2units; + ret (1) = 594.0 * mm2units; + } + else if (typ.compare ("a3")) + { + ret (0) = 297.0 * mm2units; + ret (1) = 420.0 * mm2units; + } + else if (typ.compare ("a4")) + { + ret (0) = 210.0 * mm2units; + ret (1) = 297.0 * mm2units; + } + else if (typ.compare ("a5")) + { + ret (0) = 148.0 * mm2units; + ret (1) = 210.0 * mm2units; + } + else if (typ.compare ("b0")) + { + ret (0) = 1029.0 * mm2units; + ret (1) = 1456.0 * mm2units; + } + else if (typ.compare ("b1")) + { + ret (0) = 728.0 * mm2units; + ret (1) = 1028.0 * mm2units; + } + else if (typ.compare ("b2")) + { + ret (0) = 514.0 * mm2units; + ret (1) = 728.0 * mm2units; + } + else if (typ.compare ("b3")) + { + ret (0) = 364.0 * mm2units; + ret (1) = 514.0 * mm2units; + } + else if (typ.compare ("b4")) + { + ret (0) = 257.0 * mm2units; + ret (1) = 364.0 * mm2units; + } + else if (typ.compare ("b5")) + { + ret (0) = 182.0 * mm2units; + ret (1) = 257.0 * mm2units; + } + else if (typ.compare ("arch-a")) + { + ret (0) = 9.0 * in2units; + ret (1) = 12.0 * in2units; + } + else if (typ.compare ("arch-b")) + { + ret (0) = 12.0 * in2units; + ret (1) = 18.0 * in2units; + } + else if (typ.compare ("arch-c")) + { + ret (0) = 18.0 * in2units; + ret (1) = 24.0 * in2units; + } + else if (typ.compare ("arch-d")) + { + ret (0) = 24.0 * in2units; + ret (1) = 36.0 * in2units; + } + else if (typ.compare ("arch-e")) + { + ret (0) = 36.0 * in2units; + ret (1) = 48.0 * in2units; + } + else if (typ.compare ("a")) + { + ret (0) = 8.5 * in2units; + ret (1) = 11.0 * in2units; + } + else if (typ.compare ("b")) + { + ret (0) = 11.0 * in2units; + ret (1) = 17.0 * in2units; + } + else if (typ.compare ("c")) + { + ret (0) = 17.0 * in2units; + ret (1) = 22.0 * in2units; + } + else if (typ.compare ("d")) + { + ret (0) = 22.0 * in2units; + ret (1) = 34.0 * in2units; + } + else if (typ.compare ("e")) + { + ret (0) = 34.0 * in2units; + ret (1) = 43.0 * in2units; + } + } + + return ret; +} + +void +figure::properties::update_paperunits (const caseless_str& old_paperunits) +{ + Matrix pos = get_paperposition ().matrix_value (); + Matrix sz = get_papersize ().matrix_value (); + + pos(0) /= sz(0); + pos(1) /= sz(1); + pos(2) /= sz(0); + pos(3) /= sz(1); + + std::string porient = get_paperorientation (); + caseless_str punits = get_paperunits (); + caseless_str typ = get_papertype (); + + if (typ.compare ("")) + { + if (old_paperunits.compare ("centimeters")) + { + sz(0) /= 2.54; + sz(1) /= 2.54; + } + else if (old_paperunits.compare ("points")) + { + sz(0) /= 72.0; + sz(1) /= 72.0; + } + + if (punits.compare ("centimeters")) + { + sz(0) *= 2.54; + sz(1) *= 2.54; + } + else if (punits.compare ("points")) + { + sz(0) *= 72.0; + sz(1) *= 72.0; + } + } + else + { + sz = papersize_from_type (punits, typ); + if (porient == "landscape") + std::swap (sz(0), sz(1)); + } + + pos(0) *= sz(0); + pos(1) *= sz(1); + pos(2) *= sz(0); + pos(3) *= sz(1); + + papersize.set (octave_value (sz)); + paperposition.set (octave_value (pos)); +} + +void +figure::properties::update_papertype (void) +{ + caseless_str typ = get_papertype (); + if (! typ.compare ("")) + { + Matrix sz = papersize_from_type (get_paperunits (), typ); + if (get_paperorientation () == "landscape") + std::swap (sz(0), sz(1)); + // Call papersize.set rather than set_papersize to avoid loops + // between update_papersize and update_papertype + papersize.set (octave_value (sz)); + } +} + +void +figure::properties::update_papersize (void) +{ + Matrix sz = get_papersize ().matrix_value (); + if (sz(0) > sz(1)) + { + std::swap (sz(0), sz(1)); + papersize.set (octave_value (sz)); + paperorientation.set (octave_value ("landscape")); + } + else + { + paperorientation.set ("portrait"); + } + std::string punits = get_paperunits (); + if (punits == "centimeters") + { + sz(0) /= 2.54; + sz(1) /= 2.54; + } + else if (punits == "points") + { + sz(0) /= 72.0; + sz(1) /= 72.0; + } + if (punits == "normalized") + { + caseless_str typ = get_papertype (); + if (get_papertype () == "") + error ("set: can't set the papertype to when the paperunits is normalized"); + } + else + { + // TODO - the papersizes info is also in papersize_from_type(). + // Both should be rewritten to avoid the duplication. + std::string typ = ""; + const double mm2in = 1.0 / 25.4; + const double tol = 0.01; + + if (std::abs (sz(0) - 8.5) + std::abs (sz(1) - 11.0) < tol) + typ = "usletter"; + else if (std::abs (sz(0) - 8.5) + std::abs (sz(1) - 14.0) < tol) + typ = "uslegal"; + else if (std::abs (sz(0) - 11.0) + std::abs (sz(1) - 17.0) < tol) + typ = "tabloid"; + else if (std::abs (sz(0) - 841.0 * mm2in) + std::abs (sz(1) - 1198.0 * mm2in) < tol) + typ = "a0"; + else if (std::abs (sz(0) - 594.0 * mm2in) + std::abs (sz(1) - 841.0 * mm2in) < tol) + typ = "a1"; + else if (std::abs (sz(0) - 420.0 * mm2in) + std::abs (sz(1) - 594.0 * mm2in) < tol) + typ = "a2"; + else if (std::abs (sz(0) - 297.0 * mm2in) + std::abs (sz(1) - 420.0 * mm2in) < tol) + typ = "a3"; + else if (std::abs (sz(0) - 210.0 * mm2in) + std::abs (sz(1) - 297.0 * mm2in) < tol) + typ = "a4"; + else if (std::abs (sz(0) - 148.0 * mm2in) + std::abs (sz(1) - 210.0 * mm2in) < tol) + typ = "a5"; + else if (std::abs (sz(0) - 1029.0 * mm2in) + std::abs (sz(1) - 1456.0 * mm2in) < tol) + typ = "b0"; + else if (std::abs (sz(0) - 728.0 * mm2in) + std::abs (sz(1) - 1028.0 * mm2in) < tol) + typ = "b1"; + else if (std::abs (sz(0) - 514.0 * mm2in) + std::abs (sz(1) - 728.0 * mm2in) < tol) + typ = "b2"; + else if (std::abs (sz(0) - 364.0 * mm2in) + std::abs (sz(1) - 514.0 * mm2in) < tol) + typ = "b3"; + else if (std::abs (sz(0) - 257.0 * mm2in) + std::abs (sz(1) - 364.0 * mm2in) < tol) + typ = "b4"; + else if (std::abs (sz(0) - 182.0 * mm2in) + std::abs (sz(1) - 257.0 * mm2in) < tol) + typ = "b5"; + else if (std::abs (sz(0) - 9.0) + std::abs (sz(1) - 12.0) < tol) + typ = "arch-a"; + else if (std::abs (sz(0) - 12.0) + std::abs (sz(1) - 18.0) < tol) + typ = "arch-b"; + else if (std::abs (sz(0) - 18.0) + std::abs (sz(1) - 24.0) < tol) + typ = "arch-c"; + else if (std::abs (sz(0) - 24.0) + std::abs (sz(1) - 36.0) < tol) + typ = "arch-d"; + else if (std::abs (sz(0) - 36.0) + std::abs (sz(1) - 48.0) < tol) + typ = "arch-e"; + else if (std::abs (sz(0) - 8.5) + std::abs (sz(1) - 11.0) < tol) + typ = "a"; + else if (std::abs (sz(0) - 11.0) + std::abs (sz(1) - 17.0) < tol) + typ = "b"; + else if (std::abs (sz(0) - 17.0) + std::abs (sz(1) - 22.0) < tol) + typ = "c"; + else if (std::abs (sz(0) - 22.0) + std::abs (sz(1) - 34.0) < tol) + typ = "d"; + else if (std::abs (sz(0) - 34.0) + std::abs (sz(1) - 43.0) < tol) + typ = "e"; + // Call papertype.set rather than set_papertype to avoid loops between + // update_papersize and update_papertype + papertype.set (typ); + } + if (punits == "centimeters") + { + sz(0) *= 2.54; + sz(1) *= 2.54; + } + else if (punits == "points") + { + sz(0) *= 72.0; + sz(1) *= 72.0; + } + if (get_paperorientation () == "landscape") + { + std::swap (sz(0), sz(1)); + papersize.set (octave_value (sz)); + } +} + +/* +%!test +%! figure (1, "visible", "off"); +%! set (1, "paperunits", "inches"); +%! set (1, "papersize", [5, 4]); +%! set (1, "paperunits", "points"); +%! assert (get (1, "papersize"), [5, 4] * 72, 1); +%! papersize = get (gcf, "papersize"); +%! set (1, "papersize", papersize + 1); +%! set (1, "papersize", papersize); +%! assert (get (1, "papersize"), [5, 4] * 72, 1); +%! close (1); +%!test +%! figure (1, "visible", "off"); +%! set (1, "paperunits", "inches"); +%! set (1, "papersize", [5, 4]); +%! set (1, "paperunits", "centimeters"); +%! assert (get (1, "papersize"), [5, 4] * 2.54, 2.54/72); +%! papersize = get (gcf, "papersize"); +%! set (1, "papersize", papersize + 1); +%! set (1, "papersize", papersize); +%! assert (get (1, "papersize"), [5, 4] * 2.54, 2.54/72); +%! close (1); +*/ + +void +figure::properties::update_paperorientation (void) +{ + std::string porient = get_paperorientation (); + Matrix sz = get_papersize ().matrix_value (); + Matrix pos = get_paperposition ().matrix_value (); + if ((sz(0) > sz(1) && porient == "portrait") + || (sz(0) < sz(1) && porient == "landscape")) + { + std::swap (sz(0), sz(1)); + std::swap (pos(0), pos(1)); + std::swap (pos(2), pos(3)); + // Call papertype.set rather than set_papertype to avoid loops + // between update_papersize and update_papertype + papersize.set (octave_value (sz)); + paperposition.set (octave_value (pos)); + } +} + +/* +%!test +%! figure (1, "visible", false); +%! tol = 100 * eps (); +%! ## UPPER case and MiXed case is part of test and should not be changed. +%! set (gcf (), "paperorientation", "PORTRAIT"); +%! set (gcf (), "paperunits", "inches"); +%! set (gcf (), "papertype", "USletter"); +%! assert (get (gcf (), "papersize"), [8.5, 11.0], tol); +%! set (gcf (), "paperorientation", "Landscape"); +%! assert (get (gcf (), "papersize"), [11.0, 8.5], tol); +%! set (gcf (), "paperunits", "centimeters"); +%! assert (get (gcf (), "papersize"), [11.0, 8.5] * 2.54, tol); +%! set (gcf (), "papertype", "a4"); +%! assert (get (gcf (), "papersize"), [29.7, 21.0], tol); +%! set (gcf (), "paperunits", "inches", "papersize", [8.5, 11.0]); +%! assert (get (gcf (), "papertype"), "usletter"); +%! assert (get (gcf (), "paperorientation"), "portrait"); +%! set (gcf (), "papersize", [11.0, 8.5]); +%! assert (get (gcf (), "papertype"), "usletter"); +%! assert (get (gcf (), "paperorientation"), "landscape"); +*/ + +void +figure::properties::set_units (const octave_value& v) +{ + if (! error_state) + { + caseless_str old_units = get_units (); + if (units.set (v, true)) + { + update_units (old_units); + mark_modified (); + } + } +} + +void +figure::properties::update_units (const caseless_str& old_units) +{ + position.set (convert_position (get_position ().matrix_value (), old_units, + get_units (), screen_size_pixels ()), false); +} + +/* +%!test +%! figure (1, "visible", false); +%! set (0, "units", "pixels"); +%! rsz = get (0, "screensize"); +%! set (gcf (), "units", "pixels"); +%! fsz = get (gcf (), "position"); +%! set (gcf (), "units", "normalized"); +%! assert (get (gcf (), "position"), (fsz - [1, 1, 0, 0]) ./ rsz([3, 4, 3, 4])); +*/ + +std::string +figure::properties::get_title (void) const +{ + if (is_numbertitle ()) + { + std::ostringstream os; + std::string nm = get_name (); + + os << "Figure " << __myhandle__.value (); + if (! nm.empty ()) + os << ": " << get_name (); + + return os.str (); + } + else + return get_name (); +} + +octave_value +figure::get_default (const caseless_str& name) const +{ + octave_value retval = default_properties.lookup (name); + + if (retval.is_undefined ()) + { + graphics_handle parent = get_parent (); + graphics_object parent_obj = gh_manager::get_object (parent); + + retval = parent_obj.get_default (name); + } + + return retval; +} + +void +figure::reset_default_properties (void) +{ + ::reset_default_properties (default_properties); +} + +// --------------------------------------------------------------------- + +void +axes::properties::init (void) +{ + position.add_constraint (dim_vector (1, 4)); + position.add_constraint (dim_vector (0, 0)); + outerposition.add_constraint (dim_vector (1, 4)); + colororder.add_constraint (dim_vector (-1, 3)); + dataaspectratio.add_constraint (dim_vector (1, 3)); + plotboxaspectratio.add_constraint (dim_vector (1, 3)); + xlim.add_constraint (2); + ylim.add_constraint (2); + zlim.add_constraint (2); + clim.add_constraint (2); + alim.add_constraint (2); + xtick.add_constraint (dim_vector (1, -1)); + ytick.add_constraint (dim_vector (1, -1)); + ztick.add_constraint (dim_vector (1, -1)); + Matrix vw (1, 2, 0); + vw(1) = 90; + view = vw; + view.add_constraint (dim_vector (1, 2)); + cameraposition.add_constraint (dim_vector (1, 3)); + Matrix upv (1, 3, 0.0); + upv(2) = 1.0; + cameraupvector = upv; + cameraupvector.add_constraint (dim_vector (1, 3)); + currentpoint.add_constraint (dim_vector (2, 3)); + ticklength.add_constraint (dim_vector (1, 2)); + tightinset.add_constraint (dim_vector (1, 4)); + looseinset.add_constraint (dim_vector (1, 4)); + update_font (); + + x_zlim.resize (1, 2); + + sx = "linear"; + sy = "linear"; + sz = "linear"; + + calc_ticklabels (xtick, xticklabel, xscale.is ("log")); + calc_ticklabels (ytick, yticklabel, yscale.is ("log")); + calc_ticklabels (ztick, zticklabel, zscale.is ("log")); + + xset (xlabel.handle_value (), "handlevisibility", "off"); + xset (ylabel.handle_value (), "handlevisibility", "off"); + xset (zlabel.handle_value (), "handlevisibility", "off"); + xset (title.handle_value (), "handlevisibility", "off"); + + xset (xlabel.handle_value (), "horizontalalignment", "center"); + xset (xlabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (ylabel.handle_value (), "horizontalalignment", "center"); + xset (ylabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (zlabel.handle_value (), "horizontalalignment", "right"); + xset (zlabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (title.handle_value (), "horizontalalignment", "center"); + xset (title.handle_value (), "horizontalalignmentmode", "auto"); + + xset (xlabel.handle_value (), "verticalalignment", "top"); + xset (xlabel.handle_value (), "verticalalignmentmode", "auto"); + xset (ylabel.handle_value (), "verticalalignment", "bottom"); + xset (ylabel.handle_value (), "verticalalignmentmode", "auto"); + xset (title.handle_value (), "verticalalignment", "bottom"); + xset (title.handle_value (), "verticalalignmentmode", "auto"); + + xset (ylabel.handle_value (), "rotation", 90.0); + xset (ylabel.handle_value (), "rotationmode", "auto"); + + xset (zlabel.handle_value (), "visible", "off"); + + xset (xlabel.handle_value (), "clipping", "off"); + xset (ylabel.handle_value (), "clipping", "off"); + xset (zlabel.handle_value (), "clipping", "off"); + xset (title.handle_value (), "clipping", "off"); + + xset (xlabel.handle_value (), "autopos_tag", "xlabel"); + xset (ylabel.handle_value (), "autopos_tag", "ylabel"); + xset (zlabel.handle_value (), "autopos_tag", "zlabel"); + xset (title.handle_value (), "autopos_tag", "title"); + + adopt (xlabel.handle_value ()); + adopt (ylabel.handle_value ()); + adopt (zlabel.handle_value ()); + adopt (title.handle_value ()); + + Matrix tlooseinset = default_axes_position (); + tlooseinset(2) = 1-tlooseinset(0)-tlooseinset(2); + tlooseinset(3) = 1-tlooseinset(1)-tlooseinset(3); + looseinset = tlooseinset; +} + +Matrix +axes::properties::calc_tightbox (const Matrix& init_pos) +{ + Matrix pos = init_pos; + graphics_object obj = gh_manager::get_object (get_parent ()); + Matrix parent_bb = obj.get_properties ().get_boundingbox (true); + Matrix ext = get_extent (true, true); + ext(1) = parent_bb(3) - ext(1) - ext(3); + ext(0)++; + ext(1)++; + ext = convert_position (ext, "pixels", get_units (), + parent_bb.extract_n (0, 2, 1, 2)); + if (ext(0) < pos(0)) + { + pos(2) += pos(0)-ext(0); + pos(0) = ext(0); + } + if (ext(0)+ext(2) > pos(0)+pos(2)) + pos(2) = ext(0)+ext(2)-pos(0); + + if (ext(1) < pos(1)) + { + pos(3) += pos(1)-ext(1); + pos(1) = ext(1); + } + if (ext(1)+ext(3) > pos(1)+pos(3)) + pos(3) = ext(1)+ext(3)-pos(1); + return pos; +} + +void +axes::properties::sync_positions (void) +{ + Matrix ref_linset = looseinset.get ().matrix_value (); + if (autopos_tag_is ("subplot")) + { + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + if (parent_obj.isa ("figure")) + { + // FIXME: temporarily changed units should be protected + // from interrupts + std::string fig_units = parent_obj.get ("units").string_value (); + parent_obj.set ("units", "pixels"); + + Matrix ref_outbox = outerposition.get ().matrix_value (); + ref_outbox(2) += ref_outbox(0); + ref_outbox(3) += ref_outbox(1); + + // Find those subplots that are left, right, bottom and top aligned + // with the current subplot + Matrix kids = parent_obj.get_properties ().get_children (); + std::vector aligned; + std::vector l_aligned, b_aligned, r_aligned, t_aligned; + for (octave_idx_type i = 0; i < kids.numel (); i++) + { + graphics_object go = gh_manager::get_object (kids(i)); + if (go.isa ("axes")) + { + axes::properties& props = + dynamic_cast (go.get_properties ()); + if (props.autopos_tag_is ("subplot")) + { + Matrix outpos = go.get ("outerposition").matrix_value (); + bool l_align = (std::abs (outpos(0)-ref_outbox(0)) < 1e-15); + bool b_align = (std::abs (outpos(1)-ref_outbox(1)) < 1e-15); + bool r_align = (std::abs (outpos(0)+outpos(2)-ref_outbox(2)) < 1e-15); + bool t_align = (std::abs (outpos(1)+outpos(3)-ref_outbox(3)) < 1e-15); + if (l_align || b_align || r_align || t_align) + { + aligned.push_back (kids(i)); + l_aligned.push_back (l_align); + b_aligned.push_back (b_align); + r_aligned.push_back (r_align); + t_aligned.push_back (t_align); + // FIXME: the temporarily deleted tags should be + // protected from interrupts + props.set_autopos_tag ("none"); + } + } + } + } + // Determine a minimum box which aligns the subplots + Matrix ref_box (1, 4, 0.); + ref_box(2) = 1.; + ref_box(3) = 1.; + for (size_t i = 0; i < aligned.size (); i++) + { + graphics_object go = gh_manager::get_object (aligned[i]); + axes::properties& props = + dynamic_cast (go.get_properties ()); + Matrix linset = props.get_looseinset ().matrix_value (); + if (l_aligned[i]) + linset(0) = std::min (0., linset(0)-0.01); + if (b_aligned[i]) + linset(1) = std::min (0., linset(1)-0.01); + if (r_aligned[i]) + linset(2) = std::min (0., linset(2)-0.01); + if (t_aligned[i]) + linset(3) = std::min (0., linset(3)-0.01); + props.set_looseinset (linset); + Matrix pos = props.get_position ().matrix_value (); + if (l_aligned[i]) + ref_box(0) = std::max (ref_box(0), pos(0)); + if (b_aligned[i]) + ref_box(1) = std::max (ref_box(1), pos(1)); + if (r_aligned[i]) + ref_box(2) = std::min (ref_box(2), pos(0)+pos(2)); + if (t_aligned[i]) + ref_box(3) = std::min (ref_box(3), pos(1)+pos(3)); + } + // Set common looseinset values for all aligned subplots and + // revert their tag values + for (size_t i = 0; i < aligned.size (); i++) + { + graphics_object go = gh_manager::get_object (aligned[i]); + axes::properties& props = + dynamic_cast (go.get_properties ()); + Matrix outpos = props.get_outerposition ().matrix_value (); + Matrix linset = props.get_looseinset ().matrix_value (); + if (l_aligned[i]) + linset(0) = (ref_box(0)-outpos(0))/outpos(2); + if (b_aligned[i]) + linset(1) = (ref_box(1)-outpos(1))/outpos(3); + if (r_aligned[i]) + linset(2) = (outpos(0)+outpos(2)-ref_box(2))/outpos(2); + if (t_aligned[i]) + linset(3) = (outpos(1)+outpos(3)-ref_box(3))/outpos(3); + props.set_looseinset (linset); + props.set_autopos_tag ("subplot"); + } + parent_obj.set ("units", fig_units); + } + } + else + sync_positions (ref_linset); +} + +void +axes::properties::sync_positions (const Matrix& linset) +{ + Matrix pos = position.get ().matrix_value (); + Matrix outpos = outerposition.get ().matrix_value (); + double lratio = linset(0); + double bratio = linset(1); + double wratio = 1-linset(0)-linset(2); + double hratio = 1-linset(1)-linset(3); + if (activepositionproperty.is ("outerposition")) + { + pos = outpos; + pos(0) = outpos(0)+lratio*outpos(2); + pos(1) = outpos(1)+bratio*outpos(3); + pos(2) = wratio*outpos(2); + pos(3) = hratio*outpos(3); + + position = pos; + update_transform (); + Matrix tightpos = calc_tightbox (pos); + + double thrshldx = 0.005*outpos(2); + double thrshldy = 0.005*outpos(3); + double minsizex = 0.2*outpos(2); + double minsizey = 0.2*outpos(3); + bool updatex = true, updatey = true; + for (int i = 0; i < 10; i++) + { + double dt; + bool modified = false; + dt = outpos(0)+outpos(2)-tightpos(0)-tightpos(2); + if (dt < -thrshldx && updatex) + { + pos(2) += dt; + modified = true; + } + dt = outpos(1)+outpos(3)-tightpos(1)-tightpos(3); + if (dt < -thrshldy && updatey) + { + pos(3) += dt; + modified = true; + } + dt = outpos(0)-tightpos(0); + if (dt > thrshldx && updatex) + { + pos(0) += dt; + pos(2) -= dt; + modified = true; + } + dt = outpos(1)-tightpos(1); + if (dt > thrshldy && updatey) + { + pos(1) += dt; + pos(3) -= dt; + modified = true; + } + + // Note: checking limit for minimum axes size + if (pos(2) < minsizex) + { + pos(0) -= 0.5*(minsizex-pos(2)); + pos(2) = minsizex; + updatex = false; + } + if (pos(3) < minsizey) + { + pos(1) -= 0.5*(minsizey-pos(3)); + pos(3) = minsizey; + updatey = false; + } + + if (modified) + { + position = pos; + update_transform (); + tightpos = calc_tightbox (pos); + } + else + break; + } + } + else + { + update_transform (); + + outpos(0) = pos(0)-pos(2)*lratio/wratio; + outpos(1) = pos(1)-pos(3)*bratio/hratio; + outpos(2) = pos(2)/wratio; + outpos(3) = pos(3)/hratio; + + outerposition = calc_tightbox (outpos); + } + + update_insets (); +} + +void +axes::properties::update_insets (void) +{ + Matrix pos = position.get ().matrix_value (); + Matrix outpos = outerposition.get ().matrix_value (); + Matrix tightpos = calc_tightbox (pos); + // Determine the tightinset = axes_bbox - position + Matrix inset (1, 4, 1.0); + inset(0) = pos(0)-tightpos(0); + inset(1) = pos(1)-tightpos(1); + inset(2) = tightpos(0)+tightpos(2)-pos(0)-pos(2); + inset(3) = tightpos(1)+tightpos(3)-pos(1)-pos(3); + tightinset = inset; + + // Determine the looseinset = outerposition - position + inset(0) = pos(0)-outpos(0); + inset(1) = pos(1)-outpos(1); + inset(2) = outpos(0)+outpos(2)-pos(0)-pos(2); + inset(3) = outpos(1)+outpos(3)-pos(1)-pos(3); + looseinset = inset; +} + + +void +axes::properties::set_text_child (handle_property& hp, + const std::string& who, + const octave_value& v) +{ + graphics_handle val; + + if (v.is_string ()) + { + val = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); + + xset (val, "string", v); + } + else + { + graphics_object go = gh_manager::get_object (gh_manager::lookup (v)); + + if (go.isa ("text")) + val = ::reparent (v, "set", who, __myhandle__, false); + else + { + std::string cname = v.class_name (); + + error ("set: expecting text graphics object or character string for %s property, found %s", + who.c_str (), cname.c_str ()); + } + } + + if (! error_state) + { + xset (val, "handlevisibility", "off"); + + gh_manager::free (hp.handle_value ()); + + base_properties::remove_child (hp.handle_value ()); + + hp = val; + + adopt (hp.handle_value ()); + } +} + +void +axes::properties::set_xlabel (const octave_value& v) +{ + set_text_child (xlabel, "xlabel", v); + xset (xlabel.handle_value (), "positionmode", "auto"); + xset (xlabel.handle_value (), "rotationmode", "auto"); + xset (xlabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (xlabel.handle_value (), "verticalalignmentmode", "auto"); + xset (xlabel.handle_value (), "clipping", "off"); + xset (xlabel.handle_value (), "color", get_xcolor ()); + xset (xlabel.handle_value (), "autopos_tag", "xlabel"); + update_xlabel_position (); +} + +void +axes::properties::set_ylabel (const octave_value& v) +{ + set_text_child (ylabel, "ylabel", v); + xset (ylabel.handle_value (), "positionmode", "auto"); + xset (ylabel.handle_value (), "rotationmode", "auto"); + xset (ylabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (ylabel.handle_value (), "verticalalignmentmode", "auto"); + xset (ylabel.handle_value (), "clipping", "off"); + xset (ylabel.handle_value (), "color", get_ycolor ()); + xset (ylabel.handle_value (), "autopos_tag", "ylabel"); + update_ylabel_position (); +} + +void +axes::properties::set_zlabel (const octave_value& v) +{ + set_text_child (zlabel, "zlabel", v); + xset (zlabel.handle_value (), "positionmode", "auto"); + xset (zlabel.handle_value (), "rotationmode", "auto"); + xset (zlabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (zlabel.handle_value (), "verticalalignmentmode", "auto"); + xset (zlabel.handle_value (), "clipping", "off"); + xset (zlabel.handle_value (), "color", get_zcolor ()); + xset (zlabel.handle_value (), "autopos_tag", "zlabel"); + update_zlabel_position (); +} + +void +axes::properties::set_title (const octave_value& v) +{ + set_text_child (title, "title", v); + xset (title.handle_value (), "positionmode", "auto"); + xset (title.handle_value (), "horizontalalignment", "center"); + xset (title.handle_value (), "horizontalalignmentmode", "auto"); + xset (title.handle_value (), "verticalalignment", "bottom"); + xset (title.handle_value (), "verticalalignmentmode", "auto"); + xset (title.handle_value (), "clipping", "off"); + xset (title.handle_value (), "autopos_tag", "title"); + update_title_position (); +} + +void +axes::properties::set_defaults (base_graphics_object& obj, + const std::string& mode) +{ + box = "on"; + colororder = default_colororder (); + dataaspectratio = Matrix (1, 3, 1.0); + dataaspectratiomode = "auto"; + layer = "bottom"; + + Matrix tlim (1, 2, 0.0); + tlim(1) = 1; + xlim = tlim; + ylim = tlim; + zlim = tlim; + + Matrix cl (1, 2, 0); + cl(1) = 1; + clim = cl; + + xlimmode = "auto"; + ylimmode = "auto"; + zlimmode = "auto"; + climmode = "auto"; + + xgrid = "off"; + ygrid = "off"; + zgrid = "off"; + xminorgrid = "off"; + yminorgrid = "off"; + zminorgrid = "off"; + xtick = Matrix (); + ytick = Matrix (); + ztick = Matrix (); + xtickmode = "auto"; + ytickmode = "auto"; + ztickmode = "auto"; + xticklabel = ""; + yticklabel = ""; + zticklabel = ""; + xticklabelmode = "auto"; + yticklabelmode = "auto"; + zticklabelmode = "auto"; + color = color_values ("white"); + xcolor = color_values ("black"); + ycolor = color_values ("black"); + zcolor = color_values ("black"); + xscale = "linear"; + yscale = "linear"; + zscale = "linear"; + xdir = "normal"; + ydir = "normal"; + zdir = "normal"; + yaxislocation = "left"; + xaxislocation = "bottom"; + + // Note: camera properties will be set through update_transform + camerapositionmode = "auto"; + cameratargetmode = "auto"; + cameraupvectormode = "auto"; + cameraviewanglemode = "auto"; + plotboxaspectratio = Matrix (1, 3, 1.0); + drawmode = "normal"; + gridlinestyle = ":"; + linestyleorder = "-"; + linewidth = 0.5; + minorgridlinestyle = ":"; + // Note: plotboxaspectratio will be set through update_aspectratiors + plotboxaspectratiomode = "auto"; + projection = "orthographic"; + tickdir = "in"; + tickdirmode = "auto"; + ticklength = default_axes_ticklength (); + tightinset = Matrix (1, 4, 0.0); + + sx = "linear"; + sy = "linear"; + sz = "linear"; + + Matrix tview (1, 2, 0.0); + tview(1) = 90; + view = tview; + + visible = "on"; + nextplot = "replace"; + + if (mode != "replace") + { + fontangle = "normal"; + fontname = OCTAVE_DEFAULT_FONTNAME; + fontsize = 10; + fontunits = "points"; + fontweight = "normal"; + + outerposition = default_axes_outerposition (); + position = default_axes_position (); + activepositionproperty = "outerposition"; + } + + delete_children (true); + + xlabel = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); + + ylabel = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); + + zlabel = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); + + title = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); + + xset (xlabel.handle_value (), "handlevisibility", "off"); + xset (ylabel.handle_value (), "handlevisibility", "off"); + xset (zlabel.handle_value (), "handlevisibility", "off"); + xset (title.handle_value (), "handlevisibility", "off"); + + xset (xlabel.handle_value (), "horizontalalignment", "center"); + xset (xlabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (ylabel.handle_value (), "horizontalalignment", "center"); + xset (ylabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (zlabel.handle_value (), "horizontalalignment", "right"); + xset (zlabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (title.handle_value (), "horizontalalignment", "center"); + xset (title.handle_value (), "horizontalalignmentmode", "auto"); + + xset (xlabel.handle_value (), "verticalalignment", "top"); + xset (xlabel.handle_value (), "verticalalignmentmode", "auto"); + xset (ylabel.handle_value (), "verticalalignment", "bottom"); + xset (ylabel.handle_value (), "verticalalignmentmode", "auto"); + xset (title.handle_value (), "verticalalignment", "bottom"); + xset (title.handle_value (), "verticalalignmentmode", "auto"); + + xset (ylabel.handle_value (), "rotation", 90.0); + xset (ylabel.handle_value (), "rotationmode", "auto"); + + xset (zlabel.handle_value (), "visible", "off"); + + xset (xlabel.handle_value (), "clipping", "off"); + xset (ylabel.handle_value (), "clipping", "off"); + xset (zlabel.handle_value (), "clipping", "off"); + xset (title.handle_value (), "clipping", "off"); + + xset (xlabel.handle_value (), "autopos_tag", "xlabel"); + xset (ylabel.handle_value (), "autopos_tag", "ylabel"); + xset (zlabel.handle_value (), "autopos_tag", "zlabel"); + xset (title.handle_value (), "autopos_tag", "title"); + + adopt (xlabel.handle_value ()); + adopt (ylabel.handle_value ()); + adopt (zlabel.handle_value ()); + adopt (title.handle_value ()); + + update_transform (); + update_insets (); + override_defaults (obj); +} + +void +axes::properties::delete_text_child (handle_property& hp) +{ + graphics_handle h = hp.handle_value (); + + if (h.ok ()) + { + graphics_object go = gh_manager::get_object (h); + + if (go.valid_object ()) + gh_manager::free (h); + + base_properties::remove_child (h); + } + + // FIXME -- is it necessary to check whether the axes object is + // being deleted now? I think this function is only called when an + // individual child object is delete and not when the parent axes + // object is deleted. + + if (! is_beingdeleted ()) + { + hp = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); + + xset (hp.handle_value (), "handlevisibility", "off"); + + adopt (hp.handle_value ()); + } +} + +void +axes::properties::remove_child (const graphics_handle& h) +{ + if (xlabel.handle_value ().ok () && h == xlabel.handle_value ()) + delete_text_child (xlabel); + else if (ylabel.handle_value ().ok () && h == ylabel.handle_value ()) + delete_text_child (ylabel); + else if (zlabel.handle_value ().ok () && h == zlabel.handle_value ()) + delete_text_child (zlabel); + else if (title.handle_value ().ok () && h == title.handle_value ()) + delete_text_child (title); + else + base_properties::remove_child (h); +} + +inline Matrix +xform_matrix (void) +{ + Matrix m (4, 4, 0.0); + for (int i = 0; i < 4; i++) + m(i,i) = 1; + return m; +} + +inline ColumnVector +xform_vector (void) +{ + ColumnVector v (4, 0.0); + v(3) = 1; + return v; +} + +inline ColumnVector +xform_vector (double x, double y, double z) +{ + ColumnVector v (4, 1.0); + v(0) = x; v(1) = y; v(2) = z; + return v; +} + +inline ColumnVector +transform (const Matrix& m, double x, double y, double z) +{ + return (m * xform_vector (x, y, z)); +} + +inline Matrix +xform_scale (double x, double y, double z) +{ + Matrix m (4, 4, 0.0); + m(0,0) = x; m(1,1) = y; m(2,2) = z; m(3,3) = 1; + return m; +} + +inline Matrix +xform_translate (double x, double y, double z) +{ + Matrix m = xform_matrix (); + m(0,3) = x; m(1,3) = y; m(2,3) = z; m(3,3) = 1; + return m; +} + +inline void +scale (Matrix& m, double x, double y, double z) +{ + m = m * xform_scale (x, y, z); +} + +inline void +translate (Matrix& m, double x, double y, double z) +{ + m = m * xform_translate (x, y, z); +} + +inline void +xform (ColumnVector& v, const Matrix& m) +{ + v = m*v; +} + +inline void +scale (ColumnVector& v, double x, double y, double z) +{ + v(0) *= x; + v(1) *= y; + v(2) *= z; +} + +inline void +translate (ColumnVector& v, double x, double y, double z) +{ + v(0) += x; + v(1) += y; + v(2) += z; +} + +inline void +normalize (ColumnVector& v) +{ + double fact = 1.0 / sqrt (v(0)*v(0)+v(1)*v(1)+v(2)*v(2)); + scale (v, fact, fact, fact); +} + +inline double +dot (const ColumnVector& v1, const ColumnVector& v2) +{ + return (v1(0)*v2(0)+v1(1)*v2(1)+v1(2)*v2(2)); +} + +inline double +norm (const ColumnVector& v) +{ + return sqrt (dot (v, v)); +} + +inline ColumnVector +cross (const ColumnVector& v1, const ColumnVector& v2) +{ + ColumnVector r = xform_vector (); + r(0) = v1(1)*v2(2)-v1(2)*v2(1); + r(1) = v1(2)*v2(0)-v1(0)*v2(2); + r(2) = v1(0)*v2(1)-v1(1)*v2(0); + return r; +} + +inline Matrix +unit_cube (void) +{ + static double data[32] = { + 0,0,0,1, + 1,0,0,1, + 0,1,0,1, + 0,0,1,1, + 1,1,0,1, + 1,0,1,1, + 0,1,1,1, + 1,1,1,1}; + Matrix m (4, 8); + memcpy (m.fortran_vec (), data, sizeof (double)*32); + return m; +} + +inline ColumnVector +cam2xform (const Array& m) +{ + ColumnVector retval (4, 1.0); + memcpy (retval.fortran_vec (), m.fortran_vec (), sizeof (double)*3); + return retval; +} + +inline RowVector +xform2cam (const ColumnVector& v) +{ + return v.extract_n (0, 3).transpose (); +} + +void +axes::properties::update_camera (void) +{ + double xd = (xdir_is ("normal") ? 1 : -1); + double yd = (ydir_is ("normal") ? 1 : -1); + double zd = (zdir_is ("normal") ? 1 : -1); + + Matrix xlimits = sx.scale (get_xlim ().matrix_value ()); + Matrix ylimits = sy.scale (get_ylim ().matrix_value ()); + Matrix zlimits = sz.scale (get_zlim ().matrix_value ()); + + double xo = xlimits(xd > 0 ? 0 : 1); + double yo = ylimits(yd > 0 ? 0 : 1); + double zo = zlimits(zd > 0 ? 0 : 1); + + Matrix pb = get_plotboxaspectratio ().matrix_value (); + + bool autocam = (camerapositionmode_is ("auto") + && cameratargetmode_is ("auto") + && cameraupvectormode_is ("auto") + && cameraviewanglemode_is ("auto")); + bool dowarp = (autocam && dataaspectratiomode_is ("auto") + && plotboxaspectratiomode_is ("auto")); + + ColumnVector c_eye (xform_vector ()); + ColumnVector c_center (xform_vector ()); + ColumnVector c_upv (xform_vector ()); + + if (cameratargetmode_is ("auto")) + { + c_center(0) = (xlimits(0)+xlimits(1))/2; + c_center(1) = (ylimits(0)+ylimits(1))/2; + c_center(2) = (zlimits(0)+zlimits(1))/2; + + cameratarget = xform2cam (c_center); + } + else + c_center = cam2xform (get_cameratarget ().matrix_value ()); + + if (camerapositionmode_is ("auto")) + { + Matrix tview = get_view ().matrix_value (); + double az = tview(0), el = tview(1); + double d = 5 * sqrt (pb(0)*pb(0)+pb(1)*pb(1)+pb(2)*pb(2)); + + if (el == 90 || el == -90) + c_eye(2) = d*signum (el); + else + { + az *= M_PI/180.0; + el *= M_PI/180.0; + c_eye(0) = d * cos (el) * sin (az); + c_eye(1) = -d* cos (el) * cos (az); + c_eye(2) = d * sin (el); + } + c_eye(0) = c_eye(0)*(xlimits(1)-xlimits(0))/(xd*pb(0))+c_center(0); + c_eye(1) = c_eye(1)*(ylimits(1)-ylimits(0))/(yd*pb(1))+c_center(1); + c_eye(2) = c_eye(2)*(zlimits(1)-zlimits(0))/(zd*pb(2))+c_center(2); + + cameraposition = xform2cam (c_eye); + } + else + c_eye = cam2xform (get_cameraposition ().matrix_value ()); + + if (cameraupvectormode_is ("auto")) + { + Matrix tview = get_view ().matrix_value (); + double az = tview(0), el = tview(1); + + if (el == 90 || el == -90) + { + c_upv(0) = + -signum (el) *sin (az*M_PI/180.0)*(xlimits(1)-xlimits(0))/pb(0); + c_upv(1) = + signum (el) * cos (az*M_PI/180.0)*(ylimits(1)-ylimits(0))/pb(1); + } + else + c_upv(2) = 1; + + cameraupvector = xform2cam (c_upv); + } + else + c_upv = cam2xform (get_cameraupvector ().matrix_value ()); + + Matrix x_view = xform_matrix (); + Matrix x_projection = xform_matrix (); + Matrix x_viewport = xform_matrix (); + Matrix x_normrender = xform_matrix (); + Matrix x_pre = xform_matrix (); + + x_render = xform_matrix (); + x_render_inv = xform_matrix (); + + scale (x_pre, pb(0), pb(1), pb(2)); + translate (x_pre, -0.5, -0.5, -0.5); + scale (x_pre, xd/(xlimits(1)-xlimits(0)), yd/(ylimits(1)-ylimits(0)), + zd/(zlimits(1)-zlimits(0))); + translate (x_pre, -xo, -yo, -zo); + + xform (c_eye, x_pre); + xform (c_center, x_pre); + scale (c_upv, pb(0)/(xlimits(1)-xlimits(0)), pb(1)/(ylimits(1)-ylimits(0)), + pb(2)/(zlimits(1)-zlimits(0))); + translate (c_center, -c_eye(0), -c_eye(1), -c_eye(2)); + + ColumnVector F (c_center), f (F), UP (c_upv); + normalize (f); + normalize (UP); + + if (std::abs (dot (f, UP)) > 1e-15) + { + double fa = 1 / sqrt(1-f(2)*f(2)); + scale (UP, fa, fa, fa); + } + + ColumnVector s = cross (f, UP); + ColumnVector u = cross (s, f); + + scale (x_view, 1, 1, -1); + Matrix l = xform_matrix (); + l(0,0) = s(0); l(0,1) = s(1); l(0,2) = s(2); + l(1,0) = u(0); l(1,1) = u(1); l(1,2) = u(2); + l(2,0) = -f(0); l(2,1) = -f(1); l(2,2) = -f(2); + x_view = x_view * l; + translate (x_view, -c_eye(0), -c_eye(1), -c_eye(2)); + scale (x_view, pb(0), pb(1), pb(2)); + translate (x_view, -0.5, -0.5, -0.5); + + Matrix x_cube = x_view * unit_cube (); + ColumnVector cmin = x_cube.row_min (), cmax = x_cube.row_max (); + double xM = cmax(0)-cmin(0); + double yM = cmax(1)-cmin(1); + + Matrix bb = get_boundingbox (true); + + double v_angle; + + if (cameraviewanglemode_is ("auto")) + { + double af; + + // FIXME -- was this really needed? When compared to Matlab, it + // does not seem to be required. Need investigation with concrete + // graphics toolkit to see results visually. + if (false && dowarp) + af = 1.0 / (xM > yM ? xM : yM); + else + { + if ((bb(2)/bb(3)) > (xM/yM)) + af = 1.0 / yM; + else + af = 1.0 / xM; + } + v_angle = 2 * (180.0 / M_PI) * atan (1 / (2 * af * norm (F))); + + cameraviewangle = v_angle; + } + else + v_angle = get_cameraviewangle (); + + double pf = 1 / (2 * tan ((v_angle / 2) * M_PI / 180.0) * norm (F)); + scale (x_projection, pf, pf, 1); + + if (dowarp) + { + xM *= pf; + yM *= pf; + translate (x_viewport, bb(0)+bb(2)/2, bb(1)+bb(3)/2, 0); + scale (x_viewport, bb(2)/xM, -bb(3)/yM, 1); + } + else + { + double pix = 1; + if (autocam) + { + if ((bb(2)/bb(3)) > (xM/yM)) + pix = bb(3); + else + pix = bb(2); + } + else + pix = (bb(2) < bb(3) ? bb(2) : bb(3)); + translate (x_viewport, bb(0)+bb(2)/2, bb(1)+bb(3)/2, 0); + scale (x_viewport, pix, -pix, 1); + } + + x_normrender = x_viewport * x_projection * x_view; + + x_cube = x_normrender * unit_cube (); + cmin = x_cube.row_min (); + cmax = x_cube.row_max (); + x_zlim.resize (1, 2); + x_zlim(0) = cmin(2); + x_zlim(1) = cmax(2); + + x_render = x_normrender; + scale (x_render, xd/(xlimits(1)-xlimits(0)), yd/(ylimits(1)-ylimits(0)), + zd/(zlimits(1)-zlimits(0))); + translate (x_render, -xo, -yo, -zo); + + x_viewtransform = x_view; + x_projectiontransform = x_projection; + x_viewporttransform = x_viewport; + x_normrendertransform = x_normrender; + x_rendertransform = x_render; + + x_render_inv = x_render.inverse (); + + // Note: these matrices are a slight modified version of the regular + // matrices, more suited for OpenGL rendering (x_gl_mat1 => light + // => x_gl_mat2) + x_gl_mat1 = x_view; + scale (x_gl_mat1, xd/(xlimits(1)-xlimits(0)), yd/(ylimits(1)-ylimits(0)), + zd/(zlimits(1)-zlimits(0))); + translate (x_gl_mat1, -xo, -yo, -zo); + x_gl_mat2 = x_viewport * x_projection; +} + +static bool updating_axes_layout = false; + +void +axes::properties::update_axes_layout (void) +{ + if (updating_axes_layout) + return; + + graphics_xform xform = get_transform (); + + double xd = (xdir_is ("normal") ? 1 : -1); + double yd = (ydir_is ("normal") ? 1 : -1); + double zd = (zdir_is ("normal") ? 1 : -1); + + const Matrix xlims = xform.xscale (get_xlim ().matrix_value ()); + const Matrix ylims = xform.yscale (get_ylim ().matrix_value ()); + const Matrix zlims = xform.zscale (get_zlim ().matrix_value ()); + double x_min = xlims(0), x_max = xlims(1); + double y_min = ylims(0), y_max = ylims(1); + double z_min = zlims(0), z_max = zlims(1); + + ColumnVector p1, p2, dir (3); + + xstate = ystate = zstate = AXE_ANY_DIR; + + p1 = xform.transform (x_min, (y_min+y_max)/2, (z_min+z_max)/2, false); + p2 = xform.transform (x_max, (y_min+y_max)/2, (z_min+z_max)/2, false); + dir(0) = xround (p2(0)-p1(0)); + dir(1) = xround (p2(1)-p1(1)); + dir(2) = (p2(2)-p1(2)); + if (dir(0) == 0 && dir(1) == 0) + xstate = AXE_DEPTH_DIR; + else if (dir(2) == 0) + { + if (dir(0) == 0) + xstate = AXE_VERT_DIR; + else if (dir(1) == 0) + xstate = AXE_HORZ_DIR; + } + + if (dir(2) == 0) + { + if (dir(1) == 0) + xPlane = (dir(0) > 0 ? x_max : x_min); + else + xPlane = (dir(1) < 0 ? x_max : x_min); + } + else + xPlane = (dir(2) < 0 ? x_min : x_max); + + xPlaneN = (xPlane == x_min ? x_max : x_min); + fx = (x_max-x_min) / sqrt (dir(0)*dir(0)+dir(1)*dir(1)); + + p1 = xform.transform ((x_min+x_max)/2, y_min, (z_min+z_max)/2, false); + p2 = xform.transform ((x_min+x_max)/2, y_max, (z_min+z_max)/2, false); + dir(0) = xround (p2(0)-p1(0)); + dir(1) = xround (p2(1)-p1(1)); + dir(2) = (p2(2)-p1(2)); + if (dir(0) == 0 && dir(1) == 0) + ystate = AXE_DEPTH_DIR; + else if (dir(2) == 0) + { + if (dir(0) == 0) + ystate = AXE_VERT_DIR; + else if (dir(1) == 0) + ystate = AXE_HORZ_DIR; + } + + if (dir(2) == 0) + { + if (dir(1) == 0) + yPlane = (dir(0) > 0 ? y_max : y_min); + else + yPlane = (dir(1) < 0 ? y_max : y_min); + } + else + yPlane = (dir(2) < 0 ? y_min : y_max); + + yPlaneN = (yPlane == y_min ? y_max : y_min); + fy = (y_max-y_min) / sqrt (dir(0)*dir(0)+dir(1)*dir(1)); + + p1 = xform.transform ((x_min+x_max)/2, (y_min+y_max)/2, z_min, false); + p2 = xform.transform ((x_min+x_max)/2, (y_min+y_max)/2, z_max, false); + dir(0) = xround (p2(0)-p1(0)); + dir(1) = xround (p2(1)-p1(1)); + dir(2) = (p2(2)-p1(2)); + if (dir(0) == 0 && dir(1) == 0) + zstate = AXE_DEPTH_DIR; + else if (dir(2) == 0) + { + if (dir(0) == 0) + zstate = AXE_VERT_DIR; + else if (dir(1) == 0) + zstate = AXE_HORZ_DIR; + } + + if (dir(2) == 0) + { + if (dir(1) == 0) + zPlane = (dir(0) > 0 ? z_min : z_max); + else + zPlane = (dir(1) < 0 ? z_min : z_max); + } + else + zPlane = (dir(2) < 0 ? z_min : z_max); + + zPlaneN = (zPlane == z_min ? z_max : z_min); + fz = (z_max-z_min) / sqrt (dir(0)*dir(0)+dir(1)*dir(1)); + + unwind_protect frame; + frame.protect_var (updating_axes_layout); + updating_axes_layout = true; + + xySym = (xd*yd*(xPlane-xPlaneN)*(yPlane-yPlaneN) > 0); + zSign = (zd*(zPlane-zPlaneN) <= 0); + xyzSym = zSign ? xySym : !xySym; + xpTick = (zSign ? xPlaneN : xPlane); + ypTick = (zSign ? yPlaneN : yPlane); + zpTick = (zSign ? zPlane : zPlaneN); + xpTickN = (zSign ? xPlane : xPlaneN); + ypTickN = (zSign ? yPlane : yPlaneN); + zpTickN = (zSign ? zPlaneN : zPlane); + + /* 2D mode */ + x2Dtop = false; + y2Dright = false; + layer2Dtop = false; + if (xstate == AXE_HORZ_DIR && ystate == AXE_VERT_DIR) + { + if (xaxislocation_is ("top")) + { + double tmp = yPlane; + yPlane = yPlaneN; + yPlaneN = tmp; + x2Dtop = true; + } + ypTick = yPlaneN; + ypTickN = yPlane; + if (yaxislocation_is ("right")) + { + double tmp = xPlane; + xPlane = xPlaneN; + xPlaneN = tmp; + y2Dright = true; + } + xpTick = xPlaneN; + xpTickN = xPlane; + if (layer_is ("top")) + { + zpTick = zPlaneN; + layer2Dtop = true; + } + else + zpTick = zPlane; + } + + Matrix viewmat = get_view ().matrix_value (); + nearhoriz = std::abs (viewmat(1)) <= 5; + + update_ticklength (); +} + +void +axes::properties::update_ticklength (void) +{ + bool mode2d = (((xstate > AXE_DEPTH_DIR ? 1 : 0) + + (ystate > AXE_DEPTH_DIR ? 1 : 0) + + (zstate > AXE_DEPTH_DIR ? 1 : 0)) == 2); + + if (tickdirmode_is ("auto")) + tickdir.set (mode2d ? "in" : "out", true); + + double ticksign = (tickdir_is ("in") ? -1 : 1); + + Matrix bbox = get_boundingbox (true); + Matrix ticklen = get_ticklength ().matrix_value (); + ticklen(0) = ticklen(0) * std::max (bbox(2), bbox(3)); + ticklen(1) = ticklen(1) * std::max (bbox(2), bbox(3)); + + xticklen = ticksign * (mode2d ? ticklen(0) : ticklen(1)); + yticklen = ticksign * (mode2d ? ticklen(0) : ticklen(1)); + zticklen = ticksign * (mode2d ? ticklen(0) : ticklen(1)); + + xtickoffset = (mode2d ? std::max (0., xticklen) : std::abs (xticklen)) + 5; + ytickoffset = (mode2d ? std::max (0., yticklen) : std::abs (yticklen)) + 5; + ztickoffset = (mode2d ? std::max (0., zticklen) : std::abs (zticklen)) + 5; + + update_xlabel_position (); + update_ylabel_position (); + update_zlabel_position (); + update_title_position (); +} + +/* +## FIXME: A demo can't be called in a C++ file. This should be made a test +## or moved to a .m file where it can be called. +%!demo +%! clf; +%! subplot (2,1,1); +%! plot (rand (3)); +%! xlabel xlabel; +%! ylabel ylabel; +%! title title; +%! subplot (2,1,2); +%! plot (rand (3)); +%! set (gca, "ticklength", get (gca, "ticklength") * 2, "tickdir", "out"); +%! xlabel xlabel; +%! ylabel ylabel; +%! title title; +*/ + +static bool updating_xlabel_position = false; + +void +axes::properties::update_xlabel_position (void) +{ + if (updating_xlabel_position) + return; + + text::properties& xlabel_props = reinterpret_cast + (gh_manager::get_object (get_xlabel ()).get_properties ()); + + bool is_empty = xlabel_props.get_string ().is_empty (); + + unwind_protect frame; + frame.protect_var (updating_xlabel_position); + updating_xlabel_position = true; + + if (! is_empty) + { + if (xlabel_props.horizontalalignmentmode_is ("auto")) + { + xlabel_props.set_horizontalalignment + (xstate > AXE_DEPTH_DIR + ? "center" : (xyzSym ? "left" : "right")); + + xlabel_props.set_horizontalalignmentmode ("auto"); + } + + if (xlabel_props.verticalalignmentmode_is ("auto")) + { + xlabel_props.set_verticalalignment + (xstate == AXE_VERT_DIR || x2Dtop ? "bottom" : "top"); + + xlabel_props.set_verticalalignmentmode ("auto"); + } + } + + if (xlabel_props.positionmode_is ("auto") + || xlabel_props.rotationmode_is ("auto")) + { + graphics_xform xform = get_transform (); + + Matrix ext (1, 2, 0.0); + ext = get_ticklabel_extents (get_xtick ().matrix_value (), + get_xticklabel ().all_strings (), + get_xlim ().matrix_value ()); + + double wmax = ext(0), hmax = ext(1), angle = 0; + ColumnVector p = + graphics_xform::xform_vector ((xpTickN+xpTick)/2, ypTick, zpTick); + + bool tick_along_z = nearhoriz || xisinf (fy); + if (tick_along_z) + p(2) += (signum (zpTick-zpTickN)*fz*xtickoffset); + else + p(1) += (signum (ypTick-ypTickN)*fy*xtickoffset); + + p = xform.transform (p(0), p(1), p(2), false); + + switch (xstate) + { + case AXE_ANY_DIR: + p(0) += (xyzSym ? wmax : -wmax); + p(1) += hmax; + break; + + case AXE_VERT_DIR: + p(0) -= wmax; + angle = 90; + break; + + case AXE_HORZ_DIR: + p(1) += (x2Dtop ? -hmax : hmax); + break; + } + + if (xlabel_props.positionmode_is ("auto")) + { + p = xform.untransform (p(0), p(1), p(2), true); + xlabel_props.set_position (p.extract_n (0, 3).transpose ()); + xlabel_props.set_positionmode ("auto"); + } + + if (! is_empty && xlabel_props.rotationmode_is ("auto")) + { + xlabel_props.set_rotation (angle); + xlabel_props.set_rotationmode ("auto"); + } + } +} + +static bool updating_ylabel_position = false; + +void +axes::properties::update_ylabel_position (void) +{ + if (updating_ylabel_position) + return; + + text::properties& ylabel_props = reinterpret_cast + (gh_manager::get_object (get_ylabel ()).get_properties ()); + + bool is_empty = ylabel_props.get_string ().is_empty (); + + unwind_protect frame; + frame.protect_var (updating_ylabel_position); + updating_ylabel_position = true; + + if (! is_empty) + { + if (ylabel_props.horizontalalignmentmode_is ("auto")) + { + ylabel_props.set_horizontalalignment + (ystate > AXE_DEPTH_DIR + ? "center" : (!xyzSym ? "left" : "right")); + + ylabel_props.set_horizontalalignmentmode ("auto"); + } + + if (ylabel_props.verticalalignmentmode_is ("auto")) + { + ylabel_props.set_verticalalignment + (ystate == AXE_VERT_DIR && !y2Dright ? "bottom" : "top"); + + ylabel_props.set_verticalalignmentmode ("auto"); + } + } + + if (ylabel_props.positionmode_is ("auto") + || ylabel_props.rotationmode_is ("auto")) + { + graphics_xform xform = get_transform (); + + Matrix ext (1, 2, 0.0); + + // The underlying get_extents() from FreeType produces mismatched values. + // x-extent accurately measures the width of the glyphs. + // y-extent instead measures from baseline-to-baseline. + // Pad x-extent (+4) so that it approximately matches y-extent. + // This keeps ylabels about the same distance from y-axis as + // xlabels are from x-axis. + // ALWAYS use an even number for padding or horizontal alignment + // will be off. + ext = get_ticklabel_extents (get_ytick ().matrix_value (), + get_yticklabel ().all_strings (), + get_ylim ().matrix_value ()); + + double wmax = ext(0)+4, hmax = ext(1), angle = 0; + ColumnVector p = + graphics_xform::xform_vector (xpTick, (ypTickN+ypTick)/2, zpTick); + + bool tick_along_z = nearhoriz || xisinf (fx); + if (tick_along_z) + p(2) += (signum (zpTick-zpTickN)*fz*ytickoffset); + else + p(0) += (signum (xpTick-xpTickN)*fx*ytickoffset); + + p = xform.transform (p(0), p(1), p(2), false); + + switch (ystate) + { + case AXE_ANY_DIR: + p(0) += (!xyzSym ? wmax : -wmax); + p(1) += hmax; + break; + + case AXE_VERT_DIR: + p(0) += (y2Dright ? wmax : -wmax); + angle = 90; + break; + + case AXE_HORZ_DIR: + p(1) += hmax; + break; + } + + if (ylabel_props.positionmode_is ("auto")) + { + p = xform.untransform (p(0), p(1), p(2), true); + ylabel_props.set_position (p.extract_n (0, 3).transpose ()); + ylabel_props.set_positionmode ("auto"); + } + + if (! is_empty && ylabel_props.rotationmode_is ("auto")) + { + ylabel_props.set_rotation (angle); + ylabel_props.set_rotationmode ("auto"); + } + } +} + +static bool updating_zlabel_position = false; + +void +axes::properties::update_zlabel_position (void) +{ + if (updating_zlabel_position) + return; + + text::properties& zlabel_props = reinterpret_cast + (gh_manager::get_object (get_zlabel ()).get_properties ()); + + bool camAuto = cameraupvectormode_is ("auto"); + bool is_empty = zlabel_props.get_string ().is_empty (); + + unwind_protect frame; + frame.protect_var (updating_zlabel_position); + updating_zlabel_position = true; + + if (! is_empty) + { + if (zlabel_props.horizontalalignmentmode_is ("auto")) + { + zlabel_props.set_horizontalalignment + ((zstate > AXE_DEPTH_DIR || camAuto) ? "center" : "right"); + + zlabel_props.set_horizontalalignmentmode ("auto"); + } + + if (zlabel_props.verticalalignmentmode_is ("auto")) + { + zlabel_props.set_verticalalignment + (zstate == AXE_VERT_DIR + ? "bottom" : ((zSign || camAuto) ? "bottom" : "top")); + + zlabel_props.set_verticalalignmentmode ("auto"); + } + } + + if (zlabel_props.positionmode_is ("auto") + || zlabel_props.rotationmode_is ("auto")) + { + graphics_xform xform = get_transform (); + + Matrix ext (1, 2, 0.0); + ext = get_ticklabel_extents (get_ztick ().matrix_value (), + get_zticklabel ().all_strings (), + get_zlim ().matrix_value ()); + + double wmax = ext(0), hmax = ext(1), angle = 0; + ColumnVector p; + + if (xySym) + { + p = graphics_xform::xform_vector (xPlaneN, yPlane, + (zpTickN+zpTick)/2); + if (xisinf (fy)) + p(0) += (signum (xPlaneN-xPlane)*fx*ztickoffset); + else + p(1) += (signum (yPlane-yPlaneN)*fy*ztickoffset); + } + else + { + p = graphics_xform::xform_vector (xPlane, yPlaneN, + (zpTickN+zpTick)/2); + if (xisinf (fx)) + p(1) += (signum (yPlaneN-yPlane)*fy*ztickoffset); + else + p(0) += (signum (xPlane-xPlaneN)*fx*ztickoffset); + } + + p = xform.transform (p(0), p(1), p(2), false); + + switch (zstate) + { + case AXE_ANY_DIR: + if (camAuto) + { + p(0) -= wmax; + angle = 90; + } + + // FIXME -- what's the correct offset? + // + // p[0] += (!xySym ? wmax : -wmax); + // p[1] += (zSign ? hmax : -hmax); + + break; + + case AXE_VERT_DIR: + p(0) -= wmax; + angle = 90; + break; + + case AXE_HORZ_DIR: + p(1) += hmax; + break; + } + + if (zlabel_props.positionmode_is ("auto")) + { + p = xform.untransform (p(0), p(1), p(2), true); + zlabel_props.set_position (p.extract_n (0, 3).transpose ()); + zlabel_props.set_positionmode ("auto"); + } + + if (! is_empty && zlabel_props.rotationmode_is ("auto")) + { + zlabel_props.set_rotation (angle); + zlabel_props.set_rotationmode ("auto"); + } + } +} + +static bool updating_title_position = false; + +void +axes::properties::update_title_position (void) +{ + if (updating_title_position) + return; + + text::properties& title_props = reinterpret_cast + (gh_manager::get_object (get_title ()).get_properties ()); + + unwind_protect frame; + frame.protect_var (updating_title_position); + updating_title_position = true; + + if (title_props.positionmode_is ("auto")) + { + graphics_xform xform = get_transform (); + + // FIXME: bbox should be stored in axes::properties + Matrix bbox = get_extent (false); + + ColumnVector p = + graphics_xform::xform_vector (bbox(0)+bbox(2)/2, + bbox(1)-10, + (x_zlim(0)+x_zlim(1))/2); + + if (x2Dtop) + { + Matrix ext (1, 2, 0.0); + ext = get_ticklabel_extents (get_xtick ().matrix_value (), + get_xticklabel ().all_strings (), + get_xlim ().matrix_value ()); + p(1) -= ext(1); + } + + p = xform.untransform (p(0), p(1), p(2), true); + + title_props.set_position (p.extract_n (0, 3).transpose ()); + title_props.set_positionmode ("auto"); + } +} + +void +axes::properties::update_autopos (const std::string& elem_type) +{ + if (elem_type == "xlabel") + update_xlabel_position (); + else if (elem_type == "ylabel") + update_ylabel_position (); + else if (elem_type == "zlabel") + update_zlabel_position (); + else if (elem_type == "title") + update_title_position (); + else if (elem_type == "sync") + sync_positions (); +} + +static void +normalized_aspectratios (Matrix& aspectratios, const Matrix& scalefactors, + double xlength, double ylength, double zlength) +{ + double xval = xlength/scalefactors(0); + double yval = ylength/scalefactors(1); + double zval = zlength/scalefactors(2); + + double minval = xmin (xmin (xval, yval), zval); + + aspectratios(0) = xval/minval; + aspectratios(1) = yval/minval; + aspectratios(2) = zval/minval; +} + +static void +max_axes_scale (double& s, Matrix& limits, const Matrix& kids, + double pbfactor, double dafactor, char limit_type, bool tight) +{ + if (tight) + { + double minval = octave_Inf; + double maxval = -octave_Inf; + double min_pos = octave_Inf; + double max_neg = -octave_Inf; + get_children_limits (minval, maxval, min_pos, max_neg, kids, limit_type); + if (!xisinf (minval) && !xisnan (minval) + && !xisinf (maxval) && !xisnan (maxval)) + { + limits(0) = minval; + limits(1) = maxval; + s = xmax(s, (maxval - minval) / (pbfactor * dafactor)); + } + } + else + s = xmax(s, (limits(1) - limits(0)) / (pbfactor * dafactor)); +} + +static bool updating_aspectratios = false; + +void +axes::properties::update_aspectratios (void) +{ + if (updating_aspectratios) + return; + + Matrix xlimits = get_xlim ().matrix_value (); + Matrix ylimits = get_ylim ().matrix_value (); + Matrix zlimits = get_zlim ().matrix_value (); + + double dx = (xlimits(1)-xlimits(0)); + double dy = (ylimits(1)-ylimits(0)); + double dz = (zlimits(1)-zlimits(0)); + + Matrix da = get_dataaspectratio ().matrix_value (); + Matrix pba = get_plotboxaspectratio ().matrix_value (); + + if (dataaspectratiomode_is ("auto")) + { + if (plotboxaspectratiomode_is ("auto")) + { + pba = Matrix (1, 3, 1.0); + plotboxaspectratio.set (pba, false); + } + + normalized_aspectratios (da, pba, dx, dy, dz); + dataaspectratio.set (da, false); + } + else if (plotboxaspectratiomode_is ("auto")) + { + normalized_aspectratios (pba, da, dx, dy, dz); + plotboxaspectratio.set (pba, false); + } + else + { + double s = -octave_Inf; + bool modified_limits = false; + Matrix kids; + + if (xlimmode_is ("auto") && ylimmode_is ("auto") && zlimmode_is ("auto")) + { + modified_limits = true; + kids = get_children (); + max_axes_scale (s, xlimits, kids, pba(0), da(0), 'x', true); + max_axes_scale (s, ylimits, kids, pba(1), da(1), 'y', true); + max_axes_scale (s, zlimits, kids, pba(2), da(2), 'z', true); + } + else if (xlimmode_is ("auto") && ylimmode_is ("auto")) + { + modified_limits = true; + max_axes_scale (s, zlimits, kids, pba(2), da(2), 'z', false); + } + else if (ylimmode_is ("auto") && zlimmode_is ("auto")) + { + modified_limits = true; + max_axes_scale (s, xlimits, kids, pba(0), da(0), 'x', false); + } + else if (zlimmode_is ("auto") && xlimmode_is ("auto")) + { + modified_limits = true; + max_axes_scale (s, ylimits, kids, pba(1), da(1), 'y', false); + } + + if (modified_limits) + { + + unwind_protect frame; + frame.protect_var (updating_aspectratios); + + updating_aspectratios = true; + + dx = pba(0) *da(0); + dy = pba(1) *da(1); + dz = pba(2) *da(2); + if (xisinf (s)) + s = 1 / xmin (xmin (dx, dy), dz); + + if (xlimmode_is ("auto")) + { + dx = s * dx; + xlimits(0) = 0.5 * (xlimits(0) + xlimits(1) - dx); + xlimits(1) = xlimits(0) + dx; + set_xlim (xlimits); + set_xlimmode ("auto"); + } + + if (ylimmode_is ("auto")) + { + dy = s * dy; + ylimits(0) = 0.5 * (ylimits(0) + ylimits(1) - dy); + ylimits(1) = ylimits(0) + dy; + set_ylim (ylimits); + set_ylimmode ("auto"); + } + + if (zlimmode_is ("auto")) + { + dz = s * dz; + zlimits(0) = 0.5 * (zlimits(0) + zlimits(1) - dz); + zlimits(1) = zlimits(0) + dz; + set_zlim (zlimits); + set_zlimmode ("auto"); + } + } + else + { + normalized_aspectratios (pba, da, dx, dy, dz); + plotboxaspectratio.set (pba, false); + } + } +} + +void +axes::properties::update_font (void) +{ +#ifdef HAVE_FREETYPE +#ifdef HAVE_FONTCONFIG + text_renderer.set_font (get ("fontname").string_value (), + get ("fontweight").string_value (), + get ("fontangle").string_value (), + get ("fontsize").double_value ()); +#endif +#endif +} + +// The INTERNAL flag defines whether position or outerposition is used. + +Matrix +axes::properties::get_boundingbox (bool internal, + const Matrix& parent_pix_size) const +{ + Matrix pos = (internal ? + get_position ().matrix_value () + : get_outerposition ().matrix_value ()); + Matrix parent_size (parent_pix_size); + + if (parent_size.numel () == 0) + { + graphics_object obj = gh_manager::get_object (get_parent ()); + + parent_size = + obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); + } + + pos = convert_position (pos, get_units (), "pixels", parent_size); + + pos(0)--; + pos(1)--; + pos(1) = parent_size(1) - pos(1) - pos(3); + + return pos; +} + +Matrix +axes::properties::get_extent (bool with_text, bool only_text_height) const +{ + graphics_xform xform = get_transform (); + + Matrix ext (1, 4, 0.0); + ext(0) = octave_Inf; + ext(1) = octave_Inf; + ext(2) = -octave_Inf; + ext(3) = -octave_Inf; + for (int i = 0; i <= 1; i++) + for (int j = 0; j <= 1; j++) + for (int k = 0; k <= 1; k++) + { + ColumnVector p = xform.transform (i ? xPlaneN : xPlane, + j ? yPlaneN : yPlane, + k ? zPlaneN : zPlane, false); + ext(0) = std::min (ext(0), p(0)); + ext(1) = std::min (ext(1), p(1)); + ext(2) = std::max (ext(2), p(0)); + ext(3) = std::max (ext(3), p(1)); + } + + if (with_text) + { + for (int i = 0; i < 4; i++) + { + graphics_handle text_handle; + if (i == 0) + text_handle = get_title (); + else if (i == 1) + text_handle = get_xlabel (); + else if (i == 2) + text_handle = get_ylabel (); + else if (i == 3) + text_handle = get_zlabel (); + + text::properties& text_props = reinterpret_cast + (gh_manager::get_object (text_handle).get_properties ()); + + Matrix text_pos = text_props.get_data_position (); + text_pos = xform.transform (text_pos(0), text_pos(1), text_pos(2)); + if (text_props.get_string ().is_empty ()) + { + ext(0) = std::min (ext(0), text_pos(0)); + ext(1) = std::min (ext(1), text_pos(1)); + ext(2) = std::max (ext(2), text_pos(0)); + ext(3) = std::max (ext(3), text_pos(1)); + } + else + { + Matrix text_ext = text_props.get_extent_matrix (); + + bool ignore_horizontal = false; + bool ignore_vertical = false; + if (only_text_height) + { + double text_rotation = text_props.get_rotation (); + if (text_rotation == 0. || text_rotation == 180.) + ignore_horizontal = true; + else if (text_rotation == 90. || text_rotation == 270.) + ignore_vertical = true; + } + + if (! ignore_horizontal) + { + ext(0) = std::min (ext(0), text_pos(0)+text_ext(0)); + ext(2) = std::max (ext(2), text_pos(0)+text_ext(0)+text_ext(2)); + } + + if (! ignore_vertical) + { + ext(1) = std::min (ext(1), text_pos(1)-text_ext(1)-text_ext(3)); + ext(3) = std::max (ext(3), text_pos(1)-text_ext(1)); + } + } + } + } + + ext(2) = ext(2)-ext(0); + ext(3) = ext(3)-ext(1); + + return ext; +} + +static octave_value +convert_ticklabel_string (const octave_value& val) +{ + octave_value retval = val; + + if (val.is_cellstr ()) + { + // Always return a column vector for Matlab Compatibility + if (val.columns () > 1) + retval = val.reshape (dim_vector (val.numel (), 1)); + } + else + { + string_vector sv; + if (val.is_numeric_type ()) + { + NDArray data = val.array_value (); + std::ostringstream oss; + oss.precision (5); + for (octave_idx_type i = 0; i < val.numel (); i++) + { + oss.str (""); + oss << data(i); + sv.append (oss.str ()); + } + } + else if (val.is_string () && val.rows () == 1) + { + std::string valstr = val.string_value (); + std::istringstream iss (valstr); + std::string tmpstr; + + // Split string with delimiter '|' + while (std::getline (iss, tmpstr, '|')) + sv.append (tmpstr); + + // If string ends with '|' Matlab appends a null string + if (*valstr.rbegin () == '|') + sv.append (std::string ("")); + } + else + return retval; + + charMatrix chmat (sv, ' '); + + retval = octave_value (chmat); + } + + return retval; +} + +void +axes::properties::set_xticklabel (const octave_value& v) +{ + if (!error_state) + { + if (xticklabel.set (convert_ticklabel_string (v), false)) + { + set_xticklabelmode ("manual"); + xticklabel.run_listeners (POSTSET); + mark_modified (); + } + else + set_xticklabelmode ("manual"); + } +} + +void +axes::properties::set_yticklabel (const octave_value& v) +{ + if (!error_state) + { + if (yticklabel.set (convert_ticklabel_string (v), false)) + { + set_yticklabelmode ("manual"); + yticklabel.run_listeners (POSTSET); + mark_modified (); + } + else + set_yticklabelmode ("manual"); + } +} + +void +axes::properties::set_zticklabel (const octave_value& v) +{ + if (!error_state) + { + if (zticklabel.set (convert_ticklabel_string (v), false)) + { + set_zticklabelmode ("manual"); + zticklabel.run_listeners (POSTSET); + mark_modified (); + } + else + set_zticklabelmode ("manual"); + } +} + +void +axes::properties::set_units (const octave_value& v) +{ + if (! error_state) + { + caseless_str old_units = get_units (); + if (units.set (v, true)) + { + update_units (old_units); + mark_modified (); + } + } +} + +void +axes::properties::update_units (const caseless_str& old_units) +{ + graphics_object obj = gh_manager::get_object (get_parent ()); + Matrix parent_bb = obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); + caseless_str new_units = get_units (); + position.set (octave_value (convert_position (get_position ().matrix_value (), old_units, new_units, parent_bb)), false); + outerposition.set (octave_value (convert_position (get_outerposition ().matrix_value (), old_units, new_units, parent_bb)), false); + tightinset.set (octave_value (convert_position (get_tightinset ().matrix_value (), old_units, new_units, parent_bb)), false); + looseinset.set (octave_value (convert_position (get_looseinset ().matrix_value (), old_units, new_units, parent_bb)), false); +} + +void +axes::properties::set_fontunits (const octave_value& v) +{ + if (! error_state) + { + caseless_str old_fontunits = get_fontunits (); + if (fontunits.set (v, true)) + { + update_fontunits (old_fontunits); + mark_modified (); + } + } +} + +void +axes::properties::update_fontunits (const caseless_str& old_units) +{ + caseless_str new_units = get_fontunits (); + double parent_height = get_boundingbox (true).elem (3); + double fsz = get_fontsize (); + + fsz = convert_font_size (fsz, old_units, new_units, parent_height); + + set_fontsize (octave_value (fsz)); +} + +double +axes::properties::get_fontsize_points (double box_pix_height) const +{ + double fs = get_fontsize (); + double parent_height = box_pix_height; + + if (fontunits_is ("normalized") && parent_height <= 0) + parent_height = get_boundingbox (true).elem (3); + + return convert_font_size (fs, get_fontunits (), "points", parent_height); +} + +ColumnVector +graphics_xform::xform_vector (double x, double y, double z) +{ + return ::xform_vector (x, y, z); +} + +Matrix +graphics_xform::xform_eye (void) +{ + return ::xform_matrix (); +} + +ColumnVector +graphics_xform::transform (double x, double y, double z, + bool use_scale) const +{ + if (use_scale) + { + x = sx.scale (x); + y = sy.scale (y); + z = sz.scale (z); + } + + return ::transform (xform, x, y, z); +} + +ColumnVector +graphics_xform::untransform (double x, double y, double z, + bool use_scale) const +{ + ColumnVector v = ::transform (xform_inv, x, y, z); + + if (use_scale) + { + v(0) = sx.unscale (v(0)); + v(1) = sy.unscale (v(1)); + v(2) = sz.unscale (v(2)); + } + + return v; +} + +octave_value +axes::get_default (const caseless_str& name) const +{ + octave_value retval = default_properties.lookup (name); + + if (retval.is_undefined ()) + { + graphics_handle parent = get_parent (); + graphics_object parent_obj = gh_manager::get_object (parent); + + retval = parent_obj.get_default (name); + } + + return retval; +} + +// FIXME -- remove. +// FIXME -- maybe this should go into array_property class? +/* +static void +check_limit_vals (double& min_val, double& max_val, + double& min_pos, double& max_neg, + const array_property& data) +{ + double val = data.min_val (); + if (! (xisinf (val) || xisnan (val)) && val < min_val) + min_val = val; + val = data.max_val (); + if (! (xisinf (val) || xisnan (val)) && val > max_val) + max_val = val; + val = data.min_pos (); + if (! (xisinf (val) || xisnan (val)) && val > 0 && val < min_pos) + min_pos = val; + val = data.max_neg (); + if (! (xisinf (val) || xisnan (val)) && val < 0 && val > max_neg) + max_neg = val; +} +*/ + +static void +check_limit_vals (double& min_val, double& max_val, + double& min_pos, double& max_neg, + const octave_value& data) +{ + if (data.is_matrix_type ()) + { + Matrix m = data.matrix_value (); + + if (! error_state && m.numel () == 4) + { + double val; + + val = m(0); + if (! (xisinf (val) || xisnan (val)) && val < min_val) + min_val = val; + + val = m(1); + if (! (xisinf (val) || xisnan (val)) && val > max_val) + max_val = val; + + val = m(2); + if (! (xisinf (val) || xisnan (val)) && val > 0 && val < min_pos) + min_pos = val; + + val = m(3); + if (! (xisinf (val) || xisnan (val)) && val < 0 && val > max_neg) + max_neg = val; + } + } +} + +// magform(x) Returns (a, b), where x = a * 10^b, abs (a) >= 1., and b is +// integer. + +static void +magform (double x, double& a, int& b) +{ + if (x == 0) + { + a = 0; + b = 0; + } + else + { + b = static_cast (gnulib::floor (std::log10 (std::abs (x)))); + a = x / std::pow (10.0, b); + } +} + +// A translation from Tom Holoryd's python code at +// http://kurage.nimh.nih.gov/tomh/tics.py +// FIXME -- add log ticks + +double +axes::properties::calc_tick_sep (double lo, double hi) +{ + int ticint = 5; + + // Reference: Lewart, C. R., "Algorithms SCALE1, SCALE2, and + // SCALE3 for Determination of Scales on Computer Generated + // Plots", Communications of the ACM, 10 (1973), 639-640. + // Also cited as ACM Algorithm 463. + + double a; + int b, x; + + magform ((hi-lo)/ticint, a, b); + + static const double sqrt_2 = sqrt (2.0); + static const double sqrt_10 = sqrt (10.0); + static const double sqrt_50 = sqrt (50.0); + + if (a < sqrt_2) + x = 1; + else if (a < sqrt_10) + x = 2; + else if (a < sqrt_50) + x = 5; + else + x = 10; + + return x * std::pow (10., b); + +} + +// Attempt to make "nice" limits from the actual max and min of the +// data. For log plots, we will also use the smallest strictly positive +// value. + +Matrix +axes::properties::get_axis_limits (double xmin, double xmax, + double min_pos, double max_neg, + bool logscale) +{ + Matrix retval; + + double min_val = xmin; + double max_val = xmax; + + if (xisinf (min_val) && min_val > 0 && xisinf (max_val) && max_val < 0) + { + retval = default_lim (logscale); + return retval; + } + else if (! (xisinf (min_val) || xisinf (max_val))) + { + if (logscale) + { + if (xisinf (min_pos) && xisinf (max_neg)) + { + // TODO -- max_neg is needed for "loglog ([0 -Inf])" + // This is the only place where max_neg is needed. + // Is there another way? + retval = default_lim (); + retval(0) = pow (10., retval(0)); + retval(1) = pow (10., retval(1)); + return retval; + } + if ((min_val <= 0 && max_val > 0)) + { + warning ("axis: omitting non-positive data in log plot"); + min_val = min_pos; + } + // FIXME -- maybe this test should also be relative? + if (std::abs (min_val - max_val) < sqrt (std::numeric_limits::epsilon ())) + { + // Widen range when too small + if (min_val >= 0) + { + min_val *= 0.9; + max_val *= 1.1; + } + else + { + min_val *= 1.1; + max_val *= 0.9; + } + } + if (min_val > 0) + { + // Log plots with all positive data + min_val = pow (10, gnulib::floor (log10 (min_val))); + max_val = pow (10, std::ceil (log10 (max_val))); + } + else + { + // Log plots with all negative data + min_val = -pow (10, std::ceil (log10 (-min_val))); + max_val = -pow (10, gnulib::floor (log10 (-max_val))); + } + } + else + { + if (min_val == 0 && max_val == 0) + { + min_val = -1; + max_val = 1; + } + // FIXME -- maybe this test should also be relative? + else if (std::abs (min_val - max_val) < sqrt (std::numeric_limits::epsilon ())) + { + min_val -= 0.1 * std::abs (min_val); + max_val += 0.1 * std::abs (max_val); + } + + double tick_sep = calc_tick_sep (min_val , max_val); + double min_tick = gnulib::floor (min_val / tick_sep); + double max_tick = std::ceil (max_val / tick_sep); + // Prevent round-off from cropping ticks + min_val = std::min (min_val, tick_sep * min_tick); + max_val = std::max (max_val, tick_sep * max_tick); + } + } + + retval.resize (1, 2); + + retval(1) = max_val; + retval(0) = min_val; + + return retval; +} + +void +axes::properties::calc_ticks_and_lims (array_property& lims, + array_property& ticks, + array_property& mticks, + bool limmode_is_auto, bool is_logscale) +{ + // FIXME -- add log ticks and lims + + if (lims.get ().is_empty ()) + return; + + double lo = (lims.get ().matrix_value ()) (0); + double hi = (lims.get ().matrix_value ()) (1); + bool is_negative = lo < 0 && hi < 0; + double tmp; + // FIXME should this be checked for somewhere else? (i.e. set{x,y,z}lim) + if (hi < lo) + { + tmp = hi; + hi = lo; + lo = tmp; + } + + if (is_logscale) + { + if (is_negative) + { + tmp = hi; + hi = std::log10 (-lo); + lo = std::log10 (-tmp); + } + else + { + hi = std::log10 (hi); + lo = std::log10 (lo); + } + } + + double tick_sep = calc_tick_sep (lo , hi); + + if (is_logscale && ! (xisinf (hi) || xisinf (lo))) + { + // FIXME - what if (hi-lo) < tick_sep? + // ex: loglog ([1 1.1]) + tick_sep = std::max (tick_sep, 1.); + tick_sep = std::ceil (tick_sep); + } + + int i1 = static_cast (gnulib::floor (lo / tick_sep)); + int i2 = static_cast (std::ceil (hi / tick_sep)); + + if (limmode_is_auto) + { + // adjust limits to include min and max tics + Matrix tmp_lims (1,2); + tmp_lims(0) = std::min (tick_sep * i1, lo); + tmp_lims(1) = std::max (tick_sep * i2, hi); + + if (is_logscale) + { + tmp_lims(0) = std::pow (10.,tmp_lims(0)); + tmp_lims(1) = std::pow (10.,tmp_lims(1)); + if (tmp_lims(0) <= 0) + tmp_lims(0) = std::pow (10., lo); + if (is_negative) + { + tmp = tmp_lims(0); + tmp_lims(0) = -tmp_lims(1); + tmp_lims(1) = -tmp; + } + } + lims = tmp_lims; + } + + Matrix tmp_ticks (1, i2-i1+1); + for (int i = 0; i <= i2-i1; i++) + { + tmp_ticks (i) = tick_sep * (i+i1); + if (is_logscale) + tmp_ticks (i) = std::pow (10., tmp_ticks (i)); + } + if (is_logscale && is_negative) + { + Matrix rev_ticks (1, i2-i1+1); + rev_ticks = -tmp_ticks; + for (int i = 0; i <= i2-i1; i++) + tmp_ticks (i) = rev_ticks (i2-i1-i); + } + + ticks = tmp_ticks; + + int n = is_logscale ? 8 : 4; + Matrix tmp_mticks (1, n * (tmp_ticks.numel () - 1)); + + for (int i = 0; i < tmp_ticks.numel ()-1; i++) + { + double d = (tmp_ticks (i+1) - tmp_ticks (i)) / (n+1); + for (int j = 0; j < n; j++) + { + tmp_mticks (n*i+j) = tmp_ticks (i) + d * (j+1); + } + } + mticks = tmp_mticks; +} + +void +axes::properties::calc_ticklabels (const array_property& ticks, + any_property& labels, bool logscale) +{ + Matrix values = ticks.get ().matrix_value (); + Cell c (values.dims ()); + std::ostringstream os; + + if (logscale) + { + double significand; + double exponent; + double exp_max = 0.; + double exp_min = 0.; + + for (int i = 0; i < values.numel (); i++) + { + exp_max = std::max (exp_max, std::log10 (values(i))); + exp_min = std::max (exp_min, std::log10 (values(i))); + } + + for (int i = 0; i < values.numel (); i++) + { + if (values(i) < 0.) + exponent = gnulib::floor (std::log10 (-values(i))); + else + exponent = gnulib::floor (std::log10 (values(i))); + significand = values(i) * std::pow (10., -exponent); + os.str (std::string ()); + os << significand; + if (exponent < 0.) + { + os << "e-"; + exponent = -exponent; + } + else + os << "e+"; + if (exponent < 10. && (exp_max > 9 || exp_min < -9)) + os << "0"; + os << exponent; + c(i) = os.str (); + } + } + else + { + for (int i = 0; i < values.numel (); i++) + { + os.str (std::string ()); + os << values(i); + c(i) = os.str (); + } + } + + labels = c; +} + +Matrix +axes::properties::get_ticklabel_extents (const Matrix& ticks, + const string_vector& ticklabels, + const Matrix& limits) +{ +#ifndef HAVE_FREETYPE + double fontsize = get ("fontsize").double_value (); +#endif + + Matrix ext (1, 2, 0.0); + double wmax = 0., hmax = 0.; + int n = std::min (ticklabels.numel (), ticks.numel ()); + for (int i = 0; i < n; i++) + { + double val = ticks(i); + if (limits(0) <= val && val <= limits(1)) + { + std::string label (ticklabels(i)); + label.erase (0, label.find_first_not_of (" ")); + label = label.substr (0, label.find_last_not_of (" ")+1); +#ifdef HAVE_FREETYPE + ext = text_renderer.get_extent (label); + wmax = std::max (wmax, ext(0)); + hmax = std::max (hmax, ext(1)); +#else + // FIXME: find a better approximation + int len = label.length (); + wmax = std::max (wmax, 0.5*fontsize*len); + hmax = fontsize; +#endif + } + } + + ext(0) = wmax; + ext(1) = hmax; + return ext; +} + +void +get_children_limits (double& min_val, double& max_val, + double& min_pos, double& max_neg, + const Matrix& kids, char limit_type) +{ + octave_idx_type n = kids.numel (); + + switch (limit_type) + { + case 'x': + for (octave_idx_type i = 0; i < n; i++) + { + graphics_object obj = gh_manager::get_object (kids(i)); + + if (obj.is_xliminclude ()) + { + octave_value lim = obj.get_xlim (); + + check_limit_vals (min_val, max_val, min_pos, max_neg, lim); + } + } + break; + + case 'y': + for (octave_idx_type i = 0; i < n; i++) + { + graphics_object obj = gh_manager::get_object (kids(i)); + + if (obj.is_yliminclude ()) + { + octave_value lim = obj.get_ylim (); + + check_limit_vals (min_val, max_val, min_pos, max_neg, lim); + } + } + break; + + case 'z': + for (octave_idx_type i = 0; i < n; i++) + { + graphics_object obj = gh_manager::get_object (kids(i)); + + if (obj.is_zliminclude ()) + { + octave_value lim = obj.get_zlim (); + + check_limit_vals (min_val, max_val, min_pos, max_neg, lim); + } + } + break; + + case 'c': + for (octave_idx_type i = 0; i < n; i++) + { + graphics_object obj = gh_manager::get_object (kids(i)); + + if (obj.is_climinclude ()) + { + octave_value lim = obj.get_clim (); + + check_limit_vals (min_val, max_val, min_pos, max_neg, lim); + } + } + break; + + case 'a': + for (octave_idx_type i = 0; i < n; i++) + { + graphics_object obj = gh_manager::get_object (kids(i)); + + if (obj.is_aliminclude ()) + { + octave_value lim = obj.get_alim (); + + check_limit_vals (min_val, max_val, min_pos, max_neg, lim); + } + } + break; + + default: + break; + } +} + +static bool updating_axis_limits = false; + +void +axes::update_axis_limits (const std::string& axis_type, + const graphics_handle& h) +{ + if (updating_axis_limits) + return; + + Matrix kids = Matrix (1, 1, h.value ()); + + double min_val = octave_Inf; + double max_val = -octave_Inf; + double min_pos = octave_Inf; + double max_neg = -octave_Inf; + + char update_type = 0; + + Matrix limits; + double val; + +#define FIX_LIMITS \ + if (limits.numel () == 4) \ + { \ + val = limits(0); \ + if (! (xisinf (val) || xisnan (val))) \ + min_val = val; \ + val = limits(1); \ + if (! (xisinf (val) || xisnan (val))) \ + max_val = val; \ + val = limits(2); \ + if (! (xisinf (val) || xisnan (val))) \ + min_pos = val; \ + val = limits(3); \ + if (! (xisinf (val) || xisnan (val))) \ + max_neg = val; \ + } \ + else \ + { \ + limits.resize (4, 1); \ + limits(0) = min_val; \ + limits(1) = max_val; \ + limits(2) = min_pos; \ + limits(3) = max_neg; \ + } + + if (axis_type == "xdata" || axis_type == "xscale" + || axis_type == "xlimmode" || axis_type == "xliminclude" + || axis_type == "xlim") + { + if (xproperties.xlimmode_is ("auto")) + { + limits = xproperties.get_xlim ().matrix_value (); + FIX_LIMITS ; + + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'x'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, + xproperties.xscale_is ("log")); + + update_type = 'x'; + } + } + else if (axis_type == "ydata" || axis_type == "yscale" + || axis_type == "ylimmode" || axis_type == "yliminclude" + || axis_type == "ylim") + { + if (xproperties.ylimmode_is ("auto")) + { + limits = xproperties.get_ylim ().matrix_value (); + FIX_LIMITS ; + + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'y'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, + xproperties.yscale_is ("log")); + + update_type = 'y'; + } + } + else if (axis_type == "zdata" || axis_type == "zscale" + || axis_type == "zlimmode" || axis_type == "zliminclude" + || axis_type == "zlim") + { + if (xproperties.zlimmode_is ("auto")) + { + limits = xproperties.get_zlim ().matrix_value (); + FIX_LIMITS ; + + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'z'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, + xproperties.zscale_is ("log")); + + update_type = 'z'; + } + } + else if (axis_type == "cdata" || axis_type == "climmode" + || axis_type == "cdatamapping" || axis_type == "climinclude" + || axis_type == "clim") + { + if (xproperties.climmode_is ("auto")) + { + limits = xproperties.get_clim ().matrix_value (); + FIX_LIMITS ; + + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'c'); + + if (min_val > max_val) + { + min_val = min_pos = 0; + max_val = 1; + } + else if (min_val == max_val) + { + max_val = min_val + 1; + min_val -= 1; + } + + limits.resize (1, 2); + + limits(0) = min_val; + limits(1) = max_val; + + update_type = 'c'; + } + + } + else if (axis_type == "alphadata" || axis_type == "alimmode" + || axis_type == "alphadatamapping" || axis_type == "aliminclude" + || axis_type == "alim") + { + if (xproperties.alimmode_is ("auto")) + { + limits = xproperties.get_alim ().matrix_value (); + FIX_LIMITS ; + + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'a'); + + if (min_val > max_val) + { + min_val = min_pos = 0; + max_val = 1; + } + else if (min_val == max_val) + max_val = min_val + 1; + + limits.resize (1, 2); + + limits(0) = min_val; + limits(1) = max_val; + + update_type = 'a'; + } + + } + +#undef FIX_LIMITS + + unwind_protect frame; + frame.protect_var (updating_axis_limits); + + updating_axis_limits = true; + + switch (update_type) + { + case 'x': + xproperties.set_xlim (limits); + xproperties.set_xlimmode ("auto"); + xproperties.update_xlim (); + break; + + case 'y': + xproperties.set_ylim (limits); + xproperties.set_ylimmode ("auto"); + xproperties.update_ylim (); + break; + + case 'z': + xproperties.set_zlim (limits); + xproperties.set_zlimmode ("auto"); + xproperties.update_zlim (); + break; + + case 'c': + xproperties.set_clim (limits); + xproperties.set_climmode ("auto"); + break; + + case 'a': + xproperties.set_alim (limits); + xproperties.set_alimmode ("auto"); + break; + + default: + break; + } + + xproperties.update_transform (); + +} + +void +axes::update_axis_limits (const std::string& axis_type) +{ + if (updating_axis_limits || updating_aspectratios) + return; + + Matrix kids = xproperties.get_children (); + + double min_val = octave_Inf; + double max_val = -octave_Inf; + double min_pos = octave_Inf; + double max_neg = -octave_Inf; + + char update_type = 0; + + Matrix limits; + + if (axis_type == "xdata" || axis_type == "xscale" + || axis_type == "xlimmode" || axis_type == "xliminclude" + || axis_type == "xlim") + { + if (xproperties.xlimmode_is ("auto")) + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'x'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, + xproperties.xscale_is ("log")); + + update_type = 'x'; + } + } + else if (axis_type == "ydata" || axis_type == "yscale" + || axis_type == "ylimmode" || axis_type == "yliminclude" + || axis_type == "ylim") + { + if (xproperties.ylimmode_is ("auto")) + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'y'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, + xproperties.yscale_is ("log")); + + update_type = 'y'; + } + } + else if (axis_type == "zdata" || axis_type == "zscale" + || axis_type == "zlimmode" || axis_type == "zliminclude" + || axis_type == "zlim") + { + if (xproperties.zlimmode_is ("auto")) + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'z'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, + xproperties.zscale_is ("log")); + + update_type = 'z'; + } + } + else if (axis_type == "cdata" || axis_type == "climmode" + || axis_type == "cdatamapping" || axis_type == "climinclude" + || axis_type == "clim") + { + if (xproperties.climmode_is ("auto")) + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'c'); + + if (min_val > max_val) + { + min_val = min_pos = 0; + max_val = 1; + } + else if (min_val == max_val) + { + max_val = min_val + 1; + min_val -= 1; + } + + limits.resize (1, 2); + + limits(0) = min_val; + limits(1) = max_val; + + update_type = 'c'; + } + + } + else if (axis_type == "alphadata" || axis_type == "alimmode" + || axis_type == "alphadatamapping" || axis_type == "aliminclude" + || axis_type == "alim") + { + if (xproperties.alimmode_is ("auto")) + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'a'); + + if (min_val > max_val) + { + min_val = min_pos = 0; + max_val = 1; + } + else if (min_val == max_val) + max_val = min_val + 1; + + limits.resize (1, 2); + + limits(0) = min_val; + limits(1) = max_val; + + update_type = 'a'; + } + + } + + unwind_protect frame; + frame.protect_var (updating_axis_limits); + + updating_axis_limits = true; + + switch (update_type) + { + case 'x': + xproperties.set_xlim (limits); + xproperties.set_xlimmode ("auto"); + xproperties.update_xlim (); + break; + + case 'y': + xproperties.set_ylim (limits); + xproperties.set_ylimmode ("auto"); + xproperties.update_ylim (); + break; + + case 'z': + xproperties.set_zlim (limits); + xproperties.set_zlimmode ("auto"); + xproperties.update_zlim (); + break; + + case 'c': + xproperties.set_clim (limits); + xproperties.set_climmode ("auto"); + break; + + case 'a': + xproperties.set_alim (limits); + xproperties.set_alimmode ("auto"); + break; + + default: + break; + } + + xproperties.update_transform (); +} + +inline +double force_in_range (const double x, const double lower, const double upper) +{ + if (x < lower) + { return lower; } + else if (x > upper) + { return upper; } + else + { return x; } +} + +static Matrix +do_zoom (double val, double factor, const Matrix& lims, bool is_logscale) +{ + Matrix new_lims = lims; + + double lo = lims(0); + double hi = lims(1); + + bool is_negative = lo < 0 && hi < 0; + + if (is_logscale) + { + if (is_negative) + { + double tmp = hi; + hi = std::log10 (-lo); + lo = std::log10 (-tmp); + val = std::log10 (-val); + } + else + { + hi = std::log10 (hi); + lo = std::log10 (lo); + val = std::log10 (val); + } + } + + // Perform the zooming + lo = val + factor * (lo - val); + hi = val + factor * (hi - val); + + if (is_logscale) + { + if (is_negative) + { + double tmp = -std::pow (10.0, hi); + hi = -std::pow (10.0, lo); + lo = tmp; + } + else + { + lo = std::pow (10.0, lo); + hi = std::pow (10.0, hi); + } + } + + new_lims(0) = lo; + new_lims(1) = hi; + + return new_lims; +} + +void +axes::properties::zoom_about_point (double x, double y, double factor, + bool push_to_zoom_stack) +{ + // FIXME: Do we need error checking here? + Matrix xlims = get_xlim ().matrix_value (); + Matrix ylims = get_ylim ().matrix_value (); + + // Get children axes limits + Matrix kids = get_children (); + double minx = octave_Inf; + double maxx = -octave_Inf; + double min_pos_x = octave_Inf; + double max_neg_x = -octave_Inf; + get_children_limits (minx, maxx, min_pos_x, max_neg_x, kids, 'x'); + + double miny = octave_Inf; + double maxy = -octave_Inf; + double min_pos_y = octave_Inf; + double max_neg_y = -octave_Inf; + get_children_limits (miny, maxy, min_pos_y, max_neg_y, kids, 'y'); + + xlims = do_zoom (x, factor, xlims, xscale_is ("log")); + ylims = do_zoom (y, factor, ylims, yscale_is ("log")); + + zoom (xlims, ylims, push_to_zoom_stack); +} + +void +axes::properties::zoom (const Matrix& xl, const Matrix& yl, bool push_to_zoom_stack) +{ + if (push_to_zoom_stack) + { + zoom_stack.push_front (xlimmode.get ()); + zoom_stack.push_front (xlim.get ()); + zoom_stack.push_front (ylimmode.get ()); + zoom_stack.push_front (ylim.get ()); + } + + xlim = xl; + xlimmode = "manual"; + ylim = yl; + ylimmode = "manual"; + + update_transform (); + update_xlim (false); + update_ylim (false); +} + +static Matrix +do_translate (double x0, double x1, const Matrix& lims, bool is_logscale) +{ + Matrix new_lims = lims; + + double lo = lims(0); + double hi = lims(1); + + bool is_negative = lo < 0 && hi < 0; + + double delta; + + if (is_logscale) + { + if (is_negative) + { + double tmp = hi; + hi = std::log10 (-lo); + lo = std::log10 (-tmp); + x0 = -x0; + x1 = -x1; + } + else + { + hi = std::log10 (hi); + lo = std::log10 (lo); + } + + delta = std::log10 (x0) - std::log10 (x1); + } + else + { + delta = x0 - x1; + } + + // Perform the translation + lo += delta; + hi += delta; + + if (is_logscale) + { + if (is_negative) + { + double tmp = -std::pow (10.0, hi); + hi = -std::pow (10.0, lo); + lo = tmp; + } + else + { + lo = std::pow (10.0, lo); + hi = std::pow (10.0, hi); + } + } + + new_lims(0) = lo; + new_lims(1) = hi; + + return new_lims; +} + +void +axes::properties::translate_view (double x0, double x1, double y0, double y1) +{ + // FIXME: Do we need error checking here? + Matrix xlims = get_xlim ().matrix_value (); + Matrix ylims = get_ylim ().matrix_value (); + + // Get children axes limits + Matrix kids = get_children (); + double minx = octave_Inf; + double maxx = -octave_Inf; + double min_pos_x = octave_Inf; + double max_neg_x = -octave_Inf; + get_children_limits (minx, maxx, min_pos_x, max_neg_x, kids, 'x'); + + double miny = octave_Inf; + double maxy = -octave_Inf; + double min_pos_y = octave_Inf; + double max_neg_y = -octave_Inf; + get_children_limits (miny, maxy, min_pos_y, max_neg_y, kids, 'y'); + + xlims = do_translate (x0, x1, xlims, xscale_is ("log")); + ylims = do_translate (y0, y1, ylims, yscale_is ("log")); + + zoom (xlims, ylims, false); +} + +void +axes::properties::rotate_view (double delta_el, double delta_az) +{ + Matrix v = get_view ().matrix_value (); + + v(1) += delta_el; + + if (v(1) > 90) + v(1) = 90; + if (v(1) < -90) + v(1) = -90; + + v(0) = fmod (v(0) - delta_az + 720,360); + + set_view (v); + update_transform (); +} + +void +axes::properties::unzoom (void) +{ + if (zoom_stack.size () >= 4) + { + ylim = zoom_stack.front (); + zoom_stack.pop_front (); + ylimmode = zoom_stack.front (); + zoom_stack.pop_front (); + xlim = zoom_stack.front (); + zoom_stack.pop_front (); + xlimmode = zoom_stack.front (); + zoom_stack.pop_front (); + + update_transform (); + update_xlim (false); + update_ylim (false); + } +} + +void +axes::properties::clear_zoom_stack (void) +{ + while (zoom_stack.size () > 4) + zoom_stack.pop_front (); + + unzoom (); +} + +void +axes::reset_default_properties (void) +{ + ::reset_default_properties (default_properties); +} + +void +axes::initialize (const graphics_object& go) +{ + base_graphics_object::initialize (go); + + xinitialize (xproperties.get_title ()); + xinitialize (xproperties.get_xlabel ()); + xinitialize (xproperties.get_ylabel ()); + xinitialize (xproperties.get_zlabel ()); +} + +// --------------------------------------------------------------------- + +Matrix +line::properties::compute_xlim (void) const +{ + Matrix m (1, 4); + + m(0) = xdata.min_val (); + m(1) = xdata.max_val (); + m(2) = xdata.min_pos (); + m(3) = xdata.max_neg (); + + return m; +} + +Matrix +line::properties::compute_ylim (void) const +{ + Matrix m (1, 4); + + m(0) = ydata.min_val (); + m(1) = ydata.max_val (); + m(2) = ydata.min_pos (); + m(3) = ydata.max_neg (); + + return m; +} + +// --------------------------------------------------------------------- + +Matrix +text::properties::get_data_position (void) const +{ + Matrix pos = get_position ().matrix_value (); + + if (! units_is ("data")) + pos = convert_text_position (pos, *this, get_units (), "data"); + + return pos; +} + +Matrix +text::properties::get_extent_matrix (void) const +{ + // FIXME: Should this function also add the (x,y) base position? + return extent.get ().matrix_value (); +} + +octave_value +text::properties::get_extent (void) const +{ + // FIXME: This doesn't work right for 3D plots. + // (It doesn't in Matlab either, at least not in version 6.5.) + Matrix m = extent.get ().matrix_value (); + Matrix pos = get_position ().matrix_value (); + Matrix p = convert_text_position (pos, *this, get_units (), "pixels"); + + m(0) += p(0); + m(1) += p(1); + + return convert_text_position (m, *this, "pixels", get_units ()); +} + +void +text::properties::update_font (void) +{ +#ifdef HAVE_FREETYPE +#ifdef HAVE_FONTCONFIG + renderer.set_font (get ("fontname").string_value (), + get ("fontweight").string_value (), + get ("fontangle").string_value (), + get ("fontsize").double_value ()); +#endif + renderer.set_color (get_color_rgb ()); +#endif +} + +void +text::properties::update_text_extent (void) +{ +#ifdef HAVE_FREETYPE + + int halign = 0, valign = 0; + + if (horizontalalignment_is ("center")) + halign = 1; + else if (horizontalalignment_is ("right")) + halign = 2; + + if (verticalalignment_is ("middle")) + valign = 1; + else if (verticalalignment_is ("top")) + valign = 2; + else if (verticalalignment_is ("baseline")) + valign = 3; + else if (verticalalignment_is ("cap")) + valign = 4; + + Matrix bbox; + + // FIXME: string should be parsed only when modified, for efficiency + + octave_value string_prop = get_string (); + + string_vector sv = string_prop.all_strings (); + + renderer.text_to_pixels (sv.join ("\n"), pixels, bbox, + halign, valign, get_rotation ()); + /* The bbox is relative to the text's position. + We'll leave it that way, because get_position () does not return + valid results when the text is first constructed. + Conversion to proper coordinates is performed in get_extent. */ + set_extent (bbox); + +#endif + + if (autopos_tag_is ("xlabel") || autopos_tag_is ("ylabel") || + autopos_tag_is ("zlabel") || autopos_tag_is ("title")) + update_autopos ("sync"); +} + +void +text::properties::request_autopos (void) +{ + if (autopos_tag_is ("xlabel") || autopos_tag_is ("ylabel") || + autopos_tag_is ("zlabel") || autopos_tag_is ("title")) + update_autopos (get_autopos_tag ()); +} + +void +text::properties::update_units (void) +{ + if (! units_is ("data")) + { + set_xliminclude ("off"); + set_yliminclude ("off"); + set_zliminclude ("off"); + } + + Matrix pos = get_position ().matrix_value (); + + pos = convert_text_position (pos, *this, cached_units, get_units ()); + // FIXME: if the current axes view is 2D, then one should + // probably drop the z-component of "pos" and leave "zliminclude" + // to "off". + set_position (pos); + + if (units_is ("data")) + { + set_xliminclude ("on"); + set_yliminclude ("on"); + // FIXME: see above + set_zliminclude ("off"); + } + + cached_units = get_units (); +} + +double +text::properties::get_fontsize_points (double box_pix_height) const +{ + double fs = get_fontsize (); + double parent_height = box_pix_height; + + if (fontunits_is ("normalized") && parent_height <= 0) + { + graphics_object go (gh_manager::get_object (get___myhandle__ ())); + graphics_object ax (go.get_ancestor ("axes")); + + parent_height = ax.get_properties ().get_boundingbox (true).elem (3); + } + + return convert_font_size (fs, get_fontunits (), "points", parent_height); +} + +// --------------------------------------------------------------------- + +octave_value +image::properties::get_color_data (void) const +{ + return convert_cdata (*this, get_cdata (), + cdatamapping_is ("scaled"), 3); +} + +// --------------------------------------------------------------------- + +octave_value +patch::properties::get_color_data (void) const +{ + octave_value fvc = get_facevertexcdata (); + if (fvc.is_undefined () || fvc.is_empty ()) + return Matrix (); + else + return convert_cdata (*this, fvc,cdatamapping_is ("scaled"), 2); +} + +// --------------------------------------------------------------------- + +octave_value +surface::properties::get_color_data (void) const +{ + return convert_cdata (*this, get_cdata (), cdatamapping_is ("scaled"), 3); +} + +inline void +cross_product (double x1, double y1, double z1, + double x2, double y2, double z2, + double& x, double& y, double& z) +{ + x += (y1 * z2 - z1 * y2); + y += (z1 * x2 - x1 * z2); + z += (x1 * y2 - y1 * x2); +} + +void +surface::properties::update_normals (void) +{ + if (normalmode_is ("auto")) + { + Matrix x = get_xdata ().matrix_value (); + Matrix y = get_ydata ().matrix_value (); + Matrix z = get_zdata ().matrix_value (); + + + int p = z.columns (), q = z.rows (); + int i1 = 0, i2 = 0, i3 = 0; + int j1 = 0, j2 = 0, j3 = 0; + + bool x_mat = (x.rows () == q); + bool y_mat = (y.columns () == p); + + NDArray n (dim_vector (q, p, 3), 0.0); + + for (int i = 0; i < p; i++) + { + if (y_mat) + { + i1 = i - 1; + i2 = i; + i3 = i + 1; + } + + for (int j = 0; j < q; j++) + { + if (x_mat) + { + j1 = j - 1; + j2 = j; + j3 = j + 1; + } + + double& nx = n(j, i, 0); + double& ny = n(j, i, 1); + double& nz = n(j, i, 2); + + if ((j > 0) && (i > 0)) + // upper left quadrangle + cross_product (x(j1,i-1)-x(j2,i), y(j-1,i1)-y(j,i2), z(j-1,i-1)-z(j,i), + x(j2,i-1)-x(j1,i), y(j,i1)-y(j-1,i2), z(j,i-1)-z(j-1,i), + nx, ny, nz); + + if ((j > 0) && (i < (p -1))) + // upper right quadrangle + cross_product (x(j1,i+1)-x(j2,i), y(j-1,i3)-y(j,i2), z(j-1,i+1)-z(j,i), + x(j1,i)-x(j2,i+1), y(j-1,i2)-y(j,i3), z(j-1,i)-z(j,i+1), + nx, ny, nz); + + if ((j < (q - 1)) && (i > 0)) + // lower left quadrangle + cross_product (x(j2,i-1)-x(j3,i), y(j,i1)-y(j+1,i2), z(j,i-1)-z(j+1,i), + x(j3,i-1)-x(j2,i), y(j+1,i1)-y(j,i2), z(j+1,i-1)-z(j,i), + nx, ny, nz); + + if ((j < (q - 1)) && (i < (p -1))) + // lower right quadrangle + cross_product (x(j3,i)-x(j2,i+1), y(j+1,i2)-y(j,i3), z(j+1,i)-z(j,i+1), + x(j3,i+1)-x(j2,i), y(j+1,i3)-y(j,i2), z(j+1,i+1)-z(j,i), + nx, ny, nz); + + double d = -std::max (std::max (fabs (nx), fabs (ny)), fabs (nz)); + + nx /= d; + ny /= d; + nz /= d; + } + } + vertexnormals = n; + } +} + +// --------------------------------------------------------------------- + +void +hggroup::properties::update_limits (void) const +{ + graphics_object obj = gh_manager::get_object (__myhandle__); + + if (obj) + { + obj.update_axis_limits ("xlim"); + obj.update_axis_limits ("ylim"); + obj.update_axis_limits ("zlim"); + obj.update_axis_limits ("clim"); + obj.update_axis_limits ("alim"); + } +} + +void +hggroup::properties::update_limits (const graphics_handle& h) const +{ + graphics_object obj = gh_manager::get_object (__myhandle__); + + if (obj) + { + obj.update_axis_limits ("xlim", h); + obj.update_axis_limits ("ylim", h); + obj.update_axis_limits ("zlim", h); + obj.update_axis_limits ("clim", h); + obj.update_axis_limits ("alim", h); + } +} + +static bool updating_hggroup_limits = false; + +void +hggroup::update_axis_limits (const std::string& axis_type, + const graphics_handle& h) +{ + if (updating_hggroup_limits) + return; + + Matrix kids = Matrix (1, 1, h.value ()); + + double min_val = octave_Inf; + double max_val = -octave_Inf; + double min_pos = octave_Inf; + double max_neg = -octave_Inf; + + Matrix limits; + double val; + + char update_type = 0; + + if (axis_type == "xlim" || axis_type == "xliminclude") + { + limits = xproperties.get_xlim ().matrix_value (); + update_type = 'x'; + } + else if (axis_type == "ylim" || axis_type == "yliminclude") + { + limits = xproperties.get_ylim ().matrix_value (); + update_type = 'y'; + } + else if (axis_type == "zlim" || axis_type == "zliminclude") + { + limits = xproperties.get_zlim ().matrix_value (); + update_type = 'z'; + } + else if (axis_type == "clim" || axis_type == "climinclude") + { + limits = xproperties.get_clim ().matrix_value (); + update_type = 'c'; + } + else if (axis_type == "alim" || axis_type == "aliminclude") + { + limits = xproperties.get_alim ().matrix_value (); + update_type = 'a'; + } + + if (limits.numel () == 4) + { + val = limits(0); + if (! (xisinf (val) || xisnan (val))) + min_val = val; + val = limits(1); + if (! (xisinf (val) || xisnan (val))) + max_val = val; + val = limits(2); + if (! (xisinf (val) || xisnan (val))) + min_pos = val; + val = limits(3); + if (! (xisinf (val) || xisnan (val))) + max_neg = val; + } + else + { + limits.resize (4,1); + limits(0) = min_val; + limits(1) = max_val; + limits(2) = min_pos; + limits(3) = max_neg; + } + + get_children_limits (min_val, max_val, min_pos, max_neg, kids, update_type); + + unwind_protect frame; + frame.protect_var (updating_hggroup_limits); + + updating_hggroup_limits = true; + + if (limits(0) != min_val || limits(1) != max_val + || limits(2) != min_pos || limits(3) != max_neg) + { + limits(0) = min_val; + limits(1) = max_val; + limits(2) = min_pos; + limits(3) = max_neg; + + switch (update_type) + { + case 'x': + xproperties.set_xlim (limits); + break; + + case 'y': + xproperties.set_ylim (limits); + break; + + case 'z': + xproperties.set_zlim (limits); + break; + + case 'c': + xproperties.set_clim (limits); + break; + + case 'a': + xproperties.set_alim (limits); + break; + + default: + break; + } + + base_graphics_object::update_axis_limits (axis_type, h); + } +} + +void +hggroup::update_axis_limits (const std::string& axis_type) +{ + if (updating_hggroup_limits) + return; + + Matrix kids = xproperties.get_children (); + + double min_val = octave_Inf; + double max_val = -octave_Inf; + double min_pos = octave_Inf; + double max_neg = -octave_Inf; + + char update_type = 0; + + if (axis_type == "xlim" || axis_type == "xliminclude") + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'x'); + + update_type = 'x'; + } + else if (axis_type == "ylim" || axis_type == "yliminclude") + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'y'); + + update_type = 'y'; + } + else if (axis_type == "zlim" || axis_type == "zliminclude") + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'z'); + + update_type = 'z'; + } + else if (axis_type == "clim" || axis_type == "climinclude") + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'c'); + + update_type = 'c'; + } + else if (axis_type == "alim" || axis_type == "aliminclude") + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'a'); + + update_type = 'a'; + } + + unwind_protect frame; + frame.protect_var (updating_hggroup_limits); + + updating_hggroup_limits = true; + + Matrix limits (1, 4, 0.0); + + limits(0) = min_val; + limits(1) = max_val; + limits(2) = min_pos; + limits(3) = max_neg; + + switch (update_type) + { + case 'x': + xproperties.set_xlim (limits); + break; + + case 'y': + xproperties.set_ylim (limits); + break; + + case 'z': + xproperties.set_zlim (limits); + break; + + case 'c': + xproperties.set_clim (limits); + break; + + case 'a': + xproperties.set_alim (limits); + break; + + default: + break; + } + + base_graphics_object::update_axis_limits (axis_type); +} + +// --------------------------------------------------------------------- + +octave_value +uicontrol::properties::get_extent (void) const +{ + Matrix m = extent.get ().matrix_value (); + + graphics_object parent_obj = + gh_manager::get_object (get_parent ()); + Matrix parent_bbox = parent_obj.get_properties ().get_boundingbox (true), + parent_size = parent_bbox.extract_n (0, 2, 1, 2); + + return convert_position (m, "pixels", get_units (), parent_size); +} + +void +uicontrol::properties::update_text_extent (void) +{ +#ifdef HAVE_FREETYPE + + text_element *elt; + ft_render text_renderer; + Matrix box; + + // FIXME: parsed content should be cached for efficiency + // FIXME: support multiline text + + elt = text_parser_none ().parse (get_string_string ()); +#ifdef HAVE_FONTCONFIG + text_renderer.set_font (get_fontname (), + get_fontweight (), + get_fontangle (), + get_fontsize ()); +#endif + box = text_renderer.get_extent (elt, 0); + + Matrix ext (1, 4, 0.0); + + // FIXME: also handle left and bottom components + + ext(0) = ext(1) = 1; + ext(2) = box(0); + ext(3) = box(1); + + set_extent (ext); + +#endif +} + +void +uicontrol::properties::update_units (void) +{ + Matrix pos = get_position ().matrix_value (); + + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + Matrix parent_bbox = parent_obj.get_properties ().get_boundingbox (true), + parent_size = parent_bbox.extract_n (0, 2, 1, 2); + + pos = convert_position (pos, cached_units, get_units (), parent_size); + set_position (pos); + + cached_units = get_units (); +} + +void +uicontrol::properties::set_style (const octave_value& st) +{ + if (get___object__ ().is_empty ()) + style = st; + else + error ("set: cannot change the style of a uicontrol object after creation."); +} + +Matrix +uicontrol::properties::get_boundingbox (bool, + const Matrix& parent_pix_size) const +{ + Matrix pos = get_position ().matrix_value (); + Matrix parent_size (parent_pix_size); + + if (parent_size.numel () == 0) + { + graphics_object obj = gh_manager::get_object (get_parent ()); + + parent_size = + obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); + } + + pos = convert_position (pos, get_units (), "pixels", parent_size); + + pos(0)--; + pos(1)--; + pos(1) = parent_size(1) - pos(1) - pos(3); + + return pos; +} + +void +uicontrol::properties::set_fontunits (const octave_value& v) +{ + if (! error_state) + { + caseless_str old_fontunits = get_fontunits (); + if (fontunits.set (v, true)) + { + update_fontunits (old_fontunits); + mark_modified (); + } + } +} + +void +uicontrol::properties::update_fontunits (const caseless_str& old_units) +{ + caseless_str new_units = get_fontunits (); + double parent_height = get_boundingbox (false).elem (3); + double fsz = get_fontsize (); + + fsz = convert_font_size (fsz, old_units, new_units, parent_height); + + fontsize.set (octave_value (fsz), true); +} + +double +uicontrol::properties::get_fontsize_points (double box_pix_height) const +{ + double fs = get_fontsize (); + double parent_height = box_pix_height; + + if (fontunits_is ("normalized") && parent_height <= 0) + parent_height = get_boundingbox (false).elem (3); + + return convert_font_size (fs, get_fontunits (), "points", parent_height); +} + +// --------------------------------------------------------------------- + +Matrix +uipanel::properties::get_boundingbox (bool internal, + const Matrix& parent_pix_size) const +{ + Matrix pos = get_position ().matrix_value (); + Matrix parent_size (parent_pix_size); + + if (parent_size.numel () == 0) + { + graphics_object obj = gh_manager::get_object (get_parent ()); + + parent_size = + obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); + } + + pos = convert_position (pos, get_units (), "pixels", parent_size); + + pos(0)--; + pos(1)--; + pos(1) = parent_size(1) - pos(1) - pos(3); + + if (internal) + { + double outer_height = pos(3); + + pos(0) = pos(1) = 0; + + if (! bordertype_is ("none")) + { + double bw = get_borderwidth (); + double mul = 1.0; + + if (bordertype_is ("etchedin") || bordertype_is ("etchedout")) + mul = 2.0; + + pos(0) += mul * bw; + pos(1) += mul * bw; + pos(2) -= 2 * mul * bw; + pos(3) -= 2 * mul * bw; + } + + if (! get_title ().empty ()) + { + double fs = get_fontsize (); + + if (! fontunits_is ("pixels")) + { + double res = xget (0, "screenpixelsperinch").double_value (); + + if (fontunits_is ("points")) + fs *= (res / 72.0); + else if (fontunits_is ("inches")) + fs *= res; + else if (fontunits_is ("centimeters")) + fs *= (res / 2.54); + else if (fontunits_is ("normalized")) + fs *= outer_height; + } + + if (titleposition_is ("lefttop") || titleposition_is ("centertop") + || titleposition_is ("righttop")) + pos(1) += (fs / 2); + pos(3) -= (fs / 2); + } + } + + return pos; +} + +void +uipanel::properties::set_units (const octave_value& v) +{ + if (! error_state) + { + caseless_str old_units = get_units (); + if (units.set (v, true)) + { + update_units (old_units); + mark_modified (); + } + } +} + +void +uipanel::properties::update_units (const caseless_str& old_units) +{ + Matrix pos = get_position ().matrix_value (); + + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + Matrix parent_bbox = parent_obj.get_properties ().get_boundingbox (true), + parent_size = parent_bbox.extract_n (0, 2, 1, 2); + + pos = convert_position (pos, old_units, get_units (), parent_size); + set_position (pos); +} + +void +uipanel::properties::set_fontunits (const octave_value& v) +{ + if (! error_state) + { + caseless_str old_fontunits = get_fontunits (); + if (fontunits.set (v, true)) + { + update_fontunits (old_fontunits); + mark_modified (); + } + } +} + +void +uipanel::properties::update_fontunits (const caseless_str& old_units) +{ + caseless_str new_units = get_fontunits (); + double parent_height = get_boundingbox (false).elem (3); + double fsz = get_fontsize (); + + fsz = convert_font_size (fsz, old_units, new_units, parent_height); + + set_fontsize (octave_value (fsz)); +} + +double +uipanel::properties::get_fontsize_points (double box_pix_height) const +{ + double fs = get_fontsize (); + double parent_height = box_pix_height; + + if (fontunits_is ("normalized") && parent_height <= 0) + parent_height = get_boundingbox (false).elem (3); + + return convert_font_size (fs, get_fontunits (), "points", parent_height); +} + +// --------------------------------------------------------------------- + +octave_value +uitoolbar::get_default (const caseless_str& name) const +{ + octave_value retval = default_properties.lookup (name); + + if (retval.is_undefined ()) + { + graphics_handle parent = get_parent (); + graphics_object parent_obj = gh_manager::get_object (parent); + + retval = parent_obj.get_default (name); + } + + return retval; +} + +void +uitoolbar::reset_default_properties (void) +{ + ::reset_default_properties (default_properties); +} + +// --------------------------------------------------------------------- + +octave_value +base_graphics_object::get_default (const caseless_str& name) const +{ + graphics_handle parent = get_parent (); + graphics_object parent_obj = gh_manager::get_object (parent); + + return parent_obj.get_default (type () + name); +} + +octave_value +base_graphics_object::get_factory_default (const caseless_str& name) const +{ + graphics_object parent_obj = gh_manager::get_object (0); + + return parent_obj.get_factory_default (type () + name); +} + +// We use a random value for the handle to avoid issues with plots and +// scalar values for the first argument. +gh_manager::gh_manager (void) + : handle_map (), handle_free_list (), + next_handle (-1.0 - (rand () + 1.0) / (RAND_MAX + 2.0)), + figure_list (), graphics_lock (), event_queue (), + callback_objects (), event_processing (0) +{ + handle_map[0] = graphics_object (new root_figure ()); + + // Make sure the default graphics toolkit is registered. + gtk_manager::default_toolkit (); +} + +void +gh_manager::create_instance (void) +{ + instance = new gh_manager (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); +} + +graphics_handle +gh_manager::do_make_graphics_handle (const std::string& go_name, + const graphics_handle& p, + bool integer_figure_handle, + bool do_createfcn, + bool do_notify_toolkit) +{ + graphics_handle h = get_handle (integer_figure_handle); + + base_graphics_object *go = 0; + + go = make_graphics_object_from_type (go_name, h, p); + + if (go) + { + graphics_object obj (go); + + handle_map[h] = obj; + if (do_createfcn) + go->get_properties ().execute_createfcn (); + + // Notify graphics toolkit. + if (do_notify_toolkit) + obj.initialize (); + } + else + error ("gh_manager::do_make_graphics_handle: invalid object type '%s'", + go_name.c_str ()); + + return h; +} + +graphics_handle +gh_manager::do_make_figure_handle (double val, bool do_notify_toolkit) +{ + graphics_handle h = val; + + base_graphics_object* go = new figure (h, 0); + graphics_object obj (go); + + handle_map[h] = obj; + + // Notify graphics toolkit. + if (do_notify_toolkit) + obj.initialize (); + + return h; +} + +void +gh_manager::do_push_figure (const graphics_handle& h) +{ + do_pop_figure (h); + + figure_list.push_front (h); +} + +void +gh_manager::do_pop_figure (const graphics_handle& h) +{ + for (figure_list_iterator p = figure_list.begin (); + p != figure_list.end (); + p++) + { + if (*p == h) + { + figure_list.erase (p); + break; + } + } +} + +class +callback_event : public base_graphics_event +{ +public: + callback_event (const graphics_handle& h, const std::string& name, + const octave_value& data = Matrix ()) + : base_graphics_event (), handle (h), callback_name (name), + callback (), callback_data (data) { } + + callback_event (const graphics_handle& h, const octave_value& cb, + const octave_value& data = Matrix ()) + : base_graphics_event (), handle (h), callback_name (), + callback (cb), callback_data (data) { } + + void execute (void) + { + if (callback.is_defined ()) + gh_manager::execute_callback (handle, callback, callback_data); + else + gh_manager::execute_callback (handle, callback_name, callback_data); + } + +private: + callback_event (void) + : base_graphics_event (), handle (), + callback_name (), callback_data () + { } + +private: + graphics_handle handle; + std::string callback_name; + octave_value callback; + octave_value callback_data; +}; + +class +function_event : public base_graphics_event +{ +public: + function_event (graphics_event::event_fcn fcn, void* data = 0) + : base_graphics_event (), function (fcn), + function_data (data) { } + + void execute (void) + { + function (function_data); + } + +private: + + graphics_event::event_fcn function; + + void* function_data; + + // function_event objects must be created with at least a function. + function_event (void); + + // No copying! + + function_event (const function_event &); + + function_event & operator = (const function_event &); +}; + +class +set_event : public base_graphics_event +{ +public: + set_event (const graphics_handle& h, const std::string& name, + const octave_value& value, bool do_notify_toolkit = true) + : base_graphics_event (), handle (h), property_name (name), + property_value (value), notify_toolkit (do_notify_toolkit) { } + + void execute (void) + { + gh_manager::auto_lock guard; + + graphics_object go = gh_manager::get_object (handle); + + if (go) + { + property p = go.get_properties ().get_property (property_name); + + if (p.ok ()) + p.set (property_value, true, notify_toolkit); + } + } + +private: + set_event (void) + : base_graphics_event (), handle (), property_name (), property_value () + { } + +private: + graphics_handle handle; + std::string property_name; + octave_value property_value; + bool notify_toolkit; +}; + +graphics_event +graphics_event::create_callback_event (const graphics_handle& h, + const std::string& name, + const octave_value& data) +{ + graphics_event e; + + e.rep = new callback_event (h, name, data); + + return e; +} + +graphics_event +graphics_event::create_callback_event (const graphics_handle& h, + const octave_value& cb, + const octave_value& data) +{ + graphics_event e; + + e.rep = new callback_event (h, cb, data); + + return e; +} + +graphics_event +graphics_event::create_function_event (graphics_event::event_fcn fcn, + void *data) +{ + graphics_event e; + + e.rep = new function_event (fcn, data); + + return e; +} + +graphics_event +graphics_event::create_set_event (const graphics_handle& h, + const std::string& name, + const octave_value& data, + bool notify_toolkit) +{ + graphics_event e; + + e.rep = new set_event (h, name, data, notify_toolkit); + + return e; +} + +static void +xset_gcbo (const graphics_handle& h) +{ + graphics_object go = gh_manager::get_object (0); + root_figure::properties& props = + dynamic_cast (go.get_properties ()); + + props.set_callbackobject (h.as_octave_value ()); +} + +void +gh_manager::do_restore_gcbo (void) +{ + gh_manager::auto_lock guard; + + callback_objects.pop_front (); + + xset_gcbo (callback_objects.empty () + ? graphics_handle () + : callback_objects.front ().get_handle ()); +} + +void +gh_manager::do_execute_listener (const graphics_handle& h, + const octave_value& l) +{ + if (octave_thread::is_octave_thread ()) + gh_manager::execute_callback (h, l, octave_value ()); + else + { + gh_manager::auto_lock guard; + + do_post_event (graphics_event::create_callback_event (h, l)); + } +} + +void +gh_manager::do_execute_callback (const graphics_handle& h, + const octave_value& cb_arg, + const octave_value& data) +{ + if (cb_arg.is_defined () && ! cb_arg.is_empty ()) + { + octave_value_list args; + octave_function *fcn = 0; + + args(0) = h.as_octave_value (); + if (data.is_defined ()) + args(1) = data; + else + args(1) = Matrix (); + + unwind_protect_safe frame; + frame.add_fcn (gh_manager::restore_gcbo); + + if (true) + { + gh_manager::auto_lock guard; + + callback_objects.push_front (get_object (h)); + xset_gcbo (h); + } + + BEGIN_INTERRUPT_WITH_EXCEPTIONS; + + // Copy CB because "function_value" method is non-const. + + octave_value cb = cb_arg; + + if (cb.is_function () || cb.is_function_handle ()) + fcn = cb.function_value (); + else if (cb.is_string ()) + { + int status; + std::string s = cb.string_value (); + + eval_string (s, false, status, 0); + } + else if (cb.is_cell () && cb.length () > 0 + && (cb.rows () == 1 || cb.columns () == 1) + && (cb.cell_value ()(0).is_function () + || cb.cell_value ()(0).is_function_handle ())) + { + Cell c = cb.cell_value (); + + fcn = c(0).function_value (); + if (! error_state) + { + for (int i = 1; i < c.length () ; i++) + args(1+i) = c(i); + } + } + else + { + std::string nm = cb.class_name (); + error ("trying to execute non-executable object (class = %s)", + nm.c_str ()); + } + + if (fcn && ! error_state) + feval (fcn, args); + + END_INTERRUPT_WITH_EXCEPTIONS; + } +} + +void +gh_manager::do_post_event (const graphics_event& e) +{ + event_queue.push_back (e); + + command_editor::add_event_hook (gh_manager::process_events); +} + +void +gh_manager::do_post_callback (const graphics_handle& h, const std::string name, + const octave_value& data) +{ + gh_manager::auto_lock guard; + + graphics_object go = get_object (h); + + if (go.valid_object ()) + { + if (callback_objects.empty ()) + do_post_event (graphics_event::create_callback_event (h, name, data)); + else + { + const graphics_object& current = callback_objects.front (); + + if (current.get_properties ().is_interruptible ()) + do_post_event (graphics_event::create_callback_event (h, name, data)); + else + { + caseless_str busy_action (go.get_properties ().get_busyaction ()); + + if (busy_action.compare ("queue")) + do_post_event (graphics_event::create_callback_event (h, name, data)); + else + { + caseless_str cname (name); + + if (cname.compare ("deletefcn") + || cname.compare ("createfcn") + || (go.isa ("figure") + && (cname.compare ("closerequestfcn") + || cname.compare ("resizefcn")))) + do_post_event (graphics_event::create_callback_event (h, name, data)); + } + } + } + } +} + +void +gh_manager::do_post_function (graphics_event::event_fcn fcn, void* fcn_data) +{ + gh_manager::auto_lock guard; + + do_post_event (graphics_event::create_function_event (fcn, fcn_data)); +} + +void +gh_manager::do_post_set (const graphics_handle& h, const std::string name, + const octave_value& value, bool notify_toolkit) +{ + gh_manager::auto_lock guard; + + do_post_event (graphics_event::create_set_event (h, name, value, + notify_toolkit)); +} + +int +gh_manager::do_process_events (bool force) +{ + graphics_event e; + bool old_Vdrawnow_requested = Vdrawnow_requested; + bool events_executed = false; + + do + { + e = graphics_event (); + + gh_manager::lock (); + + if (! event_queue.empty ()) + { + if (callback_objects.empty () || force) + { + e = event_queue.front (); + + event_queue.pop_front (); + } + else + { + const graphics_object& go = callback_objects.front (); + + if (go.get_properties ().is_interruptible ()) + { + e = event_queue.front (); + + event_queue.pop_front (); + } + } + } + + gh_manager::unlock (); + + if (e.ok ()) + { + e.execute (); + events_executed = true; + } + } + while (e.ok ()); + + gh_manager::lock (); + + if (event_queue.empty () && event_processing == 0) + command_editor::remove_event_hook (gh_manager::process_events); + + gh_manager::unlock (); + + if (events_executed) + flush_octave_stdout (); + + if (Vdrawnow_requested && ! old_Vdrawnow_requested) + { + Fdrawnow (); + + Vdrawnow_requested = false; + } + + return 0; +} + +void +gh_manager::do_enable_event_processing (bool enable) +{ + gh_manager::auto_lock guard; + + if (enable) + { + event_processing++; + + command_editor::add_event_hook (gh_manager::process_events); + } + else + { + event_processing--; + + if (event_queue.empty () && event_processing == 0) + command_editor::remove_event_hook (gh_manager::process_events); + } +} + +property_list::plist_map_type +root_figure::init_factory_properties (void) +{ + property_list::plist_map_type plist_map; + + plist_map["figure"] = figure::properties::factory_defaults (); + plist_map["axes"] = axes::properties::factory_defaults (); + plist_map["line"] = line::properties::factory_defaults (); + plist_map["text"] = text::properties::factory_defaults (); + plist_map["image"] = image::properties::factory_defaults (); + plist_map["patch"] = patch::properties::factory_defaults (); + plist_map["surface"] = surface::properties::factory_defaults (); + plist_map["hggroup"] = hggroup::properties::factory_defaults (); + plist_map["uimenu"] = uimenu::properties::factory_defaults (); + plist_map["uicontrol"] = uicontrol::properties::factory_defaults (); + plist_map["uipanel"] = uipanel::properties::factory_defaults (); + plist_map["uicontextmenu"] = uicontextmenu::properties::factory_defaults (); + plist_map["uitoolbar"] = uitoolbar::properties::factory_defaults (); + plist_map["uipushtool"] = uipushtool::properties::factory_defaults (); + plist_map["uitoggletool"] = uitoggletool::properties::factory_defaults (); + + return plist_map; +} + +// --------------------------------------------------------------------- + +DEFUN (ishandle, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ishandle (@var{h})\n\ +Return true if @var{h} is a graphics handle and false otherwise.\n\ +@var{h} may also be a matrix of handles in which case a logical\n\ +array is returned that is true where the elements of @var{h} are\n\ +graphics handles and false where they are not.\n\ +@seealso{isfigure}\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + if (args.length () == 1) + retval = is_handle (args(0)); + else + print_usage (); + + return retval; +} + +static bool +is_handle_visible (const graphics_handle& h) +{ + return h.ok () && gh_manager::is_handle_visible (h); +} + +static bool +is_handle_visible (double val) +{ + return is_handle_visible (gh_manager::lookup (val)); +} + +static octave_value +is_handle_visible (const octave_value& val) +{ + octave_value retval = false; + + if (val.is_real_scalar () && is_handle_visible (val.double_value ())) + retval = true; + else if (val.is_numeric_type () && val.is_real_type ()) + { + const NDArray handles = val.array_value (); + + if (! error_state) + { + boolNDArray result (handles.dims ()); + + for (octave_idx_type i = 0; i < handles.numel (); i++) + result.xelem (i) = is_handle_visible (handles (i)); + + retval = result; + } + } + + return retval; +} + +DEFUN (__is_handle_visible__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} __is_handle_visible__ (@var{h})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = is_handle_visible (args(0)); + else + print_usage (); + + return retval; +} + +DEFUN (reset, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} reset (@var{h}, @var{property})\n\ +Remove any defaults set for the handle @var{h}. The default figure\n\ +properties of \"position\", \"units\", \"windowstyle\" and\n\ +\"paperunits\" and the default axes properties of \"position\" and \"units\"\n\ +are not reset.\n\ +@end deftypefn") +{ + int nargin = args.length (); + + if (nargin != 1) + print_usage (); + else + { + // get vector of graphics handles + ColumnVector hcv (args(0).vector_value ()); + + if (! error_state) + { + // loop over graphics objects + for (octave_idx_type n = 0; n < hcv.length (); n++) + gh_manager::get_object (hcv(n)).reset_default_properties (); + } + } + + return octave_value (); +} + +DEFUN (set, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} set (@var{h}, @var{property}, @var{value}, @dots{})\n\ +@deftypefnx {Built-in Function} {} set (@var{h}, @var{properties}, @var{values})\n\ +@deftypefnx {Built-in Function} {} set (@var{h}, @var{pv})\n\ +Set named property values for the graphics handle (or vector of graphics\n\ +handles) @var{h}.\n\ +There are three ways how to give the property names and values:\n\ +\n\ +@itemize\n\ +@item as a comma separated list of @var{property}, @var{value} pairs\n\ +\n\ +Here, each @var{property} is a string containing the property name, each\n\ +@var{value} is a value of the appropriate type for the property.\n\ +\n\ +@item as a cell array of strings @var{properties} containing property names\n\ +and a cell array @var{values} containing property values.\n\ +\n\ +In this case, the number of columns of @var{values} must match the number of\n\ +elements in @var{properties}. The first column of @var{values} contains\n\ +values for the first entry in @var{properties}, etc. The number of rows of\n\ +@var{values} must be 1 or match the number of elements of @var{h}. In the\n\ +first case, each handle in @var{h} will be assigned the same values. In the\n\ +latter case, the first handle in @var{h} will be assigned the values from\n\ +the first row of @var{values} and so on.\n\ +\n\ +@item as a structure array @var{pv}\n\ +\n\ +Here, the field names of @var{pv} represent the property names, and the field\n\ +values give the property values. In contrast to the previous case, all\n\ +elements of @var{pv} will be set in all handles in @var{h} independent of\n\ +the dimensions of @var{pv}.\n\ +@end itemize\n\ +@seealso{get}\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + int nargin = args.length (); + + if (nargin > 0) + { + // get vector of graphics handles + ColumnVector hcv (args(0).vector_value ()); + + if (! error_state) + { + bool request_drawnow = false; + + // loop over graphics objects + for (octave_idx_type n = 0; n < hcv.length (); n++) + { + graphics_object obj = gh_manager::get_object (hcv(n)); + + if (obj) + { + if (nargin == 3 && args(1).is_cellstr () + && args(2).is_cell ()) + { + if (args(2).cell_value ().rows () == 1) + { + obj.set (args(1).cellstr_value (), + args(2).cell_value (), 0); + } + else if (hcv.length () == args(2).cell_value ().rows ()) + { + obj.set (args(1).cellstr_value (), + args(2).cell_value (), n); + } + else + { + error ("set: number of graphics handles must match number of value rows (%d != %d)", + hcv.length (), args(2).cell_value ().rows ()); + break; + + } + } + else if (nargin == 2 && args(1).is_map ()) + { + obj.set (args(1).map_value ()); + } + else if (nargin == 1) + { + if (nargout != 0) + retval = obj.values_as_struct (); + else + { + std::string s = obj.values_as_string (); + if (! error_state) + octave_stdout << s; + } + } + else + { + obj.set (args.splice (0, 1)); + request_drawnow = true; + } + } + else + { + error ("set: invalid handle (= %g)", hcv(n)); + break; + } + + if (error_state) + break; + + request_drawnow = true; + } + + if (! error_state && request_drawnow) + Vdrawnow_requested = true; + } + else + error ("set: expecting graphics handle as first argument"); + } + else + print_usage (); + + return retval; +} + +static std::string +get_graphics_object_type (const double val) +{ + std::string retval; + + graphics_object obj = gh_manager::get_object (val); + + if (obj) + retval = obj.type (); + else + error ("get: invalid handle (= %g)", val); + + return retval; +} + +DEFUN (get, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} get (@var{h})\n\ +@deftypefnx {Built-in Function} {@var{val} =} get (@var{h}, @var{p})\n\ +Return the value of the named property @var{p} from the graphics handle\n\ +@var{h}. If @var{p} is omitted, return the complete property list for\n\ +@var{h}. If @var{h} is a vector, return a cell array including the property\n\ +values or lists respectively.\n\ +@seealso{set}\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + Cell vals; + + int nargin = args.length (); + + bool use_cell_format = false; + + if (nargin == 1 || nargin == 2) + { + if (args(0).is_empty ()) + { + retval = Matrix (); + return retval; + } + + ColumnVector hcv (args(0).vector_value ()); + + if (! error_state) + { + octave_idx_type len = hcv.length (); + + if (nargin == 1 && len > 1) + { + std::string t0 = get_graphics_object_type (hcv(0)); + + if (! error_state) + { + for (octave_idx_type n = 1; n < len; n++) + { + std::string t = get_graphics_object_type (hcv(n)); + + if (error_state) + break; + + if (t != t0) + { + error ("get: vector of handles must all have same type"); + break; + } + } + + } + } + + if (! error_state) + { + if (nargin > 1 && args(1).is_cellstr ()) + { + Array plist = args(1).cellstr_value (); + + if (! error_state) + { + octave_idx_type plen = plist.numel (); + + use_cell_format = true; + + vals.resize (dim_vector (len, plen)); + + for (octave_idx_type n = 0; ! error_state && n < len; n++) + { + graphics_object obj = gh_manager::get_object (hcv(n)); + + if (obj) + { + for (octave_idx_type m = 0; ! error_state && m < plen; m++) + { + caseless_str property = plist(m); + + vals(n, m) = obj.get (property); + } + } + else + { + error ("get: invalid handle (= %g)", hcv(n)); + break; + } + } + } + else + error ("get: expecting property name or cell array of property names as second argument"); + } + else + { + caseless_str property; + + if (nargin > 1) + { + property = args(1).string_value (); + + if (error_state) + error ("get: expecting property name or cell array of property names as second argument"); + } + + vals.resize (dim_vector (len, 1)); + + if (! error_state) + { + for (octave_idx_type n = 0; ! error_state && n < len; n++) + { + graphics_object obj = gh_manager::get_object (hcv(n)); + + if (obj) + { + if (nargin == 1) + vals(n) = obj.get (); + else + vals(n) = obj.get (property); + } + else + { + error ("get: invalid handle (= %g)", hcv(n)); + break; + } + } + } + } + } + } + else + error ("get: expecting graphics handle as first argument"); + } + else + print_usage (); + + if (! error_state) + { + if (use_cell_format) + retval = vals; + else + { + octave_idx_type len = vals.numel (); + + if (len == 0) + retval = Matrix (); + else if (len == 1) + retval = vals(0); + else if (len > 1 && nargin == 1) + { + OCTAVE_LOCAL_BUFFER (octave_scalar_map, tmp, len); + + for (octave_idx_type n = 0; n < len; n++) + tmp[n] = vals(n).scalar_map_value (); + + retval = octave_map::cat (0, len, tmp); + } + else + retval = vals; + } + } + + return retval; +} + +/* +%!assert (get (findobj (0, "Tag", "nonexistenttag"), "nonexistentproperty"), []) +*/ + +// Return all properties from the graphics handle @var{h}. +// If @var{h} is a vector, return a cell array including the +// property values or lists respectively. + +DEFUN (__get__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __get__ (@var{h})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + Cell vals; + + int nargin = args.length (); + + if (nargin == 1) + { + ColumnVector hcv (args(0).vector_value ()); + + if (! error_state) + { + octave_idx_type len = hcv.length (); + + vals.resize (dim_vector (len, 1)); + + for (octave_idx_type n = 0; n < len; n++) + { + graphics_object obj = gh_manager::get_object (hcv(n)); + + if (obj) + vals(n) = obj.get (true); + else + { + error ("get: invalid handle (= %g)", hcv(n)); + break; + } + } + } + else + error ("get: expecting graphics handle as first argument"); + } + else + print_usage (); + + if (! error_state) + { + octave_idx_type len = vals.numel (); + + if (len > 1) + retval = vals; + else if (len == 1) + retval = vals(0); + } + + return retval; +} + +static octave_value +make_graphics_object (const std::string& go_name, + bool integer_figure_handle, + const octave_value_list& args) +{ + octave_value retval; + + double val = octave_NaN; + + octave_value_list xargs = args.splice (0, 1); + + caseless_str p ("parent"); + + for (int i = 0; i < xargs.length (); i++) + if (xargs(i).is_string () + && p.compare (xargs(i).string_value ())) + { + if (i < (xargs.length () - 1)) + { + val = xargs(i+1).double_value (); + + if (! error_state) + { + xargs = xargs.splice (i, 2); + break; + } + } + else + error ("__go_%s__: missing value for parent property", + go_name.c_str ()); + } + + if (! error_state && xisnan (val)) + val = args(0).double_value (); + + if (! error_state) + { + graphics_handle parent = gh_manager::lookup (val); + + if (parent.ok ()) + { + graphics_handle h + = gh_manager::make_graphics_handle (go_name, parent, + integer_figure_handle, + false, false); + + if (! error_state) + { + adopt (parent, h); + + xset (h, xargs); + xcreatefcn (h); + xinitialize (h); + + retval = h.value (); + + if (! error_state) + Vdrawnow_requested = true; + } + else + error ("__go%s__: unable to create graphics handle", + go_name.c_str ()); + } + else + error ("__go_%s__: invalid parent", go_name.c_str ()); + } + else + error ("__go_%s__: invalid parent", go_name.c_str ()); + + return retval; +} + +DEFUN (__go_figure__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_figure__ (@var{fignum})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + if (args.length () > 0) + { + double val = args(0).double_value (); + + if (! error_state) + { + if (is_figure (val)) + { + graphics_handle h = gh_manager::lookup (val); + + xset (h, args.splice (0, 1)); + + retval = h.value (); + } + else + { + bool int_fig_handle = true; + + octave_value_list xargs = args.splice (0, 1); + + graphics_handle h = octave_NaN; + + if (xisnan (val)) + { + caseless_str p ("integerhandle"); + + for (int i = 0; i < xargs.length (); i++) + { + if (xargs(i).is_string () + && p.compare (xargs(i).string_value ())) + { + if (i < (xargs.length () - 1)) + { + std::string pval = xargs(i+1).string_value (); + + if (! error_state) + { + caseless_str on ("on"); + int_fig_handle = on.compare (pval); + xargs = xargs.splice (i, 2); + break; + } + } + } + } + + h = gh_manager::make_graphics_handle ("figure", 0, + int_fig_handle, + false, false); + + if (! int_fig_handle) + { + // We need to intiailize the integerhandle + // property without calling the set_integerhandle + // method, because doing that will generate a new + // handle value... + + graphics_object go = gh_manager::get_object (h); + go.get_properties ().init_integerhandle ("off"); + } + } + else if (val > 0 && D_NINT (val) == val) + h = gh_manager::make_figure_handle (val, false); + + if (! error_state && h.ok ()) + { + adopt (0, h); + + gh_manager::push_figure (h); + + xset (h, xargs); + xcreatefcn (h); + xinitialize (h); + + retval = h.value (); + } + else + error ("__go_figure__: failed to create figure handle"); + } + } + else + error ("__go_figure__: expecting figure number to be double value"); + } + else + print_usage (); + + return retval; +} + +#define GO_BODY(TYPE) \ + gh_manager::auto_lock guard; \ + \ + octave_value retval; \ + \ + if (args.length () > 0) \ + retval = make_graphics_object (#TYPE, false, args); \ + else \ + print_usage (); \ + \ + return retval + +int +calc_dimensions (const graphics_object& go) +{ + + int nd = 2; + + if (go.isa ("surface")) + nd = 3; + + if ((go.isa ("line") || go.isa ("patch")) && ! go.get("zdata").is_empty ()) + nd = 3; + + Matrix kids = go.get_properties ().get_children (); + + for (octave_idx_type i = 0; i < kids.length (); i++) + { + graphics_handle hnd = gh_manager::lookup (kids(i)); + + if (hnd.ok ()) + { + const graphics_object& kid = gh_manager::get_object (hnd); + + if (kid.valid_object ()) + nd = calc_dimensions (kid); + + if (nd == 3) + break; + } + } + + return nd; +} + +DEFUN (__calc_dimensions__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __calc_dimensions__ (@var{axes})\n\ +Internal function. Determine the number of dimensions in a graphics\n\ +object, whether 2 or 3.\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + double h = args(0).double_value (); + + if (! error_state) + retval = calc_dimensions (gh_manager::get_object (h)); + else + error ("__calc_dimensions__: expecting graphics handle as only argument"); + } + else + print_usage (); + + return retval; +} + +DEFUN (__go_axes__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_axes__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (axes); +} + +DEFUN (__go_line__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_line__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (line); +} + +DEFUN (__go_text__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_text__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (text); +} + +DEFUN (__go_image__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_image__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (image); +} + +DEFUN (__go_surface__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_surface__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (surface); +} + +DEFUN (__go_patch__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_patch__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (patch); +} + +DEFUN (__go_hggroup__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_hggroup__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (hggroup); +} + +DEFUN (__go_uimenu__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uimenu__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uimenu); +} + +DEFUN (__go_uicontrol__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uicontrol__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uicontrol); +} + +DEFUN (__go_uipanel__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uipanel__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uipanel); +} + +DEFUN (__go_uicontextmenu__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uicontextmenu__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uicontextmenu); +} + +DEFUN (__go_uitoolbar__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uitoolbar__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uitoolbar); +} + +DEFUN (__go_uipushtool__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uipushtool__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uipushtool); +} + +DEFUN (__go_uitoggletool__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uitoggletool__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uitoggletool); +} + +DEFUN (__go_delete__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_delete__ (@var{h})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value_list retval; + + if (args.length () == 1) + { + graphics_handle h = octave_NaN; + + const NDArray vals = args (0).array_value (); + + if (! error_state) + { + // Check is all the handles to delete are valid first + // as callbacks might delete one of the handles we + // later want to delete + for (octave_idx_type i = 0; i < vals.numel (); i++) + { + h = gh_manager::lookup (vals.elem (i)); + + if (! h.ok ()) + { + error ("delete: invalid graphics object (= %g)", + vals.elem (i)); + break; + } + } + + if (! error_state) + delete_graphics_objects (vals); + } + else + error ("delete: invalid graphics object"); + } + else + print_usage (); + + return retval; +} + +DEFUN (__go_axes_init__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_axes_init__ (@var{h}, @var{mode})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + int nargin = args.length (); + + std::string mode = ""; + + if (nargin == 2) + { + mode = args(1).string_value (); + + if (error_state) + return retval; + } + + if (nargin == 1 || nargin == 2) + { + graphics_handle h = octave_NaN; + + double val = args(0).double_value (); + + if (! error_state) + { + h = gh_manager::lookup (val); + + if (h.ok ()) + { + graphics_object obj = gh_manager::get_object (h); + + obj.set_defaults (mode); + + h = gh_manager::lookup (val); + if (! h.ok ()) + error ("__go_axes_init__: axis deleted during initialization (= %g)", val); + } + else + error ("__go_axes_init__: invalid graphics object (= %g)", val); + } + else + error ("__go_axes_init__: invalid graphics object"); + } + else + print_usage (); + + return retval; +} + +DEFUN (__go_handles__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_handles__ (@var{show_hidden})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + bool show_hidden = false; + + if (args.length () > 0) + show_hidden = args(0).bool_value (); + + return octave_value (gh_manager::handle_list (show_hidden)); +} + +DEFUN (__go_figure_handles__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_figure_handles__ (@var{show_hidden})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + bool show_hidden = false; + + if (args.length () > 0) + show_hidden = args(0).bool_value (); + + return octave_value (gh_manager::figure_handle_list (show_hidden)); +} + +DEFUN (__go_execute_callback__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_execute_callback__ (@var{h}, @var{name})\n\ +@deftypefnx {Built-in Function} {} __go_execute_callback__ (@var{h}, @var{name}, @var{param})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2 || nargin == 3) + { + double val = args(0).double_value (); + + if (! error_state) + { + graphics_handle h = gh_manager::lookup (val); + + if (h.ok ()) + { + std::string name = args(1).string_value (); + + if (! error_state) + { + if (nargin == 2) + gh_manager::execute_callback (h, name); + else + gh_manager::execute_callback (h, name, args(2)); + } + else + error ("__go_execute_callback__: invalid callback name"); + } + else + error ("__go_execute_callback__: invalid graphics object (= %g)", + val); + } + else + error ("__go_execute_callback__: invalid graphics object"); + } + else + print_usage (); + + return retval; +} + +DEFUN (__image_pixel_size__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{px}, @var{py}} __image_pixel_size__ (@var{h})\n\ +Internal function: returns the pixel size of the image in normalized units.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + double h = args(0).double_value (); + + if (! error_state) + { + graphics_object fobj = gh_manager::get_object (h); + if (fobj && fobj.isa ("image")) + { + image::properties& ip = + dynamic_cast (fobj.get_properties ()); + + Matrix dp = Matrix (1, 2, 0); + dp(0, 0) = ip.pixel_xsize (); + dp(0, 1) = ip.pixel_ysize (); + retval = dp; + } + else + error ("__image_pixel_size__: object is not an image"); + } + else + error ("__image_pixel_size__: argument is not a handle"); + } + else + print_usage (); + + return retval; +} + +gtk_manager *gtk_manager::instance = 0; + +void +gtk_manager::create_instance (void) +{ + instance = new gtk_manager (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); +} + +graphics_toolkit +gtk_manager::do_get_toolkit (void) const +{ + graphics_toolkit retval; + + const_loaded_toolkits_iterator pl = loaded_toolkits.find (dtk); + + if (pl == loaded_toolkits.end ()) + { + const_available_toolkits_iterator pa = available_toolkits.find (dtk); + + if (pa != available_toolkits.end ()) + { + octave_value_list args; + args(0) = dtk; + feval ("graphics_toolkit", args); + + if (! error_state) + pl = loaded_toolkits.find (dtk); + + if (error_state || pl == loaded_toolkits.end ()) + error ("failed to load %s graphics toolkit", dtk.c_str ()); + else + retval = pl->second; + } + else + error ("default graphics toolkit '%s' is not available!", + dtk.c_str ()); + } + else + retval = pl->second; + + return retval; +} + +DEFUN (available_graphics_toolkits, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} available_graphics_toolkits ()\n\ +Return a cell array of registered graphics toolkits.\n\ +@seealso{graphics_toolkit, register_graphics_toolkit}\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + return octave_value (gtk_manager::available_toolkits_list ()); +} + +DEFUN (register_graphics_toolkit, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} register_graphics_toolkit (@var{toolkit})\n\ +List @var{toolkit} as an available graphics toolkit.\n\ +@seealso{available_graphics_toolkits}\n\ +@end deftypefn") +{ + octave_value retval; + + gh_manager::auto_lock guard; + + if (args.length () == 1) + { + std::string name = args(0).string_value (); + + if (! error_state) + gtk_manager::register_toolkit (name); + else + error ("register_graphics_toolkit: expecting character string"); + } + else + print_usage (); + + return retval; +} + +DEFUN (loaded_graphics_toolkits, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} loaded_graphics_toolkits ()\n\ +Return a cell array of the currently loaded graphics toolkits.\n\ +@seealso{available_graphics_toolkits}\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + return octave_value (gtk_manager::loaded_toolkits_list ()); +} + +DEFUN (drawnow, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} drawnow ()\n\ +@deftypefnx {Built-in Function} {} drawnow (\"expose\")\n\ +@deftypefnx {Built-in Function} {} drawnow (@var{term}, @var{file}, @var{mono}, @var{debug_file})\n\ +Update figure windows and their children. The event queue is flushed and\n\ +any callbacks generated are executed. With the optional argument\n\ +@code{\"expose\"}, only graphic objects are updated and no other events or\n\ +callbacks are processed.\n\ +The third calling form of @code{drawnow} is for debugging and is\n\ +undocumented.\n\ +@end deftypefn") +{ + static int drawnow_executing = 0; + + octave_value retval; + + gh_manager::lock (); + + unwind_protect frame; + frame.protect_var (Vdrawnow_requested, false); + + frame.protect_var (drawnow_executing); + + if (++drawnow_executing <= 1) + { + if (args.length () == 0 || args.length () == 1) + { + Matrix hlist = gh_manager::figure_handle_list (true); + + for (int i = 0; ! error_state && i < hlist.length (); i++) + { + graphics_handle h = gh_manager::lookup (hlist(i)); + + if (h.ok () && h != 0) + { + graphics_object go = gh_manager::get_object (h); + figure::properties& fprops = dynamic_cast (go.get_properties ()); + + if (fprops.is_modified ()) + { + if (fprops.is_visible ()) + { + gh_manager::unlock (); + + fprops.get_toolkit ().redraw_figure (go); + + gh_manager::lock (); + } + + fprops.set_modified (false); + } + } + } + + bool do_events = true; + + if (args.length () == 1) + { + caseless_str val (args(0).string_value ()); + + if (! error_state && val.compare ("expose")) + do_events = false; + else + { + error ("drawnow: invalid argument, expected 'expose' as argument"); + return retval; + } + } + + if (do_events) + { + gh_manager::unlock (); + + gh_manager::process_events (); + + gh_manager::lock (); + } + } + else if (args.length () >= 2 && args.length () <= 4) + { + std::string term, file, debug_file; + bool mono; + + term = args(0).string_value (); + + if (! error_state) + { + file = args(1).string_value (); + + if (! error_state) + { + size_t pos = file.find_first_not_of ("|"); + if (pos > 0) + file = file.substr (pos); + else + { + pos = file.find_last_of (file_ops::dir_sep_chars ()); + + if (pos != std::string::npos) + { + std::string dirname = file.substr (0, pos+1); + + file_stat fs (dirname); + + if (! (fs && fs.is_dir ())) + { + error ("drawnow: nonexistent directory '%s'", + dirname.c_str ()); + + return retval; + } + } + } + + mono = (args.length () >= 3 ? args(2).bool_value () : false); + + if (! error_state) + { + debug_file = (args.length () > 3 ? args(3).string_value () + : ""); + + if (! error_state) + { + graphics_handle h = gcf (); + + if (h.ok ()) + { + graphics_object go = gh_manager::get_object (h); + + gh_manager::unlock (); + + go.get_toolkit () + .print_figure (go, term, file, mono, debug_file); + + gh_manager::lock (); + } + else + error ("drawnow: nothing to draw"); + } + else + error ("drawnow: invalid DEBUG_FILE, expected a string value"); + } + else + error ("drawnow: invalid colormode MONO, expected a boolean value"); + } + else + error ("drawnow: invalid FILE, expected a string value"); + } + else + error ("drawnow: invalid terminal TERM, expected a string value"); + } + else + print_usage (); + } + + gh_manager::unlock (); + + return retval; +} + +DEFUN (addlistener, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} addlistener (@var{h}, @var{prop}, @var{fcn})\n\ +Register @var{fcn} as listener for the property @var{prop} of the graphics\n\ +object @var{h}. Property listeners are executed (in order of registration)\n\ +when the property is set. The new value is already available when the\n\ +listeners are executed.\n\ +\n\ +@var{prop} must be a string naming a valid property in @var{h}.\n\ +\n\ +@var{fcn} can be a function handle, a string or a cell array whose first\n\ +element is a function handle. If @var{fcn} is a function handle, the\n\ +corresponding function should accept at least 2 arguments, that will be\n\ +set to the object handle and the empty matrix respectively. If @var{fcn}\n\ +is a string, it must be any valid octave expression. If @var{fcn} is a cell\n\ +array, the first element must be a function handle with the same signature\n\ +as described above. The next elements of the cell array are passed\n\ +as additional arguments to the function.\n\ +\n\ +Example:\n\ +\n\ +@example\n\ +@group\n\ +function my_listener (h, dummy, p1)\n\ + fprintf (\"my_listener called with p1=%s\\n\", p1);\n\ +endfunction\n\ +\n\ +addlistener (gcf, \"position\", @{@@my_listener, \"my string\"@})\n\ +@end group\n\ +@end example\n\ +\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + if (args.length () >= 3 && args.length () <= 4) + { + double h = args(0).double_value (); + + if (! error_state) + { + std::string pname = args(1).string_value (); + + if (! error_state) + { + graphics_handle gh = gh_manager::lookup (h); + + if (gh.ok ()) + { + graphics_object go = gh_manager::get_object (gh); + + go.add_property_listener (pname, args(2), POSTSET); + + if (args.length () == 4) + { + caseless_str persistent = args(3).string_value (); + if (persistent.compare ("persistent")) + go.add_property_listener (pname, args(2), PERSISTENT); + } + } + else + error ("addlistener: invalid graphics object (= %g)", + h); + } + else + error ("addlistener: invalid property name, expected a string value"); + } + else + error ("addlistener: invalid handle"); + } + else + print_usage (); + + return retval; +} + +DEFUN (dellistener, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} dellistener (@var{h}, @var{prop}, @var{fcn})\n\ +Remove the registration of @var{fcn} as a listener for the property\n\ +@var{prop} of the graphics object @var{h}. The function @var{fcn} must\n\ +be the same variable (not just the same value), as was passed to the\n\ +original call to @code{addlistener}.\n\ +\n\ +If @var{fcn} is not defined then all listener functions of @var{prop}\n\ +are removed.\n\ +\n\ +Example:\n\ +\n\ +@example\n\ +@group\n\ +function my_listener (h, dummy, p1)\n\ + fprintf (\"my_listener called with p1=%s\\n\", p1);\n\ +endfunction\n\ +\n\ +c = @{@@my_listener, \"my string\"@};\n\ +addlistener (gcf, \"position\", c);\n\ +dellistener (gcf, \"position\", c);\n\ +@end group\n\ +@end example\n\ +\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + if (args.length () == 3 || args.length () == 2) + { + double h = args(0).double_value (); + + if (! error_state) + { + std::string pname = args(1).string_value (); + + if (! error_state) + { + graphics_handle gh = gh_manager::lookup (h); + + if (gh.ok ()) + { + graphics_object go = gh_manager::get_object (gh); + + if (args.length () == 2) + go.delete_property_listener (pname, octave_value (), POSTSET); + else + { + caseless_str persistent = args(2).string_value (); + if (persistent.compare ("persistent")) + { + go.delete_property_listener (pname, octave_value (), PERSISTENT); + go.delete_property_listener (pname, octave_value (), POSTSET); + } + else + go.delete_property_listener (pname, args(2), POSTSET); + } + } + else + error ("dellistener: invalid graphics object (= %g)", + h); + } + else + error ("dellistener: invalid property name, expected a string value"); + } + else + error ("dellistener: invalid handle"); + } + else + print_usage (); + + return retval; +} + +DEFUN (addproperty, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} addproperty (@var{name}, @var{h}, @var{type})\n\ +@deftypefnx {Built-in Function} {} addproperty (@var{name}, @var{h}, @var{type}, @var{arg}, @dots{})\n\ +Create a new property named @var{name} in graphics object @var{h}.\n\ +@var{type} determines the type of the property to create. @var{args}\n\ +usually contains the default value of the property, but additional\n\ +arguments might be given, depending on the type of the property.\n\ +\n\ +The supported property types are:\n\ +\n\ +@table @code\n\ +@item string\n\ +A string property. @var{arg} contains the default string value.\n\ +\n\ +@item any\n\ +An @nospell{un-typed} property. This kind of property can hold any octave\n\ +value. @var{args} contains the default value.\n\ +\n\ +@item radio\n\ +A string property with a limited set of accepted values. The first\n\ +argument must be a string with all accepted values separated by\n\ +a vertical bar ('|'). The default value can be marked by enclosing\n\ +it with a '@{' '@}' pair. The default value may also be given as\n\ +an optional second string argument.\n\ +\n\ +@item boolean\n\ +A boolean property. This property type is equivalent to a radio\n\ +property with \"on|off\" as accepted values. @var{arg} contains\n\ +the default property value.\n\ +\n\ +@item double\n\ +A scalar double property. @var{arg} contains the default value.\n\ +\n\ +@item handle\n\ +A handle property. This kind of property holds the handle of a\n\ +graphics object. @var{arg} contains the default handle value.\n\ +When no default value is given, the property is initialized to\n\ +the empty matrix.\n\ +\n\ +@item data\n\ +A data (matrix) property. @var{arg} contains the default data\n\ +value. When no default value is given, the data is initialized to\n\ +the empty matrix.\n\ +\n\ +@item color\n\ +A color property. @var{arg} contains the default color value.\n\ +When no default color is given, the property is set to black.\n\ +An optional second string argument may be given to specify an\n\ +additional set of accepted string values (like a radio property).\n\ +@end table\n\ +\n\ +@var{type} may also be the concatenation of a core object type and\n\ +a valid property name for that object type. The property created\n\ +then has the same characteristics as the referenced property (type,\n\ +possible values, hidden state@dots{}). This allows to clone an existing\n\ +property into the graphics object @var{h}.\n\ +\n\ +Examples:\n\ +\n\ +@example\n\ +@group\n\ +addproperty (\"my_property\", gcf, \"string\", \"a string value\");\n\ +addproperty (\"my_radio\", gcf, \"radio\", \"val_1|val_2|@{val_3@}\");\n\ +addproperty (\"my_style\", gcf, \"linelinestyle\", \"--\");\n\ +@end group\n\ +@end example\n\ +\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + if (args.length () >= 3) + { + std::string name = args(0).string_value (); + + if (! error_state) + { + double h = args(1).double_value (); + + if (! error_state) + { + graphics_handle gh = gh_manager::lookup (h); + + if (gh.ok ()) + { + graphics_object go = gh_manager::get_object (gh); + + std::string type = args(2).string_value (); + + if (! error_state) + { + if (! go.get_properties ().has_property (name)) + { + property p = property::create (name, gh, type, + args.splice (0, 3)); + + if (! error_state) + go.get_properties ().insert_property (name, p); + } + else + error ("addproperty: a '%s' property already exists in the graphics object", + name.c_str ()); + } + else + error ("addproperty: invalid property TYPE, expected a string value"); + } + else + error ("addproperty: invalid graphics object (= %g)", h); + } + else + error ("addproperty: invalid handle value"); + } + else + error ("addproperty: invalid property NAME, expected a string value"); + } + else + print_usage (); + + return retval; +} + +octave_value +get_property_from_handle (double handle, const std::string& property, + const std::string& func) +{ + gh_manager::auto_lock guard; + + graphics_object obj = gh_manager::get_object (handle); + octave_value retval; + + if (obj) + retval = obj.get (caseless_str (property)); + else + error ("%s: invalid handle (= %g)", func.c_str (), handle); + + return retval; +} + +bool +set_property_in_handle (double handle, const std::string& property, + const octave_value& arg, const std::string& func) +{ + gh_manager::auto_lock guard; + + graphics_object obj = gh_manager::get_object (handle); + int ret = false; + + if (obj) + { + obj.set (caseless_str (property), arg); + + if (! error_state) + ret = true; + } + else + error ("%s: invalid handle (= %g)", func.c_str (), handle); + + return ret; +} + +static bool +compare_property_values (const octave_value& o1, const octave_value& o2) +{ + octave_value_list args (2); + + args(0) = o1; + args(1) = o2; + + octave_value_list result = feval ("isequal", args, 1); + + if (! error_state && result.length () > 0) + return result(0).bool_value (); + + return false; +} + +static std::map waitfor_results; + +static void +cleanup_waitfor_id (uint32_t id) +{ + waitfor_results.erase (id); +} + +static void +do_cleanup_waitfor_listener (const octave_value& listener, + listener_mode mode = POSTSET) +{ + Cell c = listener.cell_value (); + + if (c.numel () >= 4) + { + double h = c(2).double_value (); + + if (! error_state) + { + caseless_str pname = c(3).string_value (); + + if (! error_state) + { + gh_manager::auto_lock guard; + + graphics_handle handle = gh_manager::lookup (h); + + if (handle.ok ()) + { + graphics_object go = gh_manager::get_object (handle); + + if (go.get_properties ().has_property (pname)) + { + go.get_properties () + .delete_listener (pname, listener, mode); + if (mode == POSTSET) + go.get_properties () + .delete_listener (pname, listener, PERSISTENT); + } + } + } + } + } +} + +static void +cleanup_waitfor_postset_listener (const octave_value& listener) +{ do_cleanup_waitfor_listener (listener, POSTSET); } + +static void +cleanup_waitfor_predelete_listener (const octave_value& listener) +{ do_cleanup_waitfor_listener (listener, PREDELETE); } + +static octave_value_list +waitfor_listener (const octave_value_list& args, int) +{ + if (args.length () > 3) + { + uint32_t id = args(2).uint32_scalar_value ().value (); + + if (! error_state) + { + if (args.length () > 5) + { + double h = args(0).double_value (); + + if (! error_state) + { + caseless_str pname = args(4).string_value (); + + if (! error_state) + { + gh_manager::auto_lock guard; + + graphics_handle handle = gh_manager::lookup (h); + + if (handle.ok ()) + { + graphics_object go = gh_manager::get_object (handle); + octave_value pvalue = go.get (pname); + + if (compare_property_values (pvalue, args(5))) + waitfor_results[id] = true; + } + } + } + } + else + waitfor_results[id] = true; + } + } + + return octave_value_list (); +} + +static octave_value_list +waitfor_del_listener (const octave_value_list& args, int) +{ + if (args.length () > 2) + { + uint32_t id = args(2).uint32_scalar_value ().value (); + + if (! error_state) + waitfor_results[id] = true; + } + + return octave_value_list (); +} + +DEFUN (waitfor, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} waitfor (@var{h})\n\ +@deftypefnx {Built-in Function} {} waitfor (@var{h}, @var{prop})\n\ +@deftypefnx {Built-in Function} {} waitfor (@var{h}, @var{prop}, @var{value})\n\ +@deftypefnx {Built-in Function} {} waitfor (@dots{}, \"timeout\", @var{timeout})\n\ +Suspend the execution of the current program until a condition is\n\ +satisfied on the graphics handle @var{h}. While the program is suspended\n\ +graphics events are still being processed normally, allowing callbacks to\n\ +modify the state of graphics objects. This function is reentrant and can be\n\ +called from a callback, while another @code{waitfor} call is pending at\n\ +top-level.\n\ +\n\ +In the first form, program execution is suspended until the graphics object\n\ +@var{h} is destroyed. If the graphics handle is invalid, the function\n\ +returns immediately.\n\ +\n\ +In the second form, execution is suspended until the graphics object is\n\ +destroyed or the property named @var{prop} is modified. If the graphics\n\ +handle is invalid or the property does not exist, the function returns\n\ +immediately.\n\ +\n\ +In the third form, execution is suspended until the graphics object is\n\ +destroyed or the property named @var{prop} is set to @var{value}. The\n\ +function @code{isequal} is used to compare property values. If the graphics\n\ +handle is invalid, the property does not exist or the property is already\n\ +set to @var{value}, the function returns immediately.\n\ +\n\ +An optional timeout can be specified using the property @code{timeout}.\n\ +This timeout value is the number of seconds to wait for the condition to be\n\ +true. @var{timeout} must be at least 1. If a smaller value is specified, a\n\ +warning is issued and a value of 1 is used instead. If the timeout value is\n\ +not an integer, it is truncated towards 0.\n\ +\n\ +To define a condition on a property named @code{timeout}, use the string\n\ +@code{\\timeout} instead.\n\ +\n\ +In all cases, typing CTRL-C stops program execution immediately.\n\ +@seealso{isequal}\n\ +@end deftypefn") +{ + if (args.length () > 0) + { + double h = args(0).double_value (); + + if (! error_state) + { + caseless_str pname; + + unwind_protect frame; + + static uint32_t id_counter = 0; + uint32_t id = 0; + + int max_arg_index = 0; + int timeout_index = -1; + + int timeout = 0; + + if (args.length () > 1) + { + pname = args(1).string_value (); + if (! error_state + && ! pname.empty () + && ! pname.compare ("timeout")) + { + if (pname.compare ("\\timeout")) + pname = "timeout"; + + static octave_value wf_listener; + + if (! wf_listener.is_defined ()) + wf_listener = + octave_value (new octave_builtin (waitfor_listener, + "waitfor_listener")); + + max_arg_index++; + if (args.length () > 2) + { + if (args(2).is_string ()) + { + caseless_str s = args(2).string_value (); + + if (! error_state) + { + if (s.compare ("timeout")) + timeout_index = 2; + else + max_arg_index++; + } + } + else + max_arg_index++; + } + + Cell listener (1, max_arg_index >= 2 ? 5 : 4); + + id = id_counter++; + frame.add_fcn (cleanup_waitfor_id, id); + waitfor_results[id] = false; + + listener(0) = wf_listener; + listener(1) = octave_uint32 (id); + listener(2) = h; + listener(3) = pname; + + if (max_arg_index >= 2) + listener(4) = args(2); + + octave_value ov_listener (listener); + + gh_manager::auto_lock guard; + + graphics_handle handle = gh_manager::lookup (h); + + if (handle.ok ()) + { + graphics_object go = gh_manager::get_object (handle); + + if (max_arg_index >= 2 + && compare_property_values (go.get (pname), + args(2))) + waitfor_results[id] = true; + else + { + + frame.add_fcn (cleanup_waitfor_postset_listener, + ov_listener); + go.add_property_listener (pname, ov_listener, + POSTSET); + go.add_property_listener (pname, ov_listener, + PERSISTENT); + + if (go.get_properties () + .has_dynamic_property (pname)) + { + static octave_value wf_del_listener; + + if (! wf_del_listener.is_defined ()) + wf_del_listener = + octave_value (new octave_builtin + (waitfor_del_listener, + "waitfor_del_listener")); + + Cell del_listener (1, 4); + + del_listener(0) = wf_del_listener; + del_listener(1) = octave_uint32 (id); + del_listener(2) = h; + del_listener(3) = pname; + + octave_value ov_del_listener (del_listener); + + frame.add_fcn (cleanup_waitfor_predelete_listener, + ov_del_listener); + go.add_property_listener (pname, ov_del_listener, + PREDELETE); + } + } + } + } + else if (error_state || pname.empty ()) + error ("waitfor: invalid property name, expected a non-empty string value"); + } + + if (! error_state + && timeout_index < 0 + && args.length () > (max_arg_index + 1)) + { + caseless_str s = args(max_arg_index + 1).string_value (); + + if (! error_state) + { + if (s.compare ("timeout")) + timeout_index = max_arg_index + 1; + else + error ("waitfor: invalid parameter '%s'", s.c_str ()); + } + else + error ("waitfor: invalid parameter, expected 'timeout'"); + } + + if (! error_state && timeout_index >= 0) + { + if (args.length () > (timeout_index + 1)) + { + timeout = static_cast + (args(timeout_index + 1).scalar_value ()); + + if (! error_state) + { + if (timeout < 1) + { + warning ("waitfor: the timeout value must be >= 1, using 1 instead"); + timeout = 1; + } + } + else + error ("waitfor: invalid timeout value, expected a value >= 1"); + } + else + error ("waitfor: missing timeout value"); + } + + // FIXME: There is still a "hole" in the following loop. The code + // assumes that an object handle is unique, which is a fair + // assumptions, except for figures. If a figure is destroyed + // then recreated with the same figure ID, within the same + // run of event hooks, then the figure destruction won't be + // caught and the loop will not stop. This is an unlikely + // possibility in practice, though. + // + // Using deletefcn callback is also unreliable as it could be + // modified during a callback execution and the waitfor loop + // would not stop. + // + // The only "good" implementation would require object + // listeners, similar to property listeners. + + time_t start = 0; + + if (timeout > 0) + start = time (0); + + while (! error_state) + { + if (true) + { + gh_manager::auto_lock guard; + + graphics_handle handle = gh_manager::lookup (h); + + if (handle.ok ()) + { + if (! pname.empty () && waitfor_results[id]) + break; + } + else + break; + } + + octave_usleep (100000); + + OCTAVE_QUIT; + + command_editor::run_event_hooks (); + + if (timeout > 0) + { + if (start + timeout < time (0)) + break; + } + } + } + else + error ("waitfor: invalid handle value."); + } + else + print_usage (); + + return octave_value (); +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/graphics.in.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/graphics.in.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,5862 @@ +/* + +Copyright (C) 2007-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (graphics_h) +#define graphics_h 1 + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include +#include +#include +#include +#include +#include + +#include "caseless-str.h" +#include "lo-ieee.h" + +#include "gripes.h" +#include "oct-map.h" +#include "oct-mutex.h" +#include "oct-refcount.h" +#include "ov.h" +#include "txt-eng-ft.h" + +// FIXME -- maybe this should be a configure option? +// Matlab defaults to "Helvetica", but that causes problems for many +// gnuplot users. +#if !defined (OCTAVE_DEFAULT_FONTNAME) +#define OCTAVE_DEFAULT_FONTNAME "*" +#endif + +// --------------------------------------------------------------------- + +class graphics_handle +{ +public: + graphics_handle (void) : val (octave_NaN) { } + + graphics_handle (const octave_value& a); + + graphics_handle (int a) : val (a) { } + + graphics_handle (double a) : val (a) { } + + graphics_handle (const graphics_handle& a) : val (a.val) { } + + graphics_handle& operator = (const graphics_handle& a) + { + if (&a != this) + val = a.val; + + return *this; + } + + ~graphics_handle (void) { } + + double value (void) const { return val; } + + octave_value as_octave_value (void) const + { + return ok () ? octave_value (val) : octave_value (Matrix ()); + } + + // Prefix increment/decrement operators. + graphics_handle& operator ++ (void) + { + ++val; + return *this; + } + + graphics_handle& operator -- (void) + { + --val; + return *this; + } + + // Postfix increment/decrement operators. + const graphics_handle operator ++ (int) + { + graphics_handle old_value = *this; + ++(*this); + return old_value; + } + + const graphics_handle operator -- (int) + { + graphics_handle old_value = *this; + --(*this); + return old_value; + } + + bool ok (void) const { return ! xisnan (val); } + +private: + double val; +}; + +inline bool +operator == (const graphics_handle& a, const graphics_handle& b) +{ + return a.value () == b.value (); +} + +inline bool +operator != (const graphics_handle& a, const graphics_handle& b) +{ + return a.value () != b.value (); +} + +inline bool +operator < (const graphics_handle& a, const graphics_handle& b) +{ + return a.value () < b.value (); +} + +inline bool +operator <= (const graphics_handle& a, const graphics_handle& b) +{ + return a.value () <= b.value (); +} + +inline bool +operator >= (const graphics_handle& a, const graphics_handle& b) +{ + return a.value () >= b.value (); +} + +inline bool +operator > (const graphics_handle& a, const graphics_handle& b) +{ + return a.value () > b.value (); +} + +// --------------------------------------------------------------------- + +class base_scaler +{ +public: + base_scaler (void) { } + + virtual ~base_scaler (void) { } + + virtual Matrix scale (const Matrix& m) const + { + error ("invalid axis scale"); + return m; + } + + virtual NDArray scale (const NDArray& m) const + { + error ("invalid axis scale"); + return m; + } + + virtual double scale (double d) const + { + error ("invalid axis scale"); + return d; + } + + virtual double unscale (double d) const + { + error ("invalid axis scale"); + return d; + } + + virtual base_scaler* clone () const + { return new base_scaler (); } + + virtual bool is_linear (void) const + { return false; } +}; + +class lin_scaler : public base_scaler +{ +public: + lin_scaler (void) { } + + Matrix scale (const Matrix& m) const { return m; } + + NDArray scale (const NDArray& m) const { return m; } + + double scale (double d) const { return d; } + + double unscale (double d) const { return d; } + + base_scaler* clone (void) const { return new lin_scaler (); } + + bool is_linear (void) const { return true; } +}; + +class log_scaler : public base_scaler +{ +public: + log_scaler (void) { } + + Matrix scale (const Matrix& m) const + { + Matrix retval (m.rows (), m.cols ()); + + do_scale (m.data (), retval.fortran_vec (), m.numel ()); + + return retval; + } + + NDArray scale (const NDArray& m) const + { + NDArray retval (m.dims ()); + + do_scale (m.data (), retval.fortran_vec (), m.numel ()); + + return retval; + } + + double scale (double d) const + { return log10 (d); } + + double unscale (double d) const + { return pow (10.0, d); } + + base_scaler* clone (void) const + { return new log_scaler (); } + +private: + void do_scale (const double *src, double *dest, int n) const + { + for (int i = 0; i < n; i++) + dest[i] = log10 (src[i]); + } +}; + +class neg_log_scaler : public base_scaler +{ +public: + neg_log_scaler (void) { } + + Matrix scale (const Matrix& m) const + { + Matrix retval (m.rows (), m.cols ()); + + do_scale (m.data (), retval.fortran_vec (), m.numel ()); + + return retval; + } + + NDArray scale (const NDArray& m) const + { + NDArray retval (m.dims ()); + + do_scale (m.data (), retval.fortran_vec (), m.numel ()); + + return retval; + } + + double scale (double d) const + { return -log10 (-d); } + + double unscale (double d) const + { return -pow (10.0, -d); } + + base_scaler* clone (void) const + { return new neg_log_scaler (); } + +private: + void do_scale (const double *src, double *dest, int n) const + { + for (int i = 0; i < n; i++) + dest[i] = -log10 (-src[i]); + } +}; + +class scaler +{ +public: + scaler (void) : rep (new base_scaler ()) { } + + scaler (const scaler& s) : rep (s.rep->clone ()) { } + + scaler (const std::string& s) + : rep (s == "log" + ? new log_scaler () + : (s == "neglog" ? new neg_log_scaler () + : (s == "linear" ? new lin_scaler () : new base_scaler ()))) + { } + + ~scaler (void) { delete rep; } + + Matrix scale (const Matrix& m) const + { return rep->scale (m); } + + NDArray scale (const NDArray& m) const + { return rep->scale (m); } + + double scale (double d) const + { return rep->scale (d); } + + double unscale (double d) const + { return rep->unscale (d); } + + bool is_linear (void) const + { return rep->is_linear (); } + + scaler& operator = (const scaler& s) + { + if (rep) + { + delete rep; + rep = 0; + } + + rep = s.rep->clone (); + + return *this; + } + + scaler& operator = (const std::string& s) + { + if (rep) + { + delete rep; + rep = 0; + } + + if (s == "log") + rep = new log_scaler (); + else if (s == "neglog") + rep = new neg_log_scaler (); + else if (s == "linear") + rep = new lin_scaler (); + else + rep = new base_scaler (); + + return *this; + } + +private: + base_scaler *rep; +}; + +// --------------------------------------------------------------------- + +class property; + +enum listener_mode { POSTSET, PERSISTENT, PREDELETE }; + +class base_property +{ +public: + friend class property; + +public: + base_property (void) + : id (-1), count (1), name (), parent (), hidden (), listeners () + { } + + base_property (const std::string& s, const graphics_handle& h) + : id (-1), count (1), name (s), parent (h), hidden (false), listeners () + { } + + base_property (const base_property& p) + : id (-1), count (1), name (p.name), parent (p.parent), + hidden (p.hidden), listeners () + { } + + virtual ~base_property (void) { } + + bool ok (void) const { return parent.ok (); } + + std::string get_name (void) const { return name; } + + void set_name (const std::string& s) { name = s; } + + graphics_handle get_parent (void) const { return parent; } + + void set_parent (const graphics_handle &h) { parent = h; } + + bool is_hidden (void) const { return hidden; } + + void set_hidden (bool flag) { hidden = flag; } + + virtual bool is_radio (void) const { return false; } + + int get_id (void) const { return id; } + + void set_id (int d) { id = d; } + + // Sets property value, notifies graphics toolkit. + // If do_run is true, runs associated listeners. + OCTINTERP_API bool set (const octave_value& v, bool do_run = true, + bool do_notify_toolkit = true); + + virtual octave_value get (void) const + { + error ("get: invalid property \"%s\"", name.c_str ()); + return octave_value (); + } + + + virtual std::string values_as_string (void) const + { + error ("values_as_string: invalid property \"%s\"", name.c_str ()); + return std::string (); + } + + virtual Cell values_as_cell (void) const + { + error ("values_as_cell: invalid property \"%s\"", name.c_str ()); + return Cell (); + } + + base_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + void add_listener (const octave_value& v, listener_mode mode = POSTSET) + { + octave_value_list& l = listeners[mode]; + l.resize (l.length () + 1, v); + } + + void delete_listener (const octave_value& v = octave_value (), + listener_mode mode = POSTSET) + { + octave_value_list& l = listeners[mode]; + + if (v.is_defined ()) + { + bool found = false; + int i; + + for (i = 0; i < l.length (); i++) + { + if (v.internal_rep () == l(i).internal_rep ()) + { + found = true; + break; + } + } + if (found) + { + for (int j = i; j < l.length () - 1; j++) + l(j) = l(j + 1); + + l.resize (l.length () - 1); + } + } + else + { + if (mode == PERSISTENT) + l.resize (0); + else + { + octave_value_list lnew (0); + octave_value_list& lp = listeners[PERSISTENT]; + for (int i = l.length () - 1; i >= 0 ; i--) + { + for (int j = 0; j < lp.length (); j++) + { + if (l(i).internal_rep () == lp(j).internal_rep ()) + { + lnew.resize (lnew.length () + 1, l(i)); + break; + } + } + } + l = lnew; + } + } + + } + + OCTINTERP_API void run_listeners (listener_mode mode = POSTSET); + + virtual base_property* clone (void) const + { return new base_property (*this); } + +protected: + virtual bool do_set (const octave_value&) + { + error ("set: invalid property \"%s\"", name.c_str ()); + return false; + } + +private: + typedef std::map listener_map; + typedef std::map::iterator listener_map_iterator; + typedef std::map::const_iterator listener_map_const_iterator; + +private: + int id; + octave_refcount count; + std::string name; + graphics_handle parent; + bool hidden; + listener_map listeners; +}; + +// --------------------------------------------------------------------- + +class string_property : public base_property +{ +public: + string_property (const std::string& s, const graphics_handle& h, + const std::string& val = "") + : base_property (s, h), str (val) { } + + string_property (const string_property& p) + : base_property (p), str (p.str) { } + + octave_value get (void) const + { return octave_value (str); } + + std::string string_value (void) const { return str; } + + string_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new string_property (*this); } + +protected: + bool do_set (const octave_value& val) + { + if (val.is_string ()) + { + std::string new_str = val.string_value (); + + if (new_str != str) + { + str = new_str; + return true; + } + } + else + error ("set: invalid string property value for \"%s\"", + get_name ().c_str ()); + return false; + } + +private: + std::string str; +}; + +// --------------------------------------------------------------------- + +class string_array_property : public base_property +{ +public: + enum desired_enum { string_t, cell_t }; + + string_array_property (const std::string& s, const graphics_handle& h, + const std::string& val = "", const char& sep = '|', + const desired_enum& typ = string_t) + : base_property (s, h), desired_type (typ), separator (sep), str () + { + size_t pos = 0; + + while (true) + { + size_t new_pos = val.find_first_of (separator, pos); + + if (new_pos == std::string::npos) + { + str.append (val.substr (pos)); + break; + } + else + str.append (val.substr (pos, new_pos - pos)); + + pos = new_pos + 1; + } + } + + string_array_property (const std::string& s, const graphics_handle& h, + const Cell& c, const char& sep = '|', + const desired_enum& typ = string_t) + : base_property (s, h), desired_type (typ), separator (sep), str () + { + if (c.is_cellstr ()) + { + string_vector strings (c.numel ()); + + for (octave_idx_type i = 0; i < c.numel (); i++) + strings[i] = c(i).string_value (); + + str = strings; + } + else + error ("set: invalid order property value for \"%s\"", + get_name ().c_str ()); + } + + string_array_property (const string_array_property& p) + : base_property (p), desired_type (p.desired_type), + separator (p.separator), str (p.str) { } + + octave_value get (void) const + { + if (desired_type == string_t) + return octave_value (string_value ()); + else + return octave_value (cell_value ()); + } + + std::string string_value (void) const + { + std::string s; + + for (octave_idx_type i = 0; i < str.length (); i++) + { + s += str[i]; + if (i != str.length () - 1) + s += separator; + } + + return s; + } + + Cell cell_value (void) const {return Cell (str);} + + string_vector string_vector_value (void) const { return str; } + + string_array_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new string_array_property (*this); } + +protected: + bool do_set (const octave_value& val) + { + if (val.is_string () && val.rows () == 1) + { + bool replace = false; + std::string new_str = val.string_value (); + string_vector strings; + size_t pos = 0; + + // Split single string on delimiter (usually '|') + while (pos != std::string::npos) + { + size_t new_pos = new_str.find_first_of (separator, pos); + + if (new_pos == std::string::npos) + { + strings.append (new_str.substr (pos)); + break; + } + else + strings.append (new_str.substr (pos, new_pos - pos)); + + pos = new_pos + 1; + } + + if (str.numel () == strings.numel ()) + { + for (octave_idx_type i = 0; i < str.numel (); i++) + if (strings[i] != str[i]) + { + replace = true; + break; + } + } + else + replace = true; + + desired_type = string_t; + + if (replace) + { + str = strings; + return true; + } + } + else if (val.is_string ()) // multi-row character matrix + { + bool replace = false; + charMatrix chm = val.char_matrix_value (); + octave_idx_type nel = chm.rows (); + string_vector strings (nel); + + if (nel != str.numel ()) + replace = true; + for (octave_idx_type i = 0; i < nel; i++) + { + strings[i] = chm.row_as_string (i); + if (!replace && strings[i] != str[i]) + replace = true; + } + + desired_type = string_t; + + if (replace) + { + str = strings; + return true; + } + } + else if (val.is_cellstr ()) + { + bool replace = false; + Cell new_cell = val.cell_value (); + + string_vector strings = new_cell.cellstr_value (); + + octave_idx_type nel = strings.length (); + + if (nel != str.length ()) + replace = true; + else + { + for (octave_idx_type i = 0; i < nel; i++) + { + if (strings[i] != str[i]) + { + replace = true; + break; + } + } + } + + desired_type = cell_t; + + if (replace) + { + str = strings; + return true; + } + } + else + error ("set: invalid string property value for \"%s\"", + get_name ().c_str ()); + return false; + } + +private: + desired_enum desired_type; + char separator; + string_vector str; +}; + +// --------------------------------------------------------------------- + +class text_label_property : public base_property +{ +public: + enum type { char_t, cellstr_t }; + + text_label_property (const std::string& s, const graphics_handle& h, + const std::string& val = "") + : base_property (s, h), value (val), stored_type (char_t) + { } + + text_label_property (const std::string& s, const graphics_handle& h, + const NDArray& nda) + : base_property (s, h), stored_type (char_t) + { + octave_idx_type nel = nda.numel (); + + value.resize (nel); + + for (octave_idx_type i = 0; i < nel; i++) + { + std::ostringstream buf; + buf << nda(i); + value[i] = buf.str (); + } + } + + text_label_property (const std::string& s, const graphics_handle& h, + const Cell& c) + : base_property (s, h), stored_type (cellstr_t) + { + octave_idx_type nel = c.numel (); + + value.resize (nel); + + for (octave_idx_type i = 0; i < nel; i++) + { + octave_value tmp = c(i); + + if (tmp.is_string ()) + value[i] = c(i).string_value (); + else + { + double d = c(i).double_value (); + + if (! error_state) + { + std::ostringstream buf; + buf << d; + value[i] = buf.str (); + } + else + break; + } + } + } + + text_label_property (const text_label_property& p) + : base_property (p), value (p.value), stored_type (p.stored_type) + { } + + bool empty (void) const + { + octave_value tmp = get (); + return tmp.is_empty (); + } + + octave_value get (void) const + { + if (stored_type == char_t) + return octave_value (char_value ()); + else + return octave_value (cell_value ()); + } + + std::string string_value (void) const + { + return value.empty () ? std::string () : value[0]; + } + + string_vector string_vector_value (void) const { return value; } + + charMatrix char_value (void) const { return charMatrix (value, ' '); } + + Cell cell_value (void) const {return Cell (value); } + + text_label_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new text_label_property (*this); } + +protected: + + bool do_set (const octave_value& val) + { + if (val.is_string ()) + { + value = val.all_strings (); + + stored_type = char_t; + } + else if (val.is_cell ()) + { + Cell c = val.cell_value (); + + octave_idx_type nel = c.numel (); + + value.resize (nel); + + for (octave_idx_type i = 0; i < nel; i++) + { + octave_value tmp = c(i); + + if (tmp.is_string ()) + value[i] = c(i).string_value (); + else + { + double d = c(i).double_value (); + + if (! error_state) + { + std::ostringstream buf; + buf << d; + value[i] = buf.str (); + } + else + return false; + } + } + + stored_type = cellstr_t; + } + else + { + NDArray nda = val.array_value (); + + if (! error_state) + { + octave_idx_type nel = nda.numel (); + + value.resize (nel); + + for (octave_idx_type i = 0; i < nel; i++) + { + std::ostringstream buf; + buf << nda(i); + value[i] = buf.str (); + } + + stored_type = char_t; + } + else + { + error ("set: invalid string property value for \"%s\"", + get_name ().c_str ()); + + return false; + } + } + + return true; + } + +private: + string_vector value; + type stored_type; +}; + +// --------------------------------------------------------------------- + +class radio_values +{ +public: + OCTINTERP_API radio_values (const std::string& opt_string = std::string ()); + + radio_values (const radio_values& a) + : default_val (a.default_val), possible_vals (a.possible_vals) { } + + radio_values& operator = (const radio_values& a) + { + if (&a != this) + { + default_val = a.default_val; + possible_vals = a.possible_vals; + } + + return *this; + } + + std::string default_value (void) const { return default_val; } + + bool validate (const std::string& val, std::string& match) + { + bool retval = true; + + if (! contains (val, match)) + { + error ("invalid value = %s", val.c_str ()); + retval = false; + } + + return retval; + } + + bool contains (const std::string& val, std::string& match) + { + size_t k = 0; + + size_t len = val.length (); + + std::string first_match; + + for (std::set::const_iterator p = possible_vals.begin (); + p != possible_vals.end (); p++) + { + if (p->compare (val, len)) + { + if (len == p->length ()) + { + // We found a full match (consider the case of val == + // "replace" with possible values "replace" and + // "replacechildren"). Any other matches are + // irrelevant, so set match and return now. + + match = *p; + return true; + } + else + { + if (k == 0) + first_match = *p; + + k++; + } + } + } + + if (k == 1) + { + match = first_match; + return true; + } + else + return false; + } + + std::string values_as_string (void) const; + + Cell values_as_cell (void) const; + + octave_idx_type nelem (void) const { return possible_vals.size (); } + +private: + // Might also want to cache + std::string default_val; + std::set possible_vals; +}; + +class radio_property : public base_property +{ +public: + radio_property (const std::string& nm, const graphics_handle& h, + const radio_values& v = radio_values ()) + : base_property (nm, h), + vals (v), current_val (v.default_value ()) { } + + radio_property (const std::string& nm, const graphics_handle& h, + const std::string& v) + : base_property (nm, h), + vals (v), current_val (vals.default_value ()) { } + + radio_property (const std::string& nm, const graphics_handle& h, + const radio_values& v, const std::string& def) + : base_property (nm, h), + vals (v), current_val (def) { } + + radio_property (const radio_property& p) + : base_property (p), vals (p.vals), current_val (p.current_val) { } + + octave_value get (void) const { return octave_value (current_val); } + + const std::string& current_value (void) const { return current_val; } + + std::string values_as_string (void) const { return vals.values_as_string (); } + + Cell values_as_cell (void) const { return vals.values_as_cell (); } + + bool is (const caseless_str& v) const + { return v.compare (current_val); } + + bool is_radio (void) const { return true; } + + radio_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new radio_property (*this); } + +protected: + bool do_set (const octave_value& newval) + { + if (newval.is_string ()) + { + std::string s = newval.string_value (); + + std::string match; + + if (vals.validate (s, match)) + { + if (match != current_val) + { + if (s.length () != match.length ()) + warning_with_id ("Octave:abbreviated-property-match", + "%s: allowing %s to match %s value %s", + "set", s.c_str (), get_name ().c_str (), + match.c_str ()); + current_val = match; + return true; + } + } + else + error ("set: invalid value for radio property \"%s\" (value = %s)", + get_name ().c_str (), s.c_str ()); + } + else + error ("set: invalid value for radio property \"%s\"", + get_name ().c_str ()); + return false; + } + +private: + radio_values vals; + std::string current_val; +}; + +// --------------------------------------------------------------------- + +class color_values +{ +public: + color_values (double r = 0, double g = 0, double b = 1) + : xrgb (1, 3) + { + xrgb(0) = r; + xrgb(1) = g; + xrgb(2) = b; + + validate (); + } + + color_values (std::string str) + : xrgb (1, 3) + { + if (! str2rgb (str)) + error ("invalid color specification: %s", str.c_str ()); + } + + color_values (const color_values& c) + : xrgb (c.xrgb) + { } + + color_values& operator = (const color_values& c) + { + if (&c != this) + xrgb = c.xrgb; + + return *this; + } + + bool operator == (const color_values& c) const + { + return (xrgb(0) == c.xrgb(0) + && xrgb(1) == c.xrgb(1) + && xrgb(2) == c.xrgb(2)); + } + + bool operator != (const color_values& c) const + { return ! (*this == c); } + + Matrix rgb (void) const { return xrgb; } + + operator octave_value (void) const { return xrgb; } + + void validate (void) const + { + for (int i = 0; i < 3; i++) + { + if (xrgb(i) < 0 || xrgb(i) > 1) + { + error ("invalid RGB color specification"); + break; + } + } + } + +private: + Matrix xrgb; + + OCTINTERP_API bool str2rgb (std::string str); +}; + +class color_property : public base_property +{ +public: + color_property (const color_values& c, const radio_values& v) + : base_property ("", graphics_handle ()), + current_type (color_t), color_val (c), radio_val (v), + current_val (v.default_value ()) + { } + + color_property (const std::string& nm, const graphics_handle& h, + const color_values& c = color_values (), + const radio_values& v = radio_values ()) + : base_property (nm, h), + current_type (color_t), color_val (c), radio_val (v), + current_val (v.default_value ()) + { } + + color_property (const std::string& nm, const graphics_handle& h, + const radio_values& v) + : base_property (nm, h), + current_type (radio_t), color_val (color_values ()), radio_val (v), + current_val (v.default_value ()) + { } + + color_property (const std::string& nm, const graphics_handle& h, + const std::string& v) + : base_property (nm, h), + current_type (radio_t), color_val (color_values ()), radio_val (v), + current_val (radio_val.default_value ()) + { } + + color_property (const std::string& nm, const graphics_handle& h, + const color_property& v) + : base_property (nm, h), + current_type (v.current_type), color_val (v.color_val), + radio_val (v.radio_val), current_val (v.current_val) + { } + + color_property (const color_property& p) + : base_property (p), current_type (p.current_type), + color_val (p.color_val), radio_val (p.radio_val), + current_val (p.current_val) { } + + octave_value get (void) const + { + if (current_type == color_t) + return color_val.rgb (); + + return current_val; + } + + bool is_rgb (void) const { return (current_type == color_t); } + + bool is_radio (void) const { return (current_type == radio_t); } + + bool is (const std::string& v) const + { return (is_radio () && current_val == v); } + + Matrix rgb (void) const + { + if (current_type != color_t) + error ("color has no rgb value"); + + return color_val.rgb (); + } + + const std::string& current_value (void) const + { + if (current_type != radio_t) + error ("color has no radio value"); + + return current_val; + } + + color_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + operator octave_value (void) const { return get (); } + + base_property* clone (void) const { return new color_property (*this); } + + std::string values_as_string (void) const { return radio_val.values_as_string (); } + + Cell values_as_cell (void) const { return radio_val.values_as_cell (); } + +protected: + OCTINTERP_API bool do_set (const octave_value& newval); + +private: + enum current_enum { color_t, radio_t } current_type; + color_values color_val; + radio_values radio_val; + std::string current_val; +}; + +// --------------------------------------------------------------------- + +class double_property : public base_property +{ +public: + double_property (const std::string& nm, const graphics_handle& h, + double d = 0) + : base_property (nm, h), + current_val (d) { } + + double_property (const double_property& p) + : base_property (p), current_val (p.current_val) { } + + octave_value get (void) const { return octave_value (current_val); } + + double double_value (void) const { return current_val; } + + double_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new double_property (*this); } + +protected: + bool do_set (const octave_value& v) + { + if (v.is_scalar_type () && v.is_real_type ()) + { + double new_val = v.double_value (); + + if (new_val != current_val) + { + current_val = new_val; + return true; + } + } + else + error ("set: invalid value for double property \"%s\"", + get_name ().c_str ()); + return false; + } + +private: + double current_val; +}; + +// --------------------------------------------------------------------- + +class double_radio_property : public base_property +{ +public: + double_radio_property (double d, const radio_values& v) + : base_property ("", graphics_handle ()), + current_type (double_t), dval (d), radio_val (v), + current_val (v.default_value ()) + { } + + double_radio_property (const std::string& nm, const graphics_handle& h, + const std::string& v) + : base_property (nm, h), + current_type (radio_t), dval (0), radio_val (v), + current_val (radio_val.default_value ()) + { } + + double_radio_property (const std::string& nm, const graphics_handle& h, + const double_radio_property& v) + : base_property (nm, h), + current_type (v.current_type), dval (v.dval), + radio_val (v.radio_val), current_val (v.current_val) + { } + + double_radio_property (const double_radio_property& p) + : base_property (p), current_type (p.current_type), + dval (p.dval), radio_val (p.radio_val), + current_val (p.current_val) { } + + octave_value get (void) const + { + if (current_type == double_t) + return dval; + + return current_val; + } + + bool is_double (void) const { return (current_type == double_t); } + + bool is_radio (void) const { return (current_type == radio_t); } + + bool is (const std::string& v) const + { return (is_radio () && current_val == v); } + + double double_value (void) const + { + if (current_type != double_t) + error ("%s: property has no double", get_name ().c_str ()); + + return dval; + } + + const std::string& current_value (void) const + { + if (current_type != radio_t) + error ("%s: property has no radio value"); + + return current_val; + } + + double_radio_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + operator octave_value (void) const { return get (); } + + base_property* clone (void) const + { return new double_radio_property (*this); } + +protected: + OCTINTERP_API bool do_set (const octave_value& v); + +private: + enum current_enum { double_t, radio_t } current_type; + double dval; + radio_values radio_val; + std::string current_val; +}; + +// --------------------------------------------------------------------- + +class array_property : public base_property +{ +public: + array_property (void) + : base_property ("", graphics_handle ()), data (Matrix ()), + xmin (), xmax (), xminp (), xmaxp (), + type_constraints (), size_constraints () + { + get_data_limits (); + } + + array_property (const std::string& nm, const graphics_handle& h, + const octave_value& m) + : base_property (nm, h), data (m.is_sparse_type () ? m.full_value () : m), + xmin (), xmax (), xminp (), xmaxp (), + type_constraints (), size_constraints () + { + get_data_limits (); + } + + // This copy constructor is only intended to be used + // internally to access min/max values; no need to + // copy constraints. + array_property (const array_property& p) + : base_property (p), data (p.data), + xmin (p.xmin), xmax (p.xmax), xminp (p.xminp), xmaxp (p.xmaxp), + type_constraints (), size_constraints () + { } + + octave_value get (void) const { return data; } + + void add_constraint (const std::string& type) + { type_constraints.insert (type); } + + void add_constraint (const dim_vector& dims) + { size_constraints.push_back (dims); } + + double min_val (void) const { return xmin; } + double max_val (void) const { return xmax; } + double min_pos (void) const { return xminp; } + double max_neg (void) const { return xmaxp; } + + Matrix get_limits (void) const + { + Matrix m (1, 4); + + m(0) = min_val (); + m(1) = max_val (); + m(2) = min_pos (); + m(3) = max_neg (); + + return m; + } + + array_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const + { + array_property *p = new array_property (*this); + + p->type_constraints = type_constraints; + p->size_constraints = size_constraints; + + return p; + } + +protected: + bool do_set (const octave_value& v) + { + octave_value tmp = v.is_sparse_type () ? v.full_value () : v; + + if (validate (tmp)) + { + // FIXME -- should we check for actual data change? + if (! is_equal (tmp)) + { + data = tmp; + + get_data_limits (); + + return true; + } + } + else + error ("invalid value for array property \"%s\"", + get_name ().c_str ()); + + return false; + } + +private: + OCTINTERP_API bool validate (const octave_value& v); + + OCTINTERP_API bool is_equal (const octave_value& v) const; + + OCTINTERP_API void get_data_limits (void); + +protected: + octave_value data; + double xmin; + double xmax; + double xminp; + double xmaxp; + std::set type_constraints; + std::list size_constraints; +}; + +class row_vector_property : public array_property +{ +public: + row_vector_property (const std::string& nm, const graphics_handle& h, + const octave_value& m) + : array_property (nm, h, m) + { + add_constraint (dim_vector (-1, 1)); + add_constraint (dim_vector (1, -1)); + } + + row_vector_property (const row_vector_property& p) + : array_property (p) + { + add_constraint (dim_vector (-1, 1)); + add_constraint (dim_vector (1, -1)); + } + + void add_constraint (const std::string& type) + { + array_property::add_constraint (type); + } + + void add_constraint (const dim_vector& dims) + { + array_property::add_constraint (dims); + } + + void add_constraint (octave_idx_type len) + { + size_constraints.remove (dim_vector (1, -1)); + size_constraints.remove (dim_vector (-1, 1)); + + add_constraint (dim_vector (1, len)); + add_constraint (dim_vector (len, 1)); + } + + row_vector_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const + { + row_vector_property *p = new row_vector_property (*this); + + p->type_constraints = type_constraints; + p->size_constraints = size_constraints; + + return p; + } + +protected: + bool do_set (const octave_value& v) + { + bool retval = array_property::do_set (v); + + if (! error_state) + { + dim_vector dv = data.dims (); + + if (dv(0) > 1 && dv(1) == 1) + { + int tmp = dv(0); + dv(0) = dv(1); + dv(1) = tmp; + + data = data.reshape (dv); + } + + return retval; + } + + return false; + } + +private: + OCTINTERP_API bool validate (const octave_value& v); +}; + +// --------------------------------------------------------------------- + +class bool_property : public radio_property +{ +public: + bool_property (const std::string& nm, const graphics_handle& h, + bool val) + : radio_property (nm, h, radio_values (val ? "{on}|off" : "on|{off}")) + { } + + bool_property (const std::string& nm, const graphics_handle& h, + const char* val) + : radio_property (nm, h, radio_values ("on|off"), val) + { } + + bool_property (const bool_property& p) + : radio_property (p) { } + + bool is_on (void) const { return is ("on"); } + + bool_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new bool_property (*this); } + +protected: + bool do_set (const octave_value& val) + { + if (val.is_bool_scalar ()) + return radio_property::do_set (val.bool_value () ? "on" : "off"); + else + return radio_property::do_set (val); + } +}; + +// --------------------------------------------------------------------- + +class handle_property : public base_property +{ +public: + handle_property (const std::string& nm, const graphics_handle& h, + const graphics_handle& val = graphics_handle ()) + : base_property (nm, h), + current_val (val) { } + + handle_property (const handle_property& p) + : base_property (p), current_val (p.current_val) { } + + octave_value get (void) const { return current_val.as_octave_value (); } + + graphics_handle handle_value (void) const { return current_val; } + + handle_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + handle_property& operator = (const graphics_handle& h) + { + set (octave_value (h.value ())); + return *this; + } + + base_property* clone (void) const { return new handle_property (*this); } + +protected: + OCTINTERP_API bool do_set (const octave_value& v); + +private: + graphics_handle current_val; +}; + +// --------------------------------------------------------------------- + +class any_property : public base_property +{ +public: + any_property (const std::string& nm, const graphics_handle& h, + const octave_value& m = Matrix ()) + : base_property (nm, h), data (m) { } + + any_property (const any_property& p) + : base_property (p), data (p.data) { } + + octave_value get (void) const { return data; } + + any_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new any_property (*this); } + +protected: + bool do_set (const octave_value& v) + { + data = v; + return true; + } + +private: + octave_value data; +}; + +// --------------------------------------------------------------------- + +class children_property : public base_property +{ +public: + children_property (void) + : base_property ("", graphics_handle ()), children_list () + { + do_init_children (Matrix ()); + } + + children_property (const std::string& nm, const graphics_handle& h, + const Matrix &val) + : base_property (nm, h), children_list () + { + do_init_children (val); + } + + children_property (const children_property& p) + : base_property (p), children_list () + { + do_init_children (p.children_list); + } + + children_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new children_property (*this); } + + bool remove_child (const double &val) + { + return do_remove_child (val); + } + + void adopt (const double &val) + { + do_adopt_child (val); + } + + Matrix get_children (void) const + { + return do_get_children (false); + } + + Matrix get_hidden (void) const + { + return do_get_children (true); + } + + Matrix get_all (void) const + { + return do_get_all_children (); + } + + octave_value get (void) const + { + return octave_value (get_children ()); + } + + void delete_children (bool clear = false) + { + do_delete_children (clear); + } + + void renumber (graphics_handle old_gh, graphics_handle new_gh) + { + for (children_list_iterator p = children_list.begin (); + p != children_list.end (); p++) + { + if (*p == old_gh) + { + *p = new_gh.value (); + return; + } + } + + error ("children_list::renumber: child not found!"); + } + +private: + typedef std::list::iterator children_list_iterator; + typedef std::list::const_iterator const_children_list_iterator; + std::list children_list; + +protected: + bool do_set (const octave_value& val) + { + const Matrix new_kids = val.matrix_value (); + + octave_idx_type nel = new_kids.numel (); + + const Matrix new_kids_column = new_kids.reshape (dim_vector (nel, 1)); + + bool is_ok = true; + + if (! error_state) + { + const Matrix visible_kids = do_get_children (false); + + if (visible_kids.numel () == new_kids.numel ()) + { + Matrix t1 = visible_kids.sort (); + Matrix t2 = new_kids_column.sort (); + + if (t1 != t2) + is_ok = false; + } + else + is_ok = false; + + if (! is_ok) + error ("set: new children must be a permutation of existing children"); + } + else + { + is_ok = false; + error ("set: expecting children to be array of graphics handles"); + } + + if (is_ok) + { + Matrix tmp = new_kids_column.stack (get_hidden ()); + + children_list.clear (); + + // Don't use do_init_children here, as that reverses the + // order of the list, and we don't want to do that if setting + // the child list directly. + + for (octave_idx_type i = 0; i < tmp.numel (); i++) + children_list.push_back (tmp.xelem (i)); + } + + return is_ok; + } + +private: + void do_init_children (const Matrix &val) + { + children_list.clear (); + for (octave_idx_type i = 0; i < val.numel (); i++) + children_list.push_front (val.xelem (i)); + } + + void do_init_children (const std::list &val) + { + children_list.clear (); + for (const_children_list_iterator p = val.begin (); p != val.end (); p++) + children_list.push_front (*p); + } + + Matrix do_get_children (bool return_hidden) const; + + Matrix do_get_all_children (void) const + { + Matrix retval (children_list.size (), 1); + octave_idx_type i = 0; + + for (const_children_list_iterator p = children_list.begin (); + p != children_list.end (); p++) + retval(i++) = *p; + return retval; + } + + bool do_remove_child (double child) + { + for (children_list_iterator p = children_list.begin (); + p != children_list.end (); p++) + { + if (*p == child) + { + children_list.erase (p); + return true; + } + } + return false; + } + + void do_adopt_child (const double &val) + { + children_list.push_front (val); + } + + void do_delete_children (bool clear); +}; + + + +// --------------------------------------------------------------------- + +class callback_property : public base_property +{ +public: + callback_property (const std::string& nm, const graphics_handle& h, + const octave_value& m) + : base_property (nm, h), callback (m), executing (false) { } + + callback_property (const callback_property& p) + : base_property (p), callback (p.callback), executing (false) { } + + octave_value get (void) const { return callback; } + + OCTINTERP_API void execute (const octave_value& data = octave_value ()) const; + + bool is_defined (void) const + { + return (callback.is_defined () && ! callback.is_empty ()); + } + + callback_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new callback_property (*this); } + +protected: + bool do_set (const octave_value& v) + { + if (validate (v)) + { + callback = v; + return true; + } + else + error ("invalid value for callback property \"%s\"", + get_name ().c_str ()); + return false; + } + +private: + OCTINTERP_API bool validate (const octave_value& v) const; + +private: + octave_value callback; + + // If TRUE, we are executing this callback. + mutable bool executing; +}; + +// --------------------------------------------------------------------- + +class property +{ +public: + property (void) : rep (new base_property ("", graphics_handle ())) + { } + + property (base_property *bp, bool persist = false) : rep (bp) + { if (persist) rep->count++; } + + property (const property& p) : rep (p.rep) + { + rep->count++; + } + + ~property (void) + { + if (--rep->count == 0) + delete rep; + } + + bool ok (void) const + { return rep->ok (); } + + std::string get_name (void) const + { return rep->get_name (); } + + void set_name (const std::string& name) + { rep->set_name (name); } + + graphics_handle get_parent (void) const + { return rep->get_parent (); } + + void set_parent (const graphics_handle& h) + { rep->set_parent (h); } + + bool is_hidden (void) const + { return rep->is_hidden (); } + + void set_hidden (bool flag) + { rep->set_hidden (flag); } + + bool is_radio (void) const + { return rep->is_radio (); } + + int get_id (void) const + { return rep->get_id (); } + + void set_id (int d) + { rep->set_id (d); } + + octave_value get (void) const + { return rep->get (); } + + bool set (const octave_value& val, bool do_run = true, + bool do_notify_toolkit = true) + { return rep->set (val, do_run, do_notify_toolkit); } + + std::string values_as_string (void) const + { return rep->values_as_string (); } + + Cell values_as_cell (void) const + { return rep->values_as_cell (); } + + property& operator = (const octave_value& val) + { + *rep = val; + return *this; + } + + property& operator = (const property& p) + { + if (rep && --rep->count == 0) + delete rep; + + rep = p.rep; + rep->count++; + + return *this; + } + + void add_listener (const octave_value& v, listener_mode mode = POSTSET) + { rep->add_listener (v, mode); } + + void delete_listener (const octave_value& v = octave_value (), + listener_mode mode = POSTSET) + { rep->delete_listener (v, mode); } + + void run_listeners (listener_mode mode = POSTSET) + { rep->run_listeners (mode); } + + OCTINTERP_API static + property create (const std::string& name, const graphics_handle& parent, + const caseless_str& type, + const octave_value_list& args); + + property clone (void) const + { return property (rep->clone ()); } + + /* + const string_property& as_string_property (void) const + { return *(dynamic_cast (rep)); } + + const radio_property& as_radio_property (void) const + { return *(dynamic_cast (rep)); } + + const color_property& as_color_property (void) const + { return *(dynamic_cast (rep)); } + + const double_property& as_double_property (void) const + { return *(dynamic_cast (rep)); } + + const bool_property& as_bool_property (void) const + { return *(dynamic_cast (rep)); } + + const handle_property& as_handle_property (void) const + { return *(dynamic_cast (rep)); } + */ + +private: + base_property *rep; +}; + +// --------------------------------------------------------------------- + +class property_list +{ +public: + typedef std::map pval_map_type; + typedef std::map plist_map_type; + + typedef pval_map_type::iterator pval_map_iterator; + typedef pval_map_type::const_iterator pval_map_const_iterator; + + typedef plist_map_type::iterator plist_map_iterator; + typedef plist_map_type::const_iterator plist_map_const_iterator; + + property_list (const plist_map_type& m = plist_map_type ()) + : plist_map (m) { } + + ~property_list (void) { } + + void set (const caseless_str& name, const octave_value& val); + + octave_value lookup (const caseless_str& name) const; + + plist_map_iterator begin (void) { return plist_map.begin (); } + plist_map_const_iterator begin (void) const { return plist_map.begin (); } + + plist_map_iterator end (void) { return plist_map.end (); } + plist_map_const_iterator end (void) const { return plist_map.end (); } + + plist_map_iterator find (const std::string& go_name) + { + return plist_map.find (go_name); + } + + plist_map_const_iterator find (const std::string& go_name) const + { + return plist_map.find (go_name); + } + + octave_scalar_map as_struct (const std::string& prefix_arg) const; + +private: + plist_map_type plist_map; +}; + +// --------------------------------------------------------------------- + +class graphics_toolkit; +class graphics_object; + +class base_graphics_toolkit +{ +public: + friend class graphics_toolkit; + +public: + base_graphics_toolkit (const std::string& nm) + : name (nm), count (0) { } + + virtual ~base_graphics_toolkit (void) { } + + std::string get_name (void) const { return name; } + + virtual bool is_valid (void) const { return false; } + + virtual void redraw_figure (const graphics_object&) const + { gripe_invalid ("redraw_figure"); } + + virtual void print_figure (const graphics_object&, const std::string&, + const std::string&, bool, + const std::string& = "") const + { gripe_invalid ("print_figure"); } + + virtual Matrix get_canvas_size (const graphics_handle&) const + { + gripe_invalid ("get_canvas_size"); + return Matrix (1, 2, 0.0); + } + + virtual double get_screen_resolution (void) const + { + gripe_invalid ("get_screen_resolution"); + return 72.0; + } + + virtual Matrix get_screen_size (void) const + { + gripe_invalid ("get_screen_size"); + return Matrix (1, 2, 0.0); + } + + // Callback function executed when the given graphics object + // changes. This allows the graphics toolkit to act on property + // changes if needed. + virtual void update (const graphics_object&, int) + { gripe_invalid ("base_graphics_toolkit::update"); } + + void update (const graphics_handle&, int); + + // Callback function executed when the given graphics object is + // created. This allows the graphics toolkit to do toolkit-specific + // initializations for a newly created object. + virtual bool initialize (const graphics_object&) + { gripe_invalid ("base_graphics_toolkit::initialize"); return false; } + + bool initialize (const graphics_handle&); + + // Callback function executed just prior to deleting the given + // graphics object. This allows the graphics toolkit to perform + // toolkit-specific cleanup operations before an object is deleted. + virtual void finalize (const graphics_object&) + { gripe_invalid ("base_graphics_toolkit::finalize"); } + + void finalize (const graphics_handle&); + + // Close the graphics toolkit. + virtual void close (void) + { gripe_invalid ("base_graphics_toolkit::close"); } + +private: + std::string name; + octave_refcount count; + +private: + void gripe_invalid (const std::string& fname) const + { + if (! is_valid ()) + error ("%s: invalid graphics toolkit", fname.c_str ()); + } +}; + +class graphics_toolkit +{ +public: + graphics_toolkit (void) + : rep (new base_graphics_toolkit ("unknown")) + { + rep->count++; + } + + graphics_toolkit (base_graphics_toolkit* b) + : rep (b) + { + rep->count++; + } + + graphics_toolkit (const graphics_toolkit& b) + : rep (b.rep) + { + rep->count++; + } + + ~graphics_toolkit (void) + { + if (--rep->count == 0) + delete rep; + } + + graphics_toolkit& operator = (const graphics_toolkit& b) + { + if (rep != b.rep) + { + if (--rep->count == 0) + delete rep; + + rep = b.rep; + rep->count++; + } + + return *this; + } + + operator bool (void) const { return rep->is_valid (); } + + std::string get_name (void) const { return rep->get_name (); } + + void redraw_figure (const graphics_object& go) const + { rep->redraw_figure (go); } + + void print_figure (const graphics_object& go, const std::string& term, + const std::string& file, bool mono, + const std::string& debug_file = "") const + { rep->print_figure (go, term, file, mono, debug_file); } + + Matrix get_canvas_size (const graphics_handle& fh) const + { return rep->get_canvas_size (fh); } + + double get_screen_resolution (void) const + { return rep->get_screen_resolution (); } + + Matrix get_screen_size (void) const + { return rep->get_screen_size (); } + + // Notifies graphics toolkit that object't property has changed. + void update (const graphics_object& go, int id) + { rep->update (go, id); } + + void update (const graphics_handle& h, int id) + { rep->update (h, id); } + + // Notifies graphics toolkit that new object was created. + bool initialize (const graphics_object& go) + { return rep->initialize (go); } + + bool initialize (const graphics_handle& h) + { return rep->initialize (h); } + + // Notifies graphics toolkit that object was destroyed. + // This is called only for explicitly deleted object. Children are + // deleted implicitly and graphics toolkit isn't notified. + void finalize (const graphics_object& go) + { rep->finalize (go); } + + void finalize (const graphics_handle& h) + { rep->finalize (h); } + + // Close the graphics toolkit. + void close (void) { rep->close (); } + +private: + + base_graphics_toolkit *rep; +}; + +class gtk_manager +{ +public: + + static graphics_toolkit get_toolkit (void) + { + return instance_ok () ? instance->do_get_toolkit () : graphics_toolkit (); + } + + static void register_toolkit (const std::string& name) + { + if (instance_ok ()) + instance->do_register_toolkit (name); + } + + static void unregister_toolkit (const std::string& name) + { + if (instance_ok ()) + instance->do_unregister_toolkit (name); + } + + static void load_toolkit (const graphics_toolkit& tk) + { + if (instance_ok ()) + instance->do_load_toolkit (tk); + } + + static void unload_toolkit (const std::string& name) + { + if (instance_ok ()) + instance->do_unload_toolkit (name); + } + + static graphics_toolkit find_toolkit (const std::string& name) + { + return instance_ok () + ? instance->do_find_toolkit (name) : graphics_toolkit (); + } + + static Cell available_toolkits_list (void) + { + return instance_ok () ? instance->do_available_toolkits_list () : Cell (); + } + + static Cell loaded_toolkits_list (void) + { + return instance_ok () ? instance->do_loaded_toolkits_list () : Cell (); + } + + static void unload_all_toolkits (void) + { + if (instance_ok ()) + instance->do_unload_all_toolkits (); + } + + static std::string default_toolkit (void) + { + return instance_ok () ? instance->do_default_toolkit () : std::string (); + } + +private: + + // FIXME -- default toolkit should be configurable. + + gtk_manager (void) + : dtk ("gnuplot"), available_toolkits (), loaded_toolkits () { } + + ~gtk_manager (void) { } + + OCTINTERP_API static void create_instance (void); + + static bool instance_ok (void) + { + bool retval = true; + + if (! instance) + create_instance (); + + if (! instance) + { + ::error ("unable to create gh_manager!"); + + retval = false; + } + + return retval; + } + + static void cleanup_instance (void) { delete instance; instance = 0; } + + OCTINTERP_API static gtk_manager *instance; + + // The name of the default toolkit. + std::string dtk; + + // The list of toolkits that we know about. + std::set available_toolkits; + + // The list of toolkits we have actually loaded. + std::map loaded_toolkits; + + typedef std::set::iterator available_toolkits_iterator; + + typedef std::set::const_iterator + const_available_toolkits_iterator; + + typedef std::map::iterator + loaded_toolkits_iterator; + + typedef std::map::const_iterator + const_loaded_toolkits_iterator; + + graphics_toolkit do_get_toolkit (void) const; + + void do_register_toolkit (const std::string& name) + { + available_toolkits.insert (name); + } + + void do_unregister_toolkit (const std::string& name) + { + available_toolkits.erase (name); + } + + void do_load_toolkit (const graphics_toolkit& tk) + { + loaded_toolkits[tk.get_name ()] = tk; + } + + void do_unload_toolkit (const std::string& name) + { + loaded_toolkits.erase (name); + } + + graphics_toolkit do_find_toolkit (const std::string& name) const + { + const_loaded_toolkits_iterator p = loaded_toolkits.find (name); + + if (p != loaded_toolkits.end ()) + return p->second; + else + return graphics_toolkit (); + } + + Cell do_available_toolkits_list (void) const + { + Cell m (1 , available_toolkits.size ()); + + octave_idx_type i = 0; + for (const_available_toolkits_iterator p = available_toolkits.begin (); + p != available_toolkits.end (); p++) + m(i++) = *p; + + return m; + } + + Cell do_loaded_toolkits_list (void) const + { + Cell m (1 , loaded_toolkits.size ()); + + octave_idx_type i = 0; + for (const_loaded_toolkits_iterator p = loaded_toolkits.begin (); + p != loaded_toolkits.end (); p++) + m(i++) = p->first; + + return m; + } + + void do_unload_all_toolkits (void) + { + while (! loaded_toolkits.empty ()) + { + loaded_toolkits_iterator p = loaded_toolkits.begin (); + + std::string name = p->first; + + p->second.close (); + + // The toolkit may have unloaded itself. If not, we'll do + // it here. + if (loaded_toolkits.find (name) != loaded_toolkits.end ()) + unload_toolkit (name); + } + } + + std::string do_default_toolkit (void) { return dtk; } +}; + +// --------------------------------------------------------------------- + +class base_graphics_object; +class graphics_object; + +class OCTINTERP_API base_properties +{ +public: + base_properties (const std::string& ty = "unknown", + const graphics_handle& mh = graphics_handle (), + const graphics_handle& p = graphics_handle ()); + + virtual ~base_properties (void) { } + + virtual std::string graphics_object_name (void) const { return "unknonwn"; } + + void mark_modified (void); + + void override_defaults (base_graphics_object& obj); + + virtual void init_integerhandle (const octave_value&) + { + panic_impossible (); + } + + // Look through DEFAULTS for properties with given CLASS_NAME, and + // apply them to the current object with set (virtual method). + + void set_from_list (base_graphics_object& obj, property_list& defaults); + + void insert_property (const std::string& name, property p) + { + p.set_name (name); + p.set_parent (__myhandle__); + all_props[name] = p; + } + + virtual void set (const caseless_str&, const octave_value&); + + virtual octave_value get (const caseless_str& pname) const; + + virtual octave_value get (const std::string& pname) const + { + return get (caseless_str (pname)); + } + + virtual octave_value get (const char *pname) const + { + return get (caseless_str (pname)); + } + + virtual octave_value get (bool all = false) const; + + virtual property get_property (const caseless_str& pname); + + virtual bool has_property (const caseless_str&) const + { + panic_impossible (); + return false; + } + + bool is_modified (void) const { return is___modified__ (); } + + virtual void remove_child (const graphics_handle& h) + { + if (children.remove_child (h.value ())) + mark_modified (); + } + + virtual void adopt (const graphics_handle& h) + { + children.adopt (h.value ()); + mark_modified (); + } + + virtual graphics_toolkit get_toolkit (void) const; + + virtual Matrix get_boundingbox (bool /*internal*/ = false, + const Matrix& /*parent_pix_size*/ = Matrix ()) const + { return Matrix (1, 4, 0.0); } + + virtual void update_boundingbox (void); + + virtual void update_autopos (const std::string& elem_type); + + virtual void add_listener (const caseless_str&, const octave_value&, + listener_mode = POSTSET); + + virtual void delete_listener (const caseless_str&, const octave_value&, + listener_mode = POSTSET); + + void set_tag (const octave_value& val) { tag = val; } + + void set_parent (const octave_value& val); + + Matrix get_children (void) const + { + return children.get_children (); + } + + Matrix get_all_children (void) const + { + return children.get_all (); + } + + Matrix get_hidden_children (void) const + { + return children.get_hidden (); + } + + void set_modified (const octave_value& val) { set___modified__ (val); } + + void set___modified__ (const octave_value& val) { __modified__ = val; } + + void reparent (const graphics_handle& new_parent) { parent = new_parent; } + + // Update data limits for AXIS_TYPE (xdata, ydata, etc.) in the parent + // axes object. + + virtual void update_axis_limits (const std::string& axis_type) const; + + virtual void update_axis_limits (const std::string& axis_type, + const graphics_handle& h) const; + + virtual void delete_children (bool clear = false) + { + children.delete_children (clear); + } + + void renumber_child (graphics_handle old_gh, graphics_handle new_gh) + { + children.renumber (old_gh, new_gh); + } + + void renumber_parent (graphics_handle new_gh) + { + parent = new_gh; + } + + static property_list::pval_map_type factory_defaults (void); + + // FIXME -- these functions should be generated automatically by the + // genprops.awk script. + // + // EMIT_BASE_PROPERTIES_GET_FUNCTIONS + + virtual octave_value get_xlim (void) const { return octave_value (); } + virtual octave_value get_ylim (void) const { return octave_value (); } + virtual octave_value get_zlim (void) const { return octave_value (); } + virtual octave_value get_clim (void) const { return octave_value (); } + virtual octave_value get_alim (void) const { return octave_value (); } + + virtual bool is_xliminclude (void) const { return false; } + virtual bool is_yliminclude (void) const { return false; } + virtual bool is_zliminclude (void) const { return false; } + virtual bool is_climinclude (void) const { return false; } + virtual bool is_aliminclude (void) const { return false; } + + bool is_handle_visible (void) const; + + std::set dynamic_property_names (void) const; + + bool has_dynamic_property (const std::string& pname); + +protected: + std::set dynamic_properties; + + void set_dynamic (const caseless_str& pname, const octave_value& val); + + octave_value get_dynamic (const caseless_str& pname) const; + + octave_value get_dynamic (bool all = false) const; + + property get_property_dynamic (const caseless_str& pname); + + BEGIN_BASE_PROPERTIES + // properties common to all objects + bool_property beingdeleted , "off" + radio_property busyaction , "{queue}|cancel" + callback_property buttondownfcn , Matrix () + children_property children gf , Matrix () + bool_property clipping , "on" + callback_property createfcn , Matrix () + callback_property deletefcn , Matrix () + radio_property handlevisibility , "{on}|callback|off" + bool_property hittest , "on" + bool_property interruptible , "on" + handle_property parent fs , p + bool_property selected , "off" + bool_property selectionhighlight , "on" + string_property tag s , "" + string_property type frs , ty + any_property userdata , Matrix () + bool_property visible , "on" + // additional (octave-specific) properties + bool_property __modified__ s , "on" + graphics_handle __myhandle__ fhrs , mh + // FIXME -- should this really be here? + handle_property uicontextmenu , graphics_handle () + END_PROPERTIES + +protected: + struct cmp_caseless_str + { + bool operator () (const caseless_str &a, const caseless_str &b) const + { + std::string a1 = a; + std::transform (a1.begin (), a1.end (), a1.begin (), tolower); + std::string b1 = b; + std::transform (b1.begin (), b1.end (), b1.begin (), tolower); + + return a1 < b1; + } + }; + + std::map all_props; + +protected: + void insert_static_property (const std::string& name, base_property& p) + { insert_property (name, property (&p, true)); } + + virtual void init (void) { } +}; + +class OCTINTERP_API base_graphics_object +{ +public: + friend class graphics_object; + + base_graphics_object (void) : count (1), toolkit_flag (false) { } + + virtual ~base_graphics_object (void) { } + + virtual void mark_modified (void) + { + if (valid_object ()) + get_properties ().mark_modified (); + else + error ("base_graphics_object::mark_modified: invalid graphics object"); + } + + virtual void override_defaults (base_graphics_object& obj) + { + if (valid_object ()) + get_properties ().override_defaults (obj); + else + error ("base_graphics_object::override_defaults: invalid graphics object"); + } + + virtual void set_from_list (property_list& plist) + { + if (valid_object ()) + get_properties ().set_from_list (*this, plist); + else + error ("base_graphics_object::set_from_list: invalid graphics object"); + } + + virtual void set (const caseless_str& pname, const octave_value& pval) + { + if (valid_object ()) + get_properties ().set (pname, pval); + else + error ("base_graphics_object::set: invalid graphics object"); + } + + virtual void set_defaults (const std::string&) + { + error ("base_graphics_object::set_defaults: invalid graphics object"); + } + + virtual octave_value get (bool all = false) const + { + if (valid_object ()) + return get_properties ().get (all); + else + { + error ("base_graphics_object::get: invalid graphics object"); + return octave_value (); + } + } + + virtual octave_value get (const caseless_str& pname) const + { + if (valid_object ()) + return get_properties ().get (pname); + else + { + error ("base_graphics_object::get: invalid graphics object"); + return octave_value (); + } + } + + virtual octave_value get_default (const caseless_str&) const; + + virtual octave_value get_factory_default (const caseless_str&) const; + + virtual octave_value get_defaults (void) const + { + error ("base_graphics_object::get_defaults: invalid graphics object"); + return octave_value (); + } + + virtual octave_value get_factory_defaults (void) const + { + error ("base_graphics_object::get_factory_defaults: invalid graphics object"); + return octave_value (); + } + + virtual std::string values_as_string (void); + + virtual octave_scalar_map values_as_struct (void); + + virtual graphics_handle get_parent (void) const + { + if (valid_object ()) + return get_properties ().get_parent (); + else + { + error ("base_graphics_object::get_parent: invalid graphics object"); + return graphics_handle (); + } + } + + graphics_handle get_handle (void) const + { + if (valid_object ()) + return get_properties ().get___myhandle__ (); + else + { + error ("base_graphics_object::get_handle: invalid graphics object"); + return graphics_handle (); + } + } + + virtual void remove_child (const graphics_handle& h) + { + if (valid_object ()) + get_properties ().remove_child (h); + else + error ("base_graphics_object::remove_child: invalid graphics object"); + } + + virtual void adopt (const graphics_handle& h) + { + if (valid_object ()) + get_properties ().adopt (h); + else + error ("base_graphics_object::adopt: invalid graphics object"); + } + + virtual void reparent (const graphics_handle& np) + { + if (valid_object ()) + get_properties ().reparent (np); + else + error ("base_graphics_object::reparent: invalid graphics object"); + } + + virtual void defaults (void) const + { + if (valid_object ()) + { + std::string msg = (type () + "::defaults"); + gripe_not_implemented (msg.c_str ()); + } + else + error ("base_graphics_object::default: invalid graphics object"); + } + + virtual base_properties& get_properties (void) + { + static base_properties properties; + error ("base_graphics_object::get_properties: invalid graphics object"); + return properties; + } + + virtual const base_properties& get_properties (void) const + { + static base_properties properties; + error ("base_graphics_object::get_properties: invalid graphics object"); + return properties; + } + + virtual void update_axis_limits (const std::string& axis_type); + + virtual void update_axis_limits (const std::string& axis_type, + const graphics_handle& h); + + virtual bool valid_object (void) const { return false; } + + bool valid_toolkit_object (void) const { return toolkit_flag; } + + virtual std::string type (void) const + { + return (valid_object () ? get_properties ().graphics_object_name () + : "unknown"); + } + + bool isa (const std::string& go_name) const + { + return type () == go_name; + } + + virtual graphics_toolkit get_toolkit (void) const + { + if (valid_object ()) + return get_properties ().get_toolkit (); + else + { + error ("base_graphics_object::get_toolkit: invalid graphics object"); + return graphics_toolkit (); + } + } + + virtual void add_property_listener (const std::string& nm, + const octave_value& v, + listener_mode mode = POSTSET) + { + if (valid_object ()) + get_properties ().add_listener (nm, v, mode); + } + + virtual void delete_property_listener (const std::string& nm, + const octave_value& v, + listener_mode mode = POSTSET) + { + if (valid_object ()) + get_properties ().delete_listener (nm, v, mode); + } + + virtual void remove_all_listeners (void); + + virtual void reset_default_properties (void) + { + if (valid_object ()) + { + std::string msg = (type () + "::reset_default_properties"); + gripe_not_implemented (msg.c_str ()); + } + else + error ("base_graphics_object::default: invalid graphics object"); + } + +protected: + virtual void initialize (const graphics_object& go) + { + if (! toolkit_flag) + toolkit_flag = get_toolkit ().initialize (go); + } + + virtual void finalize (const graphics_object& go) + { + if (toolkit_flag) + { + get_toolkit ().finalize (go); + toolkit_flag = false; + } + } + + virtual void update (const graphics_object& go, int id) + { + if (toolkit_flag) + get_toolkit ().update (go, id); + } + +protected: + // A reference count. + octave_refcount count; + + // A flag telling whether this object is a valid object + // in the backend context. + bool toolkit_flag; + + // No copying! + + base_graphics_object (const base_graphics_object&) : count (0) { } + + base_graphics_object& operator = (const base_graphics_object&) + { + return *this; + } +}; + +class OCTINTERP_API graphics_object +{ +public: + graphics_object (void) : rep (new base_graphics_object ()) { } + + graphics_object (base_graphics_object *new_rep) + : rep (new_rep) { } + + graphics_object (const graphics_object& obj) : rep (obj.rep) + { + rep->count++; + } + + graphics_object& operator = (const graphics_object& obj) + { + if (rep != obj.rep) + { + if (--rep->count == 0) + delete rep; + + rep = obj.rep; + rep->count++; + } + + return *this; + } + + ~graphics_object (void) + { + if (--rep->count == 0) + delete rep; + } + + void mark_modified (void) { rep->mark_modified (); } + + void override_defaults (base_graphics_object& obj) + { + rep->override_defaults (obj); + } + + void set_from_list (property_list& plist) { rep->set_from_list (plist); } + + void set (const caseless_str& name, const octave_value& val) + { + rep->set (name, val); + } + + void set (const octave_value_list& args); + + void set (const Array& names, const Cell& values, + octave_idx_type row); + + void set (const octave_map& m); + + void set_value_or_default (const caseless_str& name, + const octave_value& val); + + void set_defaults (const std::string& mode) { rep->set_defaults (mode); } + + octave_value get (bool all = false) const { return rep->get (all); } + + octave_value get (const caseless_str& name) const + { + return name.compare ("default") + ? get_defaults () + : (name.compare ("factory") + ? get_factory_defaults () : rep->get (name)); + } + + octave_value get (const std::string& name) const + { + return get (caseless_str (name)); + } + + octave_value get (const char *name) const + { + return get (caseless_str (name)); + } + + octave_value get_default (const caseless_str& name) const + { + return rep->get_default (name); + } + + octave_value get_factory_default (const caseless_str& name) const + { + return rep->get_factory_default (name); + } + + octave_value get_defaults (void) const { return rep->get_defaults (); } + + octave_value get_factory_defaults (void) const + { + return rep->get_factory_defaults (); + } + + std::string values_as_string (void) { return rep->values_as_string (); } + + octave_map values_as_struct (void) { return rep->values_as_struct (); } + + graphics_handle get_parent (void) const { return rep->get_parent (); } + + graphics_handle get_handle (void) const { return rep->get_handle (); } + + graphics_object get_ancestor (const std::string& type) const; + + void remove_child (const graphics_handle& h) { rep->remove_child (h); } + + void adopt (const graphics_handle& h) { rep->adopt (h); } + + void reparent (const graphics_handle& h) { rep->reparent (h); } + + void defaults (void) const { rep->defaults (); } + + bool isa (const std::string& go_name) const { return rep->isa (go_name); } + + base_properties& get_properties (void) { return rep->get_properties (); } + + const base_properties& get_properties (void) const + { + return rep->get_properties (); + } + + void update_axis_limits (const std::string& axis_type) + { + rep->update_axis_limits (axis_type); + } + + void update_axis_limits (const std::string& axis_type, + const graphics_handle& h) + { + rep->update_axis_limits (axis_type, h); + } + + bool valid_object (void) const { return rep->valid_object (); } + + std::string type (void) const { return rep->type (); } + + operator bool (void) const { return rep->valid_object (); } + + // FIXME -- these functions should be generated automatically by the + // genprops.awk script. + // + // EMIT_GRAPHICS_OBJECT_GET_FUNCTIONS + + octave_value get_xlim (void) const + { return get_properties ().get_xlim (); } + + octave_value get_ylim (void) const + { return get_properties ().get_ylim (); } + + octave_value get_zlim (void) const + { return get_properties ().get_zlim (); } + + octave_value get_clim (void) const + { return get_properties ().get_clim (); } + + octave_value get_alim (void) const + { return get_properties ().get_alim (); } + + bool is_xliminclude (void) const + { return get_properties ().is_xliminclude (); } + + bool is_yliminclude (void) const + { return get_properties ().is_yliminclude (); } + + bool is_zliminclude (void) const + { return get_properties ().is_zliminclude (); } + + bool is_climinclude (void) const + { return get_properties ().is_climinclude (); } + + bool is_aliminclude (void) const + { return get_properties ().is_aliminclude (); } + + bool is_handle_visible (void) const + { return get_properties ().is_handle_visible (); } + + graphics_toolkit get_toolkit (void) const { return rep->get_toolkit (); } + + void add_property_listener (const std::string& nm, const octave_value& v, + listener_mode mode = POSTSET) + { rep->add_property_listener (nm, v, mode); } + + void delete_property_listener (const std::string& nm, const octave_value& v, + listener_mode mode = POSTSET) + { rep->delete_property_listener (nm, v, mode); } + + void initialize (void) { rep->initialize (*this); } + + void finalize (void) { rep->finalize (*this); } + + void update (int id) { rep->update (*this, id); } + + void reset_default_properties (void) + { rep->reset_default_properties (); } + +private: + base_graphics_object *rep; +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API root_figure : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + void remove_child (const graphics_handle& h); + + Matrix get_boundingbox (bool internal = false, + const Matrix& parent_pix_size = Matrix ()) const; + + // See the genprops.awk script for an explanation of the + // properties declarations. + + // FIXME -- it seems strange to me that the diary, diaryfile, + // echo, format, formatspacing, language, and recursionlimit + // properties are here. WTF do they have to do with graphics? + // Also note that these properties (and the monitorpositions, + // pointerlocation, and pointerwindow properties) are not yet used + // by Octave, so setting them will have no effect, and changes + // made elswhere (say, the diary or format functions) will not + // cause these properties to be updated. + + BEGIN_PROPERTIES (root_figure, root) + handle_property callbackobject Sr , graphics_handle () + array_property commandwindowsize r , Matrix (1, 2, 0) + handle_property currentfigure S , graphics_handle () + bool_property diary , "off" + string_property diaryfile , "diary" + bool_property echo , "off" + radio_property format , "+|bank|bit|debug|hex|long|longe|longeng|longg|native-bit|native-hex|rational|{short}|shorte|shorteng|shortg" + radio_property formatspacing , "{loose}|compact" + string_property language , "ascii" + array_property monitorpositions , Matrix (1, 4, 0) + array_property pointerlocation , Matrix (1, 2, 0) + double_property pointerwindow , 0.0 + double_property recursionlimit , 256.0 + double_property screendepth r , default_screendepth () + double_property screenpixelsperinch r , default_screenpixelsperinch () + array_property screensize r , default_screensize () + bool_property showhiddenhandles , "off" + radio_property units U , "inches|centimeters|normalized|points|{pixels}" + END_PROPERTIES + + private: + std::list cbo_stack; + }; + +private: + properties xproperties; + +public: + + root_figure (void) : xproperties (0, graphics_handle ()), default_properties () { } + + ~root_figure (void) { } + + void mark_modified (void) { } + + void override_defaults (base_graphics_object& obj) + { + // Now override with our defaults. If the default_properties + // list includes the properties for all defaults (line, + // surface, etc.) then we don't have to know the type of OBJ + // here, we just call its set function and let it decide which + // properties from the list to use. + obj.set_from_list (default_properties); + } + + void set (const caseless_str& name, const octave_value& value) + { + if (name.compare ("default", 7)) + // strip "default", pass rest to function that will + // parse the remainder and add the element to the + // default_properties map. + default_properties.set (name.substr (7), value); + else + xproperties.set (name, value); + } + + octave_value get (const caseless_str& name) const + { + octave_value retval; + + if (name.compare ("default", 7)) + return get_default (name.substr (7)); + else if (name.compare ("factory", 7)) + return get_factory_default (name.substr (7)); + else + retval = xproperties.get (name); + + return retval; + } + + octave_value get_default (const caseless_str& name) const + { + octave_value retval = default_properties.lookup (name); + + if (retval.is_undefined ()) + { + // no default property found, use factory default + retval = factory_properties.lookup (name); + + if (retval.is_undefined ()) + error ("get: invalid default property '%s'", name.c_str ()); + } + + return retval; + } + + octave_value get_factory_default (const caseless_str& name) const + { + octave_value retval = factory_properties.lookup (name); + + if (retval.is_undefined ()) + error ("get: invalid factory default property '%s'", name.c_str ()); + + return retval; + } + + octave_value get_defaults (void) const + { + return default_properties.as_struct ("default"); + } + + octave_value get_factory_defaults (void) const + { + return factory_properties.as_struct ("factory"); + } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + + void reset_default_properties (void); + +private: + property_list default_properties; + + static property_list factory_properties; + + static property_list::plist_map_type init_factory_properties (void); +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API figure : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + void init_integerhandle (const octave_value& val) + { + integerhandle = val; + } + + void remove_child (const graphics_handle& h); + + void set_visible (const octave_value& val); + + graphics_toolkit get_toolkit (void) const + { + if (! toolkit) + toolkit = gtk_manager::get_toolkit (); + + return toolkit; + } + + void set_toolkit (const graphics_toolkit& b); + + void set___graphics_toolkit__ (const octave_value& val) + { + if (! error_state) + { + if (val.is_string ()) + { + std::string nm = val.string_value (); + graphics_toolkit b = gtk_manager::find_toolkit (nm); + if (b.get_name () != nm) + { + error ("set___graphics_toolkit__: invalid graphics toolkit"); + } + else + { + set_toolkit (b); + mark_modified (); + } + } + else + error ("set___graphics_toolkit__ must be a string"); + } + } + + void set_position (const octave_value& val, + bool do_notify_toolkit = true); + + void set_outerposition (const octave_value& val, + bool do_notify_toolkit = true); + + Matrix get_boundingbox (bool internal = false, + const Matrix& parent_pix_size = Matrix ()) const; + + void set_boundingbox (const Matrix& bb, bool internal = false, + bool do_notify_toolkit = true); + + Matrix map_from_boundingbox (double x, double y) const; + + Matrix map_to_boundingbox (double x, double y) const; + + void update_units (const caseless_str& old_units); + + void update_paperunits (const caseless_str& old_paperunits); + + std::string get_title (void) const; + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (figure) + any_property __plot_stream__ h , Matrix () + bool_property __enhanced__ h , "on" + radio_property nextplot , "new|{add}|replacechildren|replace" + callback_property closerequestfcn , "closereq" + handle_property currentaxes S , graphics_handle () + array_property colormap , jet_colormap () + radio_property paperorientation U , "{portrait}|landscape|rotated" + color_property color , color_property (color_values (1, 1, 1), radio_values ("none")) + array_property alphamap , Matrix (64, 1, 1) + string_property currentcharacter r , "" + handle_property currentobject r , graphics_handle () + array_property currentpoint r , Matrix (2, 1, 0) + bool_property dockcontrols , "off" + bool_property doublebuffer , "on" + string_property filename , "" + bool_property integerhandle S , "on" + bool_property inverthardcopy , "off" + callback_property keypressfcn , Matrix () + callback_property keyreleasefcn , Matrix () + radio_property menubar , "none|{figure}" + double_property mincolormap , 64 + string_property name , "" + bool_property numbertitle , "on" + array_property outerposition s , Matrix (1, 4, -1.0) + radio_property paperunits Su , "{inches}|centimeters|normalized|points" + array_property paperposition , default_figure_paperposition () + radio_property paperpositionmode , "auto|{manual}" + array_property papersize U , default_figure_papersize () + radio_property papertype SU , "{usletter}|uslegal|a0|a1|a2|a3|a4|a5|b0|b1|b2|b3|b4|b5|arch-a|arch-b|arch-c|arch-d|arch-e|a|b|c|d|e|tabloid|" + radio_property pointer , "crosshair|fullcrosshair|{arrow}|ibeam|watch|topl|topr|botl|botr|left|top|right|bottom|circle|cross|fleur|custom|hand" + array_property pointershapecdata , Matrix (16, 16, 0) + array_property pointershapehotspot , Matrix (1, 2, 0) + array_property position s , default_figure_position () + radio_property renderer , "{painters}|zbuffer|opengl|none" + radio_property renderermode , "{auto}|manual" + bool_property resize , "on" + callback_property resizefcn , Matrix () + radio_property selectiontype , "{normal}|open|alt|extend" + radio_property toolbar , "none|{auto}|figure" + radio_property units Su , "inches|centimeters|normalized|points|{pixels}|characters" + callback_property windowbuttondownfcn , Matrix () + callback_property windowbuttonmotionfcn , Matrix () + callback_property windowbuttonupfcn , Matrix () + callback_property windowbuttonwheelfcn , Matrix () + radio_property windowstyle , "{normal}|modal|docked" + string_property wvisual , "" + radio_property wvisualmode , "{auto}|manual" + string_property xdisplay , "" + string_property xvisual , "" + radio_property xvisualmode , "{auto}|manual" + callback_property buttondownfcn , Matrix () + string_property __graphics_toolkit__ s , "gnuplot" + any_property __guidata__ h , Matrix () + END_PROPERTIES + + protected: + void init (void) + { + colormap.add_constraint (dim_vector (-1, 3)); + alphamap.add_constraint (dim_vector (-1, 1)); + paperposition.add_constraint (dim_vector (1, 4)); + pointershapecdata.add_constraint (dim_vector (16, 16)); + pointershapehotspot.add_constraint (dim_vector (1, 2)); + position.add_constraint (dim_vector (1, 4)); + outerposition.add_constraint (dim_vector (1, 4)); + } + + private: + mutable graphics_toolkit toolkit; + }; + +private: + properties xproperties; + +public: + figure (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p), default_properties () + { + xproperties.override_defaults (*this); + } + + ~figure (void) { } + + void override_defaults (base_graphics_object& obj) + { + // Allow parent (root figure) to override first (properties knows how + // to find the parent object). + xproperties.override_defaults (obj); + + // Now override with our defaults. If the default_properties + // list includes the properties for all defaults (line, + // surface, etc.) then we don't have to know the type of OBJ + // here, we just call its set function and let it decide which + // properties from the list to use. + obj.set_from_list (default_properties); + } + + void set (const caseless_str& name, const octave_value& value) + { + if (name.compare ("default", 7)) + // strip "default", pass rest to function that will + // parse the remainder and add the element to the + // default_properties map. + default_properties.set (name.substr (7), value); + else + xproperties.set (name, value); + } + + octave_value get (const caseless_str& name) const + { + octave_value retval; + + if (name.compare ("default", 7)) + retval = get_default (name.substr (7)); + else + retval = xproperties.get (name); + + return retval; + } + + octave_value get_default (const caseless_str& name) const; + + octave_value get_defaults (void) const + { + return default_properties.as_struct ("default"); + } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + + void reset_default_properties (void); + +private: + property_list default_properties; +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API graphics_xform +{ +public: + graphics_xform (void) + : xform (xform_eye ()), xform_inv (xform_eye ()), + sx ("linear"), sy ("linear"), sz ("linear"), zlim (1, 2, 0.0) + { + zlim(1) = 1.0; + } + + graphics_xform (const Matrix& xm, const Matrix& xim, + const scaler& x, const scaler& y, const scaler& z, + const Matrix& zl) + : xform (xm), xform_inv (xim), sx (x), sy (y), sz (z), zlim (zl) { } + + graphics_xform (const graphics_xform& g) + : xform (g.xform), xform_inv (g.xform_inv), sx (g.sx), + sy (g.sy), sz (g.sz), zlim (g.zlim) { } + + ~graphics_xform (void) { } + + graphics_xform& operator = (const graphics_xform& g) + { + xform = g.xform; + xform_inv = g.xform_inv; + sx = g.sx; + sy = g.sy; + sz = g.sz; + zlim = g.zlim; + + return *this; + } + + static ColumnVector xform_vector (double x, double y, double z); + + static Matrix xform_eye (void); + + ColumnVector transform (double x, double y, double z, + bool use_scale = true) const; + + ColumnVector untransform (double x, double y, double z, + bool use_scale = true) const; + + ColumnVector untransform (double x, double y, bool use_scale = true) const + { return untransform (x, y, (zlim(0)+zlim(1))/2, use_scale); } + + Matrix xscale (const Matrix& m) const { return sx.scale (m); } + Matrix yscale (const Matrix& m) const { return sy.scale (m); } + Matrix zscale (const Matrix& m) const { return sz.scale (m); } + + Matrix scale (const Matrix& m) const + { + bool has_z = (m.columns () > 2); + + if (sx.is_linear () && sy.is_linear () + && (! has_z || sz.is_linear ())) + return m; + + Matrix retval (m.dims ()); + + int r = m.rows (); + + for (int i = 0; i < r; i++) + { + retval(i,0) = sx.scale (m(i,0)); + retval(i,1) = sy.scale (m(i,1)); + if (has_z) + retval(i,2) = sz.scale (m(i,2)); + } + + return retval; + } + +private: + Matrix xform; + Matrix xform_inv; + scaler sx, sy, sz; + Matrix zlim; +}; + +enum { + AXE_ANY_DIR = 0, + AXE_DEPTH_DIR = 1, + AXE_HORZ_DIR = 2, + AXE_VERT_DIR = 3 +}; + +class OCTINTERP_API axes : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + void set_defaults (base_graphics_object& obj, const std::string& mode); + + void remove_child (const graphics_handle& h); + + const scaler& get_x_scaler (void) const { return sx; } + const scaler& get_y_scaler (void) const { return sy; } + const scaler& get_z_scaler (void) const { return sz; } + + Matrix get_boundingbox (bool internal = false, + const Matrix& parent_pix_size = Matrix ()) const; + Matrix get_extent (bool with_text = false, bool only_text_height=false) const; + + double get_fontsize_points (double box_pix_height = 0) const; + + void update_boundingbox (void) + { + if (units_is ("normalized")) + { + sync_positions (); + base_properties::update_boundingbox (); + } + } + + void update_camera (void); + void update_axes_layout (void); + void update_aspectratios (void); + void update_transform (void) + { + update_aspectratios (); + update_camera (); + update_axes_layout (); + } + + void update_autopos (const std::string& elem_type); + void update_xlabel_position (void); + void update_ylabel_position (void); + void update_zlabel_position (void); + void update_title_position (void); + + graphics_xform get_transform (void) const + { return graphics_xform (x_render, x_render_inv, sx, sy, sz, x_zlim); } + + Matrix get_transform_matrix (void) const { return x_render; } + Matrix get_inverse_transform_matrix (void) const { return x_render_inv; } + Matrix get_opengl_matrix_1 (void) const { return x_gl_mat1; } + Matrix get_opengl_matrix_2 (void) const { return x_gl_mat2; } + Matrix get_transform_zlim (void) const { return x_zlim; } + + int get_xstate (void) const { return xstate; } + int get_ystate (void) const { return ystate; } + int get_zstate (void) const { return zstate; } + double get_xPlane (void) const { return xPlane; } + double get_xPlaneN (void) const { return xPlaneN; } + double get_yPlane (void) const { return yPlane; } + double get_yPlaneN (void) const { return yPlaneN; } + double get_zPlane (void) const { return zPlane; } + double get_zPlaneN (void) const { return zPlaneN; } + double get_xpTick (void) const { return xpTick; } + double get_xpTickN (void) const { return xpTickN; } + double get_ypTick (void) const { return ypTick; } + double get_ypTickN (void) const { return ypTickN; } + double get_zpTick (void) const { return zpTick; } + double get_zpTickN (void) const { return zpTickN; } + double get_x_min (void) const { return std::min (xPlane, xPlaneN); } + double get_x_max (void) const { return std::max (xPlane, xPlaneN); } + double get_y_min (void) const { return std::min (yPlane, yPlaneN); } + double get_y_max (void) const { return std::max (yPlane, yPlaneN); } + double get_z_min (void) const { return std::min (zPlane, zPlaneN); } + double get_z_max (void) const { return std::max (zPlane, zPlaneN); } + double get_fx (void) const { return fx; } + double get_fy (void) const { return fy; } + double get_fz (void) const { return fz; } + double get_xticklen (void) const { return xticklen; } + double get_yticklen (void) const { return yticklen; } + double get_zticklen (void) const { return zticklen; } + double get_xtickoffset (void) const { return xtickoffset; } + double get_ytickoffset (void) const { return ytickoffset; } + double get_ztickoffset (void) const { return ztickoffset; } + bool get_x2Dtop (void) const { return x2Dtop; } + bool get_y2Dright (void) const { return y2Dright; } + bool get_layer2Dtop (void) const { return layer2Dtop; } + bool get_xySym (void) const { return xySym; } + bool get_xyzSym (void) const { return xyzSym; } + bool get_zSign (void) const { return zSign; } + bool get_nearhoriz (void) const { return nearhoriz; } + + ColumnVector pixel2coord (double px, double py) const + { return get_transform ().untransform (px, py, (x_zlim(0)+x_zlim(1))/2); } + + ColumnVector coord2pixel (double x, double y, double z) const + { return get_transform ().transform (x, y, z); } + + void zoom_about_point (double x, double y, double factor, + bool push_to_zoom_stack = true); + void zoom (const Matrix& xl, const Matrix& yl, bool push_to_zoom_stack = true); + void translate_view (double x0, double x1, double y0, double y1); + void rotate_view (double delta_az, double delta_el); + void unzoom (void); + void clear_zoom_stack (void); + + void update_units (const caseless_str& old_units); + + void update_fontunits (const caseless_str& old_fontunits); + + private: + scaler sx, sy, sz; + Matrix x_render, x_render_inv; + Matrix x_gl_mat1, x_gl_mat2; + Matrix x_zlim; + std::list zoom_stack; + + // Axes layout data + int xstate, ystate, zstate; + double xPlane, xPlaneN, yPlane, yPlaneN, zPlane, zPlaneN; + double xpTick, xpTickN, ypTick, ypTickN, zpTick, zpTickN; + double fx, fy, fz; + double xticklen, yticklen, zticklen; + double xtickoffset, ytickoffset, ztickoffset; + bool x2Dtop, y2Dright, layer2Dtop; + bool xySym, xyzSym, zSign, nearhoriz; + +#if HAVE_FREETYPE + // freetype renderer, used for calculation of text (tick labels) size + ft_render text_renderer; +#endif + + void set_text_child (handle_property& h, const std::string& who, + const octave_value& v); + + void delete_text_child (handle_property& h); + + // See the genprops.awk script for an explanation of the + // properties declarations. + + // properties which are not in matlab: interpreter + + BEGIN_PROPERTIES (axes) + array_property position u , default_axes_position () + bool_property box , "on" + array_property colororder , default_colororder () + array_property dataaspectratio mu , Matrix (1, 3, 1.0) + radio_property dataaspectratiomode u , "{auto}|manual" + radio_property layer u , "{bottom}|top" + row_vector_property xlim mu , default_lim () + row_vector_property ylim mu , default_lim () + row_vector_property zlim mu , default_lim () + row_vector_property clim m , default_lim () + row_vector_property alim m , default_lim () + radio_property xlimmode al , "{auto}|manual" + radio_property ylimmode al , "{auto}|manual" + radio_property zlimmode al , "{auto}|manual" + radio_property climmode al , "{auto}|manual" + radio_property alimmode , "{auto}|manual" + handle_property xlabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) + handle_property ylabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) + handle_property zlabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) + handle_property title SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) + bool_property xgrid , "off" + bool_property ygrid , "off" + bool_property zgrid , "off" + bool_property xminorgrid , "off" + bool_property yminorgrid , "off" + bool_property zminorgrid , "off" + row_vector_property xtick mu , default_axes_tick () + row_vector_property ytick mu , default_axes_tick () + row_vector_property ztick mu , default_axes_tick () + radio_property xtickmode u , "{auto}|manual" + radio_property ytickmode u , "{auto}|manual" + radio_property ztickmode u , "{auto}|manual" + bool_property xminortick , "off" + bool_property yminortick , "off" + bool_property zminortick , "off" + // FIXME -- should be kind of string array. + any_property xticklabel S , "" + any_property yticklabel S , "" + any_property zticklabel S , "" + radio_property xticklabelmode u , "{auto}|manual" + radio_property yticklabelmode u , "{auto}|manual" + radio_property zticklabelmode u , "{auto}|manual" + radio_property interpreter , "tex|{none}|latex" + color_property color , color_property (color_values (1, 1, 1), radio_values ("none")) + color_property xcolor , color_values (0, 0, 0) + color_property ycolor , color_values (0, 0, 0) + color_property zcolor , color_values (0, 0, 0) + radio_property xscale alu , "{linear}|log" + radio_property yscale alu , "{linear}|log" + radio_property zscale alu , "{linear}|log" + radio_property xdir u , "{normal}|reverse" + radio_property ydir u , "{normal}|reverse" + radio_property zdir u , "{normal}|reverse" + radio_property yaxislocation u , "{left}|right|zero" + radio_property xaxislocation u , "{bottom}|top|zero" + array_property view u , Matrix () + bool_property __hold_all__ h , "off" + radio_property nextplot , "new|add|replacechildren|{replace}" + array_property outerposition u , default_axes_outerposition () + radio_property activepositionproperty , "{outerposition}|position" + color_property ambientlightcolor , color_values (1, 1, 1) + array_property cameraposition m , Matrix (1, 3, 0.0) + array_property cameratarget m , Matrix (1, 3, 0.0) + array_property cameraupvector m , Matrix () + double_property cameraviewangle m , 10.0 + radio_property camerapositionmode , "{auto}|manual" + radio_property cameratargetmode , "{auto}|manual" + radio_property cameraupvectormode , "{auto}|manual" + radio_property cameraviewanglemode , "{auto}|manual" + array_property currentpoint , Matrix (2, 3, 0.0) + radio_property drawmode , "{normal}|fast" + radio_property fontangle u , "{normal}|italic|oblique" + string_property fontname u , OCTAVE_DEFAULT_FONTNAME + double_property fontsize u , 10 + radio_property fontunits SU , "{points}|normalized|inches|centimeters|pixels" + radio_property fontweight u , "{normal}|light|demi|bold" + radio_property gridlinestyle , "-|--|{:}|-.|none" + string_array_property linestyleorder , "-" + double_property linewidth , 0.5 + radio_property minorgridlinestyle , "-|--|{:}|-.|none" + array_property plotboxaspectratio mu , Matrix (1, 3, 1.0) + radio_property plotboxaspectratiomode u , "{auto}|manual" + radio_property projection , "{orthographic}|perpective" + radio_property tickdir mu , "{in}|out" + radio_property tickdirmode u , "{auto}|manual" + array_property ticklength u , default_axes_ticklength () + array_property tightinset r , Matrix (1, 4, 0.0) + // FIXME -- uicontextmenu should be moved here. + radio_property units SU , "{normalized}|inches|centimeters|points|pixels|characters" + // hidden properties for transformation computation + array_property x_viewtransform h , Matrix (4, 4, 0.0) + array_property x_projectiontransform h , Matrix (4, 4, 0.0) + array_property x_viewporttransform h , Matrix (4, 4, 0.0) + array_property x_normrendertransform h , Matrix (4, 4, 0.0) + array_property x_rendertransform h , Matrix (4, 4, 0.0) + // hidden properties for minor ticks + row_vector_property xmtick h , Matrix () + row_vector_property ymtick h , Matrix () + row_vector_property zmtick h , Matrix () + // hidden properties for inset + array_property looseinset hu , Matrix (1, 4, 0.0) + // hidden properties for alignment of subplots + radio_property autopos_tag h , "{none}|subplot" + END_PROPERTIES + + protected: + void init (void); + + private: + + std::string + get_scale (const std::string& scale, const Matrix& lims) + { + std::string retval = scale; + + if (scale == "log" && lims.numel () > 1 && lims(0) < 0 && lims(1) < 0) + retval = "neglog"; + + return retval; + } + + void update_xscale (void) + { + sx = get_scale (get_xscale (), xlim.get ().matrix_value ()); + } + + void update_yscale (void) + { + sy = get_scale (get_yscale (), ylim.get ().matrix_value ()); + } + + void update_zscale (void) + { + sz = get_scale (get_zscale (), zlim.get ().matrix_value ()); + } + + void update_view (void) { sync_positions (); } + void update_dataaspectratio (void) { sync_positions (); } + void update_dataaspectratiomode (void) { sync_positions (); } + void update_plotboxaspectratio (void) { sync_positions (); } + void update_plotboxaspectratiomode (void) { sync_positions (); } + + void update_layer (void) { update_axes_layout (); } + void update_yaxislocation (void) + { + update_axes_layout (); + update_ylabel_position (); + } + void update_xaxislocation (void) + { + update_axes_layout (); + update_xlabel_position (); + } + + void update_xdir (void) { update_camera (); update_axes_layout (); } + void update_ydir (void) { update_camera (); update_axes_layout (); } + void update_zdir (void) { update_camera (); update_axes_layout (); } + + void update_ticklength (void); + void update_tickdir (void) { update_ticklength (); } + void update_tickdirmode (void) { update_ticklength (); } + + void update_xtick (void) + { + if (xticklabelmode.is ("auto")) + calc_ticklabels (xtick, xticklabel, xscale.is ("log")); + } + void update_ytick (void) + { + if (yticklabelmode.is ("auto")) + calc_ticklabels (ytick, yticklabel, yscale.is ("log")); + } + void update_ztick (void) + { + if (zticklabelmode.is ("auto")) + calc_ticklabels (ztick, zticklabel, zscale.is ("log")); + } + + void update_xtickmode (void) + { + if (xtickmode.is ("auto")) + { + calc_ticks_and_lims (xlim, xtick, xmtick, xlimmode.is ("auto"), xscale.is ("log")); + update_xtick (); + } + } + void update_ytickmode (void) + { + if (ytickmode.is ("auto")) + { + calc_ticks_and_lims (ylim, ytick, ymtick, ylimmode.is ("auto"), yscale.is ("log")); + update_ytick (); + } + } + void update_ztickmode (void) + { + if (ztickmode.is ("auto")) + { + calc_ticks_and_lims (zlim, ztick, zmtick, zlimmode.is ("auto"), zscale.is ("log")); + update_ztick (); + } + } + + void update_xticklabelmode (void) + { + if (xticklabelmode.is ("auto")) + calc_ticklabels (xtick, xticklabel, xscale.is ("log")); + } + void update_yticklabelmode (void) + { + if (yticklabelmode.is ("auto")) + calc_ticklabels (ytick, yticklabel, yscale.is ("log")); + } + void update_zticklabelmode (void) + { + if (zticklabelmode.is ("auto")) + calc_ticklabels (ztick, zticklabel, zscale.is ("log")); + } + + void update_font (void); + void update_fontname (void) { update_font (); } + void update_fontsize (void) { update_font (); } + void update_fontangle (void) { update_font (); } + void update_fontweight (void) { update_font (); } + + void sync_positions (const Matrix& linset); + void sync_positions (void); + + void update_insets (void); + + void update_outerposition (void) + { + set_activepositionproperty ("outerposition"); + sync_positions (); + } + + void update_position (void) + { + set_activepositionproperty ("position"); + sync_positions (); + } + + void update_looseinset (void) { sync_positions (); } + + double calc_tick_sep (double minval, double maxval); + void calc_ticks_and_lims (array_property& lims, array_property& ticks, array_property& mticks, + bool limmode_is_auto, bool is_logscale); + void calc_ticklabels (const array_property& ticks, any_property& labels, bool is_logscale); + Matrix get_ticklabel_extents (const Matrix& ticks, + const string_vector& ticklabels, + const Matrix& limits); + + void fix_limits (array_property& lims) + { + if (lims.get ().is_empty ()) + return; + + Matrix l = lims.get ().matrix_value (); + if (l(0) > l(1)) + { + l(0) = 0; + l(1) = 1; + lims = l; + } + else if (l(0) == l(1)) + { + l(0) -= 0.5; + l(1) += 0.5; + lims = l; + } + } + + Matrix calc_tightbox (const Matrix& init_pos); + + public: + Matrix get_axis_limits (double xmin, double xmax, + double min_pos, double max_neg, + bool logscale); + + void update_xlim (bool do_clr_zoom = true) + { + if (xtickmode.is ("auto")) + calc_ticks_and_lims (xlim, xtick, xmtick, xlimmode.is ("auto"), xscale.is ("log")); + if (xticklabelmode.is ("auto")) + calc_ticklabels (xtick, xticklabel, xscale.is ("log")); + + fix_limits (xlim); + + update_xscale (); + + if (do_clr_zoom) + zoom_stack.clear (); + + update_axes_layout (); + } + + void update_ylim (bool do_clr_zoom = true) + { + if (ytickmode.is ("auto")) + calc_ticks_and_lims (ylim, ytick, ymtick, ylimmode.is ("auto"), yscale.is ("log")); + if (yticklabelmode.is ("auto")) + calc_ticklabels (ytick, yticklabel, yscale.is ("log")); + + fix_limits (ylim); + + update_yscale (); + + if (do_clr_zoom) + zoom_stack.clear (); + + update_axes_layout (); + } + + void update_zlim (void) + { + if (ztickmode.is ("auto")) + calc_ticks_and_lims (zlim, ztick, zmtick, zlimmode.is ("auto"), zscale.is ("log")); + if (zticklabelmode.is ("auto")) + calc_ticklabels (ztick, zticklabel, zscale.is ("log")); + + fix_limits (zlim); + + update_zscale (); + + zoom_stack.clear (); + + update_axes_layout (); + } + + }; + +private: + properties xproperties; + +public: + axes (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p), default_properties () + { + xproperties.override_defaults (*this); + xproperties.update_transform (); + } + + ~axes (void) { } + + void override_defaults (base_graphics_object& obj) + { + // Allow parent (figure) to override first (properties knows how + // to find the parent object). + xproperties.override_defaults (obj); + + // Now override with our defaults. If the default_properties + // list includes the properties for all defaults (line, + // surface, etc.) then we don't have to know the type of OBJ + // here, we just call its set function and let it decide which + // properties from the list to use. + obj.set_from_list (default_properties); + } + + void set (const caseless_str& name, const octave_value& value) + { + if (name.compare ("default", 7)) + // strip "default", pass rest to function that will + // parse the remainder and add the element to the + // default_properties map. + default_properties.set (name.substr (7), value); + else + xproperties.set (name, value); + } + + void set_defaults (const std::string& mode) + { + remove_all_listeners (); + xproperties.set_defaults (*this, mode); + } + + octave_value get (const caseless_str& name) const + { + octave_value retval; + + // FIXME -- finish this. + if (name.compare ("default", 7)) + retval = get_default (name.substr (7)); + else + retval = xproperties.get (name); + + return retval; + } + + octave_value get_default (const caseless_str& name) const; + + octave_value get_defaults (void) const + { + return default_properties.as_struct ("default"); + } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + void update_axis_limits (const std::string& axis_type); + + void update_axis_limits (const std::string& axis_type, + const graphics_handle& h); + + bool valid_object (void) const { return true; } + + void reset_default_properties (void); + +protected: + void initialize (const graphics_object& go); + +private: + property_list default_properties; +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API line : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + // See the genprops.awk script for an explanation of the + // properties declarations. + + // properties which are not in matlab: interpreter + + BEGIN_PROPERTIES (line) + row_vector_property xdata u , default_data () + row_vector_property ydata u , default_data () + row_vector_property zdata u , Matrix () + string_property xdatasource , "" + string_property ydatasource , "" + string_property zdatasource , "" + color_property color , color_values (0, 0, 0) + radio_property linestyle , "{-}|--|:|-.|none" + double_property linewidth , 0.5 + radio_property marker , "{none}|s|o|x|+|.|*|<|>|v|^|d|p|h|@" + color_property markeredgecolor , "{auto}|none" + color_property markerfacecolor , "auto|{none}" + double_property markersize , 6 + radio_property interpreter , "{tex}|none|latex" + string_property displayname , "" + radio_property erasemode , "{normal}|none|xor|background" + // hidden properties for limit computation + row_vector_property xlim hlr , Matrix () + row_vector_property ylim hlr , Matrix () + row_vector_property zlim hlr , Matrix () + bool_property xliminclude hl , "on" + bool_property yliminclude hl , "on" + bool_property zliminclude hl , "off" + END_PROPERTIES + + private: + Matrix compute_xlim (void) const; + Matrix compute_ylim (void) const; + + void update_xdata (void) { set_xlim (compute_xlim ()); } + + void update_ydata (void) { set_ylim (compute_ylim ()); } + + void update_zdata (void) + { + set_zlim (zdata.get_limits ()); + set_zliminclude (get_zdata ().numel () > 0); + } + }; + +private: + properties xproperties; + +public: + line (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~line (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API text : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + double get_fontsize_points (double box_pix_height = 0) const; + + void set_position (const octave_value& val) + { + if (! error_state) + { + octave_value new_val (val); + + if (new_val.numel () == 2) + { + dim_vector dv (1, 3); + + new_val = new_val.resize (dv, true); + } + + if (position.set (new_val, false)) + { + set_positionmode ("manual"); + update_position (); + position.run_listeners (POSTSET); + mark_modified (); + } + else + set_positionmode ("manual"); + } + } + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (text) + text_label_property string u , "" + radio_property units u , "{data}|pixels|normalized|inches|centimeters|points" + array_property position smu , Matrix (1, 3, 0.0) + double_property rotation mu , 0 + radio_property horizontalalignment mu , "{left}|center|right" + color_property color u , color_values (0, 0, 0) + string_property fontname u , OCTAVE_DEFAULT_FONTNAME + double_property fontsize u , 10 + radio_property fontangle u , "{normal}|italic|oblique" + radio_property fontweight u , "light|{normal}|demi|bold" + radio_property interpreter u , "{tex}|none|latex" + color_property backgroundcolor , "{none}" + string_property displayname , "" + color_property edgecolor , "{none}" + radio_property erasemode , "{normal}|none|xor|background" + bool_property editing , "off" + radio_property fontunits , "inches|centimeters|normalized|{points}|pixels" + radio_property linestyle , "{-}|--|:|-.|none" + double_property linewidth , 0.5 + double_property margin , 1 + radio_property verticalalignment mu , "top|cap|{middle}|baseline|bottom" + array_property extent rG , Matrix (1, 4, 0.0) + // hidden properties for limit computation + row_vector_property xlim hlr , Matrix () + row_vector_property ylim hlr , Matrix () + row_vector_property zlim hlr , Matrix () + bool_property xliminclude hl , "off" + bool_property yliminclude hl , "off" + bool_property zliminclude hl , "off" + // hidden properties for auto-positioning + radio_property positionmode hu , "{auto}|manual" + radio_property rotationmode hu , "{auto}|manual" + radio_property horizontalalignmentmode hu , "{auto}|manual" + radio_property verticalalignmentmode hu , "{auto}|manual" + radio_property autopos_tag h , "{none}|xlabel|ylabel|zlabel|title" + END_PROPERTIES + + Matrix get_data_position (void) const; + Matrix get_extent_matrix (void) const; + const uint8NDArray& get_pixels (void) const { return pixels; } +#if HAVE_FREETYPE + // freetype renderer, used for calculation of text size + ft_render renderer; +#endif + + protected: + void init (void) + { + position.add_constraint (dim_vector (1, 3)); + cached_units = get_units (); + update_font (); + } + + private: + void update_position (void) + { + Matrix pos = get_data_position (); + Matrix lim; + + lim = Matrix (1, 3, pos(0)); + lim(2) = (lim(2) <= 0 ? octave_Inf : lim(2)); + set_xlim (lim); + + lim = Matrix (1, 3, pos(1)); + lim(2) = (lim(2) <= 0 ? octave_Inf : lim(2)); + set_ylim (lim); + + if (pos.numel () == 3) + { + lim = Matrix (1, 3, pos(2)); + lim(2) = (lim(2) <= 0 ? octave_Inf : lim(2)); + set_zliminclude ("on"); + set_zlim (lim); + } + else + set_zliminclude ("off"); + } + + void update_text_extent (void); + + void request_autopos (void); + void update_positionmode (void) { request_autopos (); } + void update_rotationmode (void) { request_autopos (); } + void update_horizontalalignmentmode (void) { request_autopos (); } + void update_verticalalignmentmode (void) { request_autopos (); } + + void update_font (void); + void update_string (void) { request_autopos (); update_text_extent (); } + void update_rotation (void) { update_text_extent (); } + void update_color (void) { update_font (); update_text_extent (); } + void update_fontname (void) { update_font (); update_text_extent (); } + void update_fontsize (void) { update_font (); update_text_extent (); } + void update_fontangle (void) { update_font (); update_text_extent (); } + void update_fontweight (void) { update_font (); update_text_extent (); } + void update_interpreter (void) { update_text_extent (); } + void update_horizontalalignment (void) { update_text_extent (); } + void update_verticalalignment (void) { update_text_extent (); } + + void update_units (void); + + private: + std::string cached_units; + uint8NDArray pixels; + }; + +private: + properties xproperties; + +public: + text (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.set_clipping ("off"); + xproperties.override_defaults (*this); + } + + ~text (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API image : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + bool is_climinclude (void) const + { return (climinclude.is_on () && cdatamapping.is ("scaled")); } + std::string get_climinclude (void) const + { return climinclude.current_value (); } + + octave_value get_color_data (void) const; + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (image) + row_vector_property xdata u , Matrix () + row_vector_property ydata u , Matrix () + array_property cdata u , Matrix () + radio_property cdatamapping al , "{scaled}|direct" + // hidden properties for limit computation + row_vector_property xlim hlr , Matrix () + row_vector_property ylim hlr , Matrix () + row_vector_property clim hlr , Matrix () + bool_property xliminclude hl , "on" + bool_property yliminclude hl , "on" + bool_property climinclude hlg , "on" + END_PROPERTIES + + protected: + void init (void) + { + xdata.add_constraint (2); + ydata.add_constraint (2); + cdata.add_constraint ("double"); + cdata.add_constraint ("single"); + cdata.add_constraint ("logical"); + cdata.add_constraint ("uint8"); + cdata.add_constraint ("uint16"); + cdata.add_constraint ("int16"); + cdata.add_constraint ("real"); + cdata.add_constraint (dim_vector (-1, -1)); + cdata.add_constraint (dim_vector (-1, -1, 3)); + } + + private: + void update_xdata (void) + { + Matrix limits = xdata.get_limits (); + float dp = pixel_xsize (); + + limits(0) = limits(0) - dp; + limits(1) = limits(1) + dp; + set_xlim (limits); + } + + void update_ydata (void) + { + Matrix limits = ydata.get_limits (); + float dp = pixel_ysize (); + + limits(0) = limits(0) - dp; + limits(1) = limits(1) + dp; + set_ylim (limits); + } + + void update_cdata (void) + { + if (cdatamapping_is ("scaled")) + set_clim (cdata.get_limits ()); + else + clim = cdata.get_limits (); + } + + float pixel_size (octave_idx_type dim, const Matrix limits) + { + octave_idx_type l = dim - 1; + float dp; + + if (l > 0 && limits(0) != limits(1)) + dp = (limits(1) - limits(0))/(2*l); + else + { + if (limits(1) == limits(2)) + dp = 0.5; + else + dp = (limits(1) - limits(0))/2; + } + return dp; + } + + public: + float pixel_xsize (void) + { + return pixel_size ((get_cdata ().dims ())(1), xdata.get_limits ()); + } + + float pixel_ysize (void) + { + return pixel_size ((get_cdata ().dims ())(0), ydata.get_limits ()); + } + }; + +private: + properties xproperties; + +public: + image (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~image (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API patch : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + octave_value get_color_data (void) const; + + bool is_climinclude (void) const + { return (climinclude.is_on () && cdatamapping.is ("scaled")); } + std::string get_climinclude (void) const + { return climinclude.current_value (); } + + bool is_aliminclude (void) const + { return (aliminclude.is_on () && alphadatamapping.is ("scaled")); } + std::string get_aliminclude (void) const + { return aliminclude.current_value (); } + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (patch) + array_property xdata u , Matrix () + array_property ydata u , Matrix () + array_property zdata u , Matrix () + array_property cdata u , Matrix () + radio_property cdatamapping l , "{scaled}|direct" + array_property faces , Matrix () + array_property facevertexalphadata , Matrix () + array_property facevertexcdata , Matrix () + array_property vertices , Matrix () + array_property vertexnormals , Matrix () + radio_property normalmode , "{auto}|manual" + color_property facecolor , color_property (color_values (0, 0, 0), radio_values ("flat|none|interp")) + double_radio_property facealpha , double_radio_property (1.0, radio_values ("flat|interp")) + radio_property facelighting , "flat|{none}|gouraud|phong" + color_property edgecolor , color_property (color_values (0, 0, 0), radio_values ("flat|none|interp")) + double_radio_property edgealpha , double_radio_property (1.0, radio_values ("flat|interp")) + radio_property edgelighting , "{none}|flat|gouraud|phong" + radio_property backfacelighting , "{reverselit}|unlit|lit" + double_property ambientstrength , 0.3 + double_property diffusestrength , 0.6 + double_property specularstrength , 0.6 + double_property specularexponent , 10.0 + double_property specularcolorreflectance , 1.0 + radio_property erasemode , "{normal}|background|xor|none" + radio_property linestyle , "{-}|--|:|-.|none" + double_property linewidth , 0.5 + radio_property marker , "{none}|s|o|x|+|.|*|<|>|v|^|d|p|h|@" + color_property markeredgecolor , "{auto}|none|flat" + color_property markerfacecolor , "auto|{none}|flat" + double_property markersize , 6 + radio_property interpreter , "{tex}|none|latex" + string_property displayname , "" + radio_property alphadatamapping l , "none|{scaled}|direct" + // hidden properties for limit computation + row_vector_property xlim hlr , Matrix () + row_vector_property ylim hlr , Matrix () + row_vector_property zlim hlr , Matrix () + row_vector_property clim hlr , Matrix () + row_vector_property alim hlr , Matrix () + bool_property xliminclude hl , "on" + bool_property yliminclude hl , "on" + bool_property zliminclude hl , "on" + bool_property climinclude hlg , "on" + bool_property aliminclude hlg , "on" + END_PROPERTIES + + protected: + void init (void) + { + xdata.add_constraint (dim_vector (-1, -1)); + ydata.add_constraint (dim_vector (-1, -1)); + zdata.add_constraint (dim_vector (-1, -1)); + vertices.add_constraint (dim_vector (-1, 2)); + vertices.add_constraint (dim_vector (-1, 3)); + cdata.add_constraint (dim_vector (-1, -1)); + cdata.add_constraint (dim_vector (-1, -1, 3)); + facevertexcdata.add_constraint (dim_vector (-1, 1)); + facevertexcdata.add_constraint (dim_vector (-1, 3)); + facevertexalphadata.add_constraint (dim_vector (-1, 1)); + } + + private: + void update_xdata (void) { set_xlim (xdata.get_limits ()); } + void update_ydata (void) { set_ylim (ydata.get_limits ()); } + void update_zdata (void) { set_zlim (zdata.get_limits ()); } + + void update_cdata (void) + { + if (cdatamapping_is ("scaled")) + set_clim (cdata.get_limits ()); + else + clim = cdata.get_limits (); + } + }; + +private: + properties xproperties; + +public: + patch (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~patch (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API surface : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + octave_value get_color_data (void) const; + + bool is_climinclude (void) const + { return (climinclude.is_on () && cdatamapping.is ("scaled")); } + std::string get_climinclude (void) const + { return climinclude.current_value (); } + + bool is_aliminclude (void) const + { return (aliminclude.is_on () && alphadatamapping.is ("scaled")); } + std::string get_aliminclude (void) const + { return aliminclude.current_value (); } + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (surface) + array_property xdata u , Matrix () + array_property ydata u , Matrix () + array_property zdata u , Matrix () + array_property cdata u , Matrix () + radio_property cdatamapping al , "{scaled}|direct" + string_property xdatasource , "" + string_property ydatasource , "" + string_property zdatasource , "" + string_property cdatasource , "" + color_property facecolor , "{flat}|none|interp|texturemap" + double_radio_property facealpha , double_radio_property (1.0, radio_values ("flat|interp")) + color_property edgecolor , color_property (color_values (0, 0, 0), radio_values ("flat|none|interp")) + radio_property linestyle , "{-}|--|:|-.|none" + double_property linewidth , 0.5 + radio_property marker , "{none}|s|o|x|+|.|*|<|>|v|^|d|p|h|@" + color_property markeredgecolor , "{auto}|none" + color_property markerfacecolor , "auto|{none}" + double_property markersize , 6 + radio_property interpreter , "{tex}|none|latex" + string_property displayname , "" + array_property alphadata u , Matrix () + radio_property alphadatamapping l , "none|direct|{scaled}" + double_property ambientstrength , 0.3 + radio_property backfacelighting , "unlit|lit|{reverselit}" + double_property diffusestrength , 0.6 + double_radio_property edgealpha , double_radio_property (1.0, radio_values ("flat|interp")) + radio_property edgelighting , "{none}|flat|gouraud|phong" + radio_property erasemode , "{normal}|none|xor|background" + radio_property facelighting , "{none}|flat|gouraud|phong" + radio_property meshstyle , "{both}|row|column" + radio_property normalmode u , "{auto}|manual" + double_property specularcolorreflectance , 1 + double_property specularexponent , 10 + double_property specularstrength , 0.9 + array_property vertexnormals u , Matrix () + // hidden properties for limit computation + row_vector_property xlim hlr , Matrix () + row_vector_property ylim hlr , Matrix () + row_vector_property zlim hlr , Matrix () + row_vector_property clim hlr , Matrix () + row_vector_property alim hlr , Matrix () + bool_property xliminclude hl , "on" + bool_property yliminclude hl , "on" + bool_property zliminclude hl , "on" + bool_property climinclude hlg , "on" + bool_property aliminclude hlg , "on" + END_PROPERTIES + + protected: + void init (void) + { + xdata.add_constraint (dim_vector (-1, -1)); + ydata.add_constraint (dim_vector (-1, -1)); + zdata.add_constraint (dim_vector (-1, -1)); + alphadata.add_constraint ("single"); + alphadata.add_constraint ("double"); + alphadata.add_constraint ("uint8"); + alphadata.add_constraint (dim_vector (-1, -1)); + vertexnormals.add_constraint (dim_vector (-1, -1, 3)); + cdata.add_constraint ("single"); + cdata.add_constraint ("double"); + cdata.add_constraint ("uint8"); + cdata.add_constraint (dim_vector (-1, -1)); + cdata.add_constraint (dim_vector (-1, -1, 3)); + } + + private: + void update_normals (void); + + void update_xdata (void) + { + update_normals (); + set_xlim (xdata.get_limits ()); + } + + void update_ydata (void) + { + update_normals (); + set_ylim (ydata.get_limits ()); + } + + void update_zdata (void) + { + update_normals (); + set_zlim (zdata.get_limits ()); + } + + void update_cdata (void) + { + if (cdatamapping_is ("scaled")) + set_clim (cdata.get_limits ()); + else + clim = cdata.get_limits (); + } + + void update_alphadata (void) + { + if (alphadatamapping_is ("scaled")) + set_alim (alphadata.get_limits ()); + else + alim = alphadata.get_limits (); + } + + void update_normalmode (void) + { update_normals (); } + + void update_vertexnormals (void) + { set_normalmode ("manual"); } + }; + +private: + properties xproperties; + +public: + surface (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~surface (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API hggroup : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + void remove_child (const graphics_handle& h) + { + base_properties::remove_child (h); + update_limits (); + } + + void adopt (const graphics_handle& h) + { + + base_properties::adopt (h); + update_limits (h); + } + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (hggroup) + string_property displayname , "" + radio_property erasemode , "{normal}|none|xor|background" + // hidden properties for limit computation + row_vector_property xlim hr , Matrix () + row_vector_property ylim hr , Matrix () + row_vector_property zlim hr , Matrix () + row_vector_property clim hr , Matrix () + row_vector_property alim hr , Matrix () + bool_property xliminclude h , "on" + bool_property yliminclude h , "on" + bool_property zliminclude h , "on" + bool_property climinclude h , "on" + bool_property aliminclude h , "on" + END_PROPERTIES + + private: + void update_limits (void) const; + + void update_limits (const graphics_handle& h) const; + + protected: + void init (void) + { } + + }; + +private: + properties xproperties; + +public: + hggroup (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~hggroup (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + + void update_axis_limits (const std::string& axis_type); + + void update_axis_limits (const std::string& axis_type, + const graphics_handle& h); + +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uimenu : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + void remove_child (const graphics_handle& h) + { + base_properties::remove_child (h); + } + + void adopt (const graphics_handle& h) + { + base_properties::adopt (h); + } + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uimenu) + any_property __object__ , Matrix () + string_property accelerator , "" + callback_property callback , Matrix () + bool_property checked , "off" + bool_property enable , "on" + color_property foregroundcolor , color_values (0, 0, 0) + string_property label , "" + double_property position , 9 + bool_property separator , "off" + string_property fltk_label h , "" + END_PROPERTIES + + protected: + void init (void) + { } + }; + +private: + properties xproperties; + +public: + uimenu (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uimenu (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uicontextmenu : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uicontextmenu) + any_property __object__ , Matrix () + callback_property callback , Matrix () + array_property position , Matrix (1, 2, 0.0) + END_PROPERTIES + + protected: + void init (void) + { + position.add_constraint (dim_vector (1, 2)); + position.add_constraint (dim_vector (2, 1)); + visible.set (octave_value (true)); + } + }; + +private: + properties xproperties; + +public: + uicontextmenu (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uicontextmenu (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uicontrol : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + Matrix get_boundingbox (bool internal = false, + const Matrix& parent_pix_size = Matrix ()) const; + + double get_fontsize_points (double box_pix_height = 0) const; + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uicontrol) + any_property __object__ , Matrix () + color_property backgroundcolor , color_values (1, 1, 1) + callback_property callback , Matrix () + array_property cdata , Matrix () + bool_property clipping , "on" + radio_property enable , "{on}|inactive|off" + array_property extent rG , Matrix (1, 4, 0.0) + radio_property fontangle u , "{normal}|italic|oblique" + string_property fontname u , OCTAVE_DEFAULT_FONTNAME + double_property fontsize u , 10 + radio_property fontunits S , "inches|centimeters|normalized|{points}|pixels" + radio_property fontweight u , "light|{normal}|demi|bold" + color_property foregroundcolor , color_values (0, 0, 0) + radio_property horizontalalignment , "{left}|center|right" + callback_property keypressfcn , Matrix () + double_property listboxtop , 1 + double_property max , 1 + double_property min , 0 + array_property position , default_control_position () + array_property sliderstep , default_control_sliderstep () + string_array_property string u , "" + radio_property style S , "{pushbutton}|togglebutton|radiobutton|checkbox|edit|text|slider|frame|listbox|popupmenu" + string_property tooltipstring , "" + radio_property units u , "normalized|inches|centimeters|points|{pixels}|characters" + row_vector_property value , Matrix (1, 1, 1.0) + radio_property verticalalignment , "top|{middle}|bottom" + END_PROPERTIES + + private: + std::string cached_units; + + protected: + void init (void) + { + cdata.add_constraint ("double"); + cdata.add_constraint ("single"); + cdata.add_constraint ("uint8"); + cdata.add_constraint (dim_vector (-1, -1, 3)); + position.add_constraint (dim_vector (1, 4)); + sliderstep.add_constraint (dim_vector (1, 2)); + cached_units = get_units (); + } + + void update_text_extent (void); + + void update_string (void) { update_text_extent (); } + void update_fontname (void) { update_text_extent (); } + void update_fontsize (void) { update_text_extent (); } + void update_fontangle (void) { update_text_extent (); } + void update_fontweight (void) { update_text_extent (); } + void update_fontunits (const caseless_str& old_units); + + void update_units (void); + + }; + +private: + properties xproperties; + +public: + uicontrol (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uicontrol (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uipanel : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + Matrix get_boundingbox (bool internal = false, + const Matrix& parent_pix_size = Matrix ()) const; + + double get_fontsize_points (double box_pix_height = 0) const; + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uipanel) + any_property __object__ , Matrix () + color_property backgroundcolor , color_values (1, 1, 1) + radio_property bordertype , "none|{etchedin}|etchedout|beveledin|beveledout|line" + double_property borderwidth , 1 + radio_property fontangle , "{normal}|italic|oblique" + string_property fontname , OCTAVE_DEFAULT_FONTNAME + double_property fontsize , 10 + radio_property fontunits S , "inches|centimeters|normalized|{points}|pixels" + radio_property fontweight , "light|{normal}|demi|bold" + color_property foregroundcolor , color_values (0, 0, 0) + color_property highlightcolor , color_values (1, 1, 1) + array_property position , default_panel_position () + callback_property resizefcn , Matrix () + color_property shadowcolor , color_values (0, 0, 0) + string_property title , "" + radio_property titleposition , "{lefttop}|centertop|righttop|leftbottom|centerbottom|rightbottom" + radio_property units S , "{normalized}|inches|centimeters|points|pixels|characters" + END_PROPERTIES + + protected: + void init (void) + { + position.add_constraint (dim_vector (1, 4)); + } + + void update_units (const caseless_str& old_units); + void update_fontunits (const caseless_str& old_units); + + }; + +private: + properties xproperties; + +public: + uipanel (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uipanel (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uitoolbar : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uitoolbar) + any_property __object__ , Matrix () + END_PROPERTIES + + protected: + void init (void) + { } + }; + +private: + properties xproperties; + +public: + uitoolbar (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p), default_properties () + { + xproperties.override_defaults (*this); + } + + ~uitoolbar (void) { } + + void override_defaults (base_graphics_object& obj) + { + // Allow parent (figure) to override first (properties knows how + // to find the parent object). + xproperties.override_defaults (obj); + + // Now override with our defaults. If the default_properties + // list includes the properties for all defaults (line, + // surface, etc.) then we don't have to know the type of OBJ + // here, we just call its set function and let it decide which + // properties from the list to use. + obj.set_from_list (default_properties); + } + + void set (const caseless_str& name, const octave_value& value) + { + if (name.compare ("default", 7)) + // strip "default", pass rest to function that will + // parse the remainder and add the element to the + // default_properties map. + default_properties.set (name.substr (7), value); + else + xproperties.set (name, value); + } + + octave_value get (const caseless_str& name) const + { + octave_value retval; + + if (name.compare ("default", 7)) + retval = get_default (name.substr (7)); + else + retval = xproperties.get (name); + + return retval; + } + + octave_value get_default (const caseless_str& name) const; + + octave_value get_defaults (void) const + { + return default_properties.as_struct ("default"); + } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + + void reset_default_properties (void); + +private: + property_list default_properties; +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uipushtool : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uipushtool) + any_property __object__ , Matrix () + array_property cdata , Matrix () + callback_property clickedcallback , Matrix () + bool_property enable , "on" + bool_property separator , "off" + string_property tooltipstring , "" + END_PROPERTIES + + protected: + void init (void) + { + cdata.add_constraint ("double"); + cdata.add_constraint ("single"); + cdata.add_constraint ("uint8"); + cdata.add_constraint (dim_vector (-1, -1, 3)); + } + }; + +private: + properties xproperties; + +public: + uipushtool (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uipushtool (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uitoggletool : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uitoggletool) + any_property __object__ , Matrix () + array_property cdata , Matrix () + callback_property clickedcallback , Matrix () + bool_property enable , "on" + callback_property offcallback , Matrix () + callback_property oncallback , Matrix () + bool_property separator , "off" + bool_property state , "off" + string_property tooltipstring , "" + END_PROPERTIES + + protected: + void init (void) + { + cdata.add_constraint ("double"); + cdata.add_constraint ("single"); + cdata.add_constraint ("uint8"); + cdata.add_constraint (dim_vector (-1, -1, 3)); + } + }; + +private: + properties xproperties; + +public: + uitoggletool (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uitoggletool (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + +}; + +// --------------------------------------------------------------------- + +octave_value +get_property_from_handle (double handle, const std::string &property, + const std::string &func); +bool +set_property_in_handle (double handle, const std::string &property, + const octave_value &arg, const std::string &func); + +// --------------------------------------------------------------------- + +class graphics_event; + +class +base_graphics_event +{ +public: + friend class graphics_event; + + base_graphics_event (void) : count (1) { } + + virtual ~base_graphics_event (void) { } + + virtual void execute (void) = 0; + +private: + octave_refcount count; +}; + +class +graphics_event +{ +public: + typedef void (*event_fcn) (void*); + + graphics_event (void) : rep (0) { } + + graphics_event (const graphics_event& e) : rep (e.rep) + { + rep->count++; + } + + ~graphics_event (void) + { + if (rep && --rep->count == 0) + delete rep; + } + + graphics_event& operator = (const graphics_event& e) + { + if (rep != e.rep) + { + if (rep && --rep->count == 0) + delete rep; + + rep = e.rep; + if (rep) + rep->count++; + } + + return *this; + } + + void execute (void) + { if (rep) rep->execute (); } + + bool ok (void) const + { return (rep != 0); } + + static graphics_event + create_callback_event (const graphics_handle& h, + const std::string& name, + const octave_value& data = Matrix ()); + + static graphics_event + create_callback_event (const graphics_handle& h, + const octave_value& cb, + const octave_value& data = Matrix ()); + + static graphics_event + create_function_event (event_fcn fcn, void *data = 0); + + static graphics_event + create_set_event (const graphics_handle& h, const std::string& name, + const octave_value& value, + bool notify_toolkit = true); +private: + base_graphics_event *rep; +}; + +class OCTINTERP_API gh_manager +{ +protected: + + gh_manager (void); + +public: + + static void create_instance (void); + + static bool instance_ok (void) + { + bool retval = true; + + if (! instance) + create_instance (); + + if (! instance) + { + ::error ("unable to create gh_manager!"); + + retval = false; + } + + return retval; + } + + static void cleanup_instance (void) { delete instance; instance = 0; } + + static graphics_handle get_handle (bool integer_figure_handle) + { + return instance_ok () + ? instance->do_get_handle (integer_figure_handle) : graphics_handle (); + } + + static void free (const graphics_handle& h) + { + if (instance_ok ()) + instance->do_free (h); + } + + static void renumber_figure (const graphics_handle& old_gh, + const graphics_handle& new_gh) + { + if (instance_ok ()) + instance->do_renumber_figure (old_gh, new_gh); + } + + static graphics_handle lookup (double val) + { + return instance_ok () ? instance->do_lookup (val) : graphics_handle (); + } + + static graphics_handle lookup (const octave_value& val) + { + return val.is_real_scalar () + ? lookup (val.double_value ()) : graphics_handle (); + } + + static graphics_object get_object (double val) + { + return get_object (lookup (val)); + } + + static graphics_object get_object (const graphics_handle& h) + { + return instance_ok () ? instance->do_get_object (h) : graphics_object (); + } + + static graphics_handle + make_graphics_handle (const std::string& go_name, + const graphics_handle& parent, + bool integer_figure_handle = false, + bool do_createfcn = true, + bool do_notify_toolkit = true) + { + return instance_ok () + ? instance->do_make_graphics_handle (go_name, parent, + integer_figure_handle, + do_createfcn, do_notify_toolkit) + : graphics_handle (); + } + + static graphics_handle make_figure_handle (double val, + bool do_notify_toolkit = true) + { + return instance_ok () + ? instance->do_make_figure_handle (val, do_notify_toolkit) + : graphics_handle (); + } + + static void push_figure (const graphics_handle& h) + { + if (instance_ok ()) + instance->do_push_figure (h); + } + + static void pop_figure (const graphics_handle& h) + { + if (instance_ok ()) + instance->do_pop_figure (h); + } + + static graphics_handle current_figure (void) + { + return instance_ok () + ? instance->do_current_figure () : graphics_handle (); + } + + static Matrix handle_list (bool show_hidden = false) + { + return instance_ok () + ? instance->do_handle_list (show_hidden) : Matrix (); + } + + static void lock (void) + { + if (instance_ok ()) + instance->do_lock (); + } + + static bool try_lock (void) + { + if (instance_ok ()) + return instance->do_try_lock (); + else + return false; + } + + static void unlock (void) + { + if (instance_ok ()) + instance->do_unlock (); + } + + static Matrix figure_handle_list (bool show_hidden = false) + { + return instance_ok () + ? instance->do_figure_handle_list (show_hidden) : Matrix (); + } + + static void execute_listener (const graphics_handle& h, + const octave_value& l) + { + if (instance_ok ()) + instance->do_execute_listener (h, l); + } + + static void execute_callback (const graphics_handle& h, + const std::string& name, + const octave_value& data = Matrix ()) + { + octave_value cb; + + if (true) + { + gh_manager::auto_lock lock; + + graphics_object go = get_object (h); + + if (go.valid_object ()) + cb = go.get (name); + } + + if (! error_state) + execute_callback (h, cb, data); + } + + static void execute_callback (const graphics_handle& h, + const octave_value& cb, + const octave_value& data = Matrix ()) + { + if (instance_ok ()) + instance->do_execute_callback (h, cb, data); + } + + static void post_callback (const graphics_handle& h, + const std::string& name, + const octave_value& data = Matrix ()) + { + if (instance_ok ()) + instance->do_post_callback (h, name, data); + } + + static void post_function (graphics_event::event_fcn fcn, void* data = 0) + { + if (instance_ok ()) + instance->do_post_function (fcn, data); + } + + static void post_set (const graphics_handle& h, const std::string& name, + const octave_value& value, bool notify_toolkit = true) + { + if (instance_ok ()) + instance->do_post_set (h, name, value, notify_toolkit); + } + + static int process_events (void) + { + return (instance_ok () ? instance->do_process_events () : 0); + } + + static int flush_events (void) + { + return (instance_ok () ? instance->do_process_events (true) : 0); + } + + static void enable_event_processing (bool enable = true) + { + if (instance_ok ()) + instance->do_enable_event_processing (enable); + } + + static bool is_handle_visible (const graphics_handle& h) + { + bool retval = false; + + graphics_object go = get_object (h); + + if (go.valid_object ()) + retval = go.is_handle_visible (); + + return retval; + } + + static void close_all_figures (void) + { + if (instance_ok ()) + instance->do_close_all_figures (); + } + +public: + class auto_lock : public octave_autolock + { + public: + auto_lock (bool wait = true) + : octave_autolock (instance_ok () + ? instance->graphics_lock + : octave_mutex (), + wait) + { } + + private: + + // No copying! + auto_lock (const auto_lock&); + auto_lock& operator = (const auto_lock&); + }; + +private: + + static gh_manager *instance; + + typedef std::map::iterator iterator; + typedef std::map::const_iterator const_iterator; + + typedef std::set::iterator free_list_iterator; + typedef std::set::const_iterator const_free_list_iterator; + + typedef std::list::iterator figure_list_iterator; + typedef std::list::const_iterator const_figure_list_iterator; + + // A map of handles to graphics objects. + std::map handle_map; + + // The available graphics handles. + std::set handle_free_list; + + // The next handle available if handle_free_list is empty. + double next_handle; + + // The allocated figure handles. Top of the stack is most recently + // created. + std::list figure_list; + + // The lock for accessing the graphics sytsem. + octave_mutex graphics_lock; + + // The list of events queued by graphics toolkits. + std::list event_queue; + + // The stack of callback objects. + std::list callback_objects; + + // A flag telling whether event processing must be constantly on. + int event_processing; + + graphics_handle do_get_handle (bool integer_figure_handle); + + void do_free (const graphics_handle& h); + + void do_renumber_figure (const graphics_handle& old_gh, + const graphics_handle& new_gh); + + graphics_handle do_lookup (double val) + { + iterator p = (xisnan (val) ? handle_map.end () : handle_map.find (val)); + + return (p != handle_map.end ()) ? p->first : graphics_handle (); + } + + graphics_object do_get_object (const graphics_handle& h) + { + iterator p = (h.ok () ? handle_map.find (h) : handle_map.end ()); + + return (p != handle_map.end ()) ? p->second : graphics_object (); + } + + graphics_handle do_make_graphics_handle (const std::string& go_name, + const graphics_handle& p, + bool integer_figure_handle, + bool do_createfcn, + bool do_notify_toolkit); + + graphics_handle do_make_figure_handle (double val, bool do_notify_toolkit); + + Matrix do_handle_list (bool show_hidden) + { + Matrix retval (1, handle_map.size ()); + + octave_idx_type i = 0; + for (const_iterator p = handle_map.begin (); p != handle_map.end (); p++) + { + graphics_handle h = p->first; + + if (show_hidden || is_handle_visible (h)) + retval(i++) = h.value (); + } + + retval.resize (1, i); + + return retval; + } + + Matrix do_figure_handle_list (bool show_hidden) + { + Matrix retval (1, figure_list.size ()); + + octave_idx_type i = 0; + for (const_figure_list_iterator p = figure_list.begin (); + p != figure_list.end (); + p++) + { + graphics_handle h = *p; + + if (show_hidden || is_handle_visible (h)) + retval(i++) = h.value (); + } + + retval.resize (1, i); + + return retval; + } + + void do_push_figure (const graphics_handle& h); + + void do_pop_figure (const graphics_handle& h); + + graphics_handle do_current_figure (void) const + { + graphics_handle retval; + + for (const_figure_list_iterator p = figure_list.begin (); + p != figure_list.end (); + p++) + { + graphics_handle h = *p; + + if (is_handle_visible (h)) + retval = h; + } + + return retval; + } + + void do_lock (void) { graphics_lock.lock (); } + + bool do_try_lock (void) { return graphics_lock.try_lock (); } + + void do_unlock (void) { graphics_lock.unlock (); } + + void do_execute_listener (const graphics_handle& h, const octave_value& l); + + void do_execute_callback (const graphics_handle& h, const octave_value& cb, + const octave_value& data); + + void do_post_callback (const graphics_handle& h, const std::string name, + const octave_value& data); + + void do_post_function (graphics_event::event_fcn fcn, void* fcn_data); + + void do_post_set (const graphics_handle& h, const std::string name, + const octave_value& value, bool notify_toolkit = true); + + int do_process_events (bool force = false); + + void do_close_all_figures (void); + + static void restore_gcbo (void) + { + if (instance_ok ()) + instance->do_restore_gcbo (); + } + + void do_restore_gcbo (void); + + void do_post_event (const graphics_event& e); + + void do_enable_event_processing (bool enable = true); +}; + +void get_children_limits (double& min_val, double& max_val, + double& min_pos, double& max_neg, + const Matrix& kids, char limit_type); + +OCTINTERP_API int calc_dimensions (const graphics_object& gh); + +// This function is NOT equivalent to the scripting language function gcf. +OCTINTERP_API graphics_handle gcf (void); + +// This function is NOT equivalent to the scripting language function gca. +OCTINTERP_API graphics_handle gca (void); + +OCTINTERP_API void close_all_figures (void); + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/gripes.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/gripes.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,238 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "oct-obj.h" +#include "utils.h" + +void +gripe_not_supported (const char *fcn) +{ + error ("%s: not supported on this system", fcn); +} + +void +gripe_not_implemented (const char *fcn) +{ + error ("%s: not implemented", fcn); +} + +void +gripe_string_invalid (void) +{ + error ("std::string constant used in invalid context"); +} + +void +gripe_range_invalid (void) +{ + error ("range constant used in invalid context"); +} + +void +gripe_nonconformant (void) +{ + error ("nonconformant matrices"); +} + +void +gripe_nonconformant (octave_idx_type r1, octave_idx_type c1, octave_idx_type r2, octave_idx_type c2) +{ + error ("nonconformant matrices (op1 is %dx%d, op2 is %dx%d)", + r1, c1, r2, c2); +} + +void +gripe_empty_arg (const char *name, bool is_error) +{ + if (is_error) + error ("%s: empty matrix is invalid as an argument", name); + else + warning ("%s: argument is empty matrix", name); +} + +void +gripe_square_matrix_required (const char *name) +{ + error ("%s: argument must be a square matrix", name); +} + +void +gripe_user_supplied_eval (const char *name) +{ + error ("%s: evaluation of user-supplied function failed", name); +} + +void +gripe_user_returned_invalid (const char *name) +{ + error ("%s: user-supplied function returned invalid value", name); +} + +void +gripe_invalid_conversion (const std::string& from, const std::string& to) +{ + error ("invalid conversion from %s to %s", from.c_str (), to.c_str ()); +} + +void +gripe_invalid_value_specified (const char *name) +{ + warning ("invalid value specified for '%s'", name); +} + +void +gripe_2_or_3_dim_plot (void) +{ + error ("plot: can only plot in 2 or 3 dimensions"); +} + +void +gripe_unrecognized_float_fmt (void) +{ + error ("unrecognized floating point format requested"); +} + +void +gripe_unrecognized_data_fmt (const char *warn_for) +{ + error ("%s: unrecognized data format requested", warn_for); +} + +void +gripe_data_conversion (const char *from, const char *to) +{ + error ("unable to convert from %s to %s format", from, to); +} + +void +gripe_wrong_type_arg (const char *name, const char *s, bool is_error) +{ + if (is_error) + error ("%s: wrong type argument '%s'", name, s); + else + warning ("%s: wrong type argument '%s'", name, s); +} + +void +gripe_wrong_type_arg (const char *name, const std::string& s, bool is_error) +{ + gripe_wrong_type_arg (name, s.c_str (), is_error); +} + +void +gripe_wrong_type_arg (const char *name, const octave_value& tc, + bool is_error) +{ + std::string type = tc.type_name (); + + gripe_wrong_type_arg (name, type, is_error); +} + +void +gripe_wrong_type_arg (const std::string& name, const octave_value& tc, + bool is_error) +{ + gripe_wrong_type_arg (name.c_str (), tc, is_error); +} + +void +gripe_wrong_type_arg_for_unary_op (const octave_value& op) +{ + std::string type = op.type_name (); + error ("invalid operand '%s' for unary operator", type.c_str ()); +} + +void +gripe_wrong_type_arg_for_binary_op (const octave_value& op) +{ + std::string type = op.type_name (); + error ("invalid operand '%s' for binary operator", type.c_str ()); +} + +void +gripe_implicit_conversion (const char *id, const char *from, const char *to) +{ + warning_with_id (id, "implicit conversion from %s to %s", from, to); +} + +void +gripe_implicit_conversion (const std::string& id, + const std::string& from, const std::string& to) +{ + warning_with_id (id.c_str (), + "implicit conversion from %s to %s", + from.c_str (), to.c_str ()); +} + +void +gripe_divide_by_zero (void) +{ + warning_with_id ("Octave:divide-by-zero", "division by zero"); +} + +void +gripe_logical_conversion (void) +{ + warning_with_id ("Octave:logical-conversion", + "value not equal to 1 or 0 converted to logical 1"); +} + +void +gripe_library_execution_error (void) +{ + octave_exception_state = octave_no_exception; + + if (! error_state) + error ("caught execution error in library function"); +} + +void +gripe_invalid_inquiry_subscript (void) +{ + error ("invalid dimension inquiry of a non-existent value"); +} + +void +gripe_indexed_cs_list (void) +{ + error ("a cs-list cannot be further indexed"); +} + +void +gripe_nonbraced_cs_list_assignment (void) +{ + error ("invalid assignment to cs-list outside multiple assignment"); +} + +void +gripe_warn_complex_cmp (void) +{ + warning_with_id ("Octave:matlab-incompatible", + "potential Matlab compatibility problem: comparing complex numbers"); +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/gripes.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/gripes.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,130 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_gripes_h) +#define octave_gripes_h 1 + +#include + +#include "lo-array-gripes.h" + +class octave_value; + +extern OCTINTERP_API void +gripe_not_supported (const char *); + +extern OCTINTERP_API void +gripe_not_implemented (const char *); + +extern OCTINTERP_API void +gripe_string_invalid (void); + +extern OCTINTERP_API void +gripe_range_invalid (void); + +extern OCTINTERP_API void +gripe_nonconformant (void); + +extern OCTINTERP_API void +gripe_nonconformant (octave_idx_type r1, octave_idx_type c1, octave_idx_type r2, octave_idx_type c2); + +extern OCTINTERP_API void +gripe_empty_arg (const char *name, bool is_error); + +extern OCTINTERP_API void +gripe_square_matrix_required (const char *name); + +extern OCTINTERP_API void +gripe_user_supplied_eval (const char *name); + +extern OCTINTERP_API void +gripe_user_returned_invalid (const char *name); + +extern OCTINTERP_API void +gripe_invalid_conversion (const std::string& from, const std::string& to); + +extern OCTINTERP_API void +gripe_invalid_value_specified (const char *name); + +extern OCTINTERP_API void +gripe_2_or_3_dim_plot (void); + +extern OCTINTERP_API void +gripe_unrecognized_float_fmt (void); + +extern OCTINTERP_API void +gripe_unrecognized_data_fmt (const char *warn_for); + +extern OCTINTERP_API void +gripe_data_conversion (const char *from, const char *to); + +extern OCTINTERP_API void +gripe_wrong_type_arg (const char *name, const char *s, + bool is_error = true); + +extern OCTINTERP_API void +gripe_wrong_type_arg (const char *name, const std::string& s, + bool is_error = true); + +extern OCTINTERP_API void +gripe_wrong_type_arg (const char *name, const octave_value& tc, + bool is_error = true); + +extern OCTINTERP_API void +gripe_wrong_type_arg (const std::string& name, const octave_value& tc, + bool is_error = true); + +extern OCTINTERP_API void +gripe_wrong_type_arg_for_unary_op (const octave_value& op); + +extern OCTINTERP_API void +gripe_wrong_type_arg_for_binary_op (const octave_value& op); + +extern OCTINTERP_API void +gripe_implicit_conversion (const char *id, const char *from, const char *to); + +extern OCTINTERP_API void +gripe_implicit_conversion (const std::string& id, const std::string& from, + const std::string& to); + +extern OCTINTERP_API void +gripe_divide_by_zero (void); + +extern OCTINTERP_API void +gripe_logical_conversion (void); + +extern OCTINTERP_API void +gripe_library_execution_error (void); + +extern OCTINTERP_API void +gripe_invalid_inquiry_subscript (void); + +extern OCTINTERP_API void +gripe_indexed_cs_list (void); + +extern OCTINTERP_API void +gripe_nonbraced_cs_list_assignment (void); + +extern OCTINTERP_API void +gripe_warn_complex_cmp (void); + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/help.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/help.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,1513 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include +#include +#include +#include +#include + +#include +#include + +#include "cmd-edit.h" +#include "file-ops.h" +#include "file-stat.h" +#include "oct-env.h" +#include "str-vec.h" + +#include +#include "defun.h" +#include "dirfns.h" +#include "error.h" +#include "gripes.h" +#include "help.h" +#include "input.h" +#include "load-path.h" +#include "oct-obj.h" +#include "ov-usr-fcn.h" +#include "pager.h" +#include "parse.h" +#include "pathsearch.h" +#include "procstream.h" +#include "pt-pr-code.h" +#include "sighandlers.h" +#include "symtab.h" +#include "syswait.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" +#include "version.h" +#include "quit.h" + +// Name of the doc cache file specified on the command line. +// (--doc-cache-file file) +std::string Vdoc_cache_file; + +// Name of the file containing local Texinfo macros that are prepended +// to doc strings before processing. +// (--texi-macros-file) +std::string Vtexi_macros_file; + +// Name of the info file specified on command line. +// (--info-file file) +std::string Vinfo_file; + +// Name of the info reader we'd like to use. +// (--info-program program) +std::string Vinfo_program; + +// Name of the makeinfo program to run. +static std::string Vmakeinfo_program = "makeinfo"; + +// If TRUE, don't print additional help message in help and usage +// functions. +static bool Vsuppress_verbose_help_message = false; + +#include + +typedef std::map map_type; +typedef map_type::value_type pair_type; +typedef map_type::const_iterator map_iter; + +template +std::size_t +size (T const (&)[z]) +{ + return z; +} + +const static pair_type operators[] = +{ + pair_type ("!", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} !\n\ +Logical 'not' operator.\n\ +@seealso{~, not}\n\ +@end deftypefn"), + + pair_type ("~", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ~\n\ +Logical 'not' operator.\n\ +@seealso{!, not}\n\ +@end deftypefn"), + + pair_type ("!=", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} !=\n\ +Logical 'not equals' operator.\n\ +@seealso{~=, ne}\n\ +@end deftypefn"), + + pair_type ("~=", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ~=\n\ +Logical 'not equals' operator.\n\ +@seealso{!=, ne}\n\ +@end deftypefn"), + + pair_type ("\"", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} \"\n\ +String delimiter.\n\ +@end deftypefn"), + + pair_type ("#", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} #\n\ +Begin comment character.\n\ +@seealso{%, #@\\{}\n\ +@end deftypefn"), + + pair_type ("%", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} %\n\ +Begin comment character.\n\ +@seealso{#, %@\\{}\n\ +@end deftypefn"), + + pair_type ("#{", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} #@{\n\ +Begin block comment. There must be nothing else, other than\n\ +whitespace, in the line both before and after @code{#@{}.\n\ +It is possible to nest block comments.\n\ +@seealso{%@\\{, #@\\}, #}\n\ +@end deftypefn"), + + pair_type ("%{", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} %@{\n\ +Begin block comment. There must be nothing else, other than\n\ +whitespace, in the line both before and after @code{%@{}.\n\ +It is possible to nest block comments.\n\ +@seealso{#@\\{, %@\\}, %}\n\ +@end deftypefn"), + + pair_type ("#}", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} #@}\n\ +Close block comment. There must be nothing else, other than\n\ +whitespace, in the line both before and after @code{#@}}.\n\ +It is possible to nest block comments.\n\ +@seealso{%@\\}, #@\\{, #}\n\ +@end deftypefn"), + + pair_type ("%}", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} %@}\n\ +Close block comment. There must be nothing else, other than\n\ +whitespace, in the line both before and after @code{%@}}.\n\ +It is possible to nest block comments.\n\ +@seealso{#@\\}, %@\\{, %}\n\ +@end deftypefn"), + + pair_type ("...", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ...\n\ +Continuation marker. Joins current line with following line.\n\ +@end deftypefn"), + + pair_type ("&", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} &\n\ +Element by element logical 'and' operator.\n\ +@seealso{&&, and}\n\ +@end deftypefn"), + + pair_type ("&&", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} &&\n\ +Logical 'and' operator (with short-circuit evaluation).\n\ +@seealso{&, and}\n\ +@end deftypefn"), + + pair_type ("'", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} '\n\ +Matrix transpose operator. For complex matrices, computes the\n\ +complex conjugate (Hermitian) transpose.\n\ +\n\ +The single quote character may also be used to delimit strings, but\n\ +it is better to use the double quote character, since that is never\n\ +ambiguous.\n\ +@seealso{.', transpose}\n\ +@end deftypefn"), + + pair_type ("(", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} (\n\ +Array index or function argument delimiter.\n\ +@end deftypefn"), + + pair_type (")", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} )\n\ +Array index or function argument delimiter.\n\ +@end deftypefn"), + + pair_type ("*", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} *\n\ +Multiplication operator.\n\ +@seealso{.*, times}\n\ +@end deftypefn"), + + pair_type ("**", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} **\n\ +Power operator. This may return complex results for real inputs. Use\n\ +@code{realsqrt}, @code{cbrt}, @code{nthroot}, or @code{realroot} to obtain\n\ +real results when possible.\n\ +@seealso{power, ^, .**, .^, realpow, realsqrt, cbrt, nthroot}\n\ +@end deftypefn"), + + pair_type ("^", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ^\n\ +Power operator. This may return complex results for real inputs. Use\n\ +@code{realsqrt}, @code{cbrt}, @code{nthroot}, or @code{realroot} to obtain\n\ +real results when possible.\n\ +@seealso{power, **, .^, .**, realpow, realsqrt, cbrt, nthroot}\n\ +@end deftypefn"), + + pair_type ("+", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} +\n\ +Addition operator.\n\ +@seealso{plus}\n\ +@end deftypefn"), + + pair_type ("++", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ++\n\ +Increment operator. As in C, may be applied as a prefix or postfix\n\ +operator.\n\ +@seealso{--}\n\ +@end deftypefn"), + + pair_type (",", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ,\n\ +Array index, function argument, or command separator.\n\ +@end deftypefn"), + + pair_type ("-", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} -\n\ +Subtraction or unary negation operator.\n\ +@seealso{minus}\n\ +@end deftypefn"), + + pair_type ("--", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} --\n\ +Decrement operator. As in C, may be applied as a prefix or postfix\n\ +operator.\n\ +@seealso{++}\n\ +@end deftypefn"), + + pair_type (".'", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} .'\n\ +Matrix transpose operator. For complex matrices, computes the\n\ +transpose, @emph{not} the complex conjugate transpose.\n\ +@seealso{', transpose}\n\ +@end deftypefn"), + + pair_type (".*", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} .*\n\ +Element by element multiplication operator.\n\ +@seealso{*, times}\n\ +@end deftypefn"), + + pair_type (".**", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} .*\n\ +Element by element power operator. If several complex results are possible,\n\ +returns the one with smallest non-negative argument (angle). Use\n\ +@code{realpow}, @code{realsqrt}, @code{cbrt}, or @code{nthroot} if a\n\ +real result is preferred.\n\ +@seealso{**, ^, .^, power, realpow, realsqrt, cbrt, nthroot}\n\ +@end deftypefn"), + + pair_type (".^", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} .^\n\ +Element by element power operator. If several complex results are possible,\n\ +returns the one with smallest non-negative argument (angle). Use\n\ +@code{realpow}, @code{realsqrt}, @code{cbrt}, or @code{nthroot} if a\n\ +real result is preferred.\n\ +@seealso{.**, ^, **, power, realpow, realsqrt, cbrt, nthroot}\n\ +@end deftypefn"), + + pair_type ("./", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ./\n\ +Element by element right division operator.\n\ +@seealso{/, .\\, rdivide, mrdivide}\n\ +@end deftypefn"), + + pair_type ("/", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} /\n\ +Right division operator.\n\ +@seealso{./, \\, rdivide, mrdivide}\n\ +@end deftypefn"), + + pair_type (".\\", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} .\\\n\ +Element by element left division operator.\n\ +@seealso{\\, ./, rdivide, mrdivide}\n\ +@end deftypefn"), + + pair_type ("\\", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} \\\n\ +Left division operator.\n\ +@seealso{.\\, /, ldivide, mldivide}\n\ +@end deftypefn"), + + pair_type (":", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} :\n\ +Select entire rows or columns of matrices.\n\ +@end deftypefn"), + + pair_type (";", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ;\n\ +Array row or command separator.\n\ +@seealso{,}\n\ +@end deftypefn"), + + pair_type ("<", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} <\n\ +'Less than' operator.\n\ +@seealso{lt}\n\ +@end deftypefn"), + + pair_type ("<=", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} <=\n\ +'Less than' or 'equals' operator.\n\ +@seealso{le}\n\ +@end deftypefn"), + + pair_type ("=", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} =\n\ +Assignment operator.\n\ +@end deftypefn"), + + pair_type ("==", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ==\n\ +Equality test operator.\n\ +@seealso{eq}\n\ +@end deftypefn"), + + pair_type (">", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} >\n\ +'Greater than' operator.\n\ +@seealso{gt}\n\ +@end deftypefn"), + + pair_type (">=", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} >=\n\ +'Greater than' or 'equals' operator.\n\ +@seealso{ge}\n\ +@end deftypefn"), + + pair_type ("[", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} [\n\ +Return list delimiter.\n\ +@seealso{]}\n\ +@end deftypefn"), + + pair_type ("]", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ]\n\ +Return list delimiter.\n\ +@seealso{[}\n\ +@end deftypefn"), + + pair_type ("|", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} |\n\ +Element by element logical 'or' operator.\n\ +@seealso{||, or}\n\ +@end deftypefn"), + + pair_type ("||", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ||\n\ +Logical 'or' (with short-circuit evaluation) operator.\n\ +@seealso{|, or}\n\ +@end deftypefn"), +}; + +const static pair_type keywords[] = +{ + pair_type ("break", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} break\n\ +Exit the innermost enclosing do, while or for loop.\n\ +@seealso{do, while, for, parfor, continue}\n\ +@end deftypefn"), + + pair_type ("case", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} case @{@var{value}@}\n\ +A case statement in an switch. Octave cases are exclusive and do not\n\ +fall-through as do C-language cases. A switch statement must have at least\n\ +one case. See @code{switch} for an example.\n\ +@seealso{switch}\n\ +@end deftypefn"), + + pair_type ("catch", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} catch\n\ +Begin the cleanup part of a try-catch block.\n\ +@seealso{try}\n\ +@end deftypefn"), + + pair_type ("continue", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} continue\n\ +Jump to the end of the innermost enclosing do, while or for loop.\n\ +@seealso{do, while, for, parfor, break}\n\ +@end deftypefn"), + + pair_type ("do", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} do\n\ +Begin a do-until loop. This differs from a do-while loop in that the\n\ +body of the loop is executed at least once.\n\ +\n\ +@example\n\ +@group\n\ +i = 0;\n\ +do\n\ + i++\n\ +until (i == 10)\n\ +@end group\n\ +@end example\n\ +@seealso{for, until, while}\n\ +@end deftypefn"), + + pair_type ("else", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} else\n\ +Alternate action for an if block. See @code{if} for an example.\n\ +@seealso{if}\n\ +@end deftypefn"), + + pair_type ("elseif", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} elseif (@var{condition})\n\ +Alternate conditional test for an if block. See @code{if} for an example.\n\ +@seealso{if}\n\ +@end deftypefn"), + + pair_type ("end", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} end\n\ +Mark the end of any @code{for}, @code{if}, @code{do}, @code{while}, or\n\ +@code{function} block.\n\ +@seealso{for, parfor, if, do, while, function}\n\ +@end deftypefn"), + + pair_type ("end_try_catch", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} end_try_catch\n\ +Mark the end of an @code{try-catch} block.\n\ +@seealso{try, catch}\n\ +@end deftypefn"), + + pair_type ("end_unwind_protect", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} end_unwind_protect\n\ +Mark the end of an unwind_protect block.\n\ +@seealso{unwind_protect}\n\ +@end deftypefn"), + + pair_type ("endfor", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} endfor\n\ +Mark the end of a for loop. See @code{for} for an example.\n\ +@seealso{for}\n\ +@end deftypefn"), + + pair_type ("endfunction", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} endfunction\n\ +Mark the end of a function.\n\ +@seealso{function}\n\ +@end deftypefn"), + + pair_type ("endif", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} endif\n\ +Mark the end of an if block. See @code{if} for an example.\n\ +@seealso{if}\n\ +@end deftypefn"), + + pair_type ("endparfor", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} endparfor\n\ +Mark the end of a parfor loop. See @code{parfor} for an example.\n\ +@seealso{parfor}\n\ +@end deftypefn"), + + pair_type ("endswitch", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} endswitch\n\ +Mark the end of a switch block. See @code{switch} for an example.\n\ +@seealso{switch}\n\ +@end deftypefn"), + + pair_type ("endwhile", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} endwhile\n\ +Mark the end of a while loop. See @code{while} for an example.\n\ +@seealso{do, while}\n\ +@end deftypefn"), + + pair_type ("for", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} for @var{i} = @var{range}\n\ +Begin a for loop.\n\ +\n\ +@example\n\ +@group\n\ +for i = 1:10\n\ + i\n\ +endfor\n\ +@end group\n\ +@end example\n\ +@seealso{do, parfor, while}\n\ +@end deftypefn"), + + pair_type ("function", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} function @var{outputs} = function (@var{input}, @dots{})\n\ +@deftypefnx {Keyword} {} function {} function (@var{input}, @dots{})\n\ +@deftypefnx {Keyword} {} function @var{outputs} = function\n\ +Begin a function body with @var{outputs} as results and @var{inputs} as\n\ +parameters.\n\ +@seealso{return}\n\ +@end deftypefn"), + + pair_type ("global", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} global\n\ +Declare variables to have global scope.\n\ +\n\ +@example\n\ +@group\n\ +global @var{x};\n\ +if (isempty (@var{x}))\n\ + x = 1;\n\ +endif\n\ +@end group\n\ +@end example\n\ +@seealso{persistent}\n\ +@end deftypefn"), + + pair_type ("if", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} if (@var{cond}) @dots{} endif\n\ +@deftypefnx {Keyword} {} if (@var{cond}) @dots{} else @dots{} endif\n\ +@deftypefnx {Keyword} {} if (@var{cond}) @dots{} elseif (@var{cond}) @dots{} endif\n\ +@deftypefnx {Keyword} {} if (@var{cond}) @dots{} elseif (@var{cond}) @dots{} else @dots{} endif\n\ +Begin an if block.\n\ +\n\ +@example\n\ +@group\n\ +x = 1;\n\ +if (x == 1)\n\ + disp (\"one\");\n\ +elseif (x == 2)\n\ + disp (\"two\");\n\ +else\n\ + disp (\"not one or two\");\n\ +endif\n\ +@end group\n\ +@end example\n\ +@seealso{switch}\n\ +@end deftypefn"), + + pair_type ("otherwise", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} otherwise\n\ +The default statement in a switch block (similar to else in an if block).\n\ +@seealso{switch}\n\ +@end deftypefn"), + + pair_type ("parfor", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} for @var{i} = @var{range}\n\ +@deftypefnx {Keyword} {} for (@var{i} = @var{range}, @var{maxproc})\n\ +Begin a for loop that may execute in parallel.\n\ +\n\ +@example\n\ +@group\n\ +parfor i = 1:10\n\ + i\n\ +endparfor\n\ +@end group\n\ +@end example\n\ +@seealso{for, do, while}\n\ +@end deftypefn"), + + pair_type ("persistent", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} persistent @var{var}\n\ +Declare variables as persistent. A variable that has been declared\n\ +persistent within a function will retain its contents in memory between\n\ +subsequent calls to the same function. The difference between persistent\n\ +variables and global variables is that persistent variables are local in \n\ +scope to a particular function and are not visible elsewhere.\n\ +@seealso{global}\n\ +@end deftypefn"), + + pair_type ("return", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} return\n\ +Return from a function.\n\ +@seealso{function}\n\ +@end deftypefn"), + + pair_type ("static", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} static\n\ +This function has been deprecated in favor of persistent.\n\ +@seealso{persistent}\n\ +@end deftypefn"), + + pair_type ("switch", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} switch @var{statement}\n\ +Begin a switch block.\n\ +\n\ +@example\n\ +@group\n\ +yesno = \"yes\"\n\ +\n\ +switch yesno\n\ + case @{\"Yes\" \"yes\" \"YES\" \"y\" \"Y\"@}\n\ + value = 1;\n\ + case @{\"No\" \"no\" \"NO\" \"n\" \"N\"@}\n\ + value = 0;\n\ + otherwise\n\ + error (\"invalid value\");\n\ +endswitch\n\ +@end group\n\ +@end example\n\ +@seealso{if, case, otherwise}\n\ +@end deftypefn"), + + pair_type ("try", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} try\n\ +Begin a try-catch block.\n\ +\n\ +If an error occurs within a try block, then the catch code will be run and\n\ +execution will proceed after the catch block (though it is often\n\ +recommended to use the lasterr function to re-throw the error after cleanup\n\ +is completed).\n\ +@seealso{catch, unwind_protect}\n\ +@end deftypefn"), + + pair_type ("until", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} until\n\ +End a do-until loop. See @code{do} for an example.\n\ +@seealso{do}\n\ +@end deftypefn"), + + pair_type ("unwind_protect", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} unwind_protect\n\ +Begin an unwind_protect block.\n\ +\n\ +If an error occurs within the first part of an unwind_protect block\n\ +the commands within the unwind_protect_cleanup block are executed before\n\ +the error is thrown. If an error is not thrown, then the\n\ +unwind_protect_cleanup block is still executed (in other words, the\n\ +unwind_protect_cleanup will be run with or without an error in the\n\ +unwind_protect block).\n\ +@seealso{unwind_protect_cleanup, try}\n\ +@end deftypefn"), + + pair_type ("unwind_protect_cleanup", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} unwind_protect_cleanup\n\ +Begin the cleanup section of an unwind_protect block.\n\ +@seealso{unwind_protect}\n\ +@end deftypefn"), + + pair_type ("varargin", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} varargin\n\ +Pass an arbitrary number of arguments into a function.\n\ +@seealso{varargout, nargin, isargout, nargout, nthargout}\n\ +@end deftypefn"), + + pair_type ("varargout", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} varargout\n\ +Pass an arbitrary number of arguments out of a function.\n\ +@seealso{varargin, nargin, isargout, nargout, nthargout}\n\ +@end deftypefn"), + + pair_type ("while", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} while\n\ +Begin a while loop.\n\ +\n\ +@example\n\ +@group\n\ +i = 0;\n\ +while (i < 10)\n\ + i++\n\ +endwhile\n\ +@end group\n\ +@end example\n\ +@seealso{do, endwhile, for, until}\n\ +@end deftypefn"), +}; + +// Return a copy of the operator or keyword names. +static string_vector +names (const map_type& lst) +{ + string_vector retval (lst.size ()); + int j = 0; + for (map_iter iter = lst.begin (); iter != lst.end (); iter ++) + retval[j++] = iter->first; + return retval; +} + +const static map_type operators_map (operators, operators + size (operators)); +const static map_type keywords_map (keywords, keywords + size (keywords)); +const static string_vector keyword_names = names (keywords_map); + +// FIXME -- It's not likely that this does the right thing now. + +string_vector +make_name_list (void) +{ + const int key_len = keyword_names.length (); + + const string_vector bif = symbol_table::built_in_function_names (); + const int bif_len = bif.length (); + + const string_vector cfl = symbol_table::cmdline_function_names (); + const int cfl_len = cfl.length (); + + const string_vector lcl = symbol_table::variable_names (); + const int lcl_len = lcl.length (); + + const string_vector ffl = load_path::fcn_names (); + const int ffl_len = ffl.length (); + + const string_vector afl = autoloaded_functions (); + const int afl_len = afl.length (); + + const int total_len + = key_len + bif_len + cfl_len + lcl_len + ffl_len + afl_len; + + string_vector list (total_len); + + // Put all the symbols in one big list. + + int j = 0; + int i = 0; + for (i = 0; i < key_len; i++) + list[j++] = keyword_names[i]; + + for (i = 0; i < bif_len; i++) + list[j++] = bif[i]; + + for (i = 0; i < cfl_len; i++) + list[j++] = cfl[i]; + + for (i = 0; i < lcl_len; i++) + list[j++] = lcl[i]; + + for (i = 0; i < ffl_len; i++) + list[j++] = ffl[i]; + + for (i = 0; i < afl_len; i++) + list[j++] = afl[i]; + + return list; +} + +static bool +looks_like_html (const std::string& msg) +{ + const size_t p1 = msg.find ('\n'); + std::string t = msg.substr (0, p1); + const size_t p2 = t.find ("doc_string (); + + retval = true; + + w = fcn->fcn_file_name (); + + if (w.empty ()) + w = fcn->is_user_function () + ? "command-line function" : "built-in function"; + } + } + + return retval; +} + +static bool +raw_help_from_file (const std::string& nm, std::string& h, + std::string& file, bool& symbol_found) +{ + bool retval = false; + + h = get_help_from_file (nm, symbol_found, file); + + if (h.length () > 0) + retval = true; + + return retval; +} + +static bool +raw_help_from_map (const std::string& nm, std::string& h, + const map_type& map, bool& symbol_found) +{ + map_iter idx = map.find (nm); + symbol_found = (idx != map.end ()); + h = (symbol_found) ? idx->second : ""; + return symbol_found; +} + +std::string +raw_help (const std::string& nm, bool& symbol_found) +{ + std::string h; + std::string w; + std::string f; + + (raw_help_from_symbol_table (nm, h, w, symbol_found) + || raw_help_from_file (nm, h, f, symbol_found) + || raw_help_from_map (nm, h, operators_map, symbol_found) + || raw_help_from_map (nm, h, keywords_map, symbol_found)); + + return h; +} + +DEFUN (built_in_docstrings_file, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} built_in_docstrings_file ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} built_in_docstrings_file (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} built_in_docstrings_file (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the name of the\n\ +file containing docstrings for built-in Octave functions.\n\ +The default value is\n\ +@file{@var{octave-home}/share/octave/@var{version}/etc/built-in-docstrings},\n\ +in which @var{octave-home} is the root directory of the Octave installation,\n\ +and @var{version} is the Octave version number.\n\ +The default value may be overridden by the environment variable\n\ +@w{@env{OCTAVE_BUILT_IN_DOCSTRINGS_FILE}}, or the command line argument\n\ +@samp{--built-in-docstrings-file FNAME}.\n\ +\n\ +Note: This variable is only used when Octave is initializing itself.\n\ +Modifying it during a running session of Octave will have no effect.\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (built_in_docstrings_file); +} + +void +install_built_in_docstrings (void) +{ + std::string fname = Vbuilt_in_docstrings_file; + + std::ifstream file (fname.c_str (), std::ios::in | std::ios::binary); + + if (file) + { + // Ignore header; + file.ignore (1000, 0x1f); + + if (file.gcount () == 1000) + { + // We use std::cerr here instead of calling Octave's warning + // function because install_built_in_docstrings is called + // before the interpreter is initialized, so warning messages + // won't work properly. + + std::cerr << "warning: is builtin-docstrings file corrupted?" + << std::endl; + return; + } + + // FIXME -- eliminate fixed buffer size. + size_t bufsize = 100000; + + OCTAVE_LOCAL_BUFFER (char, buf, bufsize); + + while (! file.eof ()) + { + file.getline (buf, bufsize, 0x1f); + + std::string tmp (buf); + + size_t pos = tmp.find ('\n'); + + std::string fcn = tmp.substr (0, pos); + + octave_value ov = symbol_table::find_built_in_function (fcn); + + if (ov.is_defined ()) + { + octave_function *fp = ov.function_value (); + + if (fp) + { + tmp = tmp.substr (pos+1); + + // Strip @c FILENAME which is part of current DOCSTRINGS + // syntax. This may disappear if a specific format for + // docstring files is developed. + while (tmp.length () > 2 && tmp[0] == '@' && tmp[1] == 'c') + { + pos = tmp.find ('\n'); + tmp = tmp.substr (pos+1); + } + + fp->document (tmp); + } + } + } + } + else + { + // See note above about using std::cerr instead of warning. + + std::cerr << "warning: docstring file '" << fname << "' not found" + << std::endl; + } + +} + +static void +do_get_help_text (const std::string& name, std::string& text, + std::string& format) +{ + bool symbol_found = false; + text = raw_help (name, symbol_found); + + format = "Not found"; + if (symbol_found) + { + size_t idx = -1; + if (text.empty ()) + { + format = "Not documented"; + } + else if (looks_like_texinfo (text, idx)) + { + format = "texinfo"; + text.erase (0, idx); + } + else if (looks_like_html (text)) + { + format = "html"; + } + else + { + format = "plain text"; + } + } +} + +DEFUN (get_help_text, args, , "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{text}, @var{format}] =} get_help_text (@var{name})\n\ +Return the raw help text of function @var{name}.\n\ +\n\ +The raw help text is returned in @var{text} and the format in @var{format}\n\ +The format is a string which is one of @t{\"texinfo\"}, @t{\"html\"}, or\n\ +@t{\"plain text\"}.\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + const std::string name = args (0).string_value (); + + if (! error_state) + { + std::string text; + std::string format; + + do_get_help_text (name, text, format); + + retval(1) = format; + retval(0) = text; + } + else + error ("get_help_text: invalid input"); + } + else + print_usage (); + + return retval; +} + +static void +do_get_help_text_from_file (const std::string& fname, std::string& text, + std::string& format) +{ + bool symbol_found = false; + + std::string f; + + raw_help_from_file (fname, text, f, symbol_found); + + format = "Not found"; + if (symbol_found) + { + size_t idx = -1; + if (text.empty ()) + { + format = "Not documented"; + } + else if (looks_like_texinfo (text, idx)) + { + format = "texinfo"; + text.erase (0, idx); + } + else if (looks_like_html (text)) + { + format = "html"; + } + else + { + format = "plain text"; + } + } +} + +DEFUN (get_help_text_from_file, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{text}, @var{format}] =} get_help_text_from_file (@var{fname})\n\ +Return the raw help text from the file @var{fname}.\n\ +\n\ +The raw help text is returned in @var{text} and the format in @var{format}\n\ +The format is a string which is one of @t{\"texinfo\"}, @t{\"html\"}, or\n\ +@t{\"plain text\"}.\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + const std::string fname = args(0).string_value (); + + if (! error_state) + { + std::string text; + std::string format; + + do_get_help_text_from_file (fname, text, format); + + retval(1) = format; + retval(0) = text; + } + else + error ("get_help_text_from_file: invalid input"); + } + else + print_usage (); + + return retval; +} + +// Return a cell array of strings containing the names of all +// operators. + +DEFUN (__operators__, , , + "-*- texinfo -*-\n\ +@deftypefn {Function File} __operators__ ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + return octave_value (Cell (names (operators_map))); +} + +// Return a cell array of strings containing the names of all +// keywords. + +DEFUN (__keywords__, , , + "-*- texinfo -*-\n\ +@deftypefn {Function File} __keywords__ ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + return octave_value (Cell (names (keywords_map))); +} + +// Return a cell array of strings containing the names of all builtin +// functions. + +DEFUN (__builtins__, , , + "-*- texinfo -*-\n\ +@deftypefn {Function File} __builtins__ ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + const string_vector bif = symbol_table::built_in_function_names (); + + return octave_value (Cell (bif)); +} + +static std::string +do_which (const std::string& name, std::string& type) +{ + std::string file; + + type = std::string (); + + octave_value val = symbol_table::find_function (name); + + if (name.find_first_of ('.') == std::string::npos) + { + if (val.is_defined ()) + { + octave_function *fcn = val.function_value (); + + if (fcn) + { + file = fcn->fcn_file_name (); + + if (file.empty ()) + { + if (fcn->is_user_function ()) + type = "command-line function"; + else + { + file = fcn->src_file_name (); + type = "built-in function"; + } + } + else + type = val.is_user_script () + ? std::string ("script") : std::string ("function"); + } + } + else + { + // We might find a file that contains only a doc string. + + file = load_path::find_fcn_file (name); + } + } + else + { + // File query. + + // For compatibility: "file." queries "file". + if (name.size () > 1 && name[name.size () - 1] == '.') + file = load_path::find_file (name.substr (0, name.size () - 1)); + else + file = load_path::find_file (name); + } + + + return file; +} + +std::string +do_which (const std::string& name) +{ + std::string retval; + + std::string type; + + retval = do_which (name, type); + + return retval; +} + +DEFUN (__which__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __which__ (@var{name}, @dots{})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + string_vector argv = args.make_argv ("which"); + + if (! error_state) + { + int argc = argv.length (); + + if (argc > 1) + { + octave_map m (dim_vector (1, argc-1)); + + Cell names (1, argc-1); + Cell files (1, argc-1); + Cell types (1, argc-1); + + for (int i = 1; i < argc; i++) + { + std::string name = argv[i]; + + std::string type; + + std::string file = do_which (name, type); + + names(i-1) = name; + files(i-1) = file; + types(i-1) = type; + } + + m.assign ("name", names); + m.assign ("file", files); + m.assign ("type", types); + + retval = m; + } + else + print_usage (); + } + + return retval; +} + +// FIXME -- Are we sure this function always does the right thing? +inline bool +file_is_in_dir (const std::string filename, const std::string dir) +{ + if (filename.find (dir) == 0) + { + const int dir_len = dir.size (); + const int filename_len = filename.size (); + const int max_allowed_seps = file_ops::is_dir_sep (dir[dir_len-1]) ? 0 : 1; + + int num_seps = 0; + for (int i = dir_len; i < filename_len; i++) + if (file_ops::is_dir_sep (filename[i])) + num_seps ++; + + return (num_seps <= max_allowed_seps); + } + else + return false; +} + +// Return a cell array of strings containing the names of all +// functions available in DIRECTORY. If no directory is given, search +// the current path. + +DEFUN (__list_functions__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Function File} {@var{retval} =} __list_functions__ ()\n\ +@deftypefnx {Function File} {@var{retval} =} __list_functions__ (@var{directory})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + // Get list of functions + string_vector ffl = load_path::fcn_names (); + string_vector afl = autoloaded_functions (); + + if (args.length () == 0) + retval = Cell (ffl.append (afl)); + else + { + std::string dir = args (0).string_value (); + + if (! error_state) + { + string_vector fl = load_path::files (dir, true); + + if (! error_state) + { + // Return a sorted list with unique entries (in case of + // .m and .oct versions of the same function in a given + // directory, for example). + fl.sort (true); + + retval = Cell (fl); + } + } + else + error ("__list_functions__: DIRECTORY argument must be a string"); + } + + return retval; +} + +DEFUN (doc_cache_file, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} doc_cache_file ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} doc_cache_file (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} doc_cache_file (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the name of the\n\ +Octave documentation cache file. A cache file significantly improves\n\ +the performance of the @code{lookfor} command. The default value is \n\ +@file{@var{octave-home}/share/octave/@var{version}/etc/doc-cache},\n\ +in which @var{octave-home} is the root directory of the Octave installation,\n\ +and @var{version} is the Octave version number.\n\ +The default value may be overridden by the environment variable\n\ +@w{@env{OCTAVE_DOC_CACHE_FILE}}, or the command line argument\n\ +@samp{--doc-cache-file FNAME}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{doc_cache_create, lookfor, info_program, doc, help, makeinfo_program}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (doc_cache_file); +} + +DEFUN (texi_macros_file, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} texi_macros_file ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} texi_macros_file (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} texi_macros_file (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the name of the\n\ +file containing Texinfo macros that are prepended to documentation strings\n\ +before they are passed to makeinfo. The default value is \n\ +@file{@var{octave-home}/share/octave/@var{version}/etc/macros.texi},\n\ +in which @var{octave-home} is the root directory of the Octave installation,\n\ +and @var{version} is the Octave version number.\n\ +The default value may be overridden by the environment variable\n\ +@w{@env{OCTAVE_TEXI_MACROS_FILE}}, or the command line argument\n\ +@samp{--texi-macros-file FNAME}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{makeinfo_program}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (texi_macros_file); +} + +DEFUN (info_file, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} info_file ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} info_file (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} info_file (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the name of the\n\ +Octave info file. The default value is\n\ +@file{@var{octave-home}/info/octave.info}, in\n\ +which @var{octave-home} is the root directory of the Octave installation.\n\ +The default value may be overridden by the environment variable\n\ +@w{@env{OCTAVE_INFO_FILE}}, or the command line argument\n\ +@samp{--info-file FNAME}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{info_program, doc, help, makeinfo_program}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (info_file); +} + +DEFUN (info_program, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} info_program ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} info_program (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} info_program (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the name of the\n\ +info program to run. The default value is\n\ +@file{@var{octave-home}/libexec/octave/@var{version}/exec/@var{arch}/info}\n\ +in which @var{octave-home} is the root directory of the Octave installation,\n\ +@var{version} is the Octave version number, and @var{arch}\n\ +is the system type (for example, @code{i686-pc-linux-gnu}). The\n\ +default value may be overridden by the environment variable\n\ +@w{@env{OCTAVE_INFO_PROGRAM}}, or the command line argument\n\ +@samp{--info-program NAME}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{info_file, doc, help, makeinfo_program}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (info_program); +} + +DEFUN (makeinfo_program, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} makeinfo_program ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} makeinfo_program (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} makeinfo_program (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the name of the\n\ +program that Octave runs to format help text containing\n\ +Texinfo markup commands. The default value is @code{makeinfo}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{texi_macros_file, info_file, info_program, doc, help}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (makeinfo_program); +} + +DEFUN (suppress_verbose_help_message, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} suppress_verbose_help_message ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} suppress_verbose_help_message (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} suppress_verbose_help_message (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave\n\ +will add additional help information to the end of the output from\n\ +the @code{help} command and usage messages for built-in commands.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (suppress_verbose_help_message); +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/help.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/help.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,56 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_help_h) +#define octave_help_h 1 + +#include +#include + +class string_vector; + +extern string_vector make_name_list (void); + +extern OCTINTERP_API std::string raw_help (const std::string&, bool&); + +extern OCTINTERP_API void install_built_in_docstrings (void); + +// Name of the doc cache file specified on the command line. +// (--doc-cache-file file) +extern OCTINTERP_API std::string Vdoc_cache_file; + +// Name of the file containing local Texinfo macros that are prepended +// to doc strings before processing. +// (--texi-macros-file) +extern OCTINTERP_API std::string Vtexi_macros_file; + +// Name of the info file specified on command line. +// (--info-file file) +extern OCTINTERP_API std::string Vinfo_file; + +// Name of the info reader we'd like to use. +// (--info-program program) +extern OCTINTERP_API std::string Vinfo_program; + +extern OCTINTERP_API std::string do_which (const std::string& name); + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/hook-fcn.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/hook-fcn.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,41 @@ +/* + +Copyright (C) 2013 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#include + +#include "hook-fcn.h" + +hook_function::hook_function (const octave_value& f, const octave_value& d) +{ + if (f.is_string ()) + { + std::string name = f.string_value (); + + rep = new named_hook_function (name, d); + } + else if (f.is_function_handle ()) + { + rep = new fcn_handle_hook_function (f, d); + } + else + error ("invalid hook function"); +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/hook-fcn.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/hook-fcn.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,262 @@ +/* + +Copyright (C) 2013 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_hook_fcn_h) +#define octave_hook_fcn_h 1 + +#include + +#include "oct-obj.h" +#include "ov.h" +#include "ov-fcn-handle.h" +#include "parse.h" +#include "variables.h" + +class +base_hook_function +{ +public: + + friend class hook_function; + + base_hook_function (void) : count (1) { } + + base_hook_function (const base_hook_function&) : count (1) { } + + virtual ~base_hook_function (void) { } + + virtual std::string id (void) { return std::string (); } + + virtual bool is_valid (void) { return false; } + + virtual void eval (const octave_value_list&) { } + +protected: + + size_t count; +}; + +class +hook_function +{ +public: + + hook_function (void) + { + static base_hook_function nil_rep; + rep = &nil_rep; + rep->count++; + } + + hook_function (const octave_value& f, + const octave_value& d = octave_value ()); + + ~hook_function (void) + { + if (--rep->count == 0) + delete rep; + } + + hook_function (const hook_function& hf) + : rep (hf.rep) + { + rep->count++; + } + + hook_function& operator = (const hook_function& hf) + { + if (rep != hf.rep) + { + if (--rep->count == 0) + delete rep; + + rep = hf.rep; + rep->count++; + } + + return *this; + } + + std::string id (void) { return rep->id (); } + + bool is_valid (void) { return rep->is_valid (); } + + void eval (const octave_value_list& initial_args) + { + rep->eval (initial_args); + } + +private: + + base_hook_function *rep; +}; + +class +named_hook_function : public base_hook_function +{ +public: + + named_hook_function (const std::string& n, const octave_value& d) + : name (n), data (d) + { } + + void eval (const octave_value_list& initial_args) + { + octave_value_list args = initial_args; + + if (data.is_defined ()) + args.append (data); + + feval (name, args, 0); + } + + std::string id (void) { return name; } + + bool is_valid (void) { return is_valid_function (name); } + +private: + + std::string name; + + octave_value data; +}; + +class +fcn_handle_hook_function : public base_hook_function +{ +public: + + fcn_handle_hook_function (const octave_value& fh_arg, const octave_value& d) + : ident (), valid (false), fcn_handle (fh_arg), data (d) + { + octave_fcn_handle *fh = fcn_handle.fcn_handle_value (true); + + if (fh) + { + valid = true; + + std::ostringstream buf; + buf << fh; + ident = fh->fcn_name () + ":" + buf.str (); + } + } + + void eval (const octave_value_list& initial_args) + { + octave_value_list args = initial_args; + + if (data.is_defined ()) + args.append (data); + + fcn_handle.do_multi_index_op (0, args); + } + + std::string id (void) { return ident; } + + bool is_valid (void) { return valid; } + +private: + + std::string ident; + + bool valid; + + octave_value fcn_handle; + + octave_value data; +}; + +class +hook_function_list +{ +public: + + typedef std::map map_type; + + typedef map_type::iterator iterator; + typedef map_type::const_iterator const_iterator; + + hook_function_list (void) : fcn_map () { } + + ~hook_function_list (void) { } + + hook_function_list (const hook_function_list& lst) + : fcn_map (lst.fcn_map) + { } + + hook_function_list& operator = (const hook_function_list& lst) + { + if (&lst != this) + fcn_map = lst.fcn_map; + + return *this; + } + + bool empty (void) const { return fcn_map.empty (); } + + void clear (void) { fcn_map.clear (); } + + void insert (const std::string& id, const hook_function& f) + { + fcn_map[id] = f; + } + + iterator find (const std::string& id) + { + return fcn_map.find (id); + } + + const_iterator find (const std::string& id) const + { + return fcn_map.find (id); + } + + iterator end (void) { return fcn_map.end (); } + + const_iterator end (void) const { return fcn_map.end (); } + + void erase (iterator p) { fcn_map.erase (p); } + + void run (const octave_value_list& initial_args = octave_value_list ()) + { + iterator p = fcn_map.begin (); + + while (p != fcn_map.end ()) + { + std::string hook_fcn_id = p->first; + hook_function hook_fcn = p->second; + + iterator q = p++; + + if (hook_fcn.is_valid ()) + hook_fcn.eval (initial_args); + else + fcn_map.erase (q); + } + } + +private: + + map_type fcn_map; +}; + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/input.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/input.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,1436 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Get command input interactively or from files. + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include +#include + +#include +#include +#include + +#include +#include + +#include "cmd-edit.h" +#include "file-ops.h" +#include "quit.h" +#include "str-vec.h" + +#include "debug.h" +#include "defun.h" +#include "dirfns.h" +#include "error.h" +#include "gripes.h" +#include "help.h" +#include "hook-fcn.h" +#include "input.h" +#include "lex.h" +#include "load-path.h" +#include "octave-link.h" +#include "oct-map.h" +#include "oct-hist.h" +#include "toplev.h" +#include "octave-link.h" +#include "oct-obj.h" +#include "ov-fcn-handle.h" +#include "pager.h" +#include "parse.h" +#include "pathlen.h" +#include "pt.h" +#include "pt-const.h" +#include "pt-eval.h" +#include "pt-stmt.h" +#include "sighandlers.h" +#include "symtab.h" +#include "sysdep.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +// Primary prompt string. +static std::string VPS1; + +// Secondary prompt string. +static std::string VPS2; + +// String printed before echoed input (enabled by --echo-input). +std::string VPS4 = "+ "; + +// Echo commands as they are executed? +// +// 1 ==> echo commands read from script files +// 2 ==> echo commands from functions +// 4 ==> echo commands read from command line +// +// more than one state can be active at once. +int Vecho_executing_commands = ECHO_OFF; + +// The time we last printed a prompt. +octave_time Vlast_prompt_time = 0.0; + +// Character to append after successful command-line completion attempts. +static char Vcompletion_append_char = ' '; + +// TRUE means this is an interactive shell. +bool interactive = false; + +// TRUE means the user forced this shell to be interactive (-i). +bool forced_interactive = false; + +// TRUE after a call to completion_matches. +bool octave_completion_matches_called = false; + +// TRUE if the plotting system has requested a call to drawnow at +// the next user prompt. +bool Vdrawnow_requested = false; + +// TRUE if we are in debugging mode. +bool Vdebugging = false; + +// If we are in debugging mode, this is the last command entered, so +// that we can repeat the previous command if the user just types RET. +static std::string last_debugging_command = "\n"; + +// TRUE if we are running in the Emacs GUD mode. +static bool Vgud_mode = false; + +// The filemarker used to separate filenames from subfunction names +char Vfilemarker = '>'; + +static hook_function_list input_event_hook_functions; + +// For octave_quit. +void +remove_input_event_hook_functions (void) +{ + input_event_hook_functions.clear (); +} + +void +set_default_prompts (void) +{ + VPS1 = "\\s:\\#> "; + VPS2 = "> "; + VPS4 = "+ "; + + octave_link::set_default_prompts (VPS1, VPS2, VPS4); +} + +void +octave_base_reader::do_input_echo (const std::string& input_string) const +{ + int do_echo = LEXER->reading_script_file ? + (Vecho_executing_commands & ECHO_SCRIPTS) + : (Vecho_executing_commands & ECHO_CMD_LINE) && ! forced_interactive; + + if (do_echo) + { + if (forced_interactive) + { + if (pflag > 0) + octave_stdout << command_editor::decode_prompt_string (VPS1); + else + octave_stdout << command_editor::decode_prompt_string (VPS2); + } + else + octave_stdout << command_editor::decode_prompt_string (VPS4); + + if (! input_string.empty ()) + { + octave_stdout << input_string; + + if (input_string[input_string.length () - 1] != '\n') + octave_stdout << "\n"; + } + } +} + +static std::string +gnu_readline (const std::string& s, bool& eof) +{ + octave_quit (); + + eof = false; + + std::string retval = command_editor::readline (s, eof); + + if (! eof && retval.empty ()) + retval = "\n"; + + return retval; +} + +static inline std::string +interactive_input (const std::string& s, bool& eof) +{ + Vlast_prompt_time.stamp (); + + if (Vdrawnow_requested && (interactive || forced_interactive)) + { + feval ("drawnow"); + + flush_octave_stdout (); + + // We set Vdrawnow_requested to false even if there is an error + // in drawnow so that the error doesn't reappear at every prompt. + + Vdrawnow_requested = false; + + if (error_state) + return "\n"; + } + + return gnu_readline (s, eof); +} + +std::string +octave_base_reader::octave_gets (bool& eof) +{ + octave_quit (); + + eof = false; + + std::string retval; + + // Process pre input event hook function prior to flushing output and + // printing the prompt. + + if (interactive || forced_interactive) + { + if (! Vdebugging) + octave_link::exit_debugger_event (); + + octave_link::pre_input_event (); + + octave_link::set_workspace (); + } + + bool history_skip_auto_repeated_debugging_command = false; + + std::string ps = (pflag > 0) ? VPS1 : VPS2; + + std::string prompt = command_editor::decode_prompt_string (ps); + + pipe_handler_error_count = 0; + + flush_octave_stdout (); + + octave_pager_stream::reset (); + octave_diary_stream::reset (); + + octave_diary << prompt; + + retval = interactive_input (prompt, eof); + + // There is no need to update the load_path cache if there is no + // user input. + if (retval != "\n" + && retval.find_first_not_of (" \t\n\r") != std::string::npos) + { + load_path::update (); + + if (Vdebugging) + last_debugging_command = retval; + else + last_debugging_command = "\n"; + } + else if (Vdebugging) + { + retval = last_debugging_command; + history_skip_auto_repeated_debugging_command = true; + } + + if (retval != "\n") + { + if (! history_skip_auto_repeated_debugging_command) + { + command_history::add (retval); + + if (! command_history::ignoring_entries ()) + octave_link::append_history (retval); + } + + octave_diary << retval; + + if (retval[retval.length () - 1] != '\n') + octave_diary << "\n"; + + do_input_echo (retval); + } + else + octave_diary << "\n"; + + // Process post input event hook function after the internal history + // list has been updated. + + if (interactive || forced_interactive) + octave_link::post_input_event (); + + return retval; +} + +// Fix things up so that input can come from the standard input. This +// may need to become much more complicated, which is why it's in a +// separate function. + +FILE * +get_input_from_stdin (void) +{ + command_editor::set_input_stream (stdin); + return command_editor::get_input_stream (); +} + +// FIXME -- make this generate file names when appropriate. + +static string_vector +generate_possible_completions (const std::string& text, std::string& prefix, + std::string& hint) +{ + string_vector names; + + prefix = ""; + + if (looks_like_struct (text)) + names = generate_struct_completions (text, prefix, hint); + else + names = make_name_list (); + + // Sort and remove duplicates. + + names.sort (true); + + return names; +} + +static bool +is_completing_dirfns (void) +{ + static std::string dirfns_commands[] = {"cd", "ls"}; + static const size_t dirfns_commands_length = 2; + + bool retval = false; + + std::string line = command_editor::get_line_buffer (); + + for (size_t i = 0; i < dirfns_commands_length; i++) + { + int index = line.find (dirfns_commands[i] + " "); + + if (index == 0) + { + retval = true; + break; + } + } + + return retval; +} + +static std::string +generate_completion (const std::string& text, int state) +{ + std::string retval; + + static std::string prefix; + static std::string hint; + + static size_t hint_len = 0; + + static int list_index = 0; + static int name_list_len = 0; + static int name_list_total_len = 0; + static string_vector name_list; + static string_vector file_name_list; + + static int matches = 0; + + if (state == 0) + { + list_index = 0; + + prefix = ""; + + hint = text; + + // No reason to display symbols while completing a + // file/directory operation. + + if (is_completing_dirfns ()) + name_list = string_vector (); + else + name_list = generate_possible_completions (text, prefix, hint); + + name_list_len = name_list.length (); + + file_name_list = command_editor::generate_filename_completions (text); + + name_list.append (file_name_list); + + name_list_total_len = name_list.length (); + + hint_len = hint.length (); + + matches = 0; + + for (int i = 0; i < name_list_len; i++) + if (hint == name_list[i].substr (0, hint_len)) + matches++; + } + + if (name_list_total_len > 0 && matches > 0) + { + while (list_index < name_list_total_len) + { + std::string name = name_list[list_index]; + + list_index++; + + if (hint == name.substr (0, hint_len)) + { + if (list_index <= name_list_len && ! prefix.empty ()) + retval = prefix + "." + name; + else + retval = name; + + // FIXME -- looks_like_struct is broken for now, + // so it always returns false. + + if (matches == 1 && looks_like_struct (retval)) + { + // Don't append anything, since we don't know + // whether it should be '(' or '.'. + + command_editor::set_completion_append_character ('\0'); + } + else + command_editor::set_completion_append_character + (Vcompletion_append_char); + + break; + } + } + } + + return retval; +} + +static std::string +quoting_filename (const std::string &text, int, char quote) +{ + if (quote) + return text; + else + return (std::string ("'") + text); +} + +void +initialize_command_input (void) +{ + // If we are using readline, this allows conditional parsing of the + // .inputrc file. + + command_editor::set_name ("Octave"); + + // FIXME -- this needs to include a comma too, but that + // causes trouble for the new struct element completion code. + + static const char *s = "\t\n !\"\'*+-/:;<=>(){}[\\]^`~"; + + command_editor::set_basic_word_break_characters (s); + + command_editor::set_completer_word_break_characters (s); + + command_editor::set_basic_quote_characters ("\""); + + command_editor::set_filename_quote_characters (" \t\n\\\"'@<>=;|&()#$`?*[!:{"); + command_editor::set_completer_quote_characters ("'\""); + + command_editor::set_completion_function (generate_completion); + + command_editor::set_quoting_function (quoting_filename); +} + +static void +execute_in_debugger_handler (const std::pair& arg) +{ + octave_link::execute_in_debugger_event (arg.first, arg.second); +} + +static void +get_debug_input (const std::string& prompt) +{ + unwind_protect frame; + + octave_user_code *caller = octave_call_stack::caller_user_code (); + std::string nm; + + int curr_debug_line = octave_call_stack::current_line (); + + bool have_file = false; + + if (caller) + { + nm = caller->fcn_file_name (); + + if (nm.empty ()) + nm = caller->name (); + else + have_file = true; + } + else + curr_debug_line = -1; + + std::ostringstream buf; + + if (! nm.empty ()) + { + if (Vgud_mode) + { + static char ctrl_z = 'Z' & 0x1f; + + buf << ctrl_z << ctrl_z << nm << ":" << curr_debug_line; + } + else + { + // FIXME -- we should come up with a clean way to detect + // that we are stopped on the no-op command that marks the + // end of a function or script. + + buf << "stopped in " << nm; + + if (curr_debug_line > 0) + buf << " at line " << curr_debug_line; + + if (have_file) + { + octave_link::enter_debugger_event (nm, curr_debug_line); + + octave_link::set_workspace (); + + frame.add_fcn (execute_in_debugger_handler, + std::pair (nm, curr_debug_line)); + + std::string line_buf + = get_file_line (nm, curr_debug_line); + + if (! line_buf.empty ()) + buf << "\n" << curr_debug_line << ": " << line_buf; + } + } + } + + std::string msg = buf.str (); + + if (! msg.empty ()) + std::cerr << msg << std::endl; + + frame.protect_var (VPS1); + VPS1 = prompt; + + if (! (interactive || forced_interactive) + || LEXER->reading_fcn_file + || LEXER->reading_classdef_file + || LEXER->reading_script_file + || LEXER->input_from_eval_string ()) + { + frame.protect_var (forced_interactive); + forced_interactive = true; + } + + // octave_parser constructor sets this for us. + frame.protect_var (LEXER); + + octave_parser curr_parser; + + while (Vdebugging) + { + unwind_protect middle_frame; + + reset_error_handler (); + + curr_parser.reset (); + + int retval = curr_parser.run (); + + if (command_editor::interrupt (false)) + break; + else + { + if (retval == 0 && curr_parser.stmt_list) + { + curr_parser.stmt_list->accept (*current_evaluator); + + if (octave_completion_matches_called) + octave_completion_matches_called = false; + } + + octave_quit (); + } + } +} + +const std::string octave_base_reader::in_src ("invalid"); + +const std::string octave_terminal_reader::in_src ("terminal"); + +std::string +octave_terminal_reader::get_input (bool& eof) +{ + octave_quit (); + + eof = false; + + return octave_gets (eof); +} + +const std::string octave_file_reader::in_src ("file"); + +std::string +octave_file_reader::get_input (bool& eof) +{ + octave_quit (); + + eof = false; + + return octave_fgets (file, eof); +} + +const std::string octave_eval_string_reader::in_src ("eval_string"); + +std::string +octave_eval_string_reader::get_input (bool& eof) +{ + octave_quit (); + + eof = false; + + std::string retval; + + retval = eval_string; + + // Clear the eval string so that the next call will return + // an empty character string with EOF = true. + eval_string = ""; + + if (retval.empty ()) + eof = true; + + return retval; +} + +// If the user simply hits return, this will produce an empty matrix. + +static octave_value_list +get_user_input (const octave_value_list& args, int nargout) +{ + octave_value_list retval; + + int nargin = args.length (); + + int read_as_string = 0; + + if (nargin == 2) + read_as_string++; + + std::string prompt = args(0).string_value (); + + if (error_state) + { + error ("input: unrecognized argument"); + return retval; + } + + flush_octave_stdout (); + + octave_pager_stream::reset (); + octave_diary_stream::reset (); + + octave_diary << prompt; + + bool eof = false; + + std::string input_buf = interactive_input (prompt.c_str (), eof); + + if (! (error_state || input_buf.empty ())) + { + size_t len = input_buf.length (); + + octave_diary << input_buf; + + if (input_buf[len - 1] != '\n') + octave_diary << "\n"; + + if (len < 1) + return read_as_string ? octave_value ("") : octave_value (Matrix ()); + + if (read_as_string) + { + // FIXME -- fix gnu_readline and octave_gets instead! + if (input_buf.length () == 1 && input_buf[0] == '\n') + retval(0) = ""; + else + retval(0) = input_buf; + } + else + { + int parse_status = 0; + + retval = eval_string (input_buf, true, parse_status, nargout); + + if (! Vdebugging && retval.length () == 0) + retval(0) = Matrix (); + } + } + else + error ("input: reading user-input failed!"); + + return retval; +} + +DEFUN (input, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{ans} =} input (@var{prompt})\n\ +@deftypefnx {Built-in Function} {@var{ans} =} input (@var{prompt}, \"s\")\n\ +Print a prompt and wait for user input. For example,\n\ +\n\ +@example\n\ +input (\"Pick a number, any number! \")\n\ +@end example\n\ +\n\ +@noindent\n\ +prints the prompt\n\ +\n\ +@example\n\ +Pick a number, any number!\n\ +@end example\n\ +\n\ +@noindent\n\ +and waits for the user to enter a value. The string entered by the user\n\ +is evaluated as an expression, so it may be a literal constant, a\n\ +variable name, or any other valid expression.\n\ +\n\ +Currently, @code{input} only returns one value, regardless of the number\n\ +of values produced by the evaluation of the expression.\n\ +\n\ +If you are only interested in getting a literal string value, you can\n\ +call @code{input} with the character string @code{\"s\"} as the second\n\ +argument. This tells Octave to return the string entered by the user\n\ +directly, without evaluating it first.\n\ +\n\ +Because there may be output waiting to be displayed by the pager, it is\n\ +a good idea to always call @code{fflush (stdout)} before calling\n\ +@code{input}. This will ensure that all pending output is written to\n\ +the screen before your prompt.\n\ +@seealso{yes_or_no, kbhit}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + retval = get_user_input (args, nargout); + else + print_usage (); + + return retval; +} + +bool +octave_yes_or_no (const std::string& prompt) +{ + std::string prompt_string = prompt + "(yes or no) "; + + while (1) + { + bool eof = false; + + std::string input_buf = interactive_input (prompt_string, eof); + + if (input_buf == "yes") + return true; + else if (input_buf == "no") + return false; + else + message (0, "Please answer yes or no."); + } +} + +DEFUN (yes_or_no, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{ans} =} yes_or_no (\"@var{prompt}\")\n\ +Ask the user a yes-or-no question. Return logical true if the answer is yes\n\ +or false if the answer is no. Takes one argument, @var{prompt}, which is\n\ +the string to display when asking the question. @var{prompt} should end in\n\ +a space; @code{yes-or-no} adds the string @samp{(yes or no) } to it. The\n\ +user must confirm the answer with @key{RET} and can edit it until it has\n\ +been confirmed.\n\ +@seealso{input}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0 || nargin == 1) + { + std::string prompt; + + if (nargin == 1) + { + prompt = args(0).string_value (); + + if (error_state) + { + error ("yes_or_no: PROMPT must be a character string"); + return retval; + } + } + + retval = octave_yes_or_no (prompt); + } + else + print_usage (); + + return retval; +} + +octave_value +do_keyboard (const octave_value_list& args) +{ + octave_value retval; + + int nargin = args.length (); + + assert (nargin == 0 || nargin == 1); + + unwind_protect frame; + + frame.add_fcn (command_history::ignore_entries, + command_history::ignoring_entries ()); + + command_history::ignore_entries (false); + + frame.protect_var (Vdebugging); + + frame.add_fcn (octave_call_stack::restore_frame, + octave_call_stack::current_frame ()); + + // FIXME -- probably we just want to print one line, not the + // entire statement, which might span many lines... + // + // tree_print_code tpc (octave_stdout); + // stmt.accept (tpc); + + Vdebugging = true; + + std::string prompt = "debug> "; + if (nargin > 0) + prompt = args(0).string_value (); + + if (! error_state) + get_debug_input (prompt); + + return retval; +} + +DEFUN (keyboard, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} keyboard ()\n\ +@deftypefnx {Built-in Function} {} keyboard (\"@var{prompt}\")\n\ +This function is normally used for simple debugging. When the\n\ +@code{keyboard} function is executed, Octave prints a prompt and waits\n\ +for user input. The input strings are then evaluated and the results\n\ +are printed. This makes it possible to examine the values of variables\n\ +within a function, and to assign new values if necessary. To leave the\n\ +prompt and return to normal execution type @samp{return} or @samp{dbcont}.\n\ +The @code{keyboard} function does not return an exit status.\n\ +\n\ +If @code{keyboard} is invoked without arguments, a default prompt of\n\ +@samp{debug> } is used.\n\ +@seealso{dbcont, dbquit}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 0 || nargin == 1) + { + unwind_protect frame; + + frame.add_fcn (octave_call_stack::restore_frame, + octave_call_stack::current_frame ()); + + // Skip the frame assigned to the keyboard function. + octave_call_stack::goto_frame_relative (0); + + tree_evaluator::debug_mode = true; + + tree_evaluator::current_frame = octave_call_stack::current_frame (); + + do_keyboard (args); + } + else + print_usage (); + + return retval; +} + +DEFUN (echo, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} echo options\n\ +Control whether commands are displayed as they are executed. Valid\n\ +options are:\n\ +\n\ +@table @code\n\ +@item on\n\ +Enable echoing of commands as they are executed in script files.\n\ +\n\ +@item off\n\ +Disable echoing of commands as they are executed in script files.\n\ +\n\ +@item on all\n\ +Enable echoing of commands as they are executed in script files and\n\ +functions.\n\ +\n\ +@item off all\n\ +Disable echoing of commands as they are executed in script files and\n\ +functions.\n\ +@end table\n\ +\n\ +@noindent\n\ +With no arguments, @code{echo} toggles the current echo state.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("echo"); + + if (error_state) + return retval; + + switch (argc) + { + case 1: + { + if ((Vecho_executing_commands & ECHO_SCRIPTS) + || (Vecho_executing_commands & ECHO_FUNCTIONS)) + Vecho_executing_commands = ECHO_OFF; + else + Vecho_executing_commands = ECHO_SCRIPTS; + } + break; + + case 2: + { + std::string arg = argv[1]; + + if (arg == "on") + Vecho_executing_commands = ECHO_SCRIPTS; + else if (arg == "off") + Vecho_executing_commands = ECHO_OFF; + else + print_usage (); + } + break; + + case 3: + { + std::string arg = argv[1]; + + if (arg == "on" && argv[2] == "all") + { + int tmp = (ECHO_SCRIPTS | ECHO_FUNCTIONS); + Vecho_executing_commands = tmp; + } + else if (arg == "off" && argv[2] == "all") + Vecho_executing_commands = ECHO_OFF; + else + print_usage (); + } + break; + + default: + print_usage (); + break; + } + + return retval; +} + +DEFUN (completion_matches, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} completion_matches (@var{hint})\n\ +Generate possible completions given @var{hint}.\n\ +\n\ +This function is provided for the benefit of programs like Emacs which\n\ +might be controlling Octave and handling user input. The current\n\ +command number is not incremented when this function is called. This is\n\ +a feature, not a bug.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + std::string hint = args(0).string_value (); + + if (! error_state) + { + int n = 32; + + string_vector list (n); + + int k = 0; + + for (;;) + { + std::string cmd = generate_completion (hint, k); + + if (! cmd.empty ()) + { + if (k == n) + { + n *= 2; + list.resize (n); + } + + list[k++] = cmd; + } + else + { + list.resize (k); + break; + } + } + + if (nargout > 0) + { + if (! list.empty ()) + retval = list; + else + retval = ""; + } + else + { + // We don't use string_vector::list_in_columns here + // because it will be easier for Emacs if the names + // appear in a single column. + + int len = list.length (); + + for (int i = 0; i < len; i++) + octave_stdout << list[i] << "\n"; + } + + octave_completion_matches_called = true; + } + } + else + print_usage (); + + return retval; +} + +DEFUN (readline_read_init_file, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} readline_read_init_file (@var{file})\n\ +Read the readline library initialization file @var{file}. If\n\ +@var{file} is omitted, read the default initialization file (normally\n\ +@file{~/.inputrc}).\n\ +\n\ +@xref{Readline Init File, , , readline, GNU Readline Library},\n\ +for details.\n\ +@seealso{readline_re_read_init_file}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 0) + command_editor::read_init_file (); + else if (nargin == 1) + { + std::string file = args(0).string_value (); + + if (! error_state) + command_editor::read_init_file (file); + } + else + print_usage (); + + return retval; +} + +DEFUN (readline_re_read_init_file, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} readline_re_read_init_file ()\n\ +Re-read the last readline library initialization file that was read.\n\ +@xref{Readline Init File, , , readline, GNU Readline Library},\n\ +for details.\n\ +@seealso{readline_read_init_file}\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 0) + command_editor::re_read_init_file (); + else + print_usage (); + + return retval; +} + +static int +internal_input_event_hook_fcn (void) +{ + input_event_hook_functions.run (); + + if (input_event_hook_functions.empty ()) + command_editor::remove_event_hook (internal_input_event_hook_fcn); + + return 0; +} + +DEFUN (add_input_event_hook, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{id} =} add_input_event_hook (@var{fcn})\n\ +@deftypefnx {Built-in Function} {@var{id} =} add_input_event_hook (@var{fcn}, @var{data})\n\ +Add the named function or function handle @var{fcn} to the list of functions\n\ +to call periodically when Octave is waiting for input. The function should\n\ +have the form\n\ +\n\ +@example\n\ +@var{fcn} (@var{data})\n\ +@end example\n\ +\n\ +If @var{data} is omitted, Octave calls the function without any\n\ +arguments.\n\ +\n\ +The returned identifier may be used to remove the function handle from\n\ +the list of input hook functions.\n\ +@seealso{remove_input_event_hook}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + octave_value user_data; + + if (nargin == 2) + user_data = args(1); + + hook_function hook_fcn (args(0), user_data); + + if (! error_state) + { + if (input_event_hook_functions.empty ()) + command_editor::add_event_hook (internal_input_event_hook_fcn); + + input_event_hook_functions.insert (hook_fcn.id (), hook_fcn); + + retval = hook_fcn.id (); + } + else + error ("add_input_event_hook: expecting function handle or character string as first argument"); + } + else + print_usage (); + + return retval; +} + +DEFUN (remove_input_event_hook, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} remove_input_event_hook (@var{name})\n\ +@deftypefnx {Built-in Function} {} remove_input_event_hook (@var{fcn_id})\n\ +Remove the named function or function handle with the given identifier\n\ +from the list of functions to call periodically when Octave is waiting\n\ +for input.\n\ +@seealso{add_input_event_hook}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + std::string hook_fcn_id = args(0).string_value (); + + bool warn = (nargin < 2); + + if (! error_state) + { + hook_function_list::iterator p + = input_event_hook_functions.find (hook_fcn_id); + + if (p != input_event_hook_functions.end ()) + input_event_hook_functions.erase (p); + else if (warn) + warning ("remove_input_event_hook: %s not found in list", + hook_fcn_id.c_str ()); + + if (input_event_hook_functions.empty ()) + command_editor::remove_event_hook (internal_input_event_hook_fcn); + } + else + error ("remove_input_event_hook: argument not valid as a hook function name or id"); + } + else + print_usage (); + + return retval; +} + +DEFUN (PS1, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} PS1 ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} PS1 (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} PS1 (@var{new_val}, \"local\")\n\ +Query or set the primary prompt string. When executing interactively,\n\ +Octave displays the primary prompt when it is ready to read a command.\n\ +\n\ +The default value of the primary prompt string is @code{\"\\s:\\#> \"}.\n\ +To change it, use a command like\n\ +\n\ +@example\n\ +PS1 (\"\\\\u@@\\\\H> \")\n\ +@end example\n\ +\n\ +@noindent\n\ +which will result in the prompt @samp{boris@@kremvax> } for the user\n\ +@samp{boris} logged in on the host @samp{kremvax.kgb.su}. Note that two\n\ +backslashes are required to enter a backslash into a double-quoted\n\ +character string. @xref{Strings}.\n\ +\n\ +You can also use ANSI escape sequences if your terminal supports them.\n\ +This can be useful for coloring the prompt. For example,\n\ +\n\ +@example\n\ +PS1 (\"\\\\[\\\\033[01;31m\\\\]\\\\s:\\\\#> \\\\[\\\\033[0m\\\\]\")\n\ +@end example\n\ +\n\ +@noindent\n\ +will give the default Octave prompt a red coloring.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{PS2, PS4}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (PS1); +} + +DEFUN (PS2, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} PS2 ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} PS2 (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} PS2 (@var{new_val}, \"local\")\n\ +Query or set the secondary prompt string. The secondary prompt is\n\ +printed when Octave is expecting additional input to complete a\n\ +command. For example, if you are typing a @code{for} loop that spans several\n\ +lines, Octave will print the secondary prompt at the beginning of\n\ +each line after the first. The default value of the secondary prompt\n\ +string is @code{\"> \"}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{PS1, PS4}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (PS2); +} + +DEFUN (PS4, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} PS4 ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} PS4 (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} PS4 (@var{new_val}, \"local\")\n\ +Query or set the character string used to prefix output produced\n\ +when echoing commands is enabled.\n\ +The default value is @code{\"+ \"}.\n\ +@xref{Diary and Echo Commands}, for a description of echoing commands.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{echo, echo_executing_commands, PS1, PS2}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (PS4); +} + +DEFUN (completion_append_char, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} completion_append_char ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} completion_append_char (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} completion_append_char (@var{new_val}, \"local\")\n\ +Query or set the internal character variable that is appended to\n\ +successful command-line completion attempts. The default\n\ +value is @code{\" \"} (a single space).\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (completion_append_char); +} + +DEFUN (echo_executing_commands, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} echo_executing_commands ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} echo_executing_commands (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} echo_executing_commands (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls the echo state.\n\ +It may be the sum of the following values:\n\ +\n\ +@table @asis\n\ +@item 1\n\ +Echo commands read from script files.\n\ +\n\ +@item 2\n\ +Echo commands from functions.\n\ +\n\ +@item 4\n\ +Echo commands read from command line.\n\ +@end table\n\ +\n\ +More than one state can be active at once. For example, a value of 3 is\n\ +equivalent to the command @kbd{echo on all}.\n\ +\n\ +The value of @code{echo_executing_commands} may be set by the @kbd{echo}\n\ +command or the command line option @option{--echo-commands}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (echo_executing_commands); +} + +DEFUN (__request_drawnow__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __request_drawnow__ ()\n\ +@deftypefnx {Built-in Function} {} __request_drawnow__ (@var{flag})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + Vdrawnow_requested = true; + else if (nargin == 1) + Vdrawnow_requested = args(0).bool_value (); + else + print_usage (); + + return retval; +} + +DEFUN (__gud_mode__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __gud_mode__ ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + retval = Vgud_mode; + else if (nargin == 1) + Vgud_mode = args(0).bool_value (); + else + print_usage (); + + return retval; +} + +DEFUN (filemarker, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} filemarker ()\n\ +@deftypefnx {Built-in Function} {} filemarker (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} filemarker (@var{new_val}, \"local\")\n\ +Query or set the character used to separate filename from the\n\ +the subfunction names contained within the file. This can be used in\n\ +a generic manner to interact with subfunctions. For example,\n\ +\n\ +@example\n\ +help ([\"myfunc\", filemarker, \"mysubfunc\"])\n\ +@end example\n\ +\n\ +@noindent\n\ +returns the help string associated with the subfunction @code{mysubfunc}\n\ +of the function @code{myfunc}. Another use of @code{filemarker} is when\n\ +debugging it allows easier placement of breakpoints within subfunctions.\n\ +For example,\n\ +\n\ +@example\n\ +dbstop ([\"myfunc\", filemarker, \"mysubfunc\"])\n\ +@end example\n\ +\n\ +@noindent\n\ +will set a breakpoint at the first line of the subfunction @code{mysubfunc}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + char tmp = Vfilemarker; + octave_value retval = SET_INTERNAL_VARIABLE (filemarker); + + // The character passed must not be a legal character for a function name + if (! error_state && (::isalnum (Vfilemarker) || Vfilemarker == '_')) + { + Vfilemarker = tmp; + error ("filemarker: character can not be a valid character for a function name"); + } + + return retval; +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/input.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/input.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,246 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Use the GNU readline library for command line editing and hisory. + +#if !defined (octave_input_h) +#define octave_input_h 1 + +#include + +#include + +#include "oct-time.h" +#include "oct-obj.h" +#include "pager.h" + +class octave_value; + +extern OCTINTERP_API FILE *get_input_from_stdin (void); + +// TRUE means this is an interactive shell. +extern bool interactive; + +// TRUE means the user forced this shell to be interactive (-i). +extern bool forced_interactive; + +// TRUE after a call to completion_matches. +extern bool octave_completion_matches_called; + +// TRUE if the plotting system has requested a call to drawnow at +// the next user prompt. +extern OCTINTERP_API bool Vdrawnow_requested; + +// TRUE if we are in debugging mode. +extern OCTINTERP_API bool Vdebugging; + +extern void initialize_command_input (void); + +extern bool octave_yes_or_no (const std::string& prompt); + +extern octave_value do_keyboard (const octave_value_list& args = octave_value_list ()); + +extern void remove_input_event_hook_functions (void); + +extern void set_default_prompts (void); + +extern std::string VPS4; + +extern char Vfilemarker; + +enum echo_state +{ + ECHO_OFF = 0, + ECHO_SCRIPTS = 1, + ECHO_FUNCTIONS = 2, + ECHO_CMD_LINE = 4 +}; + +extern int Vecho_executing_commands; + +extern octave_time Vlast_prompt_time; + +class +octave_base_reader +{ +public: + + friend class octave_input_reader; + + octave_base_reader (void) : count (1), pflag (0) { } + + octave_base_reader (const octave_base_reader&) : count (1) { } + + virtual ~octave_base_reader (void) { } + + virtual std::string get_input (bool& eof) = 0; + + virtual std::string input_source (void) const { return in_src; } + + void reset (void) { promptflag (1); } + + void increment_promptflag (void) { pflag++; } + + void decrement_promptflag (void) { pflag--; } + + int promptflag (void) const { return pflag; } + + int promptflag (int n) + { + int retval = pflag; + pflag = n; + return retval; + } + + std::string octave_gets (bool& eof); + +private: + + int count; + + int pflag; + + void do_input_echo (const std::string&) const; + + static const std::string in_src; +}; + +class +octave_terminal_reader : public octave_base_reader +{ +public: + + octave_terminal_reader (void) : octave_base_reader () { } + + std::string get_input (bool& eof); + + std::string input_source (void) const { return in_src; } + +private: + + static const std::string in_src; +}; + +class +octave_file_reader : public octave_base_reader +{ +public: + + octave_file_reader (FILE *f_arg) + : octave_base_reader (), file (f_arg) { } + + std::string get_input (bool& eof); + + std::string input_source (void) const { return in_src; } + +private: + + FILE *file; + + static const std::string in_src; +}; + +class +octave_eval_string_reader : public octave_base_reader +{ +public: + + octave_eval_string_reader (const std::string& str) + : octave_base_reader (), eval_string (str) + { } + + std::string get_input (bool& eof); + + std::string input_source (void) const { return in_src; } + +private: + + std::string eval_string; + + static const std::string in_src; +}; + +class +octave_input_reader +{ +public: + octave_input_reader (void) + : rep (new octave_terminal_reader ()) + { } + + octave_input_reader (FILE *file) + : rep (new octave_file_reader (file)) + { } + + octave_input_reader (const std::string& str) + : rep (new octave_eval_string_reader (str)) + { } + + octave_input_reader (const octave_input_reader& ir) + { + rep = ir.rep; + rep->count++; + } + + octave_input_reader& operator = (const octave_input_reader& ir) + { + if (&ir != this) + { + rep = ir.rep; + rep->count++; + } + + return *this; + } + + ~octave_input_reader (void) + { + if (--rep->count == 0) + delete rep; + } + + void reset (void) { return rep->reset (); } + + void increment_promptflag (void) { rep->increment_promptflag (); } + + void decrement_promptflag (void) { rep->decrement_promptflag (); } + + int promptflag (void) const { return rep->promptflag (); } + + int promptflag (int n) { return rep->promptflag (n); } + + std::string get_input (bool& eof) + { + return rep->get_input (eof); + } + + std::string input_source (void) const + { + return rep->input_source (); + } + +private: + + octave_base_reader *rep; +}; + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/jit-ir.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/jit-ir.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,840 @@ +/* + +Copyright (C) 2012 Max Brister + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Author: Max Brister + +// defines required by llvm +#define __STDC_LIMIT_MACROS +#define __STDC_CONSTANT_MACROS + +#ifdef HAVE_CONFIG_H +#include +#endif + +#ifdef HAVE_LLVM + +#include "jit-ir.h" + +#include +#include + +#include "error.h" + +// -------------------- jit_factory -------------------- +jit_factory::~jit_factory (void) +{ + for (value_list::iterator iter = all_values.begin (); + iter != all_values.end (); ++iter) + delete *iter; +} + +void +jit_factory::track_value (jit_value *value) +{ + if (value->type ()) + mconstants.push_back (value); + all_values.push_back (value); +} + +// -------------------- jit_block_list -------------------- +void +jit_block_list::insert_after (iterator iter, jit_block *ablock) +{ + ++iter; + insert_before (iter, ablock); +} + +void +jit_block_list::insert_after (jit_block *loc, jit_block *ablock) +{ + insert_after (loc->location (), ablock); +} + +void +jit_block_list::insert_before (iterator iter, jit_block *ablock) +{ + iter = mlist.insert (iter, ablock); + ablock->stash_location (iter); +} + +void +jit_block_list::insert_before (jit_block *loc, jit_block *ablock) +{ + insert_before (loc->location (), ablock); +} + +void +jit_block_list::label (void) +{ + if (mlist.size ()) + { + jit_block *block = mlist.back (); + block->label (); + } +} + +std::ostream& +jit_block_list::print (std::ostream& os, const std::string& header) const +{ + os << "-------------------- " << header << " --------------------\n"; + return os << *this; +} + +std::ostream& +jit_block_list::print_dom (std::ostream& os) const +{ + os << "-------------------- dom info --------------------\n"; + for (const_iterator iter = begin (); iter != end (); ++iter) + { + assert (*iter); + (*iter)->print_dom (os); + } + os << std::endl; + + return os; +} + +void +jit_block_list::push_back (jit_block *b) +{ + mlist.push_back (b); + iterator iter = mlist.end (); + b->stash_location (--iter); +} + +std::ostream& +operator<<(std::ostream& os, const jit_block_list& blocks) +{ + for (jit_block_list::const_iterator iter = blocks.begin (); + iter != blocks.end (); ++iter) + { + assert (*iter); + (*iter)->print (os, 0); + } + return os << std::endl; +} + +// -------------------- jit_use -------------------- +jit_block * +jit_use::user_parent (void) const +{ + return muser->parent (); +} + +// -------------------- jit_value -------------------- +jit_value::~jit_value (void) +{} + +jit_block * +jit_value::first_use_block (void) +{ + jit_use *use = first_use (); + while (use) + { + if (! isa (use->user ())) + return use->user_parent (); + + use = use->next (); + } + + return 0; +} + +void +jit_value::replace_with (jit_value *value) +{ + while (first_use ()) + { + jit_instruction *user = first_use ()->user (); + size_t idx = first_use ()->index (); + user->stash_argument (idx, value); + } +} + +#define JIT_METH(clname) \ + void \ + jit_ ## clname::accept (jit_ir_walker& walker) \ + { \ + walker.visit (*this); \ + } + +JIT_VISIT_IR_NOTEMPLATE +#undef JIT_METH + +std::ostream& +operator<< (std::ostream& os, const jit_value& value) +{ + return value.short_print (os); +} + +std::ostream& +jit_print (std::ostream& os, jit_value *avalue) +{ + if (avalue) + return avalue->print (os); + return os << "NULL"; +} + +// -------------------- jit_instruction -------------------- +void +jit_instruction::remove (void) +{ + if (mparent) + mparent->remove (mlocation); + resize_arguments (0); +} + +llvm::BasicBlock * +jit_instruction::parent_llvm (void) const +{ + return mparent->to_llvm (); +} + +std::ostream& +jit_instruction::short_print (std::ostream& os) const +{ + if (type ()) + jit_print (os, type ()) << ": "; + return os << "#" << mid; +} + +void +jit_instruction::do_construct_ssa (size_t start, size_t end) +{ + for (size_t i = start; i < end; ++i) + { + jit_value *arg = argument (i); + jit_variable *var = dynamic_cast (arg); + if (var && var->has_top ()) + stash_argument (i, var->top ()); + } +} + +// -------------------- jit_block -------------------- +void +jit_block::replace_with (jit_value *value) +{ + assert (isa (value)); + jit_block *block = static_cast (value); + + jit_value::replace_with (block); + + while (ILIST_T::first_use ()) + { + jit_phi_incomming *incomming = ILIST_T::first_use (); + incomming->stash_value (block); + } +} + +void +jit_block::replace_in_phi (jit_block *ablock, jit_block *with) +{ + jit_phi_incomming *node = ILIST_T::first_use (); + while (node) + { + jit_phi_incomming *prev = node; + node = node->next (); + + if (prev->user_parent () == ablock) + prev->stash_value (with); + } +} + +jit_block * +jit_block::maybe_merge () +{ + if (successor_count () == 1 && successor (0) != this + && (successor (0)->use_count () == 1 || instructions.size () == 1)) + { + jit_block *to_merge = successor (0); + merge (*to_merge); + return to_merge; + } + + return 0; +} + +void +jit_block::merge (jit_block& block) +{ + // the merge block will contain a new terminator + jit_terminator *old_term = terminator (); + if (old_term) + old_term->remove (); + + bool was_empty = end () == begin (); + iterator merge_begin = end (); + if (! was_empty) + --merge_begin; + + instructions.splice (end (), block.instructions); + if (was_empty) + merge_begin = begin (); + else + ++merge_begin; + + // now merge_begin points to the start of the new instructions, we must + // update their parent information + for (iterator iter = merge_begin; iter != end (); ++iter) + { + jit_instruction *instr = *iter; + instr->stash_parent (this, iter); + } + + block.replace_with (this); +} + +jit_instruction * +jit_block::prepend (jit_instruction *instr) +{ + instructions.push_front (instr); + instr->stash_parent (this, instructions.begin ()); + return instr; +} + +jit_instruction * +jit_block::prepend_after_phi (jit_instruction *instr) +{ + // FIXME: Make this O(1) + for (iterator iter = begin (); iter != end (); ++iter) + { + jit_instruction *temp = *iter; + if (! isa (temp)) + { + insert_before (iter, instr); + return instr; + } + } + + return append (instr); +} + +void +jit_block::internal_append (jit_instruction *instr) +{ + instructions.push_back (instr); + instr->stash_parent (this, --instructions.end ()); +} + +jit_instruction * +jit_block::insert_before (iterator loc, jit_instruction *instr) +{ + iterator iloc = instructions.insert (loc, instr); + instr->stash_parent (this, iloc); + return instr; +} + +jit_instruction * +jit_block::insert_after (iterator loc, jit_instruction *instr) +{ + ++loc; + iterator iloc = instructions.insert (loc, instr); + instr->stash_parent (this, iloc); + return instr; +} + +jit_terminator * +jit_block::terminator (void) const +{ + assert (this); + if (instructions.empty ()) + return 0; + + jit_instruction *last = instructions.back (); + return dynamic_cast (last); +} + +bool +jit_block::branch_alive (jit_block *asucc) const +{ + return terminator ()->alive (asucc); +} + +jit_block * +jit_block::successor (size_t i) const +{ + jit_terminator *term = terminator (); + return term->successor (i); +} + +size_t +jit_block::successor_count (void) const +{ + jit_terminator *term = terminator (); + return term ? term->successor_count () : 0; +} + +llvm::BasicBlock * +jit_block::to_llvm (void) const +{ + return llvm::cast (llvm_value); +} + +std::ostream& +jit_block::print_dom (std::ostream& os) const +{ + short_print (os); + os << ":\n"; + os << " mid: " << mid << std::endl; + os << " predecessors: "; + for (jit_use *use = first_use (); use; use = use->next ()) + os << *use->user_parent () << " "; + os << std::endl; + + os << " successors: "; + for (size_t i = 0; i < successor_count (); ++i) + os << *successor (i) << " "; + os << std::endl; + + os << " idom: "; + if (idom) + os << *idom; + else + os << "NULL"; + os << std::endl; + os << " df: "; + for (df_iterator iter = df_begin (); iter != df_end (); ++iter) + os << **iter << " "; + os << std::endl; + + os << " dom_succ: "; + for (size_t i = 0; i < dom_succ.size (); ++i) + os << *dom_succ[i] << " "; + + return os << std::endl; +} + +void +jit_block::compute_df (size_t avisit_count) +{ + if (visited (avisit_count)) + return; + + if (use_count () >= 2) + { + for (jit_use *use = first_use (); use; use = use->next ()) + { + jit_block *runner = use->user_parent (); + while (runner != idom) + { + runner->mdf.insert (this); + runner = runner->idom; + } + } + } + + for (size_t i = 0; i < successor_count (); ++i) + successor (i)->compute_df (avisit_count); +} + +bool +jit_block::update_idom (size_t avisit_count) +{ + if (visited (avisit_count) || ! use_count ()) + return false; + + bool changed = false; + for (jit_use *use = first_use (); use; use = use->next ()) + { + jit_block *pred = use->user_parent (); + changed = pred->update_idom (avisit_count) || changed; + } + + jit_use *use = first_use (); + jit_block *new_idom = use->user_parent (); + use = use->next (); + + for (; use; use = use->next ()) + { + jit_block *pred = use->user_parent (); + jit_block *pidom = pred->idom; + if (pidom) + new_idom = idom_intersect (pidom, new_idom); + } + + if (idom != new_idom) + { + idom = new_idom; + return true; + } + + return changed; +} + +void +jit_block::label (size_t avisit_count, size_t& number) +{ + if (visited (avisit_count)) + return; + + for (jit_use *use = first_use (); use; use = use->next ()) + { + jit_block *pred = use->user_parent (); + pred->label (avisit_count, number); + } + + mid = number++; +} + +void +jit_block::pop_all (void) +{ + for (iterator iter = begin (); iter != end (); ++iter) + { + jit_instruction *instr = *iter; + instr->pop_variable (); + } +} + +std::ostream& +jit_block::print (std::ostream& os, size_t indent) const +{ + print_indent (os, indent); + short_print (os) << ": %pred = "; + for (jit_use *use = first_use (); use; use = use->next ()) + { + jit_block *pred = use->user_parent (); + os << *pred; + if (use->next ()) + os << ", "; + } + os << std::endl; + + for (const_iterator iter = begin (); iter != end (); ++iter) + { + jit_instruction *instr = *iter; + instr->print (os, indent + 1) << std::endl; + } + return os; +} + +jit_block * +jit_block::maybe_split (jit_factory& factory, jit_block_list& blocks, + jit_block *asuccessor) +{ + if (successor_count () > 1) + { + jit_terminator *term = terminator (); + size_t idx = term->successor_index (asuccessor); + jit_block *split = factory.create ("phi_split", mvisit_count); + + // place after this to ensure define before use in the blocks list + blocks.insert_after (this, split); + + term->stash_argument (idx, split); + jit_branch *br = split->append (factory.create (asuccessor)); + replace_in_phi (asuccessor, split); + + if (alive ()) + { + split->mark_alive (); + br->infer (); + } + + return split; + } + + return this; +} + +void +jit_block::create_dom_tree (size_t avisit_count) +{ + if (visited (avisit_count)) + return; + + if (idom != this) + idom->dom_succ.push_back (this); + + for (size_t i = 0; i < successor_count (); ++i) + successor (i)->create_dom_tree (avisit_count); +} + +jit_block * +jit_block::idom_intersect (jit_block *i, jit_block *j) +{ + while (i && j && i != j) + { + while (i && i->id () > j->id ()) + i = i->idom; + + while (i && j && j->id () > i->id ()) + j = j->idom; + } + + return i ? i : j; +} + +// -------------------- jit_phi_incomming -------------------- + +jit_block * +jit_phi_incomming::user_parent (void) const +{ return muser->parent (); } + +// -------------------- jit_phi -------------------- +bool +jit_phi::prune (void) +{ + jit_block *p = parent (); + size_t new_idx = 0; + jit_value *unique = argument (1); + + for (size_t i = 0; i < argument_count (); ++i) + { + jit_block *inc = incomming (i); + if (inc->branch_alive (p)) + { + if (unique != argument (i)) + unique = 0; + + if (new_idx != i) + { + stash_argument (new_idx, argument (i)); + mincomming[new_idx].stash_value (inc); + } + + ++new_idx; + } + } + + if (new_idx != argument_count ()) + { + resize_arguments (new_idx); + mincomming.resize (new_idx); + } + + assert (argument_count () > 0); + if (unique) + { + replace_with (unique); + return true; + } + + return false; +} + +bool +jit_phi::infer (void) +{ + jit_block *p = parent (); + if (! p->alive ()) + return false; + + jit_type *infered = 0; + for (size_t i = 0; i < argument_count (); ++i) + { + jit_block *inc = incomming (i); + if (inc->branch_alive (p)) + infered = jit_typeinfo::join (infered, argument_type (i)); + } + + if (infered != type ()) + { + stash_type (infered); + return true; + } + + return false; +} + +llvm::PHINode * +jit_phi::to_llvm (void) const +{ + return llvm::cast (jit_value::to_llvm ()); +} + +// -------------------- jit_terminator -------------------- +size_t +jit_terminator::successor_index (const jit_block *asuccessor) const +{ + size_t scount = successor_count (); + for (size_t i = 0; i < scount; ++i) + if (successor (i) == asuccessor) + return i; + + panic_impossible (); +} + +bool +jit_terminator::infer (void) +{ + if (! parent ()->alive ()) + return false; + + bool changed = false; + for (size_t i = 0; i < malive.size (); ++i) + if (! malive[i] && check_alive (i)) + { + changed = true; + malive[i] = true; + successor (i)->mark_alive (); + } + + return changed; +} + +llvm::TerminatorInst * +jit_terminator::to_llvm (void) const +{ + return llvm::cast (jit_value::to_llvm ()); +} + +// -------------------- jit_call -------------------- +bool +jit_call::needs_release (void) const +{ + if (type () && jit_typeinfo::get_release (type ()).valid ()) + { + for (jit_use *use = first_use (); use; use = use->next ()) + { + jit_assign *assign = dynamic_cast (use->user ()); + if (assign && assign->artificial ()) + return false; + } + + return true; + } + return false; +} + +bool +jit_call::infer (void) +{ + // FIXME: explain algorithm + for (size_t i = 0; i < argument_count (); ++i) + { + already_infered[i] = argument_type (i); + if (! already_infered[i]) + return false; + } + + jit_type *infered = moperation.result (already_infered); + if (! infered && use_count ()) + { + std::stringstream ss; + ss << "Missing overload in type inference for "; + print (ss, 0); + throw jit_fail_exception (ss.str ()); + } + + if (infered != type ()) + { + stash_type (infered); + return true; + } + + return false; +} + +// -------------------- jit_error_check -------------------- +std::string +jit_error_check::variable_to_string (variable v) +{ + switch (v) + { + case var_error_state: + return "error_state"; + case var_interrupt: + return "interrupt"; + default: + panic_impossible (); + } +} + +std::ostream& +jit_error_check::print (std::ostream& os, size_t indent) const +{ + print_indent (os, indent) << "error_check " << variable_to_string (mvariable) + << ", "; + + if (has_check_for ()) + os << " " << *check_for () << ", "; + print_successor (os << " ", 1) << ", "; + return print_successor (os << " ", 0); +} + +// -------------------- jit_magic_end -------------------- +jit_magic_end::context::context (jit_factory& factory, jit_value *avalue, + size_t aindex, size_t acount) + : value (avalue), index (factory.create (aindex)), + count (factory.create (acount)) +{} + +jit_magic_end::jit_magic_end (const std::vector& full_context) + : contexts (full_context) +{ + resize_arguments (contexts.size ()); + + size_t i; + std::vector::const_iterator iter; + for (iter = contexts.begin (), i = 0; iter != contexts.end (); ++iter, ++i) + stash_argument (i, iter->value); +} + +jit_magic_end::context +jit_magic_end::resolve_context (void) const +{ + size_t idx; + for (idx = 0; idx < contexts.size (); ++idx) + { + jit_type *ctx_type = contexts[idx].value->type (); + if (! ctx_type || ctx_type->skip_paren ()) + break; + } + + if (idx >= contexts.size ()) + idx = 0; + + context ret = contexts[idx]; + ret.value = argument (idx); + return ret; +} + +bool +jit_magic_end::infer (void) +{ + jit_type *new_type = overload ().result (); + if (new_type != type ()) + { + stash_type (new_type); + return true; + } + + return false; +} + +std::ostream& +jit_magic_end::print (std::ostream& os, size_t indent) const +{ + context ctx = resolve_context (); + short_print (print_indent (os, indent)) << " (" << *ctx.value << ", "; + return os << *ctx.index << ", " << *ctx.count << ")"; +} + +const jit_function& +jit_magic_end::overload () const +{ + const context& ctx = resolve_context (); + return jit_typeinfo::end (ctx.value, ctx.index, ctx.count); +} + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/jit-ir.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/jit-ir.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,1436 @@ +/* + +Copyright (C) 2012 Max Brister + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Author: Max Brister + +#if !defined (octave_jit_ir_h) +#define octave_jit_ir_h 1 + +#ifdef HAVE_LLVM + +#include +#include +#include + +#include "jit-typeinfo.h" + +// The low level octave jit ir +// this ir is close to llvm, but contains information for doing type inference. +// We convert the octave parse tree to this IR directly. + +#define JIT_VISIT_IR_NOTEMPLATE \ + JIT_METH(block); \ + JIT_METH(branch); \ + JIT_METH(cond_branch); \ + JIT_METH(call); \ + JIT_METH(extract_argument); \ + JIT_METH(store_argument); \ + JIT_METH(return); \ + JIT_METH(phi); \ + JIT_METH(variable); \ + JIT_METH(error_check); \ + JIT_METH(assign) \ + JIT_METH(argument) \ + JIT_METH(magic_end) + +#define JIT_VISIT_IR_CONST \ + JIT_METH(const_bool); \ + JIT_METH(const_scalar); \ + JIT_METH(const_complex); \ + JIT_METH(const_index); \ + JIT_METH(const_string); \ + JIT_METH(const_range) + +#define JIT_VISIT_IR_CLASSES \ + JIT_VISIT_IR_NOTEMPLATE \ + JIT_VISIT_IR_CONST + +// forward declare all ir classes +#define JIT_METH(cname) \ + class jit_ ## cname; + +JIT_VISIT_IR_NOTEMPLATE + +#undef JIT_METH + +// ABCs which aren't included in JIT_VISIT_IR_ALL +class jit_instruction; +class jit_terminator; + +template +class jit_const; + +typedef jit_const jit_const_bool; +typedef jit_const jit_const_scalar; +typedef jit_const jit_const_complex; +typedef jit_const jit_const_index; + +typedef jit_const jit_const_string; +typedef jit_const +jit_const_range; + +class jit_ir_walker; +class jit_use; + +// Creates and tracks memory for jit_value and subclasses. +// Memory managment is simple, all values that are created live as long as the +// factory. +class +jit_factory +{ + typedef std::list value_list; +public: + ~jit_factory (void); + + const value_list& constants (void) const { return mconstants; } + + template + T *create (void) + { + T *ret = new T (); + track_value (ret); + return ret; + } + +#define DECL_ARG(n) const ARG ## n& arg ## n +#define JIT_CREATE(N) \ + template \ + T *create (OCT_MAKE_LIST (DECL_ARG, N)) \ + { \ + T *ret = new T (OCT_MAKE_ARG_LIST (arg, N)); \ + track_value (ret); \ + return ret; \ + } + + JIT_CREATE (1) + JIT_CREATE (2) + JIT_CREATE (3) + JIT_CREATE (4) + +#undef JIT_CREATE +#undef DECL_ARG +private: + void track_value (jit_value *v); + + value_list all_values; + + value_list mconstants; +}; + +// A list of basic blocks (jit_block) which form some body of code. +// +// We do not directly inherit from std::list because we need to update the +// blocks stashed location in push_back and insert. +class +jit_block_list +{ +public: + typedef std::list::iterator iterator; + typedef std::list::const_iterator const_iterator; + + jit_block *back (void) const { return mlist.back (); } + + iterator begin (void) { return mlist.begin (); } + + const_iterator begin (void) const { return mlist.begin (); } + + iterator end (void) { return mlist.end (); } + + const_iterator end (void) const { return mlist.end (); } + + iterator erase (iterator iter) { return mlist.erase (iter); } + + jit_block *front (void) const { return mlist.front (); } + + void insert_after (iterator iter, jit_block *ablock); + + void insert_after (jit_block *loc, jit_block *ablock); + + void insert_before (iterator iter, jit_block *ablock); + + void insert_before (jit_block *loc, jit_block *ablock); + + void label (void); + + std::ostream& print (std::ostream& os, const std::string& header) const; + + std::ostream& print_dom (std::ostream& os) const; + + void push_back (jit_block *b); +private: + std::list mlist; +}; + +std::ostream& operator<<(std::ostream& os, const jit_block_list& blocks); + +class +jit_value : public jit_internal_list +{ +public: + jit_value (void) : llvm_value (0), ty (0), mlast_use (0), + min_worklist (false) {} + + virtual ~jit_value (void); + + bool in_worklist (void) const + { + return min_worklist; + } + + void stash_in_worklist (bool ain_worklist) + { + min_worklist = ain_worklist; + } + + // The block of the first use which is not a jit_error_check + // So this is not necessarily first_use ()->parent (). + jit_block *first_use_block (void); + + // replace all uses with + virtual void replace_with (jit_value *value); + + jit_type *type (void) const { return ty; } + + llvm::Type *type_llvm (void) const + { + return ty ? ty->to_llvm () : 0; + } + + const std::string& type_name (void) const + { + return ty->name (); + } + + void stash_type (jit_type *new_ty) { ty = new_ty; } + + std::string print_string (void) + { + std::stringstream ss; + print (ss); + return ss.str (); + } + + jit_instruction *last_use (void) const { return mlast_use; } + + void stash_last_use (jit_instruction *alast_use) + { + mlast_use = alast_use; + } + + virtual bool needs_release (void) const { return false; } + + virtual std::ostream& print (std::ostream& os, size_t indent = 0) const = 0; + + virtual std::ostream& short_print (std::ostream& os) const + { return print (os); } + + virtual void accept (jit_ir_walker& walker) = 0; + + bool has_llvm (void) const + { + return llvm_value; + } + + llvm::Value *to_llvm (void) const + { + assert (llvm_value); + return llvm_value; + } + + void stash_llvm (llvm::Value *compiled) + { + llvm_value = compiled; + } + +protected: + std::ostream& print_indent (std::ostream& os, size_t indent = 0) const + { + for (size_t i = 0; i < indent * 8; ++i) + os << " "; + return os; + } + + llvm::Value *llvm_value; +private: + jit_type *ty; + jit_instruction *mlast_use; + bool min_worklist; +}; + +std::ostream& operator<< (std::ostream& os, const jit_value& value); +std::ostream& jit_print (std::ostream& os, jit_value *avalue); + +class +jit_use : public jit_internal_node +{ +public: + // some compilers don't allow us to use jit_internal_node without template + // paremeters + typedef jit_internal_node PARENT_T; + + jit_use (void) : muser (0), mindex (0) {} + + // we should really have a move operator, but not until c++11 :( + jit_use (const jit_use& use) : muser (0), mindex (0) + { + *this = use; + } + + jit_use& operator= (const jit_use& use) + { + stash_value (use.value (), use.user (), use.index ()); + return *this; + } + + size_t index (void) const { return mindex; } + + jit_instruction *user (void) const { return muser; } + + jit_block *user_parent (void) const; + + std::list user_parent_location (void) const; + + void stash_value (jit_value *avalue, jit_instruction *auser = 0, + size_t aindex = -1) + { + PARENT_T::stash_value (avalue); + mindex = aindex; + muser = auser; + } +private: + jit_instruction *muser; + size_t mindex; +}; + +class +jit_instruction : public jit_value +{ +public: + // FIXME: this code could be so much pretier with varadic templates... + jit_instruction (void) : mid (next_id ()), mparent (0) + {} + + jit_instruction (size_t nargs) : mid (next_id ()), mparent (0) + { + already_infered.reserve (nargs); + marguments.reserve (nargs); + } + +#define STASH_ARG(i) stash_argument (i, arg ## i); +#define JIT_INSTRUCTION_CTOR(N) \ + jit_instruction (OCT_MAKE_DECL_LIST (jit_value *, arg, N)) \ + : already_infered (N), marguments (N), mid (next_id ()), mparent (0) \ + { \ + OCT_ITERATE_MACRO (STASH_ARG, N); \ + } + + JIT_INSTRUCTION_CTOR(1) + JIT_INSTRUCTION_CTOR(2) + JIT_INSTRUCTION_CTOR(3) + JIT_INSTRUCTION_CTOR(4) + +#undef STASH_ARG +#undef JIT_INSTRUCTION_CTOR + + jit_instruction (const std::vector& aarguments) + : already_infered (aarguments.size ()), marguments (aarguments.size ()), + mid (next_id ()), mparent (0) + { + for (size_t i = 0; i < aarguments.size (); ++i) + stash_argument (i, aarguments[i]); + } + + static void reset_ids (void) + { + next_id (true); + } + + jit_value *argument (size_t i) const + { + return marguments[i].value (); + } + + llvm::Value *argument_llvm (size_t i) const + { + assert (argument (i)); + return argument (i)->to_llvm (); + } + + jit_type *argument_type (size_t i) const + { + return argument (i)->type (); + } + + llvm::Type *argument_type_llvm (size_t i) const + { + assert (argument (i)); + return argument_type (i)->to_llvm (); + } + + std::ostream& print_argument (std::ostream& os, size_t i) const + { + if (argument (i)) + return argument (i)->short_print (os); + else + return os << "NULL"; + } + + void stash_argument (size_t i, jit_value *arg) + { + marguments[i].stash_value (arg, this, i); + } + + void push_argument (jit_value *arg) + { + marguments.push_back (jit_use ()); + stash_argument (marguments.size () - 1, arg); + already_infered.push_back (0); + } + + size_t argument_count (void) const + { + return marguments.size (); + } + + void resize_arguments (size_t acount, jit_value *adefault = 0) + { + size_t old = marguments.size (); + marguments.resize (acount); + already_infered.resize (acount); + + if (adefault) + for (size_t i = old; i < acount; ++i) + stash_argument (i, adefault); + } + + const std::vector& arguments (void) const { return marguments; } + + // argument types which have been infered already + const std::vector& argument_types (void) const + { return already_infered; } + + virtual void push_variable (void) {} + + virtual void pop_variable (void) {} + + virtual void construct_ssa (void) + { + do_construct_ssa (0, argument_count ()); + } + + virtual bool infer (void) { return false; } + + void remove (void); + + virtual std::ostream& short_print (std::ostream& os) const; + + jit_block *parent (void) const { return mparent; } + + std::list::iterator location (void) const + { + return mlocation; + } + + llvm::BasicBlock *parent_llvm (void) const; + + void stash_parent (jit_block *aparent, + std::list::iterator alocation) + { + mparent = aparent; + mlocation = alocation; + } + + size_t id (void) const { return mid; } +protected: + + // Do SSA replacement on arguments in [start, end) + void do_construct_ssa (size_t start, size_t end); + + std::vector already_infered; +private: + static size_t next_id (bool reset = false) + { + static size_t ret = 0; + if (reset) + return ret = 0; + + return ret++; + } + + std::vector marguments; + + size_t mid; + jit_block *mparent; + std::list::iterator mlocation; +}; + +// defnie accept methods for subclasses +#define JIT_VALUE_ACCEPT \ + virtual void accept (jit_ir_walker& walker); + +// for use as a dummy argument during conversion to LLVM +class +jit_argument : public jit_value +{ +public: + jit_argument (jit_type *atype, llvm::Value *avalue) + { + stash_type (atype); + stash_llvm (avalue); + } + + virtual std::ostream& print (std::ostream& os, size_t indent = 0) const + { + print_indent (os, indent); + return jit_print (os, type ()) << ": DUMMY"; + } + + JIT_VALUE_ACCEPT; +}; + +template +class +jit_const : public jit_value +{ +public: + typedef PASS_T pass_t; + + jit_const (PASS_T avalue) : mvalue (avalue) + { + stash_type (EXTRACT_T ()); + } + + PASS_T value (void) const { return mvalue; } + + virtual std::ostream& print (std::ostream& os, size_t indent = 0) const + { + print_indent (os, indent); + jit_print (os, type ()) << ": "; + if (QUOTE) + os << "\""; + os << mvalue; + if (QUOTE) + os << "\""; + return os; + } + + JIT_VALUE_ACCEPT; +private: + T mvalue; +}; + +class jit_phi_incomming; + +class +jit_block : public jit_value, public jit_internal_list +{ + typedef jit_internal_list ILIST_T; +public: + typedef std::list instruction_list; + typedef instruction_list::iterator iterator; + typedef instruction_list::const_iterator const_iterator; + + typedef std::set df_set; + typedef df_set::const_iterator df_iterator; + + static const size_t NO_ID = static_cast (-1); + + jit_block (const std::string& aname, size_t avisit_count = 0) + : mvisit_count (avisit_count), mid (NO_ID), idom (0), mname (aname), + malive (false) + {} + + virtual void replace_with (jit_value *value); + + void replace_in_phi (jit_block *ablock, jit_block *with); + + // we have a new internal list, but we want to stay compatable with jit_value + jit_use *first_use (void) const { return jit_value::first_use (); } + + size_t use_count (void) const { return jit_value::use_count (); } + + // if a block is alive, then it might be visited during execution + bool alive (void) const { return malive; } + + void mark_alive (void) { malive = true; } + + // If we can merge with a successor, do so and return the now empty block + jit_block *maybe_merge (); + + // merge another block into this block, leaving the merge block empty + void merge (jit_block& merge); + + const std::string& name (void) const { return mname; } + + jit_instruction *prepend (jit_instruction *instr); + + jit_instruction *prepend_after_phi (jit_instruction *instr); + + template + T *append (T *instr) + { + internal_append (instr); + return instr; + } + + jit_instruction *insert_before (iterator loc, jit_instruction *instr); + + jit_instruction *insert_before (jit_instruction *loc, jit_instruction *instr) + { + return insert_before (loc->location (), instr); + } + + jit_instruction *insert_after (iterator loc, jit_instruction *instr); + + jit_instruction *insert_after (jit_instruction *loc, jit_instruction *instr) + { + return insert_after (loc->location (), instr); + } + + iterator remove (iterator iter) + { + jit_instruction *instr = *iter; + iter = instructions.erase (iter); + instr->stash_parent (0, instructions.end ()); + return iter; + } + + jit_terminator *terminator (void) const; + + // is the jump from pred alive? + bool branch_alive (jit_block *asucc) const; + + jit_block *successor (size_t i) const; + + size_t successor_count (void) const; + + iterator begin (void) { return instructions.begin (); } + + const_iterator begin (void) const { return instructions.begin (); } + + iterator end (void) { return instructions.end (); } + + const_iterator end (void) const { return instructions.end (); } + + iterator phi_begin (void); + + iterator phi_end (void); + + iterator nonphi_begin (void); + + // must label before id is valid + size_t id (void) const { return mid; } + + // dominance frontier + const df_set& df (void) const { return mdf; } + + df_iterator df_begin (void) const { return mdf.begin (); } + + df_iterator df_end (void) const { return mdf.end (); } + + // label with a RPO walk + void label (void) + { + size_t number = 0; + label (mvisit_count, number); + } + + void label (size_t avisit_count, size_t& number); + + // See for idom computation algorithm + // Cooper, Keith D.; Harvey, Timothy J; and Kennedy, Ken (2001). + // "A Simple, Fast Dominance Algorithm" + void compute_idom (jit_block& entry_block) + { + bool changed; + entry_block.idom = &entry_block; + do + changed = update_idom (mvisit_count); + while (changed); + } + + // compute dominance frontier + void compute_df (void) + { + compute_df (mvisit_count); + } + + void create_dom_tree (void) + { + create_dom_tree (mvisit_count); + } + + jit_block *dom_successor (size_t idx) const + { + return dom_succ[idx]; + } + + size_t dom_successor_count (void) const + { + return dom_succ.size (); + } + + // call pop_varaible on all instructions + void pop_all (void); + + virtual std::ostream& print (std::ostream& os, size_t indent = 0) const; + + jit_block *maybe_split (jit_factory& factory, jit_block_list& blocks, + jit_block *asuccessor); + + jit_block *maybe_split (jit_factory& factory, jit_block_list& blocks, + jit_block& asuccessor) + { + return maybe_split (factory, blocks, &asuccessor); + } + + // print dominator infomration + std::ostream& print_dom (std::ostream& os) const; + + virtual std::ostream& short_print (std::ostream& os) const + { + os << mname; + if (mid != NO_ID) + os << mid; + else + os << "!"; + return os; + } + + llvm::BasicBlock *to_llvm (void) const; + + std::list::iterator location (void) const + { return mlocation; } + + void stash_location (std::list::iterator alocation) + { mlocation = alocation; } + + // used to prevent visiting the same node twice in the graph + size_t visit_count (void) const { return mvisit_count; } + + // check if this node has been visited yet at the given visit count. If we + // have not been visited yet, mark us as visited. + bool visited (size_t avisit_count) + { + if (mvisit_count <= avisit_count) + { + mvisit_count = avisit_count + 1; + return false; + } + + return true; + } + + jit_instruction *front (void) { return instructions.front (); } + + jit_instruction *back (void) { return instructions.back (); } + + JIT_VALUE_ACCEPT; +private: + void internal_append (jit_instruction *instr); + + void compute_df (size_t avisit_count); + + bool update_idom (size_t avisit_count); + + void create_dom_tree (size_t avisit_count); + + static jit_block *idom_intersect (jit_block *i, jit_block *j); + + size_t mvisit_count; + size_t mid; + jit_block *idom; + df_set mdf; + std::vector dom_succ; + std::string mname; + instruction_list instructions; + bool malive; + std::list::iterator mlocation; +}; + +// keeps track of phi functions that use a block on incomming edges +class +jit_phi_incomming : public jit_internal_node +{ +public: + jit_phi_incomming (void) : muser (0) {} + + jit_phi_incomming (jit_phi *auser) : muser (auser) {} + + jit_phi_incomming (const jit_phi_incomming& use) + { + *this = use; + } + + jit_phi_incomming& operator= (const jit_phi_incomming& use) + { + stash_value (use.value ()); + muser = use.muser; + return *this; + } + + jit_phi *user (void) const { return muser; } + + jit_block *user_parent (void) const; +private: + jit_phi *muser; +}; + +// A non-ssa variable +class +jit_variable : public jit_value +{ +public: + jit_variable (const std::string& aname) : mname (aname), mlast_use (0) {} + + const std::string &name (void) const { return mname; } + + // manipulate the value_stack, for use during SSA construction. The top of the + // value stack represents the current value for this variable + bool has_top (void) const + { + return ! value_stack.empty (); + } + + jit_value *top (void) const + { + return value_stack.top (); + } + + void push (jit_instruction *v) + { + value_stack.push (v); + mlast_use = v; + } + + void pop (void) + { + value_stack.pop (); + } + + jit_instruction *last_use (void) const + { + return mlast_use; + } + + void stash_last_use (jit_instruction *instr) + { + mlast_use = instr; + } + + // blocks in which we are used + void use_blocks (jit_block::df_set& result) + { + jit_use *use = first_use (); + while (use) + { + result.insert (use->user_parent ()); + use = use->next (); + } + } + + virtual std::ostream& print (std::ostream& os, size_t indent = 0) const + { + return print_indent (os, indent) << mname; + } + + JIT_VALUE_ACCEPT; +private: + std::string mname; + std::stack value_stack; + jit_instruction *mlast_use; +}; + +class +jit_assign_base : public jit_instruction +{ +public: + jit_assign_base (jit_variable *adest) : jit_instruction (), mdest (adest) {} + + jit_assign_base (jit_variable *adest, size_t npred) : jit_instruction (npred), + mdest (adest) {} + + jit_assign_base (jit_variable *adest, jit_value *arg0, jit_value *arg1) + : jit_instruction (arg0, arg1), mdest (adest) {} + + jit_variable *dest (void) const { return mdest; } + + virtual void push_variable (void) + { + mdest->push (this); + } + + virtual void pop_variable (void) + { + mdest->pop (); + } + + virtual std::ostream& short_print (std::ostream& os) const + { + if (type ()) + jit_print (os, type ()) << ": "; + + dest ()->short_print (os); + return os << "#" << id (); + } +private: + jit_variable *mdest; +}; + +class +jit_assign : public jit_assign_base +{ +public: + jit_assign (jit_variable *adest, jit_value *asrc) + : jit_assign_base (adest, adest, asrc), martificial (false) {} + + jit_value *overwrite (void) const + { + return argument (0); + } + + jit_value *src (void) const + { + return argument (1); + } + + // variables don't get modified in an SSA, but COW requires we modify + // variables. An artificial assign is for when a variable gets modified. We + // need an assign in the SSA, but the reference counts shouldn't be updated. + bool artificial (void) const { return martificial; } + + void mark_artificial (void) { martificial = true; } + + virtual bool infer (void) + { + jit_type *stype = src ()->type (); + if (stype != type()) + { + stash_type (stype); + return true; + } + + return false; + } + + virtual std::ostream& print (std::ostream& os, size_t indent = 0) const + { + print_indent (os, indent) << *this << " = " << *src (); + + if (artificial ()) + os << " [artificial]"; + + return os; + } + + JIT_VALUE_ACCEPT; +private: + bool martificial; +}; + +class +jit_phi : public jit_assign_base +{ +public: + jit_phi (jit_variable *adest, size_t npred) + : jit_assign_base (adest, npred) + { + mincomming.reserve (npred); + } + + // removes arguments form dead incomming jumps + bool prune (void); + + void add_incomming (jit_block *from, jit_value *value) + { + push_argument (value); + mincomming.push_back (jit_phi_incomming (this)); + mincomming[mincomming.size () - 1].stash_value (from); + } + + jit_block *incomming (size_t i) const + { + return mincomming[i].value (); + } + + llvm::BasicBlock *incomming_llvm (size_t i) const + { + return incomming (i)->to_llvm (); + } + + virtual void construct_ssa (void) {} + + virtual bool infer (void); + + virtual std::ostream& print (std::ostream& os, size_t indent = 0) const + { + std::stringstream ss; + print_indent (ss, indent); + short_print (ss) << " phi "; + std::string ss_str = ss.str (); + std::string indent_str (ss_str.size (), ' '); + os << ss_str; + + for (size_t i = 0; i < argument_count (); ++i) + { + if (i > 0) + os << indent_str; + os << "| "; + + os << *incomming (i) << " -> "; + os << *argument (i); + + if (i + 1 < argument_count ()) + os << std::endl; + } + + return os; + } + + llvm::PHINode *to_llvm (void) const; + + JIT_VALUE_ACCEPT; +private: + std::vector mincomming; +}; + +class +jit_terminator : public jit_instruction +{ +public: +#define JIT_TERMINATOR_CONST(N) \ + jit_terminator (size_t asuccessor_count, \ + OCT_MAKE_DECL_LIST (jit_value *, arg, N)) \ + : jit_instruction (OCT_MAKE_ARG_LIST (arg, N)), \ + malive (asuccessor_count, false) {} + + JIT_TERMINATOR_CONST (1) + JIT_TERMINATOR_CONST (2) + JIT_TERMINATOR_CONST (3) + +#undef JIT_TERMINATOR_CONST + + jit_block *successor (size_t idx = 0) const + { + return static_cast (argument (idx)); + } + + llvm::BasicBlock *successor_llvm (size_t idx = 0) const + { + return successor (idx)->to_llvm (); + } + + size_t successor_index (const jit_block *asuccessor) const; + + std::ostream& print_successor (std::ostream& os, size_t idx = 0) const + { + if (alive (idx)) + os << "[live] "; + else + os << "[dead] "; + + return successor (idx)->short_print (os); + } + + // Check if the jump to successor is live + bool alive (const jit_block *asuccessor) const + { + return alive (successor_index (asuccessor)); + } + + bool alive (size_t idx) const { return malive[idx]; } + + bool alive (int idx) const { return malive[idx]; } + + size_t successor_count (void) const { return malive.size (); } + + virtual bool infer (void); + + llvm::TerminatorInst *to_llvm (void) const; +protected: + virtual bool check_alive (size_t) const { return true; } +private: + std::vector malive; +}; + +class +jit_branch : public jit_terminator +{ +public: + jit_branch (jit_block *succ) : jit_terminator (1, succ) {} + + virtual size_t successor_count (void) const { return 1; } + + virtual std::ostream& print (std::ostream& os, size_t indent = 0) const + { + print_indent (os, indent) << "branch: "; + return print_successor (os); + } + + JIT_VALUE_ACCEPT; +}; + +class +jit_cond_branch : public jit_terminator +{ +public: + jit_cond_branch (jit_value *c, jit_block *ctrue, jit_block *cfalse) + : jit_terminator (2, ctrue, cfalse, c) {} + + jit_value *cond (void) const { return argument (2); } + + std::ostream& print_cond (std::ostream& os) const + { + return cond ()->short_print (os); + } + + llvm::Value *cond_llvm (void) const + { + return cond ()->to_llvm (); + } + + virtual size_t successor_count (void) const { return 2; } + + virtual std::ostream& print (std::ostream& os, size_t indent = 0) const + { + print_indent (os, indent) << "cond_branch: "; + print_cond (os) << ", "; + print_successor (os, 0) << ", "; + return print_successor (os, 1); + } + + JIT_VALUE_ACCEPT; +}; + +class +jit_call : public jit_instruction +{ +public: + jit_call (const jit_operation& (*aoperation) (void)) + : moperation (aoperation ()) + { + const jit_function& ol = overload (); + if (ol.valid ()) + stash_type (ol.result ()); + } + + jit_call (const jit_operation& aoperation) : moperation (aoperation) + { + const jit_function& ol = overload (); + if (ol.valid ()) + stash_type (ol.result ()); + } + +#define JIT_CALL_CONST(N) \ + jit_call (const jit_operation& aoperation, \ + OCT_MAKE_DECL_LIST (jit_value *, arg, N)) \ + : jit_instruction (OCT_MAKE_ARG_LIST (arg, N)), moperation (aoperation) {} \ + \ + jit_call (const jit_operation& (*aoperation) (void), \ + OCT_MAKE_DECL_LIST (jit_value *, arg, N)) \ + : jit_instruction (OCT_MAKE_ARG_LIST (arg, N)), moperation (aoperation ()) \ + {} + + JIT_CALL_CONST (1) + JIT_CALL_CONST (2) + JIT_CALL_CONST (3) + JIT_CALL_CONST (4) + +#undef JIT_CALL_CONST + + jit_call (const jit_operation& aoperation, + const std::vector& args) + : jit_instruction (args), moperation (aoperation) + {} + + const jit_operation& operation (void) const { return moperation; } + + bool can_error (void) const + { + return overload ().can_error (); + } + + const jit_function& overload (void) const + { + return moperation.overload (argument_types ()); + } + + virtual bool needs_release (void) const; + + virtual std::ostream& print (std::ostream& os, size_t indent = 0) const + { + print_indent (os, indent); + + if (use_count ()) + short_print (os) << " = "; + os << "call " << moperation.name () << " ("; + + for (size_t i = 0; i < argument_count (); ++i) + { + print_argument (os, i); + if (i + 1 < argument_count ()) + os << ", "; + } + return os << ")"; + } + + virtual bool infer (void); + + JIT_VALUE_ACCEPT; +private: + const jit_operation& moperation; +}; + +// FIXME: This is just ugly... +// checks error_state, if error_state is false then goto the normal branch, +// otherwise goto the error branch +class +jit_error_check : public jit_terminator +{ +public: + // Which variable is the error check for? + enum variable + { + var_error_state, + var_interrupt + }; + + static std::string variable_to_string (variable v); + + jit_error_check (variable var, jit_call *acheck_for, jit_block *normal, + jit_block *error) + : jit_terminator (2, error, normal, acheck_for), mvariable (var) {} + + jit_error_check (variable var, jit_block *normal, jit_block *error) + : jit_terminator (2, error, normal), mvariable (var) {} + + variable check_variable (void) const { return mvariable; } + + bool has_check_for (void) const + { + return argument_count () == 3; + } + + jit_call *check_for (void) const + { + assert (has_check_for ()); + return static_cast (argument (2)); + } + + virtual std::ostream& print (std::ostream& os, size_t indent = 0) const; + + JIT_VALUE_ACCEPT; +protected: + virtual bool check_alive (size_t idx) const + { + if (! has_check_for ()) + return true; + return idx == 1 ? true : check_for ()->can_error (); + } +private: + variable mvariable; +}; + +// for now only handles the 1D case +class +jit_magic_end : public jit_instruction +{ +public: + class + context + { + public: + context (void) : value (0), index (0), count (0) + {} + + context (jit_factory& factory, jit_value *avalue, size_t aindex, + size_t acount); + + jit_value *value; + jit_const_index *index; + jit_const_index *count; + }; + + jit_magic_end (const std::vector& full_context); + + virtual bool infer (void); + + const jit_function& overload () const; + + virtual std::ostream& print (std::ostream& os, size_t indent = 0) const; + + context resolve_context (void) const; + + virtual std::ostream& short_print (std::ostream& os) const + { + return os << "magic_end" << "#" << id (); + } + + JIT_VALUE_ACCEPT; +private: + std::vector contexts; +}; + +class +jit_extract_argument : public jit_assign_base +{ +public: + jit_extract_argument (jit_type *atype, jit_variable *adest) + : jit_assign_base (adest) + { + stash_type (atype); + } + + const std::string& name (void) const + { + return dest ()->name (); + } + + const jit_function& overload (void) const + { + return jit_typeinfo::cast (type (), jit_typeinfo::get_any ()); + } + + virtual std::ostream& print (std::ostream& os, size_t indent = 0) const + { + print_indent (os, indent); + + return short_print (os) << " = extract " << name (); + } + + JIT_VALUE_ACCEPT; +}; + +class +jit_store_argument : public jit_instruction +{ +public: + jit_store_argument (jit_variable *var) + : jit_instruction (var), dest (var) + {} + + const std::string& name (void) const + { + return dest->name (); + } + + const jit_function& overload (void) const + { + return jit_typeinfo::cast (jit_typeinfo::get_any (), result_type ()); + } + + jit_value *result (void) const + { + return argument (0); + } + + jit_type *result_type (void) const + { + return result ()->type (); + } + + llvm::Value *result_llvm (void) const + { + return result ()->to_llvm (); + } + + virtual std::ostream& print (std::ostream& os, size_t indent = 0) const + { + jit_value *res = result (); + print_indent (os, indent) << "store "; + dest->short_print (os); + + if (! isa (res)) + { + os << " = "; + res->short_print (os); + } + + return os; + } + + JIT_VALUE_ACCEPT; +private: + jit_variable *dest; +}; + +class +jit_return : public jit_instruction +{ +public: + jit_return (void) {} + + jit_return (jit_value *retval) : jit_instruction (retval) {} + + jit_value *result (void) const + { + return argument_count () ? argument (0) : 0; + } + + jit_type *result_type (void) const + { + jit_value *res = result (); + return res ? res->type () : 0; + } + + virtual std::ostream& print (std::ostream& os, size_t indent = 0) const + { + print_indent (os, indent) << "return"; + + if (result ()) + os << " " << *result (); + + return os; + } + + JIT_VALUE_ACCEPT; +}; + +class +jit_ir_walker +{ +public: + virtual ~jit_ir_walker () {} + +#define JIT_METH(clname) \ + virtual void visit (jit_ ## clname&) = 0; + + JIT_VISIT_IR_CLASSES; + +#undef JIT_METH +}; + +template +void +jit_const::accept (jit_ir_walker& walker) +{ + walker.visit (*this); +} + +#undef JIT_VALUE_ACCEPT + +#endif +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/jit-typeinfo.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/jit-typeinfo.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,2239 @@ +/* + +Copyright (C) 2012 Max Brister + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Author: Max Brister + +// defines required by llvm +#define __STDC_LIMIT_MACROS +#define __STDC_CONSTANT_MACROS + +#ifdef HAVE_CONFIG_H +#include +#endif + +#ifdef HAVE_LLVM + +#include "jit-typeinfo.h" + +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "jit-ir.h" +#include "ov.h" +#include "ov-builtin.h" +#include "ov-complex.h" +#include "ov-scalar.h" +#include "pager.h" + +static llvm::LLVMContext& context = llvm::getGlobalContext (); + +jit_typeinfo *jit_typeinfo::instance = 0; + +std::ostream& jit_print (std::ostream& os, jit_type *atype) +{ + if (! atype) + return os << "null"; + return os << atype->name (); +} + +// function that jit code calls +extern "C" void +octave_jit_print_any (const char *name, octave_base_value *obv) +{ + obv->print_with_name (octave_stdout, name, true); +} + +extern "C" void +octave_jit_print_scalar (const char *name, double value) +{ + // FIXME: We should avoid allocating a new octave_scalar each time + octave_value ov (value); + ov.print_with_name (octave_stdout, name); +} + +extern "C" octave_base_value* +octave_jit_binary_any_any (octave_value::binary_op op, octave_base_value *lhs, + octave_base_value *rhs) +{ + octave_value olhs (lhs, true); + octave_value orhs (rhs, true); + octave_value result = do_binary_op (op, olhs, orhs); + octave_base_value *rep = result.internal_rep (); + rep->grab (); + return rep; +} + +extern "C" octave_idx_type +octave_jit_compute_nelem (double base, double limit, double inc) +{ + Range rng = Range (base, limit, inc); + return rng.nelem (); +} + +extern "C" void +octave_jit_release_any (octave_base_value *obv) +{ + obv->release (); +} + +extern "C" void +octave_jit_release_matrix (jit_matrix *m) +{ + delete m->array; +} + +extern "C" octave_base_value * +octave_jit_grab_any (octave_base_value *obv) +{ + obv->grab (); + return obv; +} + +extern "C" jit_matrix +octave_jit_grab_matrix (jit_matrix *m) +{ + return *m->array; +} + +extern "C" octave_base_value * +octave_jit_cast_any_matrix (jit_matrix *m) +{ + octave_value ret (*m->array); + octave_base_value *rep = ret.internal_rep (); + rep->grab (); + delete m->array; + + return rep; +} + +extern "C" jit_matrix +octave_jit_cast_matrix_any (octave_base_value *obv) +{ + NDArray m = obv->array_value (); + obv->release (); + return m; +} + +extern "C" octave_base_value * +octave_jit_cast_any_range (jit_range *rng) +{ + Range temp (*rng); + octave_value ret (temp); + octave_base_value *rep = ret.internal_rep (); + rep->grab (); + + return rep; +} +extern "C" jit_range +octave_jit_cast_range_any (octave_base_value *obv) +{ + + jit_range r (obv->range_value ()); + obv->release (); + return r; +} + +extern "C" double +octave_jit_cast_scalar_any (octave_base_value *obv) +{ + double ret = obv->double_value (); + obv->release (); + return ret; +} + +extern "C" octave_base_value * +octave_jit_cast_any_scalar (double value) +{ + return new octave_scalar (value); +} + +extern "C" Complex +octave_jit_cast_complex_any (octave_base_value *obv) +{ + Complex ret = obv->complex_value (); + obv->release (); + return ret; +} + +extern "C" octave_base_value * +octave_jit_cast_any_complex (Complex c) +{ + if (c.imag () == 0) + return new octave_scalar (c.real ()); + else + return new octave_complex (c); +} + +extern "C" void +octave_jit_gripe_nan_to_logical_conversion (void) +{ + try + { + gripe_nan_to_logical_conversion (); + } + catch (const octave_execution_exception&) + { + gripe_library_execution_error (); + } +} + +extern "C" void +octave_jit_ginvalid_index (void) +{ + try + { + gripe_invalid_index (); + } + catch (const octave_execution_exception&) + { + gripe_library_execution_error (); + } +} + +extern "C" void +octave_jit_gindex_range (int nd, int dim, octave_idx_type iext, + octave_idx_type ext) +{ + try + { + gripe_index_out_of_range (nd, dim, iext, ext); + } + catch (const octave_execution_exception&) + { + gripe_library_execution_error (); + } +} + +extern "C" jit_matrix +octave_jit_paren_subsasgn_impl (jit_matrix *mat, octave_idx_type index, + double value) +{ + NDArray *array = mat->array; + if (array->nelem () < index) + array->resize1 (index); + + double *data = array->fortran_vec (); + data[index - 1] = value; + + mat->update (); + return *mat; +} + +static void +make_indices (double *indices, octave_idx_type idx_count, + Array& result) +{ + result.resize (dim_vector (1, idx_count)); + for (octave_idx_type i = 0; i < idx_count; ++i) + result(i) = idx_vector (indices[i]); +} + +extern "C" double +octave_jit_paren_scalar (jit_matrix *mat, double *indicies, + octave_idx_type idx_count) +{ + // FIXME: Replace this with a more optimal version + try + { + Array idx; + make_indices (indicies, idx_count, idx); + + Array ret = mat->array->index (idx); + return ret.xelem (0); + } + catch (const octave_execution_exception&) + { + gripe_library_execution_error (); + return 0; + } +} + +extern "C" jit_matrix +octave_jit_paren_scalar_subsasgn (jit_matrix *mat, double *indices, + octave_idx_type idx_count, double value) +{ + // FIXME: Replace this with a more optimal version + jit_matrix ret; + try + { + Array idx; + make_indices (indices, idx_count, idx); + + Matrix temp (1, 1); + temp.xelem(0) = value; + mat->array->assign (idx, temp); + ret.update (mat->array); + } + catch (const octave_execution_exception&) + { + gripe_library_execution_error (); + } + + return ret; +} + +extern "C" jit_matrix +octave_jit_paren_subsasgn_matrix_range (jit_matrix *mat, jit_range *index, + double value) +{ + NDArray *array = mat->array; + bool done = false; + + // optimize for the simple case (no resizing and no errors) + if (*array->jit_ref_count () == 1 + && index->all_elements_are_ints ()) + { + // this code is similar to idx_vector::fill, but we avoid allocating an + // idx_vector and its associated rep + octave_idx_type start = static_cast (index->base) - 1; + octave_idx_type step = static_cast (index->inc); + octave_idx_type nelem = index->nelem; + octave_idx_type final = start + nelem * step; + if (step < 0) + { + step = -step; + std::swap (final, start); + } + + if (start >= 0 && final < mat->slice_len) + { + done = true; + + double *data = array->jit_slice_data (); + if (step == 1) + std::fill (data + start, data + start + nelem, value); + else + { + for (octave_idx_type i = start; i < final; i += step) + data[i] = value; + } + } + } + + if (! done) + { + idx_vector idx (*index); + NDArray avalue (dim_vector (1, 1)); + avalue.xelem (0) = value; + array->assign (idx, avalue); + } + + jit_matrix ret; + ret.update (array); + return ret; +} + +extern "C" double +octave_jit_end_matrix (jit_matrix *mat, octave_idx_type idx, + octave_idx_type count) +{ + octave_idx_type ndim = mat->dimensions[-1]; + if (ndim == count) + return mat->dimensions[idx]; + else if (ndim > count) + { + if (idx == count - 1) + { + double ret = mat->dimensions[idx]; + for (octave_idx_type i = idx + 1; i < ndim; ++i) + ret *= mat->dimensions[idx]; + return ret; + } + + return mat->dimensions[idx]; + } + else // ndim < count + return idx < ndim ? mat->dimensions[idx] : 1; +} + +extern "C" octave_base_value * +octave_jit_create_undef (void) +{ + octave_value undef; + octave_base_value *ret = undef.internal_rep (); + ret->grab (); + + return ret; +} + +extern "C" Complex +octave_jit_complex_mul (Complex lhs, Complex rhs) +{ + if (lhs.imag () == 0 && rhs.imag() == 0) + return Complex (lhs.real () * rhs.real (), 0); + + return lhs * rhs; +} + +extern "C" Complex +octave_jit_complex_div (Complex lhs, Complex rhs) +{ + // see src/OPERATORS/op-cs-cs.cc + if (rhs == 0.0) + gripe_divide_by_zero (); + + return lhs / rhs; +} + +// FIXME: CP form src/xpow.cc +static inline int +xisint (double x) +{ + return (D_NINT (x) == x + && ((x >= 0 && x < std::numeric_limits::max ()) + || (x <= 0 && x > std::numeric_limits::min ()))); +} + +extern "C" Complex +octave_jit_pow_scalar_scalar (double lhs, double rhs) +{ + // FIXME: almost CP from src/xpow.cc + if (lhs < 0.0 && ! xisint (rhs)) + return std::pow (Complex (lhs), rhs); + return std::pow (lhs, rhs); +} + +extern "C" Complex +octave_jit_pow_complex_complex (Complex lhs, Complex rhs) +{ + if (lhs.imag () == 0 && rhs.imag () == 0) + return octave_jit_pow_scalar_scalar (lhs.real (), rhs.real ()); + return std::pow (lhs, rhs); +} + +extern "C" Complex +octave_jit_pow_complex_scalar (Complex lhs, double rhs) +{ + if (lhs.imag () == 0) + return octave_jit_pow_scalar_scalar (lhs.real (), rhs); + return std::pow (lhs, rhs); +} + +extern "C" Complex +octave_jit_pow_scalar_complex (double lhs, Complex rhs) +{ + if (rhs.imag () == 0) + return octave_jit_pow_scalar_scalar (lhs, rhs.real ()); + return std::pow (lhs, rhs); +} + +extern "C" void +octave_jit_print_matrix (jit_matrix *m) +{ + std::cout << *m << std::endl; +} + +static void +gripe_bad_result (void) +{ + error ("incorrect type information given to the JIT compiler"); +} + +// FIXME: Add support for multiple outputs +extern "C" octave_base_value * +octave_jit_call (octave_builtin::fcn fn, size_t nargin, + octave_base_value **argin, jit_type *result_type) +{ + octave_value_list ovl (nargin); + for (size_t i = 0; i < nargin; ++i) + ovl.xelem (i) = octave_value (argin[i]); + + ovl = fn (ovl, 1); + + // FIXME: Check result_type somehow + if (result_type) + { + if (ovl.length () < 1) + { + gripe_bad_result (); + return 0; + } + + octave_value result = ovl.xelem(0); + octave_base_value *ret = result.internal_rep (); + ret->grab (); + return ret; + } + + if (! (ovl.length () == 0 + || (ovl.length () == 1 && ovl.xelem (0).is_undefined ()))) + gripe_bad_result (); + + return 0; +} + +// -------------------- jit_range -------------------- +bool +jit_range::all_elements_are_ints () const +{ + Range r (*this); + return r.all_elements_are_ints (); +} + +std::ostream& +operator<< (std::ostream& os, const jit_range& rng) +{ + return os << "Range[" << rng.base << ", " << rng.limit << ", " << rng.inc + << ", " << rng.nelem << "]"; +} + +// -------------------- jit_matrix -------------------- + +std::ostream& +operator<< (std::ostream& os, const jit_matrix& mat) +{ + return os << "Matrix[" << mat.ref_count << ", " << mat.slice_data << ", " + << mat.slice_len << ", " << mat.dimensions << ", " + << mat.array << "]"; +} + +// -------------------- jit_type -------------------- +jit_type::jit_type (const std::string& aname, jit_type *aparent, + llvm::Type *allvm_type, bool askip_paren, int aid) : + mname (aname), mparent (aparent), llvm_type (allvm_type), mid (aid), + mdepth (aparent ? aparent->mdepth + 1 : 0), mskip_paren (askip_paren) +{ + std::memset (msret, 0, sizeof (msret)); + std::memset (mpointer_arg, 0, sizeof (mpointer_arg)); + std::memset (mpack, 0, sizeof (mpack)); + std::memset (munpack, 0, sizeof (munpack)); + + for (size_t i = 0; i < jit_convention::length; ++i) + mpacked_type[i] = llvm_type; +} + +llvm::Type * +jit_type::to_llvm_arg (void) const +{ + return llvm_type ? llvm_type->getPointerTo () : 0; +} + +// -------------------- jit_function -------------------- +jit_function::jit_function () : module (0), llvm_function (0), mresult (0), + call_conv (jit_convention::length), + mcan_error (false) +{} + +jit_function::jit_function (llvm::Module *amodule, + jit_convention::type acall_conv, + const llvm::Twine& aname, jit_type *aresult, + const std::vector& aargs) + : module (amodule), mresult (aresult), args (aargs), call_conv (acall_conv), + mcan_error (false) +{ + llvm::SmallVector llvm_args; + + llvm::Type *rtype = llvm::Type::getVoidTy (context); + if (mresult) + { + rtype = mresult->packed_type (call_conv); + if (sret ()) + { + llvm_args.push_back (rtype->getPointerTo ()); + rtype = llvm::Type::getVoidTy (context); + } + } + + for (std::vector::const_iterator iter = args.begin (); + iter != args.end (); ++iter) + { + jit_type *ty = *iter; + assert (ty); + llvm::Type *argty = ty->packed_type (call_conv); + if (ty->pointer_arg (call_conv)) + argty = argty->getPointerTo (); + + llvm_args.push_back (argty); + } + + // we mark all functinos as external linkage because this prevents llvm + // from getting rid of always inline functions + llvm::FunctionType *ft = llvm::FunctionType::get (rtype, llvm_args, false); + llvm_function = llvm::Function::Create (ft, llvm::Function::ExternalLinkage, + aname, module); + + if (sret ()) + llvm_function->addAttribute (1, llvm::Attribute::StructRet); + + if (call_conv == jit_convention::internal) + llvm_function->addFnAttr (llvm::Attribute::AlwaysInline); +} + +jit_function::jit_function (const jit_function& fn, jit_type *aresult, + const std::vector& aargs) + : module (fn.module), llvm_function (fn.llvm_function), mresult (aresult), + args (aargs), call_conv (fn.call_conv), mcan_error (fn.mcan_error) +{ +} + +jit_function::jit_function (const jit_function& fn) + : module (fn.module), llvm_function (fn.llvm_function), mresult (fn.mresult), + args (fn.args), call_conv (fn.call_conv), mcan_error (fn.mcan_error) +{} + +void +jit_function::erase (void) +{ + if (! llvm_function) + return; + + llvm_function->eraseFromParent (); + llvm_function = 0; +} + +std::string +jit_function::name (void) const +{ + return llvm_function->getName (); +} + +llvm::BasicBlock * +jit_function::new_block (const std::string& aname, + llvm::BasicBlock *insert_before) +{ + return llvm::BasicBlock::Create (context, aname, llvm_function, + insert_before); +} + +llvm::Value * +jit_function::call (llvm::IRBuilderD& builder, + const std::vector& in_args) const +{ + if (! valid ()) + throw jit_fail_exception ("Call not implemented"); + + assert (in_args.size () == args.size ()); + std::vector llvm_args (args.size ()); + for (size_t i = 0; i < in_args.size (); ++i) + llvm_args[i] = in_args[i]->to_llvm (); + + return call (builder, llvm_args); +} + +llvm::Value * +jit_function::call (llvm::IRBuilderD& builder, + const std::vector& in_args) const +{ + if (! valid ()) + throw jit_fail_exception ("Call not implemented"); + + assert (in_args.size () == args.size ()); + llvm::SmallVector llvm_args; + llvm_args.reserve (in_args.size () + sret ()); + + llvm::BasicBlock *insert_block = builder.GetInsertBlock (); + llvm::Function *parent = insert_block->getParent (); + assert (parent); + + // we insert allocas inside the prelude block to prevent stack overflows + llvm::BasicBlock& prelude = parent->getEntryBlock (); + llvm::IRBuilder<> pre_builder (&prelude, prelude.begin ()); + + llvm::AllocaInst *sret_mem = 0; + if (sret ()) + { + sret_mem = pre_builder.CreateAlloca (mresult->packed_type (call_conv)); + llvm_args.push_back (sret_mem); + } + + for (size_t i = 0; i < in_args.size (); ++i) + { + llvm::Value *arg = in_args[i]; + jit_type::convert_fn convert = args[i]->pack (call_conv); + if (convert) + arg = convert (builder, arg); + + if (args[i]->pointer_arg (call_conv)) + { + llvm::Type *ty = args[i]->packed_type (call_conv); + llvm::Value *alloca = pre_builder.CreateAlloca (ty); + builder.CreateStore (arg, alloca); + arg = alloca; + } + + llvm_args.push_back (arg); + } + + llvm::CallInst *callinst = builder.CreateCall (llvm_function, llvm_args); + llvm::Value *ret = callinst; + + if (sret ()) + { + callinst->addAttribute (1, llvm::Attribute::StructRet); + ret = builder.CreateLoad (sret_mem); + } + + if (mresult) + { + jit_type::convert_fn unpack = mresult->unpack (call_conv); + if (unpack) + ret = unpack (builder, ret); + } + + return ret; +} + +llvm::Value * +jit_function::argument (llvm::IRBuilderD& builder, size_t idx) const +{ + assert (idx < args.size ()); + + // FIXME: We should be treating arguments like a list, not a vector. Shouldn't + // matter much for now, as the number of arguments shouldn't be much bigger + // than 4 + llvm::Function::arg_iterator iter = llvm_function->arg_begin (); + if (sret ()) + ++iter; + + for (size_t i = 0; i < idx; ++i, ++iter); + + if (args[idx]->pointer_arg (call_conv)) + return builder.CreateLoad (iter); + + return iter; +} + +void +jit_function::do_return (llvm::IRBuilderD& builder, llvm::Value *rval, + bool verify) +{ + assert (! rval == ! mresult); + + if (rval) + { + jit_type::convert_fn convert = mresult->pack (call_conv); + if (convert) + rval = convert (builder, rval); + + if (sret ()) + { + builder.CreateStore (rval, llvm_function->arg_begin ()); + builder.CreateRetVoid (); + } + else + builder.CreateRet (rval); + } + else + builder.CreateRetVoid (); + + if (verify) + llvm::verifyFunction (*llvm_function); +} + +void +jit_function::do_add_mapping (llvm::ExecutionEngine *engine, void *fn) +{ + assert (valid ()); + engine->addGlobalMapping (llvm_function, fn); +} + +std::ostream& +operator<< (std::ostream& os, const jit_function& fn) +{ + llvm::Function *lfn = fn.to_llvm (); + os << "jit_function: cc=" << fn.call_conv; + llvm::raw_os_ostream llvm_out (os); + lfn->print (llvm_out); + llvm_out.flush (); + return os; +} + +// -------------------- jit_operation -------------------- +jit_operation::~jit_operation (void) +{ + for (generated_map::iterator iter = generated.begin (); + iter != generated.end (); ++iter) + { + delete iter->first; + delete iter->second; + } +} + +void +jit_operation::add_overload (const jit_function& func, + const std::vector& args) +{ + if (args.size () >= overloads.size ()) + overloads.resize (args.size () + 1); + + Array& over = overloads[args.size ()]; + dim_vector dv (over.dims ()); + Array idx = to_idx (args); + bool must_resize = false; + + if (dv.length () != idx.numel ()) + { + dv.resize (idx.numel ()); + must_resize = true; + } + + for (octave_idx_type i = 0; i < dv.length (); ++i) + if (dv(i) <= idx(i)) + { + must_resize = true; + dv(i) = idx(i) + 1; + } + + if (must_resize) + over.resize (dv); + + over(idx) = func; +} + +const jit_function& +jit_operation::overload (const std::vector& types) const +{ + static jit_function null_overload; + for (size_t i =0; i < types.size (); ++i) + if (! types[i]) + return null_overload; + + if (types.size () >= overloads.size ()) + return do_generate (types); + + const Array& over = overloads[types.size ()]; + dim_vector dv (over.dims ()); + Array idx = to_idx (types); + for (octave_idx_type i = 0; i < dv.length (); ++i) + if (idx(i) >= dv(i)) + return do_generate (types); + + const jit_function& ret = over(idx); + if (! ret.valid ()) + return do_generate (types); + + return ret; +} + +Array +jit_operation::to_idx (const std::vector& types) const +{ + octave_idx_type numel = types.size (); + numel = std::max (2, numel); + + Array idx (dim_vector (1, numel)); + for (octave_idx_type i = 0; i < static_cast (types.size ()); + ++i) + idx(i) = types[i]->type_id (); + + if (types.size () == 0) + idx(0) = idx(1) = 0; + if (types.size () == 1) + { + idx(1) = idx(0); + idx(0) = 0; + } + + return idx; +} + +const jit_function& +jit_operation::do_generate (const signature_vec& types) const +{ + static jit_function null_overload; + generated_map::const_iterator find = generated.find (&types); + if (find != generated.end ()) + { + if (find->second) + return *find->second; + else + return null_overload; + } + + jit_function *ret = generate (types); + generated[new signature_vec (types)] = ret; + return ret ? *ret : null_overload; +} + +jit_function * +jit_operation::generate (const signature_vec&) const +{ + return 0; +} + +bool +jit_operation::signature_cmp +::operator() (const signature_vec *lhs, const signature_vec *rhs) +{ + const signature_vec& l = *lhs; + const signature_vec& r = *rhs; + + if (l.size () < r.size ()) + return true; + else if (l.size () > r.size ()) + return false; + + for (size_t i = 0; i < l.size (); ++i) + { + if (l[i]->type_id () < r[i]->type_id ()) + return true; + else if (l[i]->type_id () > r[i]->type_id ()) + return false; + } + + return false; +} + +// -------------------- jit_index_operation -------------------- +jit_function * +jit_index_operation::generate (const signature_vec& types) const +{ + if (types.size () > 2 && types[0] == jit_typeinfo::get_matrix ()) + { + // indexing a matrix with scalars + jit_type *scalar = jit_typeinfo::get_scalar (); + for (size_t i = 1; i < types.size (); ++i) + if (types[i] != scalar) + return 0; + + return generate_matrix (types); + } + + return 0; +} + +llvm::Value * +jit_index_operation::create_arg_array (llvm::IRBuilderD& builder, + const jit_function &fn, size_t start_idx, + size_t end_idx) const +{ + size_t n = end_idx - start_idx; + llvm::Type *scalar_t = jit_typeinfo::get_scalar_llvm (); + llvm::ArrayType *array_t = llvm::ArrayType::get (scalar_t, n); + llvm::Value *array = llvm::UndefValue::get (array_t); + for (size_t i = start_idx; i < end_idx; ++i) + { + llvm::Value *idx = fn.argument (builder, i); + array = builder.CreateInsertValue (array, idx, i - start_idx); + } + + llvm::Value *array_mem = builder.CreateAlloca (array_t); + builder.CreateStore (array, array_mem); + return builder.CreateBitCast (array_mem, scalar_t->getPointerTo ()); +} + +// -------------------- jit_paren_subsref -------------------- +jit_function * +jit_paren_subsref::generate_matrix (const signature_vec& types) const +{ + std::stringstream ss; + ss << "jit_paren_subsref_matrix_scalar" << (types.size () - 1); + + jit_type *scalar = jit_typeinfo::get_scalar (); + jit_function *fn = new jit_function (module, jit_convention::internal, + ss.str (), scalar, types); + fn->mark_can_error (); + llvm::BasicBlock *body = fn->new_block (); + llvm::IRBuilder<> builder (body); + + llvm::Value *array = create_arg_array (builder, *fn, 1, types.size ()); + jit_type *index = jit_typeinfo::get_index (); + llvm::Value *nelem = llvm::ConstantInt::get (index->to_llvm (), + types.size () - 1); + llvm::Value *mat = fn->argument (builder, 0); + llvm::Value *ret = paren_scalar.call (builder, mat, array, nelem); + fn->do_return (builder, ret); + return fn; +} + +void +jit_paren_subsref::do_initialize (void) +{ + std::vector types (3); + types[0] = jit_typeinfo::get_matrix (); + types[1] = jit_typeinfo::get_scalar_ptr (); + types[2] = jit_typeinfo::get_index (); + + jit_type *scalar = jit_typeinfo::get_scalar (); + paren_scalar = jit_function (module, jit_convention::external, + "octave_jit_paren_scalar", scalar, types); + paren_scalar.add_mapping (engine, &octave_jit_paren_scalar); + paren_scalar.mark_can_error (); +} + +// -------------------- jit_paren_subsasgn -------------------- +jit_function * +jit_paren_subsasgn::generate_matrix (const signature_vec& types) const +{ + std::stringstream ss; + ss << "jit_paren_subsasgn_matrix_scalar" << (types.size () - 2); + + jit_type *matrix = jit_typeinfo::get_matrix (); + jit_function *fn = new jit_function (module, jit_convention::internal, + ss.str (), matrix, types); + fn->mark_can_error (); + llvm::BasicBlock *body = fn->new_block (); + llvm::IRBuilder<> builder (body); + + llvm::Value *array = create_arg_array (builder, *fn, 1, types.size () - 1); + jit_type *index = jit_typeinfo::get_index (); + llvm::Value *nelem = llvm::ConstantInt::get (index->to_llvm (), + types.size () - 2); + + llvm::Value *mat = fn->argument (builder, 0); + llvm::Value *value = fn->argument (builder, types.size () - 1); + llvm::Value *ret = paren_scalar.call (builder, mat, array, nelem, value); + fn->do_return (builder, ret); + return fn; +} + +void +jit_paren_subsasgn::do_initialize (void) +{ + if (paren_scalar.valid ()) + return; + + jit_type *matrix = jit_typeinfo::get_matrix (); + std::vector types (4); + types[0] = matrix; + types[1] = jit_typeinfo::get_scalar_ptr (); + types[2] = jit_typeinfo::get_index (); + types[3] = jit_typeinfo::get_scalar (); + + paren_scalar = jit_function (module, jit_convention::external, + "octave_jit_paren_scalar", matrix, types); + paren_scalar.add_mapping (engine, &octave_jit_paren_scalar_subsasgn); + paren_scalar.mark_can_error (); +} + +// -------------------- jit_typeinfo -------------------- +void +jit_typeinfo::initialize (llvm::Module *m, llvm::ExecutionEngine *e) +{ + new jit_typeinfo (m, e); +} + +// wrap function names to simplify jit_typeinfo::create_external +#define JIT_FN(fn) engine, &fn, #fn + +jit_typeinfo::jit_typeinfo (llvm::Module *m, llvm::ExecutionEngine *e) + : module (m), engine (e), next_id (0), + builder (*new llvm::IRBuilderD (context)) +{ + instance = this; + + // FIXME: We should be registering types like in octave_value_typeinfo + llvm::Type *any_t = llvm::StructType::create (context, "octave_base_value"); + any_t = any_t->getPointerTo (); + + llvm::Type *scalar_t = llvm::Type::getDoubleTy (context); + llvm::Type *bool_t = llvm::Type::getInt1Ty (context); + llvm::Type *string_t = llvm::Type::getInt8Ty (context); + string_t = string_t->getPointerTo (); + llvm::Type *index_t = llvm::Type::getIntNTy (context, + sizeof(octave_idx_type) * 8); + + llvm::StructType *range_t = llvm::StructType::create (context, "range"); + std::vector range_contents (4, scalar_t); + range_contents[3] = index_t; + range_t->setBody (range_contents); + + llvm::Type *refcount_t = llvm::Type::getIntNTy (context, sizeof(int) * 8); + + llvm::StructType *matrix_t = llvm::StructType::create (context, "matrix"); + llvm::Type *matrix_contents[5]; + matrix_contents[0] = refcount_t->getPointerTo (); + matrix_contents[1] = scalar_t->getPointerTo (); + matrix_contents[2] = index_t; + matrix_contents[3] = index_t->getPointerTo (); + matrix_contents[4] = string_t; + matrix_t->setBody (llvm::makeArrayRef (matrix_contents, 5)); + + llvm::Type *complex_t = llvm::ArrayType::get (scalar_t, 2); + + // complex_ret is what is passed to C functions in order to get calling + // convention right + llvm::Type *cmplx_inner_cont[] = {scalar_t, scalar_t}; + llvm::StructType *cmplx_inner = llvm::StructType::create (cmplx_inner_cont); + + complex_ret = llvm::StructType::create (context, "complex_ret"); + { + llvm::Type *contents[] = {cmplx_inner}; + complex_ret->setBody (contents); + } + + // create types + any = new_type ("any", 0, any_t); + matrix = new_type ("matrix", any, matrix_t); + complex = new_type ("complex", any, complex_t); + scalar = new_type ("scalar", complex, scalar_t); + scalar_ptr = new_type ("scalar_ptr", 0, scalar_t->getPointerTo ()); + any_ptr = new_type ("any_ptr", 0, any_t->getPointerTo ()); + range = new_type ("range", any, range_t); + string = new_type ("string", any, string_t); + boolean = new_type ("bool", any, bool_t); + index = new_type ("index", any, index_t); + + create_int (8); + create_int (16); + create_int (32); + create_int (64); + + casts.resize (next_id + 1); + identities.resize (next_id + 1); + + // specify calling conventions + // FIXME: We should detect architecture and do something sane based on that + // here we assume x86 or x86_64 + matrix->mark_sret (jit_convention::external); + matrix->mark_pointer_arg (jit_convention::external); + + range->mark_sret (jit_convention::external); + range->mark_pointer_arg (jit_convention::external); + + complex->set_pack (jit_convention::external, &jit_typeinfo::pack_complex); + complex->set_unpack (jit_convention::external, &jit_typeinfo::unpack_complex); + complex->set_packed_type (jit_convention::external, complex_ret); + + if (sizeof (void *) == 4) + complex->mark_sret (jit_convention::external); + + paren_subsref_fn.initialize (module, engine); + paren_subsasgn_fn.initialize (module, engine); + + // bind global variables + lerror_state = new llvm::GlobalVariable (*module, bool_t, false, + llvm::GlobalValue::ExternalLinkage, + 0, "error_state"); + engine->addGlobalMapping (lerror_state, + reinterpret_cast (&error_state)); + + // sig_atomic_type is going to be some sort of integer + sig_atomic_type = llvm::Type::getIntNTy (context, sizeof(sig_atomic_t) * 8); + loctave_interrupt_state + = new llvm::GlobalVariable (*module, sig_atomic_type, false, + llvm::GlobalValue::ExternalLinkage, 0, + "octave_interrupt_state"); + engine->addGlobalMapping (loctave_interrupt_state, + reinterpret_cast (&octave_interrupt_state)); + + // generic call function + { + jit_type *int_t = intN (sizeof (octave_builtin::fcn) * 8); + any_call = create_external (JIT_FN (octave_jit_call), any, int_t, int_t, + any_ptr, int_t); + } + + // any with anything is an any op + jit_function fn; + jit_type *binary_op_type = intN (sizeof (octave_value::binary_op) * 8); + llvm::Type *llvm_bo_type = binary_op_type->to_llvm (); + jit_function any_binary = create_external (JIT_FN (octave_jit_binary_any_any), + any, binary_op_type, any, any); + any_binary.mark_can_error (); + binary_ops.resize (octave_value::num_binary_ops); + for (size_t i = 0; i < octave_value::num_binary_ops; ++i) + { + octave_value::binary_op op = static_cast (i); + std::string op_name = octave_value::binary_op_as_string (op); + binary_ops[i].stash_name ("binary" + op_name); + } + + unary_ops.resize (octave_value::num_unary_ops); + for (size_t i = 0; i < octave_value::num_unary_ops; ++i) + { + octave_value::unary_op op = static_cast (i); + std::string op_name = octave_value::unary_op_as_string (op); + unary_ops[i].stash_name ("unary" + op_name); + } + + for (int op = 0; op < octave_value::num_binary_ops; ++op) + { + llvm::Twine fn_name ("octave_jit_binary_any_any_"); + fn_name = fn_name + llvm::Twine (op); + + fn = create_internal (fn_name, any, any, any); + fn.mark_can_error (); + llvm::BasicBlock *block = fn.new_block (); + builder.SetInsertPoint (block); + llvm::APInt op_int(sizeof (octave_value::binary_op) * 8, op, + std::numeric_limits::is_signed); + llvm::Value *op_as_llvm = llvm::ConstantInt::get (llvm_bo_type, op_int); + llvm::Value *ret = any_binary.call (builder, op_as_llvm, + fn.argument (builder, 0), + fn.argument (builder, 1)); + fn.do_return (builder, ret); + binary_ops[op].add_overload (fn); + } + + // grab matrix + fn = create_external (JIT_FN (octave_jit_grab_matrix), matrix, matrix); + grab_fn.add_overload (fn); + + grab_fn.add_overload (create_identity (scalar)); + grab_fn.add_overload (create_identity (scalar_ptr)); + grab_fn.add_overload (create_identity (any_ptr)); + grab_fn.add_overload (create_identity (boolean)); + grab_fn.add_overload (create_identity (complex)); + grab_fn.add_overload (create_identity (index)); + + // release any + fn = create_external (JIT_FN (octave_jit_release_any), 0, any); + release_fn.add_overload (fn); + release_fn.stash_name ("release"); + + // release matrix + fn = create_external (JIT_FN (octave_jit_release_matrix), 0, matrix); + release_fn.add_overload (fn); + + // destroy + destroy_fn = release_fn; + destroy_fn.stash_name ("destroy"); + destroy_fn.add_overload (create_identity(scalar)); + destroy_fn.add_overload (create_identity(boolean)); + destroy_fn.add_overload (create_identity(index)); + destroy_fn.add_overload (create_identity(complex)); + + // now for binary scalar operations + add_binary_op (scalar, octave_value::op_add, llvm::Instruction::FAdd); + add_binary_op (scalar, octave_value::op_sub, llvm::Instruction::FSub); + add_binary_op (scalar, octave_value::op_mul, llvm::Instruction::FMul); + add_binary_op (scalar, octave_value::op_el_mul, llvm::Instruction::FMul); + + add_binary_fcmp (scalar, octave_value::op_lt, llvm::CmpInst::FCMP_ULT); + add_binary_fcmp (scalar, octave_value::op_le, llvm::CmpInst::FCMP_ULE); + add_binary_fcmp (scalar, octave_value::op_eq, llvm::CmpInst::FCMP_UEQ); + add_binary_fcmp (scalar, octave_value::op_ge, llvm::CmpInst::FCMP_UGE); + add_binary_fcmp (scalar, octave_value::op_gt, llvm::CmpInst::FCMP_UGT); + add_binary_fcmp (scalar, octave_value::op_ne, llvm::CmpInst::FCMP_UNE); + + jit_function gripe_div0 = create_external (JIT_FN (gripe_divide_by_zero), 0); + gripe_div0.mark_can_error (); + + // divide is annoying because it might error + fn = create_internal ("octave_jit_div_scalar_scalar", scalar, scalar, scalar); + fn.mark_can_error (); + + llvm::BasicBlock *body = fn.new_block (); + builder.SetInsertPoint (body); + { + llvm::BasicBlock *warn_block = fn.new_block ("warn"); + llvm::BasicBlock *normal_block = fn.new_block ("normal"); + + llvm::Value *zero = llvm::ConstantFP::get (scalar_t, 0); + llvm::Value *check = builder.CreateFCmpUEQ (zero, fn.argument (builder, 1)); + builder.CreateCondBr (check, warn_block, normal_block); + + builder.SetInsertPoint (warn_block); + gripe_div0.call (builder); + builder.CreateBr (normal_block); + + builder.SetInsertPoint (normal_block); + llvm::Value *ret = builder.CreateFDiv (fn.argument (builder, 0), + fn.argument (builder, 1)); + fn.do_return (builder, ret); + } + binary_ops[octave_value::op_div].add_overload (fn); + binary_ops[octave_value::op_el_div].add_overload (fn); + + // ldiv is the same as div with the operators reversed + fn = mirror_binary (fn); + binary_ops[octave_value::op_ldiv].add_overload (fn); + binary_ops[octave_value::op_el_ldiv].add_overload (fn); + + // In general, the result of scalar ^ scalar is a complex number. We might be + // able to improve on this if we keep track of the range of values varaibles + // can take on. + fn = create_external (JIT_FN (octave_jit_pow_scalar_scalar), complex, scalar, + scalar); + binary_ops[octave_value::op_pow].add_overload (fn); + binary_ops[octave_value::op_el_pow].add_overload (fn); + + // now for unary scalar operations + // FIXME: Impelment not + fn = create_internal ("octave_jit_++", scalar, scalar); + body = fn.new_block (); + builder.SetInsertPoint (body); + { + llvm::Value *one = llvm::ConstantFP::get (scalar_t, 1); + llvm::Value *val = fn.argument (builder, 0); + val = builder.CreateFAdd (val, one); + fn.do_return (builder, val); + } + unary_ops[octave_value::op_incr].add_overload (fn); + + fn = create_internal ("octave_jit_--", scalar, scalar); + body = fn.new_block (); + builder.SetInsertPoint (body); + { + llvm::Value *one = llvm::ConstantFP::get (scalar_t, 1); + llvm::Value *val = fn.argument (builder, 0); + val = builder.CreateFSub (val, one); + fn.do_return (builder, val); + } + unary_ops[octave_value::op_decr].add_overload (fn); + + fn = create_internal ("octave_jit_uminus", scalar, scalar); + body = fn.new_block (); + builder.SetInsertPoint (body); + { + llvm::Value *mone = llvm::ConstantFP::get (scalar_t, -1); + llvm::Value *val = fn.argument (builder, 0); + val = builder.CreateFMul (val, mone); + fn.do_return (builder, val); + } + + fn = create_identity (scalar); + unary_ops[octave_value::op_uplus].add_overload (fn); + unary_ops[octave_value::op_transpose].add_overload (fn); + unary_ops[octave_value::op_hermitian].add_overload (fn); + + // now for binary complex operations + fn = create_internal ("octave_jit_+_complex_complex", complex, complex, + complex); + body = fn.new_block (); + builder.SetInsertPoint (body); + { + llvm::Value *lhs = fn.argument (builder, 0); + llvm::Value *rhs = fn.argument (builder, 1); + llvm::Value *real = builder.CreateFAdd (complex_real (lhs), + complex_real (rhs)); + llvm::Value *imag = builder.CreateFAdd (complex_imag (lhs), + complex_imag (rhs)); + fn.do_return (builder, complex_new (real, imag)); + } + binary_ops[octave_value::op_add].add_overload (fn); + + fn = create_internal ("octave_jit_-_complex_complex", complex, complex, + complex); + body = fn.new_block (); + builder.SetInsertPoint (body); + { + llvm::Value *lhs = fn.argument (builder, 0); + llvm::Value *rhs = fn.argument (builder, 1); + llvm::Value *real = builder.CreateFSub (complex_real (lhs), + complex_real (rhs)); + llvm::Value *imag = builder.CreateFSub (complex_imag (lhs), + complex_imag (rhs)); + fn.do_return (builder, complex_new (real, imag)); + } + binary_ops[octave_value::op_sub].add_overload (fn); + + fn = create_external (JIT_FN (octave_jit_complex_mul), + complex, complex, complex); + binary_ops[octave_value::op_mul].add_overload (fn); + binary_ops[octave_value::op_el_mul].add_overload (fn); + + jit_function complex_div = create_external (JIT_FN (octave_jit_complex_div), + complex, complex, complex); + complex_div.mark_can_error (); + binary_ops[octave_value::op_div].add_overload (fn); + binary_ops[octave_value::op_ldiv].add_overload (fn); + + fn = create_external (JIT_FN (octave_jit_pow_complex_complex), complex, + complex, complex); + binary_ops[octave_value::op_pow].add_overload (fn); + binary_ops[octave_value::op_el_pow].add_overload (fn); + + fn = create_internal ("octave_jit_*_scalar_complex", complex, scalar, + complex); + jit_function mul_scalar_complex = fn; + body = fn.new_block (); + builder.SetInsertPoint (body); + { + llvm::BasicBlock *complex_mul = fn.new_block ("complex_mul"); + llvm::BasicBlock *scalar_mul = fn.new_block ("scalar_mul"); + + llvm::Value *fzero = llvm::ConstantFP::get (scalar_t, 0); + llvm::Value *lhs = fn.argument (builder, 0); + llvm::Value *rhs = fn.argument (builder, 1); + + llvm::Value *cmp = builder.CreateFCmpUEQ (complex_imag (rhs), fzero); + builder.CreateCondBr (cmp, scalar_mul, complex_mul); + + builder.SetInsertPoint (scalar_mul); + llvm::Value *temp = complex_real (rhs); + temp = builder.CreateFMul (lhs, temp); + fn.do_return (builder, complex_new (temp, fzero), false); + + + builder.SetInsertPoint (complex_mul); + temp = complex_new (builder.CreateFMul (lhs, complex_real (rhs)), + builder.CreateFMul (lhs, complex_imag (rhs))); + fn.do_return (builder, temp); + } + binary_ops[octave_value::op_mul].add_overload (fn); + binary_ops[octave_value::op_el_mul].add_overload (fn); + + + fn = mirror_binary (mul_scalar_complex); + binary_ops[octave_value::op_mul].add_overload (fn); + binary_ops[octave_value::op_el_mul].add_overload (fn); + + fn = create_internal ("octave_jit_+_scalar_complex", complex, scalar, + complex); + body = fn.new_block (); + builder.SetInsertPoint (body); + { + llvm::Value *lhs = fn.argument (builder, 0); + llvm::Value *rhs = fn.argument (builder, 1); + llvm::Value *real = builder.CreateFAdd (lhs, complex_real (rhs)); + fn.do_return (builder, complex_real (rhs, real)); + } + binary_ops[octave_value::op_add].add_overload (fn); + + fn = mirror_binary (fn); + binary_ops[octave_value::op_add].add_overload (fn); + + fn = create_internal ("octave_jit_-_complex_scalar", complex, complex, + scalar); + body = fn.new_block (); + builder.SetInsertPoint (body); + { + llvm::Value *lhs = fn.argument (builder, 0); + llvm::Value *rhs = fn.argument (builder, 1); + llvm::Value *real = builder.CreateFSub (complex_real (lhs), rhs); + fn.do_return (builder, complex_real (lhs, real)); + } + binary_ops[octave_value::op_sub].add_overload (fn); + + fn = create_internal ("octave_jit_-_scalar_complex", complex, scalar, + complex); + body = fn.new_block (); + builder.SetInsertPoint (body); + { + llvm::Value *lhs = fn.argument (builder, 0); + llvm::Value *rhs = fn.argument (builder, 1); + llvm::Value *real = builder.CreateFSub (lhs, complex_real (rhs)); + fn.do_return (builder, complex_real (rhs, real)); + } + binary_ops[octave_value::op_sub].add_overload (fn); + + fn = create_external (JIT_FN (octave_jit_pow_scalar_complex), complex, scalar, + complex); + binary_ops[octave_value::op_pow].add_overload (fn); + binary_ops[octave_value::op_el_pow].add_overload (fn); + + fn = create_external (JIT_FN (octave_jit_pow_complex_scalar), complex, + complex, scalar); + binary_ops[octave_value::op_pow].add_overload (fn); + binary_ops[octave_value::op_el_pow].add_overload (fn); + + // now for binary index operators + add_binary_op (index, octave_value::op_add, llvm::Instruction::Add); + + // and binary bool operators + add_binary_op (boolean, octave_value::op_el_or, llvm::Instruction::Or); + add_binary_op (boolean, octave_value::op_el_and, llvm::Instruction::And); + + // now for printing functions + print_fn.stash_name ("print"); + add_print (any, reinterpret_cast (&octave_jit_print_any)); + add_print (scalar, reinterpret_cast (&octave_jit_print_scalar)); + + // initialize for loop + for_init_fn.stash_name ("for_init"); + + fn = create_internal ("octave_jit_for_range_init", index, range); + body = fn.new_block (); + builder.SetInsertPoint (body); + { + llvm::Value *zero = llvm::ConstantInt::get (index_t, 0); + fn.do_return (builder, zero); + } + for_init_fn.add_overload (fn); + + // bounds check for for loop + for_check_fn.stash_name ("for_check"); + + fn = create_internal ("octave_jit_for_range_check", boolean, range, index); + body = fn.new_block (); + builder.SetInsertPoint (body); + { + llvm::Value *nelem + = builder.CreateExtractValue (fn.argument (builder, 0), 3); + llvm::Value *idx = fn.argument (builder, 1); + llvm::Value *ret = builder.CreateICmpULT (idx, nelem); + fn.do_return (builder, ret); + } + for_check_fn.add_overload (fn); + + // index variabe for for loop + for_index_fn.stash_name ("for_index"); + + fn = create_internal ("octave_jit_for_range_idx", scalar, range, index); + body = fn.new_block (); + builder.SetInsertPoint (body); + { + llvm::Value *idx = fn.argument (builder, 1); + llvm::Value *didx = builder.CreateSIToFP (idx, scalar_t); + llvm::Value *rng = fn.argument (builder, 0); + llvm::Value *base = builder.CreateExtractValue (rng, 0); + llvm::Value *inc = builder.CreateExtractValue (rng, 2); + + llvm::Value *ret = builder.CreateFMul (didx, inc); + ret = builder.CreateFAdd (base, ret); + fn.do_return (builder, ret); + } + for_index_fn.add_overload (fn); + + // logically true + logically_true_fn.stash_name ("logically_true"); + + jit_function gripe_nantl + = create_external (JIT_FN (octave_jit_gripe_nan_to_logical_conversion), 0); + gripe_nantl.mark_can_error (); + + fn = create_internal ("octave_jit_logically_true_scalar", boolean, scalar); + fn.mark_can_error (); + + body = fn.new_block (); + builder.SetInsertPoint (body); + { + llvm::BasicBlock *error_block = fn.new_block ("error"); + llvm::BasicBlock *normal_block = fn.new_block ("normal"); + + llvm::Value *check = builder.CreateFCmpUNE (fn.argument (builder, 0), + fn.argument (builder, 0)); + builder.CreateCondBr (check, error_block, normal_block); + + builder.SetInsertPoint (error_block); + gripe_nantl.call (builder); + builder.CreateBr (normal_block); + builder.SetInsertPoint (normal_block); + + llvm::Value *zero = llvm::ConstantFP::get (scalar_t, 0); + llvm::Value *ret = builder.CreateFCmpONE (fn.argument (builder, 0), zero); + fn.do_return (builder, ret); + } + logically_true_fn.add_overload (fn); + + // logically_true boolean + fn = create_identity (boolean); + logically_true_fn.add_overload (fn); + + // make_range + // FIXME: May be benificial to implement all in LLVM + make_range_fn.stash_name ("make_range"); + jit_function compute_nelem + = create_external (JIT_FN (octave_jit_compute_nelem), + index, scalar, scalar, scalar); + + + fn = create_internal ("octave_jit_make_range", range, scalar, scalar, scalar); + body = fn.new_block (); + builder.SetInsertPoint (body); + { + llvm::Value *base = fn.argument (builder, 0); + llvm::Value *limit = fn.argument (builder, 1); + llvm::Value *inc = fn.argument (builder, 2); + llvm::Value *nelem = compute_nelem.call (builder, base, limit, inc); + + llvm::Value *dzero = llvm::ConstantFP::get (scalar_t, 0); + llvm::Value *izero = llvm::ConstantInt::get (index_t, 0); + llvm::Value *rng = llvm::ConstantStruct::get (range_t, dzero, dzero, dzero, + izero, NULL); + rng = builder.CreateInsertValue (rng, base, 0); + rng = builder.CreateInsertValue (rng, limit, 1); + rng = builder.CreateInsertValue (rng, inc, 2); + rng = builder.CreateInsertValue (rng, nelem, 3); + fn.do_return (builder, rng); + } + make_range_fn.add_overload (fn); + + // paren_subsref + jit_type *jit_int = intN (sizeof (int) * 8); + llvm::Type *int_t = jit_int->to_llvm (); + jit_function ginvalid_index + = create_external (JIT_FN (octave_jit_ginvalid_index), 0); + jit_function gindex_range = create_external (JIT_FN (octave_jit_gindex_range), + 0, jit_int, jit_int, index, + index); + + fn = create_internal ("()subsref", scalar, matrix, scalar); + fn.mark_can_error (); + + body = fn.new_block (); + builder.SetInsertPoint (body); + { + llvm::Value *one = llvm::ConstantInt::get (index_t, 1); + llvm::Value *ione; + if (index_t == int_t) + ione = one; + else + ione = llvm::ConstantInt::get (int_t, 1); + + llvm::Value *undef = llvm::UndefValue::get (scalar_t); + llvm::Value *mat = fn.argument (builder, 0); + llvm::Value *idx = fn.argument (builder, 1); + + // convert index to scalar to integer, and check index >= 1 + llvm::Value *int_idx = builder.CreateFPToSI (idx, index_t); + llvm::Value *check_idx = builder.CreateSIToFP (int_idx, scalar_t); + llvm::Value *cond0 = builder.CreateFCmpUNE (idx, check_idx); + llvm::Value *cond1 = builder.CreateICmpSLT (int_idx, one); + llvm::Value *cond = builder.CreateOr (cond0, cond1); + + llvm::BasicBlock *done = fn.new_block ("done"); + llvm::BasicBlock *conv_error = fn.new_block ("conv_error", done); + llvm::BasicBlock *normal = fn.new_block ("normal", done); + builder.CreateCondBr (cond, conv_error, normal); + + builder.SetInsertPoint (conv_error); + ginvalid_index.call (builder); + builder.CreateBr (done); + + builder.SetInsertPoint (normal); + llvm::Value *len = builder.CreateExtractValue (mat, + llvm::ArrayRef (2)); + cond = builder.CreateICmpSGT (int_idx, len); + + + llvm::BasicBlock *bounds_error = fn.new_block ("bounds_error", done); + llvm::BasicBlock *success = fn.new_block ("success", done); + builder.CreateCondBr (cond, bounds_error, success); + + builder.SetInsertPoint (bounds_error); + gindex_range.call (builder, ione, ione, int_idx, len); + builder.CreateBr (done); + + builder.SetInsertPoint (success); + llvm::Value *data = builder.CreateExtractValue (mat, + llvm::ArrayRef (1)); + llvm::Value *gep = builder.CreateInBoundsGEP (data, int_idx); + llvm::Value *ret = builder.CreateLoad (gep); + builder.CreateBr (done); + + builder.SetInsertPoint (done); + + llvm::PHINode *merge = llvm::PHINode::Create (scalar_t, 3); + builder.Insert (merge); + merge->addIncoming (undef, conv_error); + merge->addIncoming (undef, bounds_error); + merge->addIncoming (ret, success); + fn.do_return (builder, merge); + } + paren_subsref_fn.add_overload (fn); + + // paren subsasgn + paren_subsasgn_fn.stash_name ("()subsasgn"); + + jit_function resize_paren_subsasgn + = create_external (JIT_FN (octave_jit_paren_subsasgn_impl), matrix, matrix, + index, scalar); + + fn = create_internal ("octave_jit_paren_subsasgn", matrix, matrix, scalar, + scalar); + fn.mark_can_error (); + body = fn.new_block (); + builder.SetInsertPoint (body); + { + llvm::Value *one = llvm::ConstantInt::get (index_t, 1); + + llvm::Value *mat = fn.argument (builder, 0); + llvm::Value *idx = fn.argument (builder, 1); + llvm::Value *value = fn.argument (builder, 2); + + llvm::Value *int_idx = builder.CreateFPToSI (idx, index_t); + llvm::Value *check_idx = builder.CreateSIToFP (int_idx, scalar_t); + llvm::Value *cond0 = builder.CreateFCmpUNE (idx, check_idx); + llvm::Value *cond1 = builder.CreateICmpSLT (int_idx, one); + llvm::Value *cond = builder.CreateOr (cond0, cond1); + + llvm::BasicBlock *done = fn.new_block ("done"); + + llvm::BasicBlock *conv_error = fn.new_block ("conv_error", done); + llvm::BasicBlock *normal = fn.new_block ("normal", done); + builder.CreateCondBr (cond, conv_error, normal); + builder.SetInsertPoint (conv_error); + ginvalid_index.call (builder); + builder.CreateBr (done); + + builder.SetInsertPoint (normal); + llvm::Value *len = builder.CreateExtractValue (mat, 2); + cond0 = builder.CreateICmpSGT (int_idx, len); + + llvm::Value *rcount = builder.CreateExtractValue (mat, 0); + rcount = builder.CreateLoad (rcount); + cond1 = builder.CreateICmpSGT (rcount, one); + cond = builder.CreateOr (cond0, cond1); + + llvm::BasicBlock *bounds_error = fn.new_block ("bounds_error", done); + llvm::BasicBlock *success = fn.new_block ("success", done); + builder.CreateCondBr (cond, bounds_error, success); + + // resize on out of bounds access + builder.SetInsertPoint (bounds_error); + llvm::Value *resize_result = resize_paren_subsasgn.call (builder, mat, + int_idx, value); + builder.CreateBr (done); + + builder.SetInsertPoint (success); + llvm::Value *data = builder.CreateExtractValue (mat, + llvm::ArrayRef (1)); + llvm::Value *gep = builder.CreateInBoundsGEP (data, int_idx); + builder.CreateStore (value, gep); + builder.CreateBr (done); + + builder.SetInsertPoint (done); + + llvm::PHINode *merge = llvm::PHINode::Create (matrix_t, 3); + builder.Insert (merge); + merge->addIncoming (mat, conv_error); + merge->addIncoming (resize_result, bounds_error); + merge->addIncoming (mat, success); + fn.do_return (builder, merge); + } + paren_subsasgn_fn.add_overload (fn); + + fn = create_external (JIT_FN (octave_jit_paren_subsasgn_matrix_range), matrix, + matrix, range, scalar); + fn.mark_can_error (); + paren_subsasgn_fn.add_overload (fn); + + end1_fn.stash_name ("end1"); + fn = create_internal ("octave_jit_end1_matrix", scalar, matrix, index, index); + body = fn.new_block (); + builder.SetInsertPoint (body); + { + llvm::Value *mat = fn.argument (builder, 0); + llvm::Value *ret = builder.CreateExtractValue (mat, 2); + fn.do_return (builder, builder.CreateSIToFP (ret, scalar_t)); + } + end1_fn.add_overload (fn); + + end_fn.stash_name ("end"); + fn = create_external (JIT_FN (octave_jit_end_matrix),scalar, matrix, index, + index); + end_fn.add_overload (fn); + + // -------------------- create_undef -------------------- + create_undef_fn.stash_name ("create_undef"); + fn = create_external (JIT_FN (octave_jit_create_undef), any); + create_undef_fn.add_overload (fn); + + casts[any->type_id ()].stash_name ("(any)"); + casts[scalar->type_id ()].stash_name ("(scalar)"); + casts[complex->type_id ()].stash_name ("(complex)"); + casts[matrix->type_id ()].stash_name ("(matrix)"); + casts[range->type_id ()].stash_name ("(range)"); + + // cast any <- matrix + fn = create_external (JIT_FN (octave_jit_cast_any_matrix), any, matrix); + casts[any->type_id ()].add_overload (fn); + + // cast matrix <- any + fn = create_external (JIT_FN (octave_jit_cast_matrix_any), matrix, any); + casts[matrix->type_id ()].add_overload (fn); + + // cast any <- range + fn = create_external (JIT_FN (octave_jit_cast_any_range), any, range); + casts[any->type_id ()].add_overload (fn); + + // cast range <- any + fn = create_external (JIT_FN (octave_jit_cast_range_any), range, any); + casts[range->type_id ()].add_overload (fn); + + // cast any <- scalar + fn = create_external (JIT_FN (octave_jit_cast_any_scalar), any, scalar); + casts[any->type_id ()].add_overload (fn); + + // cast scalar <- any + fn = create_external (JIT_FN (octave_jit_cast_scalar_any), scalar, any); + casts[scalar->type_id ()].add_overload (fn); + + // cast any <- complex + fn = create_external (JIT_FN (octave_jit_cast_any_complex), any, complex); + casts[any->type_id ()].add_overload (fn); + + // cast complex <- any + fn = create_external (JIT_FN (octave_jit_cast_complex_any), complex, any); + casts[complex->type_id ()].add_overload (fn); + + // cast complex <- scalar + fn = create_internal ("octave_jit_cast_complex_scalar", complex, scalar); + body = fn.new_block (); + builder.SetInsertPoint (body); + { + llvm::Value *zero = llvm::ConstantFP::get (scalar_t, 0); + fn.do_return (builder, complex_new (fn.argument (builder, 0), zero)); + } + casts[complex->type_id ()].add_overload (fn); + + // cast scalar <- complex + fn = create_internal ("octave_jit_cast_scalar_complex", scalar, complex); + body = fn.new_block (); + builder.SetInsertPoint (body); + fn.do_return (builder, complex_real (fn.argument (builder, 0))); + casts[scalar->type_id ()].add_overload (fn); + + // cast any <- any + fn = create_identity (any); + casts[any->type_id ()].add_overload (fn); + + // cast scalar <- scalar + fn = create_identity (scalar); + casts[scalar->type_id ()].add_overload (fn); + + // cast complex <- complex + fn = create_identity (complex); + casts[complex->type_id ()].add_overload (fn); + + // -------------------- builtin functions -------------------- + add_builtin ("#unknown_function"); + unknown_function = builtins["#unknown_function"]; + + add_builtin ("sin"); + register_intrinsic ("sin", llvm::Intrinsic::sin, scalar, scalar); + register_generic ("sin", matrix, matrix); + + add_builtin ("cos"); + register_intrinsic ("cos", llvm::Intrinsic::cos, scalar, scalar); + register_generic ("cos", matrix, matrix); + + add_builtin ("exp"); + register_intrinsic ("exp", llvm::Intrinsic::cos, scalar, scalar); + register_generic ("exp", matrix, matrix); + + add_builtin ("balance"); + register_generic ("balance", matrix, matrix); + + add_builtin ("cond"); + register_generic ("cond", scalar, matrix); + + add_builtin ("det"); + register_generic ("det", scalar, matrix); + + add_builtin ("norm"); + register_generic ("norm", scalar, matrix); + + add_builtin ("rand"); + register_generic ("rand", matrix, scalar); + register_generic ("rand", matrix, std::vector (2, scalar)); + + add_builtin ("magic"); + register_generic ("magic", matrix, scalar); + register_generic ("magic", matrix, std::vector (2, scalar)); + + add_builtin ("eye"); + register_generic ("eye", matrix, scalar); + register_generic ("eye", matrix, std::vector (2, scalar)); + + add_builtin ("mod"); + register_generic ("mod", scalar, std::vector (2, scalar)); + + casts.resize (next_id + 1); + jit_function any_id = create_identity (any); + jit_function grab_any = create_external (JIT_FN (octave_jit_grab_any), + any, any); + jit_function release_any = get_release (any); + std::vector args; + args.resize (1); + + for (std::map::iterator iter = builtins.begin (); + iter != builtins.end (); ++iter) + { + jit_type *btype = iter->second; + args[0] = btype; + + grab_fn.add_overload (jit_function (grab_any, btype, args)); + release_fn.add_overload (jit_function (release_any, 0, args)); + casts[any->type_id ()].add_overload (jit_function (any_id, any, args)); + + args[0] = any; + casts[btype->type_id ()].add_overload (jit_function (any_id, btype, + args)); + } +} + +const jit_function& +jit_typeinfo::do_end (jit_value *value, jit_value *idx, jit_value *count) +{ + jit_const_index *ccount = dynamic_cast (count); + if (ccount && ccount->value () == 1) + return end1_fn.overload (value->type (), idx->type (), count->type ()); + + return end_fn.overload (value->type (), idx->type (), count->type ()); +} + +jit_type* +jit_typeinfo::new_type (const std::string& name, jit_type *parent, + llvm::Type *llvm_type, bool skip_paren) +{ + jit_type *ret = new jit_type (name, parent, llvm_type, skip_paren, next_id++); + id_to_type.push_back (ret); + return ret; +} + +void +jit_typeinfo::add_print (jit_type *ty, void *fptr) +{ + std::stringstream name; + name << "octave_jit_print_" << ty->name (); + jit_function fn = create_external (engine, fptr, name.str (), 0, intN (8), ty); + print_fn.add_overload (fn); +} + +// FIXME: cp between add_binary_op, add_binary_icmp, and add_binary_fcmp +void +jit_typeinfo::add_binary_op (jit_type *ty, int op, int llvm_op) +{ + std::stringstream fname; + octave_value::binary_op ov_op = static_cast(op); + fname << "octave_jit_" << octave_value::binary_op_as_string (ov_op) + << "_" << ty->name (); + + jit_function fn = create_internal (fname.str (), ty, ty, ty); + llvm::BasicBlock *block = fn.new_block (); + builder.SetInsertPoint (block); + llvm::Instruction::BinaryOps temp + = static_cast(llvm_op); + + llvm::Value *ret = builder.CreateBinOp (temp, fn.argument (builder, 0), + fn.argument (builder, 1)); + fn.do_return (builder, ret); + binary_ops[op].add_overload (fn); +} + +void +jit_typeinfo::add_binary_icmp (jit_type *ty, int op, int llvm_op) +{ + std::stringstream fname; + octave_value::binary_op ov_op = static_cast(op); + fname << "octave_jit" << octave_value::binary_op_as_string (ov_op) + << "_" << ty->name (); + + jit_function fn = create_internal (fname.str (), boolean, ty, ty); + llvm::BasicBlock *block = fn.new_block (); + builder.SetInsertPoint (block); + llvm::CmpInst::Predicate temp + = static_cast(llvm_op); + llvm::Value *ret = builder.CreateICmp (temp, fn.argument (builder, 0), + fn.argument (builder, 1)); + fn.do_return (builder, ret); + binary_ops[op].add_overload (fn); +} + +void +jit_typeinfo::add_binary_fcmp (jit_type *ty, int op, int llvm_op) +{ + std::stringstream fname; + octave_value::binary_op ov_op = static_cast(op); + fname << "octave_jit" << octave_value::binary_op_as_string (ov_op) + << "_" << ty->name (); + + jit_function fn = create_internal (fname.str (), boolean, ty, ty); + llvm::BasicBlock *block = fn.new_block (); + builder.SetInsertPoint (block); + llvm::CmpInst::Predicate temp + = static_cast(llvm_op); + llvm::Value *ret = builder.CreateFCmp (temp, fn.argument (builder, 0), + fn.argument (builder, 1)); + fn.do_return (builder, ret); + binary_ops[op].add_overload (fn); +} + +jit_function +jit_typeinfo::create_function (jit_convention::type cc, const llvm::Twine& name, + jit_type *ret, + const std::vector& args) +{ + jit_function result (module, cc, name, ret, args); + return result; +} + +jit_function +jit_typeinfo::create_identity (jit_type *type) +{ + size_t id = type->type_id (); + if (id >= identities.size ()) + identities.resize (id + 1); + + if (! identities[id].valid ()) + { + std::stringstream name; + name << "id_" << type->name (); + + jit_function fn = create_internal (name.str (), type, type); + llvm::BasicBlock *body = fn.new_block (); + builder.SetInsertPoint (body); + fn.do_return (builder, fn.argument (builder, 0)); + return identities[id] = fn; + } + + return identities[id]; +} + +llvm::Value * +jit_typeinfo::do_insert_error_check (llvm::IRBuilderD& abuilder) +{ + return abuilder.CreateLoad (lerror_state); +} + +llvm::Value * +jit_typeinfo::do_insert_interrupt_check (llvm::IRBuilderD& abuilder) +{ + llvm::LoadInst *val = abuilder.CreateLoad (loctave_interrupt_state); + val->setVolatile (true); + return abuilder.CreateICmpSGT (val, abuilder.getInt32 (0)); +} + +void +jit_typeinfo::add_builtin (const std::string& name) +{ + jit_type *btype = new_type (name, any, any->to_llvm (), true); + builtins[name] = btype; + + octave_builtin *ov_builtin = find_builtin (name); + if (ov_builtin) + ov_builtin->stash_jit (*btype); +} + +void +jit_typeinfo::register_intrinsic (const std::string& name, size_t iid, + jit_type *result, + const std::vector& args) +{ + jit_type *builtin_type = builtins[name]; + size_t nargs = args.size (); + llvm::SmallVector llvm_args (nargs); + for (size_t i = 0; i < nargs; ++i) + llvm_args[i] = args[i]->to_llvm (); + + llvm::Intrinsic::ID id = static_cast (iid); + llvm::Function *ifun = llvm::Intrinsic::getDeclaration (module, id, + llvm_args); + std::stringstream fn_name; + fn_name << "octave_jit_" << name; + + std::vector args1 (nargs + 1); + args1[0] = builtin_type; + std::copy (args.begin (), args.end (), args1.begin () + 1); + + // The first argument will be the Octave function, but we already know that + // the function call is the equivalent of the intrinsic, so we ignore it and + // call the intrinsic with the remaining arguments. + jit_function fn = create_internal (fn_name.str (), result, args1); + llvm::BasicBlock *body = fn.new_block (); + builder.SetInsertPoint (body); + + llvm::SmallVector fargs (nargs); + for (size_t i = 0; i < nargs; ++i) + fargs[i] = fn.argument (builder, i + 1); + + llvm::Value *ret = builder.CreateCall (ifun, fargs); + fn.do_return (builder, ret); + paren_subsref_fn.add_overload (fn); +} + +octave_builtin * +jit_typeinfo::find_builtin (const std::string& name) +{ + // FIXME: Finalize what we want to store in octave_builtin, then add functions + // to access these values in octave_value + octave_value ov_builtin = symbol_table::find (name); + return dynamic_cast (ov_builtin.internal_rep ()); +} + +void +jit_typeinfo::register_generic (const std::string& name, jit_type *result, + const std::vector& args) +{ + octave_builtin *builtin = find_builtin (name); + if (! builtin) + return; + + std::vector fn_args (args.size () + 1); + fn_args[0] = builtins[name]; + std::copy (args.begin (), args.end (), fn_args.begin () + 1); + jit_function fn = create_internal (name, result, fn_args); + fn.mark_can_error (); + llvm::BasicBlock *block = fn.new_block (); + builder.SetInsertPoint (block); + llvm::Type *any_t = any->to_llvm (); + llvm::ArrayType *array_t = llvm::ArrayType::get (any_t, args.size ()); + llvm::Value *array = llvm::UndefValue::get (array_t); + for (size_t i = 0; i < args.size (); ++i) + { + llvm::Value *arg = fn.argument (builder, i + 1); + jit_function agrab = get_grab (args[i]); + if (agrab.valid ()) + arg = agrab.call (builder, arg); + jit_function acast = cast (any, args[i]); + array = builder.CreateInsertValue (array, acast.call (builder, arg), i); + } + + llvm::Value *array_mem = builder.CreateAlloca (array_t); + builder.CreateStore (array, array_mem); + array = builder.CreateBitCast (array_mem, any_t->getPointerTo ()); + + jit_type *jintTy = intN (sizeof (octave_builtin::fcn) * 8); + llvm::Type *intTy = jintTy->to_llvm (); + size_t fcn_int = reinterpret_cast (builtin->function ()); + llvm::Value *fcn = llvm::ConstantInt::get (intTy, fcn_int); + llvm::Value *nargin = llvm::ConstantInt::get (intTy, args.size ()); + size_t result_int = reinterpret_cast (result); + llvm::Value *res_llvm = llvm::ConstantInt::get (intTy, result_int); + llvm::Value *ret = any_call.call (builder, fcn, nargin, array, res_llvm); + + jit_function cast_result = cast (result, any); + fn.do_return (builder, cast_result.call (builder, ret)); + paren_subsref_fn.add_overload (fn); +} + +jit_function +jit_typeinfo::mirror_binary (const jit_function& fn) +{ + jit_function ret = create_internal (fn.name () + "_reverse", + fn.result (), fn.argument_type (1), + fn.argument_type (0)); + if (fn.can_error ()) + ret.mark_can_error (); + + llvm::BasicBlock *body = ret.new_block (); + builder.SetInsertPoint (body); + llvm::Value *result = fn.call (builder, ret.argument (builder, 1), + ret.argument (builder, 0)); + if (ret.result ()) + ret.do_return (builder, result); + else + ret.do_return (builder); + + return ret; +} + +llvm::Value * +jit_typeinfo::pack_complex (llvm::IRBuilderD& bld, llvm::Value *cplx) +{ + llvm::Type *complex_ret = instance->complex_ret; + llvm::Value *real = bld.CreateExtractValue (cplx, 0); + llvm::Value *imag = bld.CreateExtractValue (cplx, 1); + llvm::Value *ret = llvm::UndefValue::get (complex_ret); + + unsigned int re_idx[] = {0, 0}; + unsigned int im_idx[] = {0, 1}; + ret = bld.CreateInsertValue (ret, real, re_idx); + return bld.CreateInsertValue (ret, imag, im_idx); +} + +llvm::Value * +jit_typeinfo::unpack_complex (llvm::IRBuilderD& bld, llvm::Value *result) +{ + unsigned int re_idx[] = {0, 0}; + unsigned int im_idx[] = {0, 1}; + + llvm::Type *complex_t = get_complex ()->to_llvm (); + llvm::Value *real = bld.CreateExtractValue (result, re_idx); + llvm::Value *imag = bld.CreateExtractValue (result, im_idx); + llvm::Value *ret = llvm::UndefValue::get (complex_t); + + ret = bld.CreateInsertValue (ret, real, 0); + return bld.CreateInsertValue (ret, imag, 1); +} + +llvm::Value * +jit_typeinfo::complex_real (llvm::Value *cx) +{ + return builder.CreateExtractValue (cx, 0); +} + +llvm::Value * +jit_typeinfo::complex_real (llvm::Value *cx, llvm::Value *real) +{ + return builder.CreateInsertValue (cx, real, 0); +} + +llvm::Value * +jit_typeinfo::complex_imag (llvm::Value *cx) +{ + return builder.CreateExtractValue (cx, 1); +} + +llvm::Value * +jit_typeinfo::complex_imag (llvm::Value *cx, llvm::Value *imag) +{ + return builder.CreateInsertValue (cx, imag, 1); +} + +llvm::Value * +jit_typeinfo::complex_new (llvm::Value *real, llvm::Value *imag) +{ + llvm::Value *ret = llvm::UndefValue::get (complex->to_llvm ()); + ret = complex_real (ret, real); + return complex_imag (ret, imag); +} + +void +jit_typeinfo::create_int (size_t nbits) +{ + std::stringstream tname; + tname << "int" << nbits; + ints[nbits] = new_type (tname.str (), any, llvm::Type::getIntNTy (context, + nbits)); +} + +jit_type * +jit_typeinfo::intN (size_t nbits) const +{ + std::map::const_iterator iter = ints.find (nbits); + if (iter != ints.end ()) + return iter->second; + + throw jit_fail_exception ("No such integer type"); +} + +jit_type * +jit_typeinfo::do_type_of (const octave_value &ov) const +{ + if (ov.is_function ()) + { + // FIXME: This is ugly, we need to finalize how we want to to this, then + // have octave_value fully support the needed functionality + octave_builtin *builtin + = dynamic_cast (ov.internal_rep ()); + return builtin && builtin->to_jit () ? builtin->to_jit () + : unknown_function; + } + + if (ov.is_range ()) + return get_range (); + + if (ov.is_double_type () && ! ov.is_complex_type ()) + { + if (ov.is_real_scalar ()) + return get_scalar (); + + if (ov.is_matrix_type ()) + return get_matrix (); + } + + if (ov.is_complex_scalar ()) + { + Complex cv = ov.complex_value (); + + // We don't really represent complex values, instead we represent + // complex_or_scalar. If the imag value is zero, we assume a scalar. + if (cv.imag () != 0) + return get_complex (); + } + + return get_any (); +} + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/jit-typeinfo.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/jit-typeinfo.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,852 @@ +/* + +Copyright (C) 2012 Max Brister + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Author: Max Brister + +#if !defined (octave_jit_typeinfo_h) +#define octave_jit_typeinfo_h 1 + +#ifdef HAVE_LLVM + +#include +#include + +#include "Range.h" +#include "jit-util.h" + +// Defines the type system used by jit and a singleton class, jit_typeinfo, to +// manage the types. +// +// FIXME: +// Operations are defined and implemented in jit_typeinfo. Eventually they +// should be moved elsewhere. (just like with octave_typeinfo) + +// jit_range is compatable with the llvm range structure +struct +jit_range +{ + jit_range (const Range& from) : base (from.base ()), limit (from.limit ()), + inc (from.inc ()), nelem (from.nelem ()) + {} + + operator Range () const + { + return Range (base, limit, inc); + } + + bool all_elements_are_ints () const; + + double base; + double limit; + double inc; + octave_idx_type nelem; +}; + +std::ostream& operator<< (std::ostream& os, const jit_range& rng); + +// jit_array is compatable with the llvm array/matrix structures +template +struct +jit_array +{ + jit_array () : array (0) {} + + jit_array (T& from) : array (new T (from)) + { + update (); + } + + void update (void) + { + ref_count = array->jit_ref_count (); + slice_data = array->jit_slice_data () - 1; + slice_len = array->capacity (); + dimensions = array->jit_dimensions (); + } + + void update (T *aarray) + { + array = aarray; + update (); + } + + operator T () const + { + return *array; + } + + int *ref_count; + + U *slice_data; + octave_idx_type slice_len; + octave_idx_type *dimensions; + + T *array; +}; + +typedef jit_array jit_matrix; + +std::ostream& operator<< (std::ostream& os, const jit_matrix& mat); + +// calling convention +namespace +jit_convention +{ + enum + type + { + // internal to jit + internal, + + // an external C call + external, + + length + }; +} + +// Used to keep track of estimated (infered) types during JIT. This is a +// hierarchical type system which includes both concrete and abstract types. +// +// The types form a lattice. Currently we only allow for one parent type, but +// eventually we may allow for multiple predecessors. +class +jit_type +{ +public: + typedef llvm::Value *(*convert_fn) (llvm::IRBuilderD&, llvm::Value *); + + jit_type (const std::string& aname, jit_type *aparent, llvm::Type *allvm_type, + bool askip_paren, int aid); + + // a user readable type name + const std::string& name (void) const { return mname; } + + // a unique id for the type + int type_id (void) const { return mid; } + + // An abstract base type, may be null + jit_type *parent (void) const { return mparent; } + + // convert to an llvm type + llvm::Type *to_llvm (void) const { return llvm_type; } + + // how this type gets passed as a function argument + llvm::Type *to_llvm_arg (void) const; + + size_t depth (void) const { return mdepth; } + + bool skip_paren (void) const { return mskip_paren; } + + // -------------------- Calling Convention information -------------------- + + // A function declared like: mytype foo (int arg0, int arg1); + // Will be converted to: void foo (mytype *retval, int arg0, int arg1) + // if mytype is sret. The caller is responsible for allocating space for + // retval. (on the stack) + bool sret (jit_convention::type cc) const { return msret[cc]; } + + void mark_sret (jit_convention::type cc) + { msret[cc] = true; } + + // A function like: void foo (mytype arg0) + // Will be converted to: void foo (mytype *arg0) + // Basically just pass by reference. + bool pointer_arg (jit_convention::type cc) const { return mpointer_arg[cc]; } + + void mark_pointer_arg (jit_convention::type cc) + { mpointer_arg[cc] = true; } + + // Convert into an equivalent form before calling. For example, complex is + // represented as two values llvm vector, but we need to pass it as a two + // valued llvm structure to C functions. + convert_fn pack (jit_convention::type cc) { return mpack[cc]; } + + void set_pack (jit_convention::type cc, convert_fn fn) { mpack[cc] = fn; } + + // The inverse operation of pack. + convert_fn unpack (jit_convention::type cc) { return munpack[cc]; } + + void set_unpack (jit_convention::type cc, convert_fn fn) + { munpack[cc] = fn; } + + // The resulting type after pack is called. + llvm::Type *packed_type (jit_convention::type cc) + { return mpacked_type[cc]; } + + void set_packed_type (jit_convention::type cc, llvm::Type *ty) + { mpacked_type[cc] = ty; } +private: + std::string mname; + jit_type *mparent; + llvm::Type *llvm_type; + int mid; + size_t mdepth; + bool mskip_paren; + + bool msret[jit_convention::length]; + bool mpointer_arg[jit_convention::length]; + + convert_fn mpack[jit_convention::length]; + convert_fn munpack[jit_convention::length]; + + llvm::Type *mpacked_type[jit_convention::length]; +}; + +// seperate print function to allow easy printing if type is null +std::ostream& jit_print (std::ostream& os, jit_type *atype); + +class jit_value; + +// An abstraction for calling llvm functions with jit_values. Deals with calling +// convention details. +class +jit_function +{ + friend std::ostream& operator<< (std::ostream& os, const jit_function& fn); +public: + // create a function in an invalid state + jit_function (); + + jit_function (llvm::Module *amodule, jit_convention::type acall_conv, + const llvm::Twine& aname, jit_type *aresult, + const std::vector& aargs); + + // Use an existing function, but change the argument types. The new argument + // types must behave the same for the current calling convention. + jit_function (const jit_function& fn, jit_type *aresult, + const std::vector& aargs); + + jit_function (const jit_function& fn); + + // erase the interal LLVM function (if it exists). Will become invalid. + void erase (void); + + template + void add_mapping (llvm::ExecutionEngine *engine, T fn) + { + do_add_mapping (engine, reinterpret_cast (fn)); + } + + bool valid (void) const { return llvm_function; } + + std::string name (void) const; + + llvm::BasicBlock *new_block (const std::string& aname = "body", + llvm::BasicBlock *insert_before = 0); + + llvm::Value *call (llvm::IRBuilderD& builder, + const std::vector& in_args) const; + + llvm::Value *call (llvm::IRBuilderD& builder, + const std::vector& in_args + = std::vector ()) const; + +#define JIT_PARAM_ARGS llvm::IRBuilderD& builder, +#define JIT_PARAMS builder, +#define JIT_CALL(N) JIT_EXPAND (llvm::Value *, call, llvm::Value *, const, N) + + JIT_CALL (1) + JIT_CALL (2) + JIT_CALL (3) + JIT_CALL (4) + JIT_CALL (5) + +#undef JIT_CALL + +#define JIT_CALL(N) JIT_EXPAND (llvm::Value *, call, jit_value *, const, N) + + JIT_CALL (1); + JIT_CALL (2); + JIT_CALL (3); + +#undef JIT_CALL +#undef JIT_PARAMS +#undef JIT_PARAM_ARGS + + llvm::Value *argument (llvm::IRBuilderD& builder, size_t idx) const; + + void do_return (llvm::IRBuilderD& builder, llvm::Value *rval = 0, + bool verify = true); + + llvm::Function *to_llvm (void) const { return llvm_function; } + + // If true, then the return value is passed as a pointer in the first argument + bool sret (void) const { return mresult && mresult->sret (call_conv); } + + bool can_error (void) const { return mcan_error; } + + void mark_can_error (void) { mcan_error = true; } + + jit_type *result (void) const { return mresult; } + + jit_type *argument_type (size_t idx) const + { + assert (idx < args.size ()); + return args[idx]; + } + + const std::vector& arguments (void) const { return args; } +private: + void do_add_mapping (llvm::ExecutionEngine *engine, void *fn); + + llvm::Module *module; + llvm::Function *llvm_function; + jit_type *mresult; + std::vector args; + jit_convention::type call_conv; + bool mcan_error; +}; + +std::ostream& operator<< (std::ostream& os, const jit_function& fn); + + +// Keeps track of information about how to implement operations (+, -, *, ect) +// and their resulting types. +class +jit_operation +{ +public: + // type signature vector + typedef std::vector signature_vec; + + virtual ~jit_operation (void); + + void add_overload (const jit_function& func) + { + add_overload (func, func.arguments ()); + } + + void add_overload (const jit_function& func, + const signature_vec& args); + + const jit_function& overload (const signature_vec& types) const; + + jit_type *result (const signature_vec& types) const + { + const jit_function& temp = overload (types); + return temp.result (); + } + +#define JIT_PARAMS +#define JIT_PARAM_ARGS +#define JIT_OVERLOAD(N) \ + JIT_EXPAND (const jit_function&, overload, jit_type *, const, N) \ + JIT_EXPAND (jit_type *, result, jit_type *, const, N) + + JIT_OVERLOAD (1); + JIT_OVERLOAD (2); + JIT_OVERLOAD (3); + +#undef JIT_PARAMS +#undef JIT_PARAM_ARGS + + const std::string& name (void) const { return mname; } + + void stash_name (const std::string& aname) { mname = aname; } +protected: + virtual jit_function *generate (const signature_vec& types) const; +private: + Array to_idx (const signature_vec& types) const; + + const jit_function& do_generate (const signature_vec& types) const; + + struct signature_cmp + { + bool operator() (const signature_vec *lhs, const signature_vec *rhs); + }; + + typedef std::map + generated_map; + + mutable generated_map generated; + + std::vector > overloads; + + std::string mname; +}; + +class +jit_index_operation : public jit_operation +{ +public: + jit_index_operation (void) : module (0), engine (0) {} + + void initialize (llvm::Module *amodule, llvm::ExecutionEngine *aengine) + { + module = amodule; + engine = aengine; + do_initialize (); + } +protected: + virtual jit_function *generate (const signature_vec& types) const; + + virtual jit_function *generate_matrix (const signature_vec& types) const = 0; + + virtual void do_initialize (void) = 0; + + // helper functions + // [start_idx, end_idx). + llvm::Value *create_arg_array (llvm::IRBuilderD& builder, + const jit_function &fn, size_t start_idx, + size_t end_idx) const; + + llvm::Module *module; + llvm::ExecutionEngine *engine; +}; + +class +jit_paren_subsref : public jit_index_operation +{ +protected: + virtual jit_function *generate_matrix (const signature_vec& types) const; + + virtual void do_initialize (void); +private: + jit_function paren_scalar; +}; + +class +jit_paren_subsasgn : public jit_index_operation +{ +protected: + jit_function *generate_matrix (const signature_vec& types) const; + + virtual void do_initialize (void); +private: + jit_function paren_scalar; +}; + +// A singleton class which handles the construction of jit_types and +// jit_operations. +class +jit_typeinfo +{ +public: + static void initialize (llvm::Module *m, llvm::ExecutionEngine *e); + + static jit_type *join (jit_type *lhs, jit_type *rhs) + { + return instance->do_join (lhs, rhs); + } + + static jit_type *get_any (void) { return instance->any; } + + static jit_type *get_matrix (void) { return instance->matrix; } + + static jit_type *get_scalar (void) { return instance->scalar; } + + static llvm::Type *get_scalar_llvm (void) + { return instance->scalar->to_llvm (); } + + static jit_type *get_scalar_ptr (void) { return instance->scalar_ptr; } + + static jit_type *get_any_ptr (void) { return instance->any_ptr; } + + static jit_type *get_range (void) { return instance->range; } + + static jit_type *get_string (void) { return instance->string; } + + static jit_type *get_bool (void) { return instance->boolean; } + + static jit_type *get_index (void) { return instance->index; } + + static llvm::Type *get_index_llvm (void) + { return instance->index->to_llvm (); } + + static jit_type *get_complex (void) { return instance->complex; } + + // Get the jit_type of an octave_value + static jit_type *type_of (const octave_value& ov) + { + return instance->do_type_of (ov); + } + + static const jit_operation& binary_op (int op) + { + return instance->do_binary_op (op); + } + + static const jit_operation& unary_op (int op) + { + return instance->do_unary_op (op); + } + + static const jit_operation& grab (void) { return instance->grab_fn; } + + static const jit_function& get_grab (jit_type *type) + { + return instance->grab_fn.overload (type); + } + + static const jit_operation& release (void) + { + return instance->release_fn; + } + + static const jit_function& get_release (jit_type *type) + { + return instance->release_fn.overload (type); + } + + static const jit_operation& destroy (void) + { + return instance->destroy_fn; + } + + static const jit_operation& print_value (void) + { + return instance->print_fn; + } + + static const jit_operation& for_init (void) + { + return instance->for_init_fn; + } + + static const jit_operation& for_check (void) + { + return instance->for_check_fn; + } + + static const jit_operation& for_index (void) + { + return instance->for_index_fn; + } + + static const jit_operation& make_range (void) + { + return instance->make_range_fn; + } + + static const jit_operation& paren_subsref (void) + { + return instance->paren_subsref_fn; + } + + static const jit_operation& paren_subsasgn (void) + { + return instance->paren_subsasgn_fn; + } + + static const jit_operation& logically_true (void) + { + return instance->logically_true_fn; + } + + static const jit_operation& cast (jit_type *result) + { + return instance->do_cast (result); + } + + static const jit_function& cast (jit_type *to, jit_type *from) + { + return instance->do_cast (to, from); + } + + static llvm::Value *insert_error_check (llvm::IRBuilderD& bld) + { + return instance->do_insert_error_check (bld); + } + + static llvm::Value *insert_interrupt_check (llvm::IRBuilderD& bld) + { + return instance->do_insert_interrupt_check (bld); + } + + static const jit_operation& end (void) + { + return instance->end_fn; + } + + static const jit_function& end (jit_value *value, jit_value *index, + jit_value *count) + { + return instance->do_end (value, index, count); + } + + static const jit_operation& create_undef (void) + { + return instance->create_undef_fn; + } + + static llvm::Value *create_complex (llvm::Value *real, llvm::Value *imag) + { + return instance->complex_new (real, imag); + } +private: + jit_typeinfo (llvm::Module *m, llvm::ExecutionEngine *e); + + // FIXME: Do these methods really need to be in jit_typeinfo? + jit_type *do_join (jit_type *lhs, jit_type *rhs) + { + // empty case + if (! lhs) + return rhs; + + if (! rhs) + return lhs; + + // check for a shared parent + while (lhs != rhs) + { + if (lhs->depth () > rhs->depth ()) + lhs = lhs->parent (); + else if (lhs->depth () < rhs->depth ()) + rhs = rhs->parent (); + else + { + // we MUST have depth > 0 as any is the base type of everything + do + { + lhs = lhs->parent (); + rhs = rhs->parent (); + } + while (lhs != rhs); + } + } + + return lhs; + } + + jit_type *do_difference (jit_type *lhs, jit_type *) + { + // FIXME: Maybe we can do something smarter? + return lhs; + } + + jit_type *do_type_of (const octave_value &ov) const; + + const jit_operation& do_binary_op (int op) const + { + assert (static_cast(op) < binary_ops.size ()); + return binary_ops[op]; + } + + const jit_operation& do_unary_op (int op) const + { + assert (static_cast (op) < unary_ops.size ()); + return unary_ops[op]; + } + + const jit_operation& do_cast (jit_type *to) + { + static jit_operation null_function; + if (! to) + return null_function; + + size_t id = to->type_id (); + if (id >= casts.size ()) + return null_function; + return casts[id]; + } + + const jit_function& do_cast (jit_type *to, jit_type *from) + { + return do_cast (to).overload (from); + } + + const jit_function& do_end (jit_value *value, jit_value *index, + jit_value *count); + + jit_type *new_type (const std::string& name, jit_type *parent, + llvm::Type *llvm_type, bool skip_paren = false); + + + void add_print (jit_type *ty, void *fptr); + + void add_binary_op (jit_type *ty, int op, int llvm_op); + + void add_binary_icmp (jit_type *ty, int op, int llvm_op); + + void add_binary_fcmp (jit_type *ty, int op, int llvm_op); + + // create a function with an external calling convention + // forces the function pointer to be specified + template + jit_function create_external (llvm::ExecutionEngine *ee, T fn, + const llvm::Twine& name, jit_type *ret, + const std::vector& args + = std::vector ()) + { + jit_function retval = create_function (jit_convention::external, name, ret, + args); + retval.add_mapping (ee, fn); + return retval; + } + +#define JIT_PARAM_ARGS llvm::ExecutionEngine *ee, T fn, \ + const llvm::Twine& name, jit_type *ret, +#define JIT_PARAMS ee, fn, name, ret, +#define CREATE_FUNCTION(N) JIT_EXPAND(template jit_function, \ + create_external, \ + jit_type *, /* empty */, N) + + CREATE_FUNCTION(1); + CREATE_FUNCTION(2); + CREATE_FUNCTION(3); + CREATE_FUNCTION(4); + +#undef JIT_PARAM_ARGS +#undef JIT_PARAMS +#undef CREATE_FUNCTION + + // use create_external or create_internal directly + jit_function create_function (jit_convention::type cc, + const llvm::Twine& name, jit_type *ret, + const std::vector& args + = std::vector ()); + + // create an internal calling convention (a function defined in llvm) + jit_function create_internal (const llvm::Twine& name, jit_type *ret, + const std::vector& args + = std::vector ()) + { + return create_function (jit_convention::internal, name, ret, args); + } + +#define JIT_PARAM_ARGS const llvm::Twine& name, jit_type *ret, +#define JIT_PARAMS name, ret, +#define CREATE_FUNCTION(N) JIT_EXPAND(jit_function, create_internal, \ + jit_type *, /* empty */, N) + + CREATE_FUNCTION(1); + CREATE_FUNCTION(2); + CREATE_FUNCTION(3); + CREATE_FUNCTION(4); + +#undef JIT_PARAM_ARGS +#undef JIT_PARAMS +#undef CREATE_FUNCTION + + jit_function create_identity (jit_type *type); + + llvm::Value *do_insert_error_check (llvm::IRBuilderD& bld); + + llvm::Value *do_insert_interrupt_check (llvm::IRBuilderD& bld); + + void add_builtin (const std::string& name); + + void register_intrinsic (const std::string& name, size_t id, + jit_type *result, jit_type *arg0) + { + std::vector args (1, arg0); + register_intrinsic (name, id, result, args); + } + + void register_intrinsic (const std::string& name, size_t id, jit_type *result, + const std::vector& args); + + void register_generic (const std::string& name, jit_type *result, + jit_type *arg0) + { + std::vector args (1, arg0); + register_generic (name, result, args); + } + + void register_generic (const std::string& name, jit_type *result, + const std::vector& args); + + octave_builtin *find_builtin (const std::string& name); + + jit_function mirror_binary (const jit_function& fn); + + llvm::Function *wrap_complex (llvm::Function *wrap); + + static llvm::Value *pack_complex (llvm::IRBuilderD& bld, + llvm::Value *cplx); + + static llvm::Value *unpack_complex (llvm::IRBuilderD& bld, + llvm::Value *result); + + llvm::Value *complex_real (llvm::Value *cx); + + llvm::Value *complex_real (llvm::Value *cx, llvm::Value *real); + + llvm::Value *complex_imag (llvm::Value *cx); + + llvm::Value *complex_imag (llvm::Value *cx, llvm::Value *imag); + + llvm::Value *complex_new (llvm::Value *real, llvm::Value *imag); + + void create_int (size_t nbits); + + jit_type *intN (size_t nbits) const; + + static jit_typeinfo *instance; + + llvm::Module *module; + llvm::ExecutionEngine *engine; + int next_id; + + llvm::GlobalVariable *lerror_state; + llvm::GlobalVariable *loctave_interrupt_state; + + llvm::Type *sig_atomic_type; + + std::vector id_to_type; + jit_type *any; + jit_type *matrix; + jit_type *scalar; + jit_type *scalar_ptr; // a fake type for interfacing with C++ + jit_type *any_ptr; // a fake type for interfacing with C++ + jit_type *range; + jit_type *string; + jit_type *boolean; + jit_type *index; + jit_type *complex; + jit_type *unknown_function; + std::map ints; + std::map builtins; + + llvm::StructType *complex_ret; + + std::vector binary_ops; + std::vector unary_ops; + jit_operation grab_fn; + jit_operation release_fn; + jit_operation destroy_fn; + jit_operation print_fn; + jit_operation for_init_fn; + jit_operation for_check_fn; + jit_operation for_index_fn; + jit_operation logically_true_fn; + jit_operation make_range_fn; + jit_paren_subsref paren_subsref_fn; + jit_paren_subsasgn paren_subsasgn_fn; + jit_operation end1_fn; + jit_operation end_fn; + jit_operation create_undef_fn; + + jit_function any_call; + + // type id -> cast function TO that type + std::vector casts; + + // type id -> identity function + std::vector identities; + + llvm::IRBuilderD& builder; +}; + +#endif +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/jit-util.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/jit-util.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,46 @@ +/* + +Copyright (C) 2012 Max Brister + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Author: Max Brister + +// defines required by llvm +#define __STDC_LIMIT_MACROS +#define __STDC_CONSTANT_MACROS + +#ifdef HAVE_CONFIG_H +#include +#endif + +#ifdef HAVE_LLVM + +#include +#include + +std::ostream& +operator<< (std::ostream& os, const llvm::Value& v) +{ + llvm::raw_os_ostream llvm_out (os); + v.print (llvm_out); + return os; +} + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/jit-util.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/jit-util.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,205 @@ +/* + +Copyright (C) 2012 Max Brister + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Author: Max Brister + +// Some utility classes and functions used throughout jit + +#if !defined (octave_jit_util_h) +#define octave_jit_util_h 1 + +#ifdef HAVE_LLVM + +#include + +// we don't want to include llvm headers here, as they require +// __STDC_LIMIT_MACROS and __STDC_CONSTANT_MACROS be defined in the entire +// compilation unit +namespace llvm +{ + class Value; + class Module; + class FunctionPassManager; + class PassManager; + class ExecutionEngine; + class Function; + class BasicBlock; + class LLVMContext; + class Type; + class StructType; + class Twine; + class GlobalVariable; + class TerminatorInst; + class PHINode; + + class ConstantFolder; + + template + class IRBuilderDefaultInserter; + + template + class IRBuilder; + +typedef IRBuilder > +IRBuilderD; +} + +class octave_base_value; +class octave_builtin; +class octave_value; +class tree; +class tree_expression; + +// thrown when we should give up on JIT and interpret +class jit_fail_exception : public std::runtime_error +{ +public: + jit_fail_exception (void) : std::runtime_error ("unknown"), mknown (false) {} + jit_fail_exception (const std::string& reason) : std::runtime_error (reason), + mknown (true) + {} + + bool known (void) const { return mknown; } +private: + bool mknown; +}; + +// llvm doesn't provide this, and it's really useful for debugging +std::ostream& operator<< (std::ostream& os, const llvm::Value& v); + +template +class jit_internal_node; + +// jit_internal_list and jit_internal_node implement generic embedded doubly +// linked lists. List items extend from jit_internal_list, and can be placed +// in nodes of type jit_internal_node. We use CRTP twice. +template +class +jit_internal_list +{ + friend class jit_internal_node; +public: + jit_internal_list (void) : use_head (0), use_tail (0), muse_count (0) {} + + virtual ~jit_internal_list (void) + { + while (use_head) + use_head->stash_value (0); + } + + NODE_T *first_use (void) const { return use_head; } + + size_t use_count (void) const { return muse_count; } +private: + NODE_T *use_head; + NODE_T *use_tail; + size_t muse_count; +}; + +// a node for internal linked lists +template +class +jit_internal_node +{ +public: + typedef jit_internal_list jit_ilist; + + jit_internal_node (void) : mvalue (0), mnext (0), mprev (0) {} + + ~jit_internal_node (void) { remove (); } + + LIST_T *value (void) const { return mvalue; } + + void stash_value (LIST_T *avalue) + { + remove (); + + mvalue = avalue; + + if (mvalue) + { + jit_ilist *ilist = mvalue; + NODE_T *sthis = static_cast (this); + if (ilist->use_head) + { + ilist->use_tail->mnext = sthis; + mprev = ilist->use_tail; + } + else + ilist->use_head = sthis; + + ilist->use_tail = sthis; + ++ilist->muse_count; + } + } + + NODE_T *next (void) const { return mnext; } + + NODE_T *prev (void) const { return mprev; } +private: + void remove () + { + if (mvalue) + { + jit_ilist *ilist = mvalue; + if (mprev) + mprev->mnext = mnext; + else + // we are the use_head + ilist->use_head = mnext; + + if (mnext) + mnext->mprev = mprev; + else + // we are the use tail + ilist->use_tail = mprev; + + mnext = mprev = 0; + --ilist->muse_count; + mvalue = 0; + } + } + + LIST_T *mvalue; + NODE_T *mnext; + NODE_T *mprev; +}; + +// Use like: isa (value) +// basically just a short cut type typing dyanmic_cast. +template +bool isa (U *value) +{ + return dynamic_cast (value); +} + +#define JIT_ASSIGN_ARG(i) the_args[i] = arg ## i; +#define JIT_EXPAND(ret, fname, type, isconst, N) \ + ret fname (JIT_PARAM_ARGS OCT_MAKE_DECL_LIST (type, arg, N)) isconst \ + { \ + std::vector the_args (N); \ + OCT_ITERATE_MACRO (JIT_ASSIGN_ARG, N); \ + return fname (JIT_PARAMS the_args); \ + } + +#endif +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/load-path.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/load-path.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,2342 @@ +/* + +Copyright (C) 2006-2012 John W. Eaton +Copyright (C) 2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "dir-ops.h" +#include "file-ops.h" +#include "file-stat.h" +#include "oct-env.h" +#include "pathsearch.h" +#include "singleton-cleanup.h" + +#include "defaults.h" +#include "defun.h" +#include "input.h" +#include "load-path.h" +#include "pager.h" +#include "parse.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" + +load_path *load_path::instance = 0; +load_path::hook_fcn_ptr load_path::add_hook = execute_pkg_add; +load_path::hook_fcn_ptr load_path::remove_hook = execute_pkg_del; +std::string load_path::command_line_path; +std::string load_path::sys_path; +load_path::abs_dir_cache_type load_path::abs_dir_cache; + +void +load_path::dir_info::update (void) +{ + file_stat fs (dir_name); + + if (fs) + { + if (is_relative) + { + try + { + std::string abs_name = octave_env::make_absolute (dir_name); + + abs_dir_cache_iterator p = abs_dir_cache.find (abs_name); + + if (p != abs_dir_cache.end ()) + { + // The directory is in the cache of all directories + // we have visited (indexed by its absolute name). + // If it is out of date, initialize it. Otherwise, + // copy the info from the cache. By doing that, we + // avoid unnecessary calls to stat that can slow + // things down tremendously for large directories. + + const dir_info& di = p->second; + + if (fs.mtime () + fs.time_resolution () > di.dir_time_last_checked) + initialize (); + else + *this = di; + } + else + { + // We haven't seen this directory before. + + initialize (); + } + } + catch (octave_execution_exception) + { + // Skip updating if we don't know where we are, but + // don't treat it as an error. + + error_state = 0; + } + } + else if (fs.mtime () + fs.time_resolution () > dir_time_last_checked) + initialize (); + } + else + { + std::string msg = fs.error (); + warning ("load_path: %s: %s", dir_name.c_str (), msg.c_str ()); + } +} + +void +load_path::dir_info::initialize (void) +{ + is_relative = ! octave_env::absolute_pathname (dir_name); + + dir_time_last_checked = octave_time (static_cast (0)); + + file_stat fs (dir_name); + + if (fs) + { + method_file_map.clear (); + + dir_mtime = fs.mtime (); + dir_time_last_checked = octave_time (); + + get_file_list (dir_name); + + try + { + std::string abs_name = octave_env::make_absolute (dir_name); + + // FIXME -- nothing is ever removed from this cache of + // directory information, so there could be some resource + // problems. Perhaps it should be pruned from time to time. + + abs_dir_cache[abs_name] = *this; + } + catch (octave_execution_exception) + { + // Skip updating if we don't know where we are. + } + } + else + { + std::string msg = fs.error (); + warning ("load_path: %s: %s", dir_name.c_str (), msg.c_str ()); + } +} + +void +load_path::dir_info::get_file_list (const std::string& d) +{ + dir_entry dir (d); + + if (dir) + { + string_vector flist = dir.read (); + + octave_idx_type len = flist.length (); + + all_files.resize (len); + fcn_files.resize (len); + + octave_idx_type all_files_count = 0; + octave_idx_type fcn_files_count = 0; + + for (octave_idx_type i = 0; i < len; i++) + { + std::string fname = flist[i]; + + std::string full_name = file_ops::concat (d, fname); + + file_stat fs (full_name); + + if (fs) + { + if (fs.is_dir ()) + { + if (fname == "private") + get_private_file_map (full_name); + else if (fname[0] == '@') + get_method_file_map (full_name, fname.substr (1)); + } + else + { + all_files[all_files_count++] = fname; + + size_t pos = fname.rfind ('.'); + + if (pos != std::string::npos) + { + std::string ext = fname.substr (pos); + + if (ext == ".m" || ext == ".oct" || ext == ".mex") + { + std::string base = fname.substr (0, pos); + + if (valid_identifier (base)) + fcn_files[fcn_files_count++] = fname; + } + } + } + } + } + + all_files.resize (all_files_count); + fcn_files.resize (fcn_files_count); + } + else + { + std::string msg = dir.error (); + warning ("load_path: %s: %s", d.c_str (), msg.c_str ()); + } +} + +load_path::dir_info::fcn_file_map_type +get_fcn_files (const std::string& d) +{ + load_path::dir_info::fcn_file_map_type retval; + + dir_entry dir (d); + + if (dir) + { + string_vector flist = dir.read (); + + octave_idx_type len = flist.length (); + + for (octave_idx_type i = 0; i < len; i++) + { + std::string fname = flist[i]; + + std::string ext; + std::string base = fname; + + size_t pos = fname.rfind ('.'); + + if (pos != std::string::npos) + { + base = fname.substr (0, pos); + ext = fname.substr (pos); + + if (valid_identifier (base)) + { + int t = 0; + + if (ext == ".m") + t = load_path::M_FILE; + else if (ext == ".oct") + t = load_path::OCT_FILE; + else if (ext == ".mex") + t = load_path::MEX_FILE; + + retval[base] |= t; + } + } + } + } + else + { + std::string msg = dir.error (); + warning ("load_path: %s: %s", d.c_str (), msg.c_str ()); + } + + return retval; +} + +void +load_path::dir_info::get_private_file_map (const std::string& d) +{ + private_file_map = get_fcn_files (d); +} + +void +load_path::dir_info::get_method_file_map (const std::string& d, + const std::string& class_name) +{ + method_file_map[class_name].method_file_map = get_fcn_files (d); + + std::string pd = file_ops::concat (d, "private"); + + file_stat fs (pd); + + if (fs && fs.is_dir ()) + method_file_map[class_name].private_file_map = get_fcn_files (pd); +} + +bool +load_path::instance_ok (void) +{ + bool retval = true; + + if (! instance) + { + instance = new load_path (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } + + if (! instance) + { + ::error ("unable to create load path object!"); + + retval = false; + } + + return retval; +} + +// FIXME -- maybe we should also maintain a map to speed up this +// method of access. + +load_path::const_dir_info_list_iterator +load_path::find_dir_info (const std::string& dir_arg) const +{ + std::string dir = file_ops::tilde_expand (dir_arg); + + const_dir_info_list_iterator retval = dir_info_list.begin (); + + while (retval != dir_info_list.end ()) + { + if (retval->dir_name == dir) + break; + + retval++; + } + + return retval; +} + +load_path::dir_info_list_iterator +load_path::find_dir_info (const std::string& dir_arg) +{ + std::string dir = file_ops::tilde_expand (dir_arg); + + dir_info_list_iterator retval = dir_info_list.begin (); + + while (retval != dir_info_list.end ()) + { + if (retval->dir_name == dir) + break; + + retval++; + } + + return retval; +} + +bool +load_path::contains (const std::string& dir) const +{ + return find_dir_info (dir) != dir_info_list.end (); +} + +bool +load_path::do_contains_canonical (const std::string& dir) const +{ + bool retval = false; + + for (const_dir_info_list_iterator i = dir_info_list.begin (); + i != dir_info_list.end (); + i++) + { + if (same_file (dir, i->dir_name)) + { + retval = true; + break; + } + } + + return retval; +} + +void +load_path::move_fcn_map (const std::string& dir_name, + const string_vector& fcn_files, bool at_end) +{ + octave_idx_type len = fcn_files.length (); + + for (octave_idx_type k = 0; k < len; k++) + { + std::string fname = fcn_files[k]; + + std::string ext; + std::string base = fname; + + size_t pos = fname.rfind ('.'); + + if (pos != std::string::npos) + { + base = fname.substr (0, pos); + ext = fname.substr (pos); + } + + file_info_list_type& file_info_list = fcn_map[base]; + + if (file_info_list.size () == 1) + continue; + else + { + for (file_info_list_iterator p = file_info_list.begin (); + p != file_info_list.end (); + p++) + { + if (p->dir_name == dir_name) + { + file_info fi = *p; + + file_info_list.erase (p); + + if (at_end) + file_info_list.push_back (fi); + else + file_info_list.push_front (fi); + + break; + } + } + } + } +} + +void +load_path::move_method_map (const std::string& dir_name, bool at_end) +{ + for (method_map_iterator i = method_map.begin (); + i != method_map.end (); + i++) + { + std::string class_name = i->first; + + fcn_map_type& fm = i->second; + + std::string full_dir_name + = file_ops::concat (dir_name, "@" + class_name); + + for (fcn_map_iterator q = fm.begin (); q != fm.end (); q++) + { + file_info_list_type& file_info_list = q->second; + + if (file_info_list.size () == 1) + continue; + else + { + for (file_info_list_iterator p = file_info_list.begin (); + p != file_info_list.end (); + p++) + { + if (p->dir_name == full_dir_name) + { + file_info fi = *p; + + file_info_list.erase (p); + + if (at_end) + file_info_list.push_back (fi); + else + file_info_list.push_front (fi); + + break; + } + } + } + } + } +} + +void +load_path::move (dir_info_list_iterator i, bool at_end) +{ + if (dir_info_list.size () > 1) + { + dir_info di = *i; + + dir_info_list.erase (i); + + if (at_end) + dir_info_list.push_back (di); + else + dir_info_list.push_front (di); + + std::string dir_name = di.dir_name; + + move_fcn_map (dir_name, di.fcn_files, at_end); + + // No need to move elements of private function map. + + move_method_map (dir_name, at_end); + } +} + +static void +maybe_add_path_elts (std::string& path, const std::string& dir) +{ + std::string tpath = genpath (dir); + + if (! tpath.empty ()) + { + if (path.empty ()) + path = tpath; + else + path += dir_path::path_sep_str () + tpath; + } +} + +void +load_path::do_initialize (bool set_initial_path) +{ + sys_path = ""; + + if (set_initial_path) + { + maybe_add_path_elts (sys_path, Vlocal_ver_oct_file_dir); + maybe_add_path_elts (sys_path, Vlocal_api_oct_file_dir); + maybe_add_path_elts (sys_path, Vlocal_oct_file_dir); + maybe_add_path_elts (sys_path, Vlocal_ver_fcn_file_dir); + maybe_add_path_elts (sys_path, Vlocal_api_fcn_file_dir); + maybe_add_path_elts (sys_path, Vlocal_fcn_file_dir); + maybe_add_path_elts (sys_path, Voct_file_dir); + maybe_add_path_elts (sys_path, Vfcn_file_dir); + } + + std::string tpath = load_path::command_line_path; + + if (tpath.empty ()) + tpath = octave_env::getenv ("OCTAVE_PATH"); + + std::string xpath; + + if (! tpath.empty ()) + { + xpath = tpath; + + if (! sys_path.empty ()) + xpath += dir_path::path_sep_str () + sys_path; + } + else + xpath = sys_path; + + do_set (xpath, false, true); +} + +void +load_path::do_clear (void) +{ + dir_info_list.clear (); + fcn_map.clear (); + private_fcn_map.clear (); + method_map.clear (); +} + +static std::list +split_path (const std::string& p) +{ + std::list retval; + + size_t beg = 0; + size_t end = p.find (dir_path::path_sep_char ()); + + size_t len = p.length (); + + while (end != std::string::npos) + { + std::string elt = p.substr (beg, end-beg); + + if (! elt.empty ()) + retval.push_back (elt); + + beg = end + 1; + + if (beg == len) + break; + + end = p.find (dir_path::path_sep_char (), beg); + } + + std::string elt = p.substr (beg); + + if (! elt.empty ()) + retval.push_back (elt); + + return retval; +} + +void +load_path::do_set (const std::string& p, bool warn, bool is_init) +{ + // Use a list when we need to preserve order. + std::list elts = split_path (p); + + // Use a set when we need to search and order is not important. + std::set elts_set (elts.begin (), elts.end ()); + + if (is_init) + init_dirs = elts_set; + else + { + for (std::set::const_iterator it = init_dirs.begin (); + it != init_dirs.end (); it++) + { + if (elts_set.find (*it) == elts_set.end ()) + { + warning_with_id ("Octave:remove-init-dir", + "default load path altered. Some built-in functions may not be found. Try restoredefaultpath() to recover it."); + break; + } + } + } + + // Temporarily disable add hook. + + unwind_protect frame; + frame.protect_var (add_hook); + + add_hook = 0; + + do_clear (); + + for (std::list::const_iterator i = elts.begin (); + i != elts.end (); i++) + do_append (*i, warn); + + // Restore add hook and execute for all newly added directories. + frame.run_first (); + + for (dir_info_list_iterator i = dir_info_list.begin (); + i != dir_info_list.end (); + i++) + { + if (add_hook) + add_hook (i->dir_name); + } + + // Always prepend current directory. + do_prepend (".", warn); +} + +void +load_path::do_append (const std::string& dir, bool warn) +{ + if (! dir.empty ()) + do_add (dir, true, warn); +} + +void +load_path::do_prepend (const std::string& dir, bool warn) +{ + if (! dir.empty ()) + do_add (dir, false, warn); +} + +// Strip trailing directory separators. + +static std::string +strip_trailing_separators (const std::string& dir_arg) +{ + std::string dir = dir_arg; + + size_t k = dir.length (); + + while (k > 1 && file_ops::is_dir_sep (dir[k-1])) + k--; + + if (k < dir.length ()) + dir.resize (k); + + return dir; +} + +void +load_path::do_add (const std::string& dir_arg, bool at_end, bool warn) +{ + size_t len = dir_arg.length (); + + if (len > 1 && dir_arg.substr (len-2) == "//") + warning_with_id ("Octave:recursive-path-search", + "trailing '//' is no longer special in search path elements"); + + std::string dir = file_ops::tilde_expand (dir_arg); + + dir = strip_trailing_separators (dir); + + dir_info_list_iterator i = find_dir_info (dir); + + if (i != dir_info_list.end ()) + move (i, at_end); + else + { + file_stat fs (dir); + + if (fs) + { + if (fs.is_dir ()) + { + dir_info di (dir); + + if (! error_state) + { + if (at_end) + dir_info_list.push_back (di); + else + dir_info_list.push_front (di); + + add_to_fcn_map (di, at_end); + + add_to_private_fcn_map (di); + + add_to_method_map (di, at_end); + + if (add_hook) + add_hook (dir); + } + } + else if (warn) + warning ("addpath: %s: not a directory", dir_arg.c_str ()); + } + else if (warn) + { + std::string msg = fs.error (); + warning ("addpath: %s: %s", dir_arg.c_str (), msg.c_str ()); + } + } + + // FIXME -- is there a better way to do this? + + i = find_dir_info ("."); + + if (i != dir_info_list.end ()) + move (i, false); +} + +void +load_path::remove_fcn_map (const std::string& dir, + const string_vector& fcn_files) +{ + octave_idx_type len = fcn_files.length (); + + for (octave_idx_type k = 0; k < len; k++) + { + std::string fname = fcn_files[k]; + + std::string ext; + std::string base = fname; + + size_t pos = fname.rfind ('.'); + + if (pos != std::string::npos) + { + base = fname.substr (0, pos); + ext = fname.substr (pos); + } + + file_info_list_type& file_info_list = fcn_map[base]; + + for (file_info_list_iterator p = file_info_list.begin (); + p != file_info_list.end (); + p++) + { + if (p->dir_name == dir) + { + file_info_list.erase (p); + + if (file_info_list.empty ()) + fcn_map.erase (fname); + + break; + } + } + } +} + +void +load_path::remove_private_fcn_map (const std::string& dir) +{ + private_fcn_map_iterator p = private_fcn_map.find (dir); + + if (p != private_fcn_map.end ()) + private_fcn_map.erase (p); +} + +void +load_path::remove_method_map (const std::string& dir) +{ + for (method_map_iterator i = method_map.begin (); + i != method_map.end (); + i++) + { + std::string class_name = i->first; + + fcn_map_type& fm = i->second; + + std::string full_dir_name = file_ops::concat (dir, "@" + class_name); + + for (fcn_map_iterator q = fm.begin (); q != fm.end (); q++) + { + file_info_list_type& file_info_list = q->second; + + if (file_info_list.size () == 1) + continue; + else + { + for (file_info_list_iterator p = file_info_list.begin (); + p != file_info_list.end (); + p++) + { + if (p->dir_name == full_dir_name) + { + file_info_list.erase (p); + + // FIXME -- if there are no other elements, we + // should remove this element of fm but calling + // erase here would invalidate the iterator q. + + break; + } + } + } + } + } +} + +bool +load_path::do_remove (const std::string& dir_arg) +{ + bool retval = false; + + if (! dir_arg.empty ()) + { + if (dir_arg == ".") + { + warning ("rmpath: can't remove \".\" from path"); + + // Avoid additional warnings. + retval = true; + } + else + { + std::string dir = file_ops::tilde_expand (dir_arg); + + dir = strip_trailing_separators (dir); + + dir_info_list_iterator i = find_dir_info (dir); + + if (i != dir_info_list.end ()) + { + retval = true; + + if (remove_hook) + remove_hook (dir); + + string_vector fcn_files = i->fcn_files; + + dir_info_list.erase (i); + + remove_fcn_map (dir, fcn_files); + + remove_private_fcn_map (dir); + + remove_method_map (dir); + } + } + } + + return retval; +} + +void +load_path::do_update (void) const +{ + // I don't see a better way to do this because we need to + // preserve the correct directory ordering for new files that + // have appeared. + + fcn_map.clear (); + + private_fcn_map.clear (); + + method_map.clear (); + + for (dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + dir_info& di = *p; + + di.update (); + + add_to_fcn_map (di, true); + + add_to_private_fcn_map (di); + + add_to_method_map (di, true); + } +} + +bool +load_path::check_file_type (std::string& fname, int type, int possible_types, + const std::string& fcn, const char *who) +{ + bool retval = false; + + if (type == load_path::OCT_FILE) + { + if ((type & possible_types) == load_path::OCT_FILE) + { + fname += ".oct"; + retval = true; + } + } + else if (type == load_path::M_FILE) + { + if ((type & possible_types) == load_path::M_FILE) + { + fname += ".m"; + retval = true; + } + } + else if (type == load_path::MEX_FILE) + { + if ((type & possible_types) == load_path::MEX_FILE) + { + fname += ".mex"; + retval = true; + } + } + else if (type == (load_path::M_FILE | load_path::OCT_FILE)) + { + if (possible_types & load_path::OCT_FILE) + { + fname += ".oct"; + retval = true; + } + else if (possible_types & load_path::M_FILE) + { + fname += ".m"; + retval = true; + } + } + else if (type == (load_path::M_FILE | load_path::MEX_FILE)) + { + if (possible_types & load_path::MEX_FILE) + { + fname += ".mex"; + retval = true; + } + else if (possible_types & load_path::M_FILE) + { + fname += ".m"; + retval = true; + } + } + else if (type == (load_path::OCT_FILE | load_path::MEX_FILE)) + { + if (possible_types & load_path::OCT_FILE) + { + fname += ".oct"; + retval = true; + } + else if (possible_types & load_path::MEX_FILE) + { + fname += ".mex"; + retval = true; + } + } + else if (type == (load_path::M_FILE | load_path::OCT_FILE + | load_path::MEX_FILE)) + { + if (possible_types & load_path::OCT_FILE) + { + fname += ".oct"; + retval = true; + } + else if (possible_types & load_path::MEX_FILE) + { + fname += ".mex"; + retval = true; + } + else if (possible_types & load_path::M_FILE) + { + fname += ".m"; + retval = true; + } + } + else + error ("%s: %s: invalid type code = %d", who, fcn.c_str (), type); + + return retval; +} + +std::string +load_path::do_find_fcn (const std::string& fcn, std::string& dir_name, + int type) const +{ + std::string retval; + + // update (); + + if (fcn.length () > 0 && fcn[0] == '@') + { + size_t pos = fcn.find ('/'); + + if (pos != std::string::npos) + { + std::string class_name = fcn.substr (1, pos-1); + std::string meth = fcn.substr (pos+1); + + retval = do_find_method (class_name, meth, dir_name); + } + else + retval = std::string (); + } + else + { + dir_name = std::string (); + + const_fcn_map_iterator p = fcn_map.find (fcn); + + if (p != fcn_map.end ()) + { + const file_info_list_type& file_info_list = p->second; + + for (const_file_info_list_iterator i = file_info_list.begin (); + i != file_info_list.end (); + i++) + { + const file_info& fi = *i; + + retval = file_ops::concat (fi.dir_name, fcn); + + if (check_file_type (retval, type, fi.types, + fcn, "load_path::do_find_fcn")) + { + dir_name = fi.dir_name; + break; + } + else + retval = std::string (); + } + } + } + + return retval; +} + +std::string +load_path::do_find_private_fcn (const std::string& dir, + const std::string& fcn, int type) const +{ + std::string retval; + + // update (); + + const_private_fcn_map_iterator q = private_fcn_map.find (dir); + + if (q != private_fcn_map.end ()) + { + const dir_info::fcn_file_map_type& m = q->second; + + dir_info::const_fcn_file_map_iterator p = m.find (fcn); + + if (p != m.end ()) + { + std::string fname + = file_ops::concat (file_ops::concat (dir, "private"), fcn); + + if (check_file_type (fname, type, p->second, fcn, + "load_path::find_private_fcn")) + retval = fname; + } + } + + return retval; +} + +std::string +load_path::do_find_method (const std::string& class_name, + const std::string& meth, + std::string& dir_name, int type) const +{ + std::string retval; + + // update (); + + dir_name = std::string (); + + const_method_map_iterator q = method_map.find (class_name); + + if (q != method_map.end ()) + { + const fcn_map_type& m = q->second; + + const_fcn_map_iterator p = m.find (meth); + + if (p != m.end ()) + { + const file_info_list_type& file_info_list = p->second; + + for (const_file_info_list_iterator i = file_info_list.begin (); + i != file_info_list.end (); + i++) + { + const file_info& fi = *i; + + retval = file_ops::concat (fi.dir_name, meth); + + bool found = check_file_type (retval, type, fi.types, + meth, "load_path::do_find_method"); + + if (found) + { + dir_name = fi.dir_name; + break; + } + else + retval = std::string (); + } + } + } + + return retval; +} + +std::list +load_path::do_methods (const std::string& class_name) const +{ + std::list retval; + + // update (); + + const_method_map_iterator q = method_map.find (class_name); + + if (q != method_map.end ()) + { + const fcn_map_type& m = q->second; + + for (const_fcn_map_iterator p = m.begin (); p != m.end (); p++) + retval.push_back (p->first); + } + + if (! retval.empty ()) + retval.sort (); + + return retval; +} + +std::list +load_path::do_overloads (const std::string& meth) const +{ + std::list retval; + + // update (); + + for (const_method_map_iterator q = method_map.begin (); + q != method_map.end (); q++) + { + const fcn_map_type& m = q->second; + + if (m.find (meth) != m.end ()) + retval.push_back (q->first); + } + + return retval; +} + +std::string +load_path::do_find_file (const std::string& file) const +{ + std::string retval; + + if (file.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos) + { + if (octave_env::absolute_pathname (file) + || octave_env::rooted_relative_pathname (file)) + { + file_stat fs (file); + + if (fs.exists ()) + return file; + } + else + { + for (const_dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + std::string tfile = file_ops::concat (p->dir_name, file); + + file_stat fs (tfile); + + if (fs.exists ()) + return tfile; + } + } + } + else + { + for (const_dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + string_vector all_files = p->all_files; + + octave_idx_type len = all_files.length (); + + for (octave_idx_type i = 0; i < len; i++) + { + if (all_files[i] == file) + return file_ops::concat (p->dir_name, file); + } + } + } + + return retval; +} + +std::string +load_path::do_find_dir (const std::string& dir) const +{ + std::string retval; + + if (dir.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos + && (octave_env::absolute_pathname (dir) + || octave_env::rooted_relative_pathname (dir))) + { + file_stat fs (dir); + + if (fs.exists () && fs.is_dir ()) + return dir; + } + else + { + for (const_dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + std::string dname = octave_env::make_absolute (p->dir_name); + + size_t dname_len = dname.length (); + + if (dname.substr (dname_len - 1) == file_ops::dir_sep_str ()) + { + dname = dname.substr (0, dname_len - 1); + dname_len--; + } + + size_t dir_len = dir.length (); + + if (dname_len >= dir_len + && file_ops::is_dir_sep (dname[dname_len - dir_len - 1]) + && dir.compare (dname.substr (dname_len - dir_len)) == 0) + { + file_stat fs (p->dir_name); + + if (fs.exists () && fs.is_dir ()) + return p->dir_name; + } + } + } + + return retval; +} + +string_vector +load_path::do_find_matching_dirs (const std::string& dir) const +{ + std::list retlist; + + if (dir.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos + && (octave_env::absolute_pathname (dir) + || octave_env::rooted_relative_pathname (dir))) + { + file_stat fs (dir); + + if (fs.exists () && fs.is_dir ()) + retlist.push_back (dir); + } + else + { + for (const_dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + std::string dname = octave_env::make_absolute (p->dir_name); + + size_t dname_len = dname.length (); + + if (dname.substr (dname_len - 1) == file_ops::dir_sep_str ()) + { + dname = dname.substr (0, dname_len - 1); + dname_len--; + } + + size_t dir_len = dir.length (); + + if (dname_len >= dir_len + && file_ops::is_dir_sep (dname[dname_len - dir_len - 1]) + && dir.compare (dname.substr (dname_len - dir_len)) == 0) + { + file_stat fs (p->dir_name); + + if (fs.exists () && fs.is_dir ()) + retlist.push_back (p->dir_name); + } + } + } + + return retlist; +} + +std::string +load_path::do_find_first_of (const string_vector& flist) const +{ + std::string retval; + + std::string dir_name; + std::string file_name; + + octave_idx_type flen = flist.length (); + octave_idx_type rel_flen = 0; + + string_vector rel_flist (flen); + + for (octave_idx_type i = 0; i < flen; i++) + { + std::string file = flist[i]; + + if (file.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos) + { + if (octave_env::absolute_pathname (file) + || octave_env::rooted_relative_pathname (file)) + { + file_stat fs (file); + + if (fs.exists ()) + return file; + } + else + { + for (const_dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + std::string tfile = file_ops::concat (p->dir_name, file); + + file_stat fs (tfile); + + if (fs.exists ()) + return tfile; + } + } + } + else + rel_flist[rel_flen++] = file; + } + + rel_flist.resize (rel_flen); + + for (const_dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + string_vector all_files = p->all_files; + + octave_idx_type len = all_files.length (); + + for (octave_idx_type i = 0; i < len; i++) + { + for (octave_idx_type j = 0; j < rel_flen; j++) + { + if (all_files[i] == rel_flist[j]) + { + dir_name = p->dir_name; + file_name = rel_flist[j]; + + goto done; + } + } + } + } + + done: + + if (! dir_name.empty ()) + retval = file_ops::concat (dir_name, file_name); + + return retval; +} + +string_vector +load_path::do_find_all_first_of (const string_vector& flist) const +{ + std::list retlist; + + std::string dir_name; + std::string file_name; + + octave_idx_type flen = flist.length (); + octave_idx_type rel_flen = 0; + + string_vector rel_flist (flen); + + for (octave_idx_type i = 0; i < flen; i++) + { + std::string file = flist[i]; + + if (file.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos) + { + if (octave_env::absolute_pathname (file) + || octave_env::rooted_relative_pathname (file)) + { + file_stat fs (file); + + if (fs.exists ()) + retlist.push_back (file); + } + else + { + for (const_dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + std::string tfile = file_ops::concat (p->dir_name, file); + + file_stat fs (tfile); + + if (fs.exists ()) + retlist.push_back (tfile); + } + } + } + else + rel_flist[rel_flen++] = file; + } + + rel_flist.resize (rel_flen); + + for (const_dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + string_vector all_files = p->all_files; + + octave_idx_type len = all_files.length (); + + for (octave_idx_type i = 0; i < len; i++) + { + for (octave_idx_type j = 0; j < rel_flen; j++) + { + if (all_files[i] == rel_flist[j]) + retlist.push_back + (file_ops::concat (p->dir_name, rel_flist[j])); + } + } + } + + return retlist; +} + +string_vector +load_path::do_dirs (void) const +{ + size_t len = dir_info_list.size (); + + string_vector retval (len); + + octave_idx_type k = 0; + + for (const_dir_info_list_iterator i = dir_info_list.begin (); + i != dir_info_list.end (); + i++) + retval[k++] = i->dir_name; + + return retval; +} + +std::list +load_path::do_dir_list (void) const +{ + std::list retval; + + for (const_dir_info_list_iterator i = dir_info_list.begin (); + i != dir_info_list.end (); + i++) + retval.push_back (i->dir_name); + + return retval; +} + +string_vector +load_path::do_files (const std::string& dir, bool omit_exts) const +{ + string_vector retval; + + const_dir_info_list_iterator p = find_dir_info (dir); + + if (p != dir_info_list.end ()) + retval = p->fcn_files; + + if (omit_exts) + { + octave_idx_type len = retval.length (); + + for (octave_idx_type i = 0; i < len; i++) + { + std::string fname = retval[i]; + + size_t pos = fname.rfind ('.'); + + if (pos != std::string::npos) + retval[i] = fname.substr (0, pos); + } + } + + return retval; +} + +string_vector +load_path::do_fcn_names (void) const +{ + size_t len = fcn_map.size (); + + string_vector retval (len); + + octave_idx_type count = 0; + + for (const_fcn_map_iterator p = fcn_map.begin (); + p != fcn_map.end (); + p++) + retval[count++] = p->first; + + return retval; +} + +std::string +load_path::do_path (void) const +{ + std::string xpath; + + string_vector xdirs = load_path::dirs (); + + octave_idx_type len = xdirs.length (); + + if (len > 0) + xpath = xdirs[0]; + + for (octave_idx_type i = 1; i < len; i++) + xpath += dir_path::path_sep_str () + xdirs[i]; + + return xpath; +} + +void +print_types (std::ostream& os, int types) +{ + bool printed_type = false; + + if (types & load_path::OCT_FILE) + { + os << "oct"; + printed_type = true; + } + + if (types & load_path::MEX_FILE) + { + if (printed_type) + os << "|"; + os << "mex"; + printed_type = true; + } + + if (types & load_path::M_FILE) + { + if (printed_type) + os << "|"; + os << "m"; + printed_type = true; + } +} + +void +print_fcn_list (std::ostream& os, + const load_path::dir_info::fcn_file_map_type& lst) +{ + for (load_path::dir_info::const_fcn_file_map_iterator p = lst.begin (); + p != lst.end (); + p++) + { + os << " " << p->first << " ("; + + print_types (os, p->second); + + os << ")\n"; + } +} + +string_vector +get_file_list (const load_path::dir_info::fcn_file_map_type& lst) +{ + octave_idx_type n = lst.size (); + + string_vector retval (n); + + octave_idx_type count = 0; + + for (load_path::dir_info::const_fcn_file_map_iterator p = lst.begin (); + p != lst.end (); + p++) + { + std::string nm = p->first; + + int types = p->second; + + if (types & load_path::OCT_FILE) + nm += ".oct"; + else if (types & load_path::MEX_FILE) + nm += ".mex"; + else + nm += ".m"; + + retval[count++] = nm; + } + + return retval; +} + +void +load_path::do_display (std::ostream& os) const +{ + for (const_dir_info_list_iterator i = dir_info_list.begin (); + i != dir_info_list.end (); + i++) + { + string_vector fcn_files = i->fcn_files; + + if (! fcn_files.empty ()) + { + os << "\n*** function files in " << i->dir_name << ":\n\n"; + + fcn_files.list_in_columns (os); + } + + const dir_info::method_file_map_type& method_file_map + = i->method_file_map; + + if (! method_file_map.empty ()) + { + for (dir_info::const_method_file_map_iterator p = method_file_map.begin (); + p != method_file_map.end (); + p++) + { + os << "\n*** methods in " << i->dir_name + << "/@" << p->first << ":\n\n"; + + const dir_info::class_info& ci = p->second; + + string_vector method_files = get_file_list (ci.method_file_map); + + method_files.list_in_columns (os); + } + } + } + + for (const_private_fcn_map_iterator i = private_fcn_map.begin (); + i != private_fcn_map.end (); i++) + { + os << "\n*** private functions in " + << file_ops::concat (i->first, "private") << ":\n\n"; + + print_fcn_list (os, i->second); + } + +#if defined (DEBUG_LOAD_PATH) + + for (const_fcn_map_iterator i = fcn_map.begin (); + i != fcn_map.end (); + i++) + { + os << i->first << ":\n"; + + const file_info_list_type& file_info_list = i->second; + + for (const_file_info_list_iterator p = file_info_list.begin (); + p != file_info_list.end (); + p++) + { + os << " " << p->dir_name << " ("; + + print_types (os, p->types); + + os << ")\n"; + } + } + + for (const_method_map_iterator i = method_map.begin (); + i != method_map.end (); + i++) + { + os << "CLASS " << i->first << ":\n"; + + const fcn_map_type& fm = i->second; + + for (const_fcn_map_iterator q = fm.begin (); + q != fm.end (); + q++) + { + os << " " << q->first << ":\n"; + + const file_info_list_type& file_info_list = q->second; + + for (const_file_info_list_iterator p = file_info_list.begin (); + p != file_info_list.end (); + p++) + { + os << " " << p->dir_name << " ("; + + print_types (os, p->types); + + os << ")\n"; + } + } + } + + os << "\n"; + +#endif +} + +// True if a path is contained in a path list separated by path_sep_char +static bool +in_path_list (const std::string& path_list, const std::string& path) +{ + size_t ps = path.size (), pls = path_list.size (), pos = path_list.find (path); + char psc = dir_path::path_sep_char (); + while (pos != std::string::npos) + { + if ((pos == 0 || path_list[pos-1] == psc) + && (pos + ps == pls || path_list[pos + ps] == psc)) + return true; + else + pos = path_list.find (path, pos + 1); + } + + return false; +} + +void +load_path::add_to_fcn_map (const dir_info& di, bool at_end) const +{ + std::string dir_name = di.dir_name; + + string_vector fcn_files = di.fcn_files; + + octave_idx_type len = fcn_files.length (); + + for (octave_idx_type i = 0; i < len; i++) + { + std::string fname = fcn_files[i]; + + std::string ext; + std::string base = fname; + + size_t pos = fname.rfind ('.'); + + if (pos != std::string::npos) + { + base = fname.substr (0, pos); + ext = fname.substr (pos); + } + + file_info_list_type& file_info_list = fcn_map[base]; + + file_info_list_iterator p = file_info_list.begin (); + + while (p != file_info_list.end ()) + { + if (p->dir_name == dir_name) + break; + + p++; + } + + int t = 0; + if (ext == ".m") + t = load_path::M_FILE; + else if (ext == ".oct") + t = load_path::OCT_FILE; + else if (ext == ".mex") + t = load_path::MEX_FILE; + + if (p == file_info_list.end ()) + { + file_info fi (dir_name, t); + + if (at_end) + file_info_list.push_back (fi); + else + { + // Warn if a built-in or library function is being shadowed. + + if (! file_info_list.empty ()) + { + file_info& old = file_info_list.front (); + + // FIXME -- do we need to be more careful about the + // way we look for old.dir_name in sys_path to avoid + // partial matches? + + // Don't warn about Contents.m files since we expect + // more than one to exist in the load path. + + if (fname != "Contents.m" + && sys_path.find (old.dir_name) != std::string::npos + && in_path_list (sys_path, old.dir_name)) + { + std::string fcn_path = file_ops::concat (dir_name, fname); + + warning_with_id ("Octave:shadowed-function", + "function %s shadows a core library function", + fcn_path.c_str ()); + } + } + else if (symbol_table::is_built_in_function_name (base)) + { + std::string fcn_path = file_ops::concat (dir_name, fname); + warning_with_id ("Octave:shadowed-function", + "function %s shadows a built-in function", + fcn_path.c_str ()); + } + + file_info_list.push_front (fi); + } + } + else + { + file_info& fi = *p; + + fi.types |= t; + } + } +} + +void +load_path::add_to_private_fcn_map (const dir_info& di) const +{ + dir_info::fcn_file_map_type private_file_map = di.private_file_map; + + if (! private_file_map.empty ()) + private_fcn_map[di.dir_name] = private_file_map; +} + +void +load_path::add_to_method_map (const dir_info& di, bool at_end) const +{ + std::string dir_name = di.dir_name; + + // + dir_info::method_file_map_type method_file_map = di.method_file_map; + + for (dir_info::const_method_file_map_iterator q = method_file_map.begin (); + q != method_file_map.end (); + q++) + { + std::string class_name = q->first; + + fcn_map_type& fm = method_map[class_name]; + + std::string full_dir_name + = file_ops::concat (dir_name, "@" + class_name); + + const dir_info::class_info& ci = q->second; + + // + const dir_info::fcn_file_map_type& m = ci.method_file_map; + + for (dir_info::const_fcn_file_map_iterator p = m.begin (); + p != m.end (); + p++) + { + std::string base = p->first; + + int types = p->second; + + file_info_list_type& file_info_list = fm[base]; + + file_info_list_iterator p2 = file_info_list.begin (); + + while (p2 != file_info_list.end ()) + { + if (p2->dir_name == full_dir_name) + break; + + p2++; + } + + if (p2 == file_info_list.end ()) + { + file_info fi (full_dir_name, types); + + if (at_end) + file_info_list.push_back (fi); + else + file_info_list.push_front (fi); + } + else + { + // FIXME -- is this possible? + + file_info& fi = *p2; + + fi.types = types; + } + } + + // + dir_info::fcn_file_map_type private_file_map = ci.private_file_map; + + if (! private_file_map.empty ()) + private_fcn_map[full_dir_name] = private_file_map; + } +} + +std::string +genpath (const std::string& dirname, const string_vector& skip) +{ + std::string retval; + + dir_entry dir (dirname); + + if (dir) + { + retval = dirname; + + string_vector dirlist = dir.read (); + + octave_idx_type len = dirlist.length (); + + for (octave_idx_type i = 0; i < len; i++) + { + std::string elt = dirlist[i]; + + bool skip_p = (elt == "." || elt == ".." || elt[0] == '@'); + + if (! skip_p) + { + for (octave_idx_type j = 0; j < skip.length (); j++) + { + skip_p = (elt == skip[j]); + if (skip_p) + break; + } + + if (! skip_p) + { + std::string nm = file_ops::concat (dirname, elt); + + file_stat fs (nm); + + if (fs && fs.is_dir ()) + retval += dir_path::path_sep_str () + genpath (nm, skip); + } + } + } + } + + return retval; +} + +static void +execute_pkg_add_or_del (const std::string& dir, + const std::string& script_file) +{ + if (! octave_interpreter_ready) + return; + + unwind_protect frame; + + std::string file = file_ops::concat (dir, script_file); + + file_stat fs (file); + + if (fs.exists ()) + source_file (file, "base"); +} + +void +execute_pkg_add (const std::string& dir) +{ + execute_pkg_add_or_del (dir, "PKG_ADD"); +} + +void +execute_pkg_del (const std::string& dir) +{ + execute_pkg_add_or_del (dir, "PKG_DEL"); +} + +DEFUN (genpath, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} genpath (@var{dir})\n\ +@deftypefnx {Built-in Function} {} genpath (@var{dir}, @var{skip}, @dots{})\n\ +Return a path constructed from @var{dir} and all its subdirectories.\n\ +If additional string parameters are given, the resulting path will\n\ +exclude directories with those names.\n\ +@end deftypefn") +{ + octave_value retval; + + octave_idx_type nargin = args.length (); + + if (nargin == 1) + { + std::string dirname = args(0).string_value (); + + if (! error_state) + retval = genpath (dirname); + else + error ("genpath: DIR must be a character string"); + } + else if (nargin > 1) + { + std::string dirname = args(0).string_value (); + + string_vector skip (nargin - 1); + + for (octave_idx_type i = 1; i < nargin; i++) + { + skip[i-1] = args(i).string_value (); + + if (error_state) + break; + } + + if (! error_state) + retval = genpath (dirname, skip); + else + error ("genpath: all arguments must be character strings"); + } + else + print_usage (); + + return retval; +} + +static void +rehash_internal (void) +{ + load_path::update (); + + // FIXME -- maybe we should rename this variable since it is being + // used for more than keeping track of the prompt time. + + // This will force updated functions to be found. + Vlast_prompt_time.stamp (); +} + +DEFUN (rehash, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} rehash ()\n\ +Reinitialize Octave's load path directory cache.\n\ +@end deftypefn") +{ + octave_value_list retval; + + rehash_internal (); + + return retval; +} + +DEFUN (command_line_path, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} command_line_path (@dots{})\n\ +Return the command line path variable.\n\ +\n\ +@seealso{path, addpath, rmpath, genpath, pathdef, savepath, pathsep}\n\ +@end deftypefn") +{ + return octave_value (load_path::get_command_line_path ()); +} + +DEFUN (restoredefaultpath, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} restoredefaultpath (@dots{})\n\ +Restore Octave's path to its initial state at startup.\n\ +\n\ +@seealso{path, addpath, rmpath, genpath, pathdef, savepath, pathsep}\n\ +@end deftypefn") +{ + load_path::initialize (true); + + return octave_value (load_path::system_path ()); +} + +// Return Octave's original default list of directories in which to +// search for function files. This corresponds to the path that +// exists prior to running the system's octaverc file or the user's +// ~/.octaverc file + +DEFUN (__pathorig__, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} __pathorig__ ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + return octave_value (load_path::system_path ()); +} + +DEFUN (path, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} path (@dots{})\n\ +Modify or display Octave's load path.\n\ +\n\ +If @var{nargin} and @var{nargout} are zero, display the elements of\n\ +Octave's load path in an easy to read format.\n\ +\n\ +If @var{nargin} is zero and nargout is greater than zero, return the\n\ +current load path.\n\ +\n\ +If @var{nargin} is greater than zero, concatenate the arguments,\n\ +separating them with @code{pathsep}. Set the internal search path\n\ +to the result and return it.\n\ +\n\ +No checks are made for duplicate elements.\n\ +@seealso{addpath, rmpath, genpath, pathdef, savepath, pathsep}\n\ +@end deftypefn") +{ + octave_value retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("path"); + + if (! error_state) + { + if (argc > 1) + { + std::string path = argv[1]; + + for (int i = 2; i < argc; i++) + path += dir_path::path_sep_str () + argv[i]; + + load_path::set (path, true); + + rehash_internal (); + } + + if (nargout > 0) + retval = load_path::path (); + else if (argc == 1 && nargout == 0) + { + octave_stdout << "\nOctave's search path contains the following directories:\n\n"; + + string_vector dirs = load_path::dirs (); + + dirs.list_in_columns (octave_stdout); + + octave_stdout << "\n"; + } + } + + return retval; +} + +DEFUN (addpath, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} addpath (@var{dir1}, @dots{})\n\ +@deftypefnx {Built-in Function} {} addpath (@var{dir1}, @dots{}, @var{option})\n\ +Add named directories to the function search path. If\n\ +@var{option} is \"-begin\" or 0 (the default), prepend the\n\ +directory name to the current path. If @var{option} is \"-end\"\n\ +or 1, append the directory name to the current path.\n\ +Directories added to the path must exist.\n\ +\n\ +In addition to accepting individual directory arguments, lists of\n\ +directory names separated by @code{pathsep} are also accepted. For example:\n\ +\n\ +@example\n\ +addpath (\"dir1:/dir2:~/dir3\")\n\ +@end example\n\ +@seealso{path, rmpath, genpath, pathdef, savepath, pathsep}\n\ +@end deftypefn") +{ + octave_value retval; + + // Originally written by Bill Denney and Etienne Grossman. Heavily + // modified and translated to C++ by jwe. + + if (nargout > 0) + retval = load_path::path (); + + int nargin = args.length (); + + if (nargin > 0) + { + bool append = false; + + octave_value option_arg = args(nargin-1); + + if (option_arg.is_string ()) + { + std::string option = option_arg.string_value (); + + if (option == "-end") + { + append = true; + nargin--; + } + else if (option == "-begin") + nargin--; + } + else if (option_arg.is_numeric_type ()) + { + int val = option_arg.int_value (); + + if (! error_state) + { + if (val == 0) + nargin--; + else if (val == 1) + { + append = true; + nargin--; + } + else + { + error ("addpath: expecting final argument to be 1 or 0"); + return retval; + } + } + else + { + error ("addpath: expecting final argument to be 1 or 0"); + return retval; + } + } + + bool need_to_update = false; + + for (int i = 0; i < nargin; i++) + { + std::string arg = args(i).string_value (); + + if (! error_state) + { + std::list dir_elts = split_path (arg); + + if (! append) + std::reverse (dir_elts.begin (), dir_elts.end ()); + + for (std::list::const_iterator p = dir_elts.begin (); + p != dir_elts.end (); + p++) + { + std::string dir = *p; + + //dir = regexprep (dir_elts{j}, '//+', "/"); + //dir = regexprep (dir, '/$', ""); + + if (append) + load_path::append (dir, true); + else + load_path::prepend (dir, true); + + need_to_update = true; + } + } + else + error ("addpath: all arguments must be character strings"); + } + + if (need_to_update) + rehash_internal (); + } + else + print_usage (); + + return retval; +} + +DEFUN (rmpath, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} rmpath (@var{dir1}, @dots{})\n\ +Remove @var{dir1}, @dots{} from the current function search path.\n\ +\n\ +In addition to accepting individual directory arguments, lists of\n\ +directory names separated by @code{pathsep} are also accepted. For example:\n\ +\n\ +@example\n\ +rmpath (\"dir1:/dir2:~/dir3\")\n\ +@end example\n\ +@seealso{path, addpath, genpath, pathdef, savepath, pathsep}\n\ +@end deftypefn") +{ + // Originally by Etienne Grossmann. Heavily modified and translated + // to C++ by jwe. + + octave_value retval; + + if (nargout > 0) + retval = load_path::path (); + + int nargin = args.length (); + + if (nargin > 0) + { + bool need_to_update = false; + + for (int i = 0; i < nargin; i++) + { + std::string arg = args(i).string_value (); + + if (! error_state) + { + std::list dir_elts = split_path (arg); + + for (std::list::const_iterator p = dir_elts.begin (); + p != dir_elts.end (); + p++) + { + std::string dir = *p; + + //dir = regexprep (dir_elts{j}, '//+', "/"); + //dir = regexprep (dir, '/$', ""); + + if (! load_path::remove (dir)) + warning ("rmpath: %s: not found", dir.c_str ()); + else + need_to_update = true; + } + } + else + error ("addpath: all arguments must be character strings"); + } + + if (need_to_update) + rehash_internal (); + } + else + print_usage (); + + return retval; +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/load-path.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/load-path.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,573 @@ +/* + +Copyright (C) 2006-2012 John W. Eaton +Copyright (C) 2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_load_path_h) +#define octave_load_path_h 1 + +#include +#include +#include +#include + +#include "pathsearch.h" +#include "str-vec.h" + +class +OCTINTERP_API +load_path +{ +protected: + + load_path (void) + : dir_info_list (), fcn_map (), private_fcn_map (), method_map (), + init_dirs () { } + +public: + + typedef void (*hook_fcn_ptr) (const std::string& dir); + + ~load_path (void) { } + + static void initialize (bool set_initial_path = false) + { + if (instance_ok ()) + instance->do_initialize (set_initial_path); + } + + static void clear (void) + { + if (instance_ok ()) + instance->do_clear (); + } + + static void set (const std::string& p, bool warn = false) + { + if (instance_ok ()) + instance->do_set (p, warn); + } + + static void append (const std::string& dir, bool warn = false) + { + if (instance_ok ()) + instance->do_append (dir, warn); + } + + static void prepend (const std::string& dir, bool warn = false) + { + if (instance_ok ()) + instance->do_prepend (dir, warn); + } + + static bool remove (const std::string& dir) + { + return instance_ok () ? instance->do_remove (dir) : false; + } + + static void update (void) + { + if (instance_ok ()) + instance->do_update (); + } + + static bool contains_canonical (const std::string& dir_name) + { + return instance_ok () ? instance->do_contains_canonical (dir_name) : false; + } + + static std::string find_method (const std::string& class_name, + const std::string& meth, + std::string& dir_name) + { + return instance_ok () + ? instance->do_find_method (class_name, meth, dir_name) : std::string (); + } + + static std::string find_method (const std::string& class_name, + const std::string& meth) + { + std::string dir_name; + return find_method (class_name, meth, dir_name); + } + + static std::list methods (const std::string& class_name) + { + return instance_ok () + ? instance->do_methods (class_name) : std::list (); + } + + static std::list overloads (const std::string& meth) + { + return instance_ok () + ? instance->do_overloads (meth) : std::list (); + } + + static std::string find_fcn (const std::string& fcn, std::string& dir_name) + { + return instance_ok () + ? instance->do_find_fcn (fcn, dir_name) : std::string (); + } + + static std::string find_fcn (const std::string& fcn) + { + std::string dir_name; + return find_fcn (fcn, dir_name); + } + + static std::string find_private_fcn (const std::string& dir, + const std::string& fcn) + { + return instance_ok () + ? instance->do_find_private_fcn (dir, fcn) : std::string (); + } + + static std::string find_fcn_file (const std::string& fcn) + { + std::string dir_name; + + return instance_ok () ? + instance->do_find_fcn (fcn, dir_name, M_FILE) : std::string (); + } + + static std::string find_oct_file (const std::string& fcn) + { + std::string dir_name; + + return instance_ok () ? + instance->do_find_fcn (fcn, dir_name, OCT_FILE) : std::string (); + } + + static std::string find_mex_file (const std::string& fcn) + { + std::string dir_name; + + return instance_ok () ? + instance->do_find_fcn (fcn, dir_name, MEX_FILE) : std::string (); + } + + static std::string find_file (const std::string& file) + { + return instance_ok () + ? instance->do_find_file (file) : std::string (); + } + + static std::string find_dir (const std::string& dir) + { + return instance_ok () + ? instance->do_find_dir (dir) : std::string (); + } + + static string_vector find_matching_dirs (const std::string& dir) + { + return instance_ok () + ? instance->do_find_matching_dirs (dir) : string_vector (); + } + + static std::string find_first_of (const string_vector& files) + { + return instance_ok () ? + instance->do_find_first_of (files) : std::string (); + } + + static string_vector find_all_first_of (const string_vector& files) + { + return instance_ok () ? + instance->do_find_all_first_of (files) : string_vector (); + } + + static string_vector dirs (void) + { + return instance_ok () ? instance->do_dirs () : string_vector (); + } + + static std::list dir_list (void) + { + return instance_ok () + ? instance->do_dir_list () : std::list (); + } + + static string_vector files (const std::string& dir, bool omit_exts = false) + { + return instance_ok () + ? instance->do_files (dir, omit_exts) : string_vector (); + } + + static string_vector fcn_names (void) + { + return instance_ok () ? instance->do_fcn_names () : string_vector (); + } + + static std::string path (void) + { + return instance_ok () ? instance->do_path () : std::string (); + } + + static void display (std::ostream& os) + { + if (instance_ok ()) + instance->do_display (os); + } + + static void set_add_hook (hook_fcn_ptr f) { add_hook = f; } + + static void set_remove_hook (hook_fcn_ptr f) { remove_hook = f; } + + static void set_command_line_path (const std::string& p) + { + if (command_line_path.empty ()) + command_line_path = p; + else + command_line_path += dir_path::path_sep_str () + p; + } + + static std::string get_command_line_path (void) + { + return instance_ok () ? instance->do_get_command_line_path () : std::string (); + } + + static std::string system_path (void) + { + return instance_ok () ? instance->do_system_path () : std::string (); + } + +private: + + static const int M_FILE = 1; + static const int OCT_FILE = 2; + static const int MEX_FILE = 4; + + class dir_info + { + public: + + // + typedef std::map fcn_file_map_type; + + typedef fcn_file_map_type::const_iterator const_fcn_file_map_iterator; + typedef fcn_file_map_type::iterator fcn_file_map_iterator; + + struct class_info + { + class_info (void) : method_file_map (), private_file_map () { } + + class_info (const class_info& ci) + : method_file_map (ci.method_file_map), + private_file_map (ci.private_file_map) { } + + class_info& operator = (const class_info& ci) + { + if (this != &ci) + { + method_file_map = ci.method_file_map; + private_file_map = ci.private_file_map; + } + return *this; + } + + ~class_info (void) { } + + fcn_file_map_type method_file_map; + fcn_file_map_type private_file_map; + }; + + // + typedef std::map method_file_map_type; + + typedef method_file_map_type::const_iterator const_method_file_map_iterator; + typedef method_file_map_type::iterator method_file_map_iterator; + + // This default constructor is only provided so we can create a + // std::map of dir_info objects. You should not use this + // constructor for any other purpose. + dir_info (void) + : dir_name (), abs_dir_name (), is_relative (false), + dir_mtime (), dir_time_last_checked (), + all_files (), fcn_files (), private_file_map (), method_file_map () + { } + + dir_info (const std::string& d) + : dir_name (d), abs_dir_name (), is_relative (false), + dir_mtime (), dir_time_last_checked (), + all_files (), fcn_files (), private_file_map (), method_file_map () + { + initialize (); + } + + dir_info (const dir_info& di) + : dir_name (di.dir_name), abs_dir_name (di.abs_dir_name), + is_relative (di.is_relative), + dir_mtime (di.dir_mtime), + dir_time_last_checked (di.dir_time_last_checked), + all_files (di.all_files), fcn_files (di.fcn_files), + private_file_map (di.private_file_map), + method_file_map (di.method_file_map) { } + + ~dir_info (void) { } + + dir_info& operator = (const dir_info& di) + { + if (&di != this) + { + dir_name = di.dir_name; + abs_dir_name = di.abs_dir_name; + is_relative = di.is_relative; + dir_mtime = di.dir_mtime; + dir_time_last_checked = di.dir_time_last_checked; + all_files = di.all_files; + fcn_files = di.fcn_files; + private_file_map = di.private_file_map; + method_file_map = di.method_file_map; + } + + return *this; + } + + void update (void); + + std::string dir_name; + std::string abs_dir_name; + bool is_relative; + octave_time dir_mtime; + octave_time dir_time_last_checked; + string_vector all_files; + string_vector fcn_files; + fcn_file_map_type private_file_map; + method_file_map_type method_file_map; + + private: + + void initialize (void); + + void get_file_list (const std::string& d); + + void get_private_file_map (const std::string& d); + + void get_method_file_map (const std::string& d, + const std::string& class_name); + + friend fcn_file_map_type get_fcn_files (const std::string& d); + }; + + class file_info + { + public: + + file_info (const std::string& d, int t) : dir_name (d), types (t) { } + + file_info (const file_info& fi) + : dir_name (fi.dir_name), types (fi.types) { } + + ~file_info (void) { } + + file_info& operator = (const file_info& fi) + { + if (&fi != this) + { + dir_name = fi.dir_name; + types = fi.types; + } + + return *this; + } + + std::string dir_name; + int types; + }; + + // We maintain two ways of looking at the same information. + // + // First, a list of directories and the set of "public" files and + // private files (those found in the special "private" subdirectory) + // in each directory. + // + // Second, a map from file names (the union of all "public" files for all + // directories, but without filename extensions) to a list of + // corresponding information (directory name and file types). This + // way, we can quickly find shadowed file names and look up all + // overloaded functions (in the "@" directories used to implement + // classes). + + typedef std::list dir_info_list_type; + + typedef dir_info_list_type::const_iterator const_dir_info_list_iterator; + typedef dir_info_list_type::iterator dir_info_list_iterator; + + typedef std::map abs_dir_cache_type; + + typedef abs_dir_cache_type::const_iterator const_abs_dir_cache_iterator; + typedef abs_dir_cache_type::iterator abs_dir_cache_iterator; + + typedef std::list file_info_list_type; + + typedef file_info_list_type::const_iterator const_file_info_list_iterator; + typedef file_info_list_type::iterator file_info_list_iterator; + + // + typedef std::map fcn_map_type; + + typedef fcn_map_type::const_iterator const_fcn_map_iterator; + typedef fcn_map_type::iterator fcn_map_iterator; + + // > + typedef std::map private_fcn_map_type; + + typedef private_fcn_map_type::const_iterator const_private_fcn_map_iterator; + typedef private_fcn_map_type::iterator private_fcn_map_iterator; + + // > + typedef std::map method_map_type; + + typedef method_map_type::const_iterator const_method_map_iterator; + typedef method_map_type::iterator method_map_iterator; + + mutable dir_info_list_type dir_info_list; + + mutable fcn_map_type fcn_map; + + mutable private_fcn_map_type private_fcn_map; + + mutable method_map_type method_map; + + mutable std::set init_dirs; + + static load_path *instance; + + static void cleanup_instance (void) { delete instance; instance = 0; } + + static hook_fcn_ptr add_hook; + + static hook_fcn_ptr remove_hook; + + static std::string command_line_path; + + static std::string sys_path; + + static abs_dir_cache_type abs_dir_cache; + + static bool instance_ok (void); + + const_dir_info_list_iterator find_dir_info (const std::string& dir) const; + dir_info_list_iterator find_dir_info (const std::string& dir); + + bool contains (const std::string& dir) const; + + bool do_contains_canonical (const std::string& dir) const; + + void move_fcn_map (const std::string& dir, + const string_vector& fcn_files, bool at_end); + + void move_method_map (const std::string& dir, bool at_end); + + void move (std::list::iterator i, bool at_end); + + void do_initialize (bool set_initial_path); + + void do_clear (void); + + void do_set (const std::string& p, bool warn, bool is_init = false); + + void do_append (const std::string& dir, bool warn); + + void do_prepend (const std::string& dir, bool warn); + + void do_add (const std::string& dir, bool at_end, bool warn); + + void remove_fcn_map (const std::string& dir, const string_vector& fcn_files); + + void remove_private_fcn_map (const std::string& dir); + + void remove_method_map (const std::string& dir); + + bool do_remove (const std::string& dir); + + void do_update (void) const; + + static bool + check_file_type (std::string& fname, int type, int possible_types, + const std::string& fcn, const char *who); + + std::string do_find_fcn (const std::string& fcn, + std::string& dir_name, + int type = M_FILE | OCT_FILE | MEX_FILE) const; + + std::string do_find_private_fcn (const std::string& dir, + const std::string& fcn, + int type = M_FILE | OCT_FILE | MEX_FILE) const; + + std::string do_find_method (const std::string& class_name, + const std::string& meth, + std::string& dir_name, + int type = M_FILE | OCT_FILE | MEX_FILE) const; + + std::list do_methods (const std::string& class_name) const; + + std::list do_overloads (const std::string& meth) const; + + std::string do_find_file (const std::string& file) const; + + std::string do_find_dir (const std::string& dir) const; + + string_vector do_find_matching_dirs (const std::string& dir) const; + + std::string do_find_first_of (const string_vector& files) const; + + string_vector do_find_all_first_of (const string_vector& files) const; + + string_vector do_dirs (void) const; + + std::list do_dir_list (void) const; + + string_vector do_files (const std::string& dir, bool omit_exts) const; + + string_vector do_fcn_names (void) const; + + std::string do_path (void) const; + + friend void print_types (std::ostream& os, int types); + + friend string_vector get_file_list (const dir_info::fcn_file_map_type& lst); + + friend void + print_fcn_list (std::ostream& os, const dir_info::fcn_file_map_type& lst); + + void do_display (std::ostream& os) const; + + std::string do_system_path (void) const { return sys_path; } + + std::string do_get_command_line_path (void) const { return command_line_path; } + + void add_to_fcn_map (const dir_info& di, bool at_end) const; + + void add_to_private_fcn_map (const dir_info& di) const; + + void add_to_method_map (const dir_info& di, bool at_end) const; + + friend dir_info::fcn_file_map_type get_fcn_files (const std::string& d); +}; + +extern std::string +genpath (const std::string& dir, const string_vector& skip = "private"); + +extern void execute_pkg_add (const std::string& dir); +extern void execute_pkg_del (const std::string& dir); + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/load-save.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/load-save.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,1882 @@ +/* + +Copyright (C) 1994-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Author: John W. Eaton. +// HDF5 support by Steven G. Johnson +// Matlab v5 support by James R. Van Zandt + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include +#include +#include +#include +#include + +#include "strftime.h" + +#include "byte-swap.h" +#include "data-conv.h" +#include "file-ops.h" +#include "file-stat.h" +#include "glob-match.h" +#include "lo-mappers.h" +#include "mach-info.h" +#include "oct-env.h" +#include "oct-time.h" +#include "quit.h" +#include "str-vec.h" +#include "oct-locbuf.h" + +#include "Cell.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "load-path.h" +#include "load-save.h" +#include "oct-obj.h" +#include "oct-map.h" +#include "ov-cell.h" +#include "pager.h" +#include "pt-exp.h" +#include "symtab.h" +#include "sysdep.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" +#include "version.h" +#include "dMatrix.h" + +#include "ls-hdf5.h" +#include "ls-mat-ascii.h" +#include "ls-mat4.h" +#include "ls-mat5.h" +#include "ls-oct-ascii.h" +#include "ls-oct-binary.h" + +// Remove gnulib definitions, if any. +#ifdef close +#undef close +#endif +#ifdef open +#undef open +#endif + +#ifdef HAVE_ZLIB +#include "zfstream.h" +#endif + +// Write octave-workspace file if Octave crashes or is killed by a signal. +static bool Vcrash_dumps_octave_core = true; + +// The maximum amount of memory (in kilobytes) that we will attempt to +// write to the Octave core file. +static double Voctave_core_file_limit = -1.0; + +// The name of the Octave core file. +static std::string Voctave_core_file_name = "octave-workspace"; + +// The default output format. May be one of "binary", "text", +// "mat-binary", or "hdf5". +static std::string Vsave_default_options = "-text"; + +// The output format for Octave core files. +static std::string Voctave_core_file_options = "-binary"; + +static std::string +default_save_header_format (void) +{ + return + std::string ("# Created by Octave " OCTAVE_VERSION + ", %a %b %d %H:%M:%S %Y %Z <") + + octave_env::get_user_name () + + std::string ("@") + + octave_env::get_host_name () + + std::string (">"); +} + +// The format string for the comment line at the top of text-format +// save files. Passed to strftime. Should begin with '#' and contain +// no newline characters. +static std::string Vsave_header_format_string = default_save_header_format (); + +static void +gripe_file_open (const std::string& fcn, const std::string& file) +{ + if (fcn == "load") + error ("%s: unable to open input file '%s'", fcn.c_str (), file.c_str ()); + else if (fcn == "save") + error ("%s: unable to open output file '%s'", fcn.c_str (), file.c_str ()); + else + error ("%s: unable to open file '%s'", fcn.c_str (), file.c_str ()); +} + +// Install a variable with name NAME and the value VAL in the +// symbol table. If GLOBAL is TRUE, make the variable global. + +static void +install_loaded_variable (const std::string& name, + const octave_value& val, + bool global, const std::string& /*doc*/) +{ + if (global) + { + symbol_table::clear (name); + symbol_table::mark_global (name); + symbol_table::global_assign (name, val); + } + else + symbol_table::assign (name, val); +} + +// Return TRUE if NAME matches one of the given globbing PATTERNS. + +static bool +matches_patterns (const string_vector& patterns, int pat_idx, + int num_pat, const std::string& name) +{ + for (int i = pat_idx; i < num_pat; i++) + { + glob_match pattern (patterns[i]); + + if (pattern.match (name)) + return true; + } + + return false; +} + +int +read_binary_file_header (std::istream& is, bool& swap, + oct_mach_info::float_format& flt_fmt, bool quiet) +{ + const int magic_len = 10; + char magic[magic_len+1]; + is.read (magic, magic_len); + magic[magic_len] = '\0'; + + if (strncmp (magic, "Octave-1-L", magic_len) == 0) + swap = oct_mach_info::words_big_endian (); + else if (strncmp (magic, "Octave-1-B", magic_len) == 0) + swap = ! oct_mach_info::words_big_endian (); + else + { + if (! quiet) + error ("load: unable to read read binary file"); + return -1; + } + + char tmp = 0; + is.read (&tmp, 1); + + flt_fmt = mopt_digit_to_float_format (tmp); + + if (flt_fmt == oct_mach_info::flt_fmt_unknown) + { + if (! quiet) + error ("load: unrecognized binary format!"); + + return -1; + } + + return 0; +} + +#ifdef HAVE_ZLIB +static bool +check_gzip_magic (const std::string& fname) +{ + bool retval = false; + std::ifstream file (fname.c_str ()); + OCTAVE_LOCAL_BUFFER (unsigned char, magic, 2); + + if (file.read (reinterpret_cast (magic), 2) && magic[0] == 0x1f && + magic[1] == 0x8b) + retval = true; + + file.close (); + return retval; +} +#endif + +static load_save_format +get_file_format (std::istream& file, const std::string& filename) +{ + load_save_format retval = LS_UNKNOWN; + + oct_mach_info::float_format flt_fmt = oct_mach_info::flt_fmt_unknown; + + bool swap = false; + + if (read_binary_file_header (file, swap, flt_fmt, true) == 0) + retval = LS_BINARY; + else + { + file.clear (); + file.seekg (0, std::ios::beg); + + int32_t mopt, nr, nc, imag, len; + + int err = read_mat_file_header (file, swap, mopt, nr, nc, imag, len, + true); + + if (! err) + retval = LS_MAT_BINARY; + else + { + file.clear (); + file.seekg (0, std::ios::beg); + + err = read_mat5_binary_file_header (file, swap, true, filename); + + if (! err) + { + file.clear (); + file.seekg (0, std::ios::beg); + retval = LS_MAT5_BINARY; + } + else + { + file.clear (); + file.seekg (0, std::ios::beg); + + std::string tmp = extract_keyword (file, "name"); + + if (! tmp.empty ()) + retval = LS_ASCII; + } + } + } + + return retval; +} + +static load_save_format +get_file_format (const std::string& fname, const std::string& orig_fname, + bool &use_zlib, bool quiet = false) +{ + load_save_format retval = LS_UNKNOWN; + +#ifdef HAVE_HDF5 + // check this before we open the file + if (H5Fis_hdf5 (fname.c_str ()) > 0) + return LS_HDF5; +#endif /* HAVE_HDF5 */ + + std::ifstream file (fname.c_str ()); + use_zlib = false; + + if (file) + { + retval = get_file_format (file, orig_fname); + file.close (); + +#ifdef HAVE_ZLIB + if (retval == LS_UNKNOWN && check_gzip_magic (fname)) + { + gzifstream gzfile (fname.c_str ()); + use_zlib = true; + + if (gzfile) + { + retval = get_file_format (gzfile, orig_fname); + gzfile.close (); + } + } +#endif + + // FIXME -- looks_like_mat_ascii_file does not check to see + // whether the file contains numbers. It just skips comments and + // checks for the same number of words on each line. We may need + // a better check here. The best way to do that might be just + // to try to read the file and see if it works. + + if (retval == LS_UNKNOWN && looks_like_mat_ascii_file (fname)) + retval = LS_MAT_ASCII; + } + else if (! quiet) + gripe_file_open ("load", orig_fname); + + return retval; +} + +octave_value +do_load (std::istream& stream, const std::string& orig_fname, + load_save_format format, oct_mach_info::float_format flt_fmt, + bool list_only, bool swap, bool verbose, + const string_vector& argv, int argv_idx, int argc, int nargout) +{ + octave_value retval; + + octave_scalar_map retstruct; + + std::ostringstream output_buf; + std::list symbol_names; + + octave_idx_type count = 0; + + for (;;) + { + bool global = false; + octave_value tc; + + std::string name; + std::string doc; + + switch (format.type) + { + case LS_ASCII: + name = read_ascii_data (stream, orig_fname, global, tc, count); + break; + + case LS_BINARY: + name = read_binary_data (stream, swap, flt_fmt, orig_fname, + global, tc, doc); + break; + + case LS_MAT_ASCII: + name = read_mat_ascii_data (stream, orig_fname, tc); + break; + + case LS_MAT_BINARY: + name = read_mat_binary_data (stream, orig_fname, tc); + break; + +#ifdef HAVE_HDF5 + case LS_HDF5: + name = read_hdf5_data (stream, orig_fname, global, tc, doc); + break; +#endif /* HAVE_HDF5 */ + + case LS_MAT5_BINARY: + case LS_MAT7_BINARY: + name = read_mat5_binary_element (stream, orig_fname, swap, + global, tc); + break; + + default: + gripe_unrecognized_data_fmt ("load"); + break; + } + + if (error_state || stream.eof () || name.empty ()) + break; + else if (! error_state && ! name.empty ()) + { + if (tc.is_defined ()) + { + if (format == LS_MAT_ASCII && argv_idx < argc) + warning ("load: loaded ASCII file '%s' -- ignoring extra args", + orig_fname.c_str ()); + + if (format == LS_MAT_ASCII + || argv_idx == argc + || matches_patterns (argv, argv_idx, argc, name)) + { + count++; + if (list_only) + { + if (verbose) + { + if (count == 1) + output_buf + << "type rows cols name\n" + << "==== ==== ==== ====\n"; + + output_buf + << std::setiosflags (std::ios::left) + << std::setw (16) << tc.type_name () . c_str () + << std::setiosflags (std::ios::right) + << std::setw (7) << tc.rows () + << std::setw (7) << tc.columns () + << " " << name << "\n"; + } + else + symbol_names.push_back (name); + } + else + { + if (nargout == 1) + { + if (format == LS_MAT_ASCII) + retval = tc; + else + retstruct.assign (name, tc); + } + else + install_loaded_variable (name, tc, global, doc); + } + } + + // Only attempt to read one item from a headless text file. + + if (format == LS_MAT_ASCII) + break; + } + else + error ("load: unable to load variable '%s'", name.c_str ()); + } + else + { + if (count == 0) + error ("load: are you sure '%s' is an Octave data file?", + orig_fname.c_str ()); + + break; + } + } + + if (list_only && count) + { + if (verbose) + { + std::string msg = output_buf.str (); + + if (nargout > 0) + retval = msg; + else + octave_stdout << msg; + } + else + { + if (nargout > 0) + retval = Cell (string_vector (symbol_names)); + else + { + string_vector names (symbol_names); + + names.list_in_columns (octave_stdout); + + octave_stdout << "\n"; + } + } + } + else if (retstruct.nfields () != 0) + retval = retstruct; + + return retval; +} + +std::string +find_file_to_load (const std::string& name, const std::string& orig_name) +{ + std::string fname = name; + + if (! (octave_env::absolute_pathname (fname) + || octave_env::rooted_relative_pathname (fname))) + { + file_stat fs (fname); + + if (! (fs.exists () && fs.is_reg ())) + { + std::string tmp + = octave_env::make_absolute (load_path::find_file (fname)); + + if (! tmp.empty ()) + { + warning_with_id ("Octave:load-file-in-path", + "load: file found in load path"); + fname = tmp; + } + } + } + + size_t dot_pos = fname.rfind ("."); + size_t sep_pos = fname.find_last_of (file_ops::dir_sep_chars ()); + + if (dot_pos == std::string::npos + || (sep_pos != std::string::npos && dot_pos < sep_pos)) + { + // Either no '.' in name or no '.' appears after last directory + // separator. + + file_stat fs (fname); + + if (! (fs.exists () && fs.is_reg ())) + fname = find_file_to_load (fname + ".mat", orig_name); + } + else + { + file_stat fs (fname); + + if (! (fs.exists () && fs.is_reg ())) + { + fname = ""; + + error ("load: unable to find file %s", orig_name.c_str ()); + } + } + + return fname; +} + +bool +is_octave_data_file (const std::string& fname) +{ + bool use_zlib = false; + return get_file_format (fname, fname, use_zlib, true) != LS_UNKNOWN; +} + +DEFUN (load, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Command} {} load file\n\ +@deftypefnx {Command} {} load options file\n\ +@deftypefnx {Command} {} load options file v1 v2 @dots{}\n\ +@deftypefnx {Command} {S =} load (\"options\", \"file\", \"v1\", \"v2\", @dots{})\n\ +@deftypefnx {Command} {} load file options\n\ +@deftypefnx {Command} {} load file options v1 v2 @dots{}\n\ +@deftypefnx {Command} {S =} load (\"file\", \"options\", \"v1\", \"v2\", @dots{})\n\ +Load the named variables @var{v1}, @var{v2}, @dots{}, from the file\n\ +@var{file}. If no variables are specified then all variables found in the\n\ +file will be loaded. As with @code{save}, the list of variables to extract\n\ +can be full names or use a pattern syntax. The format of the file is\n\ +automatically detected but may be overridden by supplying the appropriate\n\ +option.\n\ +\n\ +If load is invoked using the functional form\n\ +\n\ +@example\n\ +load (\"-option1\", @dots{}, \"file\", \"v1\", @dots{})\n\ +@end example\n\ +\n\ +@noindent\n\ +then the @var{options}, @var{file}, and variable name arguments\n\ +(@var{v1}, @dots{}) must be specified as character strings.\n\ +\n\ +If a variable that is not marked as global is loaded from a file when a\n\ +global symbol with the same name already exists, it is loaded in the\n\ +global symbol table. Also, if a variable is marked as global in a file\n\ +and a local symbol exists, the local symbol is moved to the global\n\ +symbol table and given the value from the file.\n\ +\n\ +If invoked with a single output argument, Octave returns data instead\n\ +of inserting variables in the symbol table. If the data file contains\n\ +only numbers (TAB- or space-delimited columns), a matrix of values is\n\ +returned. Otherwise, @code{load} returns a structure with members\n\ + corresponding to the names of the variables in the file.\n\ +\n\ +The @code{load} command can read data stored in Octave's text and\n\ +binary formats, and @sc{matlab}'s binary format. If compiled with zlib\n\ +support, it can also load gzip-compressed files. It will automatically\n\ +detect the type of file and do conversion from different floating point\n\ +formats (currently only IEEE big and little endian, though other formats\n\ +may be added in the future).\n\ +\n\ +Valid options for @code{load} are listed in the following table.\n\ +\n\ +@table @code\n\ +@item -force\n\ +This option is accepted for backward compatibility but is ignored.\n\ +Octave now overwrites variables currently in memory with\n\ +those of the same name found in the file.\n\ +\n\ +@item -ascii\n\ +Force Octave to assume the file contains columns of numbers in text format\n\ +without any header or other information. Data in the file will be loaded\n\ +as a single numeric matrix with the name of the variable derived from the\n\ +name of the file.\n\ +\n\ +@item -binary\n\ +Force Octave to assume the file is in Octave's binary format.\n\ +\n\ +@item -hdf5\n\ +Force Octave to assume the file is in @sc{hdf5} format.\n\ +(@sc{hdf5} is a free, portable binary format developed by the National\n\ +Center for Supercomputing Applications at the University of Illinois.)\n\ +Note that Octave can read @sc{hdf5} files not created by itself, but may\n\ +skip some datasets in formats that it cannot support. This format is\n\ +only available if Octave was built with a link to the @sc{hdf5} libraries.\n\ +\n\ +@item -import\n\ +This option is accepted for backward compatibility but is ignored.\n\ +Octave can now support multi-dimensional HDF data and automatically\n\ +modifies variable names if they are invalid Octave identifiers.\n\ +\n\ +@item -mat\n\ +@itemx -mat-binary\n\ +@itemx -6\n\ +@itemx -v6\n\ +@itemx -7\n\ +@itemx -v7\n\ +Force Octave to assume the file is in @sc{matlab}'s version 6 or 7 binary\n\ +format.\n\ +\n\ +@item -mat4-binary\n\ +@itemx -4\n\ +@itemx -v4\n\ +@itemx -V4\n\ +Force Octave to assume the file is in the binary format written by\n\ +@sc{matlab} version 4.\n\ +\n\ +@item -text\n\ +Force Octave to assume the file is in Octave's text format.\n\ +@end table\n\ +@seealso{save, dlmwrite, csvwrite, fwrite}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("load"); + + if (error_state) + return retval; + + int i = 1; + std::string orig_fname = ""; + + // Function called with Matlab-style ["filename", options] syntax + if (argc > 1 && ! argv[1].empty () && argv[1].at (0) != '-') + { + orig_fname = argv[1]; + i++; + } + + // It isn't necessary to have the default load format stored in a + // user preference variable since we can determine the type of file + // as we are reading. + + load_save_format format = LS_UNKNOWN; + + bool list_only = false; + bool verbose = false; + + //for (i; i < argc; i++) + for (; i < argc; i++) + { + if (argv[i] == "-force" || argv[i] == "-f") + { + // Silently ignore this + // warning ("load: -force ignored"); + } + else if (argv[i] == "-list" || argv[i] == "-l") + { + list_only = true; + } + else if (argv[i] == "-verbose" || argv[i] == "-v") + { + verbose = true; + } + else if (argv[i] == "-ascii" || argv[i] == "-a") + { + format = LS_MAT_ASCII; + } + else if (argv[i] == "-binary" || argv[i] == "-b") + { + format = LS_BINARY; + } + else if (argv[i] == "-mat-binary" || argv[i] == "-mat" || argv[i] == "-m" + || argv[i] == "-6" || argv[i] == "-v6") + { + format = LS_MAT5_BINARY; + } + else if (argv[i] == "-7" || argv[i] == "-v7") + { + format = LS_MAT7_BINARY; + } + else if (argv[i] == "-mat4-binary" || argv[i] == "-V4" + || argv[i] == "-v4" || argv[i] == "-4") + { + format = LS_MAT_BINARY; + } + else if (argv[i] == "-hdf5" || argv[i] == "-h") + { +#ifdef HAVE_HDF5 + format = LS_HDF5; +#else /* ! HAVE_HDF5 */ + error ("load: octave executable was not linked with HDF5 library"); + return retval; +#endif /* ! HAVE_HDF5 */ + } + else if (argv[i] == "-import" || argv[i] == "-i") + { + warning ("load: -import ignored"); + } + else if (argv[i] == "-text" || argv[i] == "-t") + { + format = LS_ASCII; + } + else + break; + } + + if (orig_fname == "") + { + if (i == argc) + { + print_usage (); + return retval; + } + else + orig_fname = argv[i]; + } + else + i--; + + oct_mach_info::float_format flt_fmt = oct_mach_info::flt_fmt_unknown; + + bool swap = false; + + if (orig_fname == "-") + { + i++; + +#ifdef HAVE_HDF5 + if (format == LS_HDF5) + error ("load: cannot read HDF5 format from stdin"); + else +#endif /* HAVE_HDF5 */ + if (format != LS_UNKNOWN) + { + // FIXME -- if we have already seen EOF on a + // previous call, how do we fix up the state of std::cin so + // that we can get additional input? I'm afraid that we + // can't fix this using std::cin only. + + retval = do_load (std::cin, orig_fname, format, flt_fmt, + list_only, swap, verbose, argv, i, argc, + nargout); + } + else + error ("load: must specify file format if reading from stdin"); + } + else + { + std::string fname = file_ops::tilde_expand (orig_fname); + + fname = find_file_to_load (fname, orig_fname); + + if (error_state) + return retval; + + bool use_zlib = false; + + if (format == LS_UNKNOWN) + format = get_file_format (fname, orig_fname, use_zlib); + +#ifdef HAVE_HDF5 + if (format == LS_HDF5) + { + i++; + + hdf5_ifstream hdf5_file (fname.c_str ()); + + if (hdf5_file.file_id >= 0) + { + retval = do_load (hdf5_file, orig_fname, format, + flt_fmt, list_only, swap, verbose, + argv, i, argc, nargout); + + hdf5_file.close (); + } + else + gripe_file_open ("load", orig_fname); + } + else +#endif /* HAVE_HDF5 */ + // don't insert any statements here; the "else" above has to + // go with the "if" below!!!!! + if (format != LS_UNKNOWN) + { + i++; + + // Always open in binary mode and handle various + // line-endings explicitly. + std::ios::openmode mode = std::ios::in | std::ios::binary; + +#ifdef HAVE_ZLIB + if (use_zlib) + { + gzifstream file (fname.c_str (), mode); + + if (file) + { + if (format == LS_BINARY) + { + if (read_binary_file_header (file, swap, flt_fmt) < 0) + { + if (file) file.close (); + return retval; + } + } + else if (format == LS_MAT5_BINARY + || format == LS_MAT7_BINARY) + { + if (read_mat5_binary_file_header (file, swap, false, orig_fname) < 0) + { + if (file) file.close (); + return retval; + } + } + + retval = do_load (file, orig_fname, format, + flt_fmt, list_only, swap, verbose, + argv, i, argc, nargout); + + file.close (); + } + else + gripe_file_open ("load", orig_fname); + } + else +#endif + { + std::ifstream file (fname.c_str (), mode); + + if (file) + { + if (format == LS_BINARY) + { + if (read_binary_file_header (file, swap, flt_fmt) < 0) + { + if (file) file.close (); + return retval; + } + } + else if (format == LS_MAT5_BINARY + || format == LS_MAT7_BINARY) + { + if (read_mat5_binary_file_header (file, swap, false, orig_fname) < 0) + { + if (file) file.close (); + return retval; + } + } + + retval = do_load (file, orig_fname, format, + flt_fmt, list_only, swap, verbose, + argv, i, argc, nargout); + + file.close (); + } + else + error ("load: unable to open input file '%s'", + orig_fname.c_str ()); + } + } + } + + return retval; +} + +// Return TRUE if PATTERN has any special globbing chars in it. + +static bool +glob_pattern_p (const std::string& pattern) +{ + int open = 0; + + int len = pattern.length (); + + for (int i = 0; i < len; i++) + { + char c = pattern[i]; + + switch (c) + { + case '?': + case '*': + return true; + + case '[': // Only accept an open brace if there is a close + open++; // brace to match it. Bracket expressions must be + continue; // complete, according to Posix.2 + + case ']': + if (open) + return true; + continue; + + case '\\': + if (i == len - 1) + return false; + + default: + continue; + } + } + + return false; +} + +static void +do_save (std::ostream& os, const octave_value& tc, + const std::string& name, const std::string& help, + bool global, load_save_format fmt, bool save_as_floats) +{ + switch (fmt.type) + { + case LS_ASCII: + save_ascii_data (os, tc, name, global, 0); + break; + + case LS_BINARY: + save_binary_data (os, tc, name, help, global, save_as_floats); + break; + + case LS_MAT_ASCII: + if (! save_mat_ascii_data (os, tc, fmt.opts & LS_MAT_ASCII_LONG ? 16 : 8, + fmt.opts & LS_MAT_ASCII_TABS)) + warning ("save: unable to save %s in ASCII format", name.c_str ()); + break; + + case LS_MAT_BINARY: + save_mat_binary_data (os, tc, name); + break; + +#ifdef HAVE_HDF5 + case LS_HDF5: + save_hdf5_data (os, tc, name, help, global, save_as_floats); + break; +#endif /* HAVE_HDF5 */ + + case LS_MAT5_BINARY: + save_mat5_binary_element (os, tc, name, global, false, save_as_floats); + break; + + case LS_MAT7_BINARY: + save_mat5_binary_element (os, tc, name, global, true, save_as_floats); + break; + + default: + gripe_unrecognized_data_fmt ("save"); + break; + } +} + +// Save the info from SR on stream OS in the format specified by FMT. + +void +do_save (std::ostream& os, const symbol_table::symbol_record& sr, + load_save_format fmt, bool save_as_floats) +{ + octave_value val = sr.varval (); + + if (val.is_defined ()) + { + std::string name = sr.name (); + std::string help; + bool global = sr.is_global (); + + do_save (os, val, name, help, global, fmt, save_as_floats); + } +} + +// save fields of a scalar structure STR matching PATTERN on stream OS +// in the format specified by FMT. + +static size_t +save_fields (std::ostream& os, const octave_scalar_map& m, + const std::string& pattern, + load_save_format fmt, bool save_as_floats) +{ + glob_match pat (pattern); + + size_t saved = 0; + + for (octave_scalar_map::const_iterator p = m.begin (); p != m.end (); p++) + { + std::string empty_str; + + if (pat.match (m.key (p))) + { + do_save (os, m.contents (p), m.key (p), empty_str, + 0, fmt, save_as_floats); + + saved++; + } + } + + return saved; +} + +// Save variables with names matching PATTERN on stream OS in the +// format specified by FMT. + +static size_t +save_vars (std::ostream& os, const std::string& pattern, + load_save_format fmt, bool save_as_floats) +{ + std::list vars = symbol_table::glob (pattern); + + size_t saved = 0; + + typedef std::list::const_iterator const_vars_iterator; + + for (const_vars_iterator p = vars.begin (); p != vars.end (); p++) + { + do_save (os, *p, fmt, save_as_floats); + + if (error_state) + break; + + saved++; + } + + return saved; +} + +static string_vector +parse_save_options (const string_vector &argv, + load_save_format &format, bool &append, + bool &save_as_floats, bool &use_zlib) +{ + string_vector retval; + int argc = argv.length (); + + bool do_double = false, do_tabs = false; + + for (int i = 0; i < argc; i++) + { + if (argv[i] == "-append") + { + append = true; + } + else if (argv[i] == "-ascii" || argv[i] == "-a") + { + format = LS_MAT_ASCII; + } + else if (argv[i] == "-double") + { + do_double = true; + } + else if (argv[i] == "-tabs") + { + do_tabs = true; + } + else if (argv[i] == "-text" || argv[i] == "-t") + { + format = LS_ASCII; + } + else if (argv[i] == "-binary" || argv[i] == "-b") + { + format = LS_BINARY; + } + else if (argv[i] == "-hdf5" || argv[i] == "-h") + { +#ifdef HAVE_HDF5 + format = LS_HDF5; +#else /* ! HAVE_HDF5 */ + error ("save: octave executable was not linked with HDF5 library"); +#endif /* ! HAVE_HDF5 */ + } + else if (argv[i] == "-mat-binary" || argv[i] == "-mat" + || argv[i] == "-m" || argv[i] == "-6" || argv[i] == "-v6" + || argv[i] == "-V6") + { + format = LS_MAT5_BINARY; + } +#ifdef HAVE_ZLIB + else if (argv[i] == "-mat7-binary" || argv[i] == "-7" + || argv[i] == "-v7" || argv[i] == "-V7") + { + format = LS_MAT7_BINARY; + } +#endif + else if (argv[i] == "-mat4-binary" || argv[i] == "-V4" + || argv[i] == "-v4" || argv[i] == "-4") + { + format = LS_MAT_BINARY; + } + else if (argv[i] == "-float-binary" || argv[i] == "-f") + { + format = LS_BINARY; + save_as_floats = true; + } + else if (argv[i] == "-float-hdf5") + { +#ifdef HAVE_HDF5 + format = LS_HDF5; + save_as_floats = true; +#else /* ! HAVE_HDF5 */ + error ("save: octave executable was not linked with HDF5 library"); +#endif /* ! HAVE_HDF5 */ + } +#ifdef HAVE_ZLIB + else if (argv[i] == "-zip" || argv[i] == "-z") + { + use_zlib = true; + } +#endif + else if (argv[i] == "-struct") + { + retval.append (argv[i]); + } + else if (argv[i][0] == '-') + { + error ("save: Unrecognized option '%s'", argv[i].c_str ()); + } + else + retval.append (argv[i]); + } + + if (do_double) + { + if (format == LS_MAT_ASCII) + format.opts |= LS_MAT_ASCII_LONG; + else + warning ("save: \"-double\" option only has an effect with \"-ascii\""); + } + + if (do_tabs) + { + if (format == LS_MAT_ASCII) + format.opts |= LS_MAT_ASCII_TABS; + else + warning ("save: \"-tabs\" option only has an effect with \"-ascii\""); + } + + return retval; +} + +static string_vector +parse_save_options (const std::string &arg, load_save_format &format, + bool &append, bool &save_as_floats, + bool &use_zlib) +{ + std::istringstream is (arg); + std::string str; + string_vector argv; + + while (! is.eof ()) + { + is >> str; + argv.append (str); + } + + return parse_save_options (argv, format, append, save_as_floats, + use_zlib); +} + +void +write_header (std::ostream& os, load_save_format format) +{ + switch (format.type) + { + case LS_BINARY: + { + os << (oct_mach_info::words_big_endian () + ? "Octave-1-B" : "Octave-1-L"); + + oct_mach_info::float_format flt_fmt = + oct_mach_info::native_float_format (); + + char tmp = static_cast (float_format_to_mopt_digit (flt_fmt)); + + os.write (&tmp, 1); + } + break; + + case LS_MAT5_BINARY: + case LS_MAT7_BINARY: + { + char const * versionmagic; + int16_t number = *(reinterpret_cast("\x00\x01")); + struct tm bdt; + time_t now; + char headertext[128]; + + time (&now); + bdt = *gmtime (&now); + memset (headertext, ' ', 124); + // ISO 8601 format date + nstrftime (headertext, 124, "MATLAB 5.0 MAT-file, written by Octave " + OCTAVE_VERSION ", %Y-%m-%d %T UTC", &bdt, 1, 0); + + // The first pair of bytes give the version of the MAT file + // format. The second pair of bytes form a magic number which + // signals a MAT file. MAT file data are always written in + // native byte order. The order of the bytes in the second + // pair indicates whether the file was written by a big- or + // little-endian machine. However, the version number is + // written in the *opposite* byte order from everything else! + if (number == 1) + versionmagic = "\x01\x00\x4d\x49"; // this machine is big endian + else + versionmagic = "\x00\x01\x49\x4d"; // this machine is little endian + + memcpy (headertext+124, versionmagic, 4); + os.write (headertext, 128); + } + + break; + +#ifdef HAVE_HDF5 + case LS_HDF5: +#endif /* HAVE_HDF5 */ + case LS_ASCII: + { + octave_localtime now; + + std::string comment_string = now.strftime (Vsave_header_format_string); + + if (! comment_string.empty ()) + { +#ifdef HAVE_HDF5 + if (format == LS_HDF5) + { + hdf5_ofstream& hs = dynamic_cast (os); + H5Gset_comment (hs.file_id, "/", comment_string.c_str ()); + } + else +#endif /* HAVE_HDF5 */ + os << comment_string << "\n"; + } + } + break; + + default: + break; + } +} + +static void +save_vars (const string_vector& argv, int argv_idx, int argc, + std::ostream& os, load_save_format fmt, + bool save_as_floats, bool write_header_info) +{ + if (write_header_info) + write_header (os, fmt); + + if (argv_idx == argc) + { + save_vars (os, "*", fmt, save_as_floats); + } + else if (argv[argv_idx] == "-struct") + { + if (++argv_idx >= argc) + { + error ("save: missing struct name"); + return; + } + + std::string struct_name = argv[argv_idx]; + + if (! symbol_table::is_variable (struct_name)) + { + error ("save: no such variable: '%s'", struct_name.c_str ()); + return; + } + + octave_value struct_var = symbol_table::varval (struct_name); + + if (! struct_var.is_map () || struct_var.numel () != 1) + { + error ("save: '%s' is not a scalar structure", + struct_name.c_str ()); + return; + } + octave_scalar_map struct_var_map = struct_var.scalar_map_value (); + + ++argv_idx; + + if (argv_idx < argc) + { + for (int i = argv_idx; i < argc; i++) + { + if (! save_fields (os, struct_var_map, argv[i], fmt, + save_as_floats)) + { + warning ("save: no such field '%s.%s'", + struct_name.c_str (), argv[i].c_str ()); + } + } + } + else + save_fields (os, struct_var_map, "*", fmt, save_as_floats); + } + else + { + for (int i = argv_idx; i < argc; i++) + { + if (! save_vars (os, argv[i], fmt, save_as_floats)) + warning ("save: no such variable '%s'", argv[i].c_str ()); + } + } +} + +static void +dump_octave_core (std::ostream& os, const char *fname, load_save_format fmt, + bool save_as_floats) +{ + write_header (os, fmt); + + std::list vars + = symbol_table::all_variables (symbol_table::top_scope (), 0); + + double save_mem_size = 0; + + typedef std::list::const_iterator const_vars_iterator; + + for (const_vars_iterator p = vars.begin (); p != vars.end (); p++) + { + octave_value val = p->varval (); + + if (val.is_defined ()) + { + std::string name = p->name (); + std::string help; + bool global = p->is_global (); + + double val_size = val.byte_size () / 1024; + + // FIXME -- maybe we should try to throw out the largest first... + + if (Voctave_core_file_limit < 0 + || save_mem_size + val_size < Voctave_core_file_limit) + { + save_mem_size += val_size; + + do_save (os, val, name, help, global, fmt, save_as_floats); + + if (error_state) + break; + } + } + } + + message (0, "save to '%s' complete", fname); +} + +void +dump_octave_core (void) +{ + if (Vcrash_dumps_octave_core) + { + // FIXME -- should choose better file name? + + const char *fname = Voctave_core_file_name.c_str (); + + message (0, "attempting to save variables to '%s'...", fname); + + load_save_format format = LS_BINARY; + + bool save_as_floats = false; + + bool append = false; + + bool use_zlib = false; + + parse_save_options (Voctave_core_file_options, format, append, + save_as_floats, use_zlib); + + std::ios::openmode mode = std::ios::out; + + // Matlab v7 files are always compressed + if (format == LS_MAT7_BINARY) + use_zlib = false; + + if (format == LS_BINARY +#ifdef HAVE_HDF5 + || format == LS_HDF5 +#endif + || format == LS_MAT_BINARY + || format == LS_MAT5_BINARY + || format == LS_MAT7_BINARY) + mode |= std::ios::binary; + + mode |= append ? std::ios::ate : std::ios::trunc; + +#ifdef HAVE_HDF5 + if (format == LS_HDF5) + { + hdf5_ofstream file (fname, mode); + + if (file.file_id >= 0) + { + dump_octave_core (file, fname, format, save_as_floats); + + file.close (); + } + else + warning ("unable to open '%s' for writing...", fname); + } + else +#endif /* HAVE_HDF5 */ + // don't insert any commands here! The open brace below must + // go with the else above! + { +#ifdef HAVE_ZLIB + if (use_zlib) + { + gzofstream file (fname, mode); + + if (file) + { + dump_octave_core (file, fname, format, save_as_floats); + + file.close (); + } + else + warning ("unable to open '%s' for writing...", fname); + } + else +#endif + { + std::ofstream file (fname, mode); + + if (file) + { + dump_octave_core (file, fname, format, save_as_floats); + + file.close (); + } + else + warning ("unable to open '%s' for writing...", fname); + } + } + } +} + +DEFUN (save, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} save file\n\ +@deftypefnx {Command} {} save options file\n\ +@deftypefnx {Command} {} save options file @var{v1} @var{v2} @dots{}\n\ +@deftypefnx {Command} {} save options file -struct @var{STRUCT} @var{f1} @var{f2} @dots{}\n\ +Save the named variables @var{v1}, @var{v2}, @dots{}, in the file\n\ +@var{file}. The special filename @samp{-} may be used to write\n\ +output to the terminal. If no variable names are listed, Octave saves\n\ +all the variables in the current scope. Otherwise, full variable names or\n\ +pattern syntax can be used to specify the variables to save.\n\ +If the @option{-struct} modifier is used, fields @var{f1} @var{f2} @dots{}\n\ +of the scalar structure @var{STRUCT} are saved as if they were variables\n\ +with corresponding names.\n\ +Valid options for the @code{save} command are listed in the following table.\n\ +Options that modify the output format override the format specified by\n\ +@code{save_default_options}.\n\ +\n\ +If save is invoked using the functional form\n\ +\n\ +@example\n\ +save (\"-option1\", @dots{}, \"file\", \"v1\", @dots{})\n\ +@end example\n\ +\n\ +@noindent\n\ +then the @var{options}, @var{file}, and variable name arguments\n\ +(@var{v1}, @dots{}) must be specified as character strings.\n\ +\n\ +@table @code\n\ +@item -append\n\ +Append to the destination instead of overwriting.\n\ +\n\ +@item -ascii\n\ +Save a single matrix in a text file without header or any other information.\n\ +\n\ +@item -binary\n\ +Save the data in Octave's binary data format.\n\ +\n\ +@item -float-binary\n\ +Save the data in Octave's binary data format but only using single\n\ +precision. Only use this format if you know that all the\n\ +values to be saved can be represented in single precision.\n\ +\n\ +@item -hdf5\n\ +Save the data in @sc{hdf5} format.\n\ +(HDF5 is a free, portable binary format developed by the National\n\ +Center for Supercomputing Applications at the University of Illinois.)\n\ +This format is only available if Octave was built with a link to the\n\ +@sc{hdf5} libraries.\n\ +\n\ +@item -float-hdf5\n\ +Save the data in @sc{hdf5} format but only using single precision.\n\ +Only use this format if you know that all the\n\ +values to be saved can be represented in single precision.\n\ +\n\ +@item -V7\n\ +@itemx -v7\n\ +@itemx -7\n\ +@itemx -mat7-binary\n\ +Save the data in @sc{matlab}'s v7 binary data format.\n\ +\n\ +@item -V6\n\ +@itemx -v6\n\ +@itemx -6\n\ +@itemx -mat\n\ +@itemx -mat-binary\n\ +Save the data in @sc{matlab}'s v6 binary data format.\n\ +\n\ +@item -V4\n\ +@itemx -v4\n\ +@itemx -4\n\ +@itemx -mat4-binary\n\ +Save the data in the binary format written by @sc{matlab} version 4.\n\ +\n\ +@item -text\n\ +Save the data in Octave's text data format. (default).\n\ +\n\ +@item -zip\n\ +@itemx -z\n\ +Use the gzip algorithm to compress the file. This works equally on files\n\ +that are compressed with gzip outside of octave, and gzip can equally be\n\ +used to convert the files for backward compatibility.\n\ +This option is only available if Octave was built with a link to the zlib\n\ +libraries.\n\ +@end table\n\ +\n\ +The list of variables to save may use wildcard patterns containing\n\ +the following special characters:\n\ +\n\ +@table @code\n\ +@item ?\n\ +Match any single character.\n\ +\n\ +@item *\n\ +Match zero or more characters.\n\ +\n\ +@item [ @var{list} ]\n\ +Match the list of characters specified by @var{list}. If the first\n\ +character is @code{!} or @code{^}, match all characters except those\n\ +specified by @var{list}. For example, the pattern @code{[a-zA-Z]} will\n\ +match all lower and uppercase alphabetic characters.\n\ +\n\ +Wildcards may also be used in the field name specifications when using\n\ +the @option{-struct} modifier (but not in the struct name itself).\n\ +\n\ +@end table\n\ +\n\ +Except when using the @sc{matlab} binary data file format or the\n\ +@samp{-ascii} format, saving global\n\ +variables also saves the global status of the variable. If the variable\n\ +is restored at a later time using @samp{load}, it will be restored as a\n\ +global variable.\n\ +\n\ +The command\n\ +\n\ +@example\n\ +save -binary data a b*\n\ +@end example\n\ +\n\ +@noindent\n\ +saves the variable @samp{a} and all variables beginning with @samp{b} to\n\ +the file @file{data} in Octave's binary format.\n\ +@seealso{load, save_default_options, save_header_format_string, dlmread, csvread, fread}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length (); + + string_vector argv = args.make_argv (); + + if (error_state) + return retval; + + // Here is where we would get the default save format if it were + // stored in a user preference variable. + + bool save_as_floats = false; + + load_save_format format = LS_ASCII; + + bool append = false; + + bool use_zlib = false; + + // get default options + parse_save_options (Vsave_default_options, format, append, save_as_floats, + use_zlib); + + // override from command line + argv = parse_save_options (argv, format, append, save_as_floats, + use_zlib); + argc = argv.length (); + int i = 0; + + if (error_state) + return retval; + + if (i == argc) + { + print_usage (); + return retval; + } + + if (save_as_floats && format == LS_ASCII) + { + error ("save: cannot specify both -ascii and -float-binary"); + return retval; + } + + if (argv[i] == "-") + { + i++; + +#ifdef HAVE_HDF5 + if (format == LS_HDF5) + error ("save: cannot write HDF5 format to stdout"); + else +#endif /* HAVE_HDF5 */ + // don't insert any commands here! the brace below must go + // with the "else" above! + { + if (append) + warning ("save: ignoring -append option for output to stdout"); + + // FIXME -- should things intended for the screen end up + // in a octave_value (string)? + + save_vars (argv, i, argc, octave_stdout, format, + save_as_floats, true); + } + } + + // Guard against things like 'save a*', which are probably mistakes... + + else if (i == argc - 1 && glob_pattern_p (argv[i])) + { + print_usage (); + return retval; + } + else + { + std::string fname = file_ops::tilde_expand (argv[i]); + + i++; + + // Matlab v7 files are always compressed + if (format == LS_MAT7_BINARY) + use_zlib = false; + + std::ios::openmode mode + = append ? (std::ios::app | std::ios::ate) : std::ios::out; + + if (format == LS_BINARY +#ifdef HAVE_HDF5 + || format == LS_HDF5 +#endif + || format == LS_MAT_BINARY + || format == LS_MAT5_BINARY + || format == LS_MAT7_BINARY) + mode |= std::ios::binary; + +#ifdef HAVE_HDF5 + if (format == LS_HDF5) + { + // FIXME. It should be possible to append to HDF5 files. + if (append) + { + error ("save: appending to HDF5 files is not implemented"); + return retval; + } + + bool write_header_info = ! (append && + H5Fis_hdf5 (fname.c_str ()) > 0); + + hdf5_ofstream hdf5_file (fname.c_str (), mode); + + if (hdf5_file.file_id != -1) + { + save_vars (argv, i, argc, hdf5_file, format, + save_as_floats, write_header_info); + + hdf5_file.close (); + } + else + { + gripe_file_open ("save", fname); + return retval; + } + } + else +#endif /* HAVE_HDF5 */ + // don't insert any statements here! The brace below must go + // with the "else" above! + { +#ifdef HAVE_ZLIB + if (use_zlib) + { + gzofstream file (fname.c_str (), mode); + + if (file) + { + bool write_header_info = ! file.tellp (); + + save_vars (argv, i, argc, file, format, + save_as_floats, write_header_info); + + file.close (); + } + else + { + gripe_file_open ("save", fname); + return retval; + } + } + else +#endif + { + std::ofstream file (fname.c_str (), mode); + + if (file) + { + bool write_header_info = ! file.tellp (); + + save_vars (argv, i, argc, file, format, + save_as_floats, write_header_info); + + file.close (); + } + else + { + gripe_file_open ("save", fname); + return retval; + } + } + } + } + + return retval; +} + +DEFUN (crash_dumps_octave_core, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} crash_dumps_octave_core ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} crash_dumps_octave_core (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} crash_dumps_octave_core (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave tries\n\ +to save all current variables to the file \"octave-workspace\" if it\n\ +crashes or receives a hangup, terminate or similar signal.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{octave_core_file_limit, octave_core_file_name, octave_core_file_options}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (crash_dumps_octave_core); +} + +DEFUN (save_default_options, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} save_default_options ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} save_default_options (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} save_default_options (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the default options\n\ +for the @code{save} command, and defines the default format.\n\ +Typical values include @code{\"-ascii\"}, @code{\"-text -zip\"}.\n\ +The default value is @option{-text}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{save}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (save_default_options); +} + +DEFUN (octave_core_file_limit, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} octave_core_file_limit ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} octave_core_file_limit (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} octave_core_file_limit (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the maximum amount\n\ +of memory (in kilobytes) of the top-level workspace that Octave will\n\ +attempt to save when writing data to the crash dump file (the name of\n\ +the file is specified by @var{octave_core_file_name}). If\n\ +@var{octave_core_file_options} flags specify a binary format,\n\ +then @var{octave_core_file_limit} will be approximately the maximum\n\ +size of the file. If a text file format is used, then the file could\n\ +be much larger than the limit. The default value is -1 (unlimited)\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{crash_dumps_octave_core, octave_core_file_name, octave_core_file_options}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (octave_core_file_limit); +} + +DEFUN (octave_core_file_name, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} octave_core_file_name ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} octave_core_file_name (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} octave_core_file_name (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the name of the file\n\ +used for saving data from the top-level workspace if Octave aborts.\n\ +The default value is @code{\"octave-workspace\"}\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{crash_dumps_octave_core, octave_core_file_name, octave_core_file_options}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (octave_core_file_name); +} + +DEFUN (octave_core_file_options, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} octave_core_file_options ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} octave_core_file_options (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} octave_core_file_options (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the options used for\n\ +saving the workspace data if Octave aborts. The value of\n\ +@code{octave_core_file_options} should follow the same format as the\n\ +options for the @code{save} function. The default value is Octave's binary\n\ +format.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{crash_dumps_octave_core, octave_core_file_name, octave_core_file_limit}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (octave_core_file_options); +} + +DEFUN (save_header_format_string, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} save_header_format_string ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} save_header_format_string (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} save_header_format_string (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the format\n\ +string used for the comment line written at the beginning of\n\ +text-format data files saved by Octave. The format string is\n\ +passed to @code{strftime} and should begin with the character\n\ +@samp{#} and contain no newline characters. If the value of\n\ +@code{save_header_format_string} is the empty string,\n\ +the header comment is omitted from text-format data files. The\n\ +default value is\n\ +@c Set example in small font to prevent overfull line\n\ +\n\ +@smallexample\n\ +\"# Created by Octave VERSION, %a %b %d %H:%M:%S %Y %Z \"\n\ +@end smallexample\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{strftime, save}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (save_header_format_string); +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/load-save.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/load-save.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,95 @@ +/* + +Copyright (C) 1994-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_load_save_h) +#define octave_load_save_h 1 + +#include +#include + +#include "mach-info.h" +#include "symtab.h" + +class octave_value; + +// FIXME: maybe MAT5 and MAT7 should be options to MAT_BINARY. +// Similarly, save_as_floats may be an option for LS_BINARY, LS_HDF5 etc. +enum load_save_format_type + { + LS_ASCII, + LS_BINARY, + LS_MAT_ASCII, + LS_MAT_BINARY, + LS_MAT5_BINARY, + LS_MAT7_BINARY, +#ifdef HAVE_HDF5 + LS_HDF5, +#endif /* HAVE_HDF5 */ + LS_UNKNOWN + }; + +enum load_save_format_options +{ + // LS_MAT_ASCII options (not exclusive) + LS_MAT_ASCII_LONG = 1, + LS_MAT_ASCII_TABS = 2, + // LS_MAT_BINARY options + LS_MAT_BINARY_V5 = 1, + LS_MAT_BINARY_V7, + // zero means no option. + LS_NO_OPTION = 0 +}; + +class load_save_format +{ +public: + load_save_format (load_save_format_type t, + load_save_format_options o = LS_NO_OPTION) + : type (t), opts (o) { } + operator int (void) const + { return type; } + int type, opts; +}; + +extern void dump_octave_core (void); + +extern int +read_binary_file_header (std::istream& is, bool& swap, + oct_mach_info::float_format& flt_fmt, + bool quiet = false); + +extern octave_value +do_load (std::istream& stream, const std::string& orig_fname, + load_save_format format, oct_mach_info::float_format flt_fmt, + bool list_only, bool swap, bool verbose, + const string_vector& argv, int argv_idx, int argc, int nargout); + +extern OCTINTERP_API bool is_octave_data_file (const std::string& file); + +extern void +do_save (std::ostream& os, const symbol_table::symbol_record& sr, + load_save_format fmt, bool save_as_floats); + +extern void +write_header (std::ostream& os, load_save_format format); + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/ls-ascii-helper.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/ls-ascii-helper.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,175 @@ +/* + +Copyright (C) 2009-2012 Benjamin Lindner + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "ls-ascii-helper.h" + +#include +#include + +// Helper functions when reading from ascii files. + +// These function take care of CR/LF issues when files are opened in +// text-mode for reading. + +// Skip characters from stream IS until a newline is reached. +// Depending on KEEP_NEWLINE, either eat newline from stream or +// keep it unread. + +void +skip_until_newline (std::istream& is, bool keep_newline) +{ + if (! is) + return; + + while (is) + { + char c = is.peek (); + + if (c == '\n' || c == '\r') + { + // Reached newline. + if (! keep_newline) + { + // Eat the CR or LF character. + char d; + is.get (d); + + // Make sure that for binary-mode opened ascii files + // containing CRLF line endings we skip the LF after CR. + if (c == '\r' && is.peek () == '\n') + { + // Yes, LF following CR, eat it. + is.get (d); + } + } + + // Newline was found, and read from stream if + // keep_newline == true, so exit loop. + break; + } + else + { + // No newline charater peeked, so read it and proceed to next + // character. + char d; + is.get (d); + } + } +} + + +// If stream IS currently points to a newline (a leftover from a +// previous read) then eat newline(s) until a non-newline character is +// found. + +void +skip_preceeding_newline (std::istream& is) +{ + if (! is) + return; + + // Check whether IS currently points to newline character. + char c = is.peek (); + + if (c == '\n' || c == '\r') + { + // Yes, at newline. + do + { + // Eat the CR or LF character. + char d; + is.get (d); + + // Make sure that for binary-mode opened ascii files + // containing CRLF line endings we skip the LF after CR. + if (c == '\r' && is.peek () == '\n') + { + // Yes, LF following CR, eat it. + is.get (d); + } + + // Peek into next character. + c = is.peek (); + + // Loop while still a newline ahead. + } + while (c == '\n' || c == '\r'); + } +} + +// Read charaters from stream IS until a newline is reached. +// Depending on KEEP_NEWLINE, either eat newline from stream or keep +// it unread. Characters read are stored and returned as +// std::string. + +std::string +read_until_newline (std::istream& is, bool keep_newline) +{ + if (! is) + return std::string (); + + std::ostringstream buf; + + while (is) + { + char c = is.peek (); + + if (c == '\n' || c == '\r') + { + // Reached newline. + if (! keep_newline) + { + // Eat the CR or LF character. + char d; + is.get (d); + + // Make sure that for binary-mode opened ascii files + // containing CRLF line endings we skip the LF after + // CR. + + if (c == '\r' && is.peek () == '\n') + { + // Yes, LF following CR, eat it. + is.get (d); + } + } + + // Newline was found, and read from stream if + // keep_newline == true, so exit loop. + break; + } + else + { + // No newline charater peeked, so read it, store it, and + // proceed to next. + char d; + is.get (d); + buf << d; + } + } + + return buf.str (); +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/ls-ascii-helper.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/ls-ascii-helper.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,38 @@ +/* + +Copyright (C) 2009-2012 Benjamin Lindner + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_ls_ascii_helper_h) +#define octave_ls_ascii_helper_h 1 + +#include +#include + +extern OCTINTERP_API void +skip_until_newline (std::istream& is, bool keep_newline = false); + +extern OCTINTERP_API void +skip_preceeding_newline (std::istream& is); + +extern OCTINTERP_API std::string +read_until_newline (std::istream& is, bool keep_newline = false); + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/ls-hdf5.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/ls-hdf5.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,921 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Author: Steven G. Johnson + +#ifdef HAVE_CONFIG_H +#include +#endif + +#if defined (HAVE_HDF5) + +#include +#include +#include + +#include +#include +#include +#include +#include + +#include "byte-swap.h" +#include "data-conv.h" +#include "file-ops.h" +#include "glob-match.h" +#include "lo-mappers.h" +#include "mach-info.h" +#include "oct-env.h" +#include "oct-time.h" +#include "quit.h" +#include "str-vec.h" +#include "oct-locbuf.h" + +#include "Cell.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "load-save.h" +#include "oct-obj.h" +#include "oct-map.h" +#include "ov-cell.h" +#include "pager.h" +#include "pt-exp.h" +#include "sysdep.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" +#include "version.h" +#include "dMatrix.h" +#include "ov-lazy-idx.h" + +#include "ls-utils.h" +#include "ls-hdf5.h" + +static std::string +make_valid_identifier (const std::string& nm) +{ + std::string retval; + + size_t nm_len = nm.length (); + + if (nm_len > 0) + { + if (! isalpha (nm[0])) + retval += '_'; + + for (size_t i = 0; i < nm_len; i++) + { + char c = nm[i]; + retval += (isalnum (c) || c == '_') ? c : '_'; + } + } + + return retval; +} + +// Define this to 1 if/when HDF5 supports automatic conversion between +// integer and floating-point binary data: +#define HAVE_HDF5_INT2FLOAT_CONVERSIONS 0 + +// Given two compound types t1 and t2, determine whether they +// are compatible for reading/writing. This function only +// works for non-nested types composed of simple elements (ints, floats...), +// which is all we need it for + +bool +hdf5_types_compatible (hid_t t1, hid_t t2) +{ + int n; + if ((n = H5Tget_nmembers (t1)) != H5Tget_nmembers (t2)) + return false; + + for (int i = 0; i < n; ++i) + { + hid_t mt1 = H5Tget_member_type (t1, i); + hid_t mt2 = H5Tget_member_type (t2, i); + + if (H5Tget_class (mt1) != H5Tget_class (mt2)) + return false; + + H5Tclose (mt2); + H5Tclose (mt1); + } + + return true; +} + +// Return true if loc_id has the attribute named attr_name, and false +// otherwise. + +bool +hdf5_check_attr (hid_t loc_id, const char *attr_name) +{ + bool retval = false; + + // we have to pull some shenanigans here to make sure + // HDF5 doesn't print out all sorts of error messages if we + // call H5Aopen for a non-existing attribute + + H5E_auto_t err_func; + void *err_func_data; + + // turn off error reporting temporarily, but save the error + // reporting function: + +#if HAVE_HDF5_18 + H5Eget_auto (H5E_DEFAULT, &err_func, &err_func_data); + H5Eset_auto (H5E_DEFAULT, 0, 0); +#else + H5Eget_auto (&err_func, &err_func_data); + H5Eset_auto (0, 0); +#endif + + hid_t attr_id = H5Aopen_name (loc_id, attr_name); + + if (attr_id >= 0) + { + // successful + retval = true; + H5Aclose (attr_id); + } + + // restore error reporting: +#if HAVE_HDF5_18 + H5Eset_auto (H5E_DEFAULT, err_func, err_func_data); +#else + H5Eset_auto (err_func, err_func_data); +#endif + return retval; +} + +bool +hdf5_get_scalar_attr (hid_t loc_id, hid_t type_id, + const char *attr_name, void *buf) +{ + bool retval = false; + + // we have to pull some shenanigans here to make sure + // HDF5 doesn't print out all sorts of error messages if we + // call H5Aopen for a non-existing attribute + + H5E_auto_t err_func; + void *err_func_data; + + // turn off error reporting temporarily, but save the error + // reporting function: + +#if HAVE_HDF5_18 + H5Eget_auto (H5E_DEFAULT, &err_func, &err_func_data); + H5Eset_auto (H5E_DEFAULT, 0, 0); +#else + H5Eget_auto (&err_func, &err_func_data); + H5Eset_auto (0, 0); +#endif + + hid_t attr_id = H5Aopen_name (loc_id, attr_name); + + if (attr_id >= 0) + { + hid_t space_id = H5Aget_space (attr_id); + + hsize_t rank = H5Sget_simple_extent_ndims (space_id); + + if (rank == 0) + retval = H5Aread (attr_id, type_id, buf) >= 0; + H5Aclose (attr_id); + } + + // restore error reporting: +#if HAVE_HDF5_18 + H5Eset_auto (H5E_DEFAULT, err_func, err_func_data); +#else + H5Eset_auto (err_func, err_func_data); +#endif + return retval; +} + + + + +// The following subroutines creates an HDF5 representations of the way +// we will store Octave complex types (pairs of floating-point numbers). +// NUM_TYPE is the HDF5 numeric type to use for storage (e.g. +// H5T_NATIVE_DOUBLE to save as 'double'). Note that any necessary +// conversions are handled automatically by HDF5. + +hid_t +hdf5_make_complex_type (hid_t num_type) +{ + hid_t type_id = H5Tcreate (H5T_COMPOUND, sizeof (double) * 2); + + H5Tinsert (type_id, "real", 0 * sizeof (double), num_type); + H5Tinsert (type_id, "imag", 1 * sizeof (double), num_type); + + return type_id; +} + +// This function is designed to be passed to H5Giterate, which calls it +// on each data item in an HDF5 file. For the item whose name is NAME in +// the group GROUP_ID, this function sets dv->tc to an Octave representation +// of that item. (dv must be a pointer to hdf5_callback_data.) (It also +// sets the other fields of dv). +// +// It returns 1 on success (in which case H5Giterate stops and returns), +// -1 on error, and 0 to tell H5Giterate to continue on to the next item +// (e.g. if NAME was a data type we don't recognize). + +herr_t +hdf5_read_next_data (hid_t group_id, const char *name, void *dv) +{ + hdf5_callback_data *d = static_cast (dv); + hid_t type_id = -1, type_class_id = -1, data_id = -1, subgroup_id = -1, + space_id = -1; + + H5G_stat_t info; + herr_t retval = 0; + bool ident_valid = valid_identifier (name); + + std::string vname = name; + + // Allow identifiers as all digits so we can load lists saved by + // earlier versions of Octave. + + if (! ident_valid ) + { + // fix the identifier, replacing invalid chars with underscores + vname = make_valid_identifier (vname); + + // check again (in case vname was null, empty, or some such thing): + ident_valid = valid_identifier (vname); + } + + H5Gget_objinfo (group_id, name, 1, &info); + + if (info.type == H5G_GROUP && ident_valid) + { +#if HAVE_HDF5_18 + subgroup_id = H5Gopen (group_id, name, H5P_DEFAULT); +#else + subgroup_id = H5Gopen (group_id, name); +#endif + + if (subgroup_id < 0) + { + retval = subgroup_id; + goto done; + } + + if (hdf5_check_attr (subgroup_id, "OCTAVE_NEW_FORMAT")) + { +#if HAVE_HDF5_18 + data_id = H5Dopen (subgroup_id, "type", H5P_DEFAULT); +#else + data_id = H5Dopen (subgroup_id, "type"); +#endif + + if (data_id < 0) + { + retval = data_id; + goto done; + } + + type_id = H5Dget_type (data_id); + + type_class_id = H5Tget_class (type_id); + + if (type_class_id != H5T_STRING) + goto done; + + space_id = H5Dget_space (data_id); + hsize_t rank = H5Sget_simple_extent_ndims (space_id); + + if (rank != 0) + goto done; + + int slen = H5Tget_size (type_id); + if (slen < 0) + goto done; + + OCTAVE_LOCAL_BUFFER (char, typ, slen); + + // create datatype for (null-terminated) string to read into: + hid_t st_id = H5Tcopy (H5T_C_S1); + H5Tset_size (st_id, slen); + + if (H5Dread (data_id, st_id, H5S_ALL, H5S_ALL, H5P_DEFAULT, + typ) < 0) + goto done; + + H5Tclose (st_id); + H5Dclose (data_id); + + d->tc = octave_value_typeinfo::lookup_type (typ); + + retval = (d->tc.load_hdf5 (subgroup_id, "value") ? 1 : -1); + + // check for OCTAVE_GLOBAL attribute: + d->global = hdf5_check_attr (subgroup_id, "OCTAVE_GLOBAL"); + + H5Gclose (subgroup_id); + } + else + { + // an HDF5 group is treated as an octave structure by + // default (since that preserves name information), and an + // octave list otherwise. + + if (hdf5_check_attr (subgroup_id, "OCTAVE_LIST")) + d->tc = octave_value_typeinfo::lookup_type ("list"); + else + d->tc = octave_value_typeinfo::lookup_type ("struct"); + + // check for OCTAVE_GLOBAL attribute: + d->global = hdf5_check_attr (subgroup_id, "OCTAVE_GLOBAL"); + + H5Gclose (subgroup_id); + + retval = (d->tc.load_hdf5 (group_id, name) ? 1 : -1); + } + + } + else if (info.type == H5G_DATASET && ident_valid) + { + // For backwards compatiability. +#if HAVE_HDF5_18 + data_id = H5Dopen (group_id, name, H5P_DEFAULT); +#else + data_id = H5Dopen (group_id, name); +#endif + + if (data_id < 0) + { + retval = data_id; + goto done; + } + + type_id = H5Dget_type (data_id); + + type_class_id = H5Tget_class (type_id); + + if (type_class_id == H5T_FLOAT) + { + space_id = H5Dget_space (data_id); + + hsize_t rank = H5Sget_simple_extent_ndims (space_id); + + if (rank == 0) + d->tc = octave_value_typeinfo::lookup_type ("scalar"); + else + d->tc = octave_value_typeinfo::lookup_type ("matrix"); + + H5Sclose (space_id); + } + else if (type_class_id == H5T_INTEGER) + { + // What integer type do we really have.. + std::string int_typ; +#ifdef HAVE_H5T_GET_NATIVE_TYPE + // FIXME test this code and activated with an autoconf + // test!! It is also incorrect for 64-bit indexing!! + + switch (H5Tget_native_type (type_id, H5T_DIR_ASCEND)) + { + case H5T_NATIVE_CHAR: + int_typ = "int8 "; + break; + + case H5T_NATIVE_SHORT: + int_typ = "int16 "; + break; + + case H5T_NATIVE_INT: + case H5T_NATIVE_LONG: + int_typ = "int32 "; + break; + + case H5T_NATIVE_LLONG: + int_typ = "int64 "; + break; + + case H5T_NATIVE_UCHAR: + int_typ = "uint8 "; + break; + + case H5T_NATIVE_USHORT: + int_typ = "uint16 "; + break; + + case H5T_NATIVE_UINT: + case H5T_NATIVE_ULONG: + int_typ = "uint32 "; + break; + + case H5T_NATIVE_ULLONG: + int_typ = "uint64 "; + break; + } +#else + hid_t int_sign = H5Tget_sign (type_id); + + if (int_sign == H5T_SGN_ERROR) + warning ("load: can't read '%s' (unknown datatype)", name); + else + { + if (int_sign == H5T_SGN_NONE) + int_typ.append ("u"); + int_typ.append ("int"); + + int slen = H5Tget_size (type_id); + if (slen < 0) + warning ("load: can't read '%s' (unknown datatype)", name); + else + { + switch (slen) + { + case 1: + int_typ.append ("8 "); + break; + + case 2: + int_typ.append ("16 "); + break; + + case 4: + int_typ.append ("32 "); + break; + + case 8: + int_typ.append ("64 "); + break; + + default: + warning ("load: can't read '%s' (unknown datatype)", + name); + int_typ = ""; + break; + } + } + } +#endif + if (int_typ == "") + warning ("load: can't read '%s' (unknown datatype)", name); + else + { + // Matrix or scalar? + space_id = H5Dget_space (data_id); + + hsize_t rank = H5Sget_simple_extent_ndims (space_id); + + if (rank == 0) + int_typ.append ("scalar"); + else + int_typ.append ("matrix"); + + d->tc = octave_value_typeinfo::lookup_type (int_typ); + H5Sclose (space_id); + } + } + else if (type_class_id == H5T_STRING) + d->tc = octave_value_typeinfo::lookup_type ("string"); + else if (type_class_id == H5T_COMPOUND) + { + hid_t complex_type = hdf5_make_complex_type (H5T_NATIVE_DOUBLE); + + if (hdf5_types_compatible (type_id, complex_type)) + { + // read complex matrix or scalar variable + space_id = H5Dget_space (data_id); + hsize_t rank = H5Sget_simple_extent_ndims (space_id); + + if (rank == 0) + d->tc = octave_value_typeinfo::lookup_type ("complex scalar"); + else + d->tc = octave_value_typeinfo::lookup_type ("complex matrix"); + + H5Sclose (space_id); + } + else + // Assume that if its not complex its a range. If its not + // it'll be rejected later in the range code + d->tc = octave_value_typeinfo::lookup_type ("range"); + + H5Tclose (complex_type); + } + else + { + warning ("load: can't read '%s' (unknown datatype)", name); + retval = 0; // unknown datatype; skip + } + + // check for OCTAVE_GLOBAL attribute: + d->global = hdf5_check_attr (data_id, "OCTAVE_GLOBAL"); + + H5Tclose (type_id); + H5Dclose (data_id); + + retval = (d->tc.load_hdf5 (group_id, name) ? 1 : -1); + } + + if (!ident_valid) + { + // should we attempt to handle invalid identifiers by converting + // bad characters to '_', say? + warning ("load: skipping invalid identifier '%s' in hdf5 file", + name); + } + + done: + if (retval < 0) + error ("load: error while reading hdf5 item %s", name); + + if (retval > 0) + { + // get documentation string, if any: + int comment_length = H5Gget_comment (group_id, name, 0, 0); + + if (comment_length > 1) + { + OCTAVE_LOCAL_BUFFER (char, tdoc, comment_length); + H5Gget_comment (group_id, name, comment_length, tdoc); + d->doc = tdoc; + } + else if (vname != name) + { + // the name was changed; store the original name + // as the documentation string: + d->doc = name; + } + + // copy name (actually, vname): + d->name = vname; + } + + return retval; +} + +// Read the next Octave variable from the stream IS, which must really be +// an hdf5_ifstream. Return the variable value in tc, its doc string +// in doc, and whether it is global in global. The return value is +// the name of the variable, or NULL if none were found or there was +// and error. +std::string +read_hdf5_data (std::istream& is, const std::string& /* filename */, + bool& global, octave_value& tc, std::string& doc) +{ + std::string retval; + + doc.resize (0); + + hdf5_ifstream& hs = dynamic_cast (is); + hdf5_callback_data d; + + herr_t H5Giterate_retval = -1; + + hsize_t num_obj = 0; +#if HAVE_HDF5_18 + hid_t group_id = H5Gopen (hs.file_id, "/", H5P_DEFAULT); +#else + hid_t group_id = H5Gopen (hs.file_id, "/"); +#endif + H5Gget_num_objs (group_id, &num_obj); + H5Gclose (group_id); + if (hs.current_item < static_cast (num_obj)) + H5Giterate_retval = H5Giterate (hs.file_id, "/", &hs.current_item, + hdf5_read_next_data, &d); + + if (H5Giterate_retval > 0) + { + global = d.global; + tc = d.tc; + doc = d.doc; + } + else + { + // an error occurred (H5Giterate_retval < 0) or there are no + // more datasets print an error message if retval < 0? + // hdf5_read_next_data already printed one, probably. + } + + if (! d.name.empty ()) + retval = d.name; + + return retval; +} + +// Add an attribute named attr_name to loc_id (a simple scalar +// attribute with value 1). Return value is >= 0 on success. +herr_t +hdf5_add_attr (hid_t loc_id, const char *attr_name) +{ + herr_t retval = 0; + + hid_t as_id = H5Screate (H5S_SCALAR); + + if (as_id >= 0) + { +#if HAVE_HDF5_18 + hid_t a_id = H5Acreate (loc_id, attr_name, H5T_NATIVE_UCHAR, + as_id, H5P_DEFAULT, H5P_DEFAULT); +#else + hid_t a_id = H5Acreate (loc_id, attr_name, + H5T_NATIVE_UCHAR, as_id, H5P_DEFAULT); +#endif + if (a_id >= 0) + { + unsigned char attr_val = 1; + + retval = H5Awrite (a_id, H5T_NATIVE_UCHAR, &attr_val); + + H5Aclose (a_id); + } + else + retval = a_id; + + H5Sclose (as_id); + } + else + retval = as_id; + + return retval; +} + +herr_t +hdf5_add_scalar_attr (hid_t loc_id, hid_t type_id, + const char *attr_name, void *buf) +{ + herr_t retval = 0; + + hid_t as_id = H5Screate (H5S_SCALAR); + + if (as_id >= 0) + { +#if HAVE_HDF5_18 + hid_t a_id = H5Acreate (loc_id, attr_name, type_id, + as_id, H5P_DEFAULT, H5P_DEFAULT); +#else + hid_t a_id = H5Acreate (loc_id, attr_name, + type_id, as_id, H5P_DEFAULT); +#endif + if (a_id >= 0) + { + retval = H5Awrite (a_id, type_id, buf); + + H5Aclose (a_id); + } + else + retval = a_id; + + H5Sclose (as_id); + } + else + retval = as_id; + + return retval; +} + +// Save an empty matrix, if needed. Returns +// > 0 Saved empty matrix +// = 0 Not an empty matrix; did nothing +// < 0 Error condition +int +save_hdf5_empty (hid_t loc_id, const char *name, const dim_vector d) +{ + hsize_t sz = d.length (); + OCTAVE_LOCAL_BUFFER (octave_idx_type, dims, sz); + bool empty = false; + hid_t space_hid = -1, data_hid = -1; + int retval; + for (hsize_t i = 0; i < sz; i++) + { + dims[i] = d(i); + if (dims[i] < 1) + empty = true; + } + + if (!empty) + return 0; + + space_hid = H5Screate_simple (1, &sz, 0); + if (space_hid < 0) return space_hid; +#if HAVE_HDF5_18 + data_hid = H5Dcreate (loc_id, name, H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (loc_id, name, H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + return data_hid; + } + + retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, + H5P_DEFAULT, dims) >= 0; + + H5Dclose (data_hid); + H5Sclose (space_hid); + + if (retval >= 0) + retval = hdf5_add_attr (loc_id, "OCTAVE_EMPTY_MATRIX"); + + return (retval == 0 ? 1 : retval); +} + +// Load an empty matrix, if needed. Returns +// > 0 loaded empty matrix, dimensions returned +// = 0 Not an empty matrix; did nothing +// < 0 Error condition +int +load_hdf5_empty (hid_t loc_id, const char *name, dim_vector &d) +{ + if (! hdf5_check_attr (loc_id, "OCTAVE_EMPTY_MATRIX")) + return 0; + + hsize_t hdims, maxdims; +#if HAVE_HDF5_18 + hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); +#else + hid_t data_hid = H5Dopen (loc_id, name); +#endif + hid_t space_id = H5Dget_space (data_hid); + H5Sget_simple_extent_dims (space_id, &hdims, &maxdims); + int retval; + + OCTAVE_LOCAL_BUFFER (octave_idx_type, dims, hdims); + + retval = H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, + H5P_DEFAULT, dims); + if (retval >= 0) + { + d.resize (hdims); + for (hsize_t i = 0; i < hdims; i++) + d(i) = dims[i]; + } + + H5Sclose (space_id); + H5Dclose (data_hid); + + return (retval == 0 ? hdims : retval); +} + +// save_type_to_hdf5 is not currently used, since hdf5 doesn't yet support +// automatic float<->integer conversions: + +#if HAVE_HDF5_INT2FLOAT_CONVERSIONS + +// return the HDF5 type id corresponding to the Octave save_type + +hid_t +save_type_to_hdf5 (save_type st) +{ + switch (st) + { + case LS_U_CHAR: + return H5T_NATIVE_UCHAR; + + case LS_U_SHORT: + return H5T_NATIVE_USHORT; + + case LS_U_INT: + return H5T_NATIVE_UINT; + + case LS_CHAR: + return H5T_NATIVE_CHAR; + + case LS_SHORT: + return H5T_NATIVE_SHORT; + + case LS_INT: + return H5T_NATIVE_INT; + + case LS_FLOAT: + return H5T_NATIVE_FLOAT; + + case LS_DOUBLE: + default: + return H5T_NATIVE_DOUBLE; + } +} +#endif /* HAVE_HDF5_INT2FLOAT_CONVERSIONS */ + +// Add the data from TC to the HDF5 location loc_id, which could +// be either a file or a group within a file. Return true if +// successful. This function calls itself recursively for lists +// (stored as HDF5 groups). + +bool +add_hdf5_data (hid_t loc_id, const octave_value& tc, + const std::string& name, const std::string& doc, + bool mark_as_global, bool save_as_floats) +{ + hsize_t dims[3]; + hid_t type_id = -1, space_id = -1, data_id = -1, data_type_id = -1; + bool retval = false; + octave_value val = tc; + // FIXME: diagonal & permutation matrices currently don't know how to save + // themselves, so we convert them first to normal matrices using A = A(:,:). + // This is a temporary hack. + if (val.is_diag_matrix () || val.is_perm_matrix () + || val.type_id () == octave_lazy_index::static_type_id ()) + val = val.full_value (); + + std::string t = val.type_name (); +#if HAVE_HDF5_18 + data_id = H5Gcreate (loc_id, name.c_str (), H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_id = H5Gcreate (loc_id, name.c_str (), 0); +#endif + if (data_id < 0) + goto error_cleanup; + + // attach the type of the variable + type_id = H5Tcopy (H5T_C_S1); H5Tset_size (type_id, t.length () + 1); + if (type_id < 0) + goto error_cleanup; + + dims[0] = 0; + space_id = H5Screate_simple (0 , dims, 0); + if (space_id < 0) + goto error_cleanup; +#if HAVE_HDF5_18 + data_type_id = H5Dcreate (data_id, "type", type_id, space_id, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_type_id = H5Dcreate (data_id, "type", type_id, space_id, H5P_DEFAULT); +#endif + if (data_type_id < 0 || H5Dwrite (data_type_id, type_id, H5S_ALL, H5S_ALL, + H5P_DEFAULT, t.c_str ()) < 0) + goto error_cleanup; + + // Now call the real function to save the variable + retval = val.save_hdf5 (data_id, "value", save_as_floats); + + // attach doc string as comment: + if (retval && doc.length () > 0 + && H5Gset_comment (loc_id, name.c_str (), doc.c_str ()) < 0) + retval = false; + + // if it's global, add an attribute "OCTAVE_GLOBAL" with value 1 + if (retval && mark_as_global) + retval = hdf5_add_attr (data_id, "OCTAVE_GLOBAL") >= 0; + + // We are saving in the new variable format, so mark it + if (retval) + retval = hdf5_add_attr (data_id, "OCTAVE_NEW_FORMAT") >= 0; + + error_cleanup: + + if (data_type_id >= 0) + H5Dclose (data_type_id); + + if (type_id >= 0) + H5Tclose (type_id); + + if (space_id >= 0) + H5Sclose (space_id); + + if (data_id >= 0) + H5Gclose (data_id); + + if (! retval) + error ("save: error while writing '%s' to hdf5 file", name.c_str ()); + + return retval; +} + +// Write data from TC in HDF5 (binary) format to the stream OS, +// which must be an hdf5_ofstream, returning true on success. + +bool +save_hdf5_data (std::ostream& os, const octave_value& tc, + const std::string& name, const std::string& doc, + bool mark_as_global, bool save_as_floats) +{ + hdf5_ofstream& hs = dynamic_cast (os); + + return add_hdf5_data (hs.file_id, tc, name, doc, + mark_as_global, save_as_floats); +} + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/ls-hdf5.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/ls-hdf5.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,213 @@ +/* + +Copyright (C) 2003-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_ls_hdf5_h) +#define octave_ls_hdf5_h 1 + +#if defined (HAVE_HDF5) + +#include "oct-hdf5.h" + +// first, we need to define our own dummy stream subclass, since +// HDF5 needs to do its own file i/o + +// hdf5_fstreambase is used for both input and output streams, modeled +// on the fstreambase class in + +class hdf5_fstreambase : virtual public std::ios +{ +public: + + // HDF5 uses an "id" to refer to an open file + hid_t file_id; + + // keep track of current item index in the file + int current_item; + + hdf5_fstreambase () : file_id (-1), current_item () { } + + ~hdf5_fstreambase () { close (); } + + hdf5_fstreambase (const char *name, int mode, int /* prot */ = 0) + : file_id (-1), current_item (-1) + { + if (mode & std::ios::in) + file_id = H5Fopen (name, H5F_ACC_RDONLY, H5P_DEFAULT); + else if (mode & std::ios::out) + { + if (mode & std::ios::app && H5Fis_hdf5 (name) > 0) + file_id = H5Fopen (name, H5F_ACC_RDWR, H5P_DEFAULT); + else + file_id = H5Fcreate (name, H5F_ACC_TRUNC, H5P_DEFAULT, + H5P_DEFAULT); + } + if (file_id < 0) + std::ios::setstate (std::ios::badbit); + + current_item = 0; + } + + void close () + { + if (file_id >= 0) + { + if (H5Fclose (file_id) < 0) + std::ios::setstate (std::ios::badbit); + file_id = -1; + } + } + + void open (const char *name, int mode, int) + { + clear (); + + if (mode & std::ios::in) + file_id = H5Fopen (name, H5F_ACC_RDONLY, H5P_DEFAULT); + else if (mode & std::ios::out) + { + if (mode & std::ios::app && H5Fis_hdf5 (name) > 0) + file_id = H5Fopen (name, H5F_ACC_RDWR, H5P_DEFAULT); + else + file_id = H5Fcreate (name, H5F_ACC_TRUNC, H5P_DEFAULT, + H5P_DEFAULT); + } + if (file_id < 0) + std::ios::setstate (std::ios::badbit); + + current_item = 0; + } +}; + +// input and output streams, subclassing istream and ostream +// so that we can pass them for stream parameters in the functions below. + +class hdf5_ifstream : public hdf5_fstreambase, public std::istream +{ +public: + + hdf5_ifstream () : hdf5_fstreambase (), std::istream (0) { } + + hdf5_ifstream (const char *name, int mode = std::ios::in|std::ios::binary, + int prot = 0) + : hdf5_fstreambase (name, mode, prot), std::istream (0) { } + + void open (const char *name, int mode = std::ios::in|std::ios::binary, + int prot = 0) + { hdf5_fstreambase::open (name, mode, prot); } +}; + +class hdf5_ofstream : public hdf5_fstreambase, public std::ostream +{ +public: + + hdf5_ofstream () : hdf5_fstreambase (), std::ostream (0) { } + + hdf5_ofstream (const char *name, int mode = std::ios::out|std::ios::binary, + int prot = 0) + : hdf5_fstreambase (name, mode, prot), std::ostream (0) { } + + void open (const char *name, int mode = std::ios::out|std::ios::binary, + int prot = 0) + { hdf5_fstreambase::open (name, mode, prot); } +}; + +// Callback data structure for passing data to hdf5_read_next_data, below. + +struct +hdf5_callback_data +{ + hdf5_callback_data (void) + : name (), global (false), tc (), doc () { } + + // the following fields are set by hdf5_read_data on successful return: + + // the name of the variable + std::string name; + + // whether it is global + bool global; + + // the value of the variable, in Octave form + octave_value tc; + + // a documentation string (NULL if none) + std::string doc; +}; + +#if HAVE_HDF5_INT2FLOAT_CONVERSIONS +extern OCTINTERP_API hid_t +save_type_to_hdf5 (save_type st) +#endif + +extern OCTINTERP_API hid_t +hdf5_make_complex_type (hid_t num_type); + +extern OCTINTERP_API bool +hdf5_types_compatible (hid_t t1, hid_t t2); + +extern OCTINTERP_API herr_t +hdf5_read_next_data (hid_t group_id, const char *name, void *dv); + +extern OCTINTERP_API bool +add_hdf5_data (hid_t loc_id, const octave_value& tc, + const std::string& name, const std::string& doc, + bool mark_as_global, bool save_as_floats); + +extern OCTINTERP_API int +save_hdf5_empty (hid_t loc_id, const char *name, const dim_vector d); + +extern OCTINTERP_API int +load_hdf5_empty (hid_t loc_id, const char *name, dim_vector &d); + +extern OCTINTERP_API std::string +read_hdf5_data (std::istream& is, const std::string& filename, bool& global, + octave_value& tc, std::string& doc); + +extern OCTINTERP_API bool +save_hdf5_data (std::ostream& os, const octave_value& tc, + const std::string& name, const std::string& doc, + bool mark_as_global, bool save_as_floats); + +extern OCTINTERP_API bool +hdf5_check_attr (hid_t loc_id, const char *attr_name); + +extern OCTINTERP_API bool +hdf5_get_scalar_attr (hid_t loc_id, hid_t type_id, const char *attr_name, + void *buf); + +extern OCTINTERP_API herr_t +hdf5_add_attr (hid_t loc_id, const char *attr_name); + + +extern OCTINTERP_API herr_t +hdf5_add_scalar_attr (hid_t loc_id, hid_t type_id, + const char *attr_name, void *buf); + +#ifdef USE_64_BIT_IDX_T +#define H5T_NATIVE_IDX H5T_NATIVE_LONG +#else +#define H5T_NATIVE_IDX H5T_NATIVE_INT +#endif + +#endif + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/ls-mat-ascii.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/ls-mat-ascii.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,430 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include +#include +#include +#include +#include + +#include "byte-swap.h" +#include "data-conv.h" +#include "file-ops.h" +#include "glob-match.h" +#include "lo-mappers.h" +#include "mach-info.h" +#include "oct-env.h" +#include "oct-time.h" +#include "quit.h" +#include "str-vec.h" + +#include "Cell.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "lex.h" +#include "load-save.h" +#include "ls-ascii-helper.h" +#include "ls-mat-ascii.h" +#include "oct-obj.h" +#include "oct-map.h" +#include "ov-cell.h" +#include "pager.h" +#include "pt-exp.h" +#include "sysdep.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" +#include "version.h" +#include "dMatrix.h" + +static std::string +get_mat_data_input_line (std::istream& is) +{ + std::string retval; + + bool have_data = false; + + do + { + retval = ""; + + char c; + while (is.get (c)) + { + if (c == '\n' || c == '\r') + { + is.putback (c); + skip_preceeding_newline (is); + break; + } + + if (c == '%' || c == '#') + { + skip_until_newline (is, false); + break; + } + + if (! is.eof ()) + { + if (! have_data && c != ' ' && c != '\t') + have_data = true; + + retval += c; + } + } + } + while (! (have_data || is.eof ())); + + return retval; +} + +static void +get_lines_and_columns (std::istream& is, + octave_idx_type& nr, octave_idx_type& nc, + const std::string& filename = std::string (), + bool quiet = false, bool check_numeric = false) +{ + std::streampos pos = is.tellg (); + + int file_line_number = 0; + + nr = 0; + nc = 0; + + while (is && ! error_state) + { + octave_quit (); + + std::string buf = get_mat_data_input_line (is); + + file_line_number++; + + size_t beg = buf.find_first_not_of (", \t"); + + // If we see a CR as the last character in the buffer, we had a + // CRLF pair as the line separator. Any other CR in the text + // will not be considered as whitespace. + + if (beg != std::string::npos && buf[beg] == '\r' && beg == buf.length () - 1) + { + // We had a blank line ending with a CRLF. Handle it the + // same as an empty line. + beg = std::string::npos; + } + + octave_idx_type tmp_nc = 0; + + while (beg != std::string::npos) + { + tmp_nc++; + + size_t end = buf.find_first_of (", \t", beg); + + if (end != std::string::npos) + { + if (check_numeric) + { + std::istringstream tmp_stream (buf.substr (beg, end-beg)); + + octave_read_double (tmp_stream); + + if (tmp_stream.fail ()) + { + if (! quiet) + error ("load: %s: non-numeric data found near line %d", + filename.c_str (), file_line_number); + + nr = 0; + nc = 0; + + goto done; + } + } + + beg = buf.find_first_not_of (", \t", end); + + if (beg == std::string::npos || (buf[beg] == '\r' && + beg == buf.length () - 1)) + { + // We had a line with trailing spaces and + // ending with a CRLF, so this should look like EOL, + // not a new colum. + break; + } + } + else + break; + } + + if (tmp_nc > 0) + { + if (nc == 0) + { + nc = tmp_nc; + nr++; + } + else if (nc == tmp_nc) + nr++; + else + { + if (! quiet) + error ("load: %s: inconsistent number of columns near line %d", + filename.c_str (), file_line_number); + + nr = 0; + nc = 0; + + goto done; + } + } + } + + if (! quiet && (nr == 0 || nc == 0)) + error ("load: file '%s' seems to be empty!", filename.c_str ()); + + done: + + is.clear (); + is.seekg (pos); +} + +// Extract a matrix from a file of numbers only. +// +// Comments are not allowed. The file should only have numeric values. +// +// Reads the file twice. Once to find the number of rows and columns, +// and once to extract the matrix. +// +// FILENAME is used for error messages. +// +// This format provides no way to tag the data as global. + +std::string +read_mat_ascii_data (std::istream& is, const std::string& filename, + octave_value& tc) +{ + std::string retval; + + std::string varname; + + size_t pos = filename.rfind ('/'); + + if (pos != std::string::npos) + varname = filename.substr (pos+1); + else + varname = filename; + + pos = varname.rfind ('.'); + + if (pos != std::string::npos) + varname = varname.substr (0, pos); + + size_t len = varname.length (); + for (size_t i = 0; i < len; i++) + { + char c = varname[i]; + if (! (isalnum (c) || c == '_')) + varname[i] = '_'; + } + + if (is_keyword (varname) || ! isalpha (varname[0])) + varname.insert (0, "X"); + + if (valid_identifier (varname)) + { + octave_idx_type nr = 0; + octave_idx_type nc = 0; + + int total_count = 0; + + get_lines_and_columns (is, nr, nc, filename); + + octave_quit (); + + if (! error_state && nr > 0 && nc > 0) + { + Matrix tmp (nr, nc); + + if (nr < 1 || nc < 1) + is.clear (std::ios::badbit); + else + { + double d; + for (octave_idx_type i = 0; i < nr; i++) + { + std::string buf = get_mat_data_input_line (is); + + std::istringstream tmp_stream (buf); + + for (octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + + d = octave_read_value (tmp_stream); + + if (tmp_stream || tmp_stream.eof ()) + { + tmp.elem (i, j) = d; + total_count++; + + // Skip whitespace and commas. + char c; + while (1) + { + tmp_stream >> c; + + if (! tmp_stream) + break; + + if (! (c == ' ' || c == '\t' || c == ',')) + { + tmp_stream.putback (c); + break; + } + } + + if (tmp_stream.eof ()) + break; + } + else + { + error ("load: failed to read matrix from file '%s'", + filename.c_str ()); + + return retval; + } + + } + } + } + + if (is || is.eof ()) + { + // FIXME -- not sure this is best, but it works. + + if (is.eof ()) + is.clear (); + + octave_idx_type expected = nr * nc; + + if (expected == total_count) + { + tc = tmp; + retval = varname; + } + else + error ("load: expected %d elements, found %d", + expected, total_count); + } + else + error ("load: failed to read matrix from file '%s'", + filename.c_str ()); + } + else + error ("load: unable to extract matrix size from file '%s'", + filename.c_str ()); + } + else + error ("load: unable to convert filename '%s' to valid identifier", + filename.c_str ()); + + return retval; +} + +bool +save_mat_ascii_data (std::ostream& os, const octave_value& val, + int precision, bool tabs) +{ + bool success = true; + + if (val.is_complex_type ()) + warning ("save: omitting imaginary part for ASCII file"); + + Matrix m = val.matrix_value (true); + + if (error_state) + { + success = false; + + error_state = 0; + } + else + { + long old_precision = os.precision (); + + os.precision (precision); + + std::ios::fmtflags oflags + = os.flags (static_cast (std::ios::scientific)); + + if (tabs) + { + for (octave_idx_type i = 0; i < m.rows (); i++) + { + for (octave_idx_type j = 0; j < m.cols (); j++) + { + // Omit leading tabs. + if (j != 0) os << '\t'; + octave_write_double (os, m (i, j)); + } + os << "\n"; + } + } + else + os << m; + + os.flags (oflags); + + os.precision (old_precision); + } + + return (os && success); +} + +bool +looks_like_mat_ascii_file (const std::string& filename) +{ + bool retval = false; + + std::ifstream is (filename.c_str ()); + + if (is) + { + octave_idx_type nr = 0; + octave_idx_type nc = 0; + + get_lines_and_columns (is, nr, nc, filename, true, true); + + retval = (nr != 0 && nc != 0); + } + + return retval; +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/ls-mat-ascii.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/ls-mat-ascii.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,36 @@ +/* + +Copyright (C) 2003-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_ls_mat_ascii_h) +#define octave_ls_mat_ascii_h 1 + +extern std::string +read_mat_ascii_data (std::istream& is, const std::string& filename, + octave_value& tc); + +extern bool +save_mat_ascii_data (std::ostream& os, const octave_value& val_arg, + int precision, bool tabs = false); + +extern bool looks_like_mat_ascii_file (const std::string& filename); + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/ls-mat4.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/ls-mat4.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,609 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include +#include +#include +#include +#include + +#include "byte-swap.h" +#include "data-conv.h" +#include "file-ops.h" +#include "glob-match.h" +#include "lo-mappers.h" +#include "mach-info.h" +#include "oct-env.h" +#include "oct-time.h" +#include "quit.h" +#include "str-vec.h" +#include "oct-locbuf.h" + +#include "Cell.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "load-save.h" +#include "oct-obj.h" +#include "oct-map.h" +#include "ov-cell.h" +#include "pager.h" +#include "pt-exp.h" +#include "sysdep.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" +#include "version.h" +#include "dMatrix.h" +#include "dSparse.h" + +#include "ls-mat4.h" + +// Read LEN elements of data from IS in the format specified by +// PRECISION, placing the result in DATA. If SWAP is TRUE, swap +// the bytes of each element before copying to DATA. FLT_FMT +// specifies the format of the data if we are reading floating point +// numbers. + +static void +read_mat_binary_data (std::istream& is, double *data, int precision, + int len, bool swap, + oct_mach_info::float_format flt_fmt) +{ + switch (precision) + { + case 0: + read_doubles (is, data, LS_DOUBLE, len, swap, flt_fmt); + break; + + case 1: + read_doubles (is, data, LS_FLOAT, len, swap, flt_fmt); + break; + + case 2: + read_doubles (is, data, LS_INT, len, swap, flt_fmt); + break; + + case 3: + read_doubles (is, data, LS_SHORT, len, swap, flt_fmt); + break; + + case 4: + read_doubles (is, data, LS_U_SHORT, len, swap, flt_fmt); + break; + + case 5: + read_doubles (is, data, LS_U_CHAR, len, swap, flt_fmt); + break; + + default: + break; + } +} + +int +read_mat_file_header (std::istream& is, bool& swap, int32_t& mopt, + int32_t& nr, int32_t& nc, + int32_t& imag, int32_t& len, + int quiet) +{ + swap = false; + + // We expect to fail here, at the beginning of a record, so not + // being able to read another mopt value should not result in an + // error. + + is.read (reinterpret_cast (&mopt), 4); + if (! is) + return 1; + + if (! is.read (reinterpret_cast (&nr), 4)) + goto data_read_error; + + if (! is.read (reinterpret_cast (&nc), 4)) + goto data_read_error; + + if (! is.read (reinterpret_cast (&imag), 4)) + goto data_read_error; + + if (! is.read (reinterpret_cast (&len), 4)) + goto data_read_error; + +// If mopt is nonzero and the byte order is swapped, mopt will be +// bigger than we expect, so we swap bytes. +// +// If mopt is zero, it means the file was written on a little endian +// machine, and we only need to swap if we are running on a big endian +// machine. +// +// Gag me. + + if (oct_mach_info::words_big_endian () && mopt == 0) + swap = true; + + // mopt is signed, therefore byte swap may result in negative value. + + if (mopt > 9999 || mopt < 0) + swap = true; + + if (swap) + { + swap_bytes<4> (&mopt); + swap_bytes<4> (&nr); + swap_bytes<4> (&nc); + swap_bytes<4> (&imag); + swap_bytes<4> (&len); + } + + if (mopt > 9999 || mopt < 0 || imag > 1 || imag < 0) + { + if (! quiet) + error ("load: can't read binary file"); + return -1; + } + + return 0; + + data_read_error: + return -1; +} + +// We don't just use a cast here, because we need to be able to detect +// possible errors. + +oct_mach_info::float_format +mopt_digit_to_float_format (int mach) +{ + oct_mach_info::float_format flt_fmt = oct_mach_info::flt_fmt_unknown; + + switch (mach) + { + case 0: + flt_fmt = oct_mach_info::flt_fmt_ieee_little_endian; + break; + + case 1: + flt_fmt = oct_mach_info::flt_fmt_ieee_big_endian; + break; + + case 2: + flt_fmt = oct_mach_info::flt_fmt_vax_d; + break; + + case 3: + flt_fmt = oct_mach_info::flt_fmt_vax_g; + break; + + case 4: + flt_fmt = oct_mach_info::flt_fmt_cray; + break; + + default: + flt_fmt = oct_mach_info::flt_fmt_unknown; + break; + } + + return flt_fmt; +} + +int +float_format_to_mopt_digit (oct_mach_info::float_format flt_fmt) +{ + int retval = -1; + + switch (flt_fmt) + { + case oct_mach_info::flt_fmt_ieee_little_endian: + retval = 0; + break; + + case oct_mach_info::flt_fmt_ieee_big_endian: + retval = 1; + break; + + case oct_mach_info::flt_fmt_vax_d: + retval = 2; + break; + + case oct_mach_info::flt_fmt_vax_g: + retval = 3; + break; + + case oct_mach_info::flt_fmt_cray: + retval = 4; + break; + + default: + break; + } + + return retval; +} + +// Extract one value (scalar, matrix, string, etc.) from stream IS and +// place it in TC, returning the name of the variable. +// +// The data is expected to be in Matlab version 4 .mat format, though +// not all the features of that format are supported. +// +// FILENAME is used for error messages. +// +// This format provides no way to tag the data as global. + +std::string +read_mat_binary_data (std::istream& is, const std::string& filename, + octave_value& tc) +{ + std::string retval; + + // These are initialized here instead of closer to where they are + // first used to avoid errors from gcc about goto crossing + // initialization of variable. + + Matrix re; + oct_mach_info::float_format flt_fmt = oct_mach_info::flt_fmt_unknown; + bool swap = false; + int type = 0; + int prec = 0; + int order = 0; + int mach = 0; + int dlen = 0; + + int32_t mopt, nr, nc, imag, len; + + int err = read_mat_file_header (is, swap, mopt, nr, nc, imag, len); + if (err) + { + if (err < 0) + goto data_read_error; + else + return retval; + } + + type = mopt % 10; // Full, sparse, etc. + mopt /= 10; // Eliminate first digit. + prec = mopt % 10; // double, float, int, etc. + mopt /= 10; // Eliminate second digit. + order = mopt % 10; // Row or column major ordering. + mopt /= 10; // Eliminate third digit. + mach = mopt % 10; // IEEE, VAX, etc. + + flt_fmt = mopt_digit_to_float_format (mach); + + if (flt_fmt == oct_mach_info::flt_fmt_unknown) + { + error ("load: unrecognized binary format!"); + return retval; + } + + if (imag && type == 1) + { + error ("load: encountered complex matrix with string flag set!"); + return retval; + } + + // LEN includes the terminating character, and the file is also + // supposed to include it, but apparently not all files do. Either + // way, I think this should work. + + { + OCTAVE_LOCAL_BUFFER (char, name, len+1); + name[len] = '\0'; + if (! is.read (name, len)) + goto data_read_error; + retval = name; + + dlen = nr * nc; + if (dlen < 0) + goto data_read_error; + + if (order) + { + octave_idx_type tmp = nr; + nr = nc; + nc = tmp; + } + + if (type == 2) + { + if (nc == 4) + { + octave_idx_type nr_new, nc_new; + Array data (dim_vector (1, nr - 1)); + Array c (dim_vector (1, nr - 1)); + Array r (dim_vector (1, nr - 1)); + OCTAVE_LOCAL_BUFFER (double, dtmp, nr); + OCTAVE_LOCAL_BUFFER (double, ctmp, nr); + + read_mat_binary_data (is, dtmp, prec, nr, swap, flt_fmt); + for (octave_idx_type i = 0; i < nr - 1; i++) + r.xelem (i) = dtmp[i] - 1; + nr_new = dtmp[nr - 1]; + read_mat_binary_data (is, dtmp, prec, nr, swap, flt_fmt); + for (octave_idx_type i = 0; i < nr - 1; i++) + c.xelem (i) = dtmp[i] - 1; + nc_new = dtmp[nr - 1]; + read_mat_binary_data (is, dtmp, prec, nr - 1, swap, flt_fmt); + read_mat_binary_data (is, ctmp, prec, 1, swap, flt_fmt); + read_mat_binary_data (is, ctmp, prec, nr - 1, swap, flt_fmt); + + for (octave_idx_type i = 0; i < nr - 1; i++) + data.xelem (i) = Complex (dtmp[i], ctmp[i]); + read_mat_binary_data (is, ctmp, prec, 1, swap, flt_fmt); + + SparseComplexMatrix smc = SparseComplexMatrix (data, r, c, + nr_new, nc_new); + + tc = order ? smc.transpose () : smc; + } + else + { + octave_idx_type nr_new, nc_new; + Array data (dim_vector (1, nr - 1)); + Array c (dim_vector (1, nr - 1)); + Array r (dim_vector (1, nr - 1)); + OCTAVE_LOCAL_BUFFER (double, dtmp, nr); + + read_mat_binary_data (is, dtmp, prec, nr, swap, flt_fmt); + for (octave_idx_type i = 0; i < nr - 1; i++) + r.xelem (i) = dtmp[i] - 1; + nr_new = dtmp[nr - 1]; + read_mat_binary_data (is, dtmp, prec, nr, swap, flt_fmt); + for (octave_idx_type i = 0; i < nr - 1; i++) + c.xelem (i) = dtmp[i] - 1; + nc_new = dtmp[nr - 1]; + read_mat_binary_data (is, data.fortran_vec (), prec, nr - 1, swap, flt_fmt); + read_mat_binary_data (is, dtmp, prec, 1, swap, flt_fmt); + + SparseMatrix sm = SparseMatrix (data, r, c, nr_new, nc_new); + + tc = order ? sm.transpose () : sm; + } + } + else + { + re.resize (nr, nc); + + read_mat_binary_data (is, re.fortran_vec (), prec, dlen, swap, flt_fmt); + + if (! is || error_state) + { + error ("load: reading matrix data for '%s'", name); + goto data_read_error; + } + + if (imag) + { + Matrix im (nr, nc); + + read_mat_binary_data (is, im.fortran_vec (), prec, dlen, swap, + flt_fmt); + + if (! is || error_state) + { + error ("load: reading imaginary matrix data for '%s'", name); + goto data_read_error; + } + + ComplexMatrix ctmp (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + ctmp (i, j) = Complex (re (i, j), im (i, j)); + + tc = order ? ctmp.transpose () : ctmp; + } + else + tc = order ? re.transpose () : re; + + if (type == 1) + tc = tc.convert_to_str (false, true, '\''); + } + + return retval; + } + + data_read_error: + error ("load: trouble reading binary file '%s'", filename.c_str ()); + return retval; +} + +// Save the data from TC along with the corresponding NAME on stream OS +// in the MatLab version 4 binary format. + +bool +save_mat_binary_data (std::ostream& os, const octave_value& tc, + const std::string& name) +{ + int32_t mopt = 0; + + mopt += tc.is_sparse_type () ? 2 : tc.is_string () ? 1 : 0; + + oct_mach_info::float_format flt_fmt = + oct_mach_info::native_float_format ();; + + mopt += 1000 * float_format_to_mopt_digit (flt_fmt); + + os.write (reinterpret_cast (&mopt), 4); + + octave_idx_type len; + int32_t nr = tc.rows (); + + int32_t nc = tc.columns (); + + if (tc.is_sparse_type ()) + { + len = tc.nnz (); + uint32_t nnz = len + 1; + os.write (reinterpret_cast (&nnz), 4); + + uint32_t iscmplx = tc.is_complex_type () ? 4 : 3; + os.write (reinterpret_cast (&iscmplx), 4); + + uint32_t tmp = 0; + os.write (reinterpret_cast (&tmp), 4); + } + else + { + os.write (reinterpret_cast (&nr), 4); + os.write (reinterpret_cast (&nc), 4); + + int32_t imag = tc.is_complex_type () ? 1 : 0; + os.write (reinterpret_cast (&imag), 4); + + len = nr * nc; + } + + + // LEN includes the terminating character, and the file is also + // supposed to include it. + + int32_t name_len = name.length () + 1; + + os.write (reinterpret_cast (&name_len), 4); + os << name << '\0'; + + if (tc.is_string ()) + { + unwind_protect frame; + + charMatrix chm = tc.char_matrix_value (); + + octave_idx_type nrow = chm.rows (); + octave_idx_type ncol = chm.cols (); + + OCTAVE_LOCAL_BUFFER (double, buf, ncol*nrow); + + for (octave_idx_type i = 0; i < nrow; i++) + { + std::string tstr = chm.row_as_string (i); + const char *s = tstr.data (); + + for (octave_idx_type j = 0; j < ncol; j++) + buf[j*nrow+i] = static_cast (*s++ & 0x00FF); + } + os.write (reinterpret_cast (buf), nrow*ncol*sizeof (double)); + } + else if (tc.is_range ()) + { + Range r = tc.range_value (); + double base = r.base (); + double inc = r.inc (); + octave_idx_type nel = r.nelem (); + for (octave_idx_type i = 0; i < nel; i++) + { + double x = base + i * inc; + os.write (reinterpret_cast (&x), 8); + } + } + else if (tc.is_real_scalar ()) + { + double tmp = tc.double_value (); + os.write (reinterpret_cast (&tmp), 8); + } + else if (tc.is_sparse_type ()) + { + double ds; + OCTAVE_LOCAL_BUFFER (double, dtmp, len); + if (tc.is_complex_matrix ()) + { + SparseComplexMatrix m = tc.sparse_complex_matrix_value (); + + for (octave_idx_type i = 0; i < len; i++) + dtmp[i] = m.ridx (i) + 1; + os.write (reinterpret_cast (dtmp), 8 * len); + ds = nr; + os.write (reinterpret_cast (&ds), 8); + + octave_idx_type ii = 0; + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = m.cidx (j); i < m.cidx (j+1); i++) + dtmp[ii++] = j + 1; + os.write (reinterpret_cast (dtmp), 8 * len); + ds = nc; + os.write (reinterpret_cast (&ds), 8); + + for (octave_idx_type i = 0; i < len; i++) + dtmp[i] = std::real (m.data (i)); + os.write (reinterpret_cast (dtmp), 8 * len); + ds = 0.; + os.write (reinterpret_cast (&ds), 8); + + for (octave_idx_type i = 0; i < len; i++) + dtmp[i] = std::imag (m.data (i)); + os.write (reinterpret_cast (dtmp), 8 * len); + os.write (reinterpret_cast (&ds), 8); + } + else + { + SparseMatrix m = tc.sparse_matrix_value (); + + for (octave_idx_type i = 0; i < len; i++) + dtmp[i] = m.ridx (i) + 1; + os.write (reinterpret_cast (dtmp), 8 * len); + ds = nr; + os.write (reinterpret_cast (&ds), 8); + + octave_idx_type ii = 0; + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = m.cidx (j); i < m.cidx (j+1); i++) + dtmp[ii++] = j + 1; + os.write (reinterpret_cast (dtmp), 8 * len); + ds = nc; + os.write (reinterpret_cast (&ds), 8); + + os.write (reinterpret_cast (m.data ()), 8 * len); + ds = 0.; + os.write (reinterpret_cast (&ds), 8); + } + } + else if (tc.is_real_matrix ()) + { + Matrix m = tc.matrix_value (); + os.write (reinterpret_cast (m.data ()), 8 * len); + } + else if (tc.is_complex_scalar ()) + { + Complex tmp = tc.complex_value (); + os.write (reinterpret_cast (&tmp), 16); + } + else if (tc.is_complex_matrix ()) + { + ComplexMatrix m_cmplx = tc.complex_matrix_value (); + Matrix m = ::real (m_cmplx); + os.write (reinterpret_cast (m.data ()), 8 * len); + m = ::imag (m_cmplx); + os.write (reinterpret_cast (m.data ()), 8 * len); + } + else + gripe_wrong_type_arg ("save", tc, false); + + return os; +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/ls-mat4.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/ls-mat4.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,45 @@ +/* + +Copyright (C) 2003-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_ls_mat4_h) +#define octave_ls_mat4_h 1 + +extern oct_mach_info::float_format +mopt_digit_to_float_format (int mach); + +extern int +float_format_to_mopt_digit (oct_mach_info::float_format flt_fmt); + +extern int +read_mat_file_header (std::istream& is, bool& swap, int32_t& mopt, + int32_t& nr, int32_t& nc, int32_t& imag, + int32_t& len, int quiet = 0); + +extern std::string +read_mat_binary_data (std::istream& is, const std::string& filename, + octave_value& tc); + +extern bool +save_mat_binary_data (std::ostream& os, const octave_value& tc, + const std::string& name) ; + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/ls-mat5.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/ls-mat5.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,2745 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Author: James R. Van Zandt + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include +#include +#include +#include +#include +#include + +#include "byte-swap.h" +#include "data-conv.h" +#include "file-ops.h" +#include "glob-match.h" +#include "lo-mappers.h" +#include "mach-info.h" +#include "oct-env.h" +#include "oct-time.h" +#include "quit.h" +#include "str-vec.h" +#include "file-stat.h" +#include "oct-locbuf.h" + +#include "Cell.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "load-save.h" +#include "load-path.h" +#include "oct-obj.h" +#include "oct-map.h" +#include "ov-cell.h" +#include "ov-class.h" +#include "ov-fcn-inline.h" +#include "pager.h" +#include "pt-exp.h" +#include "sysdep.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" +#include "version.h" +#include "dMatrix.h" + +#include "ls-utils.h" +#include "ls-mat5.h" + +#include "parse.h" +#include "defaults.h" + +#ifdef HAVE_ZLIB +#include +#endif + +#define READ_PAD(is_small_data_element, l) ((is_small_data_element) ? 4 : (((l)+7)/8)*8) +#define PAD(l) (((l) > 0 && (l) <= 4) ? 4 : (((l)+7)/8)*8) +#define INT8(l) ((l) == miINT8 || (l) == miUINT8 || (l) == miUTF8) + + +// The subsystem data block +static octave_value subsys_ov; + +// FIXME -- the following enum values should be the same as the +// mxClassID values in mexproto.h, but it seems they have also changed +// over time. What is the correct way to handle this and maintain +// backward compatibility with old MAT files? For now, use +// "MAT_FILE_" instead of "mx" as the prefix for these names to avoid +// conflict with the mxClassID enum in mexproto.h. + +enum arrayclasstype + { + MAT_FILE_CELL_CLASS=1, // cell array + MAT_FILE_STRUCT_CLASS, // structure + MAT_FILE_OBJECT_CLASS, // object + MAT_FILE_CHAR_CLASS, // character array + MAT_FILE_SPARSE_CLASS, // sparse array + MAT_FILE_DOUBLE_CLASS, // double precision array + MAT_FILE_SINGLE_CLASS, // single precision floating point + MAT_FILE_INT8_CLASS, // 8 bit signed integer + MAT_FILE_UINT8_CLASS, // 8 bit unsigned integer + MAT_FILE_INT16_CLASS, // 16 bit signed integer + MAT_FILE_UINT16_CLASS, // 16 bit unsigned integer + MAT_FILE_INT32_CLASS, // 32 bit signed integer + MAT_FILE_UINT32_CLASS, // 32 bit unsigned integer + MAT_FILE_INT64_CLASS, // 64 bit signed integer + MAT_FILE_UINT64_CLASS, // 64 bit unsigned integer + MAT_FILE_FUNCTION_CLASS, // Function handle + MAT_FILE_WORKSPACE_CLASS // Workspace (undocumented) + }; + +// Read COUNT elements of data from IS in the format specified by TYPE, +// placing the result in DATA. If SWAP is TRUE, swap the bytes of +// each element before copying to DATA. FLT_FMT specifies the format +// of the data if we are reading floating point numbers. + +static void +read_mat5_binary_data (std::istream& is, double *data, + octave_idx_type count, bool swap, mat5_data_type type, + oct_mach_info::float_format flt_fmt) +{ + + switch (type) + { + case miINT8: + read_doubles (is, data, LS_CHAR, count, swap, flt_fmt); + break; + + case miUTF8: + case miUINT8: + read_doubles (is, data, LS_U_CHAR, count, swap, flt_fmt); + break; + + case miINT16: + read_doubles (is, data, LS_SHORT, count, swap, flt_fmt); + break; + + case miUTF16: + case miUINT16: + read_doubles (is, data, LS_U_SHORT, count, swap, flt_fmt); + break; + + case miINT32: + read_doubles (is, data, LS_INT, count, swap, flt_fmt); + break; + + case miUTF32: + case miUINT32: + read_doubles (is, data, LS_U_INT, count, swap, flt_fmt); + break; + + case miSINGLE: + read_doubles (is, data, LS_FLOAT, count, swap, flt_fmt); + break; + + case miRESERVE1: + break; + + case miDOUBLE: + read_doubles (is, data, LS_DOUBLE, count, swap, flt_fmt); + break; + + case miRESERVE2: + case miRESERVE3: + break; + + // FIXME -- how are the 64-bit cases supposed to work here? + case miINT64: + read_doubles (is, data, LS_LONG, count, swap, flt_fmt); + break; + + case miUINT64: + read_doubles (is, data, LS_U_LONG, count, swap, flt_fmt); + break; + + case miMATRIX: + default: + break; + } +} + +static void +read_mat5_binary_data (std::istream& is, float *data, + octave_idx_type count, bool swap, mat5_data_type type, + oct_mach_info::float_format flt_fmt) +{ + + switch (type) + { + case miINT8: + read_floats (is, data, LS_CHAR, count, swap, flt_fmt); + break; + + case miUTF8: + case miUINT8: + read_floats (is, data, LS_U_CHAR, count, swap, flt_fmt); + break; + + case miINT16: + read_floats (is, data, LS_SHORT, count, swap, flt_fmt); + break; + + case miUTF16: + case miUINT16: + read_floats (is, data, LS_U_SHORT, count, swap, flt_fmt); + break; + + case miINT32: + read_floats (is, data, LS_INT, count, swap, flt_fmt); + break; + + case miUTF32: + case miUINT32: + read_floats (is, data, LS_U_INT, count, swap, flt_fmt); + break; + + case miSINGLE: + read_floats (is, data, LS_FLOAT, count, swap, flt_fmt); + break; + + case miRESERVE1: + break; + + case miDOUBLE: + read_floats (is, data, LS_DOUBLE, count, swap, flt_fmt); + break; + + case miRESERVE2: + case miRESERVE3: + break; + + // FIXME -- how are the 64-bit cases supposed to work here? + case miINT64: + read_floats (is, data, LS_LONG, count, swap, flt_fmt); + break; + + case miUINT64: + read_floats (is, data, LS_U_LONG, count, swap, flt_fmt); + break; + + case miMATRIX: + default: + break; + } +} + +template +void +read_mat5_integer_data (std::istream& is, T *m, octave_idx_type count, + bool swap, mat5_data_type type) +{ + +#define READ_INTEGER_DATA(TYPE, swap, data, size, len, stream) \ + do \ + { \ + if (len > 0) \ + { \ + OCTAVE_LOCAL_BUFFER (TYPE, ptr, len); \ + stream.read (reinterpret_cast (ptr), size * len); \ + if (swap) \ + swap_bytes< size > (ptr, len); \ + for (octave_idx_type i = 0; i < len; i++) \ + data[i] = ptr[i]; \ + } \ + } \ + while (0) + + switch (type) + { + case miINT8: + READ_INTEGER_DATA (int8_t, swap, m, 1, count, is); + break; + + case miUINT8: + READ_INTEGER_DATA (uint8_t, swap, m, 1, count, is); + break; + + case miINT16: + READ_INTEGER_DATA (int16_t, swap, m, 2, count, is); + break; + + case miUINT16: + READ_INTEGER_DATA (uint16_t, swap, m, 2, count, is); + break; + + case miINT32: + READ_INTEGER_DATA (int32_t, swap, m, 4, count, is); + break; + + case miUINT32: + READ_INTEGER_DATA (uint32_t, swap, m, 4, count, is); + break; + + case miSINGLE: + case miRESERVE1: + case miDOUBLE: + case miRESERVE2: + case miRESERVE3: + break; + + case miINT64: + READ_INTEGER_DATA (int64_t, swap, m, 8, count, is); + break; + + case miUINT64: + READ_INTEGER_DATA (uint64_t, swap, m, 8, count, is); + break; + + case miMATRIX: + default: + break; + } + +#undef READ_INTEGER_DATA + +} + +template void +read_mat5_integer_data (std::istream& is, octave_int8 *m, + octave_idx_type count, bool swap, + mat5_data_type type); + +template void +read_mat5_integer_data (std::istream& is, octave_int16 *m, + octave_idx_type count, bool swap, + mat5_data_type type); + +template void +read_mat5_integer_data (std::istream& is, octave_int32 *m, + octave_idx_type count, bool swap, + mat5_data_type type); + +template void +read_mat5_integer_data (std::istream& is, octave_int64 *m, + octave_idx_type count, bool swap, + mat5_data_type type); + +template void +read_mat5_integer_data (std::istream& is, octave_uint8 *m, + octave_idx_type count, bool swap, + mat5_data_type type); + +template void +read_mat5_integer_data (std::istream& is, octave_uint16 *m, + octave_idx_type count, bool swap, + mat5_data_type type); + +template void +read_mat5_integer_data (std::istream& is, octave_uint32 *m, + octave_idx_type count, bool swap, + mat5_data_type type); + +template void +read_mat5_integer_data (std::istream& is, octave_uint64 *m, + octave_idx_type count, bool swap, + mat5_data_type type); + +template void +read_mat5_integer_data (std::istream& is, int *m, + octave_idx_type count, bool swap, + mat5_data_type type); + +#define OCTAVE_MAT5_INTEGER_READ(TYP) \ + { \ + TYP re (dims); \ + \ + std::streampos tmp_pos; \ + \ + if (read_mat5_tag (is, swap, type, len, is_small_data_element)) \ + { \ + error ("load: reading matrix data for '%s'", retval.c_str ()); \ + goto data_read_error; \ + } \ + \ + octave_idx_type n = re.numel (); \ + tmp_pos = is.tellg (); \ + read_mat5_integer_data (is, re.fortran_vec (), n, swap, \ + static_cast (type)); \ + \ + if (! is || error_state) \ + { \ + error ("load: reading matrix data for '%s'", retval.c_str ()); \ + goto data_read_error; \ + } \ + \ + is.seekg (tmp_pos + static_cast\ + (READ_PAD (is_small_data_element, len))); \ + \ + if (imag) \ + { \ + /* We don't handle imag integer types, convert to an array */ \ + NDArray im (dims); \ + \ + if (read_mat5_tag (is, swap, type, len, is_small_data_element)) \ + { \ + error ("load: reading matrix data for '%s'", \ + retval.c_str ()); \ + goto data_read_error; \ + } \ + \ + n = im.numel (); \ + read_mat5_binary_data (is, im.fortran_vec (), n, swap, \ + static_cast (type), flt_fmt); \ + \ + if (! is || error_state) \ + { \ + error ("load: reading imaginary matrix data for '%s'", \ + retval.c_str ()); \ + goto data_read_error; \ + } \ + \ + ComplexNDArray ctmp (dims); \ + \ + for (octave_idx_type i = 0; i < n; i++) \ + ctmp(i) = Complex (re(i).double_value (), im(i)); \ + \ + tc = ctmp; \ + } \ + else \ + tc = re; \ + } + +// Read one element tag from stream IS, +// place the type code in TYPE, the byte count in BYTES and true (false) to +// IS_SMALL_DATA_ELEMENT if the tag is 4 (8) bytes long. +// return nonzero on error +static int +read_mat5_tag (std::istream& is, bool swap, int32_t& type, int32_t& bytes, + bool& is_small_data_element) +{ + unsigned int upper; + int32_t temp; + + if (! is.read (reinterpret_cast (&temp), 4 )) + goto data_read_error; + + if (swap) + swap_bytes<4> (&temp); + + upper = (temp >> 16) & 0xffff; + type = temp & 0xffff; + + if (upper) + { + // "compressed" format + bytes = upper; + is_small_data_element = true; + } + else + { + if (! is.read (reinterpret_cast (&temp), 4 )) + goto data_read_error; + if (swap) + swap_bytes<4> (&temp); + bytes = temp; + is_small_data_element = false; + } + + return 0; + + data_read_error: + return 1; +} + +static void +read_int (std::istream& is, bool swap, int32_t& val) +{ + is.read (reinterpret_cast (&val), 4); + + if (swap) + swap_bytes<4> (&val); +} + +// Extract one data element (scalar, matrix, string, etc.) from stream +// IS and place it in TC, returning the name of the variable. +// +// The data is expected to be in Matlab's "Version 5" .mat format, +// though not all the features of that format are supported. +// +// FILENAME is used for error messages. + +std::string +read_mat5_binary_element (std::istream& is, const std::string& filename, + bool swap, bool& global, octave_value& tc) +{ + std::string retval; + + global = false; + + // NOTE: these are initialized here instead of closer to where they + // are first used to avoid errors from gcc about goto crossing + // initialization of variable. + + bool imag; + bool isclass = false; + bool logicalvar; + dim_vector dims; + enum arrayclasstype arrayclass; + int16_t number = *(reinterpret_cast("\x00\x01")); + octave_idx_type nzmax; + std::string classname; + + // MAT files always use IEEE floating point + oct_mach_info::float_format flt_fmt = oct_mach_info::flt_fmt_unknown; + if ((number == 1) ^ swap) + flt_fmt = oct_mach_info::flt_fmt_ieee_big_endian; + else + flt_fmt = oct_mach_info::flt_fmt_ieee_little_endian; + + // element type, length and small data element flag + int32_t type = 0; + int32_t element_length; + bool is_small_data_element; + if (read_mat5_tag (is, swap, type, element_length, is_small_data_element)) + return retval; // EOF + + if (type == miCOMPRESSED) + { +#ifdef HAVE_ZLIB + // If C++ allowed us direct access to the file descriptor of an + // ifstream in a uniform way, the code below could be vastly + // simplified, and additional copies of the data in memory + // wouldn't be needed. + + OCTAVE_LOCAL_BUFFER (char, inbuf, element_length); + is.read (inbuf, element_length); + + // We uncompress the first 8 bytes of the header to get the buffer length + // This will fail with an error Z_MEM_ERROR + uLongf destLen = 8; + OCTAVE_LOCAL_BUFFER (unsigned int, tmp, 2); + if (uncompress (reinterpret_cast (tmp), &destLen, + reinterpret_cast (inbuf), element_length) + != Z_MEM_ERROR) + { + // Why should I have to initialize outbuf as I'll just overwrite!! + if (swap) + swap_bytes<4> (tmp, 2); + + destLen = tmp[1] + 8; + std::string outbuf (destLen, ' '); + + // FIXME -- find a way to avoid casting away const here! + + int err = uncompress (reinterpret_cast (const_cast (outbuf.c_str ())), + &destLen, reinterpret_cast (inbuf), + element_length); + + if (err != Z_OK) + { + std::string msg; + switch (err) + { + case Z_STREAM_END: + msg = "stream end"; + break; + + case Z_NEED_DICT: + msg = "need dict"; + break; + + case Z_ERRNO: + msg = "errno case"; + break; + + case Z_STREAM_ERROR: + msg = "stream error"; + break; + + case Z_DATA_ERROR: + msg = "data error"; + break; + + case Z_MEM_ERROR: + msg = "mem error"; + break; + + case Z_BUF_ERROR: + msg = "buf error"; + break; + + case Z_VERSION_ERROR: + msg = "version error"; + break; + } + + error ("load: error uncompressing data element (%s from zlib)", + msg.c_str ()); + } + else + { + std::istringstream gz_is (outbuf); + retval = read_mat5_binary_element (gz_is, filename, + swap, global, tc); + } + } + else + error ("load: error probing size of compressed data element"); + + return retval; +#else // HAVE_ZLIB + error ("load: zlib unavailable, cannot read compressed data element"); +#endif + } + + std::streampos pos; + + if (type != miMATRIX) + { + pos = is.tellg (); + error ("load: invalid element type = %d", type); + goto early_read_error; + } + + if (element_length == 0) + { + tc = Matrix (); + return retval; + } + + pos = is.tellg (); + + // array flags subelement + int32_t len; + if (read_mat5_tag (is, swap, type, len, is_small_data_element) || + type != miUINT32 || len != 8 || is_small_data_element) + { + error ("load: invalid array flags subelement"); + goto early_read_error; + } + + int32_t flags; + read_int (is, swap, flags); + + imag = (flags & 0x0800) != 0; // has an imaginary part? + + global = (flags & 0x0400) != 0; // global variable? + + logicalvar = (flags & 0x0200) != 0; // boolean ? + + arrayclass = static_cast (flags & 0xff); + + int32_t tmp_nzmax; + read_int (is, swap, tmp_nzmax); // max number of non-zero in sparse + nzmax = tmp_nzmax; + + // dimensions array subelement + if (arrayclass != MAT_FILE_WORKSPACE_CLASS) + { + int32_t dim_len; + + if (read_mat5_tag (is, swap, type, dim_len, is_small_data_element) || + type != miINT32) + { + error ("load: invalid dimensions array subelement"); + goto early_read_error; + } + + int ndims = dim_len / 4; + dims.resize (ndims); + for (int i = 0; i < ndims; i++) + { + int32_t n; + read_int (is, swap, n); + dims(i) = n; + } + + std::streampos tmp_pos = is.tellg (); + is.seekg (tmp_pos + static_cast + (READ_PAD (is_small_data_element, dim_len) - dim_len)); + } + else + { + // Why did mathworks decide to not have dims for a workspace!!! + dims.resize (2); + dims(0) = 1; + dims(1) = 1; + } + + if (read_mat5_tag (is, swap, type, len, is_small_data_element) || !INT8(type)) + { + error ("load: invalid array name subelement"); + goto early_read_error; + } + + { + OCTAVE_LOCAL_BUFFER (char, name, len+1); + + // Structure field subelements have zero-length array name subelements. + + std::streampos tmp_pos = is.tellg (); + + if (len) + { + if (! is.read (name, len )) + goto data_read_error; + + is.seekg (tmp_pos + static_cast + (READ_PAD (is_small_data_element, len))); + } + + name[len] = '\0'; + retval = name; + } + + switch (arrayclass) + { + case MAT_FILE_CELL_CLASS: + { + Cell cell_array (dims); + + octave_idx_type n = cell_array.numel (); + + for (octave_idx_type i = 0; i < n; i++) + { + octave_value tc2; + + std::string nm + = read_mat5_binary_element (is, filename, swap, global, tc2); + + if (! is || error_state) + { + error ("load: reading cell data for '%s'", nm.c_str ()); + goto data_read_error; + } + + cell_array(i) = tc2; + } + + tc = cell_array; + } + break; + + case MAT_FILE_SPARSE_CLASS: + { + octave_idx_type nr = dims(0); + octave_idx_type nc = dims(1); + SparseMatrix sm; + SparseComplexMatrix scm; + octave_idx_type *ridx; + octave_idx_type *cidx; + double *data; + + // Setup return value + if (imag) + { + scm = SparseComplexMatrix (nr, nc, nzmax); + ridx = scm.ridx (); + cidx = scm.cidx (); + data = 0; + } + else + { + sm = SparseMatrix (nr, nc, nzmax); + ridx = sm.ridx (); + cidx = sm.cidx (); + data = sm.data (); + } + + // row indices + std::streampos tmp_pos; + + if (read_mat5_tag (is, swap, type, len, is_small_data_element)) + { + error ("load: reading sparse row data for '%s'", retval.c_str ()); + goto data_read_error; + } + + tmp_pos = is.tellg (); + + read_mat5_integer_data (is, ridx, nzmax, swap, + static_cast (type)); + + if (! is || error_state) + { + error ("load: reading sparse row data for '%s'", retval.c_str ()); + goto data_read_error; + } + + is.seekg (tmp_pos + static_cast + (READ_PAD (is_small_data_element, len))); + + // col indices + if (read_mat5_tag (is, swap, type, len, is_small_data_element)) + { + error ("load: reading sparse column data for '%s'", retval.c_str ()); + goto data_read_error; + } + + tmp_pos = is.tellg (); + + read_mat5_integer_data (is, cidx, nc + 1, swap, + static_cast (type)); + + if (! is || error_state) + { + error ("load: reading sparse column data for '%s'", retval.c_str ()); + goto data_read_error; + } + + is.seekg (tmp_pos + static_cast + (READ_PAD (is_small_data_element, len))); + + // real data subelement + if (read_mat5_tag (is, swap, type, len, is_small_data_element)) + { + error ("load: reading sparse matrix data for '%s'", retval.c_str ()); + goto data_read_error; + } + + octave_idx_type nnz = cidx[nc]; + NDArray re; + if (imag) + { + re = NDArray (dim_vector (nnz, 1)); + data = re.fortran_vec (); + } + + tmp_pos = is.tellg (); + read_mat5_binary_data (is, data, nnz, swap, + static_cast (type), flt_fmt); + + if (! is || error_state) + { + error ("load: reading sparse matrix data for '%s'", retval.c_str ()); + goto data_read_error; + } + + is.seekg (tmp_pos + static_cast + (READ_PAD (is_small_data_element, len))); + + // imaginary data subelement + if (imag) + { + NDArray im (dim_vector (static_cast (nnz), 1)); + + if (read_mat5_tag (is, swap, type, len, is_small_data_element)) + { + error ("load: reading sparse matrix data for '%s'", retval.c_str ()); + goto data_read_error; + } + + read_mat5_binary_data (is, im.fortran_vec (), nnz, swap, + static_cast (type), flt_fmt); + + if (! is || error_state) + { + error ("load: reading imaginary sparse matrix data for '%s'", + retval.c_str ()); + goto data_read_error; + } + + for (octave_idx_type i = 0; i < nnz; i++) + scm.xdata (i) = Complex (re (i), im (i)); + + tc = scm; + } + else + tc = sm; + } + break; + + case MAT_FILE_FUNCTION_CLASS: + { + octave_value tc2; + std::string nm + = read_mat5_binary_element (is, filename, swap, global, tc2); + + if (! is || error_state) + goto data_read_error; + + // Octave can handle both "/" and "\" as a directory seperator + // and so can ignore the separator field of m0. I think the + // sentinel field is also save to ignore. + octave_scalar_map m0 = tc2.scalar_map_value (); + octave_scalar_map m1 = m0.contents ("function_handle").scalar_map_value (); + std::string ftype = m1.contents ("type").string_value (); + std::string fname = m1.contents ("function").string_value (); + std::string fpath = m1.contents ("file").string_value (); + + if (ftype == "simple" || ftype == "scopedfunction") + { + if (fpath.length () == 0) + // We have a builtin function + tc = make_fcn_handle (fname); + else + { + std::string mroot = + m0.contents ("matlabroot").string_value (); + + if ((fpath.length () >= mroot.length ()) && + fpath.substr (0, mroot.length ()) == mroot && + OCTAVE_EXEC_PREFIX != mroot) + { + // If fpath starts with matlabroot, and matlabroot + // doesn't equal octave_config_info ("exec_prefix") + // then the function points to a version of Octave + // or Matlab other than the running version. In that + // case we replace with the same function in the + // running version of Octave? + + // First check if just replacing matlabroot is enough + std::string str = OCTAVE_EXEC_PREFIX + + fpath.substr (mroot.length ()); + file_stat fs (str); + + if (fs.exists ()) + { + size_t xpos + = str.find_last_of (file_ops::dir_sep_chars ()); + + std::string dir_name = str.substr (0, xpos); + + octave_function *fcn + = load_fcn_from_file (str, dir_name, "", fname); + + if (fcn) + { + octave_value tmp (fcn); + + tc = octave_value (new octave_fcn_handle (tmp, fname)); + } + } + else + { + // Next just search for it anywhere in the system path + string_vector names(3); + names(0) = fname + ".oct"; + names(1) = fname + ".mex"; + names(2) = fname + ".m"; + + dir_path p (load_path::system_path ()); + + str = octave_env::make_absolute (p.find_first_of (names)); + + size_t xpos + = str.find_last_of (file_ops::dir_sep_chars ()); + + std::string dir_name = str.substr (0, xpos); + + octave_function *fcn + = load_fcn_from_file (str, dir_name, "", fname); + + if (fcn) + { + octave_value tmp (fcn); + + tc = octave_value (new octave_fcn_handle (tmp, fname)); + } + else + { + warning ("load: can't find the file %s", + fpath.c_str ()); + goto skip_ahead; + } + } + } + else + { + size_t xpos + = fpath.find_last_of (file_ops::dir_sep_chars ()); + + std::string dir_name = fpath.substr (0, xpos); + + octave_function *fcn + = load_fcn_from_file (fpath, dir_name, "", fname); + + if (fcn) + { + octave_value tmp (fcn); + + tc = octave_value (new octave_fcn_handle (tmp, fname)); + } + else + { + warning ("load: can't find the file %s", + fpath.c_str ()); + goto skip_ahead; + } + } + } + } + else if (ftype == "nested") + { + warning ("load: can't load nested function"); + goto skip_ahead; + } + else if (ftype == "anonymous") + { + octave_scalar_map m2 = m1.contents ("workspace").scalar_map_value (); + uint32NDArray MCOS = m2.contents ("MCOS").uint32_array_value (); + octave_idx_type off = static_cast(MCOS(4).double_value ()); + m2 = subsys_ov.scalar_map_value (); + m2 = m2.contents ("MCOS").scalar_map_value (); + tc2 = m2.contents ("MCOS").cell_value ()(1 + off).cell_value ()(1); + m2 = tc2.scalar_map_value (); + + unwind_protect_safe frame; + + // Set up temporary scope to use for evaluating the text + // that defines the anonymous function. + + symbol_table::scope_id local_scope = symbol_table::alloc_scope (); + frame.add_fcn (symbol_table::erase_scope, local_scope); + + symbol_table::set_scope (local_scope); + + octave_call_stack::push (local_scope, 0); + frame.add_fcn (octave_call_stack::pop); + + if (m2.nfields () > 0) + { + octave_value tmp; + + for (octave_map::iterator p0 = m2.begin () ; + p0 != m2.end (); p0++) + { + std::string key = m2.key (p0); + octave_value val = m2.contents (p0); + + symbol_table::assign (key, val, local_scope, 0); + } + } + + int parse_status; + octave_value anon_fcn_handle = + eval_string (fname.substr (4), true, parse_status); + + if (parse_status == 0) + { + octave_fcn_handle *fh = + anon_fcn_handle.fcn_handle_value (); + + if (fh) + tc = new octave_fcn_handle (fh->fcn_val (), "@"); + else + { + error ("load: failed to load anonymous function handle"); + goto skip_ahead; + } + } + else + { + error ("load: failed to load anonymous function handle"); + goto skip_ahead; + } + + frame.run (); + } + else + { + error ("load: invalid function handle type"); + goto skip_ahead; + } + } + break; + + case MAT_FILE_WORKSPACE_CLASS: + { + octave_map m (dim_vector (1, 1)); + int n_fields = 2; + string_vector field (n_fields); + + for (int i = 0; i < n_fields; i++) + { + int32_t fn_type; + int32_t fn_len; + if (read_mat5_tag (is, swap, fn_type, fn_len, is_small_data_element) + || !INT8(fn_type)) + { + error ("load: invalid field name subelement"); + goto data_read_error; + } + + OCTAVE_LOCAL_BUFFER (char, elname, fn_len + 1); + + std::streampos tmp_pos = is.tellg (); + + if (fn_len) + { + if (! is.read (elname, fn_len)) + goto data_read_error; + + is.seekg (tmp_pos + static_cast + (READ_PAD (is_small_data_element, fn_len))); + } + + elname[fn_len] = '\0'; + + field(i) = elname; + } + + std::vector elt (n_fields); + + for (octave_idx_type i = 0; i < n_fields; i++) + elt[i] = Cell (dims); + + octave_idx_type n = dims.numel (); + + // fields subelements + for (octave_idx_type j = 0; j < n; j++) + { + for (octave_idx_type i = 0; i < n_fields; i++) + { + if (field(i) == "MCOS") + { + octave_value fieldtc; + read_mat5_binary_element (is, filename, swap, global, + fieldtc); + if (! is || error_state) + goto data_read_error; + + elt[i](j) = fieldtc; + } + else + elt[i](j) = octave_value (); + } + } + + for (octave_idx_type i = 0; i < n_fields; i++) + m.assign (field (i), elt[i]); + tc = m; + } + break; + + case MAT_FILE_OBJECT_CLASS: + { + isclass = true; + + if (read_mat5_tag (is, swap, type, len, is_small_data_element) || + !INT8(type)) + { + error ("load: invalid class name"); + goto skip_ahead; + } + + { + OCTAVE_LOCAL_BUFFER (char, name, len+1); + + std::streampos tmp_pos = is.tellg (); + + if (len) + { + if (! is.read (name, len )) + goto data_read_error; + + is.seekg (tmp_pos + static_cast + (READ_PAD (is_small_data_element, len))); + } + + name[len] = '\0'; + classname = name; + } + } + // Fall-through + case MAT_FILE_STRUCT_CLASS: + { + octave_map m (dims); + int32_t fn_type; + int32_t fn_len; + int32_t field_name_length; + + // field name length subelement -- actually the maximum length + // of a field name. The Matlab docs promise this will always + // be 32. We read and use the actual value, on the theory + // that eventually someone will recognize that's a waste of space. + if (read_mat5_tag (is, swap, fn_type, fn_len, is_small_data_element) + || fn_type != miINT32) + { + error ("load: invalid field name length subelement"); + goto data_read_error; + } + + if (! is.read (reinterpret_cast (&field_name_length), fn_len )) + goto data_read_error; + + if (swap) + swap_bytes<4> (&field_name_length); + + // field name subelement. The length of this subelement tells + // us how many fields there are. + if (read_mat5_tag (is, swap, fn_type, fn_len, is_small_data_element) + || !INT8(fn_type)) + { + error ("load: invalid field name subelement"); + goto data_read_error; + } + + octave_idx_type n_fields = fn_len/field_name_length; + + if (n_fields > 0) + { + fn_len = READ_PAD (is_small_data_element, fn_len); + + OCTAVE_LOCAL_BUFFER (char, elname, fn_len); + + if (! is.read (elname, fn_len)) + goto data_read_error; + + std::vector elt (n_fields); + + for (octave_idx_type i = 0; i < n_fields; i++) + elt[i] = Cell (dims); + + octave_idx_type n = dims.numel (); + + // fields subelements + for (octave_idx_type j = 0; j < n; j++) + { + for (octave_idx_type i = 0; i < n_fields; i++) + { + octave_value fieldtc; + read_mat5_binary_element (is, filename, swap, global, + fieldtc); + elt[i](j) = fieldtc; + } + } + + for (octave_idx_type i = 0; i < n_fields; i++) + { + const char *key = elname + i*field_name_length; + + m.assign (key, elt[i]); + } + } + + if (isclass) + { + if (classname == "inline") + { + // inline is not an object in Octave but rather an + // overload of a function handle. Special case. + tc = + new octave_fcn_inline (m.contents ("expr")(0).string_value (), + m.contents ("args")(0).string_value ()); + } + else + { + octave_class* cls + = new octave_class (m, classname, + std::list ()); + + if (cls->reconstruct_exemplar ()) + { + + if (! cls->reconstruct_parents ()) + warning ("load: unable to reconstruct object inheritance"); + + tc = cls; + if (load_path::find_method (classname, "loadobj") != + std::string ()) + { + octave_value_list tmp = feval ("loadobj", tc, 1); + + if (! error_state) + tc = tmp(0); + else + goto data_read_error; + } + } + else + { + tc = m; + warning ("load: element has been converted to a structure"); + } + } + } + else + tc = m; + } + break; + + case MAT_FILE_INT8_CLASS: + OCTAVE_MAT5_INTEGER_READ (int8NDArray); + break; + + case MAT_FILE_UINT8_CLASS: + { + OCTAVE_MAT5_INTEGER_READ (uint8NDArray); + + // Logical variables can either be MAT_FILE_UINT8_CLASS or + // MAT_FILE_DOUBLE_CLASS, so check if we have a logical + // variable and convert it. + + if (logicalvar) + { + uint8NDArray in = tc.uint8_array_value (); + octave_idx_type nel = in.numel (); + boolNDArray out (dims); + + for (octave_idx_type i = 0; i < nel; i++) + out(i) = in(i).bool_value (); + + tc = out; + } + } + break; + + case MAT_FILE_INT16_CLASS: + OCTAVE_MAT5_INTEGER_READ (int16NDArray); + break; + + case MAT_FILE_UINT16_CLASS: + OCTAVE_MAT5_INTEGER_READ (uint16NDArray); + break; + + case MAT_FILE_INT32_CLASS: + OCTAVE_MAT5_INTEGER_READ (int32NDArray); + break; + + case MAT_FILE_UINT32_CLASS: + OCTAVE_MAT5_INTEGER_READ (uint32NDArray); + break; + + case MAT_FILE_INT64_CLASS: + OCTAVE_MAT5_INTEGER_READ (int64NDArray); + break; + + case MAT_FILE_UINT64_CLASS: + OCTAVE_MAT5_INTEGER_READ (uint64NDArray); + break; + + + case MAT_FILE_SINGLE_CLASS: + { + FloatNDArray re (dims); + + // real data subelement + + std::streampos tmp_pos; + + if (read_mat5_tag (is, swap, type, len, is_small_data_element)) + { + error ("load: reading matrix data for '%s'", retval.c_str ()); + goto data_read_error; + } + + octave_idx_type n = re.numel (); + tmp_pos = is.tellg (); + read_mat5_binary_data (is, re.fortran_vec (), n, swap, + static_cast (type), flt_fmt); + + if (! is || error_state) + { + error ("load: reading matrix data for '%s'", retval.c_str ()); + goto data_read_error; + } + + is.seekg (tmp_pos + static_cast + (READ_PAD (is_small_data_element, len))); + + if (imag) + { + // imaginary data subelement + + FloatNDArray im (dims); + + if (read_mat5_tag (is, swap, type, len, is_small_data_element)) + { + error ("load: reading matrix data for '%s'", retval.c_str ()); + goto data_read_error; + } + + n = im.numel (); + read_mat5_binary_data (is, im.fortran_vec (), n, swap, + static_cast (type), flt_fmt); + + if (! is || error_state) + { + error ("load: reading imaginary matrix data for '%s'", + retval.c_str ()); + goto data_read_error; + } + + FloatComplexNDArray ctmp (dims); + + for (octave_idx_type i = 0; i < n; i++) + ctmp(i) = FloatComplex (re(i), im(i)); + + tc = ctmp; + } + else + tc = re; + } + break; + + case MAT_FILE_CHAR_CLASS: + // handle as a numerical array to start with + + case MAT_FILE_DOUBLE_CLASS: + default: + { + NDArray re (dims); + + // real data subelement + + std::streampos tmp_pos; + + if (read_mat5_tag (is, swap, type, len, is_small_data_element)) + { + error ("load: reading matrix data for '%s'", retval.c_str ()); + goto data_read_error; + } + + octave_idx_type n = re.numel (); + tmp_pos = is.tellg (); + read_mat5_binary_data (is, re.fortran_vec (), n, swap, + static_cast (type), flt_fmt); + + if (! is || error_state) + { + error ("load: reading matrix data for '%s'", retval.c_str ()); + goto data_read_error; + } + + is.seekg (tmp_pos + static_cast + (READ_PAD (is_small_data_element, len))); + + if (logicalvar) + { + // Logical variables can either be MAT_FILE_UINT8_CLASS or + // MAT_FILE_DOUBLE_CLASS, so check if we have a logical + // variable and convert it. + + boolNDArray out (dims); + + for (octave_idx_type i = 0; i < n; i++) + out (i) = static_cast (re (i)); + + tc = out; + } + else if (imag) + { + // imaginary data subelement + + NDArray im (dims); + + if (read_mat5_tag (is, swap, type, len, is_small_data_element)) + { + error ("load: reading matrix data for '%s'", retval.c_str ()); + goto data_read_error; + } + + n = im.numel (); + read_mat5_binary_data (is, im.fortran_vec (), n, swap, + static_cast (type), flt_fmt); + + if (! is || error_state) + { + error ("load: reading imaginary matrix data for '%s'", + retval.c_str ()); + goto data_read_error; + } + + ComplexNDArray ctmp (dims); + + for (octave_idx_type i = 0; i < n; i++) + ctmp(i) = Complex (re(i), im(i)); + + tc = ctmp; + } + else + { + if (arrayclass == MAT_FILE_CHAR_CLASS) + { + if (type == miUTF16 || type == miUTF32) + { + bool found_big_char = false; + for (octave_idx_type i = 0; i < n; i++) + { + if (re(i) > 127) { + re(i) = '?'; + found_big_char = true; + } + } + + if (found_big_char) + warning ("load: can not read non-ASCII portions of UTF characters; replacing unreadable characters with '?'"); + } + else if (type == miUTF8) + { + // Search for multi-byte encoded UTF8 characters and + // replace with 0x3F for '?'... Give the user a warning + + bool utf8_multi_byte = false; + for (octave_idx_type i = 0; i < n; i++) + { + unsigned char a = static_cast (re(i)); + if (a > 0x7f) + utf8_multi_byte = true; + } + + if (utf8_multi_byte) + { + warning ("load: can not read multi-byte encoded UTF8 characters; replacing unreadable characters with '?'"); + for (octave_idx_type i = 0; i < n; i++) + { + unsigned char a = static_cast (re(i)); + if (a > 0x7f) + re(i) = '?'; + } + } + } + tc = re; + tc = tc.convert_to_str (false, true, '\''); + } + else + tc = re; + } + } + } + + is.seekg (pos + static_cast (element_length)); + + if (is.eof ()) + is.clear (); + + return retval; + + data_read_error: + early_read_error: + error ("load: trouble reading binary file '%s'", filename.c_str ()); + return std::string (); + + skip_ahead: + warning ("skipping over '%s'", retval.c_str ()); + is.seekg (pos + static_cast (element_length)); + return read_mat5_binary_element (is, filename, swap, global, tc); +} + +int +read_mat5_binary_file_header (std::istream& is, bool& swap, bool quiet, + const std::string& filename) +{ + int16_t version=0, magic=0; + uint64_t subsys_offset; + + is.seekg (116, std::ios::beg); + is.read (reinterpret_cast (&subsys_offset), 8); + + is.seekg (124, std::ios::beg); + is.read (reinterpret_cast (&version), 2); + is.read (reinterpret_cast (&magic), 2); + + if (magic == 0x4d49) + swap = 0; + else if (magic == 0x494d) + swap = 1; + else + { + if (! quiet) + error ("load: can't read binary file"); + return -1; + } + + if (! swap) // version number is inverse swapped! + version = ((version >> 8) & 0xff) + ((version & 0xff) << 8); + + if (version != 1 && !quiet) + warning ("load: found version %d binary MAT file, " + "but only prepared for version 1", version); + + if (swap) + swap_bytes<8> (&subsys_offset, 1); + + if (subsys_offset != 0x2020202020202020ULL && subsys_offset != 0ULL) + { + // Read the subsystem data block + is.seekg (subsys_offset, std::ios::beg); + + octave_value tc; + bool global; + read_mat5_binary_element (is, filename, swap, global, tc); + + if (!is || error_state) + return -1; + + if (tc.is_uint8_type ()) + { + const uint8NDArray itmp = tc.uint8_array_value (); + octave_idx_type ilen = itmp.numel (); + + // Why should I have to initialize outbuf as just overwrite + std::string outbuf (ilen - 7, ' '); + + // FIXME -- find a way to avoid casting away const here + char *ctmp = const_cast (outbuf.c_str ()); + for (octave_idx_type j = 8; j < ilen; j++) + ctmp[j-8] = itmp(j).char_value (); + + std::istringstream fh_ws (outbuf); + + read_mat5_binary_element (fh_ws, filename, swap, global, subsys_ov); + + if (error_state) + return -1; + } + else + return -1; + + // Reposition to just after the header + is.seekg (128, std::ios::beg); + } + + return 0; +} + +static int +write_mat5_tag (std::ostream& is, int type, octave_idx_type bytes) +{ + int32_t temp; + + if (bytes > 0 && bytes <= 4) + temp = (bytes << 16) + type; + else + { + temp = type; + if (! is.write (reinterpret_cast (&temp), 4)) + goto data_write_error; + temp = bytes; + } + + if (! is.write (reinterpret_cast (&temp), 4)) + goto data_write_error; + + return 0; + + data_write_error: + return 1; +} + +// Have to use copy here to avoid writing over data accessed via +// Matrix::data(). + +#define MAT5_DO_WRITE(TYPE, data, count, stream) \ + do \ + { \ + OCTAVE_LOCAL_BUFFER (TYPE, ptr, count); \ + for (octave_idx_type i = 0; i < count; i++) \ + ptr[i] = static_cast (data[i]); \ + stream.write (reinterpret_cast (ptr), count * sizeof (TYPE)); \ + } \ + while (0) + +// write out the numeric values in M to OS, +// preceded by the appropriate tag. +static void +write_mat5_array (std::ostream& os, const NDArray& m, bool save_as_floats) +{ + save_type st = LS_DOUBLE; + const double *data = m.data (); + + if (save_as_floats) + { + if (m.too_large_for_float ()) + { + warning ("save: some values too large to save as floats --"); + warning ("save: saving as doubles instead"); + } + else + st = LS_FLOAT; + } + + double max_val, min_val; + if (m.all_integers (max_val, min_val)) + st = get_save_type (max_val, min_val); + + mat5_data_type mst; + int size; + switch (st) + { + default: + case LS_DOUBLE: mst = miDOUBLE; size = 8; break; + case LS_FLOAT: mst = miSINGLE; size = 4; break; + case LS_U_CHAR: mst = miUINT8; size = 1; break; + case LS_U_SHORT: mst = miUINT16; size = 2; break; + case LS_U_INT: mst = miUINT32; size = 4; break; + case LS_CHAR: mst = miINT8; size = 1; break; + case LS_SHORT: mst = miINT16; size = 2; break; + case LS_INT: mst = miINT32; size = 4; break; + } + + octave_idx_type nel = m.numel (); + octave_idx_type len = nel*size; + + write_mat5_tag (os, mst, len); + + { + switch (st) + { + case LS_U_CHAR: + MAT5_DO_WRITE (uint8_t, data, nel, os); + break; + + case LS_U_SHORT: + MAT5_DO_WRITE (uint16_t, data, nel, os); + break; + + case LS_U_INT: + MAT5_DO_WRITE (uint32_t, data, nel, os); + break; + + case LS_U_LONG: + MAT5_DO_WRITE (uint64_t, data, nel, os); + break; + + case LS_CHAR: + MAT5_DO_WRITE (int8_t, data, nel, os); + break; + + case LS_SHORT: + MAT5_DO_WRITE (int16_t, data, nel, os); + break; + + case LS_INT: + MAT5_DO_WRITE (int32_t, data, nel, os); + break; + + case LS_LONG: + MAT5_DO_WRITE (int64_t, data, nel, os); + break; + + case LS_FLOAT: + MAT5_DO_WRITE (float, data, nel, os); + break; + + case LS_DOUBLE: // No conversion necessary. + os.write (reinterpret_cast (data), len); + break; + + default: + (*current_liboctave_error_handler) + ("unrecognized data format requested"); + break; + } + } + if (PAD (len) > len) + { + static char buf[9]="\x00\x00\x00\x00\x00\x00\x00\x00"; + os.write (buf, PAD (len) - len); + } +} + +static void +write_mat5_array (std::ostream& os, const FloatNDArray& m, bool) +{ + save_type st = LS_FLOAT; + const float *data = m.data (); + + float max_val, min_val; + if (m.all_integers (max_val, min_val)) + st = get_save_type (max_val, min_val); + + mat5_data_type mst; + int size; + switch (st) + { + default: + case LS_DOUBLE: mst = miDOUBLE; size = 8; break; + case LS_FLOAT: mst = miSINGLE; size = 4; break; + case LS_U_CHAR: mst = miUINT8; size = 1; break; + case LS_U_SHORT: mst = miUINT16; size = 2; break; + case LS_U_INT: mst = miUINT32; size = 4; break; + case LS_CHAR: mst = miINT8; size = 1; break; + case LS_SHORT: mst = miINT16; size = 2; break; + case LS_INT: mst = miINT32; size = 4; break; + } + + octave_idx_type nel = m.numel (); + octave_idx_type len = nel*size; + + write_mat5_tag (os, mst, len); + + { + switch (st) + { + case LS_U_CHAR: + MAT5_DO_WRITE (uint8_t, data, nel, os); + break; + + case LS_U_SHORT: + MAT5_DO_WRITE (uint16_t, data, nel, os); + break; + + case LS_U_INT: + MAT5_DO_WRITE (uint32_t, data, nel, os); + break; + + case LS_U_LONG: + MAT5_DO_WRITE (uint64_t, data, nel, os); + break; + + case LS_CHAR: + MAT5_DO_WRITE (int8_t, data, nel, os); + break; + + case LS_SHORT: + MAT5_DO_WRITE (int16_t, data, nel, os); + break; + + case LS_INT: + MAT5_DO_WRITE (int32_t, data, nel, os); + break; + + case LS_LONG: + MAT5_DO_WRITE (int64_t, data, nel, os); + break; + + case LS_FLOAT: // No conversion necessary. + os.write (reinterpret_cast (data), len); + break; + + case LS_DOUBLE: + MAT5_DO_WRITE (double, data, nel, os); + break; + + default: + (*current_liboctave_error_handler) + ("unrecognized data format requested"); + break; + } + } + if (PAD (len) > len) + { + static char buf[9]="\x00\x00\x00\x00\x00\x00\x00\x00"; + os.write (buf, PAD (len) - len); + } +} + +template +void +write_mat5_integer_data (std::ostream& os, const T *m, int size, + octave_idx_type nel) +{ + mat5_data_type mst; + unsigned len; + + switch (size) + { + case 1: + mst = miUINT8; + break; + case 2: + mst = miUINT16; + break; + case 4: + mst = miUINT32; + break; + case 8: + mst = miUINT64; + break; + case -1: + mst = miINT8; + size = - size; + break; + case -2: + mst = miINT16; + size = - size; + break; + case -4: + mst = miINT32; + size = - size; + break; + case -8: + default: + mst = miINT64; + size = - size; + break; + } + + len = nel*size; + write_mat5_tag (os, mst, len); + + os.write (reinterpret_cast (m), len); + + if (PAD (len) > len) + { + static char buf[9]="\x00\x00\x00\x00\x00\x00\x00\x00"; + os.write (buf, PAD (len) - len); + } +} + +template void +write_mat5_integer_data (std::ostream& os, const octave_int8 *m, + int size, octave_idx_type nel); + +template void +write_mat5_integer_data (std::ostream& os, const octave_int16 *m, + int size, octave_idx_type nel); + +template void +write_mat5_integer_data (std::ostream& os, const octave_int32 *m, + int size, octave_idx_type nel); + +template void +write_mat5_integer_data (std::ostream& os, const octave_int64 *m, + int size, octave_idx_type nel); + +template void +write_mat5_integer_data (std::ostream& os, const octave_uint8 *m, + int size, octave_idx_type nel); + +template void +write_mat5_integer_data (std::ostream& os, const octave_uint16 *m, + int size, octave_idx_type nel); + +template void +write_mat5_integer_data (std::ostream& os, const octave_uint32 *m, + int size, octave_idx_type nel); + +template void +write_mat5_integer_data (std::ostream& os, const octave_uint64 *m, + int size, octave_idx_type nel); + +template void +write_mat5_integer_data (std::ostream& os, const int *m, + int size, octave_idx_type nel); + +// Write out cell element values in the cell array to OS, preceded by +// the appropriate tag. + +static bool +write_mat5_cell_array (std::ostream& os, const Cell& cell, + bool mark_as_global, bool save_as_floats) +{ + octave_idx_type nel = cell.numel (); + + for (octave_idx_type i = 0; i < nel; i++) + { + octave_value ov = cell(i); + + if (! save_mat5_binary_element (os, ov, "", mark_as_global, + false, save_as_floats)) + return false; + } + + return true; +} + +int +save_mat5_array_length (const double* val, octave_idx_type nel, + bool save_as_floats) +{ + if (nel > 0) + { + int size = 8; + + if (save_as_floats) + { + bool too_large_for_float = false; + for (octave_idx_type i = 0; i < nel; i++) + { + double tmp = val[i]; + + if (! (xisnan (tmp) || xisinf (tmp)) + && fabs (tmp) > std::numeric_limits::max ()) + { + too_large_for_float = true; + break; + } + } + + if (!too_large_for_float) + size = 4; + } + + // The code below is disabled since get_save_type currently doesn't + // deal with integer types. This will need to be activated if get_save_type + // is changed. + + // double max_val = val[0]; + // double min_val = val[0]; + // bool all_integers = true; + // + // for (int i = 0; i < nel; i++) + // { + // double val = val[i]; + // + // if (val > max_val) + // max_val = val; + // + // if (val < min_val) + // min_val = val; + // + // if (D_NINT (val) != val) + // { + // all_integers = false; + // break; + // } + // } + // + // if (all_integers) + // { + // if (max_val < 256 && min_val > -1) + // size = 1; + // else if (max_val < 65536 && min_val > -1) + // size = 2; + // else if (max_val < 4294967295UL && min_val > -1) + // size = 4; + // else if (max_val < 128 && min_val >= -128) + // size = 1; + // else if (max_val < 32768 && min_val >= -32768) + // size = 2; + // else if (max_val <= 2147483647L && min_val >= -2147483647L) + // size = 4; + // } + + return 8 + nel * size; + } + else + return 8; +} + +int +save_mat5_array_length (const float* /* val */, octave_idx_type nel, bool) +{ + if (nel > 0) + { + int size = 4; + + + // The code below is disabled since get_save_type currently doesn't + // deal with integer types. This will need to be activated if get_save_type + // is changed. + + // float max_val = val[0]; + // float min_val = val[0]; + // bool all_integers = true; + // + // for (int i = 0; i < nel; i++) + // { + // float val = val[i]; + // + // if (val > max_val) + // max_val = val; + // + // if (val < min_val) + // min_val = val; + // + // if (D_NINT (val) != val) + // { + // all_integers = false; + // break; + // } + // } + // + // if (all_integers) + // { + // if (max_val < 256 && min_val > -1) + // size = 1; + // else if (max_val < 65536 && min_val > -1) + // size = 2; + // else if (max_val < 4294967295UL && min_val > -1) + // size = 4; + // else if (max_val < 128 && min_val >= -128) + // size = 1; + // else if (max_val < 32768 && min_val >= -32768) + // size = 2; + // else if (max_val <= 2147483647L && min_val >= -2147483647L) + // size = 4; + // } + + // Round nel up to nearest even number of elements. Take into account + // Short tags for 4 byte elements. + return PAD ((nel > 0 && nel * size <= 4 ? 4 : 8) + nel * size); + } + else + return 8; +} + +int +save_mat5_array_length (const Complex* val, octave_idx_type nel, + bool save_as_floats) +{ + int ret; + + OCTAVE_LOCAL_BUFFER (double, tmp, nel); + + for (octave_idx_type i = 1; i < nel; i++) + tmp[i] = std::real (val[i]); + + ret = save_mat5_array_length (tmp, nel, save_as_floats); + + for (octave_idx_type i = 1; i < nel; i++) + tmp[i] = std::imag (val[i]); + + ret += save_mat5_array_length (tmp, nel, save_as_floats); + + return ret; +} + +int +save_mat5_array_length (const FloatComplex* val, octave_idx_type nel, + bool save_as_floats) +{ + int ret; + + OCTAVE_LOCAL_BUFFER (float, tmp, nel); + + for (octave_idx_type i = 1; i < nel; i++) + tmp[i] = std::real (val[i]); + + ret = save_mat5_array_length (tmp, nel, save_as_floats); + + for (octave_idx_type i = 1; i < nel; i++) + tmp[i] = std::imag (val[i]); + + ret += save_mat5_array_length (tmp, nel, save_as_floats); + + return ret; +} + +int +save_mat5_element_length (const octave_value& tc, const std::string& name, + bool save_as_floats, bool mat7_format) +{ + size_t max_namelen = 63; + size_t len = name.length (); + std::string cname = tc.class_name (); + int ret = 32; + + if (len > 4) + ret += PAD (len > max_namelen ? max_namelen : len); + + ret += PAD (4 * tc.ndims ()); + + if (tc.is_string ()) + { + charNDArray chm = tc.char_array_value (); + ret += 8; + if (chm.numel () > 2) + ret += PAD (2 * chm.numel ()); + } + else if (tc.is_sparse_type ()) + { + if (tc.is_complex_type ()) + { + const SparseComplexMatrix m = tc.sparse_complex_matrix_value (); + octave_idx_type nc = m.cols (); + octave_idx_type nnz = m.nnz (); + + ret += 16 + save_mat5_array_length (m.data (), nnz, save_as_floats); + if (nnz > 1) + ret += PAD (nnz * sizeof (int32_t)); + if (nc > 0) + ret += PAD ((nc + 1) * sizeof (int32_t)); + } + else + { + const SparseMatrix m = tc.sparse_matrix_value (); + octave_idx_type nc = m.cols (); + octave_idx_type nnz = m.nnz (); + + ret += 16 + save_mat5_array_length (m.data (), nnz, save_as_floats); + if (nnz > 1) + ret += PAD (nnz * sizeof (int32_t)); + if (nc > 0) + ret += PAD ((nc + 1) * sizeof (int32_t)); + } + } + +#define INT_LEN(nel, size) \ + { \ + ret += 8; \ + octave_idx_type sz = nel * size; \ + if (sz > 4) \ + ret += PAD (sz); \ + } + + else if (cname == "int8") + INT_LEN (tc.int8_array_value ().numel (), 1) + else if (cname == "int16") + INT_LEN (tc.int16_array_value ().numel (), 2) + else if (cname == "int32") + INT_LEN (tc.int32_array_value ().numel (), 4) + else if (cname == "int64") + INT_LEN (tc.int64_array_value ().numel (), 8) + else if (cname == "uint8") + INT_LEN (tc.uint8_array_value ().numel (), 1) + else if (cname == "uint16") + INT_LEN (tc.uint16_array_value ().numel (), 2) + else if (cname == "uint32") + INT_LEN (tc.uint32_array_value ().numel (), 4) + else if (cname == "uint64") + INT_LEN (tc.uint64_array_value ().numel (), 8) + else if (tc.is_bool_type ()) + INT_LEN (tc.bool_array_value ().numel (), 1) + else if (tc.is_real_scalar () || tc.is_real_matrix () || tc.is_range ()) + { + if (tc.is_single_type ()) + { + const FloatNDArray m = tc.float_array_value (); + ret += save_mat5_array_length (m.fortran_vec (), m.numel (), + save_as_floats); + } + else + { + const NDArray m = tc.array_value (); + ret += save_mat5_array_length (m.fortran_vec (), m.numel (), + save_as_floats); + } + } + else if (tc.is_cell ()) + { + Cell cell = tc.cell_value (); + octave_idx_type nel = cell.numel (); + + for (int i = 0; i < nel; i++) + ret += 8 + + save_mat5_element_length (cell (i), "", save_as_floats, mat7_format); + } + else if (tc.is_complex_scalar () || tc.is_complex_matrix ()) + { + if (tc.is_single_type ()) + { + const FloatComplexNDArray m = tc.float_complex_array_value (); + ret += save_mat5_array_length (m.fortran_vec (), m.numel (), + save_as_floats); + } + else + { + const ComplexNDArray m = tc.complex_array_value (); + ret += save_mat5_array_length (m.fortran_vec (), m.numel (), + save_as_floats); + } + } + else if (tc.is_map () || tc.is_inline_function () || tc.is_object ()) + { + int fieldcnt = 0; + const octave_map m = tc.map_value (); + octave_idx_type nel = m.numel (); + + if (tc.is_inline_function ()) + // length of "inline" is 6 + ret += 8 + PAD (6 > max_namelen ? max_namelen : 6); + else if (tc.is_object ()) + { + size_t classlen = tc.class_name (). length (); + + ret += 8 + PAD (classlen > max_namelen ? max_namelen : classlen); + } + + for (octave_map::const_iterator i = m.begin (); i != m.end (); i++) + fieldcnt++; + + ret += 16 + fieldcnt * (max_namelen + 1); + + + for (octave_idx_type j = 0; j < nel; j++) + { + + for (octave_map::const_iterator i = m.begin (); i != m.end (); i++) + { + const Cell elts = m.contents (i); + + ret += 8 + save_mat5_element_length (elts(j), "", + save_as_floats, mat7_format); + } + } + } + else + ret = -1; + + return ret; +} + +static void +write_mat5_sparse_index_vector (std::ostream& os, + const octave_idx_type *idx, + octave_idx_type nel) +{ + int tmp = sizeof (int32_t); + + OCTAVE_LOCAL_BUFFER (int32_t, tmp_idx, nel); + + for (octave_idx_type i = 0; i < nel; i++) + tmp_idx[i] = idx[i]; + + write_mat5_integer_data (os, tmp_idx, -tmp, nel); +} + +static void +gripe_dim_too_large (const std::string& name) +{ + warning ("save: skipping %s: dimension too large for MAT format", + name.c_str ()); +} + +// save the data from TC along with the corresponding NAME on stream +// OS in the MatLab version 5 binary format. Return true on success. + +bool +save_mat5_binary_element (std::ostream& os, + const octave_value& tc, const std::string& name, + bool mark_as_global, bool mat7_format, + bool save_as_floats, bool compressing) +{ + int32_t flags = 0; + int32_t nnz_32 = 0; + std::string cname = tc.class_name (); + size_t max_namelen = 63; + + dim_vector dv = tc.dims (); + int nd = tc.ndims (); + int dim_len = 4*nd; + + static octave_idx_type max_dim_val = std::numeric_limits::max (); + + for (int i = 0; i < nd; i++) + { + if (dv(i) > max_dim_val) + { + gripe_dim_too_large (name); + goto skip_to_next; + } + } + + if (tc.is_sparse_type ()) + { + octave_idx_type nnz; + octave_idx_type nc; + + if (tc.is_complex_type ()) + { + SparseComplexMatrix scm = tc.sparse_complex_matrix_value (); + nnz = scm.nzmax (); + nc = scm.cols (); + } + else + { + SparseMatrix sm = tc.sparse_matrix_value (); + nnz = sm.nzmax (); + nc = sm.cols (); + } + + if (nnz > max_dim_val || nc + 1 > max_dim_val) + { + gripe_dim_too_large (name); + goto skip_to_next; + } + + nnz_32 = nnz; + } + else if (dv.numel () > max_dim_val) + { + gripe_dim_too_large (name); + goto skip_to_next; + } + +#ifdef HAVE_ZLIB + if (mat7_format && !compressing) + { + bool ret = false; + + std::ostringstream buf; + + // The code seeks backwards in the stream to fix the header. Can't + // do this with zlib, so use a stringstream. + ret = save_mat5_binary_element (buf, tc, name, mark_as_global, true, + save_as_floats, true); + + if (ret) + { + // destLen must be at least 0.1% larger than source buffer + // + 12 bytes. Reality is it must be larger again than that. + std::string buf_str = buf.str (); + uLongf srcLen = buf_str.length (); + uLongf destLen = srcLen * 101 / 100 + 12; + OCTAVE_LOCAL_BUFFER (char, out_buf, destLen); + + if (compress (reinterpret_cast (out_buf), &destLen, + reinterpret_cast (buf_str.c_str ()), srcLen) == Z_OK) + { + write_mat5_tag (os, miCOMPRESSED, + static_cast (destLen)); + + os.write (out_buf, destLen); + } + else + { + error ("save: error compressing data element"); + ret = false; + } + } + + return ret; + } +#endif + + write_mat5_tag (os, miMATRIX, save_mat5_element_length + (tc, name, save_as_floats, mat7_format)); + + // array flags subelement + write_mat5_tag (os, miUINT32, 8); + + if (tc.is_bool_type ()) + flags |= 0x0200; + + if (mark_as_global) + flags |= 0x0400; + + if (tc.is_complex_scalar () || tc.is_complex_matrix ()) + flags |= 0x0800; + + if (tc.is_string ()) + flags |= MAT_FILE_CHAR_CLASS; + else if (cname == "int8") + flags |= MAT_FILE_INT8_CLASS; + else if (cname == "int16") + flags |= MAT_FILE_INT16_CLASS; + else if (cname == "int32") + flags |= MAT_FILE_INT32_CLASS; + else if (cname == "int64") + flags |= MAT_FILE_INT64_CLASS; + else if (cname == "uint8" || tc.is_bool_type ()) + flags |= MAT_FILE_UINT8_CLASS; + else if (cname == "uint16") + flags |= MAT_FILE_UINT16_CLASS; + else if (cname == "uint32") + flags |= MAT_FILE_UINT32_CLASS; + else if (cname == "uint64") + flags |= MAT_FILE_UINT64_CLASS; + else if (tc.is_sparse_type ()) + flags |= MAT_FILE_SPARSE_CLASS; + else if (tc.is_real_scalar () || tc.is_real_matrix () || tc.is_range () + || tc.is_complex_scalar () || tc.is_complex_matrix ()) + { + if (tc.is_single_type ()) + flags |= MAT_FILE_SINGLE_CLASS; + else + flags |= MAT_FILE_DOUBLE_CLASS; + } + else if (tc.is_map ()) + flags |= MAT_FILE_STRUCT_CLASS; + else if (tc.is_cell ()) + flags |= MAT_FILE_CELL_CLASS; + else if (tc.is_inline_function () || tc.is_object ()) + flags |= MAT_FILE_OBJECT_CLASS; + else + { + gripe_wrong_type_arg ("save", tc, false); + goto error_cleanup; + } + + os.write (reinterpret_cast (&flags), 4); + // Matlab seems to have trouble reading files that have nzmax == 0 at + // this point in the file. + if (nnz_32 == 0) + nnz_32 = 1; + os.write (reinterpret_cast (&nnz_32), 4); + + write_mat5_tag (os, miINT32, dim_len); + + for (int i = 0; i < nd; i++) + { + int32_t n = dv(i); + os.write (reinterpret_cast (&n), 4); + } + + if (PAD (dim_len) > dim_len) + { + static char buf[9]="\x00\x00\x00\x00\x00\x00\x00\x00"; + os.write (buf, PAD (dim_len) - dim_len); + } + + // array name subelement + { + size_t namelen = name.length (); + + if (namelen > max_namelen) + namelen = max_namelen; // Truncate names if necessary + + int paddedlength = PAD (namelen); + + write_mat5_tag (os, miINT8, namelen); + OCTAVE_LOCAL_BUFFER (char, paddedname, paddedlength); + memset (paddedname, 0, paddedlength); + strncpy (paddedname, name.c_str (), namelen); + os.write (paddedname, paddedlength); + } + + // data element + if (tc.is_string ()) + { + charNDArray chm = tc.char_array_value (); + octave_idx_type nel = chm.numel (); + octave_idx_type len = nel*2; + octave_idx_type paddedlength = PAD (len); + + OCTAVE_LOCAL_BUFFER (int16_t, buf, nel+3); + write_mat5_tag (os, miUINT16, len); + + const char *s = chm.data (); + + for (octave_idx_type i = 0; i < nel; i++) + buf[i] = *s++ & 0x00FF; + + os.write (reinterpret_cast (buf), len); + + if (paddedlength > len) + { + static char padbuf[9]="\x00\x00\x00\x00\x00\x00\x00\x00"; + os.write (padbuf, paddedlength - len); + } + } + else if (tc.is_sparse_type ()) + { + if (tc.is_complex_type ()) + { + const SparseComplexMatrix m = tc.sparse_complex_matrix_value (); + octave_idx_type nnz = m.nnz (); + octave_idx_type nc = m.cols (); + + write_mat5_sparse_index_vector (os, m.ridx (), nnz); + write_mat5_sparse_index_vector (os, m.cidx (), nc + 1); + + NDArray buf (dim_vector (nnz, 1)); + + for (octave_idx_type i = 0; i < nnz; i++) + buf (i) = std::real (m.data (i)); + + write_mat5_array (os, buf, save_as_floats); + + for (octave_idx_type i = 0; i < nnz; i++) + buf (i) = std::imag (m.data (i)); + + write_mat5_array (os, buf, save_as_floats); + } + else + { + const SparseMatrix m = tc.sparse_matrix_value (); + octave_idx_type nnz = m.nnz (); + octave_idx_type nc = m.cols (); + + write_mat5_sparse_index_vector (os, m.ridx (), nnz); + write_mat5_sparse_index_vector (os, m.cidx (), nc + 1); + + // FIXME + // Is there a way to easily do without this buffer + NDArray buf (dim_vector (nnz, 1)); + + for (int i = 0; i < nnz; i++) + buf (i) = m.data (i); + + write_mat5_array (os, buf, save_as_floats); + } + } + else if (cname == "int8") + { + int8NDArray m = tc.int8_array_value (); + + write_mat5_integer_data (os, m.fortran_vec (), -1, m.numel ()); + } + else if (cname == "int16") + { + int16NDArray m = tc.int16_array_value (); + + write_mat5_integer_data (os, m.fortran_vec (), -2, m.numel ()); + } + else if (cname == "int32") + { + int32NDArray m = tc.int32_array_value (); + + write_mat5_integer_data (os, m.fortran_vec (), -4, m.numel ()); + } + else if (cname == "int64") + { + int64NDArray m = tc.int64_array_value (); + + write_mat5_integer_data (os, m.fortran_vec (), -8, m.numel ()); + } + else if (cname == "uint8") + { + uint8NDArray m = tc.uint8_array_value (); + + write_mat5_integer_data (os, m.fortran_vec (), 1, m.numel ()); + } + else if (cname == "uint16") + { + uint16NDArray m = tc.uint16_array_value (); + + write_mat5_integer_data (os, m.fortran_vec (), 2, m.numel ()); + } + else if (cname == "uint32") + { + uint32NDArray m = tc.uint32_array_value (); + + write_mat5_integer_data (os, m.fortran_vec (), 4, m.numel ()); + } + else if (cname == "uint64") + { + uint64NDArray m = tc.uint64_array_value (); + + write_mat5_integer_data (os, m.fortran_vec (), 8, m.numel ()); + } + else if (tc.is_bool_type ()) + { + uint8NDArray m (tc.bool_array_value ()); + + write_mat5_integer_data (os, m.fortran_vec (), 1, m.numel ()); + } + else if (tc.is_real_scalar () || tc.is_real_matrix () || tc.is_range ()) + { + if (tc.is_single_type ()) + { + FloatNDArray m = tc.float_array_value (); + + write_mat5_array (os, m, save_as_floats); + } + else + { + NDArray m = tc.array_value (); + + write_mat5_array (os, m, save_as_floats); + } + } + else if (tc.is_cell ()) + { + Cell cell = tc.cell_value (); + + if (! write_mat5_cell_array (os, cell, mark_as_global, save_as_floats)) + goto error_cleanup; + } + else if (tc.is_complex_scalar () || tc.is_complex_matrix ()) + { + if (tc.is_single_type ()) + { + FloatComplexNDArray m_cmplx = tc.float_complex_array_value (); + + write_mat5_array (os, ::real (m_cmplx), save_as_floats); + write_mat5_array (os, ::imag (m_cmplx), save_as_floats); + } + else + { + ComplexNDArray m_cmplx = tc.complex_array_value (); + + write_mat5_array (os, ::real (m_cmplx), save_as_floats); + write_mat5_array (os, ::imag (m_cmplx), save_as_floats); + } + } + else if (tc.is_map () || tc.is_inline_function () || tc.is_object ()) + { + if (tc.is_inline_function () || tc.is_object ()) + { + std::string classname = tc.is_object () ? tc.class_name () : "inline"; + size_t namelen = classname.length (); + + if (namelen > max_namelen) + namelen = max_namelen; // Truncate names if necessary + + int paddedlength = PAD (namelen); + + write_mat5_tag (os, miINT8, namelen); + OCTAVE_LOCAL_BUFFER (char, paddedname, paddedlength); + memset (paddedname, 0, paddedlength); + strncpy (paddedname, classname.c_str (), namelen); + os.write (paddedname, paddedlength); + } + + octave_map m; + + if (tc.is_object () && + load_path::find_method (tc.class_name (), "saveobj") != std::string ()) + { + octave_value_list tmp = feval ("saveobj", tc, 1); + if (! error_state) + m = tmp(0).map_value (); + else + goto error_cleanup; + } + else + m = tc.map_value (); + + // an Octave structure */ + // recursively write each element of the structure + { + char buf[64]; + int32_t maxfieldnamelength = max_namelen + 1; + + octave_idx_type nf = m.nfields (); + + write_mat5_tag (os, miINT32, 4); + os.write (reinterpret_cast (&maxfieldnamelength), 4); + write_mat5_tag (os, miINT8, nf*maxfieldnamelength); + + // Iterating over the list of keys will preserve the order of + // the fields. + string_vector keys = m.keys (); + + for (octave_idx_type i = 0; i < nf; i++) + { + std::string key = keys(i); + + // write the name of each element + memset (buf, 0, max_namelen + 1); + // only 31 or 63 char names permitted + strncpy (buf, key.c_str (), max_namelen); + os.write (buf, max_namelen + 1); + } + + octave_idx_type len = m.numel (); + + // Create temporary copy of structure contents to avoid + // multiple calls of the contents method. + std::vector elts (nf); + for (octave_idx_type i = 0; i < nf; i++) + elts[i] = m.contents (keys(i)).data (); + + for (octave_idx_type j = 0; j < len; j++) + { + // write the data of each element + + // Iterating over the list of keys will preserve the order + // of the fields. + for (octave_idx_type i = 0; i < nf; i++) + { + bool retval2 = save_mat5_binary_element (os, elts[i][j], "", + mark_as_global, + false, + save_as_floats); + if (! retval2) + goto error_cleanup; + } + } + } + } + else + gripe_wrong_type_arg ("save", tc, false); + + skip_to_next: + return true; + + error_cleanup: + error ("save: error while writing '%s' to MAT file", name.c_str ()); + + return false; +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/ls-mat5.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/ls-mat5.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,61 @@ +/* + +Copyright (C) 2003-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_ls_mat5_h) +#define octave_ls_mat5_h 1 + +enum mat5_data_type + { + miINT8 = 1, // 8 bit signed + miUINT8, // 8 bit unsigned + miINT16, // 16 bit signed + miUINT16, // 16 bit unsigned + miINT32, // 32 bit signed + miUINT32, // 32 bit unsigned + miSINGLE, // IEEE 754 single precision float + miRESERVE1, + miDOUBLE, // IEEE 754 double precision float + miRESERVE2, + miRESERVE3, + miINT64, // 64 bit signed + miUINT64, // 64 bit unsigned + miMATRIX, // MATLAB array + miCOMPRESSED, // Compressed data + miUTF8, // Unicode UTF-8 Encoded Character Data + miUTF16, // Unicode UTF-16 Encoded Character Data + miUTF32 // Unicode UTF-32 Encoded Character Data + }; + +extern int +read_mat5_binary_file_header (std::istream& is, bool& swap, + bool quiet = false, + const std::string& filename = std::string ()); +extern std::string +read_mat5_binary_element (std::istream& is, const std::string& filename, + bool swap, bool& global, octave_value& tc); +extern bool +save_mat5_binary_element (std::ostream& os, + const octave_value& tc, const std::string& name, + bool mark_as_global, bool mat7_format, + bool save_as_floats, bool compressing = false); + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/ls-oct-ascii.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/ls-oct-ascii.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,433 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Author: John W. Eaton. + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include +#include +#include +#include +#include + +#include "byte-swap.h" +#include "data-conv.h" +#include "file-ops.h" +#include "glob-match.h" +#include "lo-mappers.h" +#include "mach-info.h" +#include "oct-env.h" +#include "oct-time.h" +#include "quit.h" +#include "str-vec.h" + +#include "Cell.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "load-save.h" +#include "ls-ascii-helper.h" +#include "ls-oct-ascii.h" +#include "oct-obj.h" +#include "oct-map.h" +#include "ov-cell.h" +#include "pager.h" +#include "pt-exp.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" +#include "version.h" +#include "dMatrix.h" + +// The number of decimal digits to use when writing ascii data. +static int Vsave_precision = 16; + +// Functions for reading ascii data. + +// Extract a KEYWORD and its value from stream IS, returning the +// associated value in a new string. +// +// Input should look something like: +// +// [%#][ \t]*keyword[ \t]*:[ \t]*string-value[ \t]*\n + +std::string +extract_keyword (std::istream& is, const char *keyword, const bool next_only) +{ + std::string retval; + + int ch = is.peek (); + if (next_only && ch != '%' && ch != '#') + return retval; + + char c; + while (is.get (c)) + { + if (c == '%' || c == '#') + { + std::ostringstream buf; + + while (is.get (c) && (c == ' ' || c == '\t' || c == '%' || c == '#')) + ; // Skip whitespace and comment characters. + + if (isalpha (c)) + buf << c; + + while (is.get (c) && isalpha (c)) + buf << c; + + std::string tmp = buf.str (); + bool match = (tmp.compare (0, strlen (keyword), keyword) == 0); + + if (match) + { + std::ostringstream value; + while (is.get (c) && (c == ' ' || c == '\t' || c == ':')) + ; // Skip whitespace and the colon. + + is.putback (c); + retval = read_until_newline (is, false); + break; + } + else if (next_only) + break; + else + skip_until_newline (is, false); + } + } + + int len = retval.length (); + + if (len > 0) + { + while (len) + { + c = retval[len-1]; + + if (c == ' ' || c == '\t') + len--; + else + { + retval.resize (len); + break; + } + } + } + + return retval; +} + +// Extract one value (scalar, matrix, string, etc.) from stream IS and +// place it in TC, returning the name of the variable. If the value +// is tagged as global in the file, return TRUE in GLOBAL. +// +// Each type supplies its own function to load the data, and so this +// function is extensible. +// +// FILENAME is used for error messages. +// +// The data is expected to be in the following format: +// +// The input file must have a header followed by some data. +// +// All lines in the header must begin with a '#' character. +// +// The header must contain a list of keyword and value pairs with the +// keyword and value separated by a colon. +// +// Keywords must appear in the following order: +// +// # name: +// # type: +// # +// +// Where, for the built in types are: +// +// : a valid identifier +// +// : +// | global +// +// : scalar +// | complex scalar +// | matrix +// | complex matrix +// | bool +// | bool matrix +// | string +// | range +// +// : +// | +// +// : # rows: +// : # columns: +// +// : # elements: +// : # length: (once before each string) +// +// For backward compatibility the type "string array" is treated as a +// "string" type. Also "string" can have a single element with no elements +// line such that +// +// : # length: +// +// Formatted ASCII data follows the header. +// +// Example: +// +// # name: foo +// # type: matrix +// # rows: 2 +// # columns: 2 +// 2 4 +// 1 3 +// +// Example: +// +// # name: foo +// # type: string +// # elements: 5 +// # length: 4 +// this +// # length: 2 +// is +// # length: 1 +// a +// # length: 6 +// string +// # length: 5 +// array +// +// FIXME -- this format is fairly rigid, and doesn't allow for +// arbitrary comments. Someone should fix that. It does allow arbitrary +// types however. + +// Ugh. The signature of the compare method is not standard in older +// versions of the GNU libstdc++. Do this instead: + +#define SUBSTRING_COMPARE_EQ(s, pos, n, t) (s.substr (pos, n) == t) + +std::string +read_ascii_data (std::istream& is, const std::string& filename, bool& global, + octave_value& tc, octave_idx_type count) +{ + // Read name for this entry or break on EOF. + + std::string name = extract_keyword (is, "name"); + + if (name.empty ()) + { + if (count == 0) + error ("load: empty name keyword or no data found in file '%s'", + filename.c_str ()); + + return std::string (); + } + + if (! (name == ".nargin." || name == ".nargout." + || name == CELL_ELT_TAG || valid_identifier (name))) + { + error ("load: bogus identifier '%s' found in file '%s'", + name.c_str (), filename.c_str ()); + return std::string (); + } + + // Look for type keyword. + + std::string tag = extract_keyword (is, "type"); + + if (! tag.empty ()) + { + std::string typ; + size_t pos = tag.rfind (' '); + + if (pos != std::string::npos) + { + global = SUBSTRING_COMPARE_EQ (tag, 0, 6, "global"); + + typ = global ? tag.substr (7) : tag; + } + else + typ = tag; + + // Special case for backward compatiablity. A small bit of cruft + if (SUBSTRING_COMPARE_EQ (typ, 0, 12, "string array")) + tc = charMatrix (); + else + tc = octave_value_typeinfo::lookup_type (typ); + + if (! tc.load_ascii (is)) + error ("load: trouble reading ascii file '%s'", filename.c_str ()); + } + else + error ("load: failed to extract keyword specifying value type"); + + if (error_state) + { + error ("load: reading file %s", filename.c_str ()); + return std::string (); + } + + return name; +} + +// Save the data from TC along with the corresponding NAME, and global +// flag MARK_AS_GLOBAL on stream OS in the plain text format described +// above for load_ascii_data. If NAME is empty, the name: line is not +// generated. PRECISION specifies the number of decimal digits to print. +// +// Assumes ranges and strings cannot contain Inf or NaN values. +// +// Returns 1 for success and 0 for failure. + +// FIXME -- should probably write the help string here too. + +bool +save_ascii_data (std::ostream& os, const octave_value& val_arg, + const std::string& name, bool mark_as_global, + int precision) +{ + bool success = true; + + if (! name.empty ()) + os << "# name: " << name << "\n"; + + octave_value val = val_arg; + + if (mark_as_global) + os << "# type: global " << val.type_name () << "\n"; + else + os << "# type: " << val.type_name () << "\n"; + + if (! precision) + precision = Vsave_precision; + + long old_precision = os.precision (); + os.precision (precision); + + success = val.save_ascii (os); + + // Insert an extra pair of newline characters after the data so that + // multiple data elements may be handled separately by gnuplot (see + // the description of the index qualifier for the plot command in the + // gnuplot documentation). + os << "\n\n"; + + os.precision (old_precision); + + return (os && success); +} + +bool +save_ascii_data_for_plotting (std::ostream& os, const octave_value& t, + const std::string& name) +{ + return save_ascii_data (os, t, name, false, 6); +} + +// Maybe this should be a static function in tree-plot.cc? + +// If TC is matrix, save it on stream OS in a format useful for +// making a 3-dimensional plot with gnuplot. If PARAMETRIC is +// TRUE, assume a parametric 3-dimensional plot will be generated. + +bool +save_three_d (std::ostream& os, const octave_value& tc, bool parametric) +{ + bool fail = false; + + octave_idx_type nr = tc.rows (); + octave_idx_type nc = tc.columns (); + + if (tc.is_real_matrix ()) + { + os << "# 3D data...\n" + << "# type: matrix\n" + << "# total rows: " << nr << "\n" + << "# total columns: " << nc << "\n"; + + long old_precision = os.precision (); + os.precision (6); + + if (parametric) + { + octave_idx_type extras = nc % 3; + if (extras) + warning ("ignoring last %d columns", extras); + + Matrix tmp = tc.matrix_value (); + nr = tmp.rows (); + + for (octave_idx_type i = 0; i < nc-extras; i += 3) + { + os << tmp.extract (0, i, nr-1, i+2); + if (i+3 < nc-extras) + os << "\n"; + } + } + else + { + Matrix tmp = tc.matrix_value (); + nr = tmp.rows (); + + for (octave_idx_type i = 0; i < nc; i++) + { + os << tmp.extract (0, i, nr-1, i); + if (i+1 < nc) + os << "\n"; + } + } + + os.precision (old_precision); + } + else + { + ::error ("for now, I can only save real matrices in 3D format"); + fail = true; + } + + return (os && ! fail); +} + +DEFUN (save_precision, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} save_precision ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} save_precision (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} save_precision (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the number of\n\ +digits to keep when saving data in text format.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE_WITH_LIMITS (save_precision, -1, + std::numeric_limits::max ()); +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/ls-oct-ascii.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/ls-oct-ascii.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,189 @@ +/* + +Copyright (C) 2003-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_ls_oct_ascii_h) +#define octave_ls_oct_ascii_h 1 + +#include + +#include +#include + +#include "str-vec.h" + +#include "ls-ascii-helper.h" + +// Flag for cell elements +#define CELL_ELT_TAG "" + +// Used when converting Inf to something that gnuplot can read. + +#ifndef OCT_RBV +#define OCT_RBV (std::numeric_limits::max () / 100.0) +#endif + +extern OCTINTERP_API std::string +extract_keyword (std::istream& is, const char *keyword, + const bool next_only = false); + +extern OCTINTERP_API std::string +read_ascii_data (std::istream& is, const std::string& filename, bool& global, + octave_value& tc, octave_idx_type count); + +extern OCTINTERP_API bool +save_ascii_data (std::ostream& os, const octave_value& val_arg, + const std::string& name, bool mark_as_global, int precision); + +extern OCTINTERP_API bool +save_ascii_data_for_plotting (std::ostream& os, const octave_value& t, + const std::string& name); + +extern OCTINTERP_API bool +save_three_d (std::ostream& os, const octave_value& t, + bool parametric = false); + +// Match KEYWORD on stream IS, placing the associated value in VALUE, +// returning TRUE if successful and FALSE otherwise. +// +// Input should look something like: +// +// [%#][ \t]*keyword[ \t]*int-value.*\n + +template +bool +extract_keyword (std::istream& is, const char *keyword, T& value, + const bool next_only = false) +{ + bool status = false; + value = T (); + + char c; + while (is.get (c)) + { + if (c == '%' || c == '#') + { + std::ostringstream buf; + + while (is.get (c) && (c == ' ' || c == '\t' || c == '%' || c == '#')) + ; // Skip whitespace and comment characters. + + if (isalpha (c)) + buf << c; + + while (is.get (c) && isalpha (c)) + buf << c; + + std::string tmp = buf.str (); + bool match = (tmp.compare (0, strlen (keyword), keyword) == 0); + + if (match) + { + while (is.get (c) && (c == ' ' || c == '\t' || c == ':')) + ; // Skip whitespace and the colon. + + is.putback (c); + if (c != '\n' && c != '\r') + is >> value; + if (is) + status = true; + skip_until_newline (is, false); + break; + } + else if (next_only) + break; + } + } + return status; +} + +template +bool +extract_keyword (std::istream& is, const std::string& kw, T& value, + const bool next_only = false) +{ + return extract_keyword (is, kw.c_str (), value, next_only); +} + +// Match one of the elements in KEYWORDS on stream IS, placing the +// matched keyword in KW and the associated value in VALUE, +// returning TRUE if successful and FALSE otherwise. +// +// Input should look something like: +// +// [%#][ \t]*keyword[ \t]*int-value.*\n + +template +bool +extract_keyword (std::istream& is, const string_vector& keywords, + std::string& kw, T& value, const bool next_only = false) +{ + bool status = false; + kw = ""; + value = 0; + + char c; + while (is.get (c)) + { + if (c == '%' || c == '#') + { + std::ostringstream buf; + + while (is.get (c) && (c == ' ' || c == '\t' || c == '%' || c == '#')) + ; // Skip whitespace and comment characters. + + if (isalpha (c)) + buf << c; + + while (is.get (c) && isalpha (c)) + buf << c; + + std::string tmp = buf.str (); + + for (int i = 0; i < keywords.length (); i++) + { + int match = (tmp == keywords[i]); + + if (match) + { + kw = keywords[i]; + + while (is.get (c) && (c == ' ' || c == '\t' || c == ':')) + ; // Skip whitespace and the colon. + + is.putback (c); + if (c != '\n' && c != '\r') + is >> value; + if (is) + status = true; + skip_until_newline (is, false); + return status; + } + } + + if (next_only) + break; + } + } + return status; +} + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/ls-oct-binary.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/ls-oct-binary.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,307 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include +#include +#include +#include +#include + +#include "byte-swap.h" +#include "data-conv.h" +#include "file-ops.h" +#include "glob-match.h" +#include "lo-mappers.h" +#include "mach-info.h" +#include "oct-env.h" +#include "oct-time.h" +#include "quit.h" +#include "str-vec.h" +#include "oct-locbuf.h" + +#include "Cell.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "load-save.h" +#include "oct-obj.h" +#include "oct-map.h" +#include "ov-cell.h" +#include "pager.h" +#include "pt-exp.h" +#include "sysdep.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" +#include "version.h" +#include "dMatrix.h" + +#include "ls-utils.h" +#include "ls-oct-binary.h" + +// Extract one value (scalar, matrix, string, etc.) from stream IS and +// place it in TC, returning the name of the variable. If the value +// is tagged as global in the file, return TRUE in GLOBAL. If SWAP +// is TRUE, swap bytes after reading. +// +// The data is expected to be in the following format: +// +// Header (one per file): +// ===================== +// +// object type bytes +// ------ ---- ----- +// magic number string 10 +// +// float format integer 1 +// +// +// Data (one set for each item): +// ============================ +// +// object type bytes +// ------ ---- ----- +// name_length integer 4 +// +// name string name_length +// +// doc_length integer 4 +// +// doc string doc_length +// +// global flag integer 1 +// +// data type char 1 +// +// In general "data type" is 255, and in that case the next arguments +// in the data set are +// +// object type bytes +// ------ ---- ----- +// type_length integer 4 +// +// type string type_length +// +// The string "type" is then used with octave_value_typeinfo::lookup_type +// to create an octave_value of the correct type. The specific load/save +// function is then called. +// +// For backward compatiablity "data type" can also be a value between 1 +// and 7, where this defines a hardcoded octave_value of the type +// +// data type octave_value +// --------- ------------ +// 1 scalar +// 2 matrix +// 3 complex scalar +// 4 complex matrix +// 5 string (old style storage) +// 6 range +// 7 string +// +// Except for "data type" equal 5 that requires special treatment, these +// old style "data type" value also cause the specific load/save functions +// to be called. FILENAME is used for error messages. + +std::string +read_binary_data (std::istream& is, bool swap, + oct_mach_info::float_format fmt, + const std::string& filename, bool& global, + octave_value& tc, std::string& doc) +{ + std::string retval; + + unsigned char tmp = 0; + + int32_t name_len = 0; + int32_t doc_len = 0; + + doc.resize (0); + + // We expect to fail here, at the beginning of a record, so not + // being able to read another name should not result in an error. + + is.read (reinterpret_cast (&name_len), 4); + if (! is) + return retval; + if (swap) + swap_bytes<4> (&name_len); + + { + OCTAVE_LOCAL_BUFFER (char, name, name_len+1); + name[name_len] = '\0'; + if (! is.read (reinterpret_cast (name), name_len)) + goto data_read_error; + retval = name; + } + + is.read (reinterpret_cast (&doc_len), 4); + if (! is) + goto data_read_error; + if (swap) + swap_bytes<4> (&doc_len); + + { + OCTAVE_LOCAL_BUFFER (char, tdoc, doc_len+1); + tdoc[doc_len] = '\0'; + if (! is.read (reinterpret_cast (tdoc), doc_len)) + goto data_read_error; + doc = tdoc; + } + + if (! is.read (reinterpret_cast (&tmp), 1)) + goto data_read_error; + global = tmp ? 1 : 0; + + tmp = 0; + if (! is.read (reinterpret_cast (&tmp), 1)) + goto data_read_error; + + // All cases except 255 kept for backwards compatibility + switch (tmp) + { + case 1: + tc = octave_value_typeinfo::lookup_type ("scalar"); + break; + + case 2: + tc = octave_value_typeinfo::lookup_type ("matrix"); + break; + + case 3: + tc = octave_value_typeinfo::lookup_type ("complex scalar"); + break; + + case 4: + tc = octave_value_typeinfo::lookup_type ("complex matrix"); + break; + + case 5: + { + // FIXMEX + // This is cruft, since its for a save type that is old. Maybe + // this is taking backward compatability too far!! + int32_t len; + if (! is.read (reinterpret_cast (&len), 4)) + goto data_read_error; + if (swap) + swap_bytes<4> (&len); + OCTAVE_LOCAL_BUFFER (char, s, len+1); + if (! is.read (reinterpret_cast (s), len)) + goto data_read_error; + s[len] = '\0'; + tc = s; + + // Early return, since don't want rest of this function + return retval; + } + break; + + case 6: + tc = octave_value_typeinfo::lookup_type ("range"); + break; + + case 7: + tc = octave_value_typeinfo::lookup_type ("string"); + break; + + case 255: + { + // Read the saved variable type + int32_t len; + if (! is.read (reinterpret_cast (&len), 4)) + goto data_read_error; + if (swap) + swap_bytes<4> (&len); + OCTAVE_LOCAL_BUFFER (char, s, len+1); + if (! is.read (s, len)) + goto data_read_error; + s[len] = '\0'; + std::string typ = s; + tc = octave_value_typeinfo::lookup_type (typ); + } + break; + default: + goto data_read_error; + break; + } + + if (!tc.load_binary (is, swap, fmt)) + { + data_read_error: + error ("load: trouble reading binary file '%s'", filename.c_str ()); + } + + return retval; +} + +// Save the data from TC along with the corresponding NAME, help +// string DOC, and global flag MARK_AS_GLOBAL on stream OS in the +// binary format described above for read_binary_data. + +bool +save_binary_data (std::ostream& os, const octave_value& tc, + const std::string& name, const std::string& doc, + bool mark_as_global, bool save_as_floats) +{ + int32_t name_len = name.length (); + + os.write (reinterpret_cast (&name_len), 4); + os << name; + + int32_t doc_len = doc.length (); + + os.write (reinterpret_cast (&doc_len), 4); + os << doc; + + unsigned char tmp; + + tmp = mark_as_global; + os.write (reinterpret_cast (&tmp), 1); + + // 255 flags the new binary format + tmp = 255; + os.write (reinterpret_cast (&tmp), 1); + + // Write the string corresponding to the octave_value type + std::string typ = tc.type_name (); + int32_t len = typ.length (); + os.write (reinterpret_cast (&len), 4); + const char *btmp = typ.data (); + os.write (btmp, len); + + // The octave_value of tc is const. Make a copy... + octave_value val = tc; + + // Call specific save function + bool success = val.save_binary (os, save_as_floats); + + return (os && success); +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/ls-oct-binary.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/ls-oct-binary.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,37 @@ +/* + +Copyright (C) 2003-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_ls_oct_binary_h) +#define octave_ls_oct_binary_h 1 + +extern OCTINTERP_API bool +save_binary_data (std::ostream& os, const octave_value& tc, + const std::string& name, const std::string& doc, + bool mark_as_global, bool save_as_floats); + +extern OCTINTERP_API std::string +read_binary_data (std::istream& is, bool swap, + oct_mach_info::float_format fmt, + const std::string& filename, bool& global, + octave_value& tc, std::string& doc); + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/ls-utils.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/ls-utils.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,88 @@ +/* + +Copyright (C) 2003-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "data-conv.h" + +#include "ls-utils.h" + +// MAX_VAL and MIN_VAL are assumed to have integral values even though +// they are stored in doubles. + +save_type +get_save_type (double /* max_val */, double /* min_val */) +{ + save_type st = LS_DOUBLE; + + // Matlab doesn't seem to load the UINT32 type correctly, so let's + // avoid it (and the other unsigned types, even though they may not + // have the same problem. And apparently, there are problems with + // other smaller types as well. If we avoid them all, then maybe we + // will avoid problems. Unfortunately, we won't be able to save + // space... + + // if (max_val < 256 && min_val > -1) + // st = LS_U_CHAR; + // else if (max_val < 65536 && min_val > -1) + // st = LS_U_SHORT; + // else if (max_val < 4294967295UL && min_val > -1) + // st = LS_U_INT; + // else if (max_val < 128 && min_val >= -128) + // st = LS_CHAR; + // else if (max_val < 32768 && min_val >= -32768) + // st = LS_SHORT; + // else if (max_val <= 2147483647L && min_val >= -2147483647L) + // st = LS_INT; + + return st; +} + +save_type +get_save_type (float /* max_val */, float /* min_val */) +{ + save_type st = LS_FLOAT; + + // Matlab doesn't seem to load the UINT32 type correctly, so let's + // avoid it (and the other unsigned types, even though they may not + // have the same problem. And apparently, there are problems with + // other smaller types as well. If we avoid them all, then maybe we + // will avoid problems. Unfortunately, we won't be able to save + // space... + + // if (max_val < 256 && min_val > -1) + // st = LS_U_CHAR; + // else if (max_val < 65536 && min_val > -1) + // st = LS_U_SHORT; + // else if (max_val < 4294967295UL && min_val > -1) + // st = LS_U_INT; + // else if (max_val < 128 && min_val >= -128) + // st = LS_CHAR; + // else if (max_val < 32768 && min_val >= -32768) + // st = LS_SHORT; + // else if (max_val <= 2147483647L && min_val >= -2147483647L) + // st = LS_INT; + + return st; +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/ls-utils.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/ls-utils.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,32 @@ +/* + +Copyright (C) 2003-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_ls_utils_h) +#define octave_ls_utils 1 + +extern save_type +get_save_type (double max_val, double min_val); + +extern save_type +get_save_type (float max_val, float min_val); + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/matherr.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/matherr.c Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,53 @@ +/* + +Copyright (C) 1997-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#if defined (EXCEPTION_IN_MATH) + +#include "lo-math.h" + +int +matherr (struct exception *x) +{ + /* Possibly print our own message someday. Should probably be + user-switchable. */ + + switch (x->type) + { + case DOMAIN: + case SING: + case OVERFLOW: + case UNDERFLOW: + case TLOSS: + case PLOSS: + default: + break; + } + + /* But don't print the system message. */ + + return 1; +} +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/mex.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/mex.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,3385 @@ +/* + +Copyright (C) 2006-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#include + +#include +#include +#include +#include +#include +#include + +#include + +#include "f77-fcn.h" +#include "lo-ieee.h" +#include "oct-locbuf.h" + +#include "Cell.h" +// mxArray must be declared as a class before including mexproto.h. +#include "mxarray.h" +#include "mexproto.h" +#include "oct-map.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-mex-fcn.h" +#include "ov-usr-fcn.h" +#include "pager.h" +#include "parse.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" +#include "graphics.h" + +// #define DEBUG 1 + +static void +xfree (void *ptr) +{ + ::free (ptr); +} + +static mwSize +max_str_len (mwSize m, const char **str) +{ + int max_len = 0; + + for (mwSize i = 0; i < m; i++) + { + mwSize tmp = strlen (str[i]); + + if (tmp > max_len) + max_len = tmp; + } + + return max_len; +} + +static int +valid_key (const char *key) +{ + int retval = 0; + + int nel = strlen (key); + + if (nel > 0) + { + if (isalpha (key[0])) + { + for (int i = 1; i < nel; i++) + { + if (! (isalnum (key[i]) || key[i] == '_')) + goto done; + } + + retval = 1; + } + } + + done: + + return retval; +} + +// ------------------------------------------------------------------ + +void +mxArray_base::error (const char *msg) const +{ + // FIXME + ::error ("%s", msg); +} + +static mwIndex +calc_single_subscript_internal (mwSize ndims, const mwSize *dims, + mwSize nsubs, const mwIndex *subs) +{ + mwIndex retval = 0; + + switch (nsubs) + { + case 0: + break; + + case 1: + retval = subs[0]; + break; + + default: + { + // Both nsubs and ndims should be at least 2 here. + + mwSize n = nsubs <= ndims ? nsubs : ndims; + + retval = subs[--n]; + + while (--n >= 0) + retval = dims[n] * retval + subs[n]; + } + break; + } + + return retval; +} + +// The object that handles values pass to MEX files from Octave. Some +// methods in this class may set mutate_flag to TRUE to tell the +// mxArray class to convert to the Matlab-style representation and +// then invoke the method on that object instead (for example, getting +// a pointer to real or imaginary data from a complex object requires +// a mutation but getting a pointer to real data from a real object +// does not). Changing the representation causes a copy so we try to +// avoid it unless it is really necessary. Once the conversion +// happens, we delete this representation, so the conversion can only +// happen once per call to a MEX file. + +static inline void *maybe_mark_foreign (void *ptr); + +class mxArray_octave_value : public mxArray_base +{ +public: + + mxArray_octave_value (const octave_value& ov) + : mxArray_base (), val (ov), mutate_flag (false), + id (mxUNKNOWN_CLASS), class_name (0), ndims (-1), dims (0) { } + + mxArray_base *dup (void) const { return new mxArray_octave_value (*this); } + + mxArray *as_mxArray (void) const + { + return val.as_mxArray (); + } + + ~mxArray_octave_value (void) + { + mxFree (class_name); + mxFree (dims); + } + + bool is_octave_value (void) const { return true; } + + int is_cell (void) const { return val.is_cell (); } + + int is_char (void) const { return val.is_string (); } + + int is_complex (void) const { return val.is_complex_type (); } + + int is_double (void) const { return val.is_double_type (); } + + int is_function_handle (void) const { return val.is_function_handle (); } + + int is_int16 (void) const { return val.is_int16_type (); } + + int is_int32 (void) const { return val.is_int32_type (); } + + int is_int64 (void) const { return val.is_int64_type (); } + + int is_int8 (void) const { return val.is_int8_type (); } + + int is_logical (void) const { return val.is_bool_type (); } + + int is_numeric (void) const { return val.is_numeric_type (); } + + int is_single (void) const { return val.is_single_type (); } + + int is_sparse (void) const { return val.is_sparse_type (); } + + int is_struct (void) const { return val.is_map (); } + + int is_uint16 (void) const { return val.is_uint16_type (); } + + int is_uint32 (void) const { return val.is_uint32_type (); } + + int is_uint64 (void) const { return val.is_uint64_type (); } + + int is_uint8 (void) const { return val.is_uint8_type (); } + + int is_range (void) const { return val.is_range (); } + + int is_real_type (void) const { return val.is_real_type (); } + + int is_logical_scalar_true (void) const + { + return (is_logical_scalar () && val.is_true ()); + } + + mwSize get_m (void) const { return val.rows (); } + + mwSize get_n (void) const + { + mwSize n = 1; + + // Force dims and ndims to be cached. + get_dimensions (); + + for (mwIndex i = ndims - 1; i > 0; i--) + n *= dims[i]; + + return n; + } + + mwSize *get_dimensions (void) const + { + if (! dims) + { + ndims = val.ndims (); + + dims = static_cast (mxArray::malloc (ndims * sizeof (mwSize))); + + dim_vector dv = val.dims (); + + for (mwIndex i = 0; i < ndims; i++) + dims[i] = dv(i); + } + + return dims; + } + + mwSize get_number_of_dimensions (void) const + { + // Force dims and ndims to be cached. + get_dimensions (); + + return ndims; + } + + void set_m (mwSize /*m*/) { request_mutation (); } + + void set_n (mwSize /*n*/) { request_mutation (); } + + void set_dimensions (mwSize */*dims_arg*/, mwSize /*ndims_arg*/) + { + request_mutation (); + } + + mwSize get_number_of_elements (void) const { return val.numel (); } + + int is_empty (void) const { return val.is_empty (); } + + mxClassID get_class_id (void) const + { + id = mxUNKNOWN_CLASS; + + std::string cn = val.class_name (); + + if (cn == "cell") + id = mxCELL_CLASS; + else if (cn == "struct") + id = mxSTRUCT_CLASS; + else if (cn == "logical") + id = mxLOGICAL_CLASS; + else if (cn == "char") + id = mxCHAR_CLASS; + else if (cn == "double") + id = mxDOUBLE_CLASS; + else if (cn == "single") + id = mxSINGLE_CLASS; + else if (cn == "int8") + id = mxINT8_CLASS; + else if (cn == "uint8") + id = mxUINT8_CLASS; + else if (cn == "int16") + id = mxINT16_CLASS; + else if (cn == "uint16") + id = mxUINT16_CLASS; + else if (cn == "int32") + id = mxINT32_CLASS; + else if (cn == "uint32") + id = mxUINT32_CLASS; + else if (cn == "int64") + id = mxINT64_CLASS; + else if (cn == "uint64") + id = mxUINT64_CLASS; + else if (cn == "function_handle") + id = mxFUNCTION_CLASS; + + return id; + } + + const char *get_class_name (void) const + { + if (! class_name) + { + std::string s = val.class_name (); + class_name = mxArray::strsave (s.c_str ()); + } + + return class_name; + } + + // Not allowed. + void set_class_name (const char */*name_arg*/) { request_mutation (); } + + mxArray *get_cell (mwIndex /*idx*/) const + { + request_mutation (); + return 0; + } + + // Not allowed. + void set_cell (mwIndex /*idx*/, mxArray */*val*/) { request_mutation (); } + + double get_scalar (void) const { return val.scalar_value (true); } + + void *get_data (void) const + { + void *retval = val.mex_get_data (); + + if (retval) + maybe_mark_foreign (retval); + else + request_mutation (); + + return retval; + } + + void *get_imag_data (void) const + { + void *retval = 0; + + if (is_numeric () && is_real_type ()) + retval = 0; + else + request_mutation (); + + return retval; + } + + // Not allowed. + void set_data (void */*pr*/) { request_mutation (); } + + // Not allowed. + void set_imag_data (void */*pi*/) { request_mutation (); } + + mwIndex *get_ir (void) const + { + return static_cast (maybe_mark_foreign (val.mex_get_ir ())); + } + + mwIndex *get_jc (void) const + { + return static_cast (maybe_mark_foreign (val.mex_get_jc ())); + } + + mwSize get_nzmax (void) const { return val.nzmax (); } + + // Not allowed. + void set_ir (mwIndex */*ir*/) { request_mutation (); } + + // Not allowed. + void set_jc (mwIndex */*jc*/) { request_mutation (); } + + // Not allowed. + void set_nzmax (mwSize /*nzmax*/) { request_mutation (); } + + // Not allowed. + int add_field (const char */*key*/) + { + request_mutation (); + return 0; + } + + // Not allowed. + void remove_field (int /*key_num*/) { request_mutation (); } + + mxArray *get_field_by_number (mwIndex /*index*/, int /*key_num*/) const + { + request_mutation (); + return 0; + } + + // Not allowed. + void set_field_by_number (mwIndex /*index*/, int /*key_num*/, mxArray */*val*/) + { + request_mutation (); + } + + int get_number_of_fields (void) const { return val.nfields (); } + + const char *get_field_name_by_number (int /*key_num*/) const + { + request_mutation (); + return 0; + } + + int get_field_number (const char */*key*/) const + { + request_mutation (); + return 0; + } + + int get_string (char *buf, mwSize buflen) const + { + int retval = 1; + + mwSize nel = get_number_of_elements (); + + if (val.is_string () && nel < buflen) + { + charNDArray tmp = val.char_array_value (); + + const char *p = tmp.data (); + + for (mwIndex i = 0; i < nel; i++) + buf[i] = p[i]; + + buf[nel] = 0; + + retval = 0; + } + + return retval; + } + + char *array_to_string (void) const + { + // FIXME -- this is suposed to handle multi-byte character + // strings. + + char *buf = 0; + + if (val.is_string ()) + { + mwSize nel = get_number_of_elements (); + + buf = static_cast (mxArray::malloc (nel + 1)); + + if (buf) + { + charNDArray tmp = val.char_array_value (); + + const char *p = tmp.data (); + + for (mwIndex i = 0; i < nel; i++) + buf[i] = p[i]; + + buf[nel] = '\0'; + } + } + + return buf; + } + + mwIndex calc_single_subscript (mwSize nsubs, mwIndex *subs) const + { + // Force ndims, dims to be cached. + get_dimensions (); + + return calc_single_subscript_internal (ndims, dims, nsubs, subs); + } + + size_t get_element_size (void) const + { + // Force id to be cached. + get_class_id (); + + switch (id) + { + case mxCELL_CLASS: return sizeof (mxArray *); + case mxSTRUCT_CLASS: return sizeof (mxArray *); + case mxLOGICAL_CLASS: return sizeof (mxLogical); + case mxCHAR_CLASS: return sizeof (mxChar); + case mxDOUBLE_CLASS: return sizeof (double); + case mxSINGLE_CLASS: return sizeof (float); + case mxINT8_CLASS: return 1; + case mxUINT8_CLASS: return 1; + case mxINT16_CLASS: return 2; + case mxUINT16_CLASS: return 2; + case mxINT32_CLASS: return 4; + case mxUINT32_CLASS: return 4; + case mxINT64_CLASS: return 8; + case mxUINT64_CLASS: return 8; + case mxFUNCTION_CLASS: return 0; + default: return 0; + } + } + + bool mutation_needed (void) const { return mutate_flag; } + + void request_mutation (void) const + { + if (mutate_flag) + panic_impossible (); + + mutate_flag = true; + } + + mxArray *mutate (void) const { return val.as_mxArray (); } + + octave_value as_octave_value (void) const { return val; } + +protected: + + mxArray_octave_value (const mxArray_octave_value& arg) + : mxArray_base (arg), val (arg.val), mutate_flag (arg.mutate_flag), + id (arg.id), class_name (mxArray::strsave (arg.class_name)), + ndims (arg.ndims), + dims (ndims > 0 ? static_cast (mxArray::malloc (ndims * sizeof (mwSize))) : 0) + { + if (dims) + { + for (mwIndex i = 0; i < ndims; i++) + dims[i] = arg.dims[i]; + } + } + +private: + + octave_value val; + + mutable bool mutate_flag; + + // Caching these does not cost much or lead to much duplicated + // code. For other things, we just request mutation to a + // Matlab-style mxArray object. + + mutable mxClassID id; + mutable char *class_name; + mutable mwSize ndims; + mutable mwSize *dims; + + // No assignment! FIXME -- should this be implemented? Note that we + // do have a copy constructor. + + mxArray_octave_value& operator = (const mxArray_octave_value&); +}; + +// The base class for the Matlab-style representation, used to handle +// things that are common to all Matlab-style objects. + +class mxArray_matlab : public mxArray_base +{ +protected: + + mxArray_matlab (mxClassID id_arg = mxUNKNOWN_CLASS) + : mxArray_base (), class_name (0), id (id_arg), ndims (0), dims (0) { } + + mxArray_matlab (mxClassID id_arg, mwSize ndims_arg, const mwSize *dims_arg) + : mxArray_base (), class_name (0), id (id_arg), + ndims (ndims_arg < 2 ? 2 : ndims_arg), + dims (static_cast (mxArray::malloc (ndims * sizeof (mwSize)))) + { + if (ndims_arg < 2) + { + dims[0] = 1; + dims[1] = 1; + } + + for (mwIndex i = 0; i < ndims_arg; i++) + dims[i] = dims_arg[i]; + + for (mwIndex i = ndims - 1; i > 1; i--) + { + if (dims[i] == 1) + ndims--; + else + break; + } + } + + mxArray_matlab (mxClassID id_arg, const dim_vector& dv) + : mxArray_base (), class_name (0), id (id_arg), + ndims (dv.length ()), + dims (static_cast (mxArray::malloc (ndims * sizeof (mwSize)))) + { + for (mwIndex i = 0; i < ndims; i++) + dims[i] = dv(i); + + for (mwIndex i = ndims - 1; i > 1; i--) + { + if (dims[i] == 1) + ndims--; + else + break; + } + } + + mxArray_matlab (mxClassID id_arg, mwSize m, mwSize n) + : mxArray_base (), class_name (0), id (id_arg), ndims (2), + dims (static_cast (mxArray::malloc (ndims * sizeof (mwSize)))) + { + dims[0] = m; + dims[1] = n; + } + +public: + + ~mxArray_matlab (void) + { + mxFree (class_name); + mxFree (dims); + } + + int is_cell (void) const { return id == mxCELL_CLASS; } + + int is_char (void) const { return id == mxCHAR_CLASS; } + + int is_complex (void) const { return 0; } + + int is_double (void) const { return id == mxDOUBLE_CLASS; } + + int is_function_handle (void) const { return id == mxFUNCTION_CLASS; } + + int is_int16 (void) const { return id == mxINT16_CLASS; } + + int is_int32 (void) const { return id == mxINT32_CLASS; } + + int is_int64 (void) const { return id == mxINT64_CLASS; } + + int is_int8 (void) const { return id == mxINT8_CLASS; } + + int is_logical (void) const { return id == mxLOGICAL_CLASS; } + + int is_numeric (void) const + { + return (id == mxDOUBLE_CLASS || id == mxSINGLE_CLASS + || id == mxINT8_CLASS || id == mxUINT8_CLASS + || id == mxINT16_CLASS || id == mxUINT16_CLASS + || id == mxINT32_CLASS || id == mxUINT32_CLASS + || id == mxINT64_CLASS || id == mxUINT64_CLASS); + } + + int is_single (void) const { return id == mxSINGLE_CLASS; } + + int is_sparse (void) const { return 0; } + + int is_struct (void) const { return id == mxSTRUCT_CLASS; } + + int is_uint16 (void) const { return id == mxUINT16_CLASS; } + + int is_uint32 (void) const { return id == mxUINT32_CLASS; } + + int is_uint64 (void) const { return id == mxUINT64_CLASS; } + + int is_uint8 (void) const { return id == mxUINT8_CLASS; } + + int is_logical_scalar_true (void) const + { + return (is_logical_scalar () + && static_cast (get_data ())[0] != 0); + } + + mwSize get_m (void) const { return dims[0]; } + + mwSize get_n (void) const + { + mwSize n = 1; + + for (mwSize i = ndims - 1 ; i > 0 ; i--) + n *= dims[i]; + + return n; + } + + mwSize *get_dimensions (void) const { return dims; } + + mwSize get_number_of_dimensions (void) const { return ndims; } + + void set_m (mwSize m) { dims[0] = m; } + + void set_n (mwSize n) { dims[1] = n; } + + void set_dimensions (mwSize *dims_arg, mwSize ndims_arg) + { + dims = dims_arg; + ndims = ndims_arg; + } + + mwSize get_number_of_elements (void) const + { + mwSize retval = dims[0]; + + for (mwIndex i = 1; i < ndims; i++) + retval *= dims[i]; + + return retval; + } + + int is_empty (void) const { return get_number_of_elements () == 0; } + + mxClassID get_class_id (void) const { return id; } + + const char *get_class_name (void) const + { + switch (id) + { + case mxCELL_CLASS: return "cell"; + case mxSTRUCT_CLASS: return "struct"; + case mxLOGICAL_CLASS: return "logical"; + case mxCHAR_CLASS: return "char"; + case mxDOUBLE_CLASS: return "double"; + case mxSINGLE_CLASS: return "single"; + case mxINT8_CLASS: return "int8"; + case mxUINT8_CLASS: return "uint8"; + case mxINT16_CLASS: return "int16"; + case mxUINT16_CLASS: return "uint16"; + case mxINT32_CLASS: return "int32"; + case mxUINT32_CLASS: return "uint32"; + case mxINT64_CLASS: return "int64"; + case mxUINT64_CLASS: return "uint64"; + case mxFUNCTION_CLASS: return "function_handle"; + default: return "unknown"; + } + } + + void set_class_name (const char *name_arg) + { + mxFree (class_name); + class_name = static_cast (mxArray::malloc (strlen (name_arg) + 1)); + strcpy (class_name, name_arg); + } + + mxArray *get_cell (mwIndex /*idx*/) const + { + invalid_type_error (); + return 0; + } + + void set_cell (mwIndex /*idx*/, mxArray */*val*/) + { + invalid_type_error (); + } + + double get_scalar (void) const + { + invalid_type_error (); + return 0; + } + + void *get_data (void) const + { + invalid_type_error (); + return 0; + } + + void *get_imag_data (void) const + { + invalid_type_error (); + return 0; + } + + void set_data (void */*pr*/) + { + invalid_type_error (); + } + + void set_imag_data (void */*pi*/) + { + invalid_type_error (); + } + + mwIndex *get_ir (void) const + { + invalid_type_error (); + return 0; + } + + mwIndex *get_jc (void) const + { + invalid_type_error (); + return 0; + } + + mwSize get_nzmax (void) const + { + invalid_type_error (); + return 0; + } + + void set_ir (mwIndex */*ir*/) + { + invalid_type_error (); + } + + void set_jc (mwIndex */*jc*/) + { + invalid_type_error (); + } + + void set_nzmax (mwSize /*nzmax*/) + { + invalid_type_error (); + } + + int add_field (const char */*key*/) + { + invalid_type_error (); + return -1; + } + + void remove_field (int /*key_num*/) + { + invalid_type_error (); + } + + mxArray *get_field_by_number (mwIndex /*index*/, int /*key_num*/) const + { + invalid_type_error (); + return 0; + } + + void set_field_by_number (mwIndex /*index*/, int /*key_num*/, mxArray */*val*/) + { + invalid_type_error (); + } + + int get_number_of_fields (void) const + { + invalid_type_error (); + return 0; + } + + const char *get_field_name_by_number (int /*key_num*/) const + { + invalid_type_error (); + return 0; + } + + int get_field_number (const char */*key*/) const + { + return -1; + } + + int get_string (char */*buf*/, mwSize /*buflen*/) const + { + invalid_type_error (); + return 0; + } + + char *array_to_string (void) const + { + invalid_type_error (); + return 0; + } + + mwIndex calc_single_subscript (mwSize nsubs, mwIndex *subs) const + { + return calc_single_subscript_internal (ndims, dims, nsubs, subs); + } + + size_t get_element_size (void) const + { + switch (id) + { + case mxCELL_CLASS: return sizeof (mxArray *); + case mxSTRUCT_CLASS: return sizeof (mxArray *); + case mxLOGICAL_CLASS: return sizeof (mxLogical); + case mxCHAR_CLASS: return sizeof (mxChar); + case mxDOUBLE_CLASS: return sizeof (double); + case mxSINGLE_CLASS: return sizeof (float); + case mxINT8_CLASS: return 1; + case mxUINT8_CLASS: return 1; + case mxINT16_CLASS: return 2; + case mxUINT16_CLASS: return 2; + case mxINT32_CLASS: return 4; + case mxUINT32_CLASS: return 4; + case mxINT64_CLASS: return 8; + case mxUINT64_CLASS: return 8; + case mxFUNCTION_CLASS: return 0; + default: return 0; + } + } + +protected: + + mxArray_matlab (const mxArray_matlab& val) + : mxArray_base (val), class_name (mxArray::strsave (val.class_name)), + id (val.id), ndims (val.ndims), + dims (static_cast (mxArray::malloc (ndims * sizeof (mwSize)))) + { + for (mwIndex i = 0; i < ndims; i++) + dims[i] = val.dims[i]; + } + + dim_vector + dims_to_dim_vector (void) const + { + mwSize nd = get_number_of_dimensions (); + + mwSize *d = get_dimensions (); + + dim_vector dv; + dv.resize (nd); + + for (mwIndex i = 0; i < nd; i++) + dv(i) = d[i]; + + return dv; + } + +private: + + char *class_name; + + mxClassID id; + + mwSize ndims; + mwSize *dims; + + void invalid_type_error (void) const + { + error ("invalid type for operation"); + } + + // No assignment! FIXME -- should this be implemented? Note that we + // do have a copy constructor. + + mxArray_matlab& operator = (const mxArray_matlab&); +}; + +// Matlab-style numeric, character, and logical data. + +class mxArray_number : public mxArray_matlab +{ +public: + + mxArray_number (mxClassID id_arg, mwSize ndims_arg, const mwSize *dims_arg, + mxComplexity flag = mxREAL) + : mxArray_matlab (id_arg, ndims_arg, dims_arg), + pr (mxArray::calloc (get_number_of_elements (), get_element_size ())), + pi (flag == mxCOMPLEX ? mxArray::calloc (get_number_of_elements (), get_element_size ()) : 0) { } + + mxArray_number (mxClassID id_arg, const dim_vector& dv, + mxComplexity flag = mxREAL) + : mxArray_matlab (id_arg, dv), + pr (mxArray::calloc (get_number_of_elements (), get_element_size ())), + pi (flag == mxCOMPLEX ? mxArray::calloc (get_number_of_elements (), get_element_size ()) : 0) { } + + mxArray_number (mxClassID id_arg, mwSize m, mwSize n, mxComplexity flag = mxREAL) + : mxArray_matlab (id_arg, m, n), + pr (mxArray::calloc (get_number_of_elements (), get_element_size ())), + pi (flag == mxCOMPLEX ? mxArray::calloc (get_number_of_elements (), get_element_size ()) : 0) { } + + mxArray_number (mxClassID id_arg, double val) + : mxArray_matlab (id_arg, 1, 1), + pr (mxArray::calloc (get_number_of_elements (), get_element_size ())), + pi (0) + { + double *dpr = static_cast (pr); + dpr[0] = val; + } + + mxArray_number (mxClassID id_arg, mxLogical val) + : mxArray_matlab (id_arg, 1, 1), + pr (mxArray::calloc (get_number_of_elements (), get_element_size ())), + pi (0) + { + mxLogical *lpr = static_cast (pr); + lpr[0] = val; + } + + mxArray_number (const char *str) + : mxArray_matlab (mxCHAR_CLASS, + str ? (strlen (str) ? 1 : 0) : 0, + str ? strlen (str) : 0), + pr (mxArray::calloc (get_number_of_elements (), get_element_size ())), + pi (0) + { + mxChar *cpr = static_cast (pr); + mwSize nel = get_number_of_elements (); + for (mwIndex i = 0; i < nel; i++) + cpr[i] = str[i]; + } + + // FIXME?? + mxArray_number (mwSize m, const char **str) + : mxArray_matlab (mxCHAR_CLASS, m, max_str_len (m, str)), + pr (mxArray::calloc (get_number_of_elements (), get_element_size ())), + pi (0) + { + mxChar *cpr = static_cast (pr); + + mwSize *dv = get_dimensions (); + + mwSize nc = dv[1]; + + for (mwIndex j = 0; j < m; j++) + { + const char *ptr = str[j]; + + size_t tmp_len = strlen (ptr); + + for (size_t i = 0; i < tmp_len; i++) + cpr[m*i+j] = static_cast (ptr[i]); + + for (size_t i = tmp_len; i < static_cast(nc); i++) + cpr[m*i+j] = static_cast (' '); + } + } + + mxArray_base *dup (void) const { return new mxArray_number (*this); } + + ~mxArray_number (void) + { + mxFree (pr); + mxFree (pi); + } + + int is_complex (void) const { return pi != 0; } + + double get_scalar (void) const + { + double retval = 0; + + switch (get_class_id ()) + { + case mxLOGICAL_CLASS: + retval = *(static_cast (pr)); + break; + + case mxCHAR_CLASS: + retval = *(static_cast (pr)); + break; + + case mxSINGLE_CLASS: + retval = *(static_cast (pr)); + break; + + case mxDOUBLE_CLASS: + retval = *(static_cast (pr)); + break; + + case mxINT8_CLASS: + retval = *(static_cast (pr)); + break; + + case mxUINT8_CLASS: + retval = *(static_cast (pr)); + break; + + case mxINT16_CLASS: + retval = *(static_cast (pr)); + break; + + case mxUINT16_CLASS: + retval = *(static_cast (pr)); + break; + + case mxINT32_CLASS: + retval = *(static_cast (pr)); + break; + + case mxUINT32_CLASS: + retval = *(static_cast (pr)); + break; + + case mxINT64_CLASS: + retval = *(static_cast (pr)); + break; + + case mxUINT64_CLASS: + retval = *(static_cast (pr)); + break; + + default: + panic_impossible (); + } + + return retval; + } + + void *get_data (void) const { return pr; } + + void *get_imag_data (void) const { return pi; } + + void set_data (void *pr_arg) { pr = pr_arg; } + + void set_imag_data (void *pi_arg) { pi = pi_arg; } + + int get_string (char *buf, mwSize buflen) const + { + int retval = 0; + + mwSize nel = get_number_of_elements (); + + if (! (nel < buflen)) + { + retval = 1; + if (buflen > 0) + nel = buflen-1; + } + + if (nel < buflen) + { + mxChar *ptr = static_cast (pr); + + for (mwIndex i = 0; i < nel; i++) + buf[i] = static_cast (ptr[i]); + + buf[nel] = 0; + } + + return retval; + } + + char *array_to_string (void) const + { + // FIXME -- this is suposed to handle multi-byte character + // strings. + + mwSize nel = get_number_of_elements (); + + char *buf = static_cast (mxArray::malloc (nel + 1)); + + if (buf) + { + mxChar *ptr = static_cast (pr); + + for (mwIndex i = 0; i < nel; i++) + buf[i] = static_cast (ptr[i]); + + buf[nel] = '\0'; + } + + return buf; + } + + octave_value as_octave_value (void) const + { + octave_value retval; + + dim_vector dv = dims_to_dim_vector (); + + switch (get_class_id ()) + { + case mxLOGICAL_CLASS: + retval = int_to_ov (dv); + break; + + case mxCHAR_CLASS: + { + mwSize nel = get_number_of_elements (); + + mxChar *ppr = static_cast (pr); + + charNDArray val (dv); + + char *ptr = val.fortran_vec (); + + for (mwIndex i = 0; i < nel; i++) + ptr[i] = static_cast (ppr[i]); + + retval = val; + } + break; + + case mxSINGLE_CLASS: + { + mwSize nel = get_number_of_elements (); + + float *ppr = static_cast (pr); + + if (pi) + { + FloatComplexNDArray val (dv); + + FloatComplex *ptr = val.fortran_vec (); + + float *ppi = static_cast (pi); + + for (mwIndex i = 0; i < nel; i++) + ptr[i] = FloatComplex (ppr[i], ppi[i]); + + retval = val; + } + else + { + FloatNDArray val (dv); + + float *ptr = val.fortran_vec (); + + for (mwIndex i = 0; i < nel; i++) + ptr[i] = ppr[i]; + + retval = val; + } + } + break; + + case mxDOUBLE_CLASS: + { + mwSize nel = get_number_of_elements (); + + double *ppr = static_cast (pr); + + if (pi) + { + ComplexNDArray val (dv); + + Complex *ptr = val.fortran_vec (); + + double *ppi = static_cast (pi); + + for (mwIndex i = 0; i < nel; i++) + ptr[i] = Complex (ppr[i], ppi[i]); + + retval = val; + } + else + { + NDArray val (dv); + + double *ptr = val.fortran_vec (); + + for (mwIndex i = 0; i < nel; i++) + ptr[i] = ppr[i]; + + retval = val; + } + } + break; + + case mxINT8_CLASS: + retval = int_to_ov (dv); + break; + + case mxUINT8_CLASS: + retval = int_to_ov (dv); + break; + + case mxINT16_CLASS: + retval = int_to_ov (dv); + break; + + case mxUINT16_CLASS: + retval = int_to_ov (dv); + break; + + case mxINT32_CLASS: + retval = int_to_ov (dv); + break; + + case mxUINT32_CLASS: + retval = int_to_ov (dv); + break; + + case mxINT64_CLASS: + retval = int_to_ov (dv); + break; + + case mxUINT64_CLASS: + retval = int_to_ov (dv); + break; + + default: + panic_impossible (); + } + + return retval; + } + +protected: + + template + octave_value + int_to_ov (const dim_vector& dv) const + { + octave_value retval; + + mwSize nel = get_number_of_elements (); + + ELT_T *ppr = static_cast (pr); + + if (pi) + error ("complex integer types are not supported"); + else + { + ARRAY_T val (dv); + + ARRAY_ELT_T *ptr = val.fortran_vec (); + + for (mwIndex i = 0; i < nel; i++) + ptr[i] = ppr[i]; + + retval = val; + } + + return retval; + } + + mxArray_number (const mxArray_number& val) + : mxArray_matlab (val), + pr (mxArray::malloc (get_number_of_elements () * get_element_size ())), + pi (val.pi ? mxArray::malloc (get_number_of_elements () * get_element_size ()) : 0) + { + size_t nbytes = get_number_of_elements () * get_element_size (); + + if (pr) + memcpy (pr, val.pr, nbytes); + + if (pi) + memcpy (pi, val.pi, nbytes); + } + +private: + + void *pr; + void *pi; + + // No assignment! FIXME -- should this be implemented? Note that we + // do have a copy constructor. + + mxArray_number& operator = (const mxArray_number&); +}; + +// Matlab-style sparse arrays. + +class mxArray_sparse : public mxArray_matlab +{ +public: + + mxArray_sparse (mxClassID id_arg, mwSize m, mwSize n, mwSize nzmax_arg, + mxComplexity flag = mxREAL) + : mxArray_matlab (id_arg, m, n), nzmax (nzmax_arg), + pr (mxArray::calloc (nzmax, get_element_size ())), + pi (flag == mxCOMPLEX ? mxArray::calloc (nzmax, get_element_size ()) : 0), + ir (static_cast (mxArray::calloc (nzmax, sizeof (mwIndex)))), + jc (static_cast (mxArray::calloc (n + 1, sizeof (mwIndex)))) + { } + + mxArray_base *dup (void) const { return new mxArray_sparse (*this); } + + ~mxArray_sparse (void) + { + mxFree (pr); + mxFree (pi); + mxFree (ir); + mxFree (jc); + } + + int is_complex (void) const { return pi != 0; } + + int is_sparse (void) const { return 1; } + + void *get_data (void) const { return pr; } + + void *get_imag_data (void) const { return pi; } + + void set_data (void *pr_arg) { pr = pr_arg; } + + void set_imag_data (void *pi_arg) { pi = pi_arg; } + + mwIndex *get_ir (void) const { return ir; } + + mwIndex *get_jc (void) const { return jc; } + + mwSize get_nzmax (void) const { return nzmax; } + + void set_ir (mwIndex *ir_arg) { ir = ir_arg; } + + void set_jc (mwIndex *jc_arg) { jc = jc_arg; } + + void set_nzmax (mwSize nzmax_arg) { nzmax = nzmax_arg; } + + octave_value as_octave_value (void) const + { + octave_value retval; + + dim_vector dv = dims_to_dim_vector (); + + switch (get_class_id ()) + { + case mxLOGICAL_CLASS: + { + bool *ppr = static_cast (pr); + + SparseBoolMatrix val (get_m (), get_n (), + static_cast (nzmax)); + + for (mwIndex i = 0; i < nzmax; i++) + { + val.xdata (i) = ppr[i]; + val.xridx (i) = ir[i]; + } + + for (mwIndex i = 0; i < get_n () + 1; i++) + val.xcidx (i) = jc[i]; + + retval = val; + } + break; + + case mxSINGLE_CLASS: + error ("single precision sparse data type not supported"); + break; + + case mxDOUBLE_CLASS: + { + if (pi) + { + double *ppr = static_cast (pr); + double *ppi = static_cast (pi); + + SparseComplexMatrix val (get_m (), get_n (), + static_cast (nzmax)); + + for (mwIndex i = 0; i < nzmax; i++) + { + val.xdata (i) = Complex (ppr[i], ppi[i]); + val.xridx (i) = ir[i]; + } + + for (mwIndex i = 0; i < get_n () + 1; i++) + val.xcidx (i) = jc[i]; + + retval = val; + } + else + { + double *ppr = static_cast (pr); + + SparseMatrix val (get_m (), get_n (), + static_cast (nzmax)); + + for (mwIndex i = 0; i < nzmax; i++) + { + val.xdata (i) = ppr[i]; + val.xridx (i) = ir[i]; + } + + for (mwIndex i = 0; i < get_n () + 1; i++) + val.xcidx (i) = jc[i]; + + retval = val; + } + } + break; + + default: + panic_impossible (); + } + + return retval; + } + +private: + + mwSize nzmax; + + void *pr; + void *pi; + mwIndex *ir; + mwIndex *jc; + + mxArray_sparse (const mxArray_sparse& val) + : mxArray_matlab (val), nzmax (val.nzmax), + pr (mxArray::malloc (nzmax * get_element_size ())), + pi (val.pi ? mxArray::malloc (nzmax * get_element_size ()) : 0), + ir (static_cast (mxArray::malloc (nzmax * sizeof (mwIndex)))), + jc (static_cast (mxArray::malloc (nzmax * sizeof (mwIndex)))) + { + size_t nbytes = nzmax * get_element_size (); + + if (pr) + memcpy (pr, val.pr, nbytes); + + if (pi) + memcpy (pi, val.pi, nbytes); + + if (ir) + memcpy (ir, val.ir, nzmax * sizeof (mwIndex)); + + if (jc) + memcpy (jc, val.jc, (val.get_n () + 1) * sizeof (mwIndex)); + } + + // No assignment! FIXME -- should this be implemented? Note that we + // do have a copy constructor. + + mxArray_sparse& operator = (const mxArray_sparse&); +}; + +// Matlab-style struct arrays. + +class mxArray_struct : public mxArray_matlab +{ +public: + + mxArray_struct (mwSize ndims_arg, const mwSize *dims_arg, int num_keys_arg, + const char **keys) + : mxArray_matlab (mxSTRUCT_CLASS, ndims_arg, dims_arg), nfields (num_keys_arg), + fields (static_cast (mxArray::calloc (nfields, sizeof (char *)))), + data (static_cast (mxArray::calloc (nfields * get_number_of_elements (), sizeof (mxArray *)))) + { + init (keys); + } + + mxArray_struct (const dim_vector& dv, int num_keys_arg, const char **keys) + : mxArray_matlab (mxSTRUCT_CLASS, dv), nfields (num_keys_arg), + fields (static_cast (mxArray::calloc (nfields, sizeof (char *)))), + data (static_cast (mxArray::calloc (nfields * get_number_of_elements (), sizeof (mxArray *)))) + { + init (keys); + } + + mxArray_struct (mwSize m, mwSize n, int num_keys_arg, const char **keys) + : mxArray_matlab (mxSTRUCT_CLASS, m, n), nfields (num_keys_arg), + fields (static_cast (mxArray::calloc (nfields, sizeof (char *)))), + data (static_cast (mxArray::calloc (nfields * get_number_of_elements (), sizeof (mxArray *)))) + { + init (keys); + } + + void init (const char **keys) + { + for (int i = 0; i < nfields; i++) + fields[i] = mxArray::strsave (keys[i]); + } + + mxArray_base *dup (void) const { return new mxArray_struct (*this); } + + ~mxArray_struct (void) + { + for (int i = 0; i < nfields; i++) + mxFree (fields[i]); + + mxFree (fields); + + mwSize ntot = nfields * get_number_of_elements (); + + for (mwIndex i = 0; i < ntot; i++) + delete data[i]; + + mxFree (data); + } + + int add_field (const char *key) + { + int retval = -1; + + if (valid_key (key)) + { + nfields++; + + fields = static_cast (mxRealloc (fields, nfields * sizeof (char *))); + + if (fields) + { + fields[nfields-1] = mxArray::strsave (key); + + mwSize nel = get_number_of_elements (); + + mwSize ntot = nfields * nel; + + mxArray **new_data = static_cast (mxArray::malloc (ntot * sizeof (mxArray *))); + + if (new_data) + { + mwIndex j = 0; + mwIndex k = 0; + mwIndex n = 0; + + for (mwIndex i = 0; i < ntot; i++) + { + if (++n == nfields) + { + new_data[j++] = 0; + n = 0; + } + else + new_data[j++] = data[k++]; + } + + mxFree (data); + + data = new_data; + + retval = nfields - 1; + } + } + } + + return retval; + } + + void remove_field (int key_num) + { + if (key_num >= 0 && key_num < nfields) + { + mwSize nel = get_number_of_elements (); + + mwSize ntot = nfields * nel; + + int new_nfields = nfields - 1; + + char **new_fields = static_cast (mxArray::malloc (new_nfields * sizeof (char *))); + + mxArray **new_data = static_cast (mxArray::malloc (new_nfields * nel * sizeof (mxArray *))); + + for (int i = 0; i < key_num; i++) + new_fields[i] = fields[i]; + + for (int i = key_num + 1; i < nfields; i++) + new_fields[i-1] = fields[i]; + + if (new_nfields > 0) + { + mwIndex j = 0; + mwIndex k = 0; + mwIndex n = 0; + + for (mwIndex i = 0; i < ntot; i++) + { + if (n == key_num) + k++; + else + new_data[j++] = data[k++]; + + if (++n == nfields) + n = 0; + } + } + + nfields = new_nfields; + + mxFree (fields); + mxFree (data); + + fields = new_fields; + data = new_data; + } + } + + mxArray *get_field_by_number (mwIndex index, int key_num) const + { + return key_num >= 0 && key_num < nfields + ? data[nfields * index + key_num] : 0; + } + + void set_field_by_number (mwIndex index, int key_num, mxArray *val); + + int get_number_of_fields (void) const { return nfields; } + + const char *get_field_name_by_number (int key_num) const + { + return key_num >= 0 && key_num < nfields ? fields[key_num] : 0; + } + + int get_field_number (const char *key) const + { + int retval = -1; + + for (int i = 0; i < nfields; i++) + { + if (! strcmp (key, fields[i])) + { + retval = i; + break; + } + } + + return retval; + } + + void *get_data (void) const { return data; } + + void set_data (void *data_arg) { data = static_cast (data_arg); } + + octave_value as_octave_value (void) const + { + dim_vector dv = dims_to_dim_vector (); + + string_vector keys (fields, nfields); + + octave_map m; + + mwSize ntot = nfields * get_number_of_elements (); + + for (int i = 0; i < nfields; i++) + { + Cell c (dv); + + octave_value *p = c.fortran_vec (); + + mwIndex k = 0; + for (mwIndex j = i; j < ntot; j += nfields) + p[k++] = mxArray::as_octave_value (data[j]); + + m.assign (keys[i], c); + } + + return m; + } + +private: + + int nfields; + + char **fields; + + mxArray **data; + + mxArray_struct (const mxArray_struct& val) + : mxArray_matlab (val), nfields (val.nfields), + fields (static_cast (mxArray::malloc (nfields * sizeof (char *)))), + data (static_cast (mxArray::malloc (nfields * get_number_of_elements () * sizeof (mxArray *)))) + { + for (int i = 0; i < nfields; i++) + fields[i] = mxArray::strsave (val.fields[i]); + + mwSize nel = get_number_of_elements (); + + for (mwIndex i = 0; i < nel * nfields; i++) + { + mxArray *ptr = val.data[i]; + data[i] = ptr ? ptr->dup () : 0; + } + } + + // No assignment! FIXME -- should this be implemented? Note that we + // do have a copy constructor. + + mxArray_struct& operator = (const mxArray_struct& val); +}; + +// Matlab-style cell arrays. + +class mxArray_cell : public mxArray_matlab +{ +public: + + mxArray_cell (mwSize ndims_arg, const mwSize *dims_arg) + : mxArray_matlab (mxCELL_CLASS, ndims_arg, dims_arg), + data (static_cast (mxArray::calloc (get_number_of_elements (), sizeof (mxArray *)))) { } + + mxArray_cell (const dim_vector& dv) + : mxArray_matlab (mxCELL_CLASS, dv), + data (static_cast (mxArray::calloc (get_number_of_elements (), sizeof (mxArray *)))) { } + + mxArray_cell (mwSize m, mwSize n) + : mxArray_matlab (mxCELL_CLASS, m, n), + data (static_cast (mxArray::calloc (get_number_of_elements (), sizeof (mxArray *)))) { } + + mxArray_base *dup (void) const { return new mxArray_cell (*this); } + + ~mxArray_cell (void) + { + mwSize nel = get_number_of_elements (); + + for (mwIndex i = 0; i < nel; i++) + delete data[i]; + + mxFree (data); + } + + mxArray *get_cell (mwIndex idx) const + { + return idx >= 0 && idx < get_number_of_elements () ? data[idx] : 0; + } + + void set_cell (mwIndex idx, mxArray *val); + + void *get_data (void) const { return data; } + + void set_data (void *data_arg) { data = static_cast (data_arg); } + + octave_value as_octave_value (void) const + { + dim_vector dv = dims_to_dim_vector (); + + Cell c (dv); + + mwSize nel = get_number_of_elements (); + + octave_value *p = c.fortran_vec (); + + for (mwIndex i = 0; i < nel; i++) + p[i] = mxArray::as_octave_value (data[i]); + + return c; + } + +private: + + mxArray **data; + + mxArray_cell (const mxArray_cell& val) + : mxArray_matlab (val), + data (static_cast (mxArray::malloc (get_number_of_elements () * sizeof (mxArray *)))) + { + mwSize nel = get_number_of_elements (); + + for (mwIndex i = 0; i < nel; i++) + { + mxArray *ptr = val.data[i]; + data[i] = ptr ? ptr->dup () : 0; + } + } + + // No assignment! FIXME -- should this be implemented? Note that we + // do have a copy constructor. + + mxArray_cell& operator = (const mxArray_cell&); +}; + +// ------------------------------------------------------------------ + +mxArray::mxArray (const octave_value& ov) + : rep (new mxArray_octave_value (ov)), name (0) { } + +mxArray::mxArray (mxClassID id, mwSize ndims, const mwSize *dims, mxComplexity flag) + : rep (new mxArray_number (id, ndims, dims, flag)), name (0) { } + +mxArray::mxArray (mxClassID id, const dim_vector& dv, mxComplexity flag) + : rep (new mxArray_number (id, dv, flag)), name (0) { } + +mxArray::mxArray (mxClassID id, mwSize m, mwSize n, mxComplexity flag) + : rep (new mxArray_number (id, m, n, flag)), name (0) { } + +mxArray::mxArray (mxClassID id, double val) + : rep (new mxArray_number (id, val)), name (0) { } + +mxArray::mxArray (mxClassID id, mxLogical val) + : rep (new mxArray_number (id, val)), name (0) { } + +mxArray::mxArray (const char *str) + : rep (new mxArray_number (str)), name (0) { } + +mxArray::mxArray (mwSize m, const char **str) + : rep (new mxArray_number (m, str)), name (0) { } + +mxArray::mxArray (mxClassID id, mwSize m, mwSize n, mwSize nzmax, mxComplexity flag) + : rep (new mxArray_sparse (id, m, n, nzmax, flag)), name (0) { } + +mxArray::mxArray (mwSize ndims, const mwSize *dims, int num_keys, const char **keys) + : rep (new mxArray_struct (ndims, dims, num_keys, keys)), name (0) { } + +mxArray::mxArray (const dim_vector& dv, int num_keys, const char **keys) + : rep (new mxArray_struct (dv, num_keys, keys)), name (0) { } + +mxArray::mxArray (mwSize m, mwSize n, int num_keys, const char **keys) + : rep (new mxArray_struct (m, n, num_keys, keys)), name (0) { } + +mxArray::mxArray (mwSize ndims, const mwSize *dims) + : rep (new mxArray_cell (ndims, dims)), name (0) { } + +mxArray::mxArray (const dim_vector& dv) + : rep (new mxArray_cell (dv)), name (0) { } + +mxArray::mxArray (mwSize m, mwSize n) + : rep (new mxArray_cell (m, n)), name (0) { } + +mxArray::~mxArray (void) +{ + mxFree (name); + + delete rep; +} + +void +mxArray::set_name (const char *name_arg) +{ + mxFree (name); + name = mxArray::strsave (name_arg); +} + +octave_value +mxArray::as_octave_value (const mxArray *ptr) +{ + return ptr ? ptr->as_octave_value () : octave_value (Matrix ()); +} + +octave_value +mxArray::as_octave_value (void) const +{ + return rep->as_octave_value (); +} + +void +mxArray::maybe_mutate (void) const +{ + if (rep->is_octave_value ()) + { + // The mutate function returns a pointer to a complete new + // mxArray object (or 0, if no mutation happened). We just want + // to replace the existing rep with the rep from the new object. + + mxArray *new_val = rep->mutate (); + + if (new_val) + { + delete rep; + rep = new_val->rep; + new_val->rep = 0; + delete new_val; + } + } +} + +// ------------------------------------------------------------------ + +// A class to manage calls to MEX functions. Mostly deals with memory +// management. + +class mex +{ +public: + + mex (octave_mex_function *f) + : curr_mex_fcn (f), memlist (), arraylist (), fname (0) { } + + ~mex (void) + { + if (! memlist.empty ()) + error ("mex: %s: cleanup failed", function_name ()); + + mxFree (fname); + } + + const char *function_name (void) const + { + if (! fname) + { + octave_function *fcn = octave_call_stack::current (); + + if (fcn) + { + std::string nm = fcn->name (); + fname = mxArray::strsave (nm.c_str ()); + } + else + fname = mxArray::strsave ("unknown"); + } + + return fname; + } + + // Free all unmarked pointers obtained from malloc and calloc. + static void cleanup (void *ptr) + { + mex *context = static_cast (ptr); + + // We can't use mex::free here because it modifies memlist. + for (std::set::iterator p = context->memlist.begin (); + p != context->memlist.end (); p++) + xfree (*p); + + context->memlist.clear (); + + // We can't use mex::free_value here because it modifies arraylist. + for (std::set::iterator p = context->arraylist.begin (); + p != context->arraylist.end (); p++) + delete *p; + + context->arraylist.clear (); + } + + // Allocate memory. + void *malloc_unmarked (size_t n) + { + void *ptr = gnulib::malloc (n); + + if (! ptr) + { + // FIXME -- could use "octave_new_handler();" instead + + error ("%s: failed to allocate %d bytes of memory", + function_name (), n); + + abort (); + } + + global_mark (ptr); + + return ptr; + } + + // Allocate memory to be freed on exit. + void *malloc (size_t n) + { + void *ptr = malloc_unmarked (n); + + mark (ptr); + + return ptr; + } + + // Allocate memory and initialize to 0. + void *calloc_unmarked (size_t n, size_t t) + { + void *ptr = malloc_unmarked (n*t); + + memset (ptr, 0, n*t); + + return ptr; + } + + // Allocate memory to be freed on exit and initialize to 0. + void *calloc (size_t n, size_t t) + { + void *ptr = calloc_unmarked (n, t); + + mark (ptr); + + return ptr; + } + + // Reallocate a pointer obtained from malloc or calloc. If the + // pointer is NULL, allocate using malloc. We don't need an + // "unmarked" version of this. + void *realloc (void *ptr, size_t n) + { + void *v; + + if (ptr) + { + v = gnulib::realloc (ptr, n); + + std::set::iterator p = memlist.find (ptr); + + if (v && p != memlist.end ()) + { + memlist.erase (p); + memlist.insert (v); + } + + p = global_memlist.find (ptr); + + if (v && p != global_memlist.end ()) + { + global_memlist.erase (p); + global_memlist.insert (v); + } + } + else + v = malloc (n); + + return v; + } + + // Free a pointer obtained from malloc or calloc. + void free (void *ptr) + { + if (ptr) + { + unmark (ptr); + + std::set::iterator p = global_memlist.find (ptr); + + if (p != global_memlist.end ()) + { + global_memlist.erase (p); + + xfree (ptr); + } + else + { + p = foreign_memlist.find (ptr); + + if (p != foreign_memlist.end ()) + foreign_memlist.erase (p); +#ifdef DEBUG + else + warning ("mxFree: skipping memory not allocated by mxMalloc, mxCalloc, or mxRealloc"); +#endif + } + } + } + + // Mark a pointer to be freed on exit. + void mark (void *ptr) + { +#ifdef DEBUG + if (memlist.find (ptr) != memlist.end ()) + warning ("%s: double registration ignored", function_name ()); +#endif + + memlist.insert (ptr); + } + + // Unmark a pointer to be freed on exit, either because it was + // made persistent, or because it was already freed. + void unmark (void *ptr) + { + std::set::iterator p = memlist.find (ptr); + + if (p != memlist.end ()) + memlist.erase (p); +#ifdef DEBUG + else + warning ("%s: value not marked", function_name ()); +#endif + } + + mxArray *mark_array (mxArray *ptr) + { + arraylist.insert (ptr); + return ptr; + } + + void unmark_array (mxArray *ptr) + { + std::set::iterator p = arraylist.find (ptr); + + if (p != arraylist.end ()) + arraylist.erase (p); + } + + // Mark a pointer as one we allocated. + void mark_foreign (void *ptr) + { +#ifdef DEBUG + if (foreign_memlist.find (ptr) != foreign_memlist.end ()) + warning ("%s: double registration ignored", function_name ()); +#endif + + foreign_memlist.insert (ptr); + } + + // Unmark a pointer as one we allocated. + void unmark_foreign (void *ptr) + { + std::set::iterator p = foreign_memlist.find (ptr); + + if (p != foreign_memlist.end ()) + foreign_memlist.erase (p); +#ifdef DEBUG + else + warning ("%s: value not marked", function_name ()); +#endif + + } + + // Make a new array value and initialize from an octave value; it will be + // freed on exit unless marked as persistent. + mxArray *make_value (const octave_value& ov) + { + return mark_array (new mxArray (ov)); + } + + // Free an array and its contents. + bool free_value (mxArray *ptr) + { + bool inlist = false; + + std::set::iterator p = arraylist.find (ptr); + + if (p != arraylist.end ()) + { + inlist = true; + arraylist.erase (p); + delete ptr; + } +#ifdef DEBUG + else + warning ("mex::free_value: skipping memory not allocated by mex::make_value"); +#endif + + return inlist; + } + + octave_mex_function *current_mex_function (void) const + { + return curr_mex_fcn; + } + + // 1 if error should be returned to MEX file, 0 if abort. + int trap_feval_error; + + // longjmp return point if mexErrMsgTxt or error. + jmp_buf jump; + + // Trigger a long jump back to the mex calling function. + void abort (void) { longjmp (jump, 1); } + +private: + + // Pointer to the mex function that corresponds to this mex context. + octave_mex_function *curr_mex_fcn; + + // List of memory resources that need to be freed upon exit. + std::set memlist; + + // List of mxArray objects that need to be freed upon exit. + std::set arraylist; + + // List of memory resources we know about, but that were allocated + // elsewhere. + std::set foreign_memlist; + + // The name of the currently executing function. + mutable char *fname; + + // List of memory resources we allocated. + static std::set global_memlist; + + // Mark a pointer as one we allocated. + void global_mark (void *ptr) + { +#ifdef DEBUG + if (global_memlist.find (ptr) != global_memlist.end ()) + warning ("%s: double registration ignored", function_name ()); +#endif + + global_memlist.insert (ptr); + } + + // Unmark a pointer as one we allocated. + void global_unmark (void *ptr) + { + std::set::iterator p = global_memlist.find (ptr); + + if (p != global_memlist.end ()) + global_memlist.erase (p); +#ifdef DEBUG + else + warning ("%s: value not marked", function_name ()); +#endif + + } + + // No copying! + + mex (const mex&); + + mex& operator = (const mex&); +}; + +// List of memory resources we allocated. +std::set mex::global_memlist; + +// Current context. +mex *mex_context = 0; + +void * +mxArray::malloc (size_t n) +{ + return mex_context ? mex_context->malloc_unmarked (n) : gnulib::malloc (n); +} + +void * +mxArray::calloc (size_t n, size_t t) +{ + return mex_context ? mex_context->calloc_unmarked (n, t) : ::calloc (n, t); +} + +static inline void * +maybe_mark_foreign (void *ptr) +{ + if (mex_context) + mex_context->mark_foreign (ptr); + + return ptr; +} + +static inline mxArray * +maybe_unmark_array (mxArray *ptr) +{ + if (mex_context) + mex_context->unmark_array (ptr); + + return ptr; +} + +static inline void * +maybe_unmark (void *ptr) +{ + if (mex_context) + mex_context->unmark (ptr); + + return ptr; +} + +void +mxArray_struct::set_field_by_number (mwIndex index, int key_num, mxArray *val) +{ + if (key_num >= 0 && key_num < nfields) + data[nfields * index + key_num] = maybe_unmark_array (val); +} + +void +mxArray_cell::set_cell (mwIndex idx, mxArray *val) +{ + if (idx >= 0 && idx < get_number_of_elements ()) + data[idx] = maybe_unmark_array (val); +} + +// ------------------------------------------------------------------ + +// C interface to mxArray objects: + +// Floating point predicates. + +int +mxIsFinite (const double v) +{ + return lo_ieee_finite (v) != 0; +} + +int +mxIsInf (const double v) +{ + return lo_ieee_isinf (v) != 0; +} + +int +mxIsNaN (const double v) +{ + return lo_ieee_isnan (v) != 0; +} + +double +mxGetEps (void) +{ + return std::numeric_limits::epsilon (); +} + +double +mxGetInf (void) +{ + return lo_ieee_inf_value (); +} + +double +mxGetNaN (void) +{ + return lo_ieee_nan_value (); +} + +// Memory management. +void * +mxCalloc (size_t n, size_t size) +{ + return mex_context ? mex_context->calloc (n, size) : ::calloc (n, size); +} + +void * +mxMalloc (size_t n) +{ + return mex_context ? mex_context->malloc (n) : gnulib::malloc (n); +} + +void * +mxRealloc (void *ptr, size_t size) +{ + return mex_context ? mex_context->realloc (ptr, size) : gnulib::realloc (ptr, size); +} + +void +mxFree (void *ptr) +{ + if (mex_context) + mex_context->free (ptr); + else + xfree (ptr); +} + +static inline mxArray * +maybe_mark_array (mxArray *ptr) +{ + return mex_context ? mex_context->mark_array (ptr) : ptr; +} + +// Constructors. +mxArray * +mxCreateCellArray (mwSize ndims, const mwSize *dims) +{ + return maybe_mark_array (new mxArray (ndims, dims)); +} + +mxArray * +mxCreateCellMatrix (mwSize m, mwSize n) +{ + return maybe_mark_array (new mxArray (m, n)); +} + +mxArray * +mxCreateCharArray (mwSize ndims, const mwSize *dims) +{ + return maybe_mark_array (new mxArray (mxCHAR_CLASS, ndims, dims)); +} + +mxArray * +mxCreateCharMatrixFromStrings (mwSize m, const char **str) +{ + return maybe_mark_array (new mxArray (m, str)); +} + +mxArray * +mxCreateDoubleMatrix (mwSize m, mwSize n, mxComplexity flag) +{ + return maybe_mark_array (new mxArray (mxDOUBLE_CLASS, m, n, flag)); +} + +mxArray * +mxCreateDoubleScalar (double val) +{ + return maybe_mark_array (new mxArray (mxDOUBLE_CLASS, val)); +} + +mxArray * +mxCreateLogicalArray (mwSize ndims, const mwSize *dims) +{ + return maybe_mark_array (new mxArray (mxLOGICAL_CLASS, ndims, dims)); +} + +mxArray * +mxCreateLogicalMatrix (mwSize m, mwSize n) +{ + return maybe_mark_array (new mxArray (mxLOGICAL_CLASS, m, n)); +} + +mxArray * +mxCreateLogicalScalar (mxLogical val) +{ + return maybe_mark_array (new mxArray (mxLOGICAL_CLASS, val)); +} + +mxArray * +mxCreateNumericArray (mwSize ndims, const mwSize *dims, mxClassID class_id, + mxComplexity flag) +{ + return maybe_mark_array (new mxArray (class_id, ndims, dims, flag)); +} + +mxArray * +mxCreateNumericMatrix (mwSize m, mwSize n, mxClassID class_id, mxComplexity flag) +{ + return maybe_mark_array (new mxArray (class_id, m, n, flag)); +} + +mxArray * +mxCreateSparse (mwSize m, mwSize n, mwSize nzmax, mxComplexity flag) +{ + return maybe_mark_array (new mxArray (mxDOUBLE_CLASS, m, n, nzmax, flag)); +} + +mxArray * +mxCreateSparseLogicalMatrix (mwSize m, mwSize n, mwSize nzmax) +{ + return maybe_mark_array (new mxArray (mxLOGICAL_CLASS, m, n, nzmax)); +} + +mxArray * +mxCreateString (const char *str) +{ + return maybe_mark_array (new mxArray (str)); +} + +mxArray * +mxCreateStructArray (mwSize ndims, const mwSize *dims, int num_keys, const char **keys) +{ + return maybe_mark_array (new mxArray (ndims, dims, num_keys, keys)); +} + +mxArray * +mxCreateStructMatrix (mwSize m, mwSize n, int num_keys, const char **keys) +{ + return maybe_mark_array (new mxArray (m, n, num_keys, keys)); +} + +// Copy constructor. +mxArray * +mxDuplicateArray (const mxArray *ptr) +{ + return maybe_mark_array (ptr->dup ()); +} + +// Destructor. +void +mxDestroyArray (mxArray *ptr) +{ + if (! (mex_context && mex_context->free_value (ptr))) + delete ptr; +} + +// Type Predicates. +int +mxIsCell (const mxArray *ptr) +{ + return ptr->is_cell (); +} + +int +mxIsChar (const mxArray *ptr) +{ + return ptr->is_char (); +} + +int +mxIsClass (const mxArray *ptr, const char *name) +{ + return ptr->is_class (name); +} + +int +mxIsComplex (const mxArray *ptr) +{ + return ptr->is_complex (); +} + +int +mxIsDouble (const mxArray *ptr) +{ + return ptr->is_double (); +} + +int +mxIsFunctionHandle (const mxArray *ptr) +{ + return ptr->is_function_handle (); +} + +int +mxIsInt16 (const mxArray *ptr) +{ + return ptr->is_int16 (); +} + +int +mxIsInt32 (const mxArray *ptr) +{ + return ptr->is_int32 (); +} + +int +mxIsInt64 (const mxArray *ptr) +{ + return ptr->is_int64 (); +} + +int +mxIsInt8 (const mxArray *ptr) +{ + return ptr->is_int8 (); +} + +int +mxIsLogical (const mxArray *ptr) +{ + return ptr->is_logical (); +} + +int +mxIsNumeric (const mxArray *ptr) +{ + return ptr->is_numeric (); +} + +int +mxIsSingle (const mxArray *ptr) +{ + return ptr->is_single (); +} + +int +mxIsSparse (const mxArray *ptr) +{ + return ptr->is_sparse (); +} + +int +mxIsStruct (const mxArray *ptr) +{ + return ptr->is_struct (); +} + +int +mxIsUint16 (const mxArray *ptr) +{ + return ptr->is_uint16 (); +} + +int +mxIsUint32 (const mxArray *ptr) +{ + return ptr->is_uint32 (); +} + +int +mxIsUint64 (const mxArray *ptr) +{ + return ptr->is_uint64 (); +} + +int +mxIsUint8 (const mxArray *ptr) +{ + return ptr->is_uint8 (); +} + +// Odd type+size predicate. +int +mxIsLogicalScalar (const mxArray *ptr) +{ + return ptr->is_logical_scalar (); +} + +// Odd type+size+value predicate. +int +mxIsLogicalScalarTrue (const mxArray *ptr) +{ + return ptr->is_logical_scalar_true (); +} + +// Size predicate. +int +mxIsEmpty (const mxArray *ptr) +{ + return ptr->is_empty (); +} + +// Just plain odd thing to ask of a value. +int +mxIsFromGlobalWS (const mxArray */*ptr*/) +{ + // FIXME + abort (); + return 0; +} + +// Dimension extractors. +size_t +mxGetM (const mxArray *ptr) +{ + return ptr->get_m (); +} + +size_t +mxGetN (const mxArray *ptr) +{ + return ptr->get_n (); +} + +mwSize * +mxGetDimensions (const mxArray *ptr) +{ + return ptr->get_dimensions (); +} + +mwSize +mxGetNumberOfDimensions (const mxArray *ptr) +{ + return ptr->get_number_of_dimensions (); +} + +size_t +mxGetNumberOfElements (const mxArray *ptr) +{ + return ptr->get_number_of_elements (); +} + +// Dimension setters. +void +mxSetM (mxArray *ptr, mwSize m) +{ + ptr->set_m (m); +} + +void +mxSetN (mxArray *ptr, mwSize n) +{ + ptr->set_n (n); +} + +void +mxSetDimensions (mxArray *ptr, const mwSize *dims, mwSize ndims) +{ + ptr->set_dimensions (static_cast ( + maybe_unmark (const_cast (dims))), + ndims); +} + +// Data extractors. +double * +mxGetPr (const mxArray *ptr) +{ + return static_cast (ptr->get_data ()); +} + +double * +mxGetPi (const mxArray *ptr) +{ + return static_cast (ptr->get_imag_data ()); +} + +double +mxGetScalar (const mxArray *ptr) +{ + return ptr->get_scalar (); +} + +mxChar * +mxGetChars (const mxArray *ptr) +{ + return static_cast (ptr->get_data ()); +} + +mxLogical * +mxGetLogicals (const mxArray *ptr) +{ + return static_cast (ptr->get_data ()); +} + +void * +mxGetData (const mxArray *ptr) +{ + return ptr->get_data (); +} + +void * +mxGetImagData (const mxArray *ptr) +{ + return ptr->get_imag_data (); +} + +// Data setters. +void +mxSetPr (mxArray *ptr, double *pr) +{ + ptr->set_data (maybe_unmark (pr)); +} + +void +mxSetPi (mxArray *ptr, double *pi) +{ + ptr->set_imag_data (maybe_unmark (pi)); +} + +void +mxSetData (mxArray *ptr, void *pr) +{ + ptr->set_data (maybe_unmark (pr)); +} + +void +mxSetImagData (mxArray *ptr, void *pi) +{ + ptr->set_imag_data (maybe_unmark (pi)); +} + +// Classes. +mxClassID +mxGetClassID (const mxArray *ptr) +{ + return ptr->get_class_id (); +} + +const char * +mxGetClassName (const mxArray *ptr) +{ + return ptr->get_class_name (); +} + +void +mxSetClassName (mxArray *ptr, const char *name) +{ + ptr->set_class_name (name); +} + +// Cell support. +mxArray * +mxGetCell (const mxArray *ptr, mwIndex idx) +{ + return ptr->get_cell (idx); +} + +void +mxSetCell (mxArray *ptr, mwIndex idx, mxArray *val) +{ + ptr->set_cell (idx, val); +} + +// Sparse support. +mwIndex * +mxGetIr (const mxArray *ptr) +{ + return ptr->get_ir (); +} + +mwIndex * +mxGetJc (const mxArray *ptr) +{ + return ptr->get_jc (); +} + +mwSize +mxGetNzmax (const mxArray *ptr) +{ + return ptr->get_nzmax (); +} + +void +mxSetIr (mxArray *ptr, mwIndex *ir) +{ + ptr->set_ir (static_cast (maybe_unmark (ir))); +} + +void +mxSetJc (mxArray *ptr, mwIndex *jc) +{ + ptr->set_jc (static_cast (maybe_unmark (jc))); +} + +void +mxSetNzmax (mxArray *ptr, mwSize nzmax) +{ + ptr->set_nzmax (nzmax); +} + +// Structure support. +int +mxAddField (mxArray *ptr, const char *key) +{ + return ptr->add_field (key); +} + +void +mxRemoveField (mxArray *ptr, int key_num) +{ + ptr->remove_field (key_num); +} + +mxArray * +mxGetField (const mxArray *ptr, mwIndex index, const char *key) +{ + int key_num = mxGetFieldNumber (ptr, key); + return mxGetFieldByNumber (ptr, index, key_num); +} + +mxArray * +mxGetFieldByNumber (const mxArray *ptr, mwIndex index, int key_num) +{ + return ptr->get_field_by_number (index, key_num); +} + +void +mxSetField (mxArray *ptr, mwIndex index, const char *key, mxArray *val) +{ + int key_num = mxGetFieldNumber (ptr, key); + mxSetFieldByNumber (ptr, index, key_num, val); +} + +void +mxSetFieldByNumber (mxArray *ptr, mwIndex index, int key_num, mxArray *val) +{ + ptr->set_field_by_number (index, key_num, val); +} + +int +mxGetNumberOfFields (const mxArray *ptr) +{ + return ptr->get_number_of_fields (); +} + +const char * +mxGetFieldNameByNumber (const mxArray *ptr, int key_num) +{ + return ptr->get_field_name_by_number (key_num); +} + +int +mxGetFieldNumber (const mxArray *ptr, const char *key) +{ + return ptr->get_field_number (key); +} + +int +mxGetString (const mxArray *ptr, char *buf, mwSize buflen) +{ + return ptr->get_string (buf, buflen); +} + +char * +mxArrayToString (const mxArray *ptr) +{ + return ptr->array_to_string (); +} + +mwIndex +mxCalcSingleSubscript (const mxArray *ptr, mwSize nsubs, mwIndex *subs) +{ + return ptr->calc_single_subscript (nsubs, subs); +} + +size_t +mxGetElementSize (const mxArray *ptr) +{ + return ptr->get_element_size (); +} + +// ------------------------------------------------------------------ + +typedef void (*cmex_fptr) (int nlhs, mxArray **plhs, int nrhs, mxArray **prhs); +typedef F77_RET_T (*fmex_fptr) (int& nlhs, mxArray **plhs, int& nrhs, mxArray **prhs); + +octave_value_list +call_mex (bool have_fmex, void *f, const octave_value_list& args, + int nargout_arg, octave_mex_function *curr_mex_fcn) +{ + // Use at least 1 for nargout since even for zero specified args, + // still want to be able to return an ans. + + volatile int nargout = nargout_arg; + + int nargin = args.length (); + OCTAVE_LOCAL_BUFFER (mxArray *, argin, nargin); + for (int i = 0; i < nargin; i++) + argin[i] = 0; + + int nout = nargout == 0 ? 1 : nargout; + OCTAVE_LOCAL_BUFFER (mxArray *, argout, nout); + for (int i = 0; i < nout; i++) + argout[i] = 0; + + unwind_protect_safe frame; + + // Save old mex pointer. + frame.protect_var (mex_context); + + mex context (curr_mex_fcn); + + frame.add_fcn (mex::cleanup, static_cast (&context)); + + for (int i = 0; i < nargin; i++) + argin[i] = context.make_value (args(i)); + + if (setjmp (context.jump) == 0) + { + mex_context = &context; + + if (have_fmex) + { + fmex_fptr fcn = FCN_PTR_CAST (fmex_fptr, f); + + int tmp_nargout = nargout; + int tmp_nargin = nargin; + + fcn (tmp_nargout, argout, tmp_nargin, argin); + } + else + { + cmex_fptr fcn = FCN_PTR_CAST (cmex_fptr, f); + + fcn (nargout, argout, nargin, argin); + } + } + + // Convert returned array entries back into octave values. + + octave_value_list retval; + + if (! error_state) + { + if (nargout == 0 && argout[0]) + { + // We have something for ans. + nargout = 1; + } + + retval.resize (nargout); + + for (int i = 0; i < nargout; i++) + retval(i) = mxArray::as_octave_value (argout[i]); + } + + // Clean up mex resources. + frame.run (); + + return retval; +} + +// C interface to mex functions: + +const char * +mexFunctionName (void) +{ + return mex_context ? mex_context->function_name () : "unknown"; +} + +int +mexCallMATLAB (int nargout, mxArray *argout[], int nargin, + mxArray *argin[], const char *fname) +{ + octave_value_list args; + + // FIXME -- do we need unwind protect to clean up args? Off hand, I + // would say that this problem is endemic to Octave and we will + // continue to have memory leaks after Ctrl-C until proper exception + // handling is implemented. longjmp() only clears the stack, so any + // class which allocates data on the heap is going to leak. + + args.resize (nargin); + + for (int i = 0; i < nargin; i++) + args(i) = mxArray::as_octave_value (argin[i]); + + octave_value_list retval = feval (fname, args, nargout); + + if (error_state && mex_context->trap_feval_error == 0) + { + // FIXME -- is this the correct way to clean up? abort() is + // going to trigger a long jump, so the normal class destructors + // will not be called. Hopefully this will reduce things to a + // tiny leak. Maybe create a new octave memory tracer type + // which prints a friendly message every time it is + // created/copied/deleted to check this. + + args.resize (0); + retval.resize (0); + mex_context->abort (); + } + + int num_to_copy = retval.length (); + + if (nargout < retval.length ()) + num_to_copy = nargout; + + for (int i = 0; i < num_to_copy; i++) + { + // FIXME -- it would be nice to avoid copying the value here, + // but there is no way to steal memory from a matrix, never mind + // that matrix memory is allocated by new[] and mxArray memory + // is allocated by malloc(). + argout[i] = mex_context->make_value (retval (i)); + } + + while (num_to_copy < nargout) + argout[num_to_copy++] = 0; + + if (error_state) + { + error_state = 0; + return 1; + } + else + return 0; +} + +void +mexSetTrapFlag (int flag) +{ + if (mex_context) + mex_context->trap_feval_error = flag; +} + +int +mexEvalString (const char *s) +{ + int retval = 0; + + int parse_status; + + octave_value_list ret; + + ret = eval_string (s, false, parse_status, 0); + + if (parse_status || error_state) + { + error_state = 0; + + retval = 1; + } + + return retval; +} + +void +mexErrMsgTxt (const char *s) +{ + if (s && strlen (s) > 0) + error ("%s: %s", mexFunctionName (), s); + else + { + // For compatibility with Matlab, print an empty message. + // Octave's error routine requires a non-null input so use a SPACE. + error (" "); + } + + mex_context->abort (); +} + +void +mexErrMsgIdAndTxt (const char *id, const char *fmt, ...) +{ + if (fmt && strlen (fmt) > 0) + { + const char *fname = mexFunctionName (); + size_t len = strlen (fname) + 2 + strlen (fmt) + 1; + OCTAVE_LOCAL_BUFFER (char, tmpfmt, len); + sprintf (tmpfmt, "%s: %s", fname, fmt); + va_list args; + va_start (args, fmt); + verror_with_id (id, tmpfmt, args); + va_end (args); + } + else + { + // For compatibility with Matlab, print an empty message. + // Octave's error routine requires a non-null input so use a SPACE. + error (" "); + } + + mex_context->abort (); +} + +void +mexWarnMsgTxt (const char *s) +{ + warning ("%s", s); +} + +void +mexWarnMsgIdAndTxt (const char *id, const char *fmt, ...) +{ + // FIXME -- is this right? What does Matlab do if fmt is NULL or + // an empty string? + + if (fmt && strlen (fmt) > 0) + { + const char *fname = mexFunctionName (); + size_t len = strlen (fname) + 2 + strlen (fmt) + 1; + OCTAVE_LOCAL_BUFFER (char, tmpfmt, len); + sprintf (tmpfmt, "%s: %s", fname, fmt); + va_list args; + va_start (args, fmt); + vwarning_with_id (id, tmpfmt, args); + va_end (args); + } +} + +int +mexPrintf (const char *fmt, ...) +{ + int retval; + va_list args; + va_start (args, fmt); + retval = octave_vformat (octave_stdout, fmt, args); + va_end (args); + return retval; +} + +mxArray * +mexGetVariable (const char *space, const char *name) +{ + mxArray *retval = 0; + + octave_value val; + + if (! strcmp (space, "global")) + val = get_global_value (name); + else + { + // FIXME -- should this be in variables.cc? + + unwind_protect frame; + + bool caller = ! strcmp (space, "caller"); + bool base = ! strcmp (space, "base"); + + if (caller || base) + { + // MEX files don't create a separate frame in the call stack, + // so we are already in the "caller" frame. + + if (base) + { + octave_call_stack::goto_base_frame (); + + if (error_state) + return retval; + + frame.add_fcn (octave_call_stack::pop); + } + + val = symbol_table::varval (name); + } + else + mexErrMsgTxt ("mexGetVariable: symbol table does not exist"); + } + + if (val.is_defined ()) + { + retval = mex_context->make_value (val); + + retval->set_name (name); + } + + return retval; +} + +const mxArray * +mexGetVariablePtr (const char *space, const char *name) +{ + return mexGetVariable (space, name); +} + +int +mexPutVariable (const char *space, const char *name, const mxArray *ptr) +{ + if (! ptr) + return 1; + + if (! name) + return 1; + + if (name[0] == '\0') + name = ptr->get_name (); + + if (! name || name[0] == '\0') + return 1; + + if (! strcmp (space, "global")) + set_global_value (name, mxArray::as_octave_value (ptr)); + else + { + // FIXME -- should this be in variables.cc? + + unwind_protect frame; + + bool caller = ! strcmp (space, "caller"); + bool base = ! strcmp (space, "base"); + + if (caller || base) + { + // MEX files don't create a separate frame in the call stack, + // so we are already in the "caller" frame. + + if (base) + { + octave_call_stack::goto_base_frame (); + + if (error_state) + return 1; + + frame.add_fcn (octave_call_stack::pop); + } + + symbol_table::assign (name, mxArray::as_octave_value (ptr)); + } + else + mexErrMsgTxt ("mexPutVariable: symbol table does not exist"); + } + + return 0; +} + +void +mexMakeArrayPersistent (mxArray *ptr) +{ + maybe_unmark_array (ptr); +} + +void +mexMakeMemoryPersistent (void *ptr) +{ + maybe_unmark (ptr); +} + +int +mexAtExit (void (*f) (void)) +{ + if (mex_context) + { + octave_mex_function *curr_mex_fcn = mex_context->current_mex_function (); + + assert (curr_mex_fcn); + + curr_mex_fcn->atexit (f); + } + + return 0; +} + +const mxArray * +mexGet (double handle, const char *property) +{ + mxArray *m = 0; + octave_value ret = get_property_from_handle (handle, property, "mexGet"); + + if (!error_state && ret.is_defined ()) + m = ret.as_mxArray (); + return m; +} + +int +mexIsGlobal (const mxArray *ptr) +{ + return mxIsFromGlobalWS (ptr); +} + +int +mexIsLocked (void) +{ + int retval = 0; + + if (mex_context) + { + const char *fname = mexFunctionName (); + + retval = mislocked (fname); + } + + return retval; +} + +std::map mex_lock_count; + +void +mexLock (void) +{ + if (mex_context) + { + const char *fname = mexFunctionName (); + + if (mex_lock_count.find (fname) == mex_lock_count.end ()) + mex_lock_count[fname] = 1; + else + mex_lock_count[fname]++; + + mlock (); + } +} + +int +mexSet (double handle, const char *property, mxArray *val) +{ + bool ret = + set_property_in_handle (handle, property, mxArray::as_octave_value (val), + "mexSet"); + return (ret ? 0 : 1); +} + +void +mexUnlock (void) +{ + if (mex_context) + { + const char *fname = mexFunctionName (); + + std::map::iterator p = mex_lock_count.find (fname); + + if (p != mex_lock_count.end ()) + { + int count = --mex_lock_count[fname]; + + if (count == 0) + { + munlock (fname); + + mex_lock_count.erase (p); + } + } + } +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/mex.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/mex.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,175 @@ +/* + +Copyright (C) 2001-2012 Paul Kienzle + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +/* + +This code was originally distributed as part of Octave Forge under +the following terms: + +Author: Paul Kienzle +I grant this code to the public domain. +2001-03-22 + +THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. + +*/ + +/* mex.h is for use in C-programs only; do NOT include it in mex.cc */ + +#if ! defined (MEX_H) +#define MEX_H + +#define HAVE_OCTAVE + +typedef void mxArray; + +#if ! defined (__cplusplus) +typedef int bool; +#endif + +/* -V4 stuff */ +#if defined (V4) +#define Matrix mxArray +#define REAL mxREAL +#endif + +#define mxMAXNAME 64 + +#include "mexproto.h" + +#if defined (__cplusplus) +extern "C" { +#endif + +#if defined (V4) +void mexFunction (int nlhs, mxArray* plhs[], int nrhs, mxArray *prhs[]); +#else +void mexFunction (int nlhs, mxArray* plhs[], int nrhs, const mxArray *prhs[]); +#endif + +/* V4 floating point routines renamed in V5. */ +#define mexIsNaN mxIsNaN +#define mexIsFinite mxIsFinite +#define mexIsInf mxIsInf +#define mexGetEps mxGetEps +#define mexGetInf mxGetInf +#define mexGetNaN mxGetNan + +#define mexGetGlobal(nm) mexGetArray (nm, "global") +#define mexGetMatrix(nm) mexGetArray (nm, "caller") +#define mexGetMatrixPtr(nm) mexGetArrayPtr (nm, "caller") + +#define mexGetArray(nm, space) mexGetVariable (space, nm) +#define mexGetArrayPtr(nm, space) mexGetVariablePtr (space, nm) + +#define mexPutMatrix(ptr) mexPutVariable ("caller", "", ptr) +#define mexPutArray(ptr, space) mexPutVariable (space, "", ptr) + +#define mxCreateFull mxCreateDoubleMatrix + +#define mxCreateScalarDouble mxCreateDoubleScalar + +#define mxFreeMatrix mxDestroyArray + +#define mxIsString mxIsChar + +/* Apparently these are also defined. */ + +#ifndef UINT64_T +#define UINT64_T uint64_t +#endif + +#ifndef uint64_T +#define uint64_T uint64_t +#endif + +#ifndef INT64_T +#define INT64_T int64_t +#endif + +#ifndef int64_T +#define int64_T int64_t +#endif + +#ifndef UINT32_T +#define UINT32_T uint32_t +#endif + +#ifndef uint32_T +#define uint32_T uint32_t +#endif + +#ifndef INT32_T +#define INT32_T int32_t +#endif + +#ifndef int32_T +#define int32_T int32_t +#endif + +#ifndef UINT16_T +#define UINT16_T uint16_t +#endif + +#ifndef uint16_T +#define uint16_T uint16_t +#endif + +#ifndef INT16_T +#define INT16_T int16_t +#endif + +#ifndef int16_T +#define int16_T int16_t +#endif + +#ifndef UINT8_T +#define UINT8_T uint8_t +#endif + +#ifndef uint8_T +#define uint8_T uint8_t +#endif + +#ifndef INT8_T +#define INT8_T int8_t +#endif + +#ifndef int8_T +#define int8_T int8_t +#endif + +#if defined (__cplusplus) +} +#endif + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/mexproto.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/mexproto.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,280 @@ +/* + +Copyright (C) 2006-2012 Paul Kienzle + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +/* + +This code was originally distributed as part of Octave Forge under +the following terms: + +Author: Paul Kienzle +I grant this code to the public domain. +2001-03-22 + +THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. + +*/ + +/* mex.h is for use in C-programs only; do NOT include it in mex.cc */ + +#if ! defined (MEXPROTO_H) +#define MEXPROTO_H + +#if defined (__cplusplus) +#include +extern "C" { +#else +#include +#endif + +/* The definition of OCTINTERP_API is normally provided by Octave's + config.h file. This is provided for the case of mex.h included by + user programs that don't use Octave's config.h. */ +#if ! defined (OCTINTERP_API) +#if defined (_MSC_VER) +#define OCTINTERP_API __declspec(dllimport) +#else +/* All other compilers, at least for now. */ +#define OCTINTERP_API +#endif +#endif + +#define MXARRAY_TYPEDEFS_ONLY +#include "mxarray.h" +#undef MXARRAY_TYPEDEFS_ONLY + +/* Interface to the interpreter. */ +extern OCTINTERP_API const char *mexFunctionName (void); + +extern OCTINTERP_API int mexCallMATLAB (int nargout, mxArray *argout[], int nargin, mxArray *argin[], const char *fname); + +extern OCTINTERP_API void mexSetTrapFlag (int flag); +extern OCTINTERP_API int mexEvalString (const char *s); +extern OCTINTERP_API void mexErrMsgTxt (const char *s); +extern OCTINTERP_API void mexErrMsgIdAndTxt (const char *id, const char *s, ...); +extern OCTINTERP_API void mexWarnMsgTxt (const char *s); +extern OCTINTERP_API void mexWarnMsgIdAndTxt (const char *id, const char *s, ...); +extern OCTINTERP_API int mexPrintf (const char *fmt, ...); + +extern OCTINTERP_API mxArray *mexGetVariable (const char *space, const char *name); +extern OCTINTERP_API const mxArray *mexGetVariablePtr (const char *space, const char *name); + +extern OCTINTERP_API int mexPutVariable (const char *space, const char *name, + const mxArray *ptr); + +extern OCTINTERP_API void mexMakeArrayPersistent (mxArray *ptr); +extern OCTINTERP_API void mexMakeMemoryPersistent (void *ptr); + +extern OCTINTERP_API int mexAtExit (void (*f) (void)); +extern OCTINTERP_API const mxArray *mexGet (double handle, const char *property); +extern OCTINTERP_API int mexIsGlobal (const mxArray *ptr); +extern OCTINTERP_API int mexIsLocked (void); +extern OCTINTERP_API void mexLock (void); +extern OCTINTERP_API int mexSet (double handle, const char *property, mxArray *val); +extern OCTINTERP_API void mexUnlock (void); + +/* Floating point predicates. */ +extern OCTINTERP_API int mxIsFinite (double v); +extern OCTINTERP_API int mxIsInf (double v); +extern OCTINTERP_API int mxIsNaN (double v); + +/* Floating point values. */ +extern OCTINTERP_API double mxGetEps (void); +extern OCTINTERP_API double mxGetInf (void); +extern OCTINTERP_API double mxGetNaN (void); + +/* Memory management. */ +extern OCTINTERP_API void *mxCalloc (size_t n, size_t size); +extern OCTINTERP_API void *mxMalloc (size_t n); +extern OCTINTERP_API void *mxRealloc (void *ptr, size_t size); +extern OCTINTERP_API void mxFree (void *ptr); + +/* Constructors. */ +extern OCTINTERP_API mxArray *mxCreateCellArray (mwSize ndims, const mwSize *dims); +extern OCTINTERP_API mxArray *mxCreateCellMatrix (mwSize m, mwSize n); +extern OCTINTERP_API mxArray *mxCreateCharArray (mwSize ndims, const mwSize *dims); +extern OCTINTERP_API mxArray *mxCreateCharMatrixFromStrings (mwSize m, const char **str); +extern OCTINTERP_API mxArray *mxCreateDoubleMatrix (mwSize nr, mwSize nc, mxComplexity flag); +extern OCTINTERP_API mxArray *mxCreateDoubleScalar (double val); +extern OCTINTERP_API mxArray *mxCreateLogicalArray (mwSize ndims, const mwSize *dims); +extern OCTINTERP_API mxArray *mxCreateLogicalMatrix (mwSize m, mwSize n); +extern OCTINTERP_API mxArray *mxCreateLogicalScalar (mxLogical val); +extern OCTINTERP_API mxArray *mxCreateNumericArray (mwSize ndims, const mwSize *dims, mxClassID class_id, mxComplexity flag); +extern OCTINTERP_API mxArray *mxCreateNumericMatrix (mwSize m, mwSize n, mxClassID class_id, mxComplexity flag); +extern OCTINTERP_API mxArray *mxCreateSparse (mwSize m, mwSize n, mwSize nzmax, mxComplexity flag); +extern OCTINTERP_API mxArray *mxCreateSparseLogicalMatrix (mwSize m, mwSize n, mwSize nzmax); +extern OCTINTERP_API mxArray *mxCreateString (const char *str); +extern OCTINTERP_API mxArray *mxCreateStructArray (mwSize ndims, const mwSize *dims, int num_keys, const char **keys); +extern OCTINTERP_API mxArray *mxCreateStructMatrix (mwSize rows, mwSize cols, int num_keys, const char **keys); + +/* Copy constructor. */ +extern OCTINTERP_API mxArray *mxDuplicateArray (const mxArray *v); + +/* Destructor. */ +extern OCTINTERP_API void mxDestroyArray (mxArray *v); + +/* Type Predicates. */ +extern OCTINTERP_API int mxIsCell (const mxArray *ptr); +extern OCTINTERP_API int mxIsChar (const mxArray *ptr); +extern OCTINTERP_API int mxIsClass (const mxArray *ptr, const char *name); +extern OCTINTERP_API int mxIsComplex (const mxArray *ptr); +extern OCTINTERP_API int mxIsDouble (const mxArray *ptr); +extern OCTINTERP_API int mxIsFunctionHandle (const mxArray *ptr); +extern OCTINTERP_API int mxIsInt16 (const mxArray *ptr); +extern OCTINTERP_API int mxIsInt32 (const mxArray *ptr); +extern OCTINTERP_API int mxIsInt64 (const mxArray *ptr); +extern OCTINTERP_API int mxIsInt8 (const mxArray *ptr); +extern OCTINTERP_API int mxIsLogical (const mxArray *ptr); +extern OCTINTERP_API int mxIsNumeric (const mxArray *ptr); +extern OCTINTERP_API int mxIsSingle (const mxArray *ptr); +extern OCTINTERP_API int mxIsSparse (const mxArray *ptr); +extern OCTINTERP_API int mxIsStruct (const mxArray *ptr); +extern OCTINTERP_API int mxIsUint16 (const mxArray *ptr); +extern OCTINTERP_API int mxIsUint32 (const mxArray *ptr); +extern OCTINTERP_API int mxIsUint64 (const mxArray *ptr); +extern OCTINTERP_API int mxIsUint8 (const mxArray *ptr); + +/* Odd type+size predicate. */ +extern OCTINTERP_API int mxIsLogicalScalar (const mxArray *ptr); + +/* Odd type+size+value predicate. */ +extern OCTINTERP_API int mxIsLogicalScalarTrue (const mxArray *ptr); + +/* Size predicate. */ +extern OCTINTERP_API int mxIsEmpty (const mxArray *ptr); + +/* Just plain odd thing to ask of a value. */ +extern OCTINTERP_API int mxIsFromGlobalWS (const mxArray *ptr); + +/* Dimension extractors. */ +extern OCTINTERP_API size_t mxGetM (const mxArray *ptr); +extern OCTINTERP_API size_t mxGetN (const mxArray *ptr); +extern OCTINTERP_API mwSize *mxGetDimensions (const mxArray *ptr); +extern OCTINTERP_API mwSize mxGetNumberOfDimensions (const mxArray *ptr); +extern OCTINTERP_API size_t mxGetNumberOfElements (const mxArray *ptr); + +/* Dimension setters. */ +extern OCTINTERP_API void mxSetM (mxArray *ptr, mwSize M); +extern OCTINTERP_API void mxSetN (mxArray *ptr, mwSize N); +extern OCTINTERP_API void mxSetDimensions (mxArray *ptr, const mwSize *dims, mwSize ndims); + +/* Data extractors. */ +extern OCTINTERP_API double *mxGetPi (const mxArray *ptr); +extern OCTINTERP_API double *mxGetPr (const mxArray *ptr); +extern OCTINTERP_API double mxGetScalar (const mxArray *ptr); +extern OCTINTERP_API mxChar *mxGetChars (const mxArray *ptr); +extern OCTINTERP_API mxLogical *mxGetLogicals (const mxArray *ptr); +extern OCTINTERP_API void *mxGetData (const mxArray *ptr); +extern OCTINTERP_API void *mxGetImagData (const mxArray *ptr); + +/* Data setters. */ +extern OCTINTERP_API void mxSetPr (mxArray *ptr, double *pr); +extern OCTINTERP_API void mxSetPi (mxArray *ptr, double *pi); +extern OCTINTERP_API void mxSetData (mxArray *ptr, void *data); +extern OCTINTERP_API void mxSetImagData (mxArray *ptr, void *pi); + +/* Classes. */ +extern OCTINTERP_API mxClassID mxGetClassID (const mxArray *ptr); +extern OCTINTERP_API const char *mxGetClassName (const mxArray *ptr); + +extern OCTINTERP_API void mxSetClassName (mxArray *ptr, const char *name); + +/* Cell support. */ +extern OCTINTERP_API mxArray *mxGetCell (const mxArray *ptr, mwIndex idx); + +extern OCTINTERP_API void mxSetCell (mxArray *ptr, mwIndex idx, mxArray *val); + +/* Sparse support. */ +extern OCTINTERP_API mwIndex *mxGetIr (const mxArray *ptr); +extern OCTINTERP_API mwIndex *mxGetJc (const mxArray *ptr); +extern OCTINTERP_API mwSize mxGetNzmax (const mxArray *ptr); + +extern OCTINTERP_API void mxSetIr (mxArray *ptr, mwIndex *ir); +extern OCTINTERP_API void mxSetJc (mxArray *ptr, mwIndex *jc); +extern OCTINTERP_API void mxSetNzmax (mxArray *ptr, mwSize nzmax); + +/* Structure support. */ +extern OCTINTERP_API int mxAddField (mxArray *ptr, const char *key); + +extern OCTINTERP_API void mxRemoveField (mxArray *ptr, int key_num); + +extern OCTINTERP_API mxArray *mxGetField (const mxArray *ptr, mwIndex index, const char *key); +extern OCTINTERP_API mxArray *mxGetFieldByNumber (const mxArray *ptr, mwIndex index, int key_num); + +extern OCTINTERP_API void mxSetField (mxArray *ptr, mwIndex index, const char *key, mxArray *val); +extern OCTINTERP_API void mxSetFieldByNumber (mxArray *ptr, mwIndex index, int key_num, mxArray *val); + +extern OCTINTERP_API int mxGetNumberOfFields (const mxArray *ptr); + +extern OCTINTERP_API const char *mxGetFieldNameByNumber (const mxArray *ptr, int key_num); +extern OCTINTERP_API int mxGetFieldNumber (const mxArray *ptr, const char *key); + +extern OCTINTERP_API int mxGetString (const mxArray *ptr, char *buf, mwSize buflen); +extern OCTINTERP_API char *mxArrayToString (const mxArray *ptr); + +/* Miscellaneous. */ +#ifdef NDEBUG +#define mxAssert(expr, msg) \ + do \ + { \ + if (! expr) \ + { \ + mexPrintf ("Assertion failed: %s, at line %d of file \"%s\".\n%s\n", \ + #expr, __LINE__, __FILE__, msg); \ + } \ + } \ + while (0) + +#define mxAssertS(expr, msg) \ + do \ + { \ + if (! expr) \ + { \ + mexPrintf ("Assertion failed at line %d of file \"%s\".\n%s\n", \ + __LINE__, __FILE__, msg); \ + abort (); \ + } \ + } \ + while (0) +#else +#define mxAssert(expr, msg) +#define mxAssertS(expr, msg) +#endif + +extern OCTINTERP_API mwIndex mxCalcSingleSubscript (const mxArray *ptr, mwSize nsubs, mwIndex *subs); + +extern OCTINTERP_API size_t mxGetElementSize (const mxArray *ptr); + +#if defined (__cplusplus) +} +#endif + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/module.mk --- a/libinterp/corefcn/module.mk Wed Jul 03 13:48:49 2013 -0700 +++ b/libinterp/corefcn/module.mk Wed Jul 03 17:43:48 2013 -0700 @@ -1,5 +1,10 @@ EXTRA_DIST += \ - corefcn/module.mk + corefcn/module.mk \ + corefcn/defaults.in.h \ + corefcn/gl2ps.c \ + corefcn/graphics.in.h \ + corefcn/mxarray.in.h \ + corefcn/oct-errno.in.cc ## Options functions for Fortran packages like LSODE, DASPK. ## These are generated automagically by configure and Perl. @@ -24,7 +29,101 @@ $(OPT_INC) : %.h : %.in $(MAKE) -C $(top_builddir)/liboctave/numeric $(@F) +JIT_INC = \ + corefcn/jit-util.h \ + corefcn/jit-typeinfo.h \ + corefcn/jit-ir.h \ + corefcn/pt-jit.h + +COREFCN_INC = \ + corefcn/Cell.h \ + corefcn/action-container.h \ + corefcn/c-file-ptr-stream.h \ + corefcn/comment-list.h \ + corefcn/cutils.h \ + corefcn/data.h \ + corefcn/debug.h \ + corefcn/defun-dld.h \ + corefcn/defun-int.h \ + corefcn/defun.h \ + corefcn/dirfns.h \ + corefcn/display.h \ + corefcn/dynamic-ld.h \ + corefcn/error.h \ + corefcn/event-queue.h \ + corefcn/file-io.h \ + corefcn/gl-render.h \ + corefcn/gl2ps-renderer.h \ + corefcn/gl2ps.h \ + corefcn/gripes.h \ + corefcn/help.h \ + corefcn/hook-fcn.h \ + corefcn/input.h \ + corefcn/load-path.h \ + corefcn/load-save.h \ + corefcn/ls-ascii-helper.h \ + corefcn/ls-hdf5.h \ + corefcn/ls-mat-ascii.h \ + corefcn/ls-mat4.h \ + corefcn/ls-mat5.h \ + corefcn/ls-oct-ascii.h \ + corefcn/ls-oct-binary.h \ + corefcn/ls-utils.h \ + corefcn/mex.h \ + corefcn/mexproto.h \ + corefcn/mxarray.in.h \ + corefcn/oct-errno.h \ + corefcn/oct-fstrm.h \ + corefcn/oct-hdf5.h \ + corefcn/oct-hist.h \ + corefcn/oct-iostrm.h \ + corefcn/oct-lvalue.h \ + corefcn/oct-map.h \ + corefcn/oct-obj.h \ + corefcn/oct-prcstrm.h \ + corefcn/oct-procbuf.h \ + corefcn/oct-stdstrm.h \ + corefcn/oct-stream.h \ + corefcn/oct-strstrm.h \ + corefcn/oct.h \ + corefcn/octave-link.h \ + corefcn/pager.h \ + corefcn/pr-output.h \ + corefcn/procstream.h \ + corefcn/profiler.h \ + corefcn/sighandlers.h \ + corefcn/siglist.h \ + corefcn/sparse-xdiv.h \ + corefcn/sparse-xpow.h \ + corefcn/symtab.h \ + corefcn/sysdep.h \ + corefcn/toplev.h \ + corefcn/txt-eng-ft.h \ + corefcn/txt-eng.h \ + corefcn/unwind-prot.h \ + corefcn/utils.h \ + corefcn/variables.h \ + corefcn/workspace-element.h \ + corefcn/xdiv.h \ + corefcn/xnorm.h \ + corefcn/xpow.h \ + corefcn/zfstream.h \ + $(JIT_INC) + +JIT_SRC = \ + corefcn/jit-util.cc \ + corefcn/jit-typeinfo.cc \ + corefcn/jit-ir.cc \ + corefcn/pt-jit.cc + +C_COREFCN_SRC = \ + corefcn/cutils.c \ + corefcn/matherr.c \ + corefcn/siglist.c \ + corefcn/xgl2ps.c + COREFCN_SRC = \ + corefcn/Cell.cc \ corefcn/__contourc__.cc \ corefcn/__dispatch__.cc \ corefcn/__lin_interpn__.cc \ @@ -35,20 +134,31 @@ corefcn/betainc.cc \ corefcn/bitfcns.cc \ corefcn/bsxfun.cc \ + corefcn/c-file-ptr-stream.cc \ corefcn/cellfun.cc \ corefcn/colloc.cc \ + corefcn/comment-list.cc \ corefcn/conv2.cc \ corefcn/daspk.cc \ corefcn/dasrt.cc \ corefcn/dassl.cc \ + corefcn/data.cc \ + corefcn/debug.cc \ + corefcn/defaults.cc \ + corefcn/defun.cc \ corefcn/det.cc \ + corefcn/dirfns.cc \ + corefcn/display.cc \ corefcn/dlmread.cc \ corefcn/dot.cc \ + corefcn/dynamic-ld.cc \ corefcn/eig.cc \ corefcn/ellipj.cc \ + corefcn/error.cc \ corefcn/fft.cc \ corefcn/fft2.cc \ corefcn/fftn.cc \ + corefcn/file-io.cc \ corefcn/filter.cc \ corefcn/find.cc \ corefcn/gammainc.cc \ @@ -57,11 +167,28 @@ corefcn/getpwent.cc \ corefcn/getrusage.cc \ corefcn/givens.cc \ + corefcn/gl-render.cc \ + corefcn/gl2ps-renderer.cc \ + corefcn/graphics.cc \ + corefcn/gripes.cc \ + corefcn/help.cc \ corefcn/hess.cc \ corefcn/hex2num.cc \ + corefcn/hook-fcn.cc \ + corefcn/input.cc \ corefcn/inv.cc \ corefcn/kron.cc \ + corefcn/load-path.cc \ + corefcn/load-save.cc \ corefcn/lookup.cc \ + corefcn/ls-ascii-helper.cc \ + corefcn/ls-hdf5.cc \ + corefcn/ls-mat-ascii.cc \ + corefcn/ls-mat4.cc \ + corefcn/ls-mat5.cc \ + corefcn/ls-oct-ascii.cc \ + corefcn/ls-oct-binary.cc \ + corefcn/ls-utils.cc \ corefcn/lsode.cc \ corefcn/lu.cc \ corefcn/luinc.cc \ @@ -69,9 +196,25 @@ corefcn/matrix_type.cc \ corefcn/max.cc \ corefcn/md5sum.cc \ + corefcn/mex.cc \ corefcn/mgorth.cc \ corefcn/nproc.cc \ + corefcn/oct-fstrm.cc \ + corefcn/oct-hist.cc \ + corefcn/oct-iostrm.cc \ + corefcn/oct-lvalue.cc \ + corefcn/oct-map.cc \ + corefcn/oct-obj.cc \ + corefcn/oct-prcstrm.cc \ + corefcn/oct-procbuf.cc \ + corefcn/oct-stream.cc \ + corefcn/oct-strstrm.cc \ + corefcn/octave-link.cc \ + corefcn/pager.cc \ corefcn/pinv.cc \ + corefcn/pr-output.cc \ + corefcn/procstream.cc \ + corefcn/profiler.cc \ corefcn/quad.cc \ corefcn/quadcc.cc \ corefcn/qz.cc \ @@ -79,6 +222,9 @@ corefcn/rcond.cc \ corefcn/regexp.cc \ corefcn/schur.cc \ + corefcn/sighandlers.cc \ + corefcn/sparse-xdiv.cc \ + corefcn/sparse-xpow.cc \ corefcn/sparse.cc \ corefcn/spparms.cc \ corefcn/sqrtm.cc \ @@ -88,10 +234,61 @@ corefcn/sub2ind.cc \ corefcn/svd.cc \ corefcn/syl.cc \ + corefcn/symtab.cc \ corefcn/syscalls.cc \ + corefcn/sysdep.cc \ corefcn/time.cc \ + corefcn/toplev.cc \ corefcn/tril.cc \ - corefcn/typecast.cc + corefcn/txt-eng-ft.cc \ + corefcn/typecast.cc \ + corefcn/unwind-prot.cc \ + corefcn/utils.cc \ + corefcn/variables.cc \ + corefcn/xdiv.cc \ + corefcn/xnorm.cc \ + corefcn/xpow.cc \ + corefcn/zfstream.cc \ + $(JIT_SRC) \ + $(C_COREFCN_SRC) + +## FIXME: Automake does not support per-object rules. +## These rules could be emulated by creating a new convenience +## library and using per-library rules. Or we can just live +## without the rule since there haven't been any problems. (09/18/2012) +#display.df display.lo: CPPFLAGS += $(X11_FLAGS) + +## Special rules for sources which must be built before rest of compilation. + +## defaults.h and graphics.h must depend on Makefile. Calling configure +## may change default/config values. However, calling configure will also +## regenerate the Makefiles from Makefile.am and trigger the rules below. +corefcn/defaults.h: corefcn/defaults.in.h Makefile + @$(do_subst_default_vals) + +corefcn/graphics.h: corefcn/graphics.in.h genprops.awk Makefile + $(AWK) -f $(srcdir)/genprops.awk $< > $@-t + mv $@-t $@ + +corefcn/graphics-props.cc: corefcn/graphics.in.h genprops.awk Makefile + $(AWK) -v emit_graphics_props=1 -f $(srcdir)/genprops.awk $< > $@-t + mv $@-t $@ + +corefcn/oct-errno.cc: corefcn/oct-errno.in.cc Makefile + if test -n "$(PERL)"; then \ + $(srcdir)/mk-errno-list --perl "$(PERL)" < $< > $@-t; \ + elif test -n "$(PYTHON)"; then \ + $(srcdir)/mk-errno-list --python "$(PYTHON)" < $< > $@-t; \ + else \ + $(SED) '/@SYSDEP_ERRNO_LIST@/D' $< > $@-t; \ + fi + mv $@-t $@ + +corefcn/mxarray.h: corefcn/mxarray.in.h Makefile + $(SED) < $< \ + -e "s|%NO_EDIT_WARNING%|DO NOT EDIT! Generated automatically from $( $@-t + mv $@-t $@ noinst_LTLIBRARIES += corefcn/libcorefcn.la diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/mxarray.in.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/mxarray.in.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,517 @@ +// %NO_EDIT_WARNING% +/* + +Copyright (C) 2001-2012 Paul Kienzle + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +/* + +Part of this code was originally distributed as part of Octave Forge under +the following terms: + +Author: Paul Kienzle +I grant this code to the public domain. +2001-03-22 + +THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. + +*/ + +#if ! defined (MXARRAY_H) +#define MXARRAY_H + +typedef enum + { + mxREAL = 0, + mxCOMPLEX = 1 + } + mxComplexity; + +typedef enum + { + mxUNKNOWN_CLASS = 0, + mxCELL_CLASS, + mxSTRUCT_CLASS, + mxLOGICAL_CLASS, + mxCHAR_CLASS, + mxUNUSED_CLASS, + mxDOUBLE_CLASS, + mxSINGLE_CLASS, + mxINT8_CLASS, + mxUINT8_CLASS, + mxINT16_CLASS, + mxUINT16_CLASS, + mxINT32_CLASS, + mxUINT32_CLASS, + mxINT64_CLASS, + mxUINT64_CLASS, + mxFUNCTION_CLASS + } + mxClassID; + +typedef unsigned char mxLogical; + +/* typedef Uint16 mxChar; */ +typedef char mxChar; + +/* + * FIXME? Mathworks says these should be size_t on 64-bit system and when + * mex is used with the -largearraydims flag, but why do that? Its better + * to conform to the same indexing as the rest of Octave + */ +typedef %OCTAVE_IDX_TYPE% mwSize; +typedef %OCTAVE_IDX_TYPE% mwIndex; +typedef %OCTAVE_IDX_TYPE% mwSignedIndex; + +#if ! defined (MXARRAY_TYPEDEFS_ONLY) + +#include + +class octave_value; + +#define DO_MUTABLE_METHOD(RET_T, METHOD_CALL) \ + RET_T retval = rep->METHOD_CALL; \ + \ + if (rep->mutation_needed ()) \ + { \ + maybe_mutate (); \ + retval = rep->METHOD_CALL; \ + } \ + \ + return retval + +#define DO_VOID_MUTABLE_METHOD(METHOD_CALL) \ + rep->METHOD_CALL; \ + \ + if (rep->mutation_needed ()) \ + { \ + maybe_mutate (); \ + rep->METHOD_CALL; \ + } + +// A class to provide the default implemenation of some of the virtual +// functions declared in the mxArray class. + +class mxArray; + +class mxArray_base +{ +protected: + + mxArray_base (void) { } + +public: + + virtual mxArray_base *dup (void) const = 0; + + virtual mxArray *as_mxArray (void) const { return 0; } + + virtual ~mxArray_base (void) { } + + virtual bool is_octave_value (void) const { return false; } + + virtual int is_cell (void) const = 0; + + virtual int is_char (void) const = 0; + + virtual int is_class (const char *name_arg) const + { + int retval = 0; + + const char *cname = get_class_name (); + + if (cname && name_arg) + retval = ! strcmp (cname, name_arg); + + return retval; + } + + virtual int is_complex (void) const = 0; + + virtual int is_double (void) const = 0; + + virtual int is_function_handle (void) const = 0; + + virtual int is_int16 (void) const = 0; + + virtual int is_int32 (void) const = 0; + + virtual int is_int64 (void) const = 0; + + virtual int is_int8 (void) const = 0; + + virtual int is_logical (void) const = 0; + + virtual int is_numeric (void) const = 0; + + virtual int is_single (void) const = 0; + + virtual int is_sparse (void) const = 0; + + virtual int is_struct (void) const = 0; + + virtual int is_uint16 (void) const = 0; + + virtual int is_uint32 (void) const = 0; + + virtual int is_uint64 (void) const = 0; + + virtual int is_uint8 (void) const = 0; + + virtual int is_logical_scalar (void) const + { + return is_logical () && get_number_of_elements () == 1; + } + + virtual int is_logical_scalar_true (void) const = 0; + + virtual mwSize get_m (void) const = 0; + + virtual mwSize get_n (void) const = 0; + + virtual mwSize *get_dimensions (void) const = 0; + + virtual mwSize get_number_of_dimensions (void) const = 0; + + virtual void set_m (mwSize m) = 0; + + virtual void set_n (mwSize n) = 0; + + virtual void set_dimensions (mwSize *dims_arg, mwSize ndims_arg) = 0; + + virtual mwSize get_number_of_elements (void) const = 0; + + virtual int is_empty (void) const = 0; + + virtual mxClassID get_class_id (void) const = 0; + + virtual const char *get_class_name (void) const = 0; + + virtual void set_class_name (const char *name_arg) = 0; + + virtual mxArray *get_cell (mwIndex /*idx*/) const + { + invalid_type_error (); + return 0; + } + + virtual void set_cell (mwIndex idx, mxArray *val) = 0; + + virtual double get_scalar (void) const = 0; + + virtual void *get_data (void) const = 0; + + virtual void *get_imag_data (void) const = 0; + + virtual void set_data (void *pr) = 0; + + virtual void set_imag_data (void *pi) = 0; + + virtual mwIndex *get_ir (void) const = 0; + + virtual mwIndex *get_jc (void) const = 0; + + virtual mwSize get_nzmax (void) const = 0; + + virtual void set_ir (mwIndex *ir) = 0; + + virtual void set_jc (mwIndex *jc) = 0; + + virtual void set_nzmax (mwSize nzmax) = 0; + + virtual int add_field (const char *key) = 0; + + virtual void remove_field (int key_num) = 0; + + virtual mxArray *get_field_by_number (mwIndex index, int key_num) const = 0; + + virtual void set_field_by_number (mwIndex index, int key_num, mxArray *val) = 0; + + virtual int get_number_of_fields (void) const = 0; + + virtual const char *get_field_name_by_number (int key_num) const = 0; + + virtual int get_field_number (const char *key) const = 0; + + virtual int get_string (char *buf, mwSize buflen) const = 0; + + virtual char *array_to_string (void) const = 0; + + virtual mwIndex calc_single_subscript (mwSize nsubs, mwIndex *subs) const = 0; + + virtual size_t get_element_size (void) const = 0; + + virtual bool mutation_needed (void) const { return false; } + + virtual mxArray *mutate (void) const { return 0; } + + virtual octave_value as_octave_value (void) const = 0; + +protected: + + mxArray_base (const mxArray_base&) { } + + void invalid_type_error (void) const + { + error ("invalid type for operation"); + } + + void error (const char *msg) const; +}; + +// The main interface class. The representation can be based on an +// octave_value object or a separate object that tries to reproduce +// the semantics of mxArray objects in Matlab more directly. + +class mxArray +{ +public: + + mxArray (const octave_value& ov); + + mxArray (mxClassID id, mwSize ndims, const mwSize *dims, + mxComplexity flag = mxREAL); + + mxArray (mxClassID id, const dim_vector& dv, mxComplexity flag = mxREAL); + + mxArray (mxClassID id, mwSize m, mwSize n, mxComplexity flag = mxREAL); + + mxArray (mxClassID id, double val); + + mxArray (mxClassID id, mxLogical val); + + mxArray (const char *str); + + mxArray (mwSize m, const char **str); + + mxArray (mxClassID id, mwSize m, mwSize n, mwSize nzmax, + mxComplexity flag = mxREAL); + + mxArray (mwSize ndims, const mwSize *dims, int num_keys, const char **keys); + + mxArray (const dim_vector& dv, int num_keys, const char **keys); + + mxArray (mwSize m, mwSize n, int num_keys, const char **keys); + + mxArray (mwSize ndims, const mwSize *dims); + + mxArray (const dim_vector& dv); + + mxArray (mwSize m, mwSize n); + + mxArray *dup (void) const + { + mxArray *retval = rep->as_mxArray (); + + if (retval) + retval->set_name (name); + else + { + mxArray_base *new_rep = rep->dup (); + + retval = new mxArray (new_rep, name); + } + + return retval; + } + + ~mxArray (void); + + bool is_octave_value (void) const { return rep->is_octave_value (); } + + int is_cell (void) const { return rep->is_cell (); } + + int is_char (void) const { return rep->is_char (); } + + int is_class (const char *name_arg) const { return rep->is_class (name_arg); } + + int is_complex (void) const { return rep->is_complex (); } + + int is_double (void) const { return rep->is_double (); } + + int is_function_handle (void) const { return rep->is_function_handle (); } + + int is_int16 (void) const { return rep->is_int16 (); } + + int is_int32 (void) const { return rep->is_int32 (); } + + int is_int64 (void) const { return rep->is_int64 (); } + + int is_int8 (void) const { return rep->is_int8 (); } + + int is_logical (void) const { return rep->is_logical (); } + + int is_numeric (void) const { return rep->is_numeric (); } + + int is_single (void) const { return rep->is_single (); } + + int is_sparse (void) const { return rep->is_sparse (); } + + int is_struct (void) const { return rep->is_struct (); } + + int is_uint16 (void) const { return rep->is_uint16 (); } + + int is_uint32 (void) const { return rep->is_uint32 (); } + + int is_uint64 (void) const { return rep->is_uint64 (); } + + int is_uint8 (void) const { return rep->is_uint8 (); } + + int is_logical_scalar (void) const { return rep->is_logical_scalar (); } + + int is_logical_scalar_true (void) const { return rep->is_logical_scalar_true (); } + + mwSize get_m (void) const { return rep->get_m (); } + + mwSize get_n (void) const { return rep->get_n (); } + + mwSize *get_dimensions (void) const { return rep->get_dimensions (); } + + mwSize get_number_of_dimensions (void) const { return rep->get_number_of_dimensions (); } + + void set_m (mwSize m) { DO_VOID_MUTABLE_METHOD (set_m (m)); } + + void set_n (mwSize n) { DO_VOID_MUTABLE_METHOD (set_n (n)); } + + void set_dimensions (mwSize *dims_arg, mwSize ndims_arg) { DO_VOID_MUTABLE_METHOD (set_dimensions (dims_arg, ndims_arg)); } + + mwSize get_number_of_elements (void) const { return rep->get_number_of_elements (); } + + int is_empty (void) const { return get_number_of_elements () == 0; } + + const char *get_name (void) const { return name; } + + void set_name (const char *name_arg); + + mxClassID get_class_id (void) const { return rep->get_class_id (); } + + const char *get_class_name (void) const { return rep->get_class_name (); } + + void set_class_name (const char *name_arg) { DO_VOID_MUTABLE_METHOD (set_class_name (name_arg)); } + + mxArray *get_cell (mwIndex idx) const { DO_MUTABLE_METHOD (mxArray *, get_cell (idx)); } + + void set_cell (mwIndex idx, mxArray *val) { DO_VOID_MUTABLE_METHOD (set_cell (idx, val)); } + + double get_scalar (void) const { return rep->get_scalar (); } + + void *get_data (void) const { DO_MUTABLE_METHOD (void *, get_data ()); } + + void *get_imag_data (void) const { DO_MUTABLE_METHOD (void *, get_imag_data ()); } + + void set_data (void *pr) { DO_VOID_MUTABLE_METHOD (set_data (pr)); } + + void set_imag_data (void *pi) { DO_VOID_MUTABLE_METHOD (set_imag_data (pi)); } + + mwIndex *get_ir (void) const { DO_MUTABLE_METHOD (mwIndex *, get_ir ()); } + + mwIndex *get_jc (void) const { DO_MUTABLE_METHOD (mwIndex *, get_jc ()); } + + mwSize get_nzmax (void) const { return rep->get_nzmax (); } + + void set_ir (mwIndex *ir) { DO_VOID_MUTABLE_METHOD (set_ir (ir)); } + + void set_jc (mwIndex *jc) { DO_VOID_MUTABLE_METHOD (set_jc (jc)); } + + void set_nzmax (mwSize nzmax) { DO_VOID_MUTABLE_METHOD (set_nzmax (nzmax)); } + + int add_field (const char *key) { DO_MUTABLE_METHOD (int, add_field (key)); } + + void remove_field (int key_num) { DO_VOID_MUTABLE_METHOD (remove_field (key_num)); } + + mxArray *get_field_by_number (mwIndex index, int key_num) const { DO_MUTABLE_METHOD (mxArray *, get_field_by_number (index, key_num)); } + + void set_field_by_number (mwIndex index, int key_num, mxArray *val) { DO_VOID_MUTABLE_METHOD (set_field_by_number (index, key_num, val)); } + + int get_number_of_fields (void) const { return rep->get_number_of_fields (); } + + const char *get_field_name_by_number (int key_num) const { DO_MUTABLE_METHOD (const char*, get_field_name_by_number (key_num)); } + + int get_field_number (const char *key) const { DO_MUTABLE_METHOD (int, get_field_number (key)); } + + int get_string (char *buf, mwSize buflen) const { return rep->get_string (buf, buflen); } + + char *array_to_string (void) const { return rep->array_to_string (); } + + mwIndex calc_single_subscript (mwSize nsubs, mwIndex *subs) const { return rep->calc_single_subscript (nsubs, subs); } + + size_t get_element_size (void) const { return rep->get_element_size (); } + + bool mutation_needed (void) const { return rep->mutation_needed (); } + + mxArray *mutate (void) const { return rep->mutate (); } + + static void *malloc (size_t n); + + static void *calloc (size_t n, size_t t); + + static char *strsave (const char *str) + { + char *retval = 0; + + if (str) + { + mwSize sz = sizeof (mxChar) * (strlen (str) + 1); + retval = static_cast (mxArray::malloc (sz)); + strcpy (retval, str); + } + + return retval; + } + + static octave_value as_octave_value (const mxArray *ptr); + +protected: + + octave_value as_octave_value (void) const; + +private: + + mutable mxArray_base *rep; + + char *name; + + mxArray (mxArray_base *r, const char *n) + : rep (r), name (mxArray::strsave (n)) { } + + void maybe_mutate (void) const; + + // No copying! + + mxArray (const mxArray&); + + mxArray& operator = (const mxArray&); +}; + +#undef DO_MUTABLE_METHOD +#undef DO_VOID_MUTABLE_METHOD + +#endif +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/oct-errno.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/oct-errno.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,72 @@ +// oct-errno.h.in +/* + +Copyright (C) 2005-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_errno_h) +#define octave_errno_h 1 + +#include +#include +#include + +#include "oct-map.h" + +class +octave_errno +{ +protected: + + octave_errno (void); + +public: + + ~octave_errno (void) { } + + static bool instance_ok (void); + + static void cleanup_instance (void) { delete instance; instance = 0; } + + static int lookup (const std::string& name); + + static octave_scalar_map list (void); + + static int get (void) { return errno; } + + static int set (int val) + { + int retval = errno; + errno = val; + return retval; + } + +private: + + std::map errno_tbl; + + static octave_errno *instance; + + int do_lookup (const std::string& name); + + octave_scalar_map do_list (void); +}; + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/oct-errno.in.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/oct-errno.in.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,345 @@ +// DO NOT EDIT! Generated automatically from oct-errno.in.cc by configure +/* + +Copyright (C) 2005-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "singleton-cleanup.h" + +#include "oct-errno.h" +#include "oct-map.h" +#include "error.h" + +octave_errno *octave_errno::instance = 0; + +octave_errno::octave_errno (void) +{ + struct errno_struct + { + const char *name; + int value; + }; + + static errno_struct errno_codes[] = + { + // POSIX. + +#if defined (E2BIG) + { "E2BIG", E2BIG, }, +#endif +#if defined (EACCES) + { "EACCES", EACCES, }, +#endif +#if defined (EADDRINUSE) + { "EADDRINUSE", EADDRINUSE, }, +#endif +#if defined (EADDRNOTAVAIL) + { "EADDRNOTAVAIL", EADDRNOTAVAIL, }, +#endif +#if defined (EAFNOSUPPORT) + { "EAFNOSUPPORT", EAFNOSUPPORT, }, +#endif +#if defined (EAGAIN) + { "EAGAIN", EAGAIN, }, +#endif +#if defined (EALREADY) + { "EALREADY", EALREADY, }, +#endif +#if defined (EBADF) + { "EBADF", EBADF, }, +#endif +#if defined (EBUSY) + { "EBUSY", EBUSY, }, +#endif +#if defined (ECHILD) + { "ECHILD", ECHILD, }, +#endif +#if defined (ECONNABORTED) + { "ECONNABORTED", ECONNABORTED, }, +#endif +#if defined (ECONNREFUSED) + { "ECONNREFUSED", ECONNREFUSED, }, +#endif +#if defined (ECONNRESET) + { "ECONNRESET", ECONNRESET, }, +#endif +#if defined (EDEADLK) + { "EDEADLK", EDEADLK, }, +#endif +#if defined (EDESTADDRREQ) + { "EDESTADDRREQ", EDESTADDRREQ, }, +#endif +#if defined (EDOM) + { "EDOM", EDOM, }, +#endif +#if defined (EDQUOT) + { "EDQUOT", EDQUOT, }, +#endif +#if defined (EEXIST) + { "EEXIST", EEXIST, }, +#endif +#if defined (EFAULT) + { "EFAULT", EFAULT, }, +#endif +#if defined (EFBIG) + { "EFBIG", EFBIG, }, +#endif +#if defined (EHOSTDOWN) + { "EHOSTDOWN", EHOSTDOWN, }, +#endif +#if defined (EHOSTUNREACH) + { "EHOSTUNREACH", EHOSTUNREACH, }, +#endif +#if defined (EINPROGRESS) + { "EINPROGRESS", EINPROGRESS, }, +#endif +#if defined (EINTR) + { "EINTR", EINTR, }, +#endif +#if defined (EINVAL) + { "EINVAL", EINVAL, }, +#endif +#if defined (EIO) + { "EIO", EIO, }, +#endif +#if defined (EISCONN) + { "EISCONN", EISCONN, }, +#endif +#if defined (EISDIR) + { "EISDIR", EISDIR, }, +#endif +#if defined (ELOOP) + { "ELOOP", ELOOP, }, +#endif +#if defined (EMFILE) + { "EMFILE", EMFILE, }, +#endif +#if defined (EMLINK) + { "EMLINK", EMLINK, }, +#endif +#if defined (EMSGSIZE) + { "EMSGSIZE", EMSGSIZE, }, +#endif +#if defined (ENAMETOOLONG) + { "ENAMETOOLONG", ENAMETOOLONG, }, +#endif +#if defined (ENETDOWN) + { "ENETDOWN", ENETDOWN, }, +#endif +#if defined (ENETRESET) + { "ENETRESET", ENETRESET, }, +#endif +#if defined (ENETUNREACH) + { "ENETUNREACH", ENETUNREACH, }, +#endif +#if defined (ENFILE) + { "ENFILE", ENFILE, }, +#endif +#if defined (ENOBUFS) + { "ENOBUFS", ENOBUFS, }, +#endif +#if defined (ENODEV) + { "ENODEV", ENODEV, }, +#endif +#if defined (ENOENT) + { "ENOENT", ENOENT, }, +#endif +#if defined (ENOEXEC) + { "ENOEXEC", ENOEXEC, }, +#endif +#if defined (ENOLCK) + { "ENOLCK", ENOLCK, }, +#endif +#if defined (ENOMEM) + { "ENOMEM", ENOMEM, }, +#endif +#if defined (ENOPROTOOPT) + { "ENOPROTOOPT", ENOPROTOOPT, }, +#endif +#if defined (ENOSPC) + { "ENOSPC", ENOSPC, }, +#endif +#if defined (ENOSYS) + { "ENOSYS", ENOSYS, }, +#endif +#if defined (ENOTBLK) + { "ENOTBLK", ENOTBLK, }, +#endif +#if defined (ENOTCONN) + { "ENOTCONN", ENOTCONN, }, +#endif +#if defined (ENOTDIR) + { "ENOTDIR", ENOTDIR, }, +#endif +#if defined (ENOTEMPTY) + { "ENOTEMPTY", ENOTEMPTY, }, +#endif +#if defined (ENOTSOCK) + { "ENOTSOCK", ENOTSOCK, }, +#endif +#if defined (ENOTTY) + { "ENOTTY", ENOTTY, }, +#endif +#if defined (ENXIO) + { "ENXIO", ENXIO, }, +#endif +#if defined (EOPNOTSUPP) + { "EOPNOTSUPP", EOPNOTSUPP, }, +#endif +#if defined (EPERM) + { "EPERM", EPERM, }, +#endif +#if defined (EPFNOSUPPORT) + { "EPFNOSUPPORT", EPFNOSUPPORT, }, +#endif +#if defined (EPIPE) + { "EPIPE", EPIPE, }, +#endif +#if defined (EPROTONOSUPPORT) + { "EPROTONOSUPPORT", EPROTONOSUPPORT, }, +#endif +#if defined (EPROTOTYPE) + { "EPROTOTYPE", EPROTOTYPE, }, +#endif +#if defined (ERANGE) + { "ERANGE", ERANGE, }, +#endif +#if defined (EREMOTE) + { "EREMOTE", EREMOTE, }, +#endif +#if defined (ERESTART) + { "ERESTART", ERESTART, }, +#endif +#if defined (EROFS) + { "EROFS", EROFS, }, +#endif +#if defined (ESHUTDOWN) + { "ESHUTDOWN", ESHUTDOWN, }, +#endif +#if defined (ESOCKTNOSUPPORT) + { "ESOCKTNOSUPPORT", ESOCKTNOSUPPORT, }, +#endif +#if defined (ESPIPE) + { "ESPIPE", ESPIPE, }, +#endif +#if defined (ESRCH) + { "ESRCH", ESRCH, }, +#endif +#if defined (ESTALE) + { "ESTALE", ESTALE, }, +#endif +#if defined (ETIMEDOUT) + { "ETIMEDOUT", ETIMEDOUT, }, +#endif +#if defined (ETOOMANYREFS) + { "ETOOMANYREFS", ETOOMANYREFS, }, +#endif +#if defined (ETXTBSY) + { "ETXTBSY", ETXTBSY, }, +#endif +#if defined (EUSERS) + { "EUSERS", EUSERS, }, +#endif +#if defined (EWOULDBLOCK) + { "EWOULDBLOCK", EWOULDBLOCK, }, +#endif +#if defined (EXDEV) + { "EXDEV", EXDEV, }, +#endif + + // Others (duplicates are OK). + +@SYSDEP_ERRNO_LIST@ + + { 0, 0, }, + }; + + // Stuff them all in a map for fast access. + + errno_struct *ptr = errno_codes; + + while (ptr->name) + { + errno_tbl[ptr->name] = ptr->value; + ptr++; + } +} + +bool +octave_errno::instance_ok (void) +{ + bool retval = true; + + if (! instance) + { + instance = new octave_errno (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } + + if (! instance) + { + ::error ("unable to create errno object!"); + + retval = false; + } + + return retval; +} + +int +octave_errno::lookup (const std::string& name) +{ + return (instance_ok ()) ? instance->do_lookup (name) : -1; +} + +octave_scalar_map +octave_errno::list (void) +{ + return (instance_ok ()) ? instance->do_list () : octave_scalar_map (); +} + +int +octave_errno::do_lookup (const std::string& name) +{ + return (errno_tbl.find (name) != errno_tbl.end ()) ? errno_tbl[name] : -1; +} + +octave_scalar_map +octave_errno::do_list (void) +{ + octave_scalar_map retval; + + for (std::map::const_iterator p = errno_tbl.begin (); + p != errno_tbl.end (); + p++) + { + retval.assign (p->first, p->second); + } + + return retval; +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/oct-fstrm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/oct-fstrm.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,114 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include "error.h" +#include "oct-fstrm.h" + +octave_stream +octave_fstream::create (const std::string& nm_arg, std::ios::openmode arg_md, + oct_mach_info::float_format ff) +{ + return octave_stream (new octave_fstream (nm_arg, arg_md, ff)); +} + +octave_fstream::octave_fstream (const std::string& nm_arg, + std::ios::openmode arg_md, + oct_mach_info::float_format ff) + : octave_base_stream (arg_md, ff), nm (nm_arg) +{ + +#if CXX_ISO_COMPLIANT_LIBRARY + + fs.open (nm.c_str (), arg_md); + +#else + // Override default protection of 0664 so that umask will appear to + // do the right thing. + + fs.open (nm.c_str (), arg_md, 0666); + +#endif + + if (! fs) + error (gnulib::strerror (errno)); +} + +// Position a stream at OFFSET relative to ORIGIN. + +int +octave_fstream::seek (off_t, int) +{ + error ("fseek: invalid_operation"); + return -1; +} + +// Return current stream position. + +off_t +octave_fstream::tell (void) +{ + error ("ftell: invalid_operation"); + return -1; +} + +// Return non-zero if EOF has been reached on this stream. + +bool +octave_fstream::eof (void) const +{ + return fs.eof (); +} + +void +octave_fstream::do_close (void) +{ + fs.close (); +} + +std::istream * +octave_fstream::input_stream (void) +{ + std::istream *retval = 0; + + if (mode () & std::ios::in) + retval = &fs; + + return retval; +} + +std::ostream * +octave_fstream::output_stream (void) +{ + std::ostream *retval = 0; + + if (mode () & std::ios::out) + retval = &fs; + + return retval; +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/oct-fstrm.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/oct-fstrm.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,86 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_octave_fstream_h) +#define octave_octave_fstream_h 1 + +#include +#include + +#include "oct-stream.h" + +class +octave_fstream : public octave_base_stream +{ +public: + + octave_fstream (const std::string& nm_arg, + std::ios::openmode arg_md = std::ios::in|std::ios::out, + oct_mach_info::float_format flt_fmt + = oct_mach_info::native_float_format ()); + + static octave_stream + create (const std::string& nm_arg, + std::ios::openmode arg_md = std::ios::in|std::ios::out, + oct_mach_info::float_format flt_fmt + = oct_mach_info::native_float_format ()); + + // Position a stream at OFFSET relative to ORIGIN. + + int seek (off_t offset, int origin); + + // Return current stream position. + + off_t tell (void); + + // Return non-zero if EOF has been reached on this stream. + + bool eof (void) const; + + void do_close (void); + + // The name of the file. + + std::string name (void) const { return nm; } + + std::istream *input_stream (void); + + std::ostream *output_stream (void); + +protected: + + ~octave_fstream (void) { } + +private: + + std::string nm; + + std::fstream fs; + + // No copying! + + octave_fstream (const octave_fstream&); + + octave_fstream& operator = (const octave_fstream&); +}; + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/oct-hdf5.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/oct-hdf5.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,30 @@ +/* + +Copyright (C) 2009-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave__hdf5_h) +#define octave_hdf5_h 1 + +#if defined (HAVE_HDF5) +#include +#endif + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/oct-hist.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/oct-hist.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,871 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +/* + +The functions listed below were adapted from similar functions from +GNU Bash, the Bourne Again SHell, copyright (C) 1987, 1989, 1991 Free +Software Foundation, Inc. + + do_history edit_history_readline + do_edit_history edit_history_add_hist + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include + +#include + +#include +#include + +#include "cmd-hist.h" +#include "file-ops.h" +#include "lo-mappers.h" +#include "octave-link.h" +#include "oct-env.h" +#include "oct-time.h" +#include "str-vec.h" + +#include +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "input.h" +#include "oct-hist.h" +#include "oct-obj.h" +#include "pager.h" +#include "parse.h" +#include "sighandlers.h" +#include "sysdep.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +// TRUE means input is coming from temporary history file. +bool input_from_tmp_history_file = false; + +static std::string +default_history_file (void) +{ + std::string file; + + std::string env_file = octave_env::getenv ("OCTAVE_HISTFILE"); + + if (! env_file.empty ()) + file = env_file; + + if (file.empty ()) + file = file_ops::concat (octave_env::get_home_directory (), + ".octave_hist"); + + return file; +} + +static int +default_history_size (void) +{ + int size = 1000; + + std::string env_size = octave_env::getenv ("OCTAVE_HISTSIZE"); + + if (! env_size.empty ()) + { + int val; + + if (sscanf (env_size.c_str (), "%d", &val) == 1) + size = val > 0 ? val : 0; + } + + return size; +} + +static std::string +default_history_timestamp_format (void) +{ + return + std::string ("# Octave " OCTAVE_VERSION ", %a %b %d %H:%M:%S %Y %Z <") + + octave_env::get_user_name () + + std::string ("@") + + octave_env::get_host_name () + + std::string (">"); +} + +// The format of the timestamp marker written to the history file when +// Octave exits. +static std::string Vhistory_timestamp_format_string + = default_history_timestamp_format (); + +// Display, save, or load history. Stolen and modified from bash. +// +// Arg of -w FILENAME means write file, arg of -r FILENAME +// means read file, arg of -q means don't number lines. Arg of N +// means only display that many items. + +static string_vector +do_history (const octave_value_list& args, int nargout) +{ + bool numbered_output = nargout == 0; + + unwind_protect frame; + + string_vector hlist; + + frame.add_fcn (command_history::set_file, command_history::file ()); + + int nargin = args.length (); + + // Number of history lines to show (-1 = all) + int limit = -1; + + for (octave_idx_type i = 0; i < nargin; i++) + { + octave_value arg = args(i); + + std::string option; + + if (arg.is_string ()) + option = arg.string_value (); + else if (arg.is_numeric_type ()) + { + limit = arg.int_value (); + if (limit < 0) + limit = -limit; + continue; + } + else + { + gripe_wrong_type_arg ("history", arg); + return hlist; + } + + if (option == "-r" || option == "-w" || option == "-a" + || option == "-n") + { + if (i < nargin - 1) + { + if (args(i+1).is_string ()) + command_history::set_file (args(++i).string_value ()); + else + { + error ("history: expecting file name for %s option", + option.c_str ()); + return hlist; + } + } + else + command_history::set_file (default_history_file ()); + + if (option == "-a") + // Append 'new' lines to file. + command_history::append (); + + else if (option == "-w") + // Write entire history. + command_history::write (); + + else if (option == "-r") + { + // Read entire file. + command_history::read (); + octave_link::set_history (command_history::list ()); + } + + else if (option == "-n") + { + // Read 'new' history from file. + command_history::read_range (); + octave_link::set_history (command_history::list ()); + } + + else + panic_impossible (); + + return hlist; + } + else if (option == "-c") + { + command_history::clear (); + octave_link::clear_history (); + } + else if (option == "-q") + numbered_output = false; + else if (option == "--") + { + i++; + break; + } + else + { + // The last argument found in the command list that looks like + // an integer will be used + int tmp; + + if (sscanf (option.c_str (), "%d", &tmp) == 1) + { + if (tmp > 0) + limit = tmp; + else + limit = -tmp; + } + + else + { + if (option.length () > 0 && option[0] == '-') + error ("history: unrecognized option '%s'", option.c_str ()); + else + error ("history: bad non-numeric arg '%s'", option.c_str ()); + + return hlist; + } + } + } + + hlist = command_history::list (limit, numbered_output); + + int len = hlist.length (); + + if (nargout == 0) + { + for (octave_idx_type i = 0; i < len; i++) + octave_stdout << hlist[i] << "\n"; + } + + return hlist; +} + +// Read the edited history lines from STREAM and return them +// one at a time. This can read unlimited length lines. The +// caller should free the storage. + +static char * +edit_history_readline (std::fstream& stream) +{ + char c; + int line_len = 128; + int lindex = 0; + char *line = new char [line_len]; + line[0] = '\0'; + + while (stream.get (c)) + { + if (lindex + 2 >= line_len) + { + char *tmp_line = new char [line_len += 128]; + strcpy (tmp_line, line); + delete [] line; + line = tmp_line; + } + + if (c == '\n') + { + line[lindex++] = '\n'; + line[lindex++] = '\0'; + return line; + } + else + line[lindex++] = c; + } + + if (! lindex) + { + delete [] line; + return 0; + } + + if (lindex + 2 >= line_len) + { + char *tmp_line = new char [lindex+3]; + strcpy (tmp_line, line); + delete [] line; + line = tmp_line; + } + + // Finish with newline if none in file. + + line[lindex++] = '\n'; + line[lindex++] = '\0'; + return line; +} + +static void +edit_history_add_hist (const std::string& line) +{ + if (! line.empty ()) + { + std::string tmp = line; + + int len = tmp.length (); + + if (len > 0 && tmp[len-1] == '\n') + tmp.resize (len - 1); + + if (! tmp.empty ()) + { + command_history::add (tmp); + octave_link::append_history (tmp); + } + } +} + +static bool +get_int_arg (const octave_value& arg, int& val) +{ + bool ok = true; + + if (arg.is_string ()) + { + std::string tmp = arg.string_value (); + + ok = sscanf (tmp.c_str (), "%d", &val) == 1; + } + else if (arg.is_numeric_type ()) + val = arg.int_value (); + else + ok = false; + + return ok; +} + +static std::string +mk_tmp_hist_file (const octave_value_list& args, + bool insert_curr, const char *warn_for) +{ + std::string retval; + + string_vector hlist = command_history::list (); + + int hist_count = hlist.length () - 1; // switch to zero-based indexing + + // The current command line is already part of the history list by + // the time we get to this point. Delete the cmd from the list when + // executing 'edit_history' so that it doesn't show up in the history + // but the actual commands performed will. + + if (! insert_curr) + command_history::remove (hist_count); + + hist_count--; // skip last entry in history list + + // If no numbers have been specified, the default is to edit the + // last command in the history list. + + int hist_beg = hist_count; + int hist_end = hist_count; + + bool reverse = false; + + // Process options. + + int nargin = args.length (); + + bool usage_error = false; + if (nargin == 2) + { + if (get_int_arg (args(0), hist_beg) + && get_int_arg (args(1), hist_end)) + { + if (hist_beg < 0) + hist_beg += (hist_count + 1); + else + hist_beg--; + if (hist_end < 0) + hist_end += (hist_count + 1); + else + hist_end--; + } + else + usage_error = true; + } + else if (nargin == 1) + { + if (get_int_arg (args(0), hist_beg)) + { + if (hist_beg < 0) + hist_beg += (hist_count + 1); + else + hist_beg--; + hist_end = hist_beg; + } + else + usage_error = true; + } + + if (usage_error) + { + usage ("%s [first] [last]", warn_for); + return retval; + } + + if (hist_beg > hist_count || hist_end > hist_count) + { + error ("%s: history specification out of range", warn_for); + return retval; + } + + if (hist_end < hist_beg) + { + std::swap (hist_end, hist_beg); + reverse = true; + } + + std::string name = octave_tempnam ("", "oct-"); + + std::fstream file (name.c_str (), std::ios::out); + + if (! file) + { + error ("%s: couldn't open temporary file '%s'", warn_for, + name.c_str ()); + return retval; + } + + if (reverse) + { + for (int i = hist_end; i >= hist_beg; i--) + file << hlist[i] << "\n"; + } + else + { + for (int i = hist_beg; i <= hist_end; i++) + file << hlist[i] << "\n"; + } + + file.close (); + + return name; +} + +static void +unlink_cleanup (const char *file) +{ + gnulib::unlink (file); +} + +static void +do_edit_history (const octave_value_list& args) +{ + std::string name = mk_tmp_hist_file (args, false, "edit_history"); + + if (name.empty ()) + return; + + // Call up our favorite editor on the file of commands. + + std::string cmd = VEDITOR; + cmd.append (" \"" + name + "\""); + + // Ignore interrupts while we are off editing commands. Should we + // maybe avoid using system()? + + volatile octave_interrupt_handler old_interrupt_handler + = octave_ignore_interrupts (); + + int status = system (cmd.c_str ()); + + octave_set_interrupt_handler (old_interrupt_handler); + + // Check if text edition was successfull. Abort the operation + // in case of failure. + if (status != EXIT_SUCCESS) + { + error ("edit_history: text editor command failed"); + return; + } + + // Write the commands to the history file since source_file + // disables command line history while it executes. + + std::fstream file (name.c_str (), std::ios::in); + + char *line; + //int first = 1; + while ((line = edit_history_readline (file)) != 0) + { + // Skip blank lines. + + if (line[0] == '\n') + { + delete [] line; + continue; + } + + edit_history_add_hist (line); + + delete [] line; + } + + file.close (); + + // Turn on command echo, so the output from this will make better + // sense. + + unwind_protect frame; + + frame.add_fcn (unlink_cleanup, name.c_str ()); + frame.protect_var (Vecho_executing_commands); + frame.protect_var (input_from_tmp_history_file); + + Vecho_executing_commands = ECHO_CMD_LINE; + input_from_tmp_history_file = true; + + source_file (name); +} + +static void +do_run_history (const octave_value_list& args) +{ + std::string name = mk_tmp_hist_file (args, false, "run_history"); + + if (name.empty ()) + return; + + // Turn on command echo so the output from this will make better sense. + + unwind_protect frame; + + frame.add_fcn (unlink_cleanup, name.c_str ()); + frame.protect_var (Vecho_executing_commands); + frame.protect_var (input_from_tmp_history_file); + + Vecho_executing_commands = ECHO_CMD_LINE; + input_from_tmp_history_file = true; + + source_file (name); +} + +void +initialize_history (bool read_history_file) +{ + command_history::initialize (read_history_file, + default_history_file (), + default_history_size (), + octave_env::getenv ("OCTAVE_HISTCONTROL")); + + octave_link::set_history (command_history::list ()); +} + +void +octave_history_write_timestamp (void) +{ + octave_localtime now; + + std::string timestamp = now.strftime (Vhistory_timestamp_format_string); + + if (! timestamp.empty ()) + { + command_history::add (timestamp); + octave_link::append_history (timestamp); + } +} + +DEFUN (edit_history, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} edit_history\n\ +@deftypefnx {Command} {} edit_history @var{cmd_number}\n\ +@deftypefnx {Command} {} edit_history @var{first} @var{last}\n\ +Edit the history list using the editor named by the variable\n\ +@w{@env{EDITOR}}.\n\ +\n\ +The commands to be edited are first copied to a temporary file. When you\n\ +exit the editor, Octave executes the commands that remain in the file. It\n\ +is often more convenient to use @code{edit_history} to define functions\n\ +rather than attempting to enter them directly on the command line.\n\ +The block of commands is executed as soon as you exit the editor.\n\ +To avoid executing any commands, simply delete all the lines from the buffer\n\ +before leaving the editor.\n\ +\n\ +When invoked with no arguments, edit the previously executed command;\n\ +With one argument, edit the specified command @var{cmd_number};\n\ +With two arguments, edit the list of commands between @var{first} and\n\ +@var{last}. Command number specifiers may also be negative where -1\n\ +refers to the most recently executed command.\n\ +The following are equivalent and edit the most recently executed command.\n\ +\n\ +@example\n\ +@group\n\ +edit_history\n\ +edit_history -1\n\ +@end group\n\ +@end example\n\ +\n\ +When using ranges, specifying a larger number for the first command than the\n\ +last command reverses the list of commands before they are placed in the\n\ +buffer to be edited.\n\ +@seealso{run_history}\n\ +@end deftypefn") +{ + octave_value_list retval; + + do_edit_history (args); + + return retval; +} + +DEFUN (history, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Command} {} history\n\ +@deftypefnx {Command} {} history @var{opt1} @dots{}\n\ +@deftypefnx {Built-in Function} {@var{h} =} history ()\n\ +@deftypefnx {Built-in Function} {@var{h} =} history (@var{opt1}, @dots{})\n\ +If invoked with no arguments, @code{history} displays a list of commands\n\ +that you have executed. Valid options are:\n\ +\n\ +@table @code\n\ +@item @var{n}\n\ +@itemx -@var{n}\n\ +Display only the most recent @var{n} lines of history.\n\ +\n\ +@item -c\n\ +Clear the history list.\n\ +\n\ +@item -q\n\ +Don't number the displayed lines of history. This is useful for cutting\n\ +and pasting commands using the X Window System.\n\ +\n\ +@item -r @var{file}\n\ +Read the file @var{file}, appending its contents to the current\n\ +history list. If the name is omitted, use the default history file\n\ +(normally @file{~/.octave_hist}).\n\ +\n\ +@item -w @var{file}\n\ +Write the current history to the file @var{file}. If the name is\n\ +omitted, use the default history file (normally @file{~/.octave_hist}).\n\ +@end table\n\ +\n\ +For example, to display the five most recent commands that you have\n\ +typed without displaying line numbers, use the command\n\ +@kbd{history -q 5}.\n\ +\n\ +If invoked with a single output argument, the history will be saved to that\n\ +argument as a cell string and will not be output to screen.\n\ +@end deftypefn") +{ + octave_value retval; + + string_vector hlist = do_history (args, nargout); + + if (nargout > 0) + retval = Cell (hlist); + + return retval; +} + +DEFUN (run_history, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} run_history\n\ +@deftypefnx {Command} {} run_history @var{cmd_number}\n\ +@deftypefnx {Command} {} run_history @var{first} @var{last}\n\ +Run commands from the history list.\n\ +\n\ +When invoked with no arguments, run the previously executed command;\n\ +With one argument, run the specified command @var{cmd_number};\n\ +With two arguments, run the list of commands between @var{first} and\n\ +@var{last}. Command number specifiers may also be negative where -1\n\ +refers to the most recently executed command.\n\ +For example, the command\n\ +\n\ +@example\n\ +@group\n\ +run_history\n\ + OR\n\ +run_history -1\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +executes the most recent command again.\n\ +The command\n\ +\n\ +@example\n\ +run_history 13 169\n\ +@end example\n\ +\n\ +@noindent\n\ +executes commands 13 through 169.\n\ +\n\ +Specifying a larger number for the first command than the last command\n\ +reverses the list of commands before executing them.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +disp (1)\n\ +disp (2)\n\ +run_history -1 -2\n\ +@result{}\n\ + 2\n\ + 1\n\ +@end group\n\ +@end example\n\ +\n\ +@seealso{edit_history}\n\ +@end deftypefn") +{ + octave_value_list retval; + + do_run_history (args); + + return retval; +} + +DEFUN (history_control, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} history_control ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} history_control (@var{new_val})\n\ +Query or set the internal variable that specifies how commands are saved\n\ +to the history list. The default value is an empty character string,\n\ +but may be overridden by the environment variable\n\ +@w{@env{OCTAVE_HISTCONTROL}}.\n\ +\n\ +The value of @code{history_control} is a colon-separated list of values\n\ +controlling how commands are saved on the history list. If the list\n\ +of values includes @code{ignorespace}, lines which begin with a space\n\ +character are not saved in the history list. A value of @code{ignoredups}\n\ +causes lines matching the previous history entry to not be saved.\n\ +A value of @code{ignoreboth} is shorthand for @code{ignorespace} and\n\ +@code{ignoredups}. A value of @code{erasedups} causes all previous lines\n\ +matching the current line to be removed from the history list before that\n\ +line is saved. Any value not in the above list is ignored. If\n\ +@code{history_control} is the empty string, all commands are saved on\n\ +the history list, subject to the value of @code{history_save}.\n\ +@seealso{history_file, history_size, history_timestamp_format_string, history_save}\n\ +@end deftypefn") +{ + std::string old_history_control = command_history::histcontrol (); + + std::string tmp = old_history_control; + + octave_value retval = set_internal_variable (tmp, args, nargout, + "history_control"); + + if (tmp != old_history_control) + command_history::process_histcontrol (tmp); + + return retval; +} + +DEFUN (history_size, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} history_size ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} history_size (@var{new_val})\n\ +Query or set the internal variable that specifies how many entries\n\ +to store in the history file. The default value is @code{1000},\n\ +but may be overridden by the environment variable @w{@env{OCTAVE_HISTSIZE}}.\n\ +@seealso{history_file, history_timestamp_format_string, history_save}\n\ +@end deftypefn") +{ + int old_history_size = command_history::size (); + + int tmp = old_history_size; + + octave_value retval = set_internal_variable (tmp, args, nargout, + "history_size", -1, + std::numeric_limits::max ()); + + if (tmp != old_history_size) + command_history::set_size (tmp); + + return retval; +} + +DEFUN (history_file, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} history_file ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} history_file (@var{new_val})\n\ +Query or set the internal variable that specifies the name of the\n\ +file used to store command history. The default value is\n\ +@file{~/.octave_hist}, but may be overridden by the environment\n\ +variable @w{@env{OCTAVE_HISTFILE}}.\n\ +@seealso{history_size, history_save, history_timestamp_format_string}\n\ +@end deftypefn") +{ + std::string old_history_file = command_history::file (); + + std::string tmp = old_history_file; + + octave_value retval = set_internal_variable (tmp, args, nargout, + "history_file"); + + if (tmp != old_history_file) + command_history::set_file (tmp); + + return retval; +} + +DEFUN (history_timestamp_format_string, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} history_timestamp_format_string ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} history_timestamp_format_string (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} history_timestamp_format_string (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the format string\n\ +for the comment line that is written to the history file when Octave\n\ +exits. The format string is passed to @code{strftime}. The default\n\ +value is\n\ +\n\ +@example\n\ +\"# Octave VERSION, %a %b %d %H:%M:%S %Y %Z \"\n\ +@end example\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{strftime, history_file, history_size, history_save}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (history_timestamp_format_string); +} + +DEFUN (history_save, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} history_save ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} history_save (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} history_save (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether commands entered\n\ +on the command line are saved in the history file.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{history_control, history_file, history_size, history_timestamp_format_string}\n\ +@end deftypefn") +{ + bool old_history_save = ! command_history::ignoring_entries (); + + bool tmp = old_history_save; + + octave_value retval = set_internal_variable (tmp, args, nargout, + "history_save"); + + if (tmp != old_history_save) + command_history::ignore_entries (! tmp); + + return retval; +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/oct-hist.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/oct-hist.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,38 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_octave_hist_h) +#define octave_octave_hist_h 1 + +#include + +#include "cmd-hist.h" + +extern void initialize_history (bool read_history_file = false); + +// Write timestamp to history file. +extern void octave_history_write_timestamp (void); + +// TRUE means input is coming from temporary history file. +extern bool input_from_tmp_history_file; + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/oct-iostrm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/oct-iostrm.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,89 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "error.h" +#include "oct-iostrm.h" + +// Position a stream at OFFSET relative to ORIGIN. + +int +octave_base_iostream::seek (off_t, int) +{ + invalid_operation (); + return -1; +} + +// Return current stream position. + +off_t +octave_base_iostream::tell (void) +{ + invalid_operation (); + return -1; +} + +// Return non-zero if EOF has been reached on this stream. + +bool +octave_base_iostream::eof (void) const +{ + invalid_operation (); + return false; +} + +void +octave_base_iostream::invalid_operation (void) const +{ + ::error ("%s: invalid operation", stream_type ()); +} + +// Return non-zero if EOF has been reached on this stream. + +bool +octave_istream::eof (void) const +{ + return is && is->eof (); +} + +octave_stream +octave_istream::create (std::istream *arg, const std::string& n) +{ + return octave_stream (new octave_istream (arg, n)); +} + +// Return non-zero if EOF has been reached on this stream. + +bool +octave_ostream::eof (void) const +{ + return os && os->eof (); +} + +octave_stream +octave_ostream::create (std::ostream *arg, const std::string& n) +{ + return octave_stream (new octave_ostream (arg, n)); +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/oct-iostrm.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/oct-iostrm.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,154 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_octave_iostream_h) +#define octave_octave_iostream_h 1 + +#include + +#include "oct-stream.h" + +class +octave_base_iostream : public octave_base_stream +{ +public: + + octave_base_iostream (const std::string& n = std::string (), + std::ios::openmode m = std::ios::in|std::ios::out, + oct_mach_info::float_format ff + = oct_mach_info::native_float_format ()) + : octave_base_stream (m, ff), nm (n) { } + + // Position a stream at OFFSET relative to ORIGIN. + + int seek (off_t offset, int origin); + + // Return current stream position. + + off_t tell (void); + + // Return non-zero if EOF has been reached on this stream. + + bool eof (void) const; + + // The name of the file. + + std::string name (void) const { return nm; } + +protected: + + ~octave_base_iostream (void) { } + + void invalid_operation (void) const; + +private: + + std::string nm; + + virtual const char *stream_type (void) const = 0; + + // No copying! + + octave_base_iostream (const octave_base_iostream&); + + octave_base_iostream& operator = (const octave_base_iostream&); +}; + +class +octave_istream : public octave_base_iostream +{ +public: + + octave_istream (std::istream *arg = 0, const std::string& n = std::string ()) + : octave_base_iostream (n, std::ios::in, + oct_mach_info::native_float_format ()), + is (arg) + { } + + static octave_stream + create (std::istream *arg = 0, const std::string& n = std::string ()); + + // Return non-zero if EOF has been reached on this stream. + + bool eof (void) const; + + std::istream *input_stream (void) { return is; } + + std::ostream *output_stream (void) { return 0; } + +protected: + + ~octave_istream (void) { } + +private: + + std::istream *is; + + const char *stream_type (void) const { return "octave_istream"; } + + // No copying! + + octave_istream (const octave_istream&); + + octave_istream& operator = (const octave_istream&); +}; + +class +octave_ostream : public octave_base_iostream +{ +public: + + octave_ostream (std::ostream *arg, const std::string& n = std::string ()) + : octave_base_iostream (n, std::ios::out, + oct_mach_info::native_float_format ()), + os (arg) + { } + + static octave_stream + create (std::ostream *arg, const std::string& n = std::string ()); + + // Return non-zero if EOF has been reached on this stream. + + bool eof (void) const; + + std::istream *input_stream (void) { return 0; } + + std::ostream *output_stream (void) { return os; } + +protected: + + ~octave_ostream (void) { } + +private: + + std::ostream *os; + + const char *stream_type (void) const { return "octave_ostream"; } + + // No copying! + + octave_ostream (const octave_ostream&); + + octave_ostream& operator = (const octave_ostream&); +}; + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/oct-lvalue.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/oct-lvalue.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,94 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "error.h" +#include "oct-obj.h" +#include "oct-lvalue.h" +#include "ov.h" + +void +octave_lvalue::assign (octave_value::assign_op op, const octave_value& rhs) +{ + if (! is_black_hole ()) + { + if (idx.empty ()) + sym->assign (op, rhs); + else + sym->assign (op, type, idx, rhs); + } +} + +void +octave_lvalue::set_index (const std::string& t, + const std::list& i) +{ + if (idx.empty ()) + { + type = t; + idx = i; + } + else + error ("invalid index expression in assignment"); +} + +void +octave_lvalue::do_unary_op (octave_value::unary_op op) +{ + if (! is_black_hole ()) + { + if (idx.empty ()) + sym->do_non_const_unary_op (op); + else + sym->do_non_const_unary_op (op, type, idx); + } +} + +octave_value +octave_lvalue::value (void) const +{ + octave_value retval; + + if (! is_black_hole ()) + { + octave_value val = sym->varval (); + + if (idx.empty ()) + retval = val; + else + { + if (val.is_constant ()) + retval = val.subsref (type, idx); + else + { + octave_value_list t = val.subsref (type, idx, 1); + if (t.length () > 0) + retval = t(0); + } + } + } + + return retval; +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/oct-lvalue.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/oct-lvalue.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,108 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_lvalue_h) +#define octave_lvalue_h 1 + +class octave_value; +class octave_value_list; + +#include + +#include "oct-obj.h" +#include "pt-idx.h" +#include "symtab.h" + +class +octave_lvalue +{ +public: + + octave_lvalue (const symbol_table::symbol_reference& s + = symbol_table::symbol_reference ()) + : sym (s), type (), idx (), nel (1) + { } + + octave_lvalue (const octave_lvalue& vr) + : sym (vr.sym), type (vr.type), idx (vr.idx), nel (vr.nel) + { } + + octave_lvalue& operator = (const octave_lvalue& vr) + { + if (this != &vr) + { + sym = vr.sym; + type = vr.type; + idx = vr.idx; + nel = vr.nel; + } + + return *this; + } + + ~octave_lvalue (void) { } + + bool is_black_hole (void) const { return sym.is_black_hole (); } + + bool is_defined (void) const + { + return ! is_black_hole () && sym->is_defined (); + } + + bool is_undefined (void) const + { + return is_black_hole () || sym->is_undefined (); + } + + bool is_map (void) const + { + return value().is_map (); + } + + void define (const octave_value& v) { sym->assign (v); } + + void assign (octave_value::assign_op, const octave_value&); + + void numel (octave_idx_type n) { nel = n; } + + octave_idx_type numel (void) const { return nel; } + + void set_index (const std::string& t, const std::list& i); + + void clear_index (void) { type = std::string (); idx.clear (); } + + void do_unary_op (octave_value::unary_op op); + + octave_value value (void) const; + +private: + + symbol_table::symbol_reference sym; + + std::string type; + + std::list idx; + + octave_idx_type nel; +}; + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/oct-map.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/oct-map.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,1779 @@ +/* + +Copyright (C) 1995-2012 John W. Eaton +Copyright (C) 2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "error.h" +#include "str-vec.h" + +#include "oct-map.h" +#include "utils.h" + +octave_fields::octave_fields (const string_vector& fields) + : rep (new fields_rep) +{ + octave_idx_type n = fields.numel (); + for (octave_idx_type i = 0; i < n; i++) + (*rep)[fields(i)] = i; +} + +octave_fields::octave_fields (const char * const *fields) + : rep (new fields_rep) +{ + octave_idx_type n = 0; + while (*fields) + (*rep)[std::string (*fields++)] = n++; +} + +bool +octave_fields::isfield (const std::string& field) const +{ + return rep->find (field) != rep->end (); +} + +octave_idx_type +octave_fields::getfield (const std::string& field) const +{ + fields_rep::iterator p = rep->find (field); + return (p != rep->end ()) ? p->second : -1; +} + +octave_idx_type +octave_fields::getfield (const std::string& field) +{ + fields_rep::iterator p = rep->find (field); + if (p != rep->end ()) + return p->second; + else + { + make_unique (); + octave_idx_type n = rep->size (); + return (*rep)[field] = n; + } +} + +octave_idx_type +octave_fields::rmfield (const std::string& field) +{ + fields_rep::iterator p = rep->find (field); + if (p == rep->end ()) + return -1; + else + { + octave_idx_type n = p->second; + make_unique (); + rep->erase (field); + for (fields_rep::iterator q = rep->begin (); q != rep->end (); q++) + { + if (q->second >= n) + q->second--; + } + + return n; + } +} + +void +octave_fields::orderfields (Array& perm) +{ + octave_idx_type n = rep->size (); + perm.clear (n, 1); + + make_unique (); + octave_idx_type i = 0; + for (fields_rep::iterator q = rep->begin (); q != rep->end (); q++) + { + octave_idx_type j = q->second; + q->second = i; + perm(i++) = j; + } +} + +bool +octave_fields::equal_up_to_order (const octave_fields& other, + octave_idx_type* perm) const +{ + bool retval = true; + + iterator p = begin (), q = other.begin (); + for (; p != end () && q != other.end (); p++, q++) + { + if (p->first == q->first) + perm[p->second] = q->second; + else + { + retval = false; + break; + } + } + + retval = (p == end () && q == other.end ()); + + return retval; +} + +bool +octave_fields::equal_up_to_order (const octave_fields& other, + Array& perm) const +{ + octave_idx_type n = nfields (); + if (perm.length () != n) + perm.clear (1, n); + + return equal_up_to_order (other, perm.fortran_vec ()); +} + +string_vector +octave_fields::fieldnames (void) const +{ + octave_idx_type n = nfields (); + string_vector retval(n); + + for (iterator p = begin (); p != end (); p++) + retval.xelem (p->second) = p->first; + + return retval; +} + +octave_value +octave_scalar_map::getfield (const std::string& k) const +{ + octave_idx_type idx = xkeys.getfield (k); + return (idx >= 0) ? xvals[idx] : octave_value (); +} + +void +octave_scalar_map::setfield (const std::string& k, const octave_value& val) +{ + octave_idx_type idx = xkeys.getfield (k); + if (idx < static_cast (xvals.size ())) + xvals[idx] = val; + else + xvals.push_back (val); +} + +void +octave_scalar_map::rmfield (const std::string& k) +{ + octave_idx_type idx = xkeys.rmfield (k); + if (idx >= 0) + xvals.erase (xvals.begin () + idx); +} + +octave_scalar_map +octave_scalar_map::orderfields (void) const +{ + Array perm; + return orderfields (perm); +} + +octave_scalar_map +octave_scalar_map::orderfields (Array& perm) const +{ + octave_scalar_map retval (xkeys); + retval.xkeys.orderfields (perm); + + octave_idx_type nf = nfields (); + for (octave_idx_type i = 0; i < nf; i++) + retval.xvals[i] = xvals[perm.xelem (i)]; + + return retval; +} + +octave_scalar_map +octave_scalar_map::orderfields (const octave_scalar_map& other, + Array& perm) const +{ + if (xkeys.is_same (other.xkeys)) + return *this; + else + { + octave_scalar_map retval (other.xkeys); + if (other.xkeys.equal_up_to_order (xkeys, perm)) + { + octave_idx_type nf = nfields (); + for (octave_idx_type i = 0; i < nf; i++) + retval.xvals[i] = xvals[perm.xelem (i)]; + } + else + error ("orderfields: structs must have same fields up to order"); + + return retval; + } +} + +octave_value +octave_scalar_map::contents (const std::string& k) const +{ + return getfield (k); +} + +octave_value& +octave_scalar_map::contents (const std::string& k) +{ + octave_idx_type idx = xkeys.getfield (k); + if (idx >= static_cast (xvals.size ())) + xvals.resize (idx+1); + return xvals[idx]; +} + +octave_map::octave_map (const octave_scalar_map& m) + : xkeys (m.xkeys), xvals (), dimensions (1, 1) +{ + octave_idx_type nf = m.nfields (); + xvals.reserve (nf); + for (octave_idx_type i = 0; i < nf; i++) + { + xvals.push_back (Cell (dimensions)); + xvals[i].xelem (0) = m.xvals[i]; + } +} + +octave_map::octave_map (const Octave_map& m) + : xkeys (m.keys ()), xvals (m.nfields ()), dimensions (m.dims ()) +{ + for (iterator p = begin (); p != end (); p++) + contents(p) = m.contents (key (p)); + + optimize_dimensions (); +} + +Cell +octave_map::getfield (const std::string& k) const +{ + octave_idx_type idx = xkeys.getfield (k); + return (idx >= 0) ? xvals[idx] : Cell (); +} + +void +octave_map::setfield (const std::string& k, const Cell& val) +{ + if (nfields () == 0) + dimensions = val.dims (); + + if (val.dims () == dimensions) + { + octave_idx_type idx = xkeys.getfield (k); + if (idx < static_cast (xvals.size ())) + xvals[idx] = val; + else + xvals.push_back (val); + } + else + error ("octave_map::setfield: internal error"); +} + +void +octave_map::rmfield (const std::string& k) +{ + octave_idx_type idx = xkeys.rmfield (k); + if (idx >= 0) + xvals.erase (xvals.begin () + idx); +} + +octave_map +octave_map::orderfields (void) const +{ + Array perm; + return orderfields (perm); +} + +octave_map +octave_map::orderfields (Array& perm) const +{ + octave_map retval (xkeys); + retval.xkeys.orderfields (perm); + + octave_idx_type nf = nfields (); + for (octave_idx_type i = 0; i < nf; i++) + retval.xvals[i] = xvals[perm.xelem (i)]; + + return retval; +} + +octave_map +octave_map::orderfields (const octave_map& other, + Array& perm) const +{ + if (xkeys.is_same (other.xkeys)) + return *this; + else + { + octave_map retval (other.xkeys); + if (other.xkeys.equal_up_to_order (xkeys, perm)) + { + octave_idx_type nf = nfields (); + for (octave_idx_type i = 0; i < nf; i++) + retval.xvals[i] = xvals[perm.xelem (i)]; + } + else + error ("orderfields: structs must have same fields up to order"); + + return retval; + } +} + +Cell +octave_map::contents (const std::string& k) const +{ + return getfield (k); +} + +Cell& +octave_map::contents (const std::string& k) +{ + octave_idx_type idx = xkeys.getfield (k); + if (idx >= static_cast (xvals.size ())) + xvals.push_back (Cell (dimensions)); // auto-set correct dims. + return xvals[idx]; +} + +void +octave_map::extract_scalar (octave_scalar_map& dest, + octave_idx_type idx) const +{ + octave_idx_type nf = nfields (); + for (octave_idx_type i = 0; i < nf; i++) + dest.xvals[i] = xvals[i](idx); +} + +octave_scalar_map +octave_map::checkelem (octave_idx_type n) const +{ + octave_scalar_map retval (xkeys); + + // Optimize this so that there is just one check. + extract_scalar (retval, compute_index (n, dimensions)); + + return retval; +} + +octave_scalar_map +octave_map::checkelem (octave_idx_type i, octave_idx_type j) const +{ + octave_scalar_map retval (xkeys); + + // Optimize this so that there is just one check. + extract_scalar (retval, compute_index (i, j, dimensions)); + + return retval; +} + +octave_scalar_map +octave_map::checkelem (const Array& ra_idx) const +{ + octave_scalar_map retval (xkeys); + + // Optimize this so that there is just one check. + extract_scalar (retval, compute_index (ra_idx, dimensions)); + + return retval; +} + +octave_scalar_map +octave_map::fast_elem_extract (octave_idx_type n) const +{ + octave_scalar_map retval (xkeys); + + extract_scalar (retval, n); + + return retval; +} + +bool +octave_map::fast_elem_insert (octave_idx_type n, + const octave_scalar_map& rhs) +{ + bool retval = false; + + octave_idx_type nf = nfields (); + if (rhs.xkeys.is_same (xkeys)) + { + for (octave_idx_type i = 0; i < nf; i++) + xvals[i](n) = rhs.xvals[i]; + + retval = true; + } + else + { + OCTAVE_LOCAL_BUFFER (octave_idx_type, perm, nf); + if (xkeys.equal_up_to_order (rhs.xkeys, perm)) + { + for (octave_idx_type i = 0; i < nf; i++) + xvals[i](n) = rhs.xvals[perm[i]]; + + retval = true; + } + } + + return retval; +} + +octave_map +octave_map::squeeze (void) const +{ + octave_map retval (*this); + octave_idx_type nf = nfields (); + + retval.dimensions = dimensions.squeeze (); + + for (octave_idx_type i = 0; i < nf; i++) + retval.xvals[i] = xvals[i].squeeze (); + + retval.optimize_dimensions (); + + return retval; +} + +/* +## test preservation of xkeys by squeeze +%!test +%! x(1,1,1,1).d = 10; x(3,5,1,7).a = "b"; x(2,4,1,7).f = 27; +%! assert (fieldnames (squeeze (x)), {"d"; "a"; "f"}); +*/ + +octave_map +octave_map::permute (const Array& vec, bool inv) const +{ + octave_map retval (xkeys); + octave_idx_type nf = nfields (); + + for (octave_idx_type i = 0; i < nf; i++) + retval.xvals[i] = xvals[i].permute (vec, inv); + + // FIXME: + // There is no dim_vector::permute for technical reasons. + // We pick the dim vector from results if possible, otherwise use a dummy + // array to get it. Need (?) a better solution to this problem. + if (nf > 0) + retval.dimensions = retval.xvals[0].dims (); + else + { + Array dummy (dimensions); + dummy = dummy.permute (vec, inv); + retval.dimensions = dummy.dims (); + } + + retval.optimize_dimensions (); + + return retval; +} + +/* +## test preservation of key order by permute +%!test +%! x(1,1,1,1).d = 10; x(3,5,1,7).a = "b"; x(2,4,1,7).f = 27; +%! assert (fieldnames (permute (x, [3, 4, 1, 2])), {"d"; "a"; "f"}); +*/ + +octave_map +octave_map::transpose (void) const +{ + assert (ndims () == 2); + + octave_map retval (xkeys); + + retval.dimensions = dim_vector (dimensions (1), dimensions (0)); + + octave_idx_type nf = nfields (); + for (octave_idx_type i = 0; i < nf; i++) + retval.xvals[i] = xvals[i].transpose (); + + retval.optimize_dimensions (); + + return retval; +} + +/* +## test preservation of key order by transpose +%!test +%! x(1,1).d = 10; x(3,5).a = "b"; x(2,4).f = 27; +%! assert (fieldnames (transpose (x)), {"d"; "a"; "f"}); +%! assert (fieldnames (x'), {"d"; "a"; "f"}); +%! assert (fieldnames (x.'), {"d"; "a"; "f"}); +*/ + +octave_map +octave_map::reshape (const dim_vector& dv) const +{ + octave_map retval (xkeys); + retval.dimensions = dv; + + octave_idx_type nf = nfields (); + if (nf > 0) + { + retval.xvals.reserve (nf); + for (octave_idx_type i = 0; i < nf; i++) + retval.xvals[i] = xvals[i].reshape (dv); + } + else + { + // FIXME: Do it with a dummy array, to reuse error message. + // Need (?) a better solution. + Array dummy (dimensions); + dummy.reshape (dv); + } + + retval.optimize_dimensions (); + + return retval; +} + +/* +## test preservation of key order by reshape +%!test +%! x(1,1).d = 10; x(4,6).a = "b"; x(2,4).f = 27; +%! assert (fieldnames (reshape (x, 3, 8)), {"d"; "a"; "f"}); +*/ + +void +octave_map::resize (const dim_vector& dv, bool fill) +{ + octave_idx_type nf = nfields (); + if (nf > 0) + { + for (octave_idx_type i = 0; i < nf; i++) + { + if (fill) + xvals[i].resize (dv, Matrix ()); + else + xvals[i].resize (dv); + } + } + else + { + // FIXME: Do it with a dummy array, to reuse error message. + // Need (?) a better solution. + Array dummy (dimensions); + dummy.resize (dv); + } + + dimensions = dv; + optimize_dimensions (); +} + +void +octave_map::do_cat (int dim, octave_idx_type n, const octave_scalar_map *map_list, + octave_map& retval) +{ + octave_idx_type nf = retval.nfields (); + retval.xvals.reserve (nf); + + dim_vector& rd = retval.dimensions; + rd.resize (dim+1, 1); + rd(0) = rd(1) = 1; + rd(dim) = n; + + for (octave_idx_type j = 0; j < nf; j++) + { + retval.xvals.push_back (Cell (rd)); + assert (retval.xvals[j].numel () == n); + for (octave_idx_type i = 0; i < n; i++) + retval.xvals[j].xelem (i) = map_list[i].xvals[j]; + } +} + +void +octave_map::do_cat (int dim, octave_idx_type n, const octave_map *map_list, + octave_map& retval) +{ + octave_idx_type nf = retval.nfields (); + retval.xvals.reserve (nf); + + OCTAVE_LOCAL_BUFFER (Array, field_list, n); + + for (octave_idx_type j = 0; j < nf; j++) + { + for (octave_idx_type i = 0; i < n; i++) + field_list[i] = map_list[i].xvals[j]; + + retval.xvals.push_back (Array::cat (dim, n, field_list)); + if (j == 0) + retval.dimensions = retval.xvals[j].dims (); + } +} + +// This is just a wrapper. +void permute_to_correct_order1 (const octave_scalar_map& ref, const octave_scalar_map& src, + octave_scalar_map& dest, Array& perm) +{ + dest = src.orderfields (ref, perm); +} + +// In non-scalar case, we also promote empty structs without fields. +void permute_to_correct_order1 (const octave_map& ref, const octave_map& src, + octave_map& dest, Array& perm) +{ + if (src.nfields () == 0 && src.is_empty ()) + dest = octave_map (src.dims (), ref.keys ()); + else + dest = src.orderfields (ref, perm); +} + +template +static void +permute_to_correct_order (octave_idx_type n, octave_idx_type nf, + octave_idx_type idx, const map *map_list, + map *new_map_list) +{ + new_map_list[idx] = map_list[idx]; + + Array perm (dim_vector (1, nf)); + + for (octave_idx_type i = 0; i < n; i++) + { + if (i == idx) + continue; + + permute_to_correct_order1 (map_list[idx], map_list[i], new_map_list[i], perm); + + if (error_state) + { + // Use liboctave exception to be consistent. + (*current_liboctave_error_handler) + ("cat: field names mismatch in concatenating structs"); + break; + } + } +} + + +octave_map +octave_map::cat (int dim, octave_idx_type n, const octave_scalar_map *map_list) +{ + octave_map retval; + + // Allow dim = -1, -2 for compatibility, though it makes no difference here. + if (dim == -1 || dim == -2) + dim = -dim - 1; + else if (dim < 0) + (*current_liboctave_error_handler) + ("cat: invalid dimension"); + + if (n == 1) + retval = map_list[0]; + else if (n > 1) + { + octave_idx_type idx, nf = 0; + for (idx = 0; idx < n; idx++) + { + nf = map_list[idx].nfields (); + if (nf > 0) + { + retval.xkeys = map_list[idx].xkeys; + break; + } + } + + if (nf > 0) + { + // Try the fast case. + bool all_same = true; + for (octave_idx_type i = 0; i < n; i++) + { + all_same = map_list[idx].xkeys.is_same (map_list[i].xkeys); + if (! all_same) + break; + } + + if (all_same) + do_cat (dim, n, map_list, retval); + else + { + // permute all structures to common order. + OCTAVE_LOCAL_BUFFER (octave_scalar_map, new_map_list, n); + + permute_to_correct_order (n, nf, idx, map_list, new_map_list); + + do_cat (dim, n, new_map_list, retval); + } + + } + else + { + dim_vector& rd = retval.dimensions; + rd.resize (dim+1, 1); + rd(0) = rd(1) = 1; + rd(dim) = n; + } + + retval.optimize_dimensions (); + } + + return retval; +} + +octave_map +octave_map::cat (int dim, octave_idx_type n, const octave_map *map_list) +{ + octave_map retval; + + // Allow dim = -1, -2 for compatibility, though it makes no difference here. + if (dim == -1 || dim == -2) + dim = -dim - 1; + else if (dim < 0) + (*current_liboctave_error_handler) + ("cat: invalid dimension"); + + if (n == 1) + retval = map_list[0]; + else if (n > 1) + { + octave_idx_type idx, nf = 0; + + for (idx = 0; idx < n; idx++) + { + nf = map_list[idx].nfields (); + if (nf > 0) + { + retval.xkeys = map_list[idx].xkeys; + break; + } + } + + // Try the fast case. + bool all_same = true; + + if (nf > 0) + { + for (octave_idx_type i = 0; i < n; i++) + { + all_same = map_list[idx].xkeys.is_same (map_list[i].xkeys); + + if (! all_same) + break; + } + } + + if (all_same && nf > 0) + do_cat (dim, n, map_list, retval); + else + { + if (nf > 0) + { + // permute all structures to correct order. + OCTAVE_LOCAL_BUFFER (octave_map, new_map_list, n); + + permute_to_correct_order (n, nf, idx, map_list, new_map_list); + + do_cat (dim, n, new_map_list, retval); + } + else + { + dim_vector dv = map_list[0].dimensions; + + for (octave_idx_type i = 1; i < n; i++) + { + if (! dv.concat (map_list[i].dimensions, dim)) + { + error ("dimension mismatch in struct concatenation"); + return retval; + } + } + + retval.dimensions = dv; + } + } + + retval.optimize_dimensions (); + } + + return retval; +} + +/* +## test preservation of key order by concatenation +%!test +%! x(1, 1).d = 10; x(4, 6).a = "b"; x(2, 4).f = 27; +%! y(1, 6).f = 11; y(1, 6).a = "c"; y(1, 6).d = 33; +%! assert (fieldnames ([x; y]), {"d"; "a"; "f"}); + +%!test +%! s = struct (); +%! sr = [s,s]; +%! sc = [s;s]; +%! sm = [s,s;s,s]; +%! assert (nfields (sr), 0); +%! assert (nfields (sc), 0); +%! assert (nfields (sm), 0); +%! assert (size (sr), [1, 2]); +%! assert (size (sc), [2, 1]); +%! assert (size (sm), [2, 2]); +*/ + +octave_map +octave_map::index (const idx_vector& i, bool resize_ok) const +{ + octave_map retval (xkeys); + octave_idx_type nf = nfields (); + + for (octave_idx_type k = 0; k < nf; k++) + retval.xvals[k] = xvals[k].index (i, resize_ok); + + if (nf > 0) + retval.dimensions = retval.xvals[0].dims (); + else + { + // Use dummy array. FIXME: Need(?) a better solution. + Array dummy (dimensions); + dummy = dummy.index (i, resize_ok); + retval.dimensions = dummy.dims (); + } + + retval.optimize_dimensions (); + + return retval; +} + +octave_map +octave_map::index (const idx_vector& i, const idx_vector& j, + bool resize_ok) const +{ + octave_map retval (xkeys); + octave_idx_type nf = nfields (); + + for (octave_idx_type k = 0; k < nf; k++) + retval.xvals[k] = xvals[k].index (i, j, resize_ok); + + if (nf > 0) + retval.dimensions = retval.xvals[0].dims (); + else + { + // Use dummy array. FIXME: Need(?) a better solution. + Array dummy (dimensions); + dummy = dummy.index (i, j, resize_ok); + retval.dimensions = dummy.dims (); + } + + retval.optimize_dimensions (); + + return retval; +} + +octave_map +octave_map::index (const Array& ia, bool resize_ok) const +{ + octave_map retval (xkeys); + octave_idx_type nf = nfields (); + + for (octave_idx_type k = 0; k < nf; k++) + retval.xvals[k] = xvals[k].index (ia, resize_ok); + + if (nf > 0) + retval.dimensions = retval.xvals[0].dims (); + else + { + // Use dummy array. FIXME: Need(?) a better solution. + Array dummy (dimensions); + dummy = dummy.index (ia, resize_ok); + retval.dimensions = dummy.dims (); + } + + retval.optimize_dimensions (); + + return retval; +} + +octave_map +octave_map::index (const octave_value_list& idx, bool resize_ok) const +{ + octave_idx_type n_idx = idx.length (); + octave_map retval; + + switch (n_idx) + { + case 1: + { + idx_vector i = idx(0).index_vector (); + + if (! error_state) + retval = index (i, resize_ok); + } + break; + + case 2: + { + idx_vector i = idx(0).index_vector (); + + if (! error_state) + { + idx_vector j = idx(1).index_vector (); + + retval = index (i, j, resize_ok); + } + } + break; + + default: + { + Array ia (dim_vector (n_idx, 1)); + + for (octave_idx_type i = 0; i < n_idx; i++) + { + ia(i) = idx(i).index_vector (); + + if (error_state) + break; + } + + if (! error_state) + retval = index (ia, resize_ok); + } + break; + } + + return retval; +} + +// Perhaps one day these will be optimized. Right now, they just call index. +octave_map +octave_map::column (octave_idx_type k) const +{ + return index (idx_vector::colon, k); +} + +octave_map +octave_map::page (octave_idx_type k) const +{ + static Array ia (dim_vector (3, 1), idx_vector::colon); + + ia(2) = k; + return index (ia); +} + +void +octave_map::assign (const idx_vector& i, const octave_map& rhs) +{ + if (rhs.xkeys.is_same (xkeys)) + { + octave_idx_type nf = nfields (); + + for (octave_idx_type k = 0; k < nf; k++) + xvals[k].assign (i, rhs.xvals[k], Matrix ()); + + if (nf > 0) + dimensions = xvals[0].dims (); + else + { + // Use dummy array. FIXME: Need(?) a better solution. + Array dummy (dimensions), rhs_dummy (rhs.dimensions); + dummy.assign (i, rhs_dummy);; + dimensions = dummy.dims (); + } + + optimize_dimensions (); + } + else if (nfields () == 0) + { + octave_map tmp (dimensions, rhs.xkeys); + tmp.assign (i, rhs); + *this = tmp; + } + else + { + Array perm; + octave_map rhs1 = rhs.orderfields (*this, perm); + if (! error_state) + { + assert (rhs1.xkeys.is_same (xkeys)); + assign (i, rhs1); + } + else + error ("incompatible fields in struct assignment"); + } +} + +void +octave_map::assign (const idx_vector& i, const idx_vector& j, + const octave_map& rhs) +{ + if (rhs.xkeys.is_same (xkeys)) + { + octave_idx_type nf = nfields (); + + for (octave_idx_type k = 0; k < nf; k++) + xvals[k].assign (i, j, rhs.xvals[k], Matrix ()); + + if (nf > 0) + dimensions = xvals[0].dims (); + else + { + // Use dummy array. FIXME: Need(?) a better solution. + Array dummy (dimensions), rhs_dummy (rhs.dimensions); + dummy.assign (i, j, rhs_dummy);; + dimensions = dummy.dims (); + } + + optimize_dimensions (); + } + else if (nfields () == 0) + { + octave_map tmp (dimensions, rhs.xkeys); + tmp.assign (i, j, rhs); + *this = tmp; + } + else + { + Array perm; + octave_map rhs1 = rhs.orderfields (*this, perm); + if (! error_state) + { + assert (rhs1.xkeys.is_same (xkeys)); + assign (i, j, rhs1); + } + else + error ("incompatible fields in struct assignment"); + } +} + +void +octave_map::assign (const Array& ia, + const octave_map& rhs) +{ + if (rhs.xkeys.is_same (xkeys)) + { + octave_idx_type nf = nfields (); + + for (octave_idx_type k = 0; k < nf; k++) + xvals[k].assign (ia, rhs.xvals[k], Matrix ()); + + if (nf > 0) + dimensions = xvals[0].dims (); + else + { + // Use dummy array. FIXME: Need(?) a better solution. + Array dummy (dimensions), rhs_dummy (rhs.dimensions); + dummy.assign (ia, rhs_dummy);; + dimensions = dummy.dims (); + } + + optimize_dimensions (); + } + else if (nfields () == 0) + { + octave_map tmp (dimensions, rhs.xkeys); + tmp.assign (ia, rhs); + *this = tmp; + } + else + { + Array perm; + octave_map rhs1 = rhs.orderfields (*this, perm); + if (! error_state) + { + assert (rhs1.xkeys.is_same (xkeys)); + assign (ia, rhs1); + } + else + error ("incompatible fields in struct assignment"); + } +} + +void +octave_map::assign (const octave_value_list& idx, const octave_map& rhs) +{ + octave_idx_type n_idx = idx.length (); + + switch (n_idx) + { + case 1: + { + idx_vector i = idx(0).index_vector (); + + if (! error_state) + assign (i, rhs); + } + break; + + case 2: + { + idx_vector i = idx(0).index_vector (); + + if (! error_state) + { + idx_vector j = idx(1).index_vector (); + + assign (i, j, rhs); + } + } + break; + + default: + { + Array ia (dim_vector (n_idx, 1)); + + for (octave_idx_type i = 0; i < n_idx; i++) + { + ia(i) = idx(i).index_vector (); + + if (error_state) + break; + } + + if (! error_state) + assign (ia, rhs); + } + break; + } +} + +void +octave_map::assign (const octave_value_list& idx, const std::string& k, + const Cell& rhs) +{ + Cell tmp; + iterator p = seek (k); + Cell& ref = p != end () ? contents (p) : tmp; + + if (&ref == &tmp) + ref = Cell (dimensions); + + ref.assign (idx, rhs); + + if (! error_state && ref.dims () != dimensions) + { + dimensions = ref.dims (); + + octave_idx_type nf = nfields (); + for (octave_idx_type i = 0; i < nf; i++) + { + if (&xvals[i] != &ref) + xvals[i].resize (dimensions, Matrix ()); + } + + optimize_dimensions (); + } + + if (! error_state && &ref == &tmp) + setfield (k, tmp); +} + +/* +%!test +%! rhs.b = 1; +%! a(3) = rhs; +%! assert ({a.b}, {[], [], 1}) +*/ + +void +octave_map::delete_elements (const idx_vector& i) +{ + octave_idx_type nf = nfields (); + for (octave_idx_type k = 0; k < nf; k++) + xvals[k].delete_elements (i); + + if (nf > 0) + dimensions = xvals[0].dims (); + else + { + // Use dummy array. FIXME: Need(?) a better solution. + Array dummy (dimensions); + dummy.delete_elements (i); + dimensions = dummy.dims (); + } + + optimize_dimensions (); +} + +void +octave_map::delete_elements (int dim, const idx_vector& i) +{ + octave_idx_type nf = nfields (); + for (octave_idx_type k = 0; k < nf; k++) + xvals[k].delete_elements (dim, i); + + if (nf > 0) + dimensions = xvals[0].dims (); + else + { + // Use dummy array. FIXME: Need(?) a better solution. + Array dummy (dimensions); + dummy.delete_elements (dim, i); + dimensions = dummy.dims (); + } + + optimize_dimensions (); +} + +void +octave_map::delete_elements (const Array& ia) +{ + octave_idx_type nf = nfields (); + for (octave_idx_type k = 0; k < nf; k++) + xvals[k].delete_elements (ia); + + if (nf > 0) + dimensions = xvals[0].dims (); + else + { + // Use dummy array. FIXME: Need(?) a better solution. + Array dummy (dimensions); + dummy.delete_elements (ia); + dimensions = dummy.dims (); + } + + optimize_dimensions (); +} + +void +octave_map::delete_elements (const octave_value_list& idx) +{ + octave_idx_type n_idx = idx.length (); + + Array ia (dim_vector (n_idx, 1)); + + for (octave_idx_type i = 0; i < n_idx; i++) + { + ia(i) = idx(i).index_vector (); + + if (error_state) + break; + } + + if (! error_state) + delete_elements (ia); +} + +/* +## test preservation of key order by indexing +%!test +%! x(1, 1).d = 10; x(4, 6).a = "b"; x(2, 4).f = 27; +%! assert (fieldnames (x([1, 2], [2:5])), {"d"; "a"; "f"}); +*/ + +octave_map +octave_map::concat (const octave_map& rb, const Array& ra_idx) +{ + if (nfields () == rb.nfields ()) + { + for (const_iterator pa = begin (); pa != end (); pa++) + { + const_iterator pb = rb.seek (key(pa)); + + if (pb == rb.end ()) + { + error ("field name mismatch in structure concatenation"); + break; + } + + contents(pa).insert (rb.contents (pb), ra_idx); + } + } + else + { + dim_vector dv = dims (); + + if (dv.all_zero ()) + *this = rb; + else if (! rb.dims ().all_zero ()) + error ("invalid structure concatenation"); + } + + return *this; +} + +void +octave_map::optimize_dimensions (void) +{ + octave_idx_type nf = nfields (); + + for (octave_idx_type i = 0; i < nf; i++) + { + if (! xvals[i].optimize_dimensions (dimensions)) + { + error ("internal error: dimension mismatch across fields in struct"); + break; + } + } + +} + +Octave_map::Octave_map (const dim_vector& dv, const Cell& key_vals) + : map (), key_list (), dimensions (dv) +{ + Cell c (dv); + + if (key_vals.is_cellstr ()) + { + for (octave_idx_type i = 0; i < key_vals.numel (); i++) + { + std::string k = key_vals(i).string_value (); + map[k] = c; + key_list.push_back (k); + } + } + else + error ("Octave_map: expecting keys to be cellstr"); +} + +Octave_map::Octave_map (const octave_map& m) + : map (), key_list (), dimensions (m.dims ()) +{ + for (octave_map::const_iterator p = m.begin (); p != m.end (); p++) + map[m.key (p)] = m.contents (p); + const string_vector mkeys = m.fieldnames (); + for (octave_idx_type i = 0; i < mkeys.numel (); i++) + key_list.push_back (mkeys(i)); +} + +Octave_map +Octave_map::squeeze (void) const +{ + Octave_map retval (dims ().squeeze ()); + + for (const_iterator pa = begin (); pa != end (); pa++) + { + Cell tmp = contents (pa).squeeze (); + + if (error_state) + break; + + retval.assign (key (pa), tmp); + } + + // Preserve order of keys. + retval.key_list = key_list; + + return retval; +} + +Octave_map +Octave_map::permute (const Array& vec, bool inv) const +{ + Octave_map retval (dims ()); + + for (const_iterator pa = begin (); pa != end (); pa++) + { + Cell tmp = contents (pa).permute (vec, inv); + + if (error_state) + break; + + retval.assign (key (pa), tmp); + } + + // Preserve order of keys. + retval.key_list = key_list; + + return retval; +} + +Cell& +Octave_map::contents (const std::string& k) +{ + maybe_add_to_key_list (k); + + return map[k]; +} + +Cell +Octave_map::contents (const std::string& k) const +{ + const_iterator p = seek (k); + + return p != end () ? p->second : Cell (); +} + +int +Octave_map::intfield (const std::string& k, int def_val) const +{ + int retval = def_val; + + Cell c = contents (k); + + if (! c.is_empty ()) + retval = c(0).int_value (); + + return retval; +} + +std::string +Octave_map::stringfield (const std::string& k, + const std::string& def_val) const +{ + std::string retval = def_val; + + Cell c = contents (k); + + if (! c.is_empty ()) + retval = c(0).string_value (); + + return retval; +} + +string_vector +Octave_map::keys (void) const +{ + assert (static_cast(nfields ()) == key_list.size ()); + + return string_vector (key_list); +} + +Octave_map +Octave_map::transpose (void) const +{ + assert (ndims () == 2); + + dim_vector dv = dims (); + + octave_idx_type nr = dv(0); + octave_idx_type nc = dv(1); + + dim_vector new_dims (nc, nr); + + Octave_map retval (new_dims); + + for (const_iterator p = begin (); p != end (); p++) + retval.assign (key(p), Cell (contents(p).transpose ())); + + // Preserve order of keys. + retval.key_list = key_list; + + return retval; +} + +Octave_map +Octave_map::reshape (const dim_vector& new_dims) const +{ + Octave_map retval; + + if (new_dims != dims ()) + { + for (const_iterator p = begin (); p != end (); p++) + retval.assign (key(p), contents(p).reshape (new_dims)); + + retval.dimensions = new_dims; + + // Preserve order of keys. + retval.key_list = key_list; + } + else + retval = *this; + + return retval; +} + +void +Octave_map::resize (const dim_vector& dv, bool fill) +{ + if (dv != dims ()) + { + if (nfields () == 0) + dimensions = dv; + else + { + for (const_iterator p = begin (); p != end (); p++) + { + Cell tmp = contents(p); + + if (fill) + tmp.resize (dv, Matrix ()); + else + tmp.resize (dv); + + dimensions = dv; + + assign (key(p), tmp); + } + } + } +} + +Octave_map +Octave_map::concat (const Octave_map& rb, const Array& ra_idx) +{ + Octave_map retval; + + if (nfields () == rb.nfields ()) + { + for (const_iterator pa = begin (); pa != end (); pa++) + { + const_iterator pb = rb.seek (key(pa)); + + if (pb == rb.end ()) + { + error ("field name mismatch in structure concatenation"); + break; + } + + retval.assign (key(pa), + contents(pa).insert (rb.contents(pb), ra_idx)); + } + + // Preserve order of keys. + retval.key_list = key_list; + } + else + { + dim_vector dv = dims (); + + if (dv.all_zero ()) + retval = rb; + else + { + dv = rb.dims (); + + if (dv.all_zero ()) + retval = *this; + else + error ("invalid structure concatenation"); + } + } + + return retval; +} + +static bool +keys_ok (const Octave_map& a, const Octave_map& b, string_vector& keys) +{ + bool retval = false; + + keys = string_vector (); + + if (a.nfields () == 0) + { + keys = b.keys (); + retval = true; + } + else + { + string_vector a_keys = a.keys ().sort (); + string_vector b_keys = b.keys ().sort (); + + octave_idx_type a_len = a_keys.length (); + octave_idx_type b_len = b_keys.length (); + + if (a_len == b_len) + { + for (octave_idx_type i = 0; i < a_len; i++) + { + if (a_keys[i] != b_keys[i]) + goto done; + } + + keys = a_keys; + retval = true; + } + } + + done: + return retval; +} + +Octave_map& +Octave_map::maybe_delete_elements (const octave_value_list& idx) +{ + string_vector t_keys = keys (); + octave_idx_type len = t_keys.length (); + + if (len > 0) + { + for (octave_idx_type i = 0; i < len; i++) + { + std::string k = t_keys[i]; + + contents(k).delete_elements (idx); + + if (error_state) + break; + } + + if (!error_state) + dimensions = contents(t_keys[0]).dims (); + } + + return *this; +} + +Octave_map& +Octave_map::assign (const octave_value_list& idx, const Octave_map& rhs) +{ + string_vector t_keys; + + if (keys_ok (*this, rhs, t_keys)) + { + octave_idx_type len = t_keys.length (); + + if (len == 0) + { + Cell tmp_lhs (dims ()); + Cell tmp_rhs (rhs.dims ()); + + tmp_lhs.assign (idx, tmp_rhs, Matrix ()); + + if (! error_state) + resize (tmp_lhs.dims ()); + else + error ("size mismatch in structure assignment"); + } + else + { + for (octave_idx_type i = 0; i < len; i++) + { + std::string k = t_keys[i]; + + Cell t_rhs = rhs.contents (k); + + assign (idx, k, t_rhs); + + if (error_state) + break; + } + } + } + else + error ("field name mismatch in structure assignment"); + + return *this; +} + +Octave_map& +Octave_map::assign (const octave_value_list& idx, const std::string& k, + const Cell& rhs) +{ + Cell tmp; + + if (contains (k)) + tmp = map[k]; + else + tmp = Cell (dimensions); + + tmp.assign (idx, rhs); + + if (! error_state) + { + dim_vector tmp_dims = tmp.dims (); + + if (tmp_dims != dimensions) + { + for (iterator p = begin (); p != end (); p++) + contents(p).resize (tmp_dims, Matrix ()); + + dimensions = tmp_dims; + } + + maybe_add_to_key_list (k); + + map[k] = tmp; + } + + return *this; +} + +Octave_map& +Octave_map::assign (const std::string& k, const octave_value& rhs) +{ + if (nfields () == 0) + { + maybe_add_to_key_list (k); + + map[k] = Cell (rhs); + + dimensions = dim_vector (1, 1); + } + else + { + dim_vector dv = dims (); + + if (dv.all_ones ()) + { + maybe_add_to_key_list (k); + + map[k] = Cell (rhs); + } + else + error ("invalid structure assignment"); + } + + return *this; +} + +Octave_map& +Octave_map::assign (const std::string& k, const Cell& rhs) +{ + if (nfields () == 0) + { + maybe_add_to_key_list (k); + + map[k] = rhs; + + dimensions = rhs.dims (); + } + else + { + if (dims () == rhs.dims ()) + { + maybe_add_to_key_list (k); + + map[k] = rhs; + } + else + error ("invalid structure assignment"); + } + + return *this; +} + +Octave_map +Octave_map::index (const octave_value_list& idx, bool resize_ok) const +{ + Octave_map retval; + + octave_idx_type n_idx = idx.length (); + + if (n_idx > 0) + { + Array ra_idx (dim_vector (n_idx, 1)); + + for (octave_idx_type i = 0; i < n_idx; i++) + { + ra_idx(i) = idx(i).index_vector (); + if (error_state) + break; + } + + if (! error_state) + { + for (const_iterator p = begin (); p != end (); p++) + { + Cell tmp = contents (p); + + tmp = tmp.Array::index (ra_idx, resize_ok); + + if (error_state) + break; + + retval.assign (key(p), tmp); + } + + // Preserve order of keys. + retval.key_list = key_list; + } + } + else + retval = *this; + + return retval; +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/oct-map.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/oct-map.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,659 @@ +/* + +Copyright (C) 1994-2012 John W. Eaton +Copyright (C) 2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_oct_map_h) +#define octave_oct_map_h 1 + +#include +#include + +#include "Cell.h" +#include "oct-obj.h" + +class string_vector; + +// A class holding a map field->index. Supports reference-counting. +class OCTINTERP_API +octave_fields +{ + class fields_rep : public std::map + { + public: + fields_rep (void) : std::map (), count (1) { } + fields_rep (const fields_rep& other) + : std::map (other), count (1) { } + + octave_refcount count; + + private: + fields_rep& operator = (const fields_rep&); // no assignment! + }; + + fields_rep *rep; + + static fields_rep *nil_rep (void) + { + static fields_rep nr; + return &nr; + } + +public: + + octave_fields (void) : rep (nil_rep ()) { rep->count++; } + octave_fields (const string_vector&); + octave_fields (const char * const *); + + ~octave_fields (void) + { + if (--rep->count == 0) + delete rep; + } + + void make_unique (void) + { + if (rep->count > 1) + { + fields_rep *r = new fields_rep (*rep); + + if (--rep->count == 0) + delete rep; + + rep = r; + } + } + + octave_fields (const octave_fields& o) : rep (o.rep) { rep->count++; } + + octave_fields& + operator = (const octave_fields& o) + { + o.rep->count++; + if (--rep->count == 0) + delete rep; + rep = o.rep; + + return *this; + } + + // constant iteration support. non-const iteration intentionally unsupported. + + typedef std::map::const_iterator const_iterator; + typedef const_iterator iterator; + + const_iterator begin (void) const { return rep->begin (); } + const_iterator end (void) const { return rep->end (); } + + std::string key (const_iterator p) const { return p->first; } + octave_idx_type index (const_iterator p) const { return p->second; } + + const_iterator seek (const std::string& k) const + { return rep->find (k); } + + // high-level methods. + + // number of fields. + octave_idx_type nfields (void) const { return rep->size (); } + + // check whether a field exists. + bool isfield (const std::string& name) const; + + // get index of field. return -1 if not exist + octave_idx_type getfield (const std::string& name) const; + // get index of field. add if not exist + octave_idx_type getfield (const std::string& name); + // remove field and return the index. -1 if didn't exist. + octave_idx_type rmfield (const std::string& name); + + // order the fields of this map. creates a permutation + // used to order the fields. + void orderfields (Array& perm); + + // compares two instances for equality up to order of fields. + // returns a permutation needed to bring the fields of *other* + // into the order of *this*. + bool equal_up_to_order (const octave_fields& other, + octave_idx_type* perm) const; + + bool equal_up_to_order (const octave_fields& other, + Array& perm) const; + + bool is_same (const octave_fields& other) const + { return rep == other.rep; } + + // Returns the fields as a vector of strings. + string_vector fieldnames (void) const; + + void clear (void) + { + *this = octave_fields (); + } +}; + + +class OCTINTERP_API +octave_scalar_map +{ +public: + + octave_scalar_map (const octave_fields& k) + : xkeys (k), xvals (k.nfields ()) { } + + octave_scalar_map (void) : xkeys (), xvals () { } + + octave_scalar_map (const string_vector& k) + : xkeys (k), xvals (k.length ()) { } + + octave_scalar_map (const octave_scalar_map& m) + : xkeys (m.xkeys), xvals(m.xvals) { } + + octave_scalar_map& operator = (const octave_scalar_map& m) + { + xkeys = m.xkeys; + xvals = m.xvals; + + return *this; + } + + // iteration support. note that both const and non-const iterators are the + // same. The const/non-const distinction is made by the key & contents method. + typedef octave_fields::const_iterator const_iterator; + typedef const_iterator iterator; + + const_iterator begin (void) const { return xkeys.begin (); } + const_iterator end (void) const { return xkeys.end (); } + + const_iterator seek (const std::string& k) const { return xkeys.seek (k); } + + std::string key (const_iterator p) const + { return xkeys.key (p); } + octave_idx_type index (const_iterator p) const + { return xkeys.index (p); } + + const octave_value& contents (const_iterator p) const + { return xvals[xkeys.index (p)]; } + + octave_value& contents (iterator p) + { return xvals[xkeys.index (p)]; } + + const octave_value& contents (octave_idx_type i) const + { return xvals[i]; } + + octave_value& contents (octave_idx_type i) + { return xvals[i]; } + + // number of fields. + octave_idx_type nfields (void) const { return xkeys.nfields (); } + + // check whether a field exists. + bool isfield (const std::string& name) const + { return xkeys.isfield (name); } + + bool contains (const std::string& name) const + { return isfield (name); } + + string_vector fieldnames (void) const + { return xkeys.fieldnames (); } + + string_vector keys (void) const + { return fieldnames (); } + + // get contents of a given field. empty value if not exist. + octave_value getfield (const std::string& key) const; + + // set contents of a given field. add if not exist. + void setfield (const std::string& key, const octave_value& val); + void assign (const std::string& k, const octave_value& val) + { setfield (k, val); } + + // remove a given field. do nothing if not exist. + void rmfield (const std::string& key); + void del (const std::string& k) { rmfield (k); } + + // return a copy with fields ordered, optionally along with permutation. + octave_scalar_map orderfields (void) const; + octave_scalar_map orderfields (Array& perm) const; + octave_scalar_map orderfields (const octave_scalar_map& other, + Array& perm) const; + + // aka getfield/setfield, but the latter returns a reference. + octave_value contents (const std::string& k) const; + octave_value& contents (const std::string& k); + + void clear (void) + { + xkeys.clear (); + xvals.clear (); + } + + friend class octave_map; + +private: + + octave_fields xkeys; + std::vector xvals; + +}; + +template<> +inline octave_scalar_map octave_value_extract (const octave_value& v) + { return v.scalar_map_value (); } + +class OCTINTERP_API +octave_map +{ +public: + + octave_map (const octave_fields& k) + : xkeys (k), xvals (k.nfields ()), dimensions () { } + + octave_map (const dim_vector& dv, const octave_fields& k) + : xkeys (k), xvals (k.nfields (), Cell (dv)), dimensions (dv) { } + + typedef octave_scalar_map element_type; + + octave_map (void) : xkeys (), xvals (), dimensions () { } + + octave_map (const dim_vector& dv) : xkeys (), xvals (), dimensions (dv) { } + + octave_map (const string_vector& k) + : xkeys (k), xvals (k.length (), Cell (1, 1)), dimensions (1, 1) { } + + octave_map (const dim_vector& dv, const string_vector& k) + : xkeys (k), xvals (k.length (), Cell (dv)), dimensions (dv) { } + + octave_map (const octave_map& m) + : xkeys (m.xkeys), xvals (m.xvals), dimensions (m.dimensions) { } + + octave_map (const octave_scalar_map& m); + + octave_map (const Octave_map& m); + + octave_map& operator = (const octave_map& m) + { + xkeys = m.xkeys; + xvals = m.xvals; + dimensions = m.dimensions; + + return *this; + } + + // iteration support. note that both const and non-const iterators are the + // same. The const/non-const distinction is made by the key & contents method. + typedef octave_fields::const_iterator const_iterator; + typedef const_iterator iterator; + + const_iterator begin (void) const { return xkeys.begin (); } + const_iterator end (void) const { return xkeys.end (); } + + const_iterator seek (const std::string& k) const { return xkeys.seek (k); } + + std::string key (const_iterator p) const + { return xkeys.key (p); } + octave_idx_type index (const_iterator p) const + { return xkeys.index (p); } + + const Cell& contents (const_iterator p) const + { return xvals[xkeys.index (p)]; } + + Cell& contents (iterator p) + { return xvals[xkeys.index (p)]; } + + const Cell& contents (octave_idx_type i) const + { return xvals[i]; } + + Cell& contents (octave_idx_type i) + { return xvals[i]; } + + // number of fields. + octave_idx_type nfields (void) const { return xkeys.nfields (); } + + // check whether a field exists. + bool isfield (const std::string& name) const + { return xkeys.isfield (name); } + + bool contains (const std::string& name) const + { return isfield (name); } + + string_vector fieldnames (void) const + { return xkeys.fieldnames (); } + + string_vector keys (void) const + { return fieldnames (); } + + // get contents of a given field. empty value if not exist. + Cell getfield (const std::string& key) const; + + // set contents of a given field. add if not exist. checks for + // correct dimensions. + void setfield (const std::string& key, const Cell& val); + void assign (const std::string& k, const Cell& val) + { setfield (k, val); } + + // remove a given field. do nothing if not exist. + void rmfield (const std::string& key); + void del (const std::string& k) { rmfield (k); } + + // return a copy with fields ordered, optionally along with permutation. + octave_map orderfields (void) const; + octave_map orderfields (Array& perm) const; + octave_map orderfields (const octave_map& other, + Array& perm) const; + + // aka getfield/setfield, but the latter returns a reference. + Cell contents (const std::string& k) const; + Cell& contents (const std::string& k); + + void clear (void) + { + xkeys.clear (); + xvals.clear (); + } + + // The Array-like methods. + octave_idx_type numel (void) const { return dimensions.numel (); } + octave_idx_type length (void) const { return numel (); } + bool is_empty (void) const { return dimensions.any_zero (); } + + octave_idx_type rows (void) const { return dimensions(0); } + octave_idx_type cols (void) const { return dimensions(1); } + octave_idx_type columns (void) const { return dimensions(1); } + + // Extract a scalar substructure. + octave_scalar_map checkelem (octave_idx_type n) const; + octave_scalar_map checkelem (octave_idx_type i, octave_idx_type j) const; + + octave_scalar_map + checkelem (const Array& ra_idx) const; + + octave_scalar_map operator () (octave_idx_type n) const + { return checkelem (n); } + octave_scalar_map operator () (octave_idx_type i, octave_idx_type j) const + { return checkelem (i, j); } + + octave_scalar_map + operator () (const Array& ra_idx) const + { return checkelem (ra_idx); } + + octave_map squeeze (void) const; + + octave_map permute (const Array& vec, bool inv = false) const; + + dim_vector dims (void) const { return dimensions; } + + int ndims (void) const { return dimensions.length (); } + + octave_map transpose (void) const; + + octave_map reshape (const dim_vector& dv) const; + + void resize (const dim_vector& dv, bool fill = false); + + static octave_map + cat (int dim, octave_idx_type n, const octave_scalar_map *map_list); + + static octave_map + cat (int dim, octave_idx_type n, const octave_map *map_list); + + octave_map index (const idx_vector& i, bool resize_ok = false) const; + + octave_map index (const idx_vector& i, const idx_vector& j, + bool resize_ok = false) const; + + octave_map index (const Array& ia, + bool resize_ok = false) const; + + octave_map index (const octave_value_list&, bool resize_ok = false) const; + + octave_map column (octave_idx_type k) const; + octave_map page (octave_idx_type k) const; + + void assign (const idx_vector& i, const octave_map& rhs); + + void assign (const idx_vector& i, const idx_vector& j, const octave_map& rhs); + + void assign (const Array& ia, const octave_map& rhs); + + void assign (const octave_value_list&, const octave_map& rhs); + + void assign (const octave_value_list& idx, const std::string& k, + const Cell& rhs); + + void delete_elements (const idx_vector& i); + + void delete_elements (int dim, const idx_vector& i); + + void delete_elements (const Array& ia); + + void delete_elements (const octave_value_list&); + + octave_map concat (const octave_map& rb, const Array& ra_idx); + + // like checkelem, but no check. + octave_scalar_map fast_elem_extract (octave_idx_type n) const; + + // element assignment, no bounds check + bool fast_elem_insert (octave_idx_type n, const octave_scalar_map& rhs); + +private: + + octave_fields xkeys; + std::vector xvals; + dim_vector dimensions; + + void optimize_dimensions (void); + void extract_scalar (octave_scalar_map& dest, + octave_idx_type index) const; + static void do_cat (int dim, octave_idx_type n, + const octave_scalar_map *map_list, octave_map& retval); + static void do_cat (int dim, octave_idx_type n, + const octave_map *map_list, octave_map& retval); +}; + +template<> +inline octave_map octave_value_extract (const octave_value& v) + { return v.map_value (); } + +// The original Octave_map object which is now deprecated. +// Octave_map and octave_map are convertible to each other. + +class +OCTINTERP_API +Octave_map +{ + public: + + typedef std::map::iterator iterator; + typedef std::map::const_iterator const_iterator; + + typedef std::list::iterator key_list_iterator; + typedef std::list::const_iterator const_key_list_iterator; + + // Warning! You should always use at least two dimensions. + + Octave_map (const dim_vector& dv = dim_vector (0, 0), + const Cell& key_vals = Cell ()); + + Octave_map (const std::string& k, const octave_value& value) + : map (), key_list (), dimensions (1, 1) + { + map[k] = value; + key_list.push_back (k); + } + + Octave_map (const string_vector& sv, + const dim_vector& dv = dim_vector (0, 0)) + : map (), key_list (), dimensions (dv) + { + for (octave_idx_type i = 0; i < sv.length (); i++) + { + std::string k = sv[i]; + map[k] = Cell (dv); + key_list.push_back (k); + } + } + + Octave_map (const std::string& k, const Cell& vals) + : map (), key_list (), dimensions (vals.dims ()) + { + map[k] = vals; + key_list.push_back (k); + } + + Octave_map (const std::string& k, const octave_value_list& val_list) + : map (), key_list (), dimensions (1, val_list.length ()) + { + map[k] = val_list; + key_list.push_back (k); + } + + Octave_map (const Octave_map& m) + : map (m.map), key_list (m.key_list), dimensions (m.dimensions) { } + + Octave_map (const octave_map& m); + + Octave_map& operator = (const Octave_map& m) + { + if (this != &m) + { + map = m.map; + key_list = m.key_list; + dimensions = m.dimensions; + } + + return *this; + } + + ~Octave_map (void) { } + + Octave_map squeeze (void) const; + + Octave_map permute (const Array& vec, bool inv = false) const; + + // This is the number of keys. + octave_idx_type nfields (void) const { return map.size (); } + + void del (const std::string& k) + { + iterator p = map.find (k); + + if (p != map.end ()) + { + map.erase (p); + + key_list_iterator q + = std::find (key_list.begin (), key_list.end (), k); + + assert (q != key_list.end ()); + + key_list.erase (q); + } + } + + iterator begin (void) { return iterator (map.begin ()); } + const_iterator begin (void) const { return const_iterator (map.begin ()); } + + iterator end (void) { return iterator (map.end ()); } + const_iterator end (void) const { return const_iterator (map.end ()); } + + std::string key (const_iterator p) const { return p->first; } + + Cell& contents (const std::string& k); + Cell contents (const std::string& k) const; + + Cell& contents (iterator p) + { return p->second; } + + Cell contents (const_iterator p) const + { return p->second; } + + int intfield (const std::string& k, int def_val = 0) const; + + std::string stringfield (const std::string& k, + const std::string& def_val = std::string ()) const; + + iterator seek (const std::string& k) { return map.find (k); } + const_iterator seek (const std::string& k) const { return map.find (k); } + + bool contains (const std::string& k) const + { return (seek (k) != map.end ()); } + + void clear (void) + { + map.clear (); + key_list.clear (); + } + + string_vector keys (void) const; + + octave_idx_type rows (void) const { return dimensions(0); } + + octave_idx_type columns (void) const { return dimensions(1); } + + dim_vector dims (void) const { return dimensions; } + + int ndims (void) const { return dimensions.length (); } + + Octave_map transpose (void) const; + + Octave_map reshape (const dim_vector& new_dims) const; + + void resize (const dim_vector& dv, bool fill = false); + + octave_idx_type numel (void) const { return dimensions.numel (); } + + Octave_map concat (const Octave_map& rb, const Array& ra_idx); + + Octave_map& maybe_delete_elements (const octave_value_list& idx); + + Octave_map& assign (const octave_value_list& idx, const Octave_map& rhs); + + Octave_map& assign (const octave_value_list& idx, const std::string& k, + const Cell& rhs); + + Octave_map& assign (const std::string& k, const octave_value& rhs); + + Octave_map& assign (const std::string& k, const Cell& rhs); + + Octave_map index (const octave_value_list& idx, + bool resize_ok = false) const; + +private: + + // The map of names to values. + std::map map; + + // An extra list of keys, so we can keep track of the order the keys + // are added for compatibility with you know what. + std::list key_list; + + // The current size. + mutable dim_vector dimensions; + + void maybe_add_to_key_list (const std::string& k) + { + if (! contains (k)) + key_list.push_back (k); + } +} GCC_ATTR_DEPRECATED; + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/oct-obj.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/oct-obj.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,284 @@ +/* + +Copyright (C) 1994-2012 John W. Eaton +Copyright (C) 2009 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "error.h" +#include "oct-obj.h" +#include "Cell.h" + +// We are likely to have a lot of octave_value_list objects to allocate, +// so make the grow_size large. +DEFINE_OCTAVE_ALLOCATOR2(octave_value_list, 1024); + +octave_value_list::octave_value_list (const std::list& lst) +{ + octave_idx_type n = 0, nel = 0; + + // Determine number. + for (std::list::const_iterator p = lst.begin (); + p != lst.end (); p++) + { + n++; + nel += p->length (); + } + + // Optimize single-element case + if (n == 1) + data = lst.front ().data; + else if (nel > 0) + { + data.resize (dim_vector (1, nel)); + octave_idx_type k = 0; + for (std::list::const_iterator p = lst.begin (); + p != lst.end (); p++) + { + data.assign (idx_vector (k, k + p->length ()), p->data); + k += p->length (); + } + assert (k == nel); + } + +} + +octave_value_list& +octave_value_list::prepend (const octave_value& val) +{ + octave_idx_type n = length (); + + resize (n + 1); + + while (n > 0) + { + elem (n) = elem (n - 1); + n--; + } + + elem (0) = val; + + return *this; +} + +octave_value_list& +octave_value_list::append (const octave_value& val) +{ + octave_idx_type n = length (); + + resize (n + 1); + + elem (n) = val; + + return *this; +} + +octave_value_list& +octave_value_list::append (const octave_value_list& lst) +{ + octave_idx_type len = length (); + octave_idx_type lst_len = lst.length (); + + resize (len + lst_len); + + for (octave_idx_type i = 0; i < lst_len; i++) + elem (len + i) = lst (i); + + return *this; +} + +octave_value_list& +octave_value_list::reverse (void) +{ + octave_idx_type n = length (); + + for (octave_idx_type i = 0; i < n / 2; i++) + { + octave_value tmp = elem (i); + elem (i) = elem (n - i - 1); + elem (n - i - 1) = tmp; + } + + return *this; +} + +octave_value_list +octave_value_list::splice (octave_idx_type offset, octave_idx_type rep_length, + const octave_value_list& lst) const +{ + octave_value_list retval; + + octave_idx_type len = length (); + + if (offset < 0 || offset >= len) + { + if (! (rep_length == 0 && offset == len)) + { + error ("octave_value_list::splice: invalid OFFSET"); + return retval; + } + } + + if (rep_length < 0 || rep_length + offset > len) + { + error ("octave_value_list::splice: invalid LENGTH"); + return retval; + } + + octave_idx_type lst_len = lst.length (); + + octave_idx_type new_len = len - rep_length + lst_len; + + retval.resize (new_len); + + octave_idx_type k = 0; + + for (octave_idx_type i = 0; i < offset; i++) + retval(k++) = elem (i); + + for (octave_idx_type i = 0; i < lst_len; i++) + retval(k++) = lst (i); + + for (octave_idx_type i = offset + rep_length; i < len; i++) + retval(k++) = elem (i); + + return retval; +} + +bool +octave_value_list::all_strings_p (void) const +{ + octave_idx_type n = length (); + + for (octave_idx_type i = 0; i < n; i++) + if (! elem(i).is_string ()) + return false; + + return true; +} + +bool +octave_value_list::all_scalars (void) const +{ + octave_idx_type n = length (); + + for (octave_idx_type i = 0; i < n; i++) + { + dim_vector dv = elem(i).dims (); + if (! dv.all_ones ()) + return false; + } + + return true; +} + +bool +octave_value_list::any_cell (void) const +{ + octave_idx_type n = length (); + + for (octave_idx_type i = 0; i < n; i++) + if (elem (i).is_cell ()) + return true; + + return false; +} + +bool +octave_value_list::has_magic_colon (void) const +{ + octave_idx_type n = length (); + + for (octave_idx_type i = 0; i < n; i++) + if (elem(i).is_magic_colon ()) + return true; + + return false; +} + +string_vector +octave_value_list::make_argv (const std::string& fcn_name) const +{ + string_vector argv; + + if (all_strings_p ()) + { + octave_idx_type len = length (); + + octave_idx_type total_nr = 0; + + for (octave_idx_type i = 0; i < len; i++) + { + // An empty std::string ("") has zero columns and zero rows (a + // change that was made for Matlab contemptibility. + + octave_idx_type n = elem(i).rows (); + + total_nr += n ? n : 1; + } + + octave_idx_type k = 0; + if (! fcn_name.empty ()) + { + argv.resize (total_nr+1); + argv[0] = fcn_name; + k = 1; + } + else + argv.resize (total_nr); + + for (octave_idx_type i = 0; i < len; i++) + { + octave_idx_type nr = elem(i).rows (); + + if (nr < 2) + argv[k++] = elem(i).string_value (); + else + { + string_vector tmp = elem(i).all_strings (); + + for (octave_idx_type j = 0; j < nr; j++) + argv[k++] = tmp[j]; + } + } + } + else + error ("%s: expecting all arguments to be strings", fcn_name.c_str ()); + + return argv; +} + +void +octave_value_list::make_storable_values (void) +{ + octave_idx_type len = length (); + const Array& cdata = data; + + for (octave_idx_type i = 0; i < len; i++) + { + // This is optimized so that we don't force a copy unless necessary. + octave_value tmp = cdata(i).storable_value (); + if (! tmp.is_copy_of (cdata (i))) + data(i) = tmp; + } +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/oct-obj.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/oct-obj.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,317 @@ +/* + +Copyright (C) 1994-2012 John W. Eaton +Copyright (C) 2009 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_oct_obj_h) +#define octave_oct_obj_h 1 + +#include +#include + +#include "oct-alloc.h" +#include "str-vec.h" +#include "Array.h" + +#include "ov.h" +#include "Cell.h" + +class +OCTINTERP_API +octave_value_list +{ +public: + + octave_value_list (void) + : data (), names () { } + + explicit octave_value_list (octave_idx_type n) + : data (dim_vector (1, n)), names () { } + + octave_value_list (octave_idx_type n, const octave_value& val) + : data (dim_vector (1, n), val), names () { } + + octave_value_list (const octave_value& tc) + : data (dim_vector (1, 1), tc), names () { } + + octave_value_list (const Array& d) + : data (d.as_row ()), names () { } + + octave_value_list (const Cell& tc) + : data (tc.as_row ()), names () { } + + octave_value_list (const octave_value_list& obj) + : data (obj.data), names (obj.names) { } + + // Concatenation constructor. + octave_value_list (const std::list&); + + ~octave_value_list (void) { } + + octave_value_list& operator = (const octave_value_list& obj) + { + if (this != &obj) + { + data = obj.data; + names = obj.names; + } + + return *this; + } + + Array array_value (void) const { return data; } + + Cell cell_value (void) const { return array_value (); } + + // Assignment will resize on range errors. + + octave_value& operator () (octave_idx_type n) { return elem (n); } + + const octave_value& operator () (octave_idx_type n) const { return elem (n); } + + octave_idx_type length (void) const { return data.length (); } + + bool empty (void) const { return length () == 0; } + + void resize (octave_idx_type n, const octave_value& rfv = octave_value ()) + { + data.resize (dim_vector (1, n), rfv); + } + + octave_value_list& prepend (const octave_value& val); + + octave_value_list& append (const octave_value& val); + + octave_value_list& append (const octave_value_list& lst); + + octave_value_list& reverse (void); + + octave_value_list + slice (octave_idx_type offset, octave_idx_type len, bool tags = false) const + { + octave_value_list retval (data.linear_slice (offset, offset + len)); + if (tags && len > 0 && names.length () > 0) + retval.names = names.linear_slice (offset, std::min (len, names.length ())); + + return retval; + } + + octave_value_list + splice (octave_idx_type offset, octave_idx_type len, + const octave_value_list& lst = octave_value_list ()) const; + + bool all_strings_p (void) const; + + bool all_scalars (void) const; + + bool any_cell (void) const; + + bool has_magic_colon (void) const; + + string_vector make_argv (const std::string& = std::string ()) const; + + void stash_name_tags (const string_vector& nm) { names = nm; } + + string_vector name_tags (void) const { return names; } + + void make_storable_values (void); + + octave_value& xelem (octave_idx_type i) + { + return data.xelem (i); + } + + void clear (void) + { + data.clear (); + } + +private: + + Array data; + + // This list of strings can be used to tag each element of data with + // a name. By default, it is empty. + string_vector names; + + octave_value& elem (octave_idx_type n) + { + if (n >= length ()) + resize (n + 1); + + return data(n); + } + + const octave_value& elem (octave_idx_type n) const + { return data(n); } + + DECLARE_OCTAVE_ALLOCATOR +}; + +// Make it easy to build argument lists for built-in functions or for +// returning values. + +inline octave_value_list +ovl (const octave_value& a0) +{ + octave_value_list retval; + retval(0) = a0; + return retval; +} + +inline octave_value_list +ovl (const octave_value& a0, const octave_value& a1) +{ + octave_value_list retval; + retval(1) = a1; + retval(0) = a0; + return retval; +} + +inline octave_value_list +ovl (const octave_value& a0, const octave_value& a1, + const octave_value& a2) +{ + octave_value_list retval; + retval(2) = a2; + retval(1) = a1; + retval(0) = a0; + return retval; +} + +inline octave_value_list +ovl (const octave_value& a0, const octave_value& a1, + const octave_value& a2, const octave_value& a3) +{ + octave_value_list retval; + retval(3) = a3; + retval(2) = a2; + retval(1) = a1; + retval(0) = a0; + return retval; +} + +inline octave_value_list +ovl (const octave_value& a0, const octave_value& a1, + const octave_value& a2, const octave_value& a3, + const octave_value& a4) +{ + octave_value_list retval; + retval(4) = a4; + retval(3) = a3; + retval(2) = a2; + retval(1) = a1; + retval(0) = a0; + return retval; +} + +inline octave_value_list +ovl (const octave_value& a0, const octave_value& a1, + const octave_value& a2, const octave_value& a3, + const octave_value& a4, const octave_value& a5) +{ + octave_value_list retval; + retval(5) = a5; + retval(4) = a4; + retval(3) = a3; + retval(2) = a2; + retval(1) = a1; + retval(0) = a0; + return retval; +} + +inline octave_value_list +ovl (const octave_value& a0, const octave_value& a1, + const octave_value& a2, const octave_value& a3, + const octave_value& a4, const octave_value& a5, + const octave_value& a6) +{ + octave_value_list retval; + retval(6) = a6; + retval(5) = a5; + retval(4) = a4; + retval(3) = a3; + retval(2) = a2; + retval(1) = a1; + retval(0) = a0; + return retval; +} + +inline octave_value_list +ovl (const octave_value& a0, const octave_value& a1, + const octave_value& a2, const octave_value& a3, + const octave_value& a4, const octave_value& a5, + const octave_value& a6, const octave_value& a7) +{ + octave_value_list retval; + retval(7) = a7; + retval(6) = a6; + retval(5) = a5; + retval(4) = a4; + retval(3) = a3; + retval(2) = a2; + retval(1) = a1; + retval(0) = a0; + return retval; +} + +inline octave_value_list +ovl (const octave_value& a0, const octave_value& a1, + const octave_value& a2, const octave_value& a3, + const octave_value& a4, const octave_value& a5, + const octave_value& a6, const octave_value& a7, + const octave_value& a8) +{ + octave_value_list retval; + retval(8) = a8; + retval(7) = a7; + retval(6) = a6; + retval(5) = a5; + retval(4) = a4; + retval(3) = a3; + retval(2) = a2; + retval(1) = a1; + retval(0) = a0; + return retval; +} + +inline octave_value_list +ovl (const octave_value& a0, const octave_value& a1, + const octave_value& a2, const octave_value& a3, + const octave_value& a4, const octave_value& a5, + const octave_value& a6, const octave_value& a7, + const octave_value& a8, const octave_value& a9) +{ + octave_value_list retval; + retval(9) = a9; + retval(8) = a8; + retval(7) = a7; + retval(6) = a6; + retval(5) = a5; + retval(4) = a4; + retval(3) = a3; + retval(2) = a2; + retval(1) = a1; + retval(0) = a0; + return retval; +} + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/oct-prcstrm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/oct-prcstrm.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,70 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "oct-prcstrm.h" +#include "sysdep.h" + +octave_stream +octave_iprocstream::create (const std::string& n, std::ios::openmode arg_md, + oct_mach_info::float_format ff) +{ + return octave_stream (new octave_iprocstream (n, arg_md, ff)); +} + +octave_iprocstream::octave_iprocstream (const std::string& n, + std::ios::openmode arg_md, + oct_mach_info::float_format ff) + : octave_stdiostream (n, octave_popen (n.c_str (), "r"), + arg_md, ff, octave_pclose) +{ +} + +octave_iprocstream::~octave_iprocstream (void) +{ + do_close (); +} + +octave_stream +octave_oprocstream::create (const std::string& n, std::ios::openmode arg_md, + oct_mach_info::float_format ff) +{ + return octave_stream (new octave_oprocstream (n, arg_md, ff)); +} + +octave_oprocstream::octave_oprocstream (const std::string& n, + std::ios::openmode arg_md, + oct_mach_info::float_format ff) + : octave_stdiostream (n, octave_popen (n.c_str (), "w"), + arg_md, ff, octave_pclose) +{ +} + +octave_oprocstream::~octave_oprocstream (void) +{ + do_close (); +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/oct-prcstrm.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/oct-prcstrm.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,87 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_octave_procstream_h) +#define octave_octave_procstream_h 1 + +#include "oct-stdstrm.h" + +// FIXME -- why don't these classes use iprocstream and +// oprocstream, which in turn use the octave_procbuf class? + +class +octave_iprocstream : public octave_stdiostream +{ +public: + + octave_iprocstream (const std::string& n, + std::ios::openmode arg_md = std::ios::in, + oct_mach_info::float_format flt_fmt + = oct_mach_info::native_float_format ()); + + static octave_stream + create (const std::string& n, std::ios::openmode arg_md = std::ios::in, + oct_mach_info::float_format flt_fmt + = oct_mach_info::native_float_format ()); + +protected: + + ~octave_iprocstream (void); + +private: + + // No copying! + + octave_iprocstream (const octave_iprocstream&); + + octave_iprocstream& operator = (const octave_iprocstream&); +}; + +class +octave_oprocstream : public octave_stdiostream +{ +public: + + octave_oprocstream (const std::string& n, + std::ios::openmode arg_md = std::ios::out, + oct_mach_info::float_format flt_fmt + = oct_mach_info::native_float_format ()); + + static octave_stream + create (const std::string& n, std::ios::openmode arg_md = std::ios::out, + oct_mach_info::float_format flt_fmt + = oct_mach_info::native_float_format ()); + +protected: + + ~octave_oprocstream (void); + +private: + + // No copying! + + octave_oprocstream (const octave_oprocstream&); + + octave_oprocstream& operator = (const octave_oprocstream&); +}; + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/oct-procbuf.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/oct-procbuf.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,222 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include + +#include +#include + +#include "lo-mappers.h" +#include "lo-utils.h" +#include "oct-procbuf.h" +#include "oct-syscalls.h" +#include "sysdep.h" +#include "variables.h" + +#include "defun.h" +#include "gripes.h" +#include "utils.h" + +#ifndef SHELL_PATH +#define SHELL_PATH "/bin/sh" +#endif + +// This class is based on the procbuf class from libg++, written by +// Per Bothner, Copyright (C) 1993 Free Software Foundation. + +static octave_procbuf *octave_procbuf_list = 0; + +#ifndef BUFSIZ +#define BUFSIZ 1024 +#endif + +octave_procbuf * +octave_procbuf::open (const char *command, int mode) +{ +#if defined (__CYGWIN__) || defined (__MINGW32__) || defined (_MSC_VER) + + if (is_open ()) + return 0; + + f = octave_popen (command, (mode & std::ios::in) ? "r" : "w"); + + if (! f) + return 0; + + // Oops... popen doesn't return the associated pid, so fake it for now + + proc_pid = 1; + + open_p = true; + + if (mode & std::ios::out) + ::setvbuf (f, 0, _IOLBF, BUFSIZ); + + return this; + +#elif defined (HAVE_SYS_WAIT_H) + + int pipe_fds[2]; + + volatile int child_std_end = (mode & std::ios::in) ? 1 : 0; + + volatile int parent_end, child_end; + + if (is_open ()) + return 0; + + if (pipe (pipe_fds) < 0) + return 0; + + if (mode & std::ios::in) + { + parent_end = pipe_fds[0]; + child_end = pipe_fds[1]; + } + else + { + parent_end = pipe_fds[1]; + child_end = pipe_fds[0]; + } + + proc_pid = ::fork (); + + if (proc_pid == 0) + { + gnulib::close (parent_end); + + if (child_end != child_std_end) + { + gnulib::dup2 (child_end, child_std_end); + gnulib::close (child_end); + } + + while (octave_procbuf_list) + { + FILE *fp = octave_procbuf_list->f; + + if (fp) + { + gnulib::fclose (fp); + fp = 0; + } + + octave_procbuf_list = octave_procbuf_list->next; + } + + execl (SHELL_PATH, "sh", "-c", command, static_cast (0)); + + exit (127); + } + + gnulib::close (child_end); + + if (proc_pid < 0) + { + gnulib::close (parent_end); + return 0; + } + + f = ::fdopen (parent_end, (mode & std::ios::in) ? "r" : "w"); + + if (mode & std::ios::out) + ::setvbuf (f, 0, _IOLBF, BUFSIZ); + + open_p = true; + + next = octave_procbuf_list; + octave_procbuf_list = this; + + return this; + +#else + + return 0; + +#endif +} + +octave_procbuf * +octave_procbuf::close (void) +{ +#if defined (__CYGWIN__) || defined (__MINGW32__) || defined (_MSC_VER) + + if (f) + { + wstatus = octave_pclose (f); + f = 0; + } + + open_p = false; + + return this; + +#elif defined (HAVE_SYS_WAIT_H) + + if (f) + { + pid_t wait_pid; + + int status = -1; + + for (octave_procbuf **ptr = &octave_procbuf_list; + *ptr != 0; + ptr = &(*ptr)->next) + { + if (*ptr == this) + { + *ptr = (*ptr)->next; + status = 0; + break; + } + } + + if (status == 0 && gnulib::fclose (f) == 0) + { + using namespace std; + + do + { + wait_pid = octave_syscalls::waitpid (proc_pid, &wstatus, 0); + } + while (wait_pid == -1 && errno == EINTR); + } + + f = 0; + } + + open_p = false; + + return this; + +#else + + return 0; + +#endif +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/oct-procbuf.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/oct-procbuf.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,79 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// This class is based on the procbuf class from libg++, written by +// Per Bothner, Copyright (C) 1993 Free Software Foundation. + +#if !defined (octave_octave_procbuf_h) +#define octave_octave_procbuf_h 1 + +#include + +#include "c-file-ptr-stream.h" + +class +octave_procbuf : public c_file_ptr_buf +{ +public: + + octave_procbuf (void) + : c_file_ptr_buf (0), wstatus (-1), open_p (false), proc_pid (-1), + next (0) { } + + octave_procbuf (const char *command, int mode) + : c_file_ptr_buf (0), wstatus (-1), open_p (false), proc_pid (-1), + next (0) { open (command, mode); } + + ~octave_procbuf (void) { close (); } + + octave_procbuf *open (const char *command, int mode); + + octave_procbuf *close (void); + + int wait_status (void) const { return wstatus; } + + bool is_open (void) const { return open_p; } + + pid_t pid (void) const { return proc_pid; } + +protected: + + int wstatus; + + bool open_p; + + pid_t proc_pid; + + octave_procbuf *next; + +private: + + // No copying! + + octave_procbuf (const octave_procbuf&); + + octave_procbuf& operator = (const octave_procbuf&); +}; + +extern void symbols_of_oct_procbuf (void); + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/oct-stdstrm.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/oct-stdstrm.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,175 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_octave_stdiostream_h) +#define octave_octave_stdiostream_h 1 + +#include "oct-stream.h" +#include "c-file-ptr-stream.h" + +template +class +octave_tstdiostream : public octave_base_stream +{ +public: + + octave_tstdiostream (const std::string& n, FILE_T f = 0, int fid = 0, + std::ios::openmode m = std::ios::in|std::ios::out, + oct_mach_info::float_format ff + = oct_mach_info::native_float_format (), + typename BUF_T::close_fcn cf = BUF_T::file_close) + : octave_base_stream (m, ff), nm (n), md (m), + s (f ? new STREAM_T (f, cf) : 0), fnum (fid) + { } + + // Position a stream at OFFSET relative to ORIGIN. + + int seek (off_t offset, int origin) + { return s ? s->seek (offset, origin) : -1; } + + // Return current stream position. + + off_t tell (void) { return s ? s->tell () : -1; } + + // Return non-zero if EOF has been reached on this stream. + + bool eof (void) const { return s ? s->eof () : true; } + + // The name of the file. + + std::string name (void) const { return nm; } + + std::istream *input_stream (void) { return (md & std::ios::in) ? s : 0; } + + std::ostream *output_stream (void) { return (md & std::ios::out) ? s : 0; } + + // FIXME -- should not have to cast away const here. + BUF_T *rdbuf (void) const + { return s ? (const_cast (s))->rdbuf () : 0; } + + int file_number (void) const { return fnum; } + + bool bad (void) const { return s ? s->bad () : true; } + + void clear (void) { if (s) s->clear (); } + + void do_close (void) { if (s) s->stream_close (); } + +protected: + + std::string nm; + + std::ios::openmode md; + + STREAM_T *s; + + // The file number associated with this file. + int fnum; + + ~octave_tstdiostream (void) { delete s; } + +private: + + // No copying! + + octave_tstdiostream (const octave_tstdiostream&); + + octave_tstdiostream& operator = (const octave_tstdiostream&); +}; + +class +octave_stdiostream + : public octave_tstdiostream +{ +public: + + octave_stdiostream (const std::string& n, FILE *f = 0, + std::ios::openmode m = std::ios::in|std::ios::out, + oct_mach_info::float_format ff + = oct_mach_info::native_float_format (), + c_file_ptr_buf::close_fcn cf = c_file_ptr_buf::file_close) + : octave_tstdiostream (n, f, f ? fileno (f) : -1, m, ff, cf) { } + + static octave_stream + create (const std::string& n, FILE *f = 0, + std::ios::openmode m = std::ios::in|std::ios::out, + oct_mach_info::float_format ff + = oct_mach_info::native_float_format (), + c_file_ptr_buf::close_fcn cf = c_file_ptr_buf::file_close) + { + return octave_stream (new octave_stdiostream (n, f, m, ff, cf)); + } + +protected: + + ~octave_stdiostream (void) { } + +private: + + // No copying! + + octave_stdiostream (const octave_stdiostream&); + + octave_stdiostream& operator = (const octave_stdiostream&); +}; + +#ifdef HAVE_ZLIB + +class +octave_zstdiostream + : public octave_tstdiostream +{ +public: + + octave_zstdiostream (const std::string& n, gzFile f = 0, int fid = 0, + std::ios::openmode m = std::ios::in|std::ios::out, + oct_mach_info::float_format ff + = oct_mach_info::native_float_format (), + c_zfile_ptr_buf::close_fcn cf = c_zfile_ptr_buf::file_close) + : octave_tstdiostream (n, f, fid, m, ff, cf) { } + + static octave_stream + create (const std::string& n, gzFile f = 0, int fid = 0, + std::ios::openmode m = std::ios::in|std::ios::out, + oct_mach_info::float_format ff + = oct_mach_info::native_float_format (), + c_zfile_ptr_buf::close_fcn cf = c_zfile_ptr_buf::file_close) + { + return octave_stream (new octave_zstdiostream (n, f, fid, m, ff, cf)); + } + +protected: + + ~octave_zstdiostream (void) { } + +private: + + // No copying! + + octave_zstdiostream (const octave_zstdiostream&); + + octave_zstdiostream& operator = (const octave_zstdiostream&); +}; + +#endif + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/oct-stream.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/oct-stream.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,4311 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include +#include +#include +#include +#include + +#include + +#include "byte-swap.h" +#include "lo-ieee.h" +#include "lo-mappers.h" +#include "lo-utils.h" +#include "quit.h" +#include "singleton-cleanup.h" +#include "str-vec.h" + +#include "error.h" +#include "gripes.h" +#include "input.h" +#include "oct-stdstrm.h" +#include "oct-stream.h" +#include "oct-obj.h" +#include "utils.h" + +// Possible values for conv_err: +// +// 1 : not a real scalar +// 2 : value is NaN +// 3 : value is not an integer + +static int +convert_to_valid_int (const octave_value& tc, int& conv_err) +{ + int retval = 0; + + conv_err = 0; + + double dval = tc.double_value (); + + if (! error_state) + { + if (! lo_ieee_isnan (dval)) + { + int ival = NINT (dval); + + if (ival == dval) + retval = ival; + else + conv_err = 3; + } + else + conv_err = 2; + } + else + conv_err = 1; + + return retval; +} + +static int +get_size (double d, const std::string& who) +{ + int retval = -1; + + if (! lo_ieee_isnan (d)) + { + if (! xisinf (d)) + { + if (d >= 0.0) + retval = NINT (d); + else + ::error ("%s: negative value invalid as size specification", + who.c_str ()); + } + else + retval = -1; + } + else + ::error ("%s: NaN is invalid as size specification", who.c_str ()); + + return retval; +} + +static void +get_size (const Array& size, octave_idx_type& nr, octave_idx_type& nc, bool& one_elt_size_spec, + const std::string& who) +{ + nr = -1; + nc = -1; + + one_elt_size_spec = false; + + double dnr = -1.0; + double dnc = -1.0; + + octave_idx_type sz_len = size.length (); + + if (sz_len == 1) + { + one_elt_size_spec = true; + + dnr = size (0); + + dnc = (dnr == 0.0) ? 0.0 : 1.0; + } + else if (sz_len == 2) + { + dnr = size (0); + + if (! xisinf (dnr)) + dnc = size (1); + else + ::error ("%s: invalid size specification", who.c_str ()); + } + else + ::error ("%s: invalid size specification", who.c_str ()); + + if (! error_state) + { + nr = get_size (dnr, who); + + if (! error_state && dnc >= 0.0) + nc = get_size (dnc, who); + } +} + +scanf_format_list::scanf_format_list (const std::string& s) + : nconv (0), curr_idx (0), list (dim_vector (16, 1)), buf (0) +{ + octave_idx_type num_elts = 0; + + size_t n = s.length (); + + size_t i = 0; + + int width = 0; + bool discard = false; + char modifier = '\0'; + char type = '\0'; + + bool have_more = true; + + while (i < n) + { + have_more = true; + + if (! buf) + buf = new std::ostringstream (); + + if (s[i] == '%') + { + // Process percent-escape conversion type. + + process_conversion (s, i, n, width, discard, type, modifier, + num_elts); + + have_more = (buf != 0); + } + else if (isspace (s[i])) + { + type = scanf_format_elt::whitespace_conversion; + + width = 0; + discard = false; + modifier = '\0'; + *buf << " "; + + while (++i < n && isspace (s[i])) + /* skip whitespace */; + + add_elt_to_list (width, discard, type, modifier, num_elts); + + have_more = false; + } + else + { + type = scanf_format_elt::literal_conversion; + + width = 0; + discard = false; + modifier = '\0'; + + while (i < n && ! isspace (s[i]) && s[i] != '%') + *buf << s[i++]; + + add_elt_to_list (width, discard, type, modifier, num_elts); + + have_more = false; + } + + if (nconv < 0) + { + have_more = false; + break; + } + } + + if (have_more) + add_elt_to_list (width, discard, type, modifier, num_elts); + + list.resize (dim_vector (num_elts, 1)); + + delete buf; +} + +scanf_format_list::~scanf_format_list (void) +{ + octave_idx_type n = list.length (); + + for (octave_idx_type i = 0; i < n; i++) + { + scanf_format_elt *elt = list(i); + delete elt; + } +} + +void +scanf_format_list::add_elt_to_list (int width, bool discard, char type, + char modifier, octave_idx_type& num_elts, + const std::string& char_class) +{ + if (buf) + { + std::string text = buf->str (); + + if (! text.empty ()) + { + scanf_format_elt *elt + = new scanf_format_elt (text.c_str (), width, discard, type, + modifier, char_class); + + if (num_elts == list.length ()) + list.resize (dim_vector (2 * num_elts, 1)); + + list(num_elts++) = elt; + } + + delete buf; + buf = 0; + } +} + +static std::string +expand_char_class (const std::string& s) +{ + std::string retval; + + size_t len = s.length (); + + size_t i = 0; + + while (i < len) + { + unsigned char c = s[i++]; + + if (c == '-' && i > 1 && i < len + && static_cast (s[i-2]) <= static_cast (s[i])) + { + // Add all characters from the range except the first (we + // already added it below). + + for (c = s[i-2]+1; c < s[i]; c++) + retval += c; + } + else + { + // Add the character to the class. Only add '-' if it is + // the last character in the class. + + if (c != '-' || i == len) + retval += c; + } + } + + return retval; +} + +void +scanf_format_list::process_conversion (const std::string& s, size_t& i, + size_t n, int& width, bool& discard, + char& type, char& modifier, + octave_idx_type& num_elts) +{ + width = 0; + discard = false; + modifier = '\0'; + type = '\0'; + + *buf << s[i++]; + + bool have_width = false; + + while (i < n) + { + switch (s[i]) + { + case '*': + if (discard) + nconv = -1; + else + { + discard = true; + *buf << s[i++]; + } + break; + + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + if (have_width) + nconv = -1; + else + { + char c = s[i++]; + width = width * 10 + c - '0'; + have_width = true; + *buf << c; + while (i < n && isdigit (s[i])) + { + c = s[i++]; + width = width * 10 + c - '0'; + *buf << c; + } + } + break; + + case 'h': case 'l': case 'L': + if (modifier != '\0') + nconv = -1; + else + modifier = s[i++]; + break; + + case 'd': case 'i': case 'o': case 'u': case 'x': + if (modifier == 'L') + { + nconv = -1; + break; + } + goto fini; + + case 'e': case 'f': case 'g': + if (modifier == 'h') + { + nconv = -1; + break; + } + + // No float or long double conversions, thanks. + *buf << 'l'; + + goto fini; + + case 'c': case 's': case 'p': case '%': case '[': + if (modifier != '\0') + { + nconv = -1; + break; + } + goto fini; + + fini: + { + if (finish_conversion (s, i, n, width, discard, type, + modifier, num_elts) == 0) + return; + } + break; + + default: + nconv = -1; + break; + } + + if (nconv < 0) + break; + } + + nconv = -1; +} + +int +scanf_format_list::finish_conversion (const std::string& s, size_t& i, + size_t n, int& width, bool discard, + char& type, char modifier, + octave_idx_type& num_elts) +{ + int retval = 0; + + std::string char_class; + + size_t beg_idx = std::string::npos; + size_t end_idx = std::string::npos; + + if (s[i] == '%') + { + type = '%'; + *buf << s[i++]; + } + else + { + type = s[i]; + + if (s[i] == '[') + { + *buf << s[i++]; + + if (i < n) + { + beg_idx = i; + + if (s[i] == '^') + { + type = '^'; + *buf << s[i++]; + + if (i < n) + { + beg_idx = i; + + if (s[i] == ']') + *buf << s[i++]; + } + } + else if (s[i] == ']') + *buf << s[i++]; + } + + while (i < n && s[i] != ']') + *buf << s[i++]; + + if (i < n && s[i] == ']') + { + end_idx = i-1; + *buf << s[i++]; + } + + if (s[i-1] != ']') + retval = nconv = -1; + } + else + *buf << s[i++]; + + nconv++; + } + + if (nconv >= 0) + { + if (beg_idx != std::string::npos && end_idx != std::string::npos) + char_class = expand_char_class (s.substr (beg_idx, + end_idx - beg_idx + 1)); + + add_elt_to_list (width, discard, type, modifier, num_elts, char_class); + } + + return retval; +} + +void +scanf_format_list::printme (void) const +{ + octave_idx_type n = list.length (); + + for (octave_idx_type i = 0; i < n; i++) + { + scanf_format_elt *elt = list(i); + + std::cerr + << "width: " << elt->width << "\n" + << "discard: " << elt->discard << "\n" + << "type: "; + + if (elt->type == scanf_format_elt::literal_conversion) + std::cerr << "literal text\n"; + else if (elt->type == scanf_format_elt::whitespace_conversion) + std::cerr << "whitespace\n"; + else + std::cerr << elt->type << "\n"; + + std::cerr + << "modifier: " << elt->modifier << "\n" + << "char_class: '" << undo_string_escapes (elt->char_class) << "'\n" + << "text: '" << undo_string_escapes (elt->text) << "'\n\n"; + } +} + +bool +scanf_format_list::all_character_conversions (void) +{ + octave_idx_type n = list.length (); + + if (n > 0) + { + for (octave_idx_type i = 0; i < n; i++) + { + scanf_format_elt *elt = list(i); + + switch (elt->type) + { + case 'c': case 's': case '%': case '[': case '^': + case scanf_format_elt::literal_conversion: + case scanf_format_elt::whitespace_conversion: + break; + + default: + return false; + break; + } + } + + return true; + } + else + return false; +} + +bool +scanf_format_list::all_numeric_conversions (void) +{ + octave_idx_type n = list.length (); + + if (n > 0) + { + for (octave_idx_type i = 0; i < n; i++) + { + scanf_format_elt *elt = list(i); + + switch (elt->type) + { + case 'd': case 'i': case 'o': case 'u': case 'x': + case 'e': case 'f': case 'g': + break; + + default: + return false; + break; + } + } + + return true; + } + else + return false; +} + +// Ugh again. + +printf_format_list::printf_format_list (const std::string& s) + : nconv (0), curr_idx (0), list (dim_vector (16, 1)), buf (0) +{ + octave_idx_type num_elts = 0; + + size_t n = s.length (); + + size_t i = 0; + + int args = 0; + std::string flags; + int fw = 0; + int prec = 0; + char modifier = '\0'; + char type = '\0'; + + bool have_more = true; + bool empty_buf = true; + + if (n == 0) + { + printf_format_elt *elt + = new printf_format_elt ("", args, fw, prec, flags, type, modifier); + + list(num_elts++) = elt; + + list.resize (dim_vector (num_elts, 1)); + } + else + { + while (i < n) + { + have_more = true; + + if (! buf) + { + buf = new std::ostringstream (); + empty_buf = true; + } + + switch (s[i]) + { + case '%': + { + if (empty_buf) + { + process_conversion (s, i, n, args, flags, fw, prec, + type, modifier, num_elts); + + have_more = (buf != 0); + } + else + add_elt_to_list (args, flags, fw, prec, type, modifier, + num_elts); + } + break; + + default: + { + args = 0; + flags = ""; + fw = 0; + prec = 0; + modifier = '\0'; + type = '\0'; + *buf << s[i++]; + empty_buf = false; + } + break; + } + + if (nconv < 0) + { + have_more = false; + break; + } + } + + if (have_more) + add_elt_to_list (args, flags, fw, prec, type, modifier, num_elts); + + list.resize (dim_vector (num_elts, 1)); + + delete buf; + } +} + +printf_format_list::~printf_format_list (void) +{ + octave_idx_type n = list.length (); + + for (octave_idx_type i = 0; i < n; i++) + { + printf_format_elt *elt = list(i); + delete elt; + } +} + +void +printf_format_list::add_elt_to_list (int args, const std::string& flags, + int fw, int prec, char type, + char modifier, octave_idx_type& num_elts) +{ + if (buf) + { + std::string text = buf->str (); + + if (! text.empty ()) + { + printf_format_elt *elt + = new printf_format_elt (text.c_str (), args, fw, prec, flags, + type, modifier); + + if (num_elts == list.length ()) + list.resize (dim_vector (2 * num_elts, 1)); + + list(num_elts++) = elt; + } + + delete buf; + buf = 0; + } +} + +void +printf_format_list::process_conversion + (const std::string& s, size_t& i, size_t n, int& args, std::string& flags, + int& fw, int& prec, char& modifier, char& type, octave_idx_type& num_elts) +{ + args = 0; + flags = ""; + fw = 0; + prec = 0; + modifier = '\0'; + type = '\0'; + + *buf << s[i++]; + + bool nxt = false; + + while (i < n) + { + switch (s[i]) + { + case '-': case '+': case ' ': case '0': case '#': + flags += s[i]; + *buf << s[i++]; + break; + + default: + nxt = true; + break; + } + + if (nxt) + break; + } + + if (i < n) + { + if (s[i] == '*') + { + fw = -1; + args++; + *buf << s[i++]; + } + else + { + if (isdigit (s[i])) + { + int nn = 0; + std::string tmp = s.substr (i); + sscanf (tmp.c_str (), "%d%n", &fw, &nn); + } + + while (i < n && isdigit (s[i])) + *buf << s[i++]; + } + } + + if (i < n && s[i] == '.') + { + *buf << s[i++]; + + if (i < n) + { + if (s[i] == '*') + { + prec = -1; + args++; + *buf << s[i++]; + } + else + { + if (isdigit (s[i])) + { + int nn = 0; + std::string tmp = s.substr (i); + sscanf (tmp.c_str (), "%d%n", &prec, &nn); + } + + while (i < n && isdigit (s[i])) + *buf << s[i++]; + } + } + } + + if (i < n) + { + switch (s[i]) + { + case 'h': case 'l': case 'L': + modifier = s[i]; + *buf << s[i++]; + break; + + default: + break; + } + } + + if (i < n) + finish_conversion (s, i, args, flags, fw, prec, modifier, type, num_elts); + else + nconv = -1; +} + +void +printf_format_list::finish_conversion + (const std::string& s, size_t& i, int args, const std::string& flags, + int fw, int prec, char modifier, char& type, octave_idx_type& num_elts) + +{ + switch (s[i]) + { + case 'd': case 'i': case 'o': case 'x': case 'X': + case 'u': case 'c': + if (modifier == 'L') + { + nconv = -1; + break; + } + goto fini; + + case 'f': case 'e': case 'E': case 'g': case 'G': + if (modifier == 'h' || modifier == 'l') + { + nconv = -1; + break; + } + goto fini; + + case 's': case 'p': case '%': + if (modifier != '\0') + { + nconv = -1; + break; + } + goto fini; + + fini: + + type = s[i]; + + *buf << s[i++]; + + if (type != '%' || args != 0) + nconv++; + + if (type != '%') + args++; + + add_elt_to_list (args, flags, fw, prec, type, modifier, num_elts); + + break; + + default: + nconv = -1; + break; + } +} + +void +printf_format_list::printme (void) const +{ + int n = list.length (); + + for (int i = 0; i < n; i++) + { + printf_format_elt *elt = list(i); + + std::cerr + << "args: " << elt->args << "\n" + << "flags: '" << elt->flags << "'\n" + << "width: " << elt->fw << "\n" + << "prec: " << elt->prec << "\n" + << "type: '" << elt->type << "'\n" + << "modifier: '" << elt->modifier << "'\n" + << "text: '" << undo_string_escapes (elt->text) << "'\n\n"; + } +} + +void +octave_base_stream::error (const std::string& msg) +{ + fail = true; + errmsg = msg; +} + +void +octave_base_stream::error (const std::string& who, const std::string& msg) +{ + fail = true; + errmsg = who + ": " + msg; +} + +void +octave_base_stream::clear (void) +{ + fail = false; + errmsg = ""; +} + +void +octave_base_stream::clearerr (void) +{ + std::istream *is = input_stream (); + std::ostream *os = output_stream (); + + if (is) + is->clear (); + + if (os) + os->clear (); +} + +// Functions that are defined for all input streams (input streams +// are those that define is). + +std::string +octave_base_stream::do_gets (octave_idx_type max_len, bool& err, + bool strip_newline, const std::string& who) +{ + std::string retval; + + if ((interactive || forced_interactive) && file_number () == 0) + { + ::error ("%s: unable to read from stdin while running interactively", + who.c_str ()); + + return retval; + } + + err = false; + + std::istream *isp = input_stream (); + + if (isp) + { + std::istream& is = *isp; + + std::ostringstream buf; + + int c = 0; + int char_count = 0; + + if (max_len != 0) + { + while (is && (c = is.get ()) != EOF) + { + char_count++; + + // Handle CRLF, CR, or LF as line ending. + + if (c == '\r') + { + if (! strip_newline) + buf << static_cast (c); + + c = is.get (); + + if (c != EOF) + { + if (c == '\n') + { + char_count++; + + if (! strip_newline) + buf << static_cast (c); + } + else + is.putback (c); + } + + break; + } + else if (c == '\n') + { + if (! strip_newline) + buf << static_cast (c); + + break; + } + else + buf << static_cast (c); + + if (max_len > 0 && char_count == max_len) + break; + } + } + + if (! is.eof () && char_count > 0) + { + // GAGME. Matlab seems to check for EOF even if the last + // character in a file is a newline character. This is NOT + // what the corresponding C-library functions do. + int disgusting_compatibility_hack = is.get (); + if (! is.eof ()) + is.putback (disgusting_compatibility_hack); + } + + if (is.good () || (is.eof () && char_count > 0)) + retval = buf.str (); + else + { + err = true; + + if (is.eof () && char_count == 0) + error (who, "at end of file"); + else + error (who, "read error"); + } + } + else + { + err = true; + invalid_operation (who, "reading"); + } + + return retval; +} + +std::string +octave_base_stream::getl (octave_idx_type max_len, bool& err, const std::string& who) +{ + return do_gets (max_len, err, true, who); +} + +std::string +octave_base_stream::gets (octave_idx_type max_len, bool& err, const std::string& who) +{ + return do_gets (max_len, err, false, who); +} + +off_t +octave_base_stream::skipl (off_t num, bool& err, const std::string& who) +{ + off_t cnt = -1; + + if ((interactive || forced_interactive) && file_number () == 0) + { + ::error ("%s: unable to read from stdin while running interactively", + who.c_str ()); + + return count; + } + + err = false; + + std::istream *isp = input_stream (); + + if (isp) + { + std::istream& is = *isp; + + int c = 0, lastc = -1; + cnt = 0; + + while (is && (c = is.get ()) != EOF) + { + // Handle CRLF, CR, or LF as line ending. + + if (c == '\r' || (c == '\n' && lastc != '\r')) + { + if (++cnt == num) + break; + } + + lastc = c; + } + + // Maybe eat the following \n if \r was just met. + if (c == '\r' && is.peek () == '\n') + is.get (); + + if (is.bad ()) + { + err = true; + error (who, "read error"); + } + + if (err) + cnt = -1; + } + else + { + err = true; + invalid_operation (who, "reading"); + } + + return cnt; +} + +#define OCTAVE_SCAN(is, fmt, arg) octave_scan (is, fmt, arg) + +template +std::istream& +octave_scan_1 (std::istream& is, const scanf_format_elt& fmt, T* valptr) +{ + T& ref = *valptr; + + switch (fmt.type) + { + case 'o': + is >> std::oct >> ref >> std::dec; + break; + + case 'x': + is >> std::hex >> ref >> std::dec; + break; + + case 'i': + { + int c1 = EOF; + + while (is && (c1 = is.get ()) != EOF && isspace (c1)) + /* skip whitespace */; + + if (c1 != EOF) + { + if (c1 == '0') + { + int c2 = is.peek (); + + if (c2 == 'x' || c2 == 'X') + { + is.ignore (); + if (std::isxdigit (is.peek ())) + is >> std::hex >> ref >> std::dec; + else + ref = 0; + } + else + { + if (c2 == '0' || c2 == '1' || c2 == '2' + || c2 == '3' || c2 == '4' || c2 == '5' + || c2 == '6' || c2 == '7') + is >> std::oct >> ref >> std::dec; + else + ref = 0; + } + } + else + { + is.putback (c1); + + is >> ref; + } + } + } + break; + + default: + is >> ref; + break; + } + + return is; +} + +template +std::istream& +octave_scan (std::istream& is, const scanf_format_elt& fmt, T* valptr) +{ + if (fmt.width) + { + // Limit input to fmt.width characters by reading into a + // temporary stringstream buffer. + + std::string tmp; + + is.width (fmt.width); + is >> tmp; + + std::istringstream ss (tmp); + + octave_scan_1 (ss, fmt, valptr); + } + else + octave_scan_1 (is, fmt, valptr); + + return is; +} + +// Note that this specialization is only used for reading characters, not +// character strings. See BEGIN_S_CONVERSION for details. + +template<> +std::istream& +octave_scan<> (std::istream& is, const scanf_format_elt& /* fmt */, + char* valptr) +{ + return is >> valptr; +} + +template std::istream& +octave_scan (std::istream&, const scanf_format_elt&, int*); + +template std::istream& +octave_scan (std::istream&, const scanf_format_elt&, long int*); + +template std::istream& +octave_scan (std::istream&, const scanf_format_elt&, short int*); + +template std::istream& +octave_scan (std::istream&, const scanf_format_elt&, unsigned int*); + +template std::istream& +octave_scan (std::istream&, const scanf_format_elt&, unsigned long int*); + +template std::istream& +octave_scan (std::istream&, const scanf_format_elt&, unsigned short int*); + +#if 0 +template std::istream& +octave_scan (std::istream&, const scanf_format_elt&, float*); +#endif + +template<> +std::istream& +octave_scan<> (std::istream& is, const scanf_format_elt& fmt, double* valptr) +{ + double& ref = *valptr; + + switch (fmt.type) + { + case 'e': + case 'f': + case 'g': + { + int c1 = EOF; + + while (is && (c1 = is.get ()) != EOF && isspace (c1)) + /* skip whitespace */; + + if (c1 != EOF) + { + is.putback (c1); + + ref = octave_read_value (is); + } + } + break; + + default: + panic_impossible (); + break; + } + + return is; +} + +template +void +do_scanf_conv (std::istream& is, const scanf_format_elt& fmt, + T valptr, Matrix& mval, double *data, octave_idx_type& idx, + octave_idx_type& conversion_count, octave_idx_type nr, octave_idx_type max_size, + bool discard) +{ + OCTAVE_SCAN (is, fmt, valptr); + + if (is) + { + if (idx == max_size && ! discard) + { + max_size *= 2; + + if (nr > 0) + mval.resize (nr, max_size / nr, 0.0); + else + mval.resize (max_size, 1, 0.0); + + data = mval.fortran_vec (); + } + + if (! discard) + { + conversion_count++; + data[idx++] = *(valptr); + } + } +} + +template void +do_scanf_conv (std::istream&, const scanf_format_elt&, int*, + Matrix&, double*, octave_idx_type&, octave_idx_type&, octave_idx_type, octave_idx_type, bool); + +template void +do_scanf_conv (std::istream&, const scanf_format_elt&, long int*, + Matrix&, double*, octave_idx_type&, octave_idx_type&, octave_idx_type, octave_idx_type, bool); + +template void +do_scanf_conv (std::istream&, const scanf_format_elt&, short int*, + Matrix&, double*, octave_idx_type&, octave_idx_type&, octave_idx_type, octave_idx_type, bool); + +template void +do_scanf_conv (std::istream&, const scanf_format_elt&, unsigned int*, + Matrix&, double*, octave_idx_type&, octave_idx_type&, octave_idx_type, octave_idx_type, bool); + +template void +do_scanf_conv (std::istream&, const scanf_format_elt&, unsigned long int*, + Matrix&, double*, octave_idx_type&, octave_idx_type&, octave_idx_type, octave_idx_type, bool); + +template void +do_scanf_conv (std::istream&, const scanf_format_elt&, unsigned short int*, + Matrix&, double*, octave_idx_type&, octave_idx_type&, octave_idx_type, octave_idx_type, bool); + +#if 0 +template void +do_scanf_conv (std::istream&, const scanf_format_elt&, float*, + Matrix&, double*, octave_idx_type&, octave_idx_type&, octave_idx_type, octave_idx_type, bool); +#endif + +template void +do_scanf_conv (std::istream&, const scanf_format_elt&, double*, + Matrix&, double*, octave_idx_type&, octave_idx_type&, octave_idx_type, octave_idx_type, bool); + +#define DO_WHITESPACE_CONVERSION() \ + do \ + { \ + int c = EOF; \ + \ + while (is && (c = is.get ()) != EOF && isspace (c)) \ + /* skip whitespace */; \ + \ + if (c != EOF) \ + is.putback (c); \ + } \ + while (0) + +#define DO_LITERAL_CONVERSION() \ + do \ + { \ + int c = EOF; \ + \ + int n = strlen (fmt); \ + int i = 0; \ + \ + while (i < n && is && (c = is.get ()) != EOF) \ + { \ + if (c == static_cast (fmt[i])) \ + { \ + i++; \ + continue; \ + } \ + else \ + { \ + is.putback (c); \ + break; \ + } \ + } \ + \ + if (i != n) \ + is.setstate (std::ios::failbit); \ + } \ + while (0) + +#define DO_PCT_CONVERSION() \ + do \ + { \ + int c = is.get (); \ + \ + if (c != EOF) \ + { \ + if (c != '%') \ + { \ + is.putback (c); \ + is.setstate (std::ios::failbit); \ + } \ + } \ + else \ + is.setstate (std::ios::failbit); \ + } \ + while (0) + +#define BEGIN_C_CONVERSION() \ + is.unsetf (std::ios::skipws); \ + \ + int width = elt->width ? elt->width : 1; \ + \ + std::string tmp (width, '\0'); \ + \ + int c = EOF; \ + int n = 0; \ + \ + while (is && n < width && (c = is.get ()) != EOF) \ + tmp[n++] = static_cast (c); \ + \ + if (n > 0 && c == EOF) \ + is.clear (); \ + \ + tmp.resize (n) + +// For a '%s' format, skip initial whitespace and then read until the +// next whitespace character or until WIDTH characters have been read. +#define BEGIN_S_CONVERSION() \ + int width = elt->width; \ + \ + std::string tmp; \ + \ + do \ + { \ + if (width) \ + { \ + tmp = std::string (width, '\0'); \ + \ + int c = EOF; \ + \ + int n = 0; \ + \ + while (is && (c = is.get ()) != EOF) \ + { \ + if (! isspace (c)) \ + { \ + tmp[n++] = static_cast (c); \ + break; \ + } \ + } \ + \ + while (is && n < width && (c = is.get ()) != EOF) \ + { \ + if (isspace (c)) \ + { \ + is.putback (c); \ + break; \ + } \ + else \ + tmp[n++] = static_cast (c); \ + } \ + \ + if (n > 0 && c == EOF) \ + is.clear (); \ + \ + tmp.resize (n); \ + } \ + else \ + { \ + is >> std::ws >> tmp; \ + } \ + } \ + while (0) + +// This format must match a nonempty sequence of characters. +#define BEGIN_CHAR_CLASS_CONVERSION() \ + int width = elt->width; \ + \ + std::string tmp; \ + \ + do \ + { \ + if (! width) \ + width = std::numeric_limits::max (); \ + \ + std::ostringstream buf; \ + \ + std::string char_class = elt->char_class; \ + \ + int c = EOF; \ + \ + if (elt->type == '[') \ + { \ + int chars_read = 0; \ + while (is && chars_read++ < width && (c = is.get ()) != EOF \ + && char_class.find (c) != std::string::npos) \ + buf << static_cast (c); \ + } \ + else \ + { \ + int chars_read = 0; \ + while (is && chars_read++ < width && (c = is.get ()) != EOF \ + && char_class.find (c) == std::string::npos) \ + buf << static_cast (c); \ + } \ + \ + if (width == std::numeric_limits::max () && c != EOF) \ + is.putback (c); \ + \ + tmp = buf.str (); \ + \ + if (tmp.empty ()) \ + is.setstate (std::ios::failbit); \ + else if (c == EOF) \ + is.clear (); \ + \ + } \ + while (0) + +#define FINISH_CHARACTER_CONVERSION() \ + do \ + { \ + width = tmp.length (); \ + \ + if (is) \ + { \ + int i = 0; \ + \ + if (! discard) \ + { \ + conversion_count++; \ + \ + while (i < width) \ + { \ + if (data_index == max_size) \ + { \ + max_size *= 2; \ + \ + if (all_char_conv) \ + { \ + if (one_elt_size_spec) \ + mval.resize (1, max_size, 0.0); \ + else if (nr > 0) \ + mval.resize (nr, max_size / nr, 0.0); \ + else \ + panic_impossible (); \ + } \ + else if (nr > 0) \ + mval.resize (nr, max_size / nr, 0.0); \ + else \ + mval.resize (max_size, 1, 0.0); \ + \ + data = mval.fortran_vec (); \ + } \ + \ + data[data_index++] = tmp[i++]; \ + } \ + } \ + } \ + } \ + while (0) + +octave_value +octave_base_stream::do_scanf (scanf_format_list& fmt_list, + octave_idx_type nr, octave_idx_type nc, bool one_elt_size_spec, + octave_idx_type& conversion_count, const std::string& who) +{ + octave_value retval = Matrix (); + + if ((interactive || forced_interactive) && file_number () == 0) + { + ::error ("%s: unable to read from stdin while running interactively", + who.c_str ()); + + return retval; + } + + conversion_count = 0; + + octave_idx_type nconv = fmt_list.num_conversions (); + + octave_idx_type data_index = 0; + + if (nr == 0 || nc == 0) + { + if (one_elt_size_spec) + nc = 0; + + return Matrix (nr, nc, 0.0); + } + + std::istream *isp = input_stream (); + + bool all_char_conv = fmt_list.all_character_conversions (); + + Matrix mval; + double *data = 0; + octave_idx_type max_size = 0; + octave_idx_type max_conv = 0; + + octave_idx_type final_nr = 0; + octave_idx_type final_nc = 0; + + if (all_char_conv) + { + // Any of these could be resized later (if we have %s + // conversions, we may read more than one element for each + // conversion). + + if (one_elt_size_spec) + { + max_size = 512; + mval.resize (1, max_size, 0.0); + + if (nr > 0) + max_conv = nr; + } + else if (nr > 0) + { + if (nc > 0) + { + mval.resize (nr, nc, 0.0); + max_size = max_conv = nr * nc; + } + else + { + mval.resize (nr, 32, 0.0); + max_size = nr * 32; + } + } + else + panic_impossible (); + } + else if (nr > 0) + { + if (nc > 0) + { + // Will not resize later. + mval.resize (nr, nc, 0.0); + max_size = nr * nc; + max_conv = max_size; + } + else + { + // Maybe resize later. + mval.resize (nr, 32, 0.0); + max_size = nr * 32; + } + } + else + { + // Maybe resize later. + mval.resize (32, 1, 0.0); + max_size = 32; + } + + data = mval.fortran_vec (); + + if (isp) + { + std::istream& is = *isp; + + const scanf_format_elt *elt = fmt_list.first (); + + std::ios::fmtflags flags = is.flags (); + + octave_idx_type trips = 0; + + octave_idx_type num_fmt_elts = fmt_list.length (); + + for (;;) + { + octave_quit (); + + if (elt) + { + if (! (elt->type == scanf_format_elt::whitespace_conversion + || elt->type == scanf_format_elt::literal_conversion + || elt->type == '%') + && max_conv > 0 && conversion_count == max_conv) + { + if (all_char_conv && one_elt_size_spec) + { + final_nr = 1; + final_nc = data_index; + } + else + { + final_nr = nr; + final_nc = (data_index - 1) / nr + 1; + } + + break; + } + else if (data_index == max_size) + { + max_size *= 2; + + if (all_char_conv) + { + if (one_elt_size_spec) + mval.resize (1, max_size, 0.0); + else if (nr > 0) + mval.resize (nr, max_size / nr, 0.0); + else + panic_impossible (); + } + else if (nr > 0) + mval.resize (nr, max_size / nr, 0.0); + else + mval.resize (max_size, 1, 0.0); + + data = mval.fortran_vec (); + } + + const char *fmt = elt->text; + + bool discard = elt->discard; + + switch (elt->type) + { + case scanf_format_elt::whitespace_conversion: + DO_WHITESPACE_CONVERSION (); + break; + + case scanf_format_elt::literal_conversion: + DO_LITERAL_CONVERSION (); + break; + + case '%': + DO_PCT_CONVERSION (); + break; + + case 'd': case 'i': + { + switch (elt->modifier) + { + case 'h': + { + short int tmp; + do_scanf_conv (is, *elt, &tmp, mval, data, + data_index, conversion_count, + nr, max_size, discard); + } + break; + + case 'l': + { + long int tmp; + do_scanf_conv (is, *elt, &tmp, mval, data, + data_index, conversion_count, + nr, max_size, discard); + } + break; + + default: + { + int tmp; + do_scanf_conv (is, *elt, &tmp, mval, data, + data_index, conversion_count, + nr, max_size, discard); + } + break; + } + } + break; + + case 'o': case 'u': case 'x': + { + switch (elt->modifier) + { + case 'h': + { + unsigned short int tmp; + do_scanf_conv (is, *elt, &tmp, mval, data, + data_index, conversion_count, + nr, max_size, discard); + } + break; + + case 'l': + { + unsigned long int tmp; + do_scanf_conv (is, *elt, &tmp, mval, data, + data_index, conversion_count, + nr, max_size, discard); + } + break; + + default: + { + unsigned int tmp; + do_scanf_conv (is, *elt, &tmp, mval, data, + data_index, conversion_count, + nr, max_size, discard); + } + break; + } + } + break; + + case 'e': case 'f': case 'g': + { + double tmp; + + do_scanf_conv (is, *elt, &tmp, mval, data, + data_index, conversion_count, + nr, max_size, discard); + } + break; + + case 'c': + { + BEGIN_C_CONVERSION (); + + FINISH_CHARACTER_CONVERSION (); + + is.setf (flags); + } + break; + + case 's': + { + BEGIN_S_CONVERSION (); + + FINISH_CHARACTER_CONVERSION (); + } + break; + + case '[': case '^': + { + BEGIN_CHAR_CLASS_CONVERSION (); + + FINISH_CHARACTER_CONVERSION (); + } + break; + + case 'p': + error ("%s: unsupported format specifier", who.c_str ()); + break; + + default: + error ("%s: internal format error", who.c_str ()); + break; + } + + if (! ok ()) + { + break; + } + else if (! is) + { + if (all_char_conv) + { + if (one_elt_size_spec) + { + final_nr = 1; + final_nc = data_index; + } + else if (data_index > nr) + { + final_nr = nr; + final_nc = (data_index - 1) / nr + 1; + } + else + { + final_nr = data_index; + final_nc = 1; + } + } + else if (nr > 0) + { + if (data_index > nr) + { + final_nr = nr; + final_nc = (data_index - 1) / nr + 1; + } + else + { + final_nr = data_index; + final_nc = 1; + } + } + else + { + final_nr = data_index; + final_nc = 1; + } + + // If it looks like we have a matching failure, then + // reset the failbit in the stream state. + + if (is.rdstate () & std::ios::failbit) + is.clear (is.rdstate () & (~std::ios::failbit)); + + // FIXME -- is this the right thing to do? + + if (interactive && name () == "stdin") + { + is.clear (); + + // Skip to end of line. + + bool err; + do_gets (-1, err, false, who); + } + + break; + } + } + else + { + error ("%s: internal format error", who.c_str ()); + break; + } + + if (nconv == 0 && ++trips == num_fmt_elts) + { + if (all_char_conv && one_elt_size_spec) + { + final_nr = 1; + final_nc = data_index; + } + else + { + final_nr = nr; + final_nc = (data_index - 1) / nr + 1; + } + + break; + } + else + elt = fmt_list.next (nconv > 0); + } + } + + if (ok ()) + { + mval.resize (final_nr, final_nc, 0.0); + + retval = mval; + + if (all_char_conv) + retval = retval.convert_to_str (false, true); + } + + return retval; +} + +octave_value +octave_base_stream::scanf (const std::string& fmt, const Array& size, + octave_idx_type& conversion_count, const std::string& who) +{ + octave_value retval = Matrix (); + + conversion_count = 0; + + std::istream *isp = input_stream (); + + if (isp) + { + scanf_format_list fmt_list (fmt); + + if (fmt_list.num_conversions () == -1) + ::error ("%s: invalid format specified", who.c_str ()); + else + { + octave_idx_type nr = -1; + octave_idx_type nc = -1; + + bool one_elt_size_spec; + + get_size (size, nr, nc, one_elt_size_spec, who); + + if (! error_state) + retval = do_scanf (fmt_list, nr, nc, one_elt_size_spec, + conversion_count, who); + } + } + else + invalid_operation (who, "reading"); + + return retval; +} + +bool +octave_base_stream::do_oscanf (const scanf_format_elt *elt, + octave_value& retval, const std::string& who) +{ + bool quit = false; + + std::istream *isp = input_stream (); + + if (isp) + { + std::istream& is = *isp; + + std::ios::fmtflags flags = is.flags (); + + if (elt) + { + const char *fmt = elt->text; + + bool discard = elt->discard; + + switch (elt->type) + { + case scanf_format_elt::whitespace_conversion: + DO_WHITESPACE_CONVERSION (); + break; + + case scanf_format_elt::literal_conversion: + DO_LITERAL_CONVERSION (); + break; + + case '%': + { + DO_PCT_CONVERSION (); + + if (! is) + quit = true; + + } + break; + + case 'd': case 'i': + { + int tmp; + + if (OCTAVE_SCAN (is, *elt, &tmp)) + { + if (! discard) + retval = tmp; + } + else + quit = true; + } + break; + + case 'o': case 'u': case 'x': + { + long int tmp; + + if (OCTAVE_SCAN (is, *elt, &tmp)) + { + if (! discard) + retval = tmp; + } + else + quit = true; + } + break; + + case 'e': case 'f': case 'g': + { + double tmp; + + if (OCTAVE_SCAN (is, *elt, &tmp)) + { + if (! discard) + retval = tmp; + } + else + quit = true; + } + break; + + case 'c': + { + BEGIN_C_CONVERSION (); + + if (! discard) + retval = tmp; + + if (! is) + quit = true; + + is.setf (flags); + } + break; + + case 's': + { + BEGIN_S_CONVERSION (); + + if (! discard) + retval = tmp; + + if (! is) + quit = true; + } + break; + + case '[': case '^': + { + BEGIN_CHAR_CLASS_CONVERSION (); + + if (! discard) + retval = tmp; + + if (! is) + quit = true; + } + break; + + case 'p': + error ("%s: unsupported format specifier", who.c_str ()); + break; + + default: + error ("%s: internal format error", who.c_str ()); + break; + } + } + + if (ok () && is.fail ()) + { + error ("%s: read error", who.c_str ()); + + // FIXME -- is this the right thing to do? + + if (interactive && name () == "stdin") + { + // Skip to end of line. + + bool err; + do_gets (-1, err, false, who); + } + } + } + + return quit; +} + +octave_value_list +octave_base_stream::oscanf (const std::string& fmt, const std::string& who) +{ + octave_value_list retval; + + std::istream *isp = input_stream (); + + if (isp) + { + std::istream& is = *isp; + + scanf_format_list fmt_list (fmt); + + octave_idx_type nconv = fmt_list.num_conversions (); + + if (nconv == -1) + ::error ("%s: invalid format specified", who.c_str ()); + else + { + is.clear (); + + octave_idx_type len = fmt_list.length (); + + retval.resize (nconv+2, Matrix ()); + + const scanf_format_elt *elt = fmt_list.first (); + + int num_values = 0; + + bool quit = false; + + for (octave_idx_type i = 0; i < len; i++) + { + octave_value tmp; + + quit = do_oscanf (elt, tmp, who); + + if (quit) + break; + else + { + if (tmp.is_defined ()) + retval(num_values++) = tmp; + + if (! ok ()) + break; + + elt = fmt_list.next (nconv > 0); + } + } + + retval(nconv) = num_values; + + int err_num; + retval(nconv+1) = error (false, err_num); + + if (! quit) + { + // Pick up any trailing stuff. + if (ok () && len > nconv) + { + octave_value tmp; + + elt = fmt_list.next (); + + do_oscanf (elt, tmp, who); + } + } + } + } + else + invalid_operation (who, "reading"); + + return retval; +} + +// Functions that are defined for all output streams (output streams +// are those that define os). + +int +octave_base_stream::flush (void) +{ + int retval = -1; + + std::ostream *os = output_stream (); + + if (os) + { + os->flush (); + + if (os->good ()) + retval = 0; + } + else + invalid_operation ("fflush", "writing"); + + return retval; +} + +class +printf_value_cache +{ +public: + + enum state { ok, conversion_error }; + + printf_value_cache (const octave_value_list& args, const std::string& who) + : values (args), val_idx (0), elt_idx (0), + n_vals (values.length ()), n_elts (0), data (0), + curr_state (ok) + { + for (octave_idx_type i = 0; i < values.length (); i++) + { + octave_value val = values(i); + + if (val.is_map () || val.is_cell () || val.is_object ()) + { + gripe_wrong_type_arg (who, val); + break; + } + } + } + + ~printf_value_cache (void) { } + + // Get the current value as a double and advance the internal pointer. + double double_value (void); + + // Get the current value as an int and advance the internal pointer. + int int_value (void); + + // Get the current value as a string and advance the internal pointer. + std::string string_value (void); + + operator bool () const { return (curr_state == ok); } + + bool exhausted (void) { return (val_idx >= n_vals); } + +private: + + const octave_value_list values; + int val_idx; + int elt_idx; + int n_vals; + int n_elts; + const double *data; + NDArray curr_val; + state curr_state; + + // Must create value cache with values! + + printf_value_cache (void); + + // No copying! + + printf_value_cache (const printf_value_cache&); + + printf_value_cache& operator = (const printf_value_cache&); +}; + +double +printf_value_cache::double_value (void) +{ + double retval = 0.0; + + if (exhausted ()) + curr_state = conversion_error; + + while (! exhausted ()) + { + if (! data) + { + octave_value tmp_val = values (val_idx); + + // Force string conversion here for compatibility. + + curr_val = tmp_val.array_value (true); + + if (! error_state) + { + elt_idx = 0; + n_elts = curr_val.length (); + data = curr_val.data (); + } + else + { + curr_state = conversion_error; + break; + } + } + + if (elt_idx < n_elts) + { + retval = data[elt_idx++]; + + if (elt_idx >= n_elts) + { + elt_idx = 0; + val_idx++; + data = 0; + } + + break; + } + else + { + val_idx++; + data = 0; + + if (n_elts == 0 && exhausted ()) + curr_state = conversion_error; + + continue; + } + } + + return retval; +} + +int +printf_value_cache::int_value (void) +{ + int retval = 0; + + double dval = double_value (); + + if (! error_state) + { + if (D_NINT (dval) == dval) + retval = NINT (dval); + else + curr_state = conversion_error; + } + + return retval; +} + +std::string +printf_value_cache::string_value (void) +{ + std::string retval; + + if (exhausted ()) + curr_state = conversion_error; + else + { + octave_value tval = values (val_idx++); + + if (tval.rows () == 1) + retval = tval.string_value (); + else + { + // In the name of Matlab compatibility. + + charMatrix chm = tval.char_matrix_value (); + + octave_idx_type nr = chm.rows (); + octave_idx_type nc = chm.columns (); + + int k = 0; + + retval.resize (nr * nc, '\0'); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + retval[k++] = chm(i,j); + } + + if (error_state) + curr_state = conversion_error; + } + + return retval; +} + +// Ugh again and again. + +template +int +do_printf_conv (std::ostream& os, const char *fmt, int nsa, int sa_1, + int sa_2, T arg, const std::string& who) +{ + int retval = 0; + + switch (nsa) + { + case 2: + retval = octave_format (os, fmt, sa_1, sa_2, arg); + break; + + case 1: + retval = octave_format (os, fmt, sa_1, arg); + break; + + case 0: + retval = octave_format (os, fmt, arg); + break; + + default: + ::error ("%s: internal error handling format", who.c_str ()); + break; + } + + return retval; +} + +template int +do_printf_conv (std::ostream&, const char*, int, int, int, int, + const std::string&); + +template int +do_printf_conv (std::ostream&, const char*, int, int, int, long, + const std::string&); + +template int +do_printf_conv (std::ostream&, const char*, int, int, int, unsigned int, + const std::string&); + +template int +do_printf_conv (std::ostream&, const char*, int, int, int, unsigned long, + const std::string&); + +template int +do_printf_conv (std::ostream&, const char*, int, int, int, double, + const std::string&); + +template int +do_printf_conv (std::ostream&, const char*, int, int, int, const char*, + const std::string&); + +#define DO_DOUBLE_CONV(TQUAL) \ + do \ + { \ + if (val > std::numeric_limits::max () \ + || val < std::numeric_limits::min ()) \ + { \ + std::string tfmt = fmt; \ + \ + tfmt.replace (tfmt.rfind (elt->type), 1, ".f"); \ + \ + if (elt->modifier == 'l') \ + tfmt.replace (tfmt.rfind (elt->modifier), 1, ""); \ + \ + retval += do_printf_conv (os, tfmt.c_str (), nsa, sa_1, sa_2, \ + val, who); \ + } \ + else \ + retval += do_printf_conv (os, fmt, nsa, sa_1, sa_2, \ + static_cast (val), who); \ + } \ + while (0) + +int +octave_base_stream::do_printf (printf_format_list& fmt_list, + const octave_value_list& args, + const std::string& who) +{ + int retval = 0; + + octave_idx_type nconv = fmt_list.num_conversions (); + + std::ostream *osp = output_stream (); + + if (osp) + { + std::ostream& os = *osp; + + const printf_format_elt *elt = fmt_list.first (); + + printf_value_cache val_cache (args, who); + + if (error_state) + return retval; + + for (;;) + { + octave_quit (); + + if (elt) + { + // NSA is the number of 'star' args to convert. + + int nsa = (elt->fw < 0) + (elt->prec < 0); + + int sa_1 = 0; + int sa_2 = 0; + + if (nsa > 0) + { + sa_1 = val_cache.int_value (); + + if (! val_cache) + break; + else + { + if (nsa > 1) + { + sa_2 = val_cache.int_value (); + + if (! val_cache) + break; + } + } + } + + const char *fmt = elt->text; + + if (elt->type == '%') + { + os << "%"; + retval++; + } + else if (elt->args == 0 && elt->text) + { + os << elt->text; + retval += strlen (elt->text); + } + else if (elt->type == 's') + { + std::string val = val_cache.string_value (); + + if (val_cache) + retval += do_printf_conv (os, fmt, nsa, sa_1, + sa_2, val.c_str (), who); + else + break; + } + else + { + double val = val_cache.double_value (); + + if (val_cache) + { + if (lo_ieee_isnan (val) || xisinf (val)) + { + std::string tfmt = fmt; + std::string::size_type i1, i2; + + tfmt.replace ((i1 = tfmt.rfind (elt->type)), + 1, 1, 's'); + + if ((i2 = tfmt.rfind ('.')) != std::string::npos && i2 < i1) + { + tfmt.erase (i2, i1-i2); + if (elt->prec < 0) + nsa--; + } + + const char *tval = xisinf (val) + ? (val < 0 ? "-Inf" : "Inf") + : (lo_ieee_is_NA (val) ? "NA" : "NaN"); + + retval += do_printf_conv (os, tfmt.c_str (), + nsa, sa_1, sa_2, + tval, who); + } + else + { + char type = elt->type; + + switch (type) + { + case 'd': case 'i': case 'c': + DO_DOUBLE_CONV (OCTAVE_EMPTY_CPP_ARG); + break; + + case 'o': case 'x': case 'X': case 'u': + DO_DOUBLE_CONV (unsigned); + break; + + case 'f': case 'e': case 'E': + case 'g': case 'G': + retval + += do_printf_conv (os, fmt, nsa, sa_1, sa_2, + val, who); + break; + + default: + error ("%s: invalid format specifier", + who.c_str ()); + return -1; + break; + } + } + } + else + break; + } + + if (! os) + { + error ("%s: write error", who.c_str ()); + break; + } + } + else + { + ::error ("%s: internal error handling format", who.c_str ()); + retval = -1; + break; + } + + elt = fmt_list.next (nconv > 0 && ! val_cache.exhausted ()); + + if (! elt || (val_cache.exhausted () && elt->args > 0)) + break; + } + } + else + invalid_operation (who, "writing"); + + return retval; +} + +int +octave_base_stream::printf (const std::string& fmt, + const octave_value_list& args, + const std::string& who) +{ + int retval = 0; + + printf_format_list fmt_list (fmt); + + if (fmt_list.num_conversions () == -1) + ::error ("%s: invalid format specified", who.c_str ()); + else + retval = do_printf (fmt_list, args, who); + + return retval; +} + +int +octave_base_stream::puts (const std::string& s, const std::string& who) +{ + int retval = -1; + + std::ostream *osp = output_stream (); + + if (osp) + { + std::ostream& os = *osp; + + os << s; + + if (os) + { + // FIXME -- why does this seem to be necessary? + // Without it, output from a loop like + // + // for i = 1:100, fputs (stdout, "foo\n"); endfor + // + // doesn't seem to go to the pager immediately. + + os.flush (); + + if (os) + retval = 0; + else + error ("%s: write error", who.c_str ()); + } + else + error ("%s: write error", who.c_str ()); + } + else + invalid_operation (who, "writing"); + + return retval; +} + +// Return current error message for this stream. + +std::string +octave_base_stream::error (bool clear_err, int& err_num) +{ + err_num = fail ? -1 : 0; + + std::string tmp = errmsg; + + if (clear_err) + clear (); + + return tmp; +} + +void +octave_base_stream::invalid_operation (const std::string& who, const char *rw) +{ + // Note that this is not ::error () ! + + error (who, std::string ("stream not open for ") + rw); +} + +octave_stream::octave_stream (octave_base_stream *bs) + : rep (bs) +{ + if (rep) + rep->count = 1; +} + +octave_stream::~octave_stream (void) +{ + if (rep && --rep->count == 0) + delete rep; +} + +octave_stream::octave_stream (const octave_stream& s) + : rep (s.rep) +{ + if (rep) + rep->count++; +} + +octave_stream& +octave_stream::operator = (const octave_stream& s) +{ + if (rep != s.rep) + { + if (rep && --rep->count == 0) + delete rep; + + rep = s.rep; + + if (rep) + rep->count++; + } + + return *this; +} + +int +octave_stream::flush (void) +{ + int retval = -1; + + if (stream_ok ()) + retval = rep->flush (); + + return retval; +} + +std::string +octave_stream::getl (octave_idx_type max_len, bool& err, const std::string& who) +{ + std::string retval; + + if (stream_ok ()) + retval = rep->getl (max_len, err, who); + + return retval; +} + +std::string +octave_stream::getl (const octave_value& tc_max_len, bool& err, + const std::string& who) +{ + std::string retval; + + err = false; + + int conv_err = 0; + + int max_len = -1; + + if (tc_max_len.is_defined ()) + { + max_len = convert_to_valid_int (tc_max_len, conv_err); + + if (conv_err || max_len < 0) + { + err = true; + ::error ("%s: invalid maximum length specified", who.c_str ()); + } + } + + if (! error_state) + retval = getl (max_len, err, who); + + return retval; +} + +std::string +octave_stream::gets (octave_idx_type max_len, bool& err, const std::string& who) +{ + std::string retval; + + if (stream_ok ()) + retval = rep->gets (max_len, err, who); + + return retval; +} + +std::string +octave_stream::gets (const octave_value& tc_max_len, bool& err, + const std::string& who) +{ + std::string retval; + + err = false; + + int conv_err = 0; + + int max_len = -1; + + if (tc_max_len.is_defined ()) + { + max_len = convert_to_valid_int (tc_max_len, conv_err); + + if (conv_err || max_len < 0) + { + err = true; + ::error ("%s: invalid maximum length specified", who.c_str ()); + } + } + + if (! error_state) + retval = gets (max_len, err, who); + + return retval; +} + +off_t +octave_stream::skipl (off_t count, bool& err, const std::string& who) +{ + off_t retval = -1; + + if (stream_ok ()) + retval = rep->skipl (count, err, who); + + return retval; +} + +off_t +octave_stream::skipl (const octave_value& tc_count, bool& err, const std::string& who) +{ + off_t retval = -1; + + err = false; + + int conv_err = 0; + + int count = 1; + + if (tc_count.is_defined ()) + { + if (tc_count.is_scalar_type () && xisinf (tc_count.scalar_value ())) + count = -1; + else + { + count = convert_to_valid_int (tc_count, conv_err); + + if (conv_err || count < 0) + { + err = true; + ::error ("%s: invalid number of lines specified", who.c_str ()); + } + } + } + + if (! error_state) + retval = skipl (count, err, who); + + return retval; +} + +int +octave_stream::seek (off_t offset, int origin) +{ + int status = -1; + + if (stream_ok ()) + { + clearerr (); + + // Find current position so we can return to it if needed. + + off_t orig_pos = rep->tell (); + + // Move to end of file. If successful, find the offset of the end. + + status = rep->seek (0, SEEK_END); + + if (status == 0) + { + off_t eof_pos = rep->tell (); + + if (origin == SEEK_CUR) + { + // Move back to original position, otherwise we will be + // seeking from the end of file which is probably not the + // original location. + + rep->seek (orig_pos, SEEK_SET); + } + + // Attempt to move to desired position; may be outside bounds + // of existing file. + + status = rep->seek (offset, origin); + + if (status == 0) + { + // Where are we after moving to desired position? + + off_t desired_pos = rep->tell (); + + // I don't think save_pos can be less than zero, but we'll + // check anyway... + + if (desired_pos > eof_pos || desired_pos < 0) + { + // Seek outside bounds of file. Failure should leave + // position unchanged. + + rep->seek (orig_pos, SEEK_SET); + + status = -1; + } + } + else + { + // Seeking to the desired position failed. Move back to + // original position and return failure status. + + rep->seek (orig_pos, SEEK_SET); + + status = -1; + } + } + } + + return status; +} + +int +octave_stream::seek (const octave_value& tc_offset, + const octave_value& tc_origin) +{ + int retval = -1; + + // FIXME -- should we have octave_value methods that handle off_t + // explicitly? + octave_int64 val = tc_offset.int64_scalar_value (); + off_t xoffset = val.value (); + + if (! error_state) + { + int conv_err = 0; + + int origin = SEEK_SET; + + if (tc_origin.is_string ()) + { + std::string xorigin = tc_origin.string_value (); + + if (xorigin == "bof") + origin = SEEK_SET; + else if (xorigin == "cof") + origin = SEEK_CUR; + else if (xorigin == "eof") + origin = SEEK_END; + else + conv_err = -1; + } + else + { + int xorigin = convert_to_valid_int (tc_origin, conv_err); + + if (! conv_err) + { + if (xorigin == -1) + origin = SEEK_SET; + else if (xorigin == 0) + origin = SEEK_CUR; + else if (xorigin == 1) + origin = SEEK_END; + else + conv_err = -1; + } + } + + if (! conv_err) + { + retval = seek (xoffset, origin); + + if (retval != 0) + error ("fseek: failed to seek to requested position"); + } + else + error ("fseek: invalid value for origin"); + } + else + error ("fseek: invalid value for offset"); + + return retval; +} + +off_t +octave_stream::tell (void) +{ + off_t retval = -1; + + if (stream_ok ()) + retval = rep->tell (); + + return retval; +} + +int +octave_stream::rewind (void) +{ + return seek (0, SEEK_SET); +} + +bool +octave_stream::is_open (void) const +{ + bool retval = false; + + if (stream_ok ()) + retval = rep->is_open (); + + return retval; +} + +void +octave_stream::close (void) +{ + if (stream_ok ()) + rep->close (); +} + +template +octave_value +do_read (octave_stream& strm, octave_idx_type nr, octave_idx_type nc, octave_idx_type block_size, + octave_idx_type skip, bool do_float_fmt_conv, bool do_NA_conv, + oct_mach_info::float_format from_flt_fmt, octave_idx_type& count) +{ + octave_value retval; + + RET_T nda; + + count = 0; + + typedef typename RET_T::element_type ELMT; + ELMT elt_zero = ELMT (); + + ELMT *dat = 0; + + octave_idx_type max_size = 0; + + octave_idx_type final_nr = 0; + octave_idx_type final_nc = 1; + + if (nr > 0) + { + if (nc > 0) + { + nda.resize (dim_vector (nr, nc), elt_zero); + dat = nda.fortran_vec (); + max_size = nr * nc; + } + else + { + nda.resize (dim_vector (nr, 32), elt_zero); + dat = nda.fortran_vec (); + max_size = nr * 32; + } + } + else + { + nda.resize (dim_vector (32, 1), elt_zero); + dat = nda.fortran_vec (); + max_size = 32; + } + + // FIXME -- byte order for Cray? + + bool swap = false; + + if (oct_mach_info::words_big_endian ()) + swap = (from_flt_fmt == oct_mach_info::flt_fmt_ieee_little_endian + || from_flt_fmt == oct_mach_info::flt_fmt_vax_g + || from_flt_fmt == oct_mach_info::flt_fmt_vax_g); + else + swap = (from_flt_fmt == oct_mach_info::flt_fmt_ieee_big_endian); + + union + { + char buf[sizeof (typename strip_template_param::type)]; + typename strip_template_param::type val; + } u; + + std::istream *isp = strm.input_stream (); + + if (isp) + { + std::istream& is = *isp; + + octave_idx_type elts_read = 0; + + for (;;) + { + // FIXME -- maybe there should be a special case for + // skip == 0. + + if (is) + { + if (nr > 0 && nc > 0 && count == max_size) + { + final_nr = nr; + final_nc = nc; + + break; + } + + is.read (u.buf, sizeof (typename strip_template_param::type)); + + // We only swap bytes for integer types. For float + // types, the format conversion will also handle byte + // swapping. + + if (swap) + swap_bytes::type)> (u.buf); + else if (do_float_fmt_conv) + do_float_format_conversion + (u.buf, + sizeof (typename strip_template_param::type), + 1, from_flt_fmt, oct_mach_info::float_format ()); + + typename RET_T::element_type tmp + = static_cast (u.val); + + if (is) + { + if (count == max_size) + { + max_size *= 2; + + if (nr > 0) + nda.resize (dim_vector (nr, max_size / nr), + elt_zero); + else + nda.resize (dim_vector (max_size, 1), elt_zero); + + dat = nda.fortran_vec (); + } + + if (do_NA_conv && __lo_ieee_is_old_NA (tmp)) + tmp = __lo_ieee_replace_old_NA (tmp); + + dat[count++] = tmp; + + elts_read++; + } + + int seek_status = 0; + + if (skip != 0 && elts_read == block_size) + { + seek_status = strm.seek (skip, SEEK_CUR); + elts_read = 0; + } + + if (is.eof () || seek_status < 0) + { + if (nr > 0) + { + if (count > nr) + { + final_nr = nr; + final_nc = (count - 1) / nr + 1; + } + else + { + final_nr = count; + final_nc = 1; + } + } + else + { + final_nr = count; + final_nc = 1; + } + + break; + } + } + else if (is.eof ()) + break; + } + } + + nda.resize (dim_vector (final_nr, final_nc), elt_zero); + + retval = nda; + + return retval; +} + +#define DO_READ_VAL_TEMPLATE(RET_T, READ_T) \ + template octave_value \ + do_read (octave_stream&, octave_idx_type, octave_idx_type, octave_idx_type, octave_idx_type, bool, bool, \ + oct_mach_info::float_format, octave_idx_type&) + +// FIXME -- should we only have float if it is a different +// size from double? + +#define INSTANTIATE_DO_READ(VAL_T) \ + DO_READ_VAL_TEMPLATE (VAL_T, octave_int8); \ + DO_READ_VAL_TEMPLATE (VAL_T, octave_uint8); \ + DO_READ_VAL_TEMPLATE (VAL_T, octave_int16); \ + DO_READ_VAL_TEMPLATE (VAL_T, octave_uint16); \ + DO_READ_VAL_TEMPLATE (VAL_T, octave_int32); \ + DO_READ_VAL_TEMPLATE (VAL_T, octave_uint32); \ + DO_READ_VAL_TEMPLATE (VAL_T, octave_int64); \ + DO_READ_VAL_TEMPLATE (VAL_T, octave_uint64); \ + DO_READ_VAL_TEMPLATE (VAL_T, float); \ + DO_READ_VAL_TEMPLATE (VAL_T, double); \ + DO_READ_VAL_TEMPLATE (VAL_T, char); \ + DO_READ_VAL_TEMPLATE (VAL_T, signed char); \ + DO_READ_VAL_TEMPLATE (VAL_T, unsigned char) + +INSTANTIATE_DO_READ (int8NDArray); +INSTANTIATE_DO_READ (uint8NDArray); +INSTANTIATE_DO_READ (int16NDArray); +INSTANTIATE_DO_READ (uint16NDArray); +INSTANTIATE_DO_READ (int32NDArray); +INSTANTIATE_DO_READ (uint32NDArray); +INSTANTIATE_DO_READ (int64NDArray); +INSTANTIATE_DO_READ (uint64NDArray); +INSTANTIATE_DO_READ (FloatNDArray); +INSTANTIATE_DO_READ (NDArray); +INSTANTIATE_DO_READ (charNDArray); +INSTANTIATE_DO_READ (boolNDArray); + +typedef octave_value (*read_fptr) (octave_stream&, octave_idx_type, octave_idx_type, octave_idx_type, octave_idx_type, bool, bool, + oct_mach_info::float_format ffmt, octave_idx_type&); + +#define FILL_TABLE_ROW(R, VAL_T) \ + read_fptr_table[R][oct_data_conv::dt_int8] = do_read; \ + read_fptr_table[R][oct_data_conv::dt_uint8] = do_read; \ + read_fptr_table[R][oct_data_conv::dt_int16] = do_read; \ + read_fptr_table[R][oct_data_conv::dt_uint16] = do_read; \ + read_fptr_table[R][oct_data_conv::dt_int32] = do_read; \ + read_fptr_table[R][oct_data_conv::dt_uint32] = do_read; \ + read_fptr_table[R][oct_data_conv::dt_int64] = do_read; \ + read_fptr_table[R][oct_data_conv::dt_uint64] = do_read; \ + read_fptr_table[R][oct_data_conv::dt_single] = do_read; \ + read_fptr_table[R][oct_data_conv::dt_double] = do_read; \ + read_fptr_table[R][oct_data_conv::dt_char] = do_read; \ + read_fptr_table[R][oct_data_conv::dt_schar] = do_read; \ + read_fptr_table[R][oct_data_conv::dt_uchar] = do_read; \ + read_fptr_table[R][oct_data_conv::dt_logical] = do_read + +octave_value +octave_stream::read (const Array& size, octave_idx_type block_size, + oct_data_conv::data_type input_type, + oct_data_conv::data_type output_type, + octave_idx_type skip, oct_mach_info::float_format ffmt, + octave_idx_type& char_count) +{ + static bool initialized = false; + + // Table function pointers for return types x read types. + + static read_fptr read_fptr_table[oct_data_conv::dt_unknown][14]; + + if (! initialized) + { + for (int i = 0; i < oct_data_conv::dt_unknown; i++) + for (int j = 0; j < 14; j++) + read_fptr_table[i][j] = 0; + + FILL_TABLE_ROW (oct_data_conv::dt_int8, int8NDArray); + FILL_TABLE_ROW (oct_data_conv::dt_uint8, uint8NDArray); + FILL_TABLE_ROW (oct_data_conv::dt_int16, int16NDArray); + FILL_TABLE_ROW (oct_data_conv::dt_uint16, uint16NDArray); + FILL_TABLE_ROW (oct_data_conv::dt_int32, int32NDArray); + FILL_TABLE_ROW (oct_data_conv::dt_uint32, uint32NDArray); + FILL_TABLE_ROW (oct_data_conv::dt_int64, int64NDArray); + FILL_TABLE_ROW (oct_data_conv::dt_uint64, uint64NDArray); + FILL_TABLE_ROW (oct_data_conv::dt_single, FloatNDArray); + FILL_TABLE_ROW (oct_data_conv::dt_double, NDArray); + FILL_TABLE_ROW (oct_data_conv::dt_char, charNDArray); + FILL_TABLE_ROW (oct_data_conv::dt_schar, charNDArray); + FILL_TABLE_ROW (oct_data_conv::dt_uchar, charNDArray); + FILL_TABLE_ROW (oct_data_conv::dt_logical, boolNDArray); + + initialized = true; + } + + octave_value retval; + + if (stream_ok ()) + { + // FIXME -- we may eventually want to make this extensible. + + // FIXME -- we need a better way to ensure that this + // numbering stays consistent with the order of the elements in the + // data_type enum in the oct_data_conv class. + + char_count = 0; + + octave_idx_type nr = -1; + octave_idx_type nc = -1; + + bool ignore; + + get_size (size, nr, nc, ignore, "fread"); + + if (! error_state) + { + if (nr == 0 || nc == 0) + retval = Matrix (nr, nc); + else + { + if (ffmt == oct_mach_info::flt_fmt_unknown) + ffmt = float_format (); + + read_fptr fcn = read_fptr_table[output_type][input_type]; + + bool do_float_fmt_conv = ((input_type == oct_data_conv::dt_double + || input_type == oct_data_conv::dt_single) + && ffmt != float_format ()); + + bool do_NA_conv = (output_type == oct_data_conv::dt_double); + + if (fcn) + { + retval = (*fcn) (*this, nr, nc, block_size, skip, + do_float_fmt_conv, do_NA_conv, + ffmt, char_count); + + // FIXME -- kluge! + + if (! error_state + && (output_type == oct_data_conv::dt_char + || output_type == oct_data_conv::dt_schar + || output_type == oct_data_conv::dt_uchar)) + retval = retval.char_matrix_value (); + } + else + error ("fread: unable to read and convert requested types"); + } + } + else + invalid_operation ("fread", "reading"); + } + + return retval; +} + +octave_idx_type +octave_stream::write (const octave_value& data, octave_idx_type block_size, + oct_data_conv::data_type output_type, octave_idx_type skip, + oct_mach_info::float_format flt_fmt) +{ + octave_idx_type retval = -1; + + if (stream_ok ()) + { + if (! error_state) + { + if (flt_fmt == oct_mach_info::flt_fmt_unknown) + flt_fmt = float_format (); + + octave_idx_type status = data.write (*this, block_size, output_type, + skip, flt_fmt); + + if (status < 0) + error ("fwrite: write error"); + else + retval = status; + } + else + invalid_operation ("fwrite", "writing"); + } + + return retval; +} + +template +void +write_int (std::ostream& os, bool swap, const T& val) +{ + typename T::val_type tmp = val.value (); + + if (swap) + swap_bytes (&tmp); + + os.write (reinterpret_cast (&tmp), + sizeof (typename T::val_type)); +} + +template void write_int (std::ostream&, bool, const octave_int8&); +template void write_int (std::ostream&, bool, const octave_uint8&); +template void write_int (std::ostream&, bool, const octave_int16&); +template void write_int (std::ostream&, bool, const octave_uint16&); +template void write_int (std::ostream&, bool, const octave_int32&); +template void write_int (std::ostream&, bool, const octave_uint32&); +template void write_int (std::ostream&, bool, const octave_int64&); +template void write_int (std::ostream&, bool, const octave_uint64&); + +template +static inline bool +do_write (std::ostream& os, const T& val, oct_data_conv::data_type output_type, + oct_mach_info::float_format flt_fmt, bool swap, + bool do_float_conversion) +{ + bool retval = true; + + // For compatibility, Octave converts to the output type, then + // writes. This means that truncation happens on the conversion. + // For example, the following program prints 0: + // + // x = int8 (-1) + // f = fopen ("foo.dat", "w"); + // fwrite (f, x, "unsigned char"); + // fclose (f); + // f = fopen ("foo.dat", "r"); + // y = fread (f, 1, "unsigned char"); + // printf ("%d\n", y); + + switch (output_type) + { + case oct_data_conv::dt_char: + case oct_data_conv::dt_schar: + case oct_data_conv::dt_int8: + write_int (os, swap, octave_int8 (val)); + break; + + case oct_data_conv::dt_uchar: + case oct_data_conv::dt_uint8: + write_int (os, swap, octave_uint8 (val)); + break; + + case oct_data_conv::dt_int16: + write_int (os, swap, octave_int16 (val)); + break; + + case oct_data_conv::dt_uint16: + write_int (os, swap, octave_uint16 (val)); + break; + + case oct_data_conv::dt_int32: + write_int (os, swap, octave_int32 (val)); + break; + + case oct_data_conv::dt_uint32: + write_int (os, swap, octave_uint32 (val)); + break; + + case oct_data_conv::dt_int64: + write_int (os, swap, octave_int64 (val)); + break; + + case oct_data_conv::dt_uint64: + write_int (os, swap, octave_uint64 (val)); + break; + + case oct_data_conv::dt_single: + { + float f = static_cast (val); + + if (do_float_conversion) + do_float_format_conversion (&f, 1, flt_fmt); + + os.write (reinterpret_cast (&f), sizeof (float)); + } + break; + + case oct_data_conv::dt_double: + { + double d = static_cast (val); + if (do_float_conversion) + do_double_format_conversion (&d, 1, flt_fmt); + + os.write (reinterpret_cast (&d), sizeof (double)); + } + break; + + default: + retval = false; + (*current_liboctave_error_handler) + ("write: invalid type specification"); + break; + } + + return retval; +} + +template bool +do_write (std::ostream&, const octave_int8&, oct_data_conv::data_type, + oct_mach_info::float_format, bool, bool); + +template bool +do_write (std::ostream&, const octave_uint8&, oct_data_conv::data_type, + oct_mach_info::float_format, bool, bool); + +template bool +do_write (std::ostream&, const octave_int16&, oct_data_conv::data_type, + oct_mach_info::float_format, bool, bool); + +template bool +do_write (std::ostream&, const octave_uint16&, oct_data_conv::data_type, + oct_mach_info::float_format, bool, bool); + +template bool +do_write (std::ostream&, const octave_int32&, oct_data_conv::data_type, + oct_mach_info::float_format, bool, bool); + +template bool +do_write (std::ostream&, const octave_uint32&, oct_data_conv::data_type, + oct_mach_info::float_format, bool, bool); + +template bool +do_write (std::ostream&, const octave_int64&, oct_data_conv::data_type, + oct_mach_info::float_format, bool, bool); + +template bool +do_write (std::ostream&, const octave_uint64&, oct_data_conv::data_type, + oct_mach_info::float_format, bool, bool); + +template +octave_idx_type +octave_stream::write (const Array& data, octave_idx_type block_size, + oct_data_conv::data_type output_type, + octave_idx_type skip, oct_mach_info::float_format flt_fmt) +{ + octave_idx_type retval = -1; + + bool status = true; + + octave_idx_type count = 0; + + const T *d = data.data (); + + octave_idx_type n = data.length (); + + oct_mach_info::float_format native_flt_fmt + = oct_mach_info::float_format (); + + bool do_float_conversion = (flt_fmt != native_flt_fmt); + + // FIXME -- byte order for Cray? + + bool swap = false; + + if (oct_mach_info::words_big_endian ()) + swap = (flt_fmt == oct_mach_info::flt_fmt_ieee_little_endian + || flt_fmt == oct_mach_info::flt_fmt_vax_g + || flt_fmt == oct_mach_info::flt_fmt_vax_g); + else + swap = (flt_fmt == oct_mach_info::flt_fmt_ieee_big_endian); + + for (octave_idx_type i = 0; i < n; i++) + { + std::ostream *osp = output_stream (); + + if (osp) + { + std::ostream& os = *osp; + + if (skip != 0 && (i % block_size) == 0) + { + // Seek to skip when inside bounds of existing file. + // Otherwise, write NUL to skip. + + off_t orig_pos = tell (); + + seek (0, SEEK_END); + + off_t eof_pos = tell (); + + // Is it possible for this to fail to return us to the + // original position? + seek (orig_pos, SEEK_SET); + + off_t remaining = eof_pos - orig_pos; + + if (remaining < skip) + { + seek (0, SEEK_END); + + // FIXME -- probably should try to write larger + // blocks... + + unsigned char zero = 0; + for (octave_idx_type j = 0; j < skip - remaining; j++) + os.write (reinterpret_cast (&zero), 1); + } + else + seek (skip, SEEK_CUR); + } + + if (os) + { + status = do_write (os, d[i], output_type, flt_fmt, swap, + do_float_conversion); + + if (os && status) + count++; + else + break; + } + else + { + status = false; + break; + } + } + else + { + status = false; + break; + } + } + + if (status) + retval = count; + + return retval; +} + +template octave_idx_type +octave_stream::write (const Array&, octave_idx_type, + oct_data_conv::data_type, + octave_idx_type, oct_mach_info::float_format); + +template octave_idx_type +octave_stream::write (const Array&, octave_idx_type, + oct_data_conv::data_type, + octave_idx_type, oct_mach_info::float_format); + +template octave_idx_type +octave_stream::write (const Array&, octave_idx_type, + oct_data_conv::data_type, + octave_idx_type, oct_mach_info::float_format); + +template octave_idx_type +octave_stream::write (const Array&, octave_idx_type, + oct_data_conv::data_type, + octave_idx_type, oct_mach_info::float_format); + +template octave_idx_type +octave_stream::write (const Array&, octave_idx_type, + oct_data_conv::data_type, + octave_idx_type, oct_mach_info::float_format); + +template octave_idx_type +octave_stream::write (const Array&, octave_idx_type, + oct_data_conv::data_type, + octave_idx_type, oct_mach_info::float_format); + +template octave_idx_type +octave_stream::write (const Array&, octave_idx_type, + oct_data_conv::data_type, + octave_idx_type, oct_mach_info::float_format); + +template octave_idx_type +octave_stream::write (const Array&, octave_idx_type, + oct_data_conv::data_type, + octave_idx_type, oct_mach_info::float_format); + +template octave_idx_type +octave_stream::write (const Array&, octave_idx_type, + oct_data_conv::data_type, + octave_idx_type, oct_mach_info::float_format); + +template octave_idx_type +octave_stream::write (const Array&, octave_idx_type, + oct_data_conv::data_type, + octave_idx_type, oct_mach_info::float_format); + +template octave_idx_type +octave_stream::write (const Array&, octave_idx_type, + oct_data_conv::data_type, + octave_idx_type, oct_mach_info::float_format); + +template octave_idx_type +octave_stream::write (const Array&, octave_idx_type, + oct_data_conv::data_type, + octave_idx_type, oct_mach_info::float_format); + +octave_value +octave_stream::scanf (const std::string& fmt, const Array& size, + octave_idx_type& count, const std::string& who) +{ + octave_value retval; + + if (stream_ok ()) + retval = rep->scanf (fmt, size, count, who); + + return retval; +} + +octave_value +octave_stream::scanf (const octave_value& fmt, const Array& size, + octave_idx_type& count, const std::string& who) +{ + octave_value retval = Matrix (); + + if (fmt.is_string ()) + { + std::string sfmt = fmt.string_value (); + + if (fmt.is_sq_string ()) + sfmt = do_string_escapes (sfmt); + + retval = scanf (sfmt, size, count, who); + } + else + { + // Note that this is not ::error () ! + + error (who + ": format must be a string"); + } + + return retval; +} + +octave_value_list +octave_stream::oscanf (const std::string& fmt, const std::string& who) +{ + octave_value_list retval; + + if (stream_ok ()) + retval = rep->oscanf (fmt, who); + + return retval; +} + +octave_value_list +octave_stream::oscanf (const octave_value& fmt, const std::string& who) +{ + octave_value_list retval; + + if (fmt.is_string ()) + { + std::string sfmt = fmt.string_value (); + + if (fmt.is_sq_string ()) + sfmt = do_string_escapes (sfmt); + + retval = oscanf (sfmt, who); + } + else + { + // Note that this is not ::error () ! + + error (who + ": format must be a string"); + } + + return retval; +} + +int +octave_stream::printf (const std::string& fmt, const octave_value_list& args, + const std::string& who) +{ + int retval = -1; + + if (stream_ok ()) + retval = rep->printf (fmt, args, who); + + return retval; +} + +int +octave_stream::printf (const octave_value& fmt, const octave_value_list& args, + const std::string& who) +{ + int retval = 0; + + if (fmt.is_string ()) + { + std::string sfmt = fmt.string_value (); + + if (fmt.is_sq_string ()) + sfmt = do_string_escapes (sfmt); + + retval = printf (sfmt, args, who); + } + else + { + // Note that this is not ::error () ! + + error (who + ": format must be a string"); + } + + return retval; +} + +int +octave_stream::puts (const std::string& s, const std::string& who) +{ + int retval = -1; + + if (stream_ok ()) + retval = rep->puts (s, who); + + return retval; +} + +// FIXME -- maybe this should work for string arrays too. + +int +octave_stream::puts (const octave_value& tc_s, const std::string& who) +{ + int retval = -1; + + if (tc_s.is_string ()) + { + std::string s = tc_s.string_value (); + retval = puts (s, who); + } + else + { + // Note that this is not ::error () ! + + error (who + ": argument must be a string"); + } + + return retval; +} + +bool +octave_stream::eof (void) const +{ + int retval = -1; + + if (stream_ok ()) + retval = rep->eof (); + + return retval; +} + +std::string +octave_stream::error (bool clear, int& err_num) +{ + std::string retval = "invalid stream object"; + + if (stream_ok (false)) + retval = rep->error (clear, err_num); + + return retval; +} + +std::string +octave_stream::name (void) const +{ + std::string retval; + + if (stream_ok ()) + retval = rep->name (); + + return retval; +} + +int +octave_stream::mode (void) const +{ + int retval = 0; + + if (stream_ok ()) + retval = rep->mode (); + + return retval; +} + +oct_mach_info::float_format +octave_stream::float_format (void) const +{ + oct_mach_info::float_format retval = oct_mach_info::flt_fmt_unknown; + + if (stream_ok ()) + retval = rep->float_format (); + + return retval; +} + +std::string +octave_stream::mode_as_string (int mode) +{ + std::string retval = "???"; + std::ios::openmode in_mode = static_cast (mode); + + if (in_mode == std::ios::in) + retval = "r"; + else if (in_mode == std::ios::out + || in_mode == (std::ios::out | std::ios::trunc)) + retval = "w"; + else if (in_mode == (std::ios::out | std::ios::app)) + retval = "a"; + else if (in_mode == (std::ios::in | std::ios::out)) + retval = "r+"; + else if (in_mode == (std::ios::in | std::ios::out | std::ios::trunc)) + retval = "w+"; + else if (in_mode == (std::ios::in | std::ios::out | std::ios::ate)) + retval = "a+"; + else if (in_mode == (std::ios::in | std::ios::binary)) + retval = "rb"; + else if (in_mode == (std::ios::out | std::ios::binary) + || in_mode == (std::ios::out | std::ios::trunc | std::ios::binary)) + retval = "wb"; + else if (in_mode == (std::ios::out | std::ios::app | std::ios::binary)) + retval = "ab"; + else if (in_mode == (std::ios::in | std::ios::out | std::ios::binary)) + retval = "r+b"; + else if (in_mode == (std::ios::in | std::ios::out | std::ios::trunc + | std::ios::binary)) + retval = "w+b"; + else if (in_mode == (std::ios::in | std::ios::out | std::ios::ate + | std::ios::binary)) + retval = "a+b"; + + return retval; +} + +octave_stream_list *octave_stream_list::instance = 0; + +bool +octave_stream_list::instance_ok (void) +{ + bool retval = true; + + if (! instance) + { + instance = new octave_stream_list (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } + + if (! instance) + { + ::error ("unable to create stream list object!"); + + retval = false; + } + + return retval; +} + +int +octave_stream_list::insert (octave_stream& os) +{ + return (instance_ok ()) ? instance->do_insert (os) : -1; +} + +octave_stream +octave_stream_list::lookup (int fid, const std::string& who) +{ + return (instance_ok ()) ? instance->do_lookup (fid, who) : octave_stream (); +} + +octave_stream +octave_stream_list::lookup (const octave_value& fid, const std::string& who) +{ + return (instance_ok ()) ? instance->do_lookup (fid, who) : octave_stream (); +} + +int +octave_stream_list::remove (int fid, const std::string& who) +{ + return (instance_ok ()) ? instance->do_remove (fid, who) : -1; +} + +int +octave_stream_list::remove (const octave_value& fid, const std::string& who) +{ + return (instance_ok ()) ? instance->do_remove (fid, who) : -1; +} + +void +octave_stream_list::clear (bool flush) +{ + if (instance) + instance->do_clear (flush); +} + +string_vector +octave_stream_list::get_info (int fid) +{ + return (instance_ok ()) ? instance->do_get_info (fid) : string_vector (); +} + +string_vector +octave_stream_list::get_info (const octave_value& fid) +{ + return (instance_ok ()) ? instance->do_get_info (fid) : string_vector (); +} + +std::string +octave_stream_list::list_open_files (void) +{ + return (instance_ok ()) ? instance->do_list_open_files () : std::string (); +} + +octave_value +octave_stream_list::open_file_numbers (void) +{ + return (instance_ok ()) + ? instance->do_open_file_numbers () : octave_value (); +} + +int +octave_stream_list::get_file_number (const octave_value& fid) +{ + return (instance_ok ()) ? instance->do_get_file_number (fid) : -1; +} + +int +octave_stream_list::do_insert (octave_stream& os) +{ + // Insert item with key corresponding to file-descriptor. + + int stream_number; + + if ((stream_number = os.file_number ()) == -1) + return stream_number; + + // Should we test for "(list.find (stream_number) != list.end ()) && + // list[stream_number].is_open ()" and respond with "error + // ("internal error: ...")"? It should not happen except for some + // bug or if the user has opened a stream with an interpreted + // command, but closed it directly with a system call in an + // oct-file; then the kernel knows the fd is free, but Octave does + // not know. If it happens, it should not do harm here to simply + // overwrite this entry, although the wrong entry might have done + // harm before. + + if (list.size () < list.max_size ()) + list[stream_number] = os; + else + { + stream_number = -1; + error ("could not create file id"); + } + + return stream_number; + +} + +static void +gripe_invalid_file_id (int fid, const std::string& who) +{ + if (who.empty ()) + ::error ("invalid stream number = %d", fid); + else + ::error ("%s: invalid stream number = %d", who.c_str (), fid); +} + +octave_stream +octave_stream_list::do_lookup (int fid, const std::string& who) const +{ + octave_stream retval; + + if (fid >= 0) + { + if (lookup_cache != list.end () && lookup_cache->first == fid) + retval = lookup_cache->second; + else + { + ostrl_map::const_iterator iter = list.find (fid); + + if (iter != list.end ()) + { + retval = iter->second; + lookup_cache = iter; + } + else + gripe_invalid_file_id (fid, who); + } + } + else + gripe_invalid_file_id (fid, who); + + return retval; +} + +octave_stream +octave_stream_list::do_lookup (const octave_value& fid, + const std::string& who) const +{ + octave_stream retval; + + int i = get_file_number (fid); + + if (! error_state) + retval = do_lookup (i, who); + + return retval; +} + +int +octave_stream_list::do_remove (int fid, const std::string& who) +{ + int retval = -1; + + // Can't remove stdin (std::cin), stdout (std::cout), or stderr + // (std::cerr). + + if (fid > 2) + { + ostrl_map::iterator iter = list.find (fid); + + if (iter != list.end ()) + { + octave_stream os = iter->second; + list.erase (iter); + lookup_cache = list.end (); + + // FIXME: is this check redundant? + if (os.is_valid ()) + { + os.close (); + retval = 0; + } + else + gripe_invalid_file_id (fid, who); + } + else + gripe_invalid_file_id (fid, who); + } + else + gripe_invalid_file_id (fid, who); + + return retval; +} + +int +octave_stream_list::do_remove (const octave_value& fid, const std::string& who) +{ + int retval = -1; + + if (fid.is_string () && fid.string_value () == "all") + { + do_clear (false); + + retval = 0; + } + else + { + int i = get_file_number (fid); + + if (! error_state) + retval = do_remove (i, who); + } + + return retval; +} + +void +octave_stream_list::do_clear (bool flush) +{ + if (flush) + { + // Do flush stdout and stderr. + + list[0].flush (); + list[1].flush (); + } + + octave_stream saved_os[3]; + // But don't delete them or stdin. + for (ostrl_map::iterator iter = list.begin (); iter != list.end (); iter++) + { + int fid = iter->first; + octave_stream os = iter->second; + if (fid < 3) + saved_os[fid] = os; + else if (os.is_valid ()) + os.close (); + } + list.clear (); + for (int fid = 0; fid < 3; fid++) list[fid] = saved_os[fid]; + lookup_cache = list.end (); +} + +string_vector +octave_stream_list::do_get_info (int fid) const +{ + string_vector retval; + + octave_stream os = do_lookup (fid); + + if (os.is_valid ()) + { + retval.resize (3); + + retval(2) = oct_mach_info::float_format_as_string (os.float_format ()); + retval(1) = octave_stream::mode_as_string (os.mode ()); + retval(0) = os.name (); + } + else + ::error ("invalid file id = %d", fid); + + return retval; +} + +string_vector +octave_stream_list::do_get_info (const octave_value& fid) const +{ + string_vector retval; + + int conv_err = 0; + + int int_fid = convert_to_valid_int (fid, conv_err); + + if (! conv_err) + retval = do_get_info (int_fid); + else + ::error ("file id must be a file object or integer value"); + + return retval; +} + +std::string +octave_stream_list::do_list_open_files (void) const +{ + std::string retval; + + std::ostringstream buf; + + buf << "\n" + << " number mode arch name\n" + << " ------ ---- ---- ----\n"; + + for (ostrl_map::const_iterator p = list.begin (); p != list.end (); p++) + { + octave_stream os = p->second; + + buf << " " + << std::setiosflags (std::ios::right) + << std::setw (4) << p->first << " " + << std::setiosflags (std::ios::left) + << std::setw (3) + << octave_stream::mode_as_string (os.mode ()) + << " " + << std::setw (9) + << oct_mach_info::float_format_as_string (os.float_format ()) + << " " + << os.name () << "\n"; + } + + buf << "\n"; + + retval = buf.str (); + + return retval; +} + +octave_value +octave_stream_list::do_open_file_numbers (void) const +{ + Matrix retval (1, list.size (), 0.0); + + int num_open = 0; + + for (ostrl_map::const_iterator p = list.begin (); p != list.end (); p++) + { + // Skip stdin, stdout, and stderr. + + if (p->first > 2 && p->second) + retval(0,num_open++) = p->first; + } + + retval.resize ((num_open > 0), num_open); + + return retval; +} + +int +octave_stream_list::do_get_file_number (const octave_value& fid) const +{ + int retval = -1; + + if (fid.is_string ()) + { + std::string nm = fid.string_value (); + + for (ostrl_map::const_iterator p = list.begin (); p != list.end (); p++) + { + // stdin (std::cin), stdout (std::cout), and stderr (std::cerr) + // are unnamed. + + if (p->first > 2) + { + octave_stream os = p->second; + + if (os && os.name () == nm) + { + retval = p->first; + break; + } + } + } + } + else + { + int conv_err = 0; + + int int_fid = convert_to_valid_int (fid, conv_err); + + if (conv_err) + ::error ("file id must be a file object, std::string, or integer value"); + else + retval = int_fid; + } + + return retval; +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/oct-stream.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/oct-stream.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,716 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_octave_stream_h) +#define octave_octave_stream_h 1 + +class Matrix; +class string_vector; +class octave_value; +class octave_value_list; + +#include +#include +#include +#include + +#include "Array.h" +#include "data-conv.h" +#include "lo-utils.h" +#include "mach-info.h" +#include "oct-refcount.h" + +class +OCTINTERP_API +scanf_format_elt +{ +public: + + enum special_conversion + { + whitespace_conversion = 1, + literal_conversion = 2 + }; + + scanf_format_elt (const char *txt = 0, int w = 0, bool d = false, + char typ = '\0', char mod = '\0', + const std::string& ch_class = std::string ()) + : text (strsave (txt)), width (w), discard (d), type (typ), + modifier (mod), char_class (ch_class) { } + + scanf_format_elt (const scanf_format_elt& e) + : text (strsave (e.text)), width (e.width), discard (e.discard), + type (e.type), modifier (e.modifier), char_class (e.char_class) { } + + scanf_format_elt& operator = (const scanf_format_elt& e) + { + if (this != &e) + { + text = strsave (e.text); + width = e.width; + discard = e.discard; + type = e.type; + modifier = e.modifier; + char_class = e.char_class; + } + + return *this; + } + + ~scanf_format_elt (void) { delete [] text; } + + // The C-style format string. + const char *text; + + // The maximum field width. + int width; + + // TRUE if we are not storing the result of this conversion. + bool discard; + + // Type of conversion -- 'd', 'i', 'o', 'u', 'x', 'e', 'f', 'g', + // 'c', 's', 'p', '%', or '['. + char type; + + // A length modifier -- 'h', 'l', or 'L'. + char modifier; + + // The class of characters in a '[' format. + std::string char_class; +}; + +class +OCTINTERP_API +scanf_format_list +{ +public: + + scanf_format_list (const std::string& fmt = std::string ()); + + ~scanf_format_list (void); + + octave_idx_type num_conversions (void) { return nconv; } + + // The length can be different than the number of conversions. + // For example, "x %d y %d z" has 2 conversions but the length of + // the list is 3 because of the characters that appear after the + // last conversion. + + octave_idx_type length (void) { return list.length (); } + + const scanf_format_elt *first (void) + { + curr_idx = 0; + return current (); + } + + const scanf_format_elt *current (void) const + { return list.length () > 0 ? list.elem (curr_idx) : 0; } + + const scanf_format_elt *next (bool cycle = true) + { + curr_idx++; + + if (curr_idx >= list.length ()) + { + if (cycle) + curr_idx = 0; + else + return 0; + } + return current (); + } + + void printme (void) const; + + bool ok (void) const { return (nconv >= 0); } + + operator bool () const { return ok (); } + + bool all_character_conversions (void); + + bool all_numeric_conversions (void); + +private: + + // Number of conversions specified by this format string, or -1 if + // invalid conversions have been found. + octave_idx_type nconv; + + // Index to current element; + octave_idx_type curr_idx; + + // FIXME -- maybe LIST should be a std::list object? + // List of format elements. + Array list; + + // Temporary buffer. + std::ostringstream *buf; + + void add_elt_to_list (int width, bool discard, char type, char modifier, + octave_idx_type& num_elts, + const std::string& char_class = std::string ()); + + void process_conversion (const std::string& s, size_t& i, size_t n, + int& width, bool& discard, char& type, + char& modifier, octave_idx_type& num_elts); + + int finish_conversion (const std::string& s, size_t& i, size_t n, + int& width, bool discard, char& type, + char modifier, octave_idx_type& num_elts); + // No copying! + + scanf_format_list (const scanf_format_list&); + + scanf_format_list& operator = (const scanf_format_list&); +}; + +class +printf_format_elt +{ +public: + + printf_format_elt (const char *txt = 0, int n = 0, int w = 0, + int p = 0, const std::string& f = std::string (), + char typ = '\0', char mod = '\0') + : text (strsave (txt)), args (n), fw (w), prec (p), flags (f), + type (typ), modifier (mod) { } + + printf_format_elt (const printf_format_elt& e) + : text (strsave (e.text)), args (e.args), fw (e.fw), prec (e.prec), + flags (e.flags), type (e.type), modifier (e.modifier) { } + + printf_format_elt& operator = (const printf_format_elt& e) + { + if (this != &e) + { + text = strsave (e.text); + args = e.args; + fw = e.fw; + prec = e.prec; + flags = e.flags; + type = e.type; + modifier = e.modifier; + } + + return *this; + } + + ~printf_format_elt (void) { delete [] text; } + + // The C-style format string. + const char *text; + + // How many args do we expect to consume? + int args; + + // Field width. + int fw; + + // Precision. + int prec; + + // Flags -- '-', '+', ' ', '0', or '#'. + std::string flags; + + // Type of conversion -- 'd', 'i', 'o', 'x', 'X', 'u', 'c', 's', + // 'f', 'e', 'E', 'g', 'G', 'p', or '%' + char type; + + // A length modifier -- 'h', 'l', or 'L'. + char modifier; +}; + +class +OCTINTERP_API +printf_format_list +{ +public: + + printf_format_list (const std::string& fmt = std::string ()); + + ~printf_format_list (void); + + octave_idx_type num_conversions (void) { return nconv; } + + const printf_format_elt *first (void) + { + curr_idx = 0; + return current (); + } + + const printf_format_elt *current (void) const + { return list.length () > 0 ? list.elem (curr_idx) : 0; } + + const printf_format_elt *next (bool cycle = true) + { + curr_idx++; + + if (curr_idx >= list.length ()) + { + if (cycle) + curr_idx = 0; + else + return 0; + } + + return current (); + } + + bool last_elt_p (void) { return (curr_idx + 1 == list.length ()); } + + void printme (void) const; + + bool ok (void) const { return (nconv >= 0); } + + operator bool () const { return ok (); } + +private: + + // Number of conversions specified by this format string, or -1 if + // invalid conversions have been found. + octave_idx_type nconv; + + // Index to current element; + octave_idx_type curr_idx; + + // FIXME -- maybe LIST should be a std::list object? + // List of format elements. + Array list; + + // Temporary buffer. + std::ostringstream *buf; + + void add_elt_to_list (int args, const std::string& flags, int fw, + int prec, char type, char modifier, + octave_idx_type& num_elts); + + void process_conversion (const std::string& s, size_t& i, size_t n, + int& args, std::string& flags, int& fw, + int& prec, char& modifier, char& type, + octave_idx_type& num_elts); + + void finish_conversion (const std::string& s, size_t& i, int args, + const std::string& flags, int fw, int prec, + char modifier, char& type, + octave_idx_type& num_elts); + + // No copying! + + printf_format_list (const printf_format_list&); + + printf_format_list& operator = (const printf_format_list&); +}; + +// Provide an interface for Octave streams. + +class +OCTINTERP_API +octave_base_stream +{ +friend class octave_stream; + +public: + + octave_base_stream (std::ios::openmode arg_md = std::ios::in|std::ios::out, + oct_mach_info::float_format ff + = oct_mach_info::native_float_format ()) + : count (0), md (arg_md), flt_fmt (ff), fail (false), open_state (true), + errmsg () + { } + + virtual ~octave_base_stream (void) { } + + // The remaining functions are not specific to input or output only, + // and must be provided by the derived classes. + + // Position a stream at OFFSET relative to ORIGIN. + + virtual int seek (off_t offset, int origin) = 0; + + // Return current stream position. + + virtual off_t tell (void) = 0; + + // Return TRUE if EOF has been reached on this stream. + + virtual bool eof (void) const = 0; + + // The name of the file. + + virtual std::string name (void) const = 0; + + // If the derived class provides this function and it returns a + // pointer to a valid istream, scanf(), read(), getl(), and gets() + // will automatically work for this stream. + + virtual std::istream *input_stream (void) { return 0; } + + // If the derived class provides this function and it returns a + // pointer to a valid ostream, flush(), write(), and printf() will + // automatically work for this stream. + + virtual std::ostream *output_stream (void) { return 0; } + + // Return TRUE if this stream is open. + + bool is_open (void) const { return open_state; } + + virtual void do_close (void) { } + + void close (void) + { + if (is_open ()) + { + open_state = false; + do_close (); + } + } + + virtual int file_number (void) const + { + // Kluge alert! + + if (name () == "stdin") + return 0; + else if (name () == "stdout") + return 1; + else if (name () == "stderr") + return 2; + else + return -1; + } + + bool ok (void) const { return ! fail; } + + // Return current error message for this stream. + + std::string error (bool clear, int& err_num); + +protected: + + int mode (void) const { return md; } + + oct_mach_info::float_format float_format (void) const { return flt_fmt; } + + // Set current error state and set fail to TRUE. + + void error (const std::string& msg); + void error (const std::string& who, const std::string& msg); + + // Clear any error message and set fail to FALSE. + + void clear (void); + + // Clear stream state. + + void clearerr (void); + +private: + + // A reference count. + octave_refcount count; + + // The permission bits for the file. Should be some combination of + // std::ios::open_mode bits. + int md; + + // Data format. + oct_mach_info::float_format flt_fmt; + + // TRUE if an error has occurred. + bool fail; + + // TRUE if this stream is open. + bool open_state; + + // Should contain error message if fail is TRUE. + std::string errmsg; + + // Functions that are defined for all input streams (input streams + // are those that define is). + + std::string do_gets (octave_idx_type max_len, bool& err, bool strip_newline, + const std::string& who /* = "gets" */); + + std::string getl (octave_idx_type max_len, bool& err, const std::string& who /* = "getl" */); + std::string gets (octave_idx_type max_len, bool& err, const std::string& who /* = "gets" */); + off_t skipl (off_t count, bool& err, const std::string& who /* = "skipl" */); + + octave_value do_scanf (scanf_format_list& fmt_list, octave_idx_type nr, octave_idx_type nc, + bool one_elt_size_spec, octave_idx_type& count, + const std::string& who /* = "scanf" */); + + octave_value scanf (const std::string& fmt, const Array& size, + octave_idx_type& count, const std::string& who /* = "scanf" */); + + bool do_oscanf (const scanf_format_elt *elt, octave_value&, + const std::string& who /* = "scanf" */); + + octave_value_list oscanf (const std::string& fmt, + const std::string& who /* = "scanf" */); + + // Functions that are defined for all output streams (output streams + // are those that define os). + + int flush (void); + + int do_printf (printf_format_list& fmt_list, const octave_value_list& args, + const std::string& who /* = "printf" */); + + int printf (const std::string& fmt, const octave_value_list& args, + const std::string& who /* = "printf" */); + + int puts (const std::string& s, const std::string& who /* = "puts" */); + + // We can always do this in terms of seek(), so the derived class + // only has to provide that. + + void invalid_operation (const std::string& who, const char *rw); + + // No copying! + + octave_base_stream (const octave_base_stream&); + + octave_base_stream& operator = (const octave_base_stream&); +}; + +class +OCTINTERP_API +octave_stream +{ +public: + + octave_stream (octave_base_stream *bs = 0); + + ~octave_stream (void); + + octave_stream (const octave_stream&); + + octave_stream& operator = (const octave_stream&); + + int flush (void); + + std::string getl (octave_idx_type max_len, bool& err, const std::string& who /* = "getl" */); + std::string getl (const octave_value& max_len, bool& err, + const std::string& who /* = "getl" */); + + std::string gets (octave_idx_type max_len, bool& err, const std::string& who /* = "gets" */); + std::string gets (const octave_value& max_len, bool& err, + const std::string& who /* = "gets" */); + + off_t skipl (off_t count, bool& err, const std::string& who /* = "skipl" */); + off_t skipl (const octave_value& count, bool& err, const std::string& who /* = "skipl" */); + + int seek (off_t offset, int origin); + int seek (const octave_value& offset, const octave_value& origin); + + off_t tell (void); + + int rewind (void); + + bool is_open (void) const; + + void close (void); + + octave_value read (const Array& size, octave_idx_type block_size, + oct_data_conv::data_type input_type, + oct_data_conv::data_type output_type, + octave_idx_type skip, oct_mach_info::float_format flt_fmt, + octave_idx_type& count); + + octave_idx_type write (const octave_value& data, octave_idx_type block_size, + oct_data_conv::data_type output_type, + octave_idx_type skip, oct_mach_info::float_format flt_fmt); + + template + octave_idx_type write (const Array&, octave_idx_type block_size, + oct_data_conv::data_type output_type, + octave_idx_type skip, oct_mach_info::float_format flt_fmt); + + octave_value scanf (const std::string& fmt, const Array& size, + octave_idx_type& count, const std::string& who /* = "scanf" */); + + octave_value scanf (const octave_value& fmt, const Array& size, + octave_idx_type& count, const std::string& who /* = "scanf" */); + + octave_value_list oscanf (const std::string& fmt, + const std::string& who /* = "scanf" */); + + octave_value_list oscanf (const octave_value& fmt, + const std::string& who /* = "scanf" */); + + int printf (const std::string& fmt, const octave_value_list& args, + const std::string& who /* = "printf" */); + + int printf (const octave_value& fmt, const octave_value_list& args, + const std::string& who /* = "printf" */); + + int puts (const std::string& s, const std::string& who /* = "puts" */); + int puts (const octave_value& s, const std::string& who /* = "puts" */); + + bool eof (void) const; + + std::string error (bool clear, int& err_num); + + std::string error (bool clear = false) + { + int err_num; + return error (clear, err_num); + } + + // Set the error message and state. + + void error (const std::string& msg) + { + if (rep) + rep->error (msg); + } + + void error (const char *msg) { error (std::string (msg)); } + + int file_number (void) { return rep ? rep->file_number () : -1; } + + bool is_valid (void) const { return (rep != 0); } + + bool ok (void) const { return rep && rep->ok (); } + + operator bool () const { return ok (); } + + std::string name (void) const; + + int mode (void) const; + + oct_mach_info::float_format float_format (void) const; + + static std::string mode_as_string (int mode); + + std::istream *input_stream (void) + { + return rep ? rep->input_stream () : 0; + } + + std::ostream *output_stream (void) + { + return rep ? rep->output_stream () : 0; + } + + void clearerr (void) { if (rep) rep->clearerr (); } + +private: + + // The actual representation of this stream. + octave_base_stream *rep; + + bool stream_ok (bool clear = true) const + { + bool retval = true; + + if (rep) + { + if (clear) + rep->clear (); + } + else + retval = false; + + return retval; + } + + void invalid_operation (const std::string& who, const char *rw) + { + if (rep) + rep->invalid_operation (who, rw); + } +}; + +class +OCTINTERP_API +octave_stream_list +{ +protected: + + octave_stream_list (void) : list (), lookup_cache (list.end ()) { } + +public: + + ~octave_stream_list (void) { } + + static bool instance_ok (void); + + static int insert (octave_stream& os); + + static octave_stream + lookup (int fid, const std::string& who = std::string ()); + + static octave_stream + lookup (const octave_value& fid, const std::string& who = std::string ()); + + static int remove (int fid, const std::string& who = std::string ()); + static int remove (const octave_value& fid, + const std::string& who = std::string ()); + + static void clear (bool flush = true); + + static string_vector get_info (int fid); + static string_vector get_info (const octave_value& fid); + + static std::string list_open_files (void); + + static octave_value open_file_numbers (void); + + static int get_file_number (const octave_value& fid); + +private: + + typedef std::map ostrl_map; + + ostrl_map list; + + mutable ostrl_map::const_iterator lookup_cache; + + static octave_stream_list *instance; + + static void cleanup_instance (void) { delete instance; instance = 0; } + + int do_insert (octave_stream& os); + + octave_stream do_lookup (int fid, const std::string& who = std::string ()) const; + octave_stream do_lookup (const octave_value& fid, + const std::string& who = std::string ()) const; + + int do_remove (int fid, const std::string& who = std::string ()); + int do_remove (const octave_value& fid, const std::string& who = std::string ()); + + void do_clear (bool flush = true); + + string_vector do_get_info (int fid) const; + string_vector do_get_info (const octave_value& fid) const; + + std::string do_list_open_files (void) const; + + octave_value do_open_file_numbers (void) const; + + int do_get_file_number (const octave_value& fid) const; +}; + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/oct-strstrm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/oct-strstrm.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,66 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "oct-strstrm.h" + +// Position a stream at OFFSET relative to ORIGIN. + +int +octave_base_strstream::seek (off_t, int) +{ + error ("fseek: invalid operation"); + return -1; +} + +// Return current stream position. + +off_t +octave_base_strstream::tell (void) +{ + error ("ftell: invalid operation"); + return -1; +} + +octave_stream +octave_istrstream::create (const char *data, std::ios::openmode arg_md, + oct_mach_info::float_format flt_fmt) +{ + return octave_stream (new octave_istrstream (data, arg_md, flt_fmt)); +} + +octave_stream +octave_istrstream::create (const std::string& data, std::ios::openmode arg_md, + oct_mach_info::float_format flt_fmt) +{ + return octave_stream (new octave_istrstream (data, arg_md, flt_fmt)); +} + +octave_stream +octave_ostrstream::create (std::ios::openmode arg_md, + oct_mach_info::float_format flt_fmt) +{ + return octave_stream (new octave_ostrstream (arg_md, flt_fmt)); +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/oct-strstrm.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/oct-strstrm.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,176 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_octave_strstream_h) +#define octave_octave_strstream_h 1 + +#include +#include + +#include "oct-stream.h" + +class +octave_base_strstream : public octave_base_stream +{ +public: + + octave_base_strstream (std::ios::openmode m = std::ios::out, + oct_mach_info::float_format ff + = oct_mach_info::native_float_format ()) + : octave_base_stream (m, ff) { } + + // Position a stream at OFFSET relative to ORIGIN. + + int seek (off_t, int); + + // Return current stream position. + + virtual off_t tell (void); + + // The name of the file. + + std::string name (void) const { return std::string (); } + + virtual std::streambuf *rdbuf (void) = 0; + + virtual bool bad (void) const = 0; + + virtual void clear (void) = 0; + +protected: + + ~octave_base_strstream (void) { } + +private: + + // No copying! + + octave_base_strstream (const octave_base_strstream&); + + octave_base_strstream& operator = (const octave_base_strstream&); +}; + +class +octave_istrstream : public octave_base_strstream +{ +public: + + octave_istrstream (const char *data, + std::ios::openmode arg_md = std::ios::out, + oct_mach_info::float_format ff + = oct_mach_info::native_float_format ()) + : octave_base_strstream (arg_md, ff), is (data) { } + + octave_istrstream (const std::string& data, + std::ios::openmode arg_md = std::ios::out, + oct_mach_info::float_format ff + = oct_mach_info::native_float_format ()) + : octave_base_strstream (arg_md, ff), is (data.c_str ()) { } + + static octave_stream + create (const char *data, std::ios::openmode arg_md = std::ios::out, + oct_mach_info::float_format ff + = oct_mach_info::native_float_format ()); + + static octave_stream + create (const std::string& data, std::ios::openmode arg_md = std::ios::out, + oct_mach_info::float_format ff + = oct_mach_info::native_float_format ()); + + // Return non-zero if EOF has been reached on this stream. + + bool eof (void) const { return is.eof (); } + + std::istream *input_stream (void) { return &is; } + + std::ostream *output_stream (void) { return 0; } + + off_t tell (void) { return is.tellg (); } + + std::streambuf *rdbuf (void) { return is ? is.rdbuf () : 0; } + + bool bad (void) const { return is.bad (); } + + void clear (void) { is.clear (); } + +protected: + + ~octave_istrstream (void) { } + +private: + + std::istringstream is; + + // No copying! + + octave_istrstream (const octave_istrstream&); + + octave_istrstream& operator = (const octave_istrstream&); +}; + +class +octave_ostrstream : public octave_base_strstream +{ +public: + + octave_ostrstream (std::ios::openmode arg_md = std::ios::out, + oct_mach_info::float_format ff + = oct_mach_info::native_float_format ()) + : octave_base_strstream (arg_md, ff), os () { } + + static octave_stream + create (std::ios::openmode arg_md = std::ios::out, + oct_mach_info::float_format ff + = oct_mach_info::native_float_format ()); + + // Return non-zero if EOF has been reached on this stream. + + bool eof (void) const { return os.eof (); } + + std::istream *input_stream (void) { return 0; } + + std::ostream *output_stream (void) { return &os; } + + std::string str (void) { return os.str (); } + + std::streambuf *rdbuf (void) { return os ? os.rdbuf () : 0; } + + bool bad (void) const { return os.bad (); } + + void clear (void) { os.clear (); } + +protected: + + ~octave_ostrstream (void) { } + +private: + + std::ostringstream os; + + // No copying! + + octave_ostrstream (const octave_ostrstream&); + + octave_ostrstream& operator = (const octave_ostrstream&); +}; + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/oct.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/oct.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,45 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_oct_h) +#define octave_oct_h 1 + +// Things that are often included to create .oct files. + +// config.h needs to be first because it includes #defines that can */ +// affect other header files. + +#include + +#include "Matrix.h" + +#include "oct-locbuf.h" +#include "defun-dld.h" +#include "error.h" +#include "gripes.h" +#include "help.h" +#include "oct-obj.h" +#include "pager.h" +#include "utils.h" +#include "variables.h" + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/octave-link.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/octave-link.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,404 @@ +/* + +Copyright (C) 2013 John W. Eaton +Copyright (C) 2011-2012 Jacob Dawid +Copyright (C) 2011-2012 John P. Swensen + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "cmd-edit.h" +#include "defun.h" +#include "oct-env.h" +#include "oct-mutex.h" +#include "singleton-cleanup.h" +#include "toplev.h" + +#include "octave-link.h" + +static int +octave_readline_hook (void) +{ + octave_link::entered_readline_hook (); + octave_link::generate_events (); + octave_link::process_events (); + octave_link::finished_readline_hook (); + + return 0; +} + +octave_link *octave_link::instance = 0; + +octave_link::octave_link (void) + : event_queue_mutex (new octave_mutex ()), gui_event_queue (), + debugging (false), link_enabled (true) +{ + command_editor::add_event_hook (octave_readline_hook); +} + +void +octave_link::set_workspace (void) +{ + if (enabled ()) + instance->do_set_workspace ((symbol_table::current_scope () + == symbol_table::top_scope ()), + symbol_table::workspace_info ()); +} + +// OBJ should be an object of a class that is derived from the base +// class octave_link, or 0 to disconnect the link. It is the +// responsibility of the caller to delete obj. + +void +octave_link::connect_link (octave_link* obj) +{ + if (obj && instance) + ::error ("octave_link is already linked!"); + else + instance = obj; +} + +void +octave_link::do_generate_events (void) +{ +} + +void +octave_link::do_process_events (void) +{ + event_queue_mutex->lock (); + + gui_event_queue.run (); + + event_queue_mutex->unlock (); +} + +void +octave_link::do_discard_events (void) +{ + event_queue_mutex->lock (); + + gui_event_queue.discard (); + + event_queue_mutex->unlock (); +} + +DEFUN (__octave_link_enabled__, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __octave_link_enabled__ ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + return octave_value (octave_link::enabled ()); +} + +DEFUN (__octave_link_edit_file__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __octave_link_edit_file__ (@var{file})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + { + std::string file = args(0).string_value (); + + if (! error_state) + { + flush_octave_stdout (); + + retval = octave_link::edit_file (file); + } + else + error ("expecting file name as argument"); + } + + return retval; +} + +DEFUN (__octave_link_message_dialog__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __octave_link_message_dialog__ (@var{dlg}, @var{msg}, @var{title})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 3) + { + std::string dlg = args(0).string_value (); + std::string msg = args(1).string_value (); + std::string title = args(2).string_value (); + + if (! error_state) + { + flush_octave_stdout (); + + retval = octave_link::message_dialog (dlg, msg, title); + } + else + error ("invalid arguments"); + } + + return retval; +} + +DEFUN (__octave_link_question_dialog__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __octave_link_question_dialog__ (@var{msg}, @var{title}, @var{btn1}, @var{btn2}, @var{btn3}, @var{default})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 6) + { + std::string msg = args(0).string_value (); + std::string title = args(1).string_value (); + std::string btn1 = args(2).string_value (); + std::string btn2 = args(3).string_value (); + std::string btn3 = args(4).string_value (); + std::string btndef = args(5).string_value (); + + if (! error_state) + { + flush_octave_stdout (); + + retval = octave_link::question_dialog (msg, title, btn1, btn2, btn3, btndef); + } + else + error ("invalid arguments"); + } + + return retval; +} + +DEFUN (__octave_link_file_dialog__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __octave_link_file_dialog__ (@var{filterlist}, @var{title}, @var{filename}, @var{size} @var{multiselect}, @var{pathname})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 6) + { + + const Array flist = args(0).cellstr_value (); + std::string title = args(1).string_value (); + std::string filename = args(2).string_value (); + Matrix pos = args(3).matrix_value (); + std::string multi_on = args(4).string_value (); // on, off, create + std::string pathname = args(5).string_value (); + + octave_idx_type nel = flist.numel (); + octave_link::filter_list filter_lst; + + for (octave_idx_type i = 0; i < flist.rows (); i++) + filter_lst.push_back (std::make_pair (flist(i,0), + (flist.columns () > 1 + ? flist(i,1) : ""))); + + if (! error_state) + { + flush_octave_stdout (); + + std::list items_lst + = octave_link::file_dialog (filter_lst, title, filename, pathname, + multi_on); + + nel = items_lst.size (); + + retval.resize (3); + + // If 3, then is filename, directory and selected index. + if (nel <= 3) + { + int idx = 0; + for (std::list::iterator it = items_lst.begin (); + it != items_lst.end (); it++) + { + retval(idx++) = *it; + + if (idx == 1 && retval(0).string_value ().length () == 0) + retval(0) = 0; + + if (idx == 3) + retval(2) = atoi (retval(2).string_value ().c_str ()); + } + } + else + { + // Multiple files. + nel = items_lst.size (); + Cell items (dim_vector (1, nel)); + + std::list::iterator it = items_lst.begin (); + + for (int idx = 0; idx < items_lst.size ()-2; idx++) + { + items.xelem (idx) = *it; + it++; + } + + retval(0) = items; + retval(1) = *it++; + retval(2) = atoi (it->c_str ()); + } + } + else + error ("invalid arguments"); + } + + return retval; +} + +DEFUN (__octave_link_list_dialog__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __octave_link_list_dialog__ (@var{list}, @var{mode}, @var{size}, @var{intial}, @var{name}, @var{prompt}, @var{ok_string}, @var{cancel_string})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 8) + { + Cell list = args(0).cell_value (); + const Array tlist = list.cellstr_value (); + octave_idx_type nel = tlist.numel (); + std::list list_lst; + for (octave_idx_type i = 0; i < nel; i++) + list_lst.push_back (tlist(i)); + + std::string mode = args(1).string_value (); + + Matrix size_matrix = args(2).matrix_value (); + int width = size_matrix(0); + int height = size_matrix(1); + + Matrix initial_matrix = args(3).matrix_value (); + nel = initial_matrix.numel (); + std::list initial_lst; + for (octave_idx_type i = 0; i < nel; i++) + initial_lst.push_back (initial_matrix(i)); + + std::string name = args(4).string_value (); + list = args(5).cell_value (); + const Array plist = list.cellstr_value (); + nel = plist.numel (); + std::list prompt_lst; + for (octave_idx_type i = 0; i < nel; i++) + prompt_lst.push_back (plist(i)); + std::string ok_string = args(6).string_value (); + std::string cancel_string = args(7).string_value (); + + if (! error_state) + { + flush_octave_stdout (); + + std::pair, int> result + = octave_link::list_dialog (list_lst, mode, width, height, + initial_lst, name, prompt_lst, + ok_string, cancel_string); + + std::list items_lst = result.first; + nel = items_lst.size (); + Matrix items (dim_vector (1, nel)); + octave_idx_type i = 0; + for (std::list::iterator it = items_lst.begin (); + it != items_lst.end (); it++) + { + items.xelem(i++) = *it; + } + + retval(1) = result.second; + retval(0) = items; + } + else + error ("invalid arguments"); + } + + return retval; +} + +DEFUN (__octave_link_input_dialog__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __octave_link_input_dialog__ (@var{prompt}, @var{title}, @var{rowscols}, @var{defaults})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 4) + { + Cell prompt = args(0).cell_value (); + Array tmp = prompt.cellstr_value (); + octave_idx_type nel = tmp.numel (); + std::list prompt_lst; + for (octave_idx_type i = 0; i < nel; i++) + prompt_lst.push_back (tmp(i)); + + std::string title = args(1).string_value (); + + Matrix rc = args(2).matrix_value (); + nel = rc.rows (); + std::list nr; + std::list nc; + for (octave_idx_type i = 0; i < nel; i++) + { + nr.push_back (rc(i,0)); + nc.push_back (rc(i,1)); + } + + Cell defaults = args(3).cell_value (); + tmp = defaults.cellstr_value (); + nel = tmp.numel (); + std::list defaults_lst; + for (octave_idx_type i = 0; i < nel; i++) + defaults_lst.push_back (tmp(i)); + + if (! error_state) + { + flush_octave_stdout (); + + std::list items_lst + = octave_link::input_dialog (prompt_lst, title, nr, nc, + defaults_lst); + + nel = items_lst.size (); + Cell items (dim_vector (1, nel)); + octave_idx_type i = 0; + for (std::list::iterator it = items_lst.begin (); + it != items_lst.end (); it++) + { + items.xelem(i++) = *it; + } + + retval = items; + } + else + error ("invalid arguments"); + } + + return retval; +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/octave-link.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/octave-link.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,430 @@ +/* + +Copyright (C) 2013 John W. Eaton +Copyright (C) 2011-2012 Jacob Dawid +Copyright (C) 2011-2012 John P. Swensen + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_link_h) +#define octave_link_h 1 + +#include + +#include "event-queue.h" + +class octave_mutex; +class string_vector; +class workspace_element; + +// \class OctaveLink +// \brief Provides threadsafe access to octave. +// \author Jacob Dawid +// +// This class is a wrapper around octave and provides thread safety by +// buffering access operations to octave and executing them in the +// readline event hook, which lives in the octave thread. + +class +OCTINTERP_API +octave_link +{ +protected: + + octave_link (void); + +public: + + virtual ~octave_link (void) { } + + static void generate_events (void) + { + if (enabled ()) + instance->do_generate_events (); + } + + // If disable is TRUE, then no additional events will be processed + // other than exit. + + static void process_events (bool disable = false) + { + if (enabled ()) + { + if (disable) + instance->link_enabled = false; + + instance->do_process_events (); + } + } + + static void discard_events (void) + { + if (enabled ()) + instance->do_discard_events (); + } + + static bool exit (int status) + { + bool retval = false; + + if (instance_ok ()) + retval = instance->do_exit (status); + + return retval; + } + + template + static void post_event (T *obj, void (T::*method) (void)) + { + if (enabled ()) + instance->do_post_event (obj, method); + } + + template + static void post_event (T *obj, void (T::*method) (A), A arg) + { + if (enabled ()) + instance->do_post_event (obj, method, arg); + } + + template + static void post_event (T *obj, void (T::*method) (const A&), const A& arg) + { + if (enabled ()) + instance->do_post_event (obj, method, arg); + } + + template + static void post_event (T *obj, void (T::*method) (const A&, const B&), + const A& arg_a, const B& arg_b) + { + if (enabled ()) + instance->do_post_event (obj, method, arg_a, arg_b); + } + + static void entered_readline_hook (void) + { + if (enabled ()) + instance->do_entered_readline_hook (); + } + + static void finished_readline_hook (void) + { + if (enabled ()) + instance->do_finished_readline_hook (); + } + + static bool + edit_file (const std::string& file) + { + return enabled () ? instance->do_edit_file (file) : false; + } + + static int + message_dialog (const std::string& dlg, const std::string& msg, + const std::string& title) + { + return enabled () ? instance->do_message_dialog (dlg, msg, title) : 0; + } + + static std::string + question_dialog (const std::string& msg, const std::string& title, + const std::string& btn1, const std::string& btn2, + const std::string& btn3, const std::string& btndef) + { + return enabled () ? instance->do_question_dialog (msg, title, btn1, + btn2, btn3, btndef) : 0; + } + + static std::pair, int> + list_dialog (const std::list& list, + const std::string& mode, + int width, int height, + const std::list& initial_value, + const std::string& name, + const std::list& prompt, + const std::string& ok_string, + const std::string& cancel_string) + { + return enabled () + ? instance->do_list_dialog (list, mode, width, height, + initial_value, name, prompt, + ok_string, cancel_string) + : std::pair, int> (); + } + + static std::list + input_dialog (const std::list& prompt, + const std::string& title, + const std::list& nr, + const std::list& nc, + const std::list& defaults) + { + return enabled () + ? instance->do_input_dialog (prompt, title, nr, nc, defaults) + : std::list (); + } + + typedef std::list > filter_list; + + static std::list + file_dialog (const filter_list& filter, const std::string& title, + const std::string& filename, const std::string& dirname, + const std::string& multimode) + { + return enabled () + ? instance->do_file_dialog (filter, title, filename, dirname, multimode) + : std::list (); + } + + + static int debug_cd_or_addpath_error (const std::string& file, + const std::string& dir, + bool addpath_option) + { + return enabled () + ? instance->do_debug_cd_or_addpath_error (file, dir, addpath_option) : 0; + } + + static void change_directory (const std::string& dir) + { + if (enabled ()) + instance->do_change_directory (dir); + } + + // Preserves pending input. + static void execute_command_in_terminal (const std::string& command) + { + if (enabled ()) + instance->do_execute_command_in_terminal (command); + } + + static void set_workspace (void); + + static void set_workspace (bool top_level, + const std::list& ws) + { + if (enabled ()) + instance->do_set_workspace (top_level, ws); + } + + static void clear_workspace (void) + { + if (enabled ()) + instance->do_clear_workspace (); + } + + static void set_history (const string_vector& hist) + { + if (enabled ()) + instance->do_set_history (hist); + } + + static void append_history (const std::string& hist_entry) + { + if (enabled ()) + instance->do_append_history (hist_entry); + } + + static void clear_history (void) + { + if (enabled ()) + instance->do_clear_history (); + } + + static void pre_input_event (void) + { + if (enabled ()) + instance->do_pre_input_event (); + } + + static void post_input_event (void) + { + if (enabled ()) + instance->do_post_input_event (); + } + + static void enter_debugger_event (const std::string& file, int line) + { + if (enabled ()) + { + instance->debugging = true; + + instance->do_enter_debugger_event (file, line); + } + } + + static void execute_in_debugger_event (const std::string& file, int line) + { + if (enabled ()) + instance->do_execute_in_debugger_event (file, line); + } + + static void exit_debugger_event (void) + { + if (enabled () && instance->debugging) + { + instance->debugging = false; + + instance->do_exit_debugger_event (); + } + } + + static void + update_breakpoint (bool insert, const std::string& file, int line) + { + if (enabled ()) + instance->do_update_breakpoint (insert, file, line); + } + + static void connect_link (octave_link *); + + static void set_default_prompts (std::string& ps1, std::string& ps2, + std::string& ps4) + { + if (enabled ()) + instance->do_set_default_prompts (ps1, ps2, ps4); + } + + static bool enabled (void) + { + return instance_ok () ? instance->link_enabled : false; + } + +private: + + static octave_link *instance; + + // No copying! + + octave_link (const octave_link&); + + octave_link& operator = (const octave_link&); + + static bool instance_ok (void) { return instance != 0; } + +protected: + + // Semaphore to lock access to the event queue. + octave_mutex *event_queue_mutex; + + // Event Queue. + event_queue gui_event_queue; + + bool debugging; + bool link_enabled; + + void do_generate_events (void); + void do_process_events (void); + void do_discard_events (void); + + template + void do_post_event (T *obj, void (T::*method) (void)) + { + gui_event_queue.add_method (obj, method); + } + + template + void do_post_event (T *obj, void (T::*method) (A), A arg) + { + gui_event_queue.add_method (obj, method, arg); + } + + template + void do_post_event (T *obj, void (T::*method) (const A&), const A& arg) + { + gui_event_queue.add_method (obj, method, arg); + } + + void do_entered_readline_hook (void) { } + void do_finished_readline_hook (void) { } + + virtual bool do_exit (int status) = 0; + + virtual bool do_edit_file (const std::string& file) = 0; + + virtual int + do_message_dialog (const std::string& dlg, const std::string& msg, + const std::string& title) = 0; + + virtual std::string + do_question_dialog (const std::string& msg, const std::string& title, + const std::string& btn1, const std::string& btn2, + const std::string& btn3, const std::string& btndef) = 0; + + virtual std::pair, int> + do_list_dialog (const std::list& list, + const std::string& mode, + int width, int height, + const std::list& initial_value, + const std::string& name, + const std::list& prompt, + const std::string& ok_string, + const std::string& cancel_string) = 0; + + virtual std::list + do_input_dialog (const std::list& prompt, + const std::string& title, + const std::list& nr, + const std::list& nc, + const std::list& defaults) = 0; + + virtual std::list + do_file_dialog (const filter_list& filter, const std::string& title, + const std::string& filename, const std::string& dirname, + const std::string& multimode) = 0; + + virtual int + do_debug_cd_or_addpath_error (const std::string& file, + const std::string& dir, + bool addpath_option) = 0; + + virtual void do_change_directory (const std::string& dir) = 0; + + virtual void do_execute_command_in_terminal (const std::string& command) = 0; + + virtual void + do_set_workspace (bool top_level, + const std::list& ws) = 0; + + virtual void do_clear_workspace (void) = 0; + + virtual void do_set_history (const string_vector& hist) = 0; + virtual void do_append_history (const std::string& hist_entry) = 0; + virtual void do_clear_history (void) = 0; + + virtual void do_pre_input_event (void) = 0; + virtual void do_post_input_event (void) = 0; + + virtual void + do_enter_debugger_event (const std::string& file, int line) = 0; + + virtual void + do_execute_in_debugger_event (const std::string& file, int line) = 0; + + virtual void do_exit_debugger_event (void) = 0; + + virtual void do_update_breakpoint (bool insert, + const std::string& file, int line) = 0; + + virtual void do_set_default_prompts (std::string& ps1, std::string& ps2, + std::string& ps4) = 0; +}; + +#endif // OCTAVELINK_H diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/pager.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/pager.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,715 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include "cmd-edit.h" +#include "oct-env.h" +#include "singleton-cleanup.h" + +#include "defaults.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "input.h" +#include "oct-obj.h" +#include "pager.h" +#include "procstream.h" +#include "sighandlers.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +// Our actual connection to the external pager. +static oprocstream *external_pager = 0; + +// TRUE means we write to the diary file. +static bool write_to_diary_file = false; + +// The name of the current diary file. +static std::string diary_file; + +// The diary file. +static std::ofstream external_diary_file; + +static std::string +default_pager (void) +{ + std::string pager_binary = octave_env::getenv ("PAGER"); + +#ifdef OCTAVE_DEFAULT_PAGER + if (pager_binary.empty ()) + pager_binary = OCTAVE_DEFAULT_PAGER; +#endif + + return pager_binary; +} + +// The shell command to run as the pager. +static std::string VPAGER = default_pager (); + +// The options to pass to the pager. +static std::string VPAGER_FLAGS; + +// TRUE means that if output is going to the pager, it is sent as soon +// as it is available. Otherwise, it is buffered and only sent to the +// pager when it is time to print another prompt. +static bool Vpage_output_immediately = false; + +// TRUE means all output intended for the screen should be passed +// through the pager. +static bool Vpage_screen_output = true; + +static bool really_flush_to_pager = false; + +static bool flushing_output_to_pager = false; + +static void +clear_external_pager (void) +{ + if (external_pager) + { + octave_child_list::remove (external_pager->pid ()); + + delete external_pager; + external_pager = 0; + } +} + +static bool +pager_event_handler (pid_t pid, int status) +{ + bool retval = false; + + if (pid > 0) + { + if (octave_wait::ifexited (status) || octave_wait::ifsignaled (status)) + { + // Avoid warning() since that will put us back in the pager, + // which would be bad news. + + std::cerr << "warning: connection to external pager lost (pid = " + << pid << ")" << std::endl; + std::cerr << "warning: flushing pending output (please wait)" + << std::endl; + + // Request removal of this PID from the list of child + // processes. + + retval = true; + } + } + + return retval; +} + +static std::string +pager_command (void) +{ + std::string cmd = VPAGER; + + if (! (cmd.empty () || VPAGER_FLAGS.empty ())) + cmd += " " + VPAGER_FLAGS; + + return cmd; +} + +static void +do_sync (const char *msg, int len, bool bypass_pager) +{ + if (msg && len > 0) + { + if (bypass_pager) + { + std::cout.write (msg, len); + std::cout.flush (); + } + else + { + if (! external_pager) + { + std::string pgr = pager_command (); + + if (! pgr.empty ()) + { + external_pager = new oprocstream (pgr.c_str ()); + + if (external_pager) + octave_child_list::insert (external_pager->pid (), + pager_event_handler); + } + } + + if (external_pager) + { + if (external_pager->good ()) + { + external_pager->write (msg, len); + + external_pager->flush (); + +#if defined (EPIPE) + if (errno == EPIPE) + external_pager->setstate (std::ios::failbit); +#endif + } + else + { + // FIXME -- omething is not right with the + // pager. If it died then we should receive a + // signal for that. If there is some other problem, + // then what? + } + } + else + { + std::cout.write (msg, len); + std::cout.flush (); + } + } + } +} + +// Assume our terminal wraps long lines. + +static bool +more_than_a_screenful (const char *s, int len) +{ + if (s) + { + int available_rows = command_editor::terminal_rows () - 2; + + int cols = command_editor::terminal_cols (); + + int count = 0; + + int chars_this_line = 0; + + for (int i = 0; i < len; i++) + { + if (*s++ == '\n') + { + count += chars_this_line / cols + 1; + chars_this_line = 0; + } + else + chars_this_line++; + } + + if (count > available_rows) + return true; + } + + return false; +} + +int +octave_pager_buf::sync (void) +{ + if (! interactive + || really_flush_to_pager + || (Vpage_screen_output && Vpage_output_immediately) + || ! Vpage_screen_output) + { + char *buf = eback (); + + int len = pptr () - buf; + + bool bypass_pager = (! interactive + || ! Vpage_screen_output + || (really_flush_to_pager + && Vpage_screen_output + && ! Vpage_output_immediately + && ! more_than_a_screenful (buf, len))); + + if (len > 0) + { + do_sync (buf, len, bypass_pager); + + flush_current_contents_to_diary (); + + seekoff (0, std::ios::beg); + } + } + + return 0; +} + +void +octave_pager_buf::flush_current_contents_to_diary (void) +{ + char *buf = eback () + diary_skip; + + size_t len = pptr () - buf; + + octave_diary.write (buf, len); + + diary_skip = 0; +} + +void +octave_pager_buf::set_diary_skip (void) +{ + diary_skip = pptr () - eback (); +} + +int +octave_diary_buf::sync (void) +{ + if (write_to_diary_file && external_diary_file) + { + char *buf = eback (); + + int len = pptr () - buf; + + if (len > 0) + external_diary_file.write (buf, len); + } + + seekoff (0, std::ios::beg); + + return 0; +} + +octave_pager_stream *octave_pager_stream::instance = 0; + +octave_pager_stream::octave_pager_stream (void) : std::ostream (0), pb (0) +{ + pb = new octave_pager_buf (); + rdbuf (pb); + setf (unitbuf); +} + +octave_pager_stream::~octave_pager_stream (void) +{ + flush (); + delete pb; +} + +std::ostream& +octave_pager_stream::stream (void) +{ + return instance_ok () ? *instance : std::cout; +} + +void +octave_pager_stream::flush_current_contents_to_diary (void) +{ + if (instance_ok ()) + instance->do_flush_current_contents_to_diary (); +} + +void +octave_pager_stream::set_diary_skip (void) +{ + if (instance_ok ()) + instance->do_set_diary_skip (); +} + +// Reinitialize the pager buffer to avoid hanging on to large internal +// buffers when they might not be needed. This function should only be +// called when the pager is not in use. For example, just before +// getting command-line input. + +void +octave_pager_stream::reset (void) +{ + if (instance_ok ()) + instance->do_reset (); +} + +void +octave_pager_stream::do_flush_current_contents_to_diary (void) +{ + if (pb) + pb->flush_current_contents_to_diary (); +} + +void +octave_pager_stream::do_set_diary_skip (void) +{ + if (pb) + pb->set_diary_skip (); +} + +void +octave_pager_stream::do_reset (void) +{ + delete pb; + pb = new octave_pager_buf (); + rdbuf (pb); + setf (unitbuf); +} + +bool +octave_pager_stream::instance_ok (void) +{ + bool retval = true; + + if (! instance) + { + instance = new octave_pager_stream (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } + + if (! instance) + { + ::error ("unable to create pager_stream object!"); + + retval = false; + } + + return retval; +} + +octave_diary_stream *octave_diary_stream::instance = 0; + +octave_diary_stream::octave_diary_stream (void) : std::ostream (0), db (0) +{ + db = new octave_diary_buf (); + rdbuf (db); + setf (unitbuf); +} + +octave_diary_stream::~octave_diary_stream (void) +{ + flush (); + delete db; +} + +std::ostream& +octave_diary_stream::stream (void) +{ + return instance_ok () ? *instance : std::cout; +} + +// Reinitialize the diary buffer to avoid hanging on to large internal +// buffers when they might not be needed. This function should only be +// called when the pager is not in use. For example, just before +// getting command-line input. + +void +octave_diary_stream::reset (void) +{ + if (instance_ok ()) + instance->do_reset (); +} + +void +octave_diary_stream::do_reset (void) +{ + delete db; + db = new octave_diary_buf (); + rdbuf (db); + setf (unitbuf); +} + +bool +octave_diary_stream::instance_ok (void) +{ + bool retval = true; + + if (! instance) + { + instance = new octave_diary_stream (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } + + if (! instance) + { + ::error ("unable to create diary_stream object!"); + + retval = false; + } + + return retval; +} + +void +flush_octave_stdout (void) +{ + if (! flushing_output_to_pager) + { + unwind_protect frame; + + frame.protect_var (really_flush_to_pager); + frame.protect_var (flushing_output_to_pager); + + really_flush_to_pager = true; + flushing_output_to_pager = true; + + octave_stdout.flush (); + + clear_external_pager (); + } +} + +static void +close_diary_file (void) +{ + // Try to flush the current buffer to the diary now, so that things + // like + // + // function foo () + // diary on; + // ... + // diary off; + // endfunction + // + // will do the right thing. + + octave_pager_stream::flush_current_contents_to_diary (); + + if (external_diary_file.is_open ()) + { + octave_diary.flush (); + external_diary_file.close (); + } +} + +static void +open_diary_file (void) +{ + close_diary_file (); + + // If there is pending output in the pager buf, it should not go + // into the diary file. + + octave_pager_stream::set_diary_skip (); + + external_diary_file.open (diary_file.c_str (), std::ios::app); + + if (! external_diary_file) + error ("diary: can't open diary file '%s'", diary_file.c_str ()); +} + +DEFUN (diary, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} diary options\n\ +Record a list of all commands @emph{and} the output they produce, mixed\n\ +together just as you see them on your terminal. Valid options are:\n\ +\n\ +@table @code\n\ +@item on\n\ +Start recording your session in a file called @file{diary} in your\n\ +current working directory.\n\ +\n\ +@item off\n\ +Stop recording your session in the diary file.\n\ +\n\ +@item @var{file}\n\ +Record your session in the file named @var{file}.\n\ +@end table\n\ +\n\ +With no arguments, @code{diary} toggles the current diary state.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("diary"); + + if (error_state) + return retval; + + if (diary_file.empty ()) + diary_file = "diary"; + + switch (argc) + { + case 1: + write_to_diary_file = ! write_to_diary_file; + open_diary_file (); + break; + + case 2: + { + std::string arg = argv[1]; + + if (arg == "on") + { + write_to_diary_file = true; + open_diary_file (); + } + else if (arg == "off") + { + close_diary_file (); + write_to_diary_file = false; + } + else + { + diary_file = arg; + write_to_diary_file = true; + open_diary_file (); + } + } + break; + + default: + print_usage (); + break; + } + + return retval; +} + +DEFUN (more, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} more\n\ +@deftypefnx {Command} {} more on\n\ +@deftypefnx {Command} {} more off\n\ +Turn output pagination on or off. Without an argument, @code{more}\n\ +toggles the current state.\n\ +The current state can be determined via @code{page_screen_output}.\n\ +@seealso{page_screen_output, page_output_immediately, PAGER, PAGER_FLAGS}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("more"); + + if (error_state) + return retval; + + if (argc == 2) + { + std::string arg = argv[1]; + + if (arg == "on") + Vpage_screen_output = true; + else if (arg == "off") + Vpage_screen_output = false; + else + error ("more: unrecognized argument '%s'", arg.c_str ()); + } + else if (argc == 1) + Vpage_screen_output = ! Vpage_screen_output; + else + print_usage (); + + return retval; +} + +DEFUN (terminal_size, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} terminal_size ()\n\ +Return a two-element row vector containing the current size of the\n\ +terminal window in characters (rows and columns).\n\ +@seealso{list_in_columns}\n\ +@end deftypefn") +{ + RowVector size (2, 0.0); + + size(0) = command_editor::terminal_rows (); + size(1) = command_editor::terminal_cols (); + + return octave_value (size); +} + +DEFUN (page_output_immediately, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} page_output_immediately ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} page_output_immediately (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} page_output_immediately (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave sends\n\ +output to the pager as soon as it is available. Otherwise, Octave\n\ +buffers its output and waits until just before the prompt is printed to\n\ +flush it to the pager.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{page_screen_output, more, PAGER, PAGER_FLAGS}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (page_output_immediately); +} + +DEFUN (page_screen_output, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} page_screen_output ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} page_screen_output (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} page_screen_output (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether output intended\n\ +for the terminal window that is longer than one page is sent through a\n\ +pager. This allows you to view one screenful at a time. Some pagers\n\ +(such as @code{less}---see @ref{Installation}) are also capable of moving\n\ +backward on the output.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{more, page_output_immediately, PAGER, PAGER_FLAGS}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (page_screen_output); +} + +DEFUN (PAGER, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} PAGER ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} PAGER (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} PAGER (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the program to use\n\ +to display terminal output on your system. The default value is\n\ +normally @code{\"less\"}, @code{\"more\"}, or\n\ +@code{\"pg\"}, depending on what programs are installed on your system.\n\ +@xref{Installation}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{PAGER_FLAGS, page_output_immediately, more, page_screen_output}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (PAGER); +} + +DEFUN (PAGER_FLAGS, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} PAGER_FLAGS ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} PAGER_FLAGS (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} PAGER_FLAGS (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the options to pass\n\ +to the pager.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{PAGER, more, page_screen_output, page_output_immediately}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (PAGER_FLAGS); +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/pager.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/pager.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,150 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_pager_h) +#define octave_pager_h 1 + +#include +#include +#include + +#include + +class +OCTINTERP_API +octave_pager_buf : public std::stringbuf +{ +public: + + octave_pager_buf (void) : std::stringbuf (), diary_skip (0) { } + + void flush_current_contents_to_diary (void); + + void set_diary_skip (void); + +protected: + + int sync (void); + +private: + + size_t diary_skip; +}; + +class +OCTINTERP_API +octave_pager_stream : public std::ostream +{ +protected: + + octave_pager_stream (void); + +public: + + ~octave_pager_stream (void); + + static void flush_current_contents_to_diary (void); + + static void set_diary_skip (void); + + static std::ostream& stream (void); + + static void reset (void); + +private: + + void do_flush_current_contents_to_diary (void); + + void do_set_diary_skip (void); + + void do_reset (void); + + static octave_pager_stream *instance; + + static bool instance_ok (void); + + static void cleanup_instance (void) { delete instance; instance = 0; } + + octave_pager_buf *pb; + + // No copying! + + octave_pager_stream (const octave_pager_stream&); + + octave_pager_stream& operator = (const octave_pager_stream&); +}; + +class +OCTINTERP_API +octave_diary_buf : public std::stringbuf +{ +public: + + octave_diary_buf (void) : std::stringbuf () { } + +protected: + + int sync (void); +}; + +class +OCTINTERP_API +octave_diary_stream : public std::ostream +{ +protected: + + octave_diary_stream (void); + +public: + + ~octave_diary_stream (void); + + static std::ostream& stream (void); + + static void reset (void); + +private: + + void do_reset (void); + + static octave_diary_stream *instance; + + static bool instance_ok (void); + + static void cleanup_instance (void) { delete instance; instance = 0; } + + octave_diary_buf *db; + + // No copying! + + octave_diary_stream (const octave_diary_stream&); + + octave_diary_stream& operator = (const octave_diary_stream&); +}; + +#define octave_stdout (octave_pager_stream::stream ()) + +#define octave_diary (octave_diary_stream::stream ()) + +extern OCTINTERP_API void flush_octave_stdout (void); + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/pr-output.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/pr-output.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,4097 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include +#include +#include +#include + +#include "Array-util.h" +#include "CMatrix.h" +#include "Range.h" +#include "cmd-edit.h" +#include "dMatrix.h" +#include "lo-mappers.h" +#include "lo-math.h" +#include "mach-info.h" +#include "oct-cmplx.h" +#include "quit.h" +#include "str-vec.h" + +#include "Cell.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "oct-obj.h" +#include "oct-stream.h" +#include "pager.h" +#include "pr-output.h" +#include "sysdep.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +// TRUE means use a scaled fixed point format for 'format long' and +// 'format short'. +static bool Vfixed_point_format = false; + +// The maximum field width for a number printed by the default output +// routines. +static int Voutput_max_field_width = 10; + +// The precision of the numbers printed by the default output +// routines. +static int Voutput_precision = 5; + +// TRUE means that the dimensions of empty objects should be printed +// like this: x = [](2x0). +bool Vprint_empty_dimensions = true; + +// TRUE means that the rows of big matrices should be split into +// smaller slices that fit on the screen. +static bool Vsplit_long_rows = true; + +// TRUE means don't do any fancy formatting. +static bool free_format = false; + +// TRUE means print plus sign for nonzero, blank for zero. +static bool plus_format = false; + +// First char for > 0, second for < 0, third for == 0. +static std::string plus_format_chars = "+ "; + +// TRUE means always print in a rational approximation +static bool rat_format = false; + +// Used to force the length of the rational approximation string for Frats +static int rat_string_len = -1; + +// TRUE means always print like dollars and cents. +static bool bank_format = false; + +// TRUE means print data in hexadecimal format. +static int hex_format = 0; + +// TRUE means print data in binary-bit-pattern format. +static int bit_format = 0; + +// TRUE means don't put newlines around the column number headers. +bool Vcompact_format = false; + +// TRUE means use an e format. +static bool print_e = false; + +// TRUE means use a g format. +static bool print_g = false; + +// TRUE means print E instead of e for exponent field. +static bool print_big_e = false; + +// TRUE means use an engineering format. +static bool print_eng = false; + +class pr_engineering_float; +class pr_formatted_float; +class pr_rational_float; + +static int +current_output_max_field_width (void) +{ + return Voutput_max_field_width; +} + +static int +current_output_precision (void) +{ + return Voutput_precision; +} + +class +float_format +{ +public: + + float_format (int w = current_output_max_field_width (), + int p = current_output_precision (), int f = 0) + : fw (w), ex (0), prec (p), fmt (f), up (0), sp (0) { } + + float_format (int w, int e, int p, int f) + : fw (w), ex (e), prec (p), fmt (f), up (0), sp (0) { } + + float_format (const float_format& ff) + : fw (ff.fw), ex (ff.ex), prec (ff.prec), fmt (ff.fmt), up (ff.up), sp (ff.sp) { } + + float_format& operator = (const float_format& ff) + { + if (&ff != this) + { + fw = ff.fw; + ex = ff.ex; + prec = ff.prec; + fmt = ff.fmt; + up = ff.up; + sp = ff.sp; + } + + return *this; + } + + ~float_format (void) { } + + float_format& scientific (void) { fmt = std::ios::scientific; return *this; } + float_format& fixed (void) { fmt = std::ios::fixed; return *this; } + float_format& general (void) { fmt = 0; return *this; } + + float_format& uppercase (void) { up = std::ios::uppercase; return *this; } + float_format& lowercase (void) { up = 0; return *this; } + + float_format& precision (int p) { prec = p; return *this; } + + float_format& width (int w) { fw = w; return *this; } + + float_format& trailing_zeros (bool tz = true) + { sp = tz ? std::ios::showpoint : 0; return *this; } + + friend std::ostream& operator << (std::ostream& os, + const pr_engineering_float& pef); + + friend std::ostream& operator << (std::ostream& os, + const pr_formatted_float& pff); + + friend std::ostream& operator << (std::ostream& os, + const pr_rational_float& prf); + +private: + + // Field width. Zero means as wide as necessary. + int fw; + + // Exponent Field width. Zero means as wide as necessary. + int ex; + + // Precision. + int prec; + + // Format. + int fmt; + + // E or e. + int up; + + // Show trailing zeros. + int sp; +}; + +static int +calc_scale_exp (const int& x) +{ + if (! print_eng) + return x; + else + return x - 3*static_cast (x/3); + /* The expression above is equivalent to x - (x % 3). + * According to the ISO specification for C++ the modulo operator is + * compiler dependent if any of the arguments are negative. Since this + * function will need to work on negative arguments, and we want to avoid + * portability issues, we re-implement the modulo function to the desired + * behavior (truncation). There may be a gnulib replacement. + * + * ISO/IEC 14882:2003 : Programming languages -- C++. 5.6.4: ISO, IEC. 2003 . + * "the binary % operator yields the remainder from the division of the first + * expression by the second. .... If both operands are nonnegative then the + * remainder is nonnegative; if not, the sign of the remainder is + * implementation-defined". */ +} + +static int +engineering_exponent (const double& x) +{ + int ex = 0; + if (x != 0) + { + double absval = (x < 0.0 ? -x : x); + int logabsval = static_cast (gnulib::floor (log10 (absval))); + /* Avoid using modulo function with negative arguments for portability. + * See extended comment at calc_scale_exp */ + if (logabsval < 0.0) + ex = logabsval - 2 + ((-logabsval + 2) % 3); + else + ex = logabsval - (logabsval % 3); + } + return ex; +} + +static int +num_digits (const double& x) +{ + return 1 + (print_eng + ? engineering_exponent (x) + : static_cast (gnulib::floor (log10 (x)))); +} + +class +pr_engineering_float +{ +public: + + const float_format& f; + + double val; + + int exponent (void) const + { + return engineering_exponent (val); + } + + double mantissa (void) const + { + return val / std::pow (10.0, exponent ()); + } + + pr_engineering_float (const float_format& f_arg, double val_arg) + : f (f_arg), val (val_arg) { } +}; + +std::ostream& +operator << (std::ostream& os, const pr_engineering_float& pef) +{ + if (pef.f.fw >= 0) + os << std::setw (pef.f.fw - pef.f.ex); + + if (pef.f.prec >= 0) + os << std::setprecision (pef.f.prec); + + std::ios::fmtflags oflags = + os.flags (static_cast + (pef.f.fmt | pef.f.up | pef.f.sp)); + + os << pef.mantissa (); + + int ex = pef.exponent (); + if (ex < 0) + { + os << std::setw (0) << "e-"; + ex = -ex; + } + else + os << std::setw (0) << "e+"; + + os << std::setw (pef.f.ex - 2) << std::setfill ('0') << ex + << std::setfill (' '); + + os.flags (oflags); + + return os; +} + +class +pr_formatted_float +{ +public: + + const float_format& f; + + double val; + + pr_formatted_float (const float_format& f_arg, double val_arg) + : f (f_arg), val (val_arg) { } +}; + +std::ostream& +operator << (std::ostream& os, const pr_formatted_float& pff) +{ + if (pff.f.fw >= 0) + os << std::setw (pff.f.fw); + + if (pff.f.prec >= 0) + os << std::setprecision (pff.f.prec); + + std::ios::fmtflags oflags = + os.flags (static_cast + (pff.f.fmt | pff.f.up | pff.f.sp)); + + os << pff.val; + + os.flags (oflags); + + return os; +} + +static inline std::string +rational_approx (double val, int len) +{ + std::string s; + + if (len <= 0) + len = 10; + + if (xisinf (val)) + s = "1/0"; + else if (xisnan (val)) + s = "0/0"; + else if (val < std::numeric_limits::min () + || val > std::numeric_limits::max () + || D_NINT (val) == val) + { + std::ostringstream buf; + buf.flags (std::ios::fixed); + buf << std::setprecision (0) << xround (val); + s = buf.str (); + } + else + { + double lastn = 1.; + double lastd = 0.; + double n = xround (val); + double d = 1.; + double frac = val - n; + int m = 0; + + std::ostringstream buf2; + buf2.flags (std::ios::fixed); + buf2 << std::setprecision (0) << static_cast(n); + s = buf2.str (); + + while (1) + { + double flip = 1. / frac; + double step = xround (flip); + double nextn = n; + double nextd = d; + + // Have we converged to 1/intmax ? + if (m > 100 || fabs (frac) < 1 / static_cast (std::numeric_limits::max ())) + { + lastn = n; + lastd = d; + break; + } + + frac = flip - step; + n = n * step + lastn; + d = d * step + lastd; + lastn = nextn; + lastd = nextd; + + std::ostringstream buf; + buf.flags (std::ios::fixed); + buf << std::setprecision (0) << static_cast(n) + << "/" << static_cast(d); + m++; + + if (n < 0 && d < 0) + { + // Double negative, string can be two characters longer.. + if (buf.str ().length () > static_cast(len + 2) && + m > 1) + break; + } + else if (buf.str ().length () > static_cast(len) && + m > 1) + break; + + s = buf.str (); + } + + if (lastd < 0.) + { + // Move sign to the top + lastd = - lastd; + lastn = - lastn; + std::ostringstream buf; + buf.flags (std::ios::fixed); + buf << std::setprecision (0) << static_cast(lastn) + << "/" << static_cast(lastd); + s = buf.str (); + } + } + + return s; +} + +class +pr_rational_float +{ +public: + + const float_format& f; + + double val; + + pr_rational_float (const float_format& f_arg, double val_arg) + : f (f_arg), val (val_arg) { } +}; + +std::ostream& +operator << (std::ostream& os, const pr_rational_float& prf) +{ + int fw = (rat_string_len > 0 ? rat_string_len : prf.f.fw); + std::string s = rational_approx (prf.val, fw); + + if (fw >= 0) + os << std::setw (fw); + + std::ios::fmtflags oflags = + os.flags (static_cast + (prf.f.fmt | prf.f.up | prf.f.sp)); + + if (fw > 0 && s.length () > static_cast(fw)) + os << "*"; + else + os << s; + + os.flags (oflags); + + return os; +} + +// Current format for real numbers and the real part of complex +// numbers. +static float_format *curr_real_fmt = 0; + +// Current format for the imaginary part of complex numbers. +static float_format *curr_imag_fmt = 0; + +static double +pr_max_internal (const Matrix& m) +{ + octave_idx_type nr = m.rows (); + octave_idx_type nc = m.columns (); + + double result = -std::numeric_limits::max (); + + bool all_inf_or_nan = true; + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + double val = m(i,j); + if (xisinf (val) || xisnan (val)) + continue; + + all_inf_or_nan = false; + + if (val > result) + result = val; + } + + if (all_inf_or_nan) + result = 0.0; + + return result; +} + +static double +pr_min_internal (const Matrix& m) +{ + octave_idx_type nr = m.rows (); + octave_idx_type nc = m.columns (); + + double result = std::numeric_limits::max (); + + bool all_inf_or_nan = true; + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + double val = m(i,j); + if (xisinf (val) || xisnan (val)) + continue; + + all_inf_or_nan = false; + + if (val < result) + result = val; + } + + if (all_inf_or_nan) + result = 0.0; + + return result; +} + +// FIXME -- it would be nice to share more code among these +// functions,.. + +static void +set_real_format (int digits, bool inf_or_nan, bool int_only, int &fw) +{ + static float_format fmt; + + int prec = Voutput_precision; + + int ld, rd; + + if (rat_format) + { + fw = 0; + rd = 0; + } + else if (bank_format) + { + fw = digits < 0 ? 4 : digits + 3; + if (inf_or_nan && fw < 4) + fw = 4; + rd = 2; + } + else if (hex_format) + { + fw = 2 * sizeof (double); + rd = 0; + } + else if (bit_format) + { + fw = 8 * sizeof (double); + rd = 0; + } + else if (inf_or_nan || int_only) + { + fw = 1 + digits; + if (inf_or_nan && fw < 4) + fw = 4; + rd = fw; + } + else + { + if (digits > 0) + { + ld = digits; + rd = prec > digits ? prec - digits : prec; + digits++; + } + else + { + ld = 1; + rd = prec > digits ? prec - digits : prec; + digits = -digits + 1; + } + + fw = 1 + ld + 1 + rd; + if (inf_or_nan && fw < 4) + fw = 4; + } + + if (! (rat_format || bank_format || hex_format || bit_format) + && (fw > Voutput_max_field_width || print_e || print_g || print_eng)) + { + if (print_g) + fmt = float_format (); + else + { + // e+ddd + int ex = 5; + + if (print_eng) + { + // -ddd. + fw = 5 + prec + ex; + if (inf_or_nan && fw < 6) + fw = 6; + fmt = float_format (fw, ex, prec - 1, std::ios::fixed); + } + else + { + // -d. + fw = 3 + prec + ex; + if (inf_or_nan && fw < 4) + fw = 4; + fmt = float_format (fw, ex, prec - 1, std::ios::scientific); + } + } + + if (print_big_e) + fmt.uppercase (); + } + else if (! bank_format && (inf_or_nan || int_only)) + fmt = float_format (fw, rd); + else + fmt = float_format (fw, rd, std::ios::fixed); + + curr_real_fmt = &fmt; +} + +static void +set_format (double d, int& fw) +{ + curr_real_fmt = 0; + curr_imag_fmt = 0; + + if (free_format) + return; + + bool inf_or_nan = (xisinf (d) || xisnan (d)); + + bool int_only = (! inf_or_nan && D_NINT (d) == d); + + double d_abs = d < 0.0 ? -d : d; + + int digits = (inf_or_nan || d_abs == 0.0) + ? 0 : num_digits (d_abs); + + set_real_format (digits, inf_or_nan, int_only, fw); +} + +static inline void +set_format (double d) +{ + int fw; + set_format (d, fw); +} + +static void +set_real_matrix_format (int x_max, int x_min, bool inf_or_nan, + int int_or_inf_or_nan, int& fw) +{ + static float_format fmt; + + int prec = Voutput_precision; + + int ld, rd; + + if (rat_format) + { + fw = 9; + rd = 0; + } + else if (bank_format) + { + int digits = x_max > x_min ? x_max : x_min; + fw = digits <= 0 ? 4 : digits + 3; + if (inf_or_nan && fw < 4) + fw = 4; + rd = 2; + } + else if (hex_format) + { + fw = 2 * sizeof (double); + rd = 0; + } + else if (bit_format) + { + fw = 8 * sizeof (double); + rd = 0; + } + else if (Vfixed_point_format && ! print_g) + { + rd = prec; + fw = rd + 2; + if (inf_or_nan && fw < 4) + fw = 4; + } + else if (int_or_inf_or_nan) + { + int digits = x_max > x_min ? x_max : x_min; + fw = digits <= 0 ? 2 : digits + 1; + if (inf_or_nan && fw < 4) + fw = 4; + rd = fw; + } + else + { + int ld_max, rd_max; + if (x_max > 0) + { + ld_max = x_max; + rd_max = prec > x_max ? prec - x_max : prec; + x_max++; + } + else + { + ld_max = 1; + rd_max = prec > x_max ? prec - x_max : prec; + x_max = -x_max + 1; + } + + int ld_min, rd_min; + if (x_min > 0) + { + ld_min = x_min; + rd_min = prec > x_min ? prec - x_min : prec; + x_min++; + } + else + { + ld_min = 1; + rd_min = prec > x_min ? prec - x_min : prec; + x_min = -x_min + 1; + } + + ld = ld_max > ld_min ? ld_max : ld_min; + rd = rd_max > rd_min ? rd_max : rd_min; + + fw = 1 + ld + 1 + rd; + if (inf_or_nan && fw < 4) + fw = 4; + } + + if (! (rat_format || bank_format || hex_format || bit_format) + && (print_e + || print_eng || print_g + || (! Vfixed_point_format && fw > Voutput_max_field_width))) + { + if (print_g) + fmt = float_format (); + else + { + int ex = 4; + if (x_max > 100 || x_min > 100) + ex++; + + if (print_eng) + { + fw = 4 + prec + ex; + if (inf_or_nan && fw < 6) + fw = 6; + fmt = float_format (fw, ex, prec - 1, std::ios::fixed); + } + else + { + fw = 2 + prec + ex; + if (inf_or_nan && fw < 4) + fw = 4; + fmt = float_format (fw, prec - 1, std::ios::scientific); + } + } + + if (print_big_e) + fmt.uppercase (); + } + else if (! bank_format && int_or_inf_or_nan) + fmt = float_format (fw, rd); + else + fmt = float_format (fw, rd, std::ios::fixed); + + curr_real_fmt = &fmt; +} + +static void +set_format (const Matrix& m, int& fw, double& scale) +{ + curr_real_fmt = 0; + curr_imag_fmt = 0; + + if (free_format) + return; + + bool inf_or_nan = m.any_element_is_inf_or_nan (); + + bool int_or_inf_or_nan = m.all_elements_are_int_or_inf_or_nan (); + + Matrix m_abs = m.abs (); + double max_abs = pr_max_internal (m_abs); + double min_abs = pr_min_internal (m_abs); + + int x_max = max_abs == 0.0 ? 0 : num_digits (max_abs); + + int x_min = min_abs == 0.0 ? 0 : num_digits (min_abs); + + scale = (x_max == 0 || int_or_inf_or_nan) ? 1.0 + : std::pow (10.0, calc_scale_exp (x_max - 1)); + + set_real_matrix_format (x_max, x_min, inf_or_nan, int_or_inf_or_nan, fw); +} + +static inline void +set_format (const Matrix& m) +{ + int fw; + double scale; + set_format (m, fw, scale); +} + +static void +set_complex_format (int x_max, int x_min, int r_x, bool inf_or_nan, + int int_only, int& r_fw, int& i_fw) +{ + static float_format r_fmt; + static float_format i_fmt; + + int prec = Voutput_precision; + + int ld, rd; + + if (rat_format) + { + i_fw = 0; + r_fw = 0; + rd = 0; + } + else if (bank_format) + { + int digits = r_x; + i_fw = 0; + r_fw = digits <= 0 ? 4 : digits + 3; + if (inf_or_nan && r_fw < 4) + r_fw = 4; + rd = 2; + } + else if (hex_format) + { + r_fw = 2 * sizeof (double); + i_fw = 2 * sizeof (double); + rd = 0; + } + else if (bit_format) + { + r_fw = 8 * sizeof (double); + i_fw = 8 * sizeof (double); + rd = 0; + } + else if (inf_or_nan || int_only) + { + int digits = x_max > x_min ? x_max : x_min; + i_fw = digits <= 0 ? 1 : digits; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 3) + { + i_fw = 3; + r_fw = 4; + } + rd = r_fw; + } + else + { + int ld_max, rd_max; + if (x_max > 0) + { + ld_max = x_max; + rd_max = prec > x_max ? prec - x_max : prec; + x_max++; + } + else + { + ld_max = 1; + rd_max = prec > x_max ? prec - x_max : prec; + x_max = -x_max + 1; + } + + int ld_min, rd_min; + if (x_min > 0) + { + ld_min = x_min; + rd_min = prec > x_min ? prec - x_min : prec; + x_min++; + } + else + { + ld_min = 1; + rd_min = prec > x_min ? prec - x_min : prec; + x_min = -x_min + 1; + } + + ld = ld_max > ld_min ? ld_max : ld_min; + rd = rd_max > rd_min ? rd_max : rd_min; + + i_fw = ld + 1 + rd; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 3) + { + i_fw = 3; + r_fw = 4; + } + } + + if (! (rat_format || bank_format || hex_format || bit_format) + && (r_fw > Voutput_max_field_width || print_e || print_eng || print_g)) + { + if (print_g) + { + r_fmt = float_format (); + i_fmt = float_format (); + } + else + { + int ex = 4; + if (x_max > 100 || x_min > 100) + ex++; + + if (print_eng) + { + i_fw = 3 + prec + ex; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 5) + { + i_fw = 5; + r_fw = 6; + } + r_fmt = float_format (r_fw, ex, prec - 1, std::ios::fixed); + i_fmt = float_format (i_fw, ex, prec - 1, std::ios::fixed); + } + else + { + i_fw = 1 + prec + ex; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 3) + { + i_fw = 3; + r_fw = 4; + } + r_fmt = float_format (r_fw, prec - 1, std::ios::scientific); + i_fmt = float_format (i_fw, prec - 1, std::ios::scientific); + } + } + + if (print_big_e) + { + r_fmt.uppercase (); + i_fmt.uppercase (); + } + } + else if (! bank_format && (inf_or_nan || int_only)) + { + r_fmt = float_format (r_fw, rd); + i_fmt = float_format (i_fw, rd); + } + else + { + r_fmt = float_format (r_fw, rd, std::ios::fixed); + i_fmt = float_format (i_fw, rd, std::ios::fixed); + } + + curr_real_fmt = &r_fmt; + curr_imag_fmt = &i_fmt; +} + +static void +set_format (const Complex& c, int& r_fw, int& i_fw) +{ + curr_real_fmt = 0; + curr_imag_fmt = 0; + + if (free_format) + return; + + double rp = c.real (); + double ip = c.imag (); + + bool inf_or_nan = (xisinf (c) || xisnan (c)); + + bool int_only = (D_NINT (rp) == rp && D_NINT (ip) == ip); + + double r_abs = rp < 0.0 ? -rp : rp; + double i_abs = ip < 0.0 ? -ip : ip; + + int r_x = (xisinf (rp) || xisnan (rp) || r_abs == 0.0) + ? 0 : num_digits (r_abs); + + int i_x = (xisinf (ip) || xisnan (ip) || i_abs == 0.0) + ? 0 : num_digits (i_abs); + + int x_max, x_min; + + if (r_x > i_x) + { + x_max = r_x; + x_min = i_x; + } + else + { + x_max = i_x; + x_min = r_x; + } + + set_complex_format (x_max, x_min, r_x, inf_or_nan, int_only, r_fw, i_fw); +} + +static inline void +set_format (const Complex& c) +{ + int r_fw, i_fw; + set_format (c, r_fw, i_fw); +} + +static void +set_complex_matrix_format (int x_max, int x_min, int r_x_max, + int r_x_min, bool inf_or_nan, + int int_or_inf_or_nan, int& r_fw, int& i_fw) +{ + static float_format r_fmt; + static float_format i_fmt; + + int prec = Voutput_precision; + + int ld, rd; + + if (rat_format) + { + i_fw = 9; + r_fw = 9; + rd = 0; + } + else if (bank_format) + { + int digits = r_x_max > r_x_min ? r_x_max : r_x_min; + i_fw = 0; + r_fw = digits <= 0 ? 4 : digits + 3; + if (inf_or_nan && r_fw < 4) + r_fw = 4; + rd = 2; + } + else if (hex_format) + { + r_fw = 2 * sizeof (double); + i_fw = 2 * sizeof (double); + rd = 0; + } + else if (bit_format) + { + r_fw = 8 * sizeof (double); + i_fw = 8 * sizeof (double); + rd = 0; + } + else if (Vfixed_point_format && ! print_g) + { + rd = prec; + i_fw = rd + 1; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 3) + { + i_fw = 3; + r_fw = 4; + } + } + else if (int_or_inf_or_nan) + { + int digits = x_max > x_min ? x_max : x_min; + i_fw = digits <= 0 ? 1 : digits; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 3) + { + i_fw = 3; + r_fw = 4; + } + rd = r_fw; + } + else + { + int ld_max, rd_max; + if (x_max > 0) + { + ld_max = x_max; + rd_max = prec > x_max ? prec - x_max : prec; + x_max++; + } + else + { + ld_max = 1; + rd_max = prec > x_max ? prec - x_max : prec; + x_max = -x_max + 1; + } + + int ld_min, rd_min; + if (x_min > 0) + { + ld_min = x_min; + rd_min = prec > x_min ? prec - x_min : prec; + x_min++; + } + else + { + ld_min = 1; + rd_min = prec > x_min ? prec - x_min : prec; + x_min = -x_min + 1; + } + + ld = ld_max > ld_min ? ld_max : ld_min; + rd = rd_max > rd_min ? rd_max : rd_min; + + i_fw = ld + 1 + rd; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 3) + { + i_fw = 3; + r_fw = 4; + } + } + + if (! (rat_format || bank_format || hex_format || bit_format) + && (print_e + || print_eng || print_g + || (! Vfixed_point_format && r_fw > Voutput_max_field_width))) + { + if (print_g) + { + r_fmt = float_format (); + i_fmt = float_format (); + } + else + { + int ex = 4; + if (x_max > 100 || x_min > 100) + ex++; + + if (print_eng) + { + i_fw = 3 + prec + ex; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 5) + { + i_fw = 5; + r_fw = 6; + } + r_fmt = float_format (r_fw, ex, prec - 1, std::ios::fixed); + i_fmt = float_format (i_fw, ex, prec - 1, std::ios::fixed); + } + else + { + i_fw = 1 + prec + ex; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 3) + { + i_fw = 3; + r_fw = 4; + } + r_fmt = float_format (r_fw, prec - 1, std::ios::scientific); + i_fmt = float_format (i_fw, prec - 1, std::ios::scientific); + } + } + + if (print_big_e) + { + r_fmt.uppercase (); + i_fmt.uppercase (); + } + } + else if (! bank_format && int_or_inf_or_nan) + { + r_fmt = float_format (r_fw, rd); + i_fmt = float_format (i_fw, rd); + } + else + { + r_fmt = float_format (r_fw, rd, std::ios::fixed); + i_fmt = float_format (i_fw, rd, std::ios::fixed); + } + + curr_real_fmt = &r_fmt; + curr_imag_fmt = &i_fmt; +} + +static void +set_format (const ComplexMatrix& cm, int& r_fw, int& i_fw, double& scale) +{ + curr_real_fmt = 0; + curr_imag_fmt = 0; + + if (free_format) + return; + + Matrix rp = real (cm); + Matrix ip = imag (cm); + + bool inf_or_nan = cm.any_element_is_inf_or_nan (); + + bool int_or_inf_or_nan = (rp.all_elements_are_int_or_inf_or_nan () + && ip.all_elements_are_int_or_inf_or_nan ()); + + Matrix r_m_abs = rp.abs (); + double r_max_abs = pr_max_internal (r_m_abs); + double r_min_abs = pr_min_internal (r_m_abs); + + Matrix i_m_abs = ip.abs (); + double i_max_abs = pr_max_internal (i_m_abs); + double i_min_abs = pr_min_internal (i_m_abs); + + int r_x_max = r_max_abs == 0.0 ? 0 : num_digits (r_max_abs); + + int r_x_min = r_min_abs == 0.0 ? 0 : num_digits (r_min_abs); + + int i_x_max = i_max_abs == 0.0 ? 0 : num_digits (i_max_abs); + + int i_x_min = i_min_abs == 0.0 ? 0 : num_digits (i_min_abs); + + int x_max = r_x_max > i_x_max ? r_x_max : i_x_max; + int x_min = r_x_min > i_x_min ? r_x_min : i_x_min; + + scale = (x_max == 0 || int_or_inf_or_nan) ? 1.0 + : std::pow (10.0, calc_scale_exp (x_max - 1)); + + set_complex_matrix_format (x_max, x_min, r_x_max, r_x_min, inf_or_nan, + int_or_inf_or_nan, r_fw, i_fw); +} + +static inline void +set_format (const ComplexMatrix& cm) +{ + int r_fw, i_fw; + double scale; + set_format (cm, r_fw, i_fw, scale); +} + +static void +set_range_format (int x_max, int x_min, int all_ints, int& fw) +{ + static float_format fmt; + + int prec = Voutput_precision; + + int ld, rd; + + if (rat_format) + { + fw = 9; + rd = 0; + } + else if (bank_format) + { + int digits = x_max > x_min ? x_max : x_min; + fw = digits < 0 ? 5 : digits + 4; + rd = 2; + } + else if (hex_format) + { + fw = 2 * sizeof (double); + rd = 0; + } + else if (bit_format) + { + fw = 8 * sizeof (double); + rd = 0; + } + else if (all_ints) + { + int digits = x_max > x_min ? x_max : x_min; + fw = digits + 1; + rd = fw; + } + else if (Vfixed_point_format && ! print_g) + { + rd = prec; + fw = rd + 3; + } + else + { + int ld_max, rd_max; + if (x_max > 0) + { + ld_max = x_max; + rd_max = prec > x_max ? prec - x_max : prec; + x_max++; + } + else + { + ld_max = 1; + rd_max = prec > x_max ? prec - x_max : prec; + x_max = -x_max + 1; + } + + int ld_min, rd_min; + if (x_min > 0) + { + ld_min = x_min; + rd_min = prec > x_min ? prec - x_min : prec; + x_min++; + } + else + { + ld_min = 1; + rd_min = prec > x_min ? prec - x_min : prec; + x_min = -x_min + 1; + } + + ld = ld_max > ld_min ? ld_max : ld_min; + rd = rd_max > rd_min ? rd_max : rd_min; + + fw = ld + rd + 3; + } + + if (! (rat_format || bank_format || hex_format || bit_format) + && (print_e + || print_eng || print_g + || (! Vfixed_point_format && fw > Voutput_max_field_width))) + { + if (print_g) + fmt = float_format (); + else + { + int ex = 4; + if (x_max > 100 || x_min > 100) + ex++; + + if (print_eng) + { + fw = 5 + prec + ex; + fmt = float_format (fw, ex, prec - 1, std::ios::fixed); + } + else + { + fw = 3 + prec + ex; + fmt = float_format (fw, prec - 1, std::ios::scientific); + } + } + + if (print_big_e) + fmt.uppercase (); + } + else if (! bank_format && all_ints) + fmt = float_format (fw, rd); + else + fmt = float_format (fw, rd, std::ios::fixed); + + curr_real_fmt = &fmt; +} + +static void +set_format (const Range& r, int& fw, double& scale) +{ + curr_real_fmt = 0; + curr_imag_fmt = 0; + + if (free_format) + return; + + double r_min = r.base (); + double r_max = r.limit (); + + if (r_max < r_min) + { + double tmp = r_max; + r_max = r_min; + r_min = tmp; + } + + bool all_ints = r.all_elements_are_ints (); + + double max_abs = r_max < 0.0 ? -r_max : r_max; + double min_abs = r_min < 0.0 ? -r_min : r_min; + + int x_max = max_abs == 0.0 ? 0 : num_digits (max_abs); + + int x_min = min_abs == 0.0 ? 0 : num_digits (min_abs); + + scale = (x_max == 0 || all_ints) ? 1.0 + : std::pow (10.0, calc_scale_exp (x_max - 1)); + + set_range_format (x_max, x_min, all_ints, fw); +} + +static inline void +set_format (const Range& r) +{ + int fw; + double scale; + set_format (r, fw, scale); +} + +union equiv +{ + double d; + unsigned char i[sizeof (double)]; +}; + +#define PRINT_CHAR_BITS(os, c) \ + do \ + { \ + unsigned char ctmp = c; \ + char stmp[9]; \ + stmp[0] = (ctmp & 0x80) ? '1' : '0'; \ + stmp[1] = (ctmp & 0x40) ? '1' : '0'; \ + stmp[2] = (ctmp & 0x20) ? '1' : '0'; \ + stmp[3] = (ctmp & 0x10) ? '1' : '0'; \ + stmp[4] = (ctmp & 0x08) ? '1' : '0'; \ + stmp[5] = (ctmp & 0x04) ? '1' : '0'; \ + stmp[6] = (ctmp & 0x02) ? '1' : '0'; \ + stmp[7] = (ctmp & 0x01) ? '1' : '0'; \ + stmp[8] = '\0'; \ + os << stmp; \ + } \ + while (0) + +#define PRINT_CHAR_BITS_SWAPPED(os, c) \ + do \ + { \ + unsigned char ctmp = c; \ + char stmp[9]; \ + stmp[0] = (ctmp & 0x01) ? '1' : '0'; \ + stmp[1] = (ctmp & 0x02) ? '1' : '0'; \ + stmp[2] = (ctmp & 0x04) ? '1' : '0'; \ + stmp[3] = (ctmp & 0x08) ? '1' : '0'; \ + stmp[4] = (ctmp & 0x10) ? '1' : '0'; \ + stmp[5] = (ctmp & 0x20) ? '1' : '0'; \ + stmp[6] = (ctmp & 0x40) ? '1' : '0'; \ + stmp[7] = (ctmp & 0x80) ? '1' : '0'; \ + stmp[8] = '\0'; \ + os << stmp; \ + } \ + while (0) + +static void +pr_any_float (const float_format *fmt, std::ostream& os, double d, int fw = 0) +{ + if (fmt) + { + // Unless explicitly asked for, always print in big-endian + // format for hex and bit formats. + // + // {bit,hex}_format == 1: print big-endian + // {bit,hex}_format == 2: print native + + if (hex_format) + { + equiv tmp; + tmp.d = d; + + // Unless explicitly asked for, always print in big-endian + // format. + + // FIXME -- is it correct to swap bytes for VAX + // formats and not for Cray? + + // FIXME -- will bad things happen if we are + // interrupted before resetting the format flags and fill + // character? + + oct_mach_info::float_format flt_fmt = + oct_mach_info::native_float_format (); + + char ofill = os.fill ('0'); + + std::ios::fmtflags oflags + = os.flags (std::ios::right | std::ios::hex); + + if (hex_format > 1 + || flt_fmt == oct_mach_info::flt_fmt_ieee_big_endian + || flt_fmt == oct_mach_info::flt_fmt_cray + || flt_fmt == oct_mach_info::flt_fmt_unknown) + { + for (size_t i = 0; i < sizeof (double); i++) + os << std::setw (2) << static_cast (tmp.i[i]); + } + else + { + for (int i = sizeof (double) - 1; i >= 0; i--) + os << std::setw (2) << static_cast (tmp.i[i]); + } + + os.fill (ofill); + os.setf (oflags); + } + else if (bit_format) + { + equiv tmp; + tmp.d = d; + + // FIXME -- is it correct to swap bytes for VAX + // formats and not for Cray? + + oct_mach_info::float_format flt_fmt = + oct_mach_info::native_float_format (); + + if (flt_fmt == oct_mach_info::flt_fmt_ieee_big_endian + || flt_fmt == oct_mach_info::flt_fmt_cray + || flt_fmt == oct_mach_info::flt_fmt_unknown) + { + for (size_t i = 0; i < sizeof (double); i++) + PRINT_CHAR_BITS (os, tmp.i[i]); + } + else + { + if (bit_format > 1) + { + for (size_t i = 0; i < sizeof (double); i++) + PRINT_CHAR_BITS_SWAPPED (os, tmp.i[i]); + } + else + { + for (int i = sizeof (double) - 1; i >= 0; i--) + PRINT_CHAR_BITS (os, tmp.i[i]); + } + } + } + else if (octave_is_NA (d)) + { + if (fw > 0) + os << std::setw (fw) << "NA"; + else + os << "NA"; + } + else if (rat_format) + os << pr_rational_float (*fmt, d); + else if (xisinf (d)) + { + const char *s; + if (d < 0.0) + s = "-Inf"; + else + s = "Inf"; + + if (fw > 0) + os << std::setw (fw) << s; + else + os << s; + } + else if (xisnan (d)) + { + if (fw > 0) + os << std::setw (fw) << "NaN"; + else + os << "NaN"; + } + else if (print_eng) + os << pr_engineering_float (*fmt, d); + else + os << pr_formatted_float (*fmt, d); + } + else + os << d; +} + +static inline void +pr_float (std::ostream& os, double d, int fw = 0, double scale = 1.0) +{ + if (Vfixed_point_format && ! print_g && scale != 1.0) + d /= scale; + + pr_any_float (curr_real_fmt, os, d, fw); +} + +static inline void +pr_imag_float (std::ostream& os, double d, int fw = 0) +{ + pr_any_float (curr_imag_fmt, os, d, fw); +} + +static void +pr_complex (std::ostream& os, const Complex& c, int r_fw = 0, + int i_fw = 0, double scale = 1.0) +{ + Complex tmp + = (Vfixed_point_format && ! print_g && scale != 1.0) ? c / scale : c; + + double r = tmp.real (); + + pr_float (os, r, r_fw); + + if (! bank_format) + { + double i = tmp.imag (); + if (! (hex_format || bit_format) && lo_ieee_signbit (i)) + { + os << " - "; + i = -i; + pr_imag_float (os, i, i_fw); + } + else + { + if (hex_format || bit_format) + os << " "; + else + os << " + "; + + pr_imag_float (os, i, i_fw); + } + os << "i"; + } +} + +static void +print_empty_matrix (std::ostream& os, octave_idx_type nr, octave_idx_type nc, bool pr_as_read_syntax) +{ + assert (nr == 0 || nc == 0); + + if (pr_as_read_syntax) + { + if (nr == 0 && nc == 0) + os << "[]"; + else + os << "zeros (" << nr << ", " << nc << ")"; + } + else + { + os << "[]"; + + if (Vprint_empty_dimensions) + os << "(" << nr << "x" << nc << ")"; + } +} + +static void +print_empty_nd_array (std::ostream& os, const dim_vector& dims, + bool pr_as_read_syntax) +{ + assert (dims.any_zero ()); + + if (pr_as_read_syntax) + os << "zeros (" << dims.str (',') << ")"; + else + { + os << "[]"; + + if (Vprint_empty_dimensions) + os << "(" << dims.str () << ")"; + } +} + +static void +pr_scale_header (std::ostream& os, double scale) +{ + if (Vfixed_point_format && ! print_g && scale != 1.0) + { + os << " " + << std::setw (8) << std::setprecision (1) + << std::setiosflags (std::ios::scientific|std::ios::left) + << scale + << std::resetiosflags (std::ios::scientific|std::ios::left) + << " *\n"; + + if (! Vcompact_format) + os << "\n"; + } +} + +static void +pr_col_num_header (std::ostream& os, octave_idx_type total_width, int max_width, + octave_idx_type lim, octave_idx_type col, int extra_indent) +{ + if (total_width > max_width && Vsplit_long_rows) + { + if (col != 0) + { + if (Vcompact_format) + os << "\n"; + else + os << "\n\n"; + } + + octave_idx_type num_cols = lim - col; + + os << std::setw (extra_indent) << ""; + + if (num_cols == 1) + os << " Column " << col + 1 << ":\n"; + else if (num_cols == 2) + os << " Columns " << col + 1 << " and " << lim << ":\n"; + else + os << " Columns " << col + 1 << " through " << lim << ":\n"; + + if (! Vcompact_format) + os << "\n"; + } +} + +template +/* static */ inline void +pr_plus_format (std::ostream& os, const T& val) +{ + if (val > T (0)) + os << plus_format_chars[0]; + else if (val < T (0)) + os << plus_format_chars[1]; + else + os << plus_format_chars[2]; +} + +void +octave_print_internal (std::ostream& os, double d, + bool /* pr_as_read_syntax */) +{ + if (plus_format) + { + pr_plus_format (os, d); + } + else + { + set_format (d); + if (free_format) + os << d; + else + pr_float (os, d); + } +} + +void +octave_print_internal (std::ostream& os, const Matrix& m, + bool pr_as_read_syntax, int extra_indent) +{ + octave_idx_type nr = m.rows (); + octave_idx_type nc = m.columns (); + + if (nr == 0 || nc == 0) + print_empty_matrix (os, nr, nc, pr_as_read_syntax); + else if (plus_format && ! pr_as_read_syntax) + { + for (octave_idx_type i = 0; i < nr; i++) + { + for (octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + + pr_plus_format (os, m(i,j)); + } + + if (i < nr - 1) + os << "\n"; + } + } + else + { + int fw; + double scale = 1.0; + set_format (m, fw, scale); + int column_width = fw + 2; + octave_idx_type total_width = nc * column_width; + octave_idx_type max_width = command_editor::terminal_cols (); + + if (pr_as_read_syntax) + max_width -= 4; + else + max_width -= extra_indent; + + if (max_width < 0) + max_width = 0; + + if (free_format) + { + if (pr_as_read_syntax) + os << "[\n"; + + os << m; + + if (pr_as_read_syntax) + os << "]"; + + return; + } + + octave_idx_type inc = nc; + if (total_width > max_width && Vsplit_long_rows) + { + inc = max_width / column_width; + if (inc == 0) + inc++; + } + + if (pr_as_read_syntax) + { + for (octave_idx_type i = 0; i < nr; i++) + { + octave_idx_type col = 0; + while (col < nc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + if (i == 0 && j == 0) + os << "[ "; + else + { + if (j > col && j < lim) + os << ", "; + else + os << " "; + } + + pr_float (os, m(i,j)); + } + + col += inc; + + if (col >= nc) + { + if (i == nr - 1) + os << " ]"; + else + os << ";\n"; + } + else + os << " ...\n"; + } + } + } + else + { + pr_scale_header (os, scale); + + for (octave_idx_type col = 0; col < nc; col += inc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + pr_col_num_header (os, total_width, max_width, lim, col, + extra_indent); + + for (octave_idx_type i = 0; i < nr; i++) + { + os << std::setw (extra_indent) << ""; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + os << " "; + + pr_float (os, m(i,j), fw, scale); + } + + if (i < nr - 1) + os << "\n"; + } + } + } + } +} + +void +octave_print_internal (std::ostream& os, const DiagMatrix& m, + bool pr_as_read_syntax, int extra_indent) +{ + octave_idx_type nr = m.rows (); + octave_idx_type nc = m.columns (); + + if (nr == 0 || nc == 0) + print_empty_matrix (os, nr, nc, pr_as_read_syntax); + else if (plus_format && ! pr_as_read_syntax) + { + for (octave_idx_type i = 0; i < nr; i++) + { + for (octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + + pr_plus_format (os, m(i,j)); + } + + if (i < nr - 1) + os << "\n"; + } + } + else + { + int fw; + double scale = 1.0; + set_format (Matrix (m.diag ()), fw, scale); + int column_width = fw + 2; + octave_idx_type total_width = nc * column_width; + octave_idx_type max_width = command_editor::terminal_cols (); + + if (pr_as_read_syntax) + max_width -= 4; + else + max_width -= extra_indent; + + if (max_width < 0) + max_width = 0; + + if (free_format) + { + if (pr_as_read_syntax) + os << "[\n"; + + os << Matrix (m); + + if (pr_as_read_syntax) + os << "]"; + + return; + } + + octave_idx_type inc = nc; + if (total_width > max_width && Vsplit_long_rows) + { + inc = max_width / column_width; + if (inc == 0) + inc++; + } + + if (pr_as_read_syntax) + { + os << "diag ("; + + octave_idx_type col = 0; + while (col < nc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + if (j == 0) + os << "[ "; + else + { + if (j > col && j < lim) + os << ", "; + else + os << " "; + } + + pr_float (os, m(j,j)); + } + + col += inc; + + if (col >= nc) + os << " ]"; + else + os << " ...\n"; + } + os << ")"; + } + else + { + os << "Diagonal Matrix\n"; + if (! Vcompact_format) + os << "\n"; + + pr_scale_header (os, scale); + + // kluge. Get the true width of a number. + int zero_fw; + + { + std::ostringstream tmp_oss; + pr_float (tmp_oss, 0.0, fw, scale); + zero_fw = tmp_oss.str ().length (); + } + + for (octave_idx_type col = 0; col < nc; col += inc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + pr_col_num_header (os, total_width, max_width, lim, col, + extra_indent); + + for (octave_idx_type i = 0; i < nr; i++) + { + os << std::setw (extra_indent) << ""; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + os << " "; + + if (i == j) + pr_float (os, m(i,j), fw, scale); + else + os << std::setw (zero_fw) << '0'; + + } + + if (i < nr - 1) + os << "\n"; + } + } + } + } +} + +template +void print_nd_array (std::ostream& os, const NDA_T& nda, + bool pr_as_read_syntax) +{ + + if (nda.is_empty ()) + print_empty_nd_array (os, nda.dims (), pr_as_read_syntax); + else + { + + int ndims = nda.ndims (); + + dim_vector dims = nda.dims (); + + Array ra_idx (dim_vector (ndims, 1), 0); + + octave_idx_type m = 1; + + for (int i = 2; i < ndims; i++) + m *= dims(i); + + octave_idx_type nr = dims(0); + octave_idx_type nc = dims(1); + + for (octave_idx_type i = 0; i < m; i++) + { + octave_quit (); + + std::string nm = "ans"; + + if (m > 1) + { + nm += "(:,:,"; + + std::ostringstream buf; + + for (int k = 2; k < ndims; k++) + { + buf << ra_idx(k) + 1; + + if (k < ndims - 1) + buf << ","; + else + buf << ")"; + } + + nm += buf.str (); + } + + Array idx (dim_vector (ndims, 1)); + + idx(0) = idx_vector (':'); + idx(1) = idx_vector (':'); + + for (int k = 2; k < ndims; k++) + idx(k) = idx_vector (ra_idx(k)); + + octave_value page + = MAT_T (Array (nda.index (idx), dim_vector (nr, nc))); + + if (i != m - 1) + { + page.print_with_name (os, nm); + } + else + { + page.print_name_tag (os, nm); + page.print_raw (os); + } + + if (i < m) + NDA_T::increment_index (ra_idx, dims, 2); + } + } +} + +void +octave_print_internal (std::ostream& os, const NDArray& nda, + bool pr_as_read_syntax, int extra_indent) +{ + switch (nda.ndims ()) + { + case 1: + case 2: + octave_print_internal (os, nda.matrix_value (), + pr_as_read_syntax, extra_indent); + break; + + default: + print_nd_array (os, nda, pr_as_read_syntax); + break; + } +} + +template <> +/* static */ inline void +pr_plus_format<> (std::ostream& os, const Complex& c) +{ + double rp = c.real (); + double ip = c.imag (); + + if (rp == 0.0) + { + if (ip == 0.0) + os << " "; + else + os << "i"; + } + else if (ip == 0.0) + pr_plus_format (os, rp); + else + os << "c"; +} + +void +octave_print_internal (std::ostream& os, const Complex& c, + bool /* pr_as_read_syntax */) +{ + if (plus_format) + { + pr_plus_format (os, c); + } + else + { + set_format (c); + if (free_format) + os << c; + else + pr_complex (os, c); + } +} + +void +octave_print_internal (std::ostream& os, const ComplexMatrix& cm, + bool pr_as_read_syntax, int extra_indent) +{ + octave_idx_type nr = cm.rows (); + octave_idx_type nc = cm.columns (); + + if (nr == 0 || nc == 0) + print_empty_matrix (os, nr, nc, pr_as_read_syntax); + else if (plus_format && ! pr_as_read_syntax) + { + for (octave_idx_type i = 0; i < nr; i++) + { + for (octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + + pr_plus_format (os, cm(i,j)); + } + + if (i < nr - 1) + os << "\n"; + } + } + else + { + int r_fw, i_fw; + double scale = 1.0; + set_format (cm, r_fw, i_fw, scale); + int column_width = i_fw + r_fw; + column_width += (rat_format || bank_format || hex_format + || bit_format) ? 2 : 7; + octave_idx_type total_width = nc * column_width; + octave_idx_type max_width = command_editor::terminal_cols (); + + if (pr_as_read_syntax) + max_width -= 4; + else + max_width -= extra_indent; + + if (max_width < 0) + max_width = 0; + + if (free_format) + { + if (pr_as_read_syntax) + os << "[\n"; + + os << cm; + + if (pr_as_read_syntax) + os << "]"; + + return; + } + + octave_idx_type inc = nc; + if (total_width > max_width && Vsplit_long_rows) + { + inc = max_width / column_width; + if (inc == 0) + inc++; + } + + if (pr_as_read_syntax) + { + for (octave_idx_type i = 0; i < nr; i++) + { + octave_idx_type col = 0; + while (col < nc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + if (i == 0 && j == 0) + os << "[ "; + else + { + if (j > col && j < lim) + os << ", "; + else + os << " "; + } + + pr_complex (os, cm(i,j)); + } + + col += inc; + + if (col >= nc) + { + if (i == nr - 1) + os << " ]"; + else + os << ";\n"; + } + else + os << " ...\n"; + } + } + } + else + { + pr_scale_header (os, scale); + + for (octave_idx_type col = 0; col < nc; col += inc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + pr_col_num_header (os, total_width, max_width, lim, col, + extra_indent); + + for (octave_idx_type i = 0; i < nr; i++) + { + os << std::setw (extra_indent) << ""; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + os << " "; + + pr_complex (os, cm(i,j), r_fw, i_fw, scale); + } + + if (i < nr - 1) + os << "\n"; + } + } + } + } +} + +void +octave_print_internal (std::ostream& os, const ComplexDiagMatrix& cm, + bool pr_as_read_syntax, int extra_indent) +{ + octave_idx_type nr = cm.rows (); + octave_idx_type nc = cm.columns (); + + if (nr == 0 || nc == 0) + print_empty_matrix (os, nr, nc, pr_as_read_syntax); + else if (plus_format && ! pr_as_read_syntax) + { + for (octave_idx_type i = 0; i < nr; i++) + { + for (octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + + pr_plus_format (os, cm(i,j)); + } + + if (i < nr - 1) + os << "\n"; + } + } + else + { + int r_fw, i_fw; + double scale = 1.0; + set_format (ComplexMatrix (cm.diag ()), r_fw, i_fw, scale); + int column_width = i_fw + r_fw; + column_width += (rat_format || bank_format || hex_format + || bit_format) ? 2 : 7; + octave_idx_type total_width = nc * column_width; + octave_idx_type max_width = command_editor::terminal_cols (); + + if (pr_as_read_syntax) + max_width -= 4; + else + max_width -= extra_indent; + + if (max_width < 0) + max_width = 0; + + if (free_format) + { + if (pr_as_read_syntax) + os << "[\n"; + + os << ComplexMatrix (cm); + + if (pr_as_read_syntax) + os << "]"; + + return; + } + + octave_idx_type inc = nc; + if (total_width > max_width && Vsplit_long_rows) + { + inc = max_width / column_width; + if (inc == 0) + inc++; + } + + if (pr_as_read_syntax) + { + os << "diag ("; + + octave_idx_type col = 0; + while (col < nc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + if (j == 0) + os << "[ "; + else + { + if (j > col && j < lim) + os << ", "; + else + os << " "; + } + + pr_complex (os, cm(j,j)); + } + + col += inc; + + if (col >= nc) + os << " ]"; + else + os << " ...\n"; + } + os << ")"; + } + else + { + os << "Diagonal Matrix\n"; + if (! Vcompact_format) + os << "\n"; + + pr_scale_header (os, scale); + + // kluge. Get the true width of a number. + int zero_fw; + + { + std::ostringstream tmp_oss; + pr_complex (tmp_oss, Complex (0.0), r_fw, i_fw, scale); + zero_fw = tmp_oss.str ().length (); + } + + for (octave_idx_type col = 0; col < nc; col += inc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + pr_col_num_header (os, total_width, max_width, lim, col, + extra_indent); + + for (octave_idx_type i = 0; i < nr; i++) + { + os << std::setw (extra_indent) << ""; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + os << " "; + + if (i == j) + pr_complex (os, cm(i,j), r_fw, i_fw, scale); + else + os << std::setw (zero_fw) << '0'; + } + + if (i < nr - 1) + os << "\n"; + } + } + } + } +} + +void +octave_print_internal (std::ostream& os, const PermMatrix& m, + bool pr_as_read_syntax, int extra_indent) +{ + octave_idx_type nr = m.rows (); + octave_idx_type nc = m.columns (); + + if (nr == 0 || nc == 0) + print_empty_matrix (os, nr, nc, pr_as_read_syntax); + else if (plus_format && ! pr_as_read_syntax) + { + for (octave_idx_type i = 0; i < nr; i++) + { + for (octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + + pr_plus_format (os, m(i,j)); + } + + if (i < nr - 1) + os << "\n"; + } + } + else + { + int fw = 2; + int column_width = fw + 2; + octave_idx_type total_width = nc * column_width; + octave_idx_type max_width = command_editor::terminal_cols (); + + if (pr_as_read_syntax) + max_width -= 4; + else + max_width -= extra_indent; + + if (max_width < 0) + max_width = 0; + + if (free_format) + { + if (pr_as_read_syntax) + os << "[\n"; + + os << Matrix (m); + + if (pr_as_read_syntax) + os << "]"; + + return; + } + + octave_idx_type inc = nc; + if (total_width > max_width && Vsplit_long_rows) + { + inc = max_width / column_width; + if (inc == 0) + inc++; + } + + if (pr_as_read_syntax) + { + Array pvec = m.pvec (); + bool colp = m.is_col_perm (); + + os << "eye ("; + if (colp) os << ":, "; + + octave_idx_type col = 0; + while (col < nc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + if (j == 0) + os << "[ "; + else + { + if (j > col && j < lim) + os << ", "; + else + os << " "; + } + + os << pvec (j); + } + + col += inc; + + if (col >= nc) + os << " ]"; + else + os << " ...\n"; + } + if (! colp) os << ", :"; + os << ")"; + } + else + { + os << "Permutation Matrix\n"; + if (! Vcompact_format) + os << "\n"; + + for (octave_idx_type col = 0; col < nc; col += inc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + pr_col_num_header (os, total_width, max_width, lim, col, + extra_indent); + + for (octave_idx_type i = 0; i < nr; i++) + { + os << std::setw (extra_indent) << ""; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + os << " "; + + os << std::setw (fw) << m(i,j); + } + + if (i < nr - 1) + os << "\n"; + } + } + } + } +} + +void +octave_print_internal (std::ostream& os, const ComplexNDArray& nda, + bool pr_as_read_syntax, int extra_indent) +{ + switch (nda.ndims ()) + { + case 1: + case 2: + octave_print_internal (os, nda.matrix_value (), + pr_as_read_syntax, extra_indent); + break; + + default: + print_nd_array (os, nda, pr_as_read_syntax); + break; + } +} + +void +octave_print_internal (std::ostream& os, bool d, bool pr_as_read_syntax) +{ + octave_print_internal (os, double (d), pr_as_read_syntax); +} + +// FIXME -- write single precision versions of the printing functions. + +void +octave_print_internal (std::ostream& os, float d, bool pr_as_read_syntax) +{ + octave_print_internal (os, double (d), pr_as_read_syntax); +} + +void +octave_print_internal (std::ostream& os, const FloatMatrix& m, + bool pr_as_read_syntax, int extra_indent) +{ + octave_print_internal (os, Matrix (m), pr_as_read_syntax, extra_indent); +} + +void +octave_print_internal (std::ostream& os, const FloatDiagMatrix& m, + bool pr_as_read_syntax, int extra_indent) +{ + octave_print_internal (os, DiagMatrix (m), pr_as_read_syntax, extra_indent); +} + +void +octave_print_internal (std::ostream& os, const FloatNDArray& nda, + bool pr_as_read_syntax, int extra_indent) +{ + octave_print_internal (os, NDArray (nda), pr_as_read_syntax, extra_indent); +} + +void +octave_print_internal (std::ostream& os, const FloatComplex& c, + bool pr_as_read_syntax) +{ + octave_print_internal (os, Complex (c), pr_as_read_syntax); +} + +void +octave_print_internal (std::ostream& os, const FloatComplexMatrix& cm, + bool pr_as_read_syntax, int extra_indent) +{ + octave_print_internal (os, ComplexMatrix (cm), pr_as_read_syntax, extra_indent); +} + +void +octave_print_internal (std::ostream& os, const FloatComplexDiagMatrix& cm, + bool pr_as_read_syntax, int extra_indent) +{ + octave_print_internal (os, ComplexDiagMatrix (cm), pr_as_read_syntax, extra_indent); +} + +void +octave_print_internal (std::ostream& os, const FloatComplexNDArray& nda, + bool pr_as_read_syntax, int extra_indent) +{ + octave_print_internal (os, ComplexNDArray (nda), pr_as_read_syntax, extra_indent); +} + +void +octave_print_internal (std::ostream& os, const Range& r, + bool pr_as_read_syntax, int extra_indent) +{ + double base = r.base (); + double increment = r.inc (); + double limit = r.limit (); + octave_idx_type num_elem = r.nelem (); + + if (plus_format && ! pr_as_read_syntax) + { + for (octave_idx_type i = 0; i < num_elem; i++) + { + octave_quit (); + + double val = base + i * increment; + + pr_plus_format (os, val); + } + } + else + { + int fw = 0; + double scale = 1.0; + set_format (r, fw, scale); + + if (pr_as_read_syntax) + { + if (free_format) + { + os << base << " : "; + if (increment != 1.0) + os << increment << " : "; + os << limit; + } + else + { + pr_float (os, base, fw); + os << " : "; + if (increment != 1.0) + { + pr_float (os, increment, fw); + os << " : "; + } + pr_float (os, limit, fw); + } + } + else + { + int column_width = fw + 2; + octave_idx_type total_width = num_elem * column_width; + octave_idx_type max_width = command_editor::terminal_cols (); + + if (free_format) + { + os << r; + return; + } + + octave_idx_type inc = num_elem; + if (total_width > max_width && Vsplit_long_rows) + { + inc = max_width / column_width; + if (inc == 0) + inc++; + } + + max_width -= extra_indent; + + if (max_width < 0) + max_width = 0; + + pr_scale_header (os, scale); + + octave_idx_type col = 0; + while (col < num_elem) + { + octave_idx_type lim = col + inc < num_elem ? col + inc : num_elem; + + pr_col_num_header (os, total_width, max_width, lim, col, + extra_indent); + + os << std::setw (extra_indent) << ""; + + for (octave_idx_type i = col; i < lim; i++) + { + octave_quit (); + + double val; + if (i == 0) + val = base; + else + val = base + i * increment; + + if (i == num_elem - 1) + { + // See the comments in Range::matrix_value. + if ((increment > 0 && val >= limit) + || (increment < 0 && val <= limit)) + val = limit; + } + + os << " "; + + pr_float (os, val, fw, scale); + } + + col += inc; + } + } + } +} + +void +octave_print_internal (std::ostream& os, const boolMatrix& bm, + bool pr_as_read_syntax, + int extra_indent) +{ + Matrix tmp (bm); + octave_print_internal (os, tmp, pr_as_read_syntax, extra_indent); +} + +void +octave_print_internal (std::ostream& os, const boolNDArray& nda, + bool pr_as_read_syntax, + int extra_indent) +{ + switch (nda.ndims ()) + { + case 1: + case 2: + octave_print_internal (os, nda.matrix_value (), + pr_as_read_syntax, extra_indent); + break; + + default: + print_nd_array (os, nda, pr_as_read_syntax); + break; + } +} + +void +octave_print_internal (std::ostream& os, const charMatrix& chm, + bool pr_as_read_syntax, + int /* extra_indent FIXME */, + bool pr_as_string) +{ + if (pr_as_string) + { + octave_idx_type nstr = chm.rows (); + + if (pr_as_read_syntax && nstr > 1) + os << "[ "; + + if (nstr != 0) + { + for (octave_idx_type i = 0; i < nstr; i++) + { + octave_quit (); + + std::string row = chm.row_as_string (i); + + if (pr_as_read_syntax) + { + os << "\"" << undo_string_escapes (row) << "\""; + + if (i < nstr - 1) + os << "; "; + } + else + { + os << row; + + if (i < nstr - 1) + os << "\n"; + } + } + } + + if (pr_as_read_syntax && nstr > 1) + os << " ]"; + } + else + { + os << "sorry, printing char matrices not implemented yet\n"; + } +} + +void +octave_print_internal (std::ostream& os, const charNDArray& nda, + bool pr_as_read_syntax, int extra_indent, + bool pr_as_string) +{ + switch (nda.ndims ()) + { + case 1: + case 2: + octave_print_internal (os, nda.matrix_value (), + pr_as_read_syntax, extra_indent, pr_as_string); + break; + + default: + print_nd_array (os, nda, pr_as_read_syntax); + break; + } +} + +void +octave_print_internal (std::ostream& os, const std::string& s, + bool pr_as_read_syntax, int extra_indent) +{ + Array nda (dim_vector (1, 1), s); + + octave_print_internal (os, nda, pr_as_read_syntax, extra_indent); +} + +void +octave_print_internal (std::ostream& os, const Array& nda, + bool pr_as_read_syntax, int /* extra_indent */) +{ + // FIXME -- this mostly duplicates the code in the print_nd_array<> + // function. Can fix this with std::is_same from C++11. + + if (nda.is_empty ()) + print_empty_nd_array (os, nda.dims (), pr_as_read_syntax); + else if (nda.length () == 1) + { + os << nda(0); + } + else + { + int ndims = nda.ndims (); + + dim_vector dims = nda.dims (); + + Array ra_idx (dim_vector (ndims, 1), 0); + + octave_idx_type m = 1; + + for (int i = 2; i < ndims; i++) + m *= dims(i); + + octave_idx_type nr = dims(0); + octave_idx_type nc = dims(1); + + for (octave_idx_type i = 0; i < m; i++) + { + std::string nm = "ans"; + + if (m > 1) + { + nm += "(:,:,"; + + std::ostringstream buf; + + for (int k = 2; k < ndims; k++) + { + buf << ra_idx(k) + 1; + + if (k < ndims - 1) + buf << ","; + else + buf << ")"; + } + + nm += buf.str (); + } + + Array idx (dim_vector (ndims, 1)); + + idx(0) = idx_vector (':'); + idx(1) = idx_vector (':'); + + for (int k = 2; k < ndims; k++) + idx(k) = idx_vector (ra_idx(k)); + + Array page (nda.index (idx), dim_vector (nr, nc)); + + // FIXME -- need to do some more work to put these + // in neatly aligned columns... + + octave_idx_type n_rows = page.rows (); + octave_idx_type n_cols = page.cols (); + + os << nm << " =\n"; + if (! Vcompact_format) + os << "\n"; + + for (octave_idx_type ii = 0; ii < n_rows; ii++) + { + for (octave_idx_type jj = 0; jj < n_cols; jj++) + os << " " << page(ii,jj); + + os << "\n"; + } + + if (i < m - 1) + os << "\n"; + + if (i < m) + increment_index (ra_idx, dims, 2); + } + } +} + +template +class +octave_print_conv +{ +public: + typedef T print_conv_type; +}; + +#define PRINT_CONV(T1, T2) \ + template <> \ + class \ + octave_print_conv \ + { \ + public: \ + typedef T2 print_conv_type; \ + } + +PRINT_CONV (octave_int8, octave_int16); +PRINT_CONV (octave_uint8, octave_uint16); + +#undef PRINT_CONV + +template +/* static */ inline void +pr_int (std::ostream& os, const T& d, int fw = 0) +{ + size_t sz = d.byte_size (); + const unsigned char * tmpi = d.iptr (); + + // Unless explicitly asked for, always print in big-endian + // format for hex and bit formats. + // + // {bit,hex}_format == 1: print big-endian + // {bit,hex}_format == 2: print native + + if (hex_format) + { + char ofill = os.fill ('0'); + + std::ios::fmtflags oflags + = os.flags (std::ios::right | std::ios::hex); + + if (hex_format > 1 || oct_mach_info::words_big_endian ()) + { + for (size_t i = 0; i < sz; i++) + os << std::setw (2) << static_cast (tmpi[i]); + } + else + { + for (int i = sz - 1; i >= 0; i--) + os << std::setw (2) << static_cast (tmpi[i]); + } + + os.fill (ofill); + os.setf (oflags); + } + else if (bit_format) + { + if (oct_mach_info::words_big_endian ()) + { + for (size_t i = 0; i < sz; i++) + PRINT_CHAR_BITS (os, tmpi[i]); + } + else + { + if (bit_format > 1) + { + for (size_t i = 0; i < sz; i++) + PRINT_CHAR_BITS_SWAPPED (os, tmpi[i]); + } + else + { + for (int i = sz - 1; i >= 0; i--) + PRINT_CHAR_BITS (os, tmpi[i]); + } + } + } + else + { + os << std::setw (fw) + << typename octave_print_conv::print_conv_type (d); + + if (bank_format) + os << ".00"; + } +} + +// FIXME -- all this mess with abs is an attempt to avoid seeing +// +// warning: comparison of unsigned expression < 0 is always false +// +// from GCC. Isn't there a better way + +template +/* static */ inline T +abs (T x) +{ + return x < 0 ? -x : x; +} + +#define INSTANTIATE_ABS(T) \ + template /* static */ T abs (T) + +INSTANTIATE_ABS(signed char); +INSTANTIATE_ABS(short); +INSTANTIATE_ABS(int); +INSTANTIATE_ABS(long); +INSTANTIATE_ABS(long long); + +#define SPECIALIZE_UABS(T) \ + template <> \ + /* static */ inline unsigned T \ + abs (unsigned T x) \ + { \ + return x; \ + } + +SPECIALIZE_UABS(char) +SPECIALIZE_UABS(short) +SPECIALIZE_UABS(int) +SPECIALIZE_UABS(long) +SPECIALIZE_UABS(long long) + +template void +pr_int (std::ostream&, const octave_int8&, int); + +template void +pr_int (std::ostream&, const octave_int16&, int); + +template void +pr_int (std::ostream&, const octave_int32&, int); + +template void +pr_int (std::ostream&, const octave_int64&, int); + +template void +pr_int (std::ostream&, const octave_uint8&, int); + +template void +pr_int (std::ostream&, const octave_uint16&, int); + +template void +pr_int (std::ostream&, const octave_uint32&, int); + +template void +pr_int (std::ostream&, const octave_uint64&, int); + +template +void +octave_print_internal_template (std::ostream& os, const octave_int& val, + bool) +{ + if (plus_format) + { + pr_plus_format (os, val); + } + else + { + if (free_format) + os << typename octave_print_conv >::print_conv_type (val); + else + pr_int (os, val); + } +} + +#define PRINT_INT_SCALAR_INTERNAL(TYPE) \ + OCTINTERP_API void \ + octave_print_internal (std::ostream& os, const octave_int& val, bool dummy) \ + { \ + octave_print_internal_template (os, val, dummy); \ + } + +PRINT_INT_SCALAR_INTERNAL (int8_t) +PRINT_INT_SCALAR_INTERNAL (uint8_t) +PRINT_INT_SCALAR_INTERNAL (int16_t) +PRINT_INT_SCALAR_INTERNAL (uint16_t) +PRINT_INT_SCALAR_INTERNAL (int32_t) +PRINT_INT_SCALAR_INTERNAL (uint32_t) +PRINT_INT_SCALAR_INTERNAL (int64_t) +PRINT_INT_SCALAR_INTERNAL (uint64_t) + +template +/* static */ inline void +octave_print_internal_template (std::ostream& os, const intNDArray& nda, + bool pr_as_read_syntax, int extra_indent) +{ + // FIXME -- this mostly duplicates the code in the print_nd_array<> + // function. Can fix this with std::is_same from C++11. + + if (nda.is_empty ()) + print_empty_nd_array (os, nda.dims (), pr_as_read_syntax); + else if (nda.length () == 1) + octave_print_internal_template (os, nda(0), pr_as_read_syntax); + else if (plus_format && ! pr_as_read_syntax) + { + int ndims = nda.ndims (); + + Array ra_idx (dim_vector (ndims, 1), 0); + + dim_vector dims = nda.dims (); + + octave_idx_type m = 1; + + for (int i = 2; i < ndims; i++) + m *= dims(i); + + octave_idx_type nr = dims(0); + octave_idx_type nc = dims(1); + + for (octave_idx_type i = 0; i < m; i++) + { + if (m > 1) + { + std::string nm = "ans(:,:,"; + + std::ostringstream buf; + + for (int k = 2; k < ndims; k++) + { + buf << ra_idx(k) + 1; + + if (k < ndims - 1) + buf << ","; + else + buf << ")"; + } + + nm += buf.str (); + + os << nm << " =\n"; + if (! Vcompact_format) + os << "\n"; + } + + Array idx (dim_vector (ndims, 1)); + + idx(0) = idx_vector (':'); + idx(1) = idx_vector (':'); + + for (int k = 2; k < ndims; k++) + idx(k) = idx_vector (ra_idx(k)); + + Array page (nda.index (idx), dim_vector (nr, nc)); + + for (octave_idx_type ii = 0; ii < nr; ii++) + { + for (octave_idx_type jj = 0; jj < nc; jj++) + { + octave_quit (); + + pr_plus_format (os, page(ii,jj)); + } + + if ((ii < nr - 1) || (i < m -1)) + os << "\n"; + } + + if (i < m - 1) + { + os << "\n"; + increment_index (ra_idx, dims, 2); + } + } + } + else + { + int ndims = nda.ndims (); + + dim_vector dims = nda.dims (); + + Array ra_idx (dim_vector (ndims, 1), 0); + + octave_idx_type m = 1; + + for (int i = 2; i < ndims; i++) + m *= dims(i); + + octave_idx_type nr = dims(0); + octave_idx_type nc = dims(1); + + int fw = 0; + if (hex_format) + fw = 2 * nda(0).byte_size (); + else if (bit_format) + fw = nda(0).nbits (); + else + { + bool isneg = false; + int digits = 0; + + for (octave_idx_type i = 0; i < dims.numel (); i++) + { + int new_digits = static_cast + (gnulib::floor (log10 (double (abs (nda(i).value ()))) + 1.0)); + + if (new_digits > digits) + digits = new_digits; + + if (! isneg) + isneg = (abs (nda(i).value ()) != nda(i).value ()); + } + + fw = digits + isneg; + } + + int column_width = fw + (rat_format ? 0 : (bank_format ? 5 : 2)); + octave_idx_type total_width = nc * column_width; + int max_width = command_editor::terminal_cols () - extra_indent; + octave_idx_type inc = nc; + if (total_width > max_width && Vsplit_long_rows) + { + inc = max_width / column_width; + if (inc == 0) + inc++; + } + + for (octave_idx_type i = 0; i < m; i++) + { + if (m > 1) + { + std::string nm = "ans(:,:,"; + + std::ostringstream buf; + + for (int k = 2; k < ndims; k++) + { + buf << ra_idx(k) + 1; + + if (k < ndims - 1) + buf << ","; + else + buf << ")"; + } + + nm += buf.str (); + + os << nm << " =\n"; + if (! Vcompact_format) + os << "\n"; + } + + Array idx (dim_vector (ndims, 1)); + + idx(0) = idx_vector (':'); + idx(1) = idx_vector (':'); + + for (int k = 2; k < ndims; k++) + idx(k) = idx_vector (ra_idx(k)); + + Array page (nda.index (idx), dim_vector (nr, nc)); + + if (free_format) + { + if (pr_as_read_syntax) + os << "[\n"; + + for (octave_idx_type ii = 0; ii < nr; ii++) + { + for (octave_idx_type jj = 0; jj < nc; jj++) + { + octave_quit (); + os << " "; + os << typename octave_print_conv::print_conv_type (page(ii,jj)); + } + os << "\n"; + } + + if (pr_as_read_syntax) + os << "]"; + } + else + { + octave_idx_type n_rows = page.rows (); + octave_idx_type n_cols = page.cols (); + + for (octave_idx_type col = 0; col < n_cols; col += inc) + { + octave_idx_type lim = col + inc < n_cols ? col + inc : n_cols; + + pr_col_num_header (os, total_width, max_width, lim, col, + extra_indent); + + for (octave_idx_type ii = 0; ii < n_rows; ii++) + { + os << std::setw (extra_indent) << ""; + + for (octave_idx_type jj = col; jj < lim; jj++) + { + octave_quit (); + os << " "; + pr_int (os, page(ii,jj), fw); + } + if ((ii < n_rows - 1) || (i < m -1)) + os << "\n"; + } + } + } + + if (i < m - 1) + { + os << "\n"; + increment_index (ra_idx, dims, 2); + } + } + } +} + +#define PRINT_INT_ARRAY_INTERNAL(TYPE) \ + OCTINTERP_API void \ + octave_print_internal (std::ostream& os, const intNDArray& nda, \ + bool pr_as_read_syntax, int extra_indent) \ + { \ + octave_print_internal_template (os, nda, pr_as_read_syntax, extra_indent); \ + } + +PRINT_INT_ARRAY_INTERNAL (octave_int8) +PRINT_INT_ARRAY_INTERNAL (octave_uint8) +PRINT_INT_ARRAY_INTERNAL (octave_int16) +PRINT_INT_ARRAY_INTERNAL (octave_uint16) +PRINT_INT_ARRAY_INTERNAL (octave_int32) +PRINT_INT_ARRAY_INTERNAL (octave_uint32) +PRINT_INT_ARRAY_INTERNAL (octave_int64) +PRINT_INT_ARRAY_INTERNAL (octave_uint64) + +void +octave_print_internal (std::ostream&, const Cell&, bool, int, bool) +{ + panic_impossible (); +} + +DEFUN (rats, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} rats (@var{x}, @var{len})\n\ +Convert @var{x} into a rational approximation represented as a string.\n\ +You can convert the string back into a matrix as follows:\n\ +\n\ +@example\n\ +@group\n\ +r = rats (hilb (4));\n\ +x = str2num (r)\n\ +@end group\n\ +@end example\n\ +\n\ +The optional second argument defines the maximum length of the string\n\ +representing the elements of @var{x}. By default @var{len} is 9.\n\ +@seealso{format, rat}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin < 1 || nargin > 2 || nargout > 1) + print_usage (); + else + { + unwind_protect frame; + + frame.protect_var (rat_string_len); + + rat_string_len = 9; + + if (nargin == 2) + rat_string_len = args(1).nint_value (); + + if (! error_state) + { + octave_value arg = args(0); + + if (arg.is_numeric_type ()) + { + frame.protect_var (rat_format); + + rat_format = true; + + std::ostringstream buf; + args(0).print (buf); + std::string s = buf.str (); + + std::list lst; + + size_t n = 0; + size_t s_len = s.length (); + + while (n < s_len) + { + size_t m = s.find ('\n', n); + + if (m == std::string::npos) + { + lst.push_back (s.substr (n)); + break; + } + else + { + lst.push_back (s.substr (n, m - n)); + n = m + 1; + } + } + + retval = string_vector (lst); + } + else + error ("rats: X must be numeric"); + } + } + + return retval; +} + +DEFUN (disp, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} disp (@var{x})\n\ +Display the value of @var{x}. For example:\n\ +\n\ +@example\n\ +@group\n\ +disp (\"The value of pi is:\"), disp (pi)\n\ +\n\ + @print{} the value of pi is:\n\ + @print{} 3.1416\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +Note that the output from @code{disp} always ends with a newline.\n\ +\n\ +If an output value is requested, @code{disp} prints nothing and\n\ +returns the formatted output in a string.\n\ +@seealso{fdisp}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 1 && nargout < 2) + { + if (nargout == 0) + args(0).print (octave_stdout); + else + { + octave_value arg = args(0); + std::ostringstream buf; + arg.print (buf); + retval = octave_value (buf.str (), arg.is_dq_string () ? '"' : '\''); + } + } + else + print_usage (); + + return retval; +} + +DEFUN (fdisp, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} fdisp (@var{fid}, @var{x})\n\ +Display the value of @var{x} on the stream @var{fid}. For example:\n\ +\n\ +@example\n\ +@group\n\ +fdisp (stdout, \"The value of pi is:\"), fdisp (stdout, pi)\n\ +\n\ + @print{} the value of pi is:\n\ + @print{} 3.1416\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +Note that the output from @code{fdisp} always ends with a newline.\n\ +@seealso{disp}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 2) + { + int fid = octave_stream_list::get_file_number (args (0)); + + octave_stream os = octave_stream_list::lookup (fid, "fdisp"); + + if (! error_state) + { + std::ostream *osp = os.output_stream (); + + if (osp) + args(1).print (*osp); + else + error ("fdisp: stream FID not open for writing"); + } + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! format short +%! fd = tmpfile (); +%! for r = [0, Inf -Inf, NaN] +%! for i = [0, Inf -Inf, NaN] +%! fdisp (fd, complex (r, i)); +%! endfor +%! endfor +%! fclose (fd); + +%!test +%! foo.real = pi * ones (3,20,3); +%! foo.complex = pi * ones (3,20,3) + 1i; +%! foo.char = repmat ("- Hello World -", [3, 20]); +%! foo.cell = {foo.real, foo.complex, foo.char}; +%! fields = fieldnames (foo); +%! for f = 1:numel (fields) +%! format loose; +%! loose = disp (foo.(fields{f})); +%! format compact; +%! compact = disp (foo.(fields{f})); +%! expected = strrep (loose, "\n\n", "\n"); +%! assert (expected, compact); +%! endfor +*/ + +static void +init_format_state (void) +{ + free_format = false; + plus_format = false; + rat_format = false; + bank_format = false; + hex_format = 0; + bit_format = 0; + Vcompact_format = false; + print_e = false; + print_big_e = false; + print_g = false; + print_eng = false; +} + +static void +set_output_prec_and_fw (int prec, int fw) +{ + Voutput_precision = prec; + Voutput_max_field_width = fw; +} + +static void +set_format_style (int argc, const string_vector& argv) +{ + int idx = 1; + + if (--argc > 0) + { + std::string arg = argv[idx++]; + + if (arg == "short") + { + if (--argc > 0) + { + arg = argv[idx++]; + + if (arg == "e") + { + init_format_state (); + print_e = true; + } + else if (arg == "E") + { + init_format_state (); + print_e = true; + print_big_e = true; + } + else if (arg == "g") + { + init_format_state (); + print_g = true; + } + else if (arg == "G") + { + init_format_state (); + print_g = true; + print_big_e = true; + } + else if (arg == "eng") + { + init_format_state (); + print_eng = true; + } + else + { + error ("format: unrecognized option 'short %s'", + arg.c_str ()); + return; + } + } + else + init_format_state (); + + set_output_prec_and_fw (5, 10); + } + else if (arg == "long") + { + if (--argc > 0) + { + arg = argv[idx++]; + + if (arg == "e") + { + init_format_state (); + print_e = true; + } + else if (arg == "E") + { + init_format_state (); + print_e = true; + print_big_e = true; + } + else if (arg == "g") + { + init_format_state (); + print_g = true; + } + else if (arg == "G") + { + init_format_state (); + print_g = true; + print_big_e = true; + } + else if (arg == "eng") + { + init_format_state (); + print_eng = true; + } + else + { + error ("format: unrecognized option 'long %s'", + arg.c_str ()); + return; + } + } + else + init_format_state (); + + set_output_prec_and_fw (15, 20); + } + else if (arg == "hex") + { + init_format_state (); + hex_format = 1; + } + else if (arg == "native-hex") + { + init_format_state (); + hex_format = 2; + } + else if (arg == "bit") + { + init_format_state (); + bit_format = 1; + } + else if (arg == "native-bit") + { + init_format_state (); + bit_format = 2; + } + else if (arg == "+" || arg == "plus") + { + if (--argc > 0) + { + arg = argv[idx++]; + + if (arg.length () == 3) + plus_format_chars = arg; + else + { + error ("format: invalid option for plus format"); + return; + } + } + else + plus_format_chars = "+ "; + + init_format_state (); + plus_format = true; + } + else if (arg == "rat") + { + init_format_state (); + rat_format = true; + } + else if (arg == "bank") + { + init_format_state (); + bank_format = true; + } + else if (arg == "free") + { + init_format_state (); + free_format = true; + } + else if (arg == "none") + { + init_format_state (); + free_format = true; + } + else if (arg == "compact") + { + Vcompact_format = true; + } + else if (arg == "loose") + { + Vcompact_format = false; + } + else + error ("format: unrecognized format state '%s'", arg.c_str ()); + } + else + { + init_format_state (); + set_output_prec_and_fw (5, 10); + } +} + +DEFUN (format, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} format\n\ +@deftypefnx {Command} {} format options\n\ +Reset or specify the format of the output produced by @code{disp} and\n\ +Octave's normal echoing mechanism. This command only affects the display\n\ +of numbers but not how they are stored or computed. To change the internal\n\ +representation from the default double use one of the conversion functions\n\ +such as @code{single}, @code{uint8}, @code{int64}, etc.\n\ +\n\ +By default, Octave displays 5 significant digits in a human readable form\n\ +(option @samp{short} paired with @samp{loose} format for matrices).\n\ +If @code{format} is invoked without any options, this default format\n\ +is restored.\n\ +\n\ +Valid formats for floating point numbers are listed in the following\n\ +table.\n\ +\n\ +@table @code\n\ +@item short\n\ +Fixed point format with 5 significant figures in a field that is a maximum\n\ +of 10 characters wide. (default).\n\ +\n\ +If Octave is unable to format a matrix so that columns line up on the\n\ +decimal point and all numbers fit within the maximum field width then\n\ +it switches to an exponential @samp{e} format.\n\ +\n\ +@item long\n\ +Fixed point format with 15 significant figures in a field that is a maximum\n\ +of 20 characters wide.\n\ +\n\ +As with the @samp{short} format, Octave will switch to an exponential\n\ +@samp{e} format if it is unable to format a matrix properly using the\n\ +current format.\n\ +\n\ +@item short e\n\ +@itemx long e\n\ +Exponential format. The number to be represented is split between a mantissa\n\ +and an exponent (power of 10). The mantissa has 5 significant digits in the\n\ +short format and 15 digits in the long format.\n\ +For example, with the @samp{short e} format, @code{pi} is displayed as\n\ +@code{3.1416e+00}.\n\ +\n\ +@item short E\n\ +@itemx long E\n\ +Identical to @samp{short e} or @samp{long e} but displays an uppercase\n\ +@samp{E} to indicate the exponent.\n\ +For example, with the @samp{long E} format, @code{pi} is displayed as\n\ +@code{3.14159265358979E+00}.\n\ +\n\ +@item short g\n\ +@itemx long g\n\ +Optimally choose between fixed point and exponential format based on\n\ +the magnitude of the number.\n\ +For example, with the @samp{short g} format,\n\ +@code{pi .^ [2; 4; 8; 16; 32]} is displayed as\n\ +\n\ +@example\n\ +@group\n\ +ans =\n\ +\n\ + 9.8696\n\ + 97.409\n\ + 9488.5\n\ + 9.0032e+07\n\ + 8.1058e+15\n\ +@end group\n\ +@end example\n\ +\n\ +@item short eng\n\ +@itemx long eng\n\ +Identical to @samp{short e} or @samp{long e} but displays the value\n\ +using an engineering format, where the exponent is divisible by 3. For\n\ +example, with the @samp{short eng} format, @code{10 * pi} is displayed as\n\ +@code{31.4159e+00}.\n\ +\n\ +@item long G\n\ +@itemx short G\n\ +Identical to @samp{short g} or @samp{long g} but displays an uppercase\n\ +@samp{E} to indicate the exponent.\n\ +\n\ +@item free\n\ +@itemx none\n\ +Print output in free format, without trying to line up columns of\n\ +matrices on the decimal point. This also causes complex numbers to be\n\ +formatted as numeric pairs like this @samp{(0.60419, 0.60709)} instead\n\ +of like this @samp{0.60419 + 0.60709i}.\n\ +@end table\n\ +\n\ +The following formats affect all numeric output (floating point and\n\ +integer types).\n\ +\n\ +@table @code\n\ +@item +\n\ +@itemx + @var{chars}\n\ +@itemx plus\n\ +@itemx plus @var{chars}\n\ +Print a @samp{+} symbol for nonzero matrix elements and a space for zero\n\ +matrix elements. This format can be very useful for examining the\n\ +structure of a large sparse matrix.\n\ +\n\ +The optional argument @var{chars} specifies a list of 3 characters to use\n\ +for printing values greater than zero, less than zero and equal to zero.\n\ +For example, with the @samp{+ \"+-.\"} format, @code{[1, 0, -1; -1, 0, 1]}\n\ +is displayed as\n\ +\n\ +@example\n\ +@group\n\ +ans =\n\ +\n\ ++.-\n\ +-.+\n\ +@end group\n\ +@end example\n\ +\n\ +@item bank\n\ +Print in a fixed format with two digits to the right of the decimal\n\ +point.\n\ +\n\ +@item native-hex\n\ +Print the hexadecimal representation of numbers as they are stored in\n\ +memory. For example, on a workstation which stores 8 byte real values\n\ +in IEEE format with the least significant byte first, the value of\n\ +@code{pi} when printed in @code{native-hex} format is\n\ +@code{400921fb54442d18}.\n\ +\n\ +@item hex\n\ +The same as @code{native-hex}, but always print the most significant\n\ +byte first.\n\ +\n\ +@item native-bit\n\ +Print the bit representation of numbers as stored in memory.\n\ +For example, the value of @code{pi} is\n\ +\n\ +@example\n\ +@group\n\ +01000000000010010010000111111011\n\ +01010100010001000010110100011000\n\ +@end group\n\ +@end example\n\ +\n\ +(shown here in two 32 bit sections for typesetting purposes) when\n\ +printed in native-bit format on a workstation which stores 8 byte real values\n\ +in IEEE format with the least significant byte first.\n\ +\n\ +@item bit\n\ +The same as @code{native-bit}, but always print the most significant\n\ +bits first.\n\ +\n\ +@item rat\n\ +Print a rational approximation, i.e., values are approximated\n\ +as the ratio of small integers.\n\ +For example, with the @samp{rat} format,\n\ +@code{pi} is displayed as @code{355/113}.\n\ +@end table\n\ +\n\ +The following two options affect the display of all matrices.\n\ +\n\ +@table @code\n\ +@item compact\n\ +Remove blank lines around column number labels and between\n\ +matrices producing more compact output with more data per page.\n\ +\n\ +@item loose\n\ +Insert blank lines above and below column number labels and between matrices\n\ +to produce a more readable output with less data per page. (default).\n\ +@end table\n\ +@seealso{fixed_point_format, output_max_field_width, output_precision, split_long_rows, rats}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("format"); + + if (error_state) + return retval; + + set_format_style (argc, argv); + + return retval; +} + +DEFUN (fixed_point_format, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} fixed_point_format ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} fixed_point_format (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} fixed_point_format (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave will\n\ +use a scaled format to print matrix values such that the largest\n\ +element may be written with a single leading digit with the scaling\n\ +factor is printed on the first line of output. For example:\n\ +\n\ +@example\n\ +@group\n\ +octave:1> logspace (1, 7, 5)'\n\ +ans =\n\ +\n\ + 1.0e+07 *\n\ +\n\ + 0.00000\n\ + 0.00003\n\ + 0.00100\n\ + 0.03162\n\ + 1.00000\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +Notice that first value appears to be zero when it is actually 1. For\n\ +this reason, you should be careful when setting\n\ +@code{fixed_point_format} to a nonzero value.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{format, output_max_field_width, output_precision}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (fixed_point_format); +} + +DEFUN (print_empty_dimensions, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} print_empty_dimensions ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} print_empty_dimensions (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} print_empty_dimensions (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether the\n\ +dimensions of empty matrices are printed along with the empty matrix\n\ +symbol, @samp{[]}. For example, the expression\n\ +\n\ +@example\n\ +zeros (3, 0)\n\ +@end example\n\ +\n\ +@noindent\n\ +will print\n\ +\n\ +@example\n\ +ans = [](3x0)\n\ +@end example\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{format}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (print_empty_dimensions); +} + +DEFUN (split_long_rows, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} split_long_rows ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} split_long_rows (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} split_long_rows (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether rows of a matrix\n\ +may be split when displayed to a terminal window. If the rows are split,\n\ +Octave will display the matrix in a series of smaller pieces, each of\n\ +which can fit within the limits of your terminal width and each set of\n\ +rows is labeled so that you can easily see which columns are currently\n\ +being displayed. For example:\n\ +\n\ +@example\n\ +@group\n\ +octave:13> rand (2,10)\n\ +ans =\n\ +\n\ + Columns 1 through 6:\n\ +\n\ + 0.75883 0.93290 0.40064 0.43818 0.94958 0.16467\n\ + 0.75697 0.51942 0.40031 0.61784 0.92309 0.40201\n\ +\n\ + Columns 7 through 10:\n\ +\n\ + 0.90174 0.11854 0.72313 0.73326\n\ + 0.44672 0.94303 0.56564 0.82150\n\ +@end group\n\ +@end example\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{format}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (split_long_rows); +} + +DEFUN (output_max_field_width, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} output_max_field_width ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} output_max_field_width (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} output_max_field_width (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the maximum width\n\ +of a numeric output field.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{format, fixed_point_format, output_precision}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE_WITH_LIMITS (output_max_field_width, 0, + std::numeric_limits::max ()); +} + +DEFUN (output_precision, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} output_precision ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} output_precision (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} output_precision (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the minimum number of\n\ +significant figures to display for numeric output.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{format, fixed_point_format, output_max_field_width}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE_WITH_LIMITS (output_precision, -1, + std::numeric_limits::max ()); +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/pr-output.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/pr-output.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,262 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_pr_output_h) +#define octave_pr_output_h 1 + +#include + +#include "oct-cmplx.h" + +template class Array; +class ComplexMatrix; +class FloatComplexMatrix; +class ComplexDiagMatrix; +class FloatComplexDiagMatrix; +class ComplexNDArray; +class FloatComplexNDArray; +class Matrix; +class FloatMatrix; +class DiagMatrix; +class FloatDiagMatrix; +class NDArray; +class FloatNDArray; +class Range; +class boolMatrix; +class boolNDArray; +class charMatrix; +class charNDArray; +class PermMatrix; +class Cell; + +#include "intNDArray.h" +#include "oct-inttypes.h" + + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, bool d, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, double d, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, float d, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const Matrix& m, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const DiagMatrix& m, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const FloatMatrix& m, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const FloatDiagMatrix& m, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const NDArray& nda, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const FloatNDArray& nda, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const Complex& c, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const FloatComplex& c, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const ComplexMatrix& cm, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const ComplexDiagMatrix& cm, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const FloatComplexMatrix& cm, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const FloatComplexDiagMatrix& cm, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const ComplexNDArray& nda, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const FloatComplexNDArray& nda, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const PermMatrix& m, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const Range& r, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const boolMatrix& m, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const boolNDArray& m, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const charMatrix& chm, + bool pr_as_read_syntax = false, + int extra_indent = 0, + bool pr_as_string = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const charNDArray& nda, + bool pr_as_read_syntax = false, + int extra_indent = 0, + bool pr_as_string = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const std::string& s, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const Array& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const intNDArray& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const intNDArray& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const intNDArray& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const intNDArray& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const intNDArray& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const intNDArray& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const intNDArray& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const intNDArray& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const octave_int& sa, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const octave_int& sa, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const octave_int& sa, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const octave_int& sa, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const octave_int& sa, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const octave_int& sa, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const octave_int& sa, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const octave_int& sa, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const Cell& cell, + bool pr_as_read_syntax = false, + int extra_indent = 0, + bool pr_as_string = false); + +// TRUE means that the dimensions of empty objects should be printed +// like this: x = [](2x0). +extern bool Vprint_empty_dimensions; + +// TRUE means don't put empty lines in output +extern bool Vcompact_format; + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/procstream.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/procstream.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,70 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "procstream.h" + +procstreambase::procstreambase (const std::string& command, int mode) +{ + pb_init (); + + if (! pb.open (command.c_str (), mode)) + std::ios::setstate (std::ios::badbit); +} + +procstreambase::procstreambase (const char *command, int mode) +{ + pb_init (); + + if (! pb.open (command, mode)) + std::ios::setstate (std::ios::badbit); +} + +void +procstreambase::open (const char *command, int mode) +{ + clear (); + + if (! pb.open (command, mode)) + std::ios::setstate (std::ios::badbit); +} + +int +procstreambase::close (void) +{ + int status = 0; + + if (is_open ()) + { + if (! pb.close ()) + std::ios::setstate (std::ios::failbit); + + status = pb.wait_status (); + } + + return status; +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/procstream.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/procstream.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,161 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_procstream_h) +#define octave_procstream_h 1 + +#include +#include + +#include + +#include "oct-procbuf.h" + +class +OCTINTERP_API +procstreambase : virtual public std::ios +{ +public: + + procstreambase (void) : pb () { pb_init (); } + + procstreambase (const std::string& name, int mode); + + procstreambase (const char *name, int mode); + + ~procstreambase (void) { close (); } + + void open (const std::string& name, int mode) + { open (name.c_str (), mode); } + + void open (const char *name, int mode); + + int is_open (void) const { return pb.is_open (); } + + int close (void); + + pid_t pid (void) const { return pb.pid (); } + + int file_number (void) const { return pb.file_number (); } + +private: + + octave_procbuf pb; + + void pb_init (void) { init (&pb); } + + procstreambase (const procstreambase&); + + procstreambase& operator = (const procstreambase&); +}; + +class +OCTINTERP_API +iprocstream : public std::istream, public procstreambase +// iprocstream : public procstreambase, public std::istream +{ +public: + + iprocstream (void) : std::istream (0), procstreambase () { } + + iprocstream (const std::string& name, int mode = std::ios::in) + : std::istream (0), procstreambase (name, mode) { } + + iprocstream (const char *name, int mode = std::ios::in) + : std::istream (0), procstreambase (name, mode) { } + + ~iprocstream (void) { } + + void open (const std::string& name, int mode = std::ios::in) + { procstreambase::open (name, mode); } + + void open (const char *name, int mode = std::ios::in) + { procstreambase::open (name, mode); } + +private: + + iprocstream (const iprocstream&); + + iprocstream& operator = (const iprocstream&); +}; + +class +OCTINTERP_API +oprocstream : public std::ostream, public procstreambase +// oprocstream : public procstreambase, public std::ostream +{ +public: + + oprocstream (void) : std::ostream (0), procstreambase () { } + + oprocstream (const std::string& name, int mode = std::ios::out) + : std::ostream (0), procstreambase (name, mode) { } + + oprocstream (const char *name, int mode = std::ios::out) + : std::ostream (0), procstreambase (name, mode) { } + + ~oprocstream (void) { } + + void open (const std::string& name, int mode = std::ios::out) + { procstreambase::open (name, mode); } + + void open (const char *name, int mode = std::ios::out) + { procstreambase::open (name, mode); } + +private: + + oprocstream (const oprocstream&); + + oprocstream& operator = (const oprocstream&); +}; + +class +OCTINTERP_API +procstream : public std::iostream, public procstreambase +// procstream : public procstreambase, public std::iostream +{ +public: + + procstream (void) : std::iostream (0), procstreambase () { } + + procstream (const std::string& name, int mode) + : std::iostream (0), procstreambase (name, mode) { } + + procstream (const char *name, int mode) + : std::iostream (0), procstreambase (name, mode) { } + + ~procstream (void) { } + + void open (const std::string& name, int mode) + { procstreambase::open (name, mode); } + + void open (const char *name, int mode) + { procstreambase::open (name, mode); } + +private: + + procstream (const procstream&); + + procstream& operator = (const procstream&); +}; + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/profiler.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/profiler.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,470 @@ +/* + +Copyright (C) 2012 Daniel Kraft + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "defun.h" +#include "oct-time.h" +#include "ov-struct.h" +#include "pager.h" +#include "profiler.h" + +profile_data_accumulator::enter::enter (profile_data_accumulator& a, + const std::string& f) + : acc (a) +{ + if (acc.is_active ()) + { + fcn = f; + acc.enter_function (fcn); + } + else + fcn = ""; +} + +profile_data_accumulator::enter::~enter () +{ + if (fcn != "") + acc.exit_function (fcn); +} + +profile_data_accumulator::stats::stats () + : time (0.0), calls (0), recursive (false), + parents (), children () +{} + +octave_value +profile_data_accumulator::stats::function_set_value (const function_set& list) +{ + const octave_idx_type n = list.size (); + + RowVector retval (n); + octave_idx_type i = 0; + for (function_set::const_iterator p = list.begin (); p != list.end (); ++p) + { + retval(i) = *p; + ++i; + } + assert (i == n); + + return retval; +} + +profile_data_accumulator::tree_node::tree_node (tree_node* p, octave_idx_type f) + : parent (p), fcn_id (f), children (), time (0.0), calls (0) +{} + +profile_data_accumulator::tree_node::~tree_node () +{ + for (child_map::iterator i = children.begin (); i != children.end (); ++i) + delete i->second; +} + +profile_data_accumulator::tree_node* +profile_data_accumulator::tree_node::enter (octave_idx_type fcn) +{ + tree_node* retval; + + child_map::iterator pos = children.find (fcn); + if (pos == children.end ()) + { + retval = new tree_node (this, fcn); + children[fcn] = retval; + } + else + retval = pos->second; + + ++retval->calls; + return retval; +} + +profile_data_accumulator::tree_node* +profile_data_accumulator::tree_node::exit (octave_idx_type fcn) +{ + assert (parent); + assert (fcn_id == fcn); + + return parent; +} + +void +profile_data_accumulator::tree_node::build_flat (flat_profile& data) const +{ + // If this is not the top-level node, update profile entry for this function. + if (fcn_id != 0) + { + stats& entry = data[fcn_id - 1]; + + entry.time += time; + entry.calls += calls; + + assert (parent); + if (parent->fcn_id != 0) + { + entry.parents.insert (parent->fcn_id); + data[parent->fcn_id - 1].children.insert (fcn_id); + } + + if (!entry.recursive) + for (const tree_node* i = parent; i; i = i->parent) + if (i->fcn_id == fcn_id) + { + entry.recursive = true; + break; + } + } + + // Recurse on children. + for (child_map::const_iterator i = children.begin (); + i != children.end (); ++i) + i->second->build_flat (data); +} + +octave_value +profile_data_accumulator::tree_node::get_hierarchical (double* total) const +{ + /* Note that we don't generate the entry just for this node, but rather + a struct-array with entries for all children. This way, the top-node + (for which we don't want a real entry) generates already the final + hierarchical profile data. */ + + const octave_idx_type n = children.size (); + + Cell rv_indices (n, 1); + Cell rv_times (n, 1); + Cell rv_totals (n, 1); + Cell rv_calls (n, 1); + Cell rv_children (n, 1); + + octave_idx_type i = 0; + for (child_map::const_iterator p = children.begin (); + p != children.end (); ++p) + { + const tree_node& entry = *p->second; + double child_total = entry.time; + + rv_indices(i) = octave_value (p->first); + rv_times(i) = octave_value (entry.time); + rv_calls(i) = octave_value (entry.calls); + rv_children(i) = entry.get_hierarchical (&child_total); + rv_totals(i) = octave_value (child_total); + + if (total) + *total += child_total; + + ++i; + } + assert (i == n); + + octave_map retval; + + retval.assign ("Index", rv_indices); + retval.assign ("SelfTime", rv_times); + retval.assign ("TotalTime", rv_totals); + retval.assign ("NumCalls", rv_calls); + retval.assign ("Children", rv_children); + + return retval; +} + +profile_data_accumulator::profile_data_accumulator () + : known_functions (), fcn_index (), + enabled (false), call_tree (NULL), last_time (-1.0) +{} + +profile_data_accumulator::~profile_data_accumulator () +{ + if (call_tree) + delete call_tree; +} + +void +profile_data_accumulator::set_active (bool value) +{ + if (value) + { + // Create a call-tree top-node if there isn't yet one. + if (!call_tree) + call_tree = new tree_node (NULL, 0); + + // Let the top-node be the active one. This ensures we have a clean + // fresh start collecting times. + active_fcn = call_tree; + } + else + { + // Make sure we start with fresh timing if we're re-enabled later. + last_time = -1.0; + } + + enabled = value; +} + +void +profile_data_accumulator::enter_function (const std::string& fcn) +{ + // The enter class will check and only call us if the profiler is active. + assert (is_active ()); + assert (call_tree); + + // If there is already an active function, add to its time before + // pushing the new one. + if (active_fcn != call_tree) + add_current_time (); + + // Map the function's name to its index. + octave_idx_type fcn_idx; + fcn_index_map::iterator pos = fcn_index.find (fcn); + if (pos == fcn_index.end ()) + { + known_functions.push_back (fcn); + fcn_idx = known_functions.size (); + fcn_index[fcn] = fcn_idx; + } + else + fcn_idx = pos->second; + + active_fcn = active_fcn->enter (fcn_idx); + last_time = query_time (); +} + +void +profile_data_accumulator::exit_function (const std::string& fcn) +{ + assert (call_tree); + assert (active_fcn != call_tree); + + // Usually, if we are disabled this function is not even called. But the + // call disabling the profiler is an exception. So also check here + // and only record the time if enabled. + if (is_active ()) + add_current_time (); + + fcn_index_map::iterator pos = fcn_index.find (fcn); + assert (pos != fcn_index.end ()); + active_fcn = active_fcn->exit (pos->second); + + // If this was an "inner call", we resume executing the parent function + // up the stack. So note the start-time for this! + last_time = query_time (); +} + +void +profile_data_accumulator::reset (void) +{ + if (is_active ()) + { + error ("Can't reset active profiler."); + return; + } + + known_functions.clear (); + fcn_index.clear (); + + if (call_tree) + { + delete call_tree; + call_tree = NULL; + } + + last_time = -1.0; +} + +octave_value +profile_data_accumulator::get_flat (void) const +{ + octave_value retval; + + const octave_idx_type n = known_functions.size (); + + flat_profile flat (n); + + if (call_tree) + { + call_tree->build_flat (flat); + + Cell rv_names (n, 1); + Cell rv_times (n, 1); + Cell rv_calls (n, 1); + Cell rv_recursive (n, 1); + Cell rv_parents (n, 1); + Cell rv_children (n, 1); + + for (octave_idx_type i = 0; i != n; ++i) + { + rv_names(i) = octave_value (known_functions[i]); + rv_times(i) = octave_value (flat[i].time); + rv_calls(i) = octave_value (flat[i].calls); + rv_recursive(i) = octave_value (flat[i].recursive); + rv_parents(i) = stats::function_set_value (flat[i].parents); + rv_children(i) = stats::function_set_value (flat[i].children); + } + + octave_map m; + + m.assign ("FunctionName", rv_names); + m.assign ("TotalTime", rv_times); + m.assign ("NumCalls", rv_calls); + m.assign ("IsRecursive", rv_recursive); + m.assign ("Parents", rv_parents); + m.assign ("Children", rv_children); + + retval = m; + } + else + { + static const char *fn[] = + { + "FunctionName", + "TotalTime", + "NumCalls", + "IsRecursive", + "Parents", + "Children", + 0 + }; + + static octave_map m (dim_vector (0, 1), string_vector (fn)); + + retval = m; + } + + return retval; +} + +octave_value +profile_data_accumulator::get_hierarchical (void) const +{ + octave_value retval; + + if (call_tree) + retval = call_tree->get_hierarchical (); + else + { + static const char *fn[] = + { + "Index", + "SelfTime", + "NumCalls", + "Children", + 0 + }; + + static octave_map m (dim_vector (0, 1), string_vector (fn)); + + retval = m; + } + + return retval; +} + +double +profile_data_accumulator::query_time (void) const +{ + octave_time now; + + // FIXME -- is this volatile declaration really needed? + // See bug #34210 for additional details. + volatile double dnow = now.double_value (); + + return dnow; +} + +void +profile_data_accumulator::add_current_time (void) +{ + const double t = query_time (); + assert (last_time >= 0.0 && last_time <= t); + + assert (call_tree && active_fcn != call_tree); + active_fcn->add_time (t - last_time); +} + +profile_data_accumulator profiler; + +// Enable or disable the profiler data collection. +DEFUN (__profiler_enable__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Function File} __profiler_enable ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value_list retval; + + const int nargin = args.length (); + if (nargin > 0) + { + if (nargin > 1) + { + print_usage (); + return retval; + } + + profiler.set_active (args(0).bool_value ()); + } + + retval(0) = profiler.is_active (); + + return retval; +} + +// Clear all collected profiling data. +DEFUN (__profiler_reset__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Function File} __profiler_reset ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value_list retval; + const int nargin = args.length (); + + if (nargin > 0) + warning ("profiler_reset: ignoring extra arguments"); + + profiler.reset (); + + return retval; +} + +// Query the timings collected by the profiler. +DEFUN (__profiler_data__, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Function File} __profiler_data ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value_list retval; + const int nargin = args.length (); + + if (nargin > 0) + warning ("profiler_data: ignoring extra arguments"); + + retval(0) = profiler.get_flat (); + if (nargout > 1) + retval(1) = profiler.get_hierarchical (); + + return retval; +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/profiler.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/profiler.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,190 @@ +/* + +Copyright (C) 2012 Daniel Kraft + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_profiler_h) +#define octave_profiler_h 1 + +#include +#include +#include +#include +#include + +class octave_value; + +class +OCTINTERP_API +profile_data_accumulator +{ +public: + + // This is a utility class that can be used to call the enter/exit + // functions in a manner protected from stack unwinding. + class enter + { + private: + + profile_data_accumulator& acc; + std::string fcn; + + public: + + enter (profile_data_accumulator&, const std::string&); + virtual ~enter (void); + + private: + + // No copying! + enter (const enter&); + enter& operator = (const enter&); + }; + + profile_data_accumulator (void); + virtual ~profile_data_accumulator (); + + bool is_active (void) const { return enabled; } + void set_active (bool); + + void reset (void); + + octave_value get_flat (void) const; + octave_value get_hierarchical (void) const; + +private: + + // One entry in the flat profile (i.e., a collection of data for a single + // function). This is filled in when building the flat profile from the + // hierarchical call tree. + struct stats + { + stats (); + + double time; + unsigned calls; + + bool recursive; + + typedef std::set function_set; + function_set parents; + function_set children; + + // Convert a function_set list to an Octave array of indices. + static octave_value function_set_value (const function_set&); + }; + + typedef std::vector flat_profile; + + // Store data for one node in the call-tree of the hierarchical profiler + // data we collect. + class tree_node + { + public: + + tree_node (tree_node*, octave_idx_type); + virtual ~tree_node (); + + void add_time (double dt) { time += dt; } + + // Enter a child function. It is created in the list of children if it + // wasn't already there. The now-active child node is returned. + tree_node* enter (octave_idx_type); + + // Exit function. As a sanity-check, it is verified that the currently + // active function actually is the one handed in here. Returned is the + // then-active node, which is our parent. + tree_node* exit (octave_idx_type); + + void build_flat (flat_profile&) const; + + // Get the hierarchical profile for this node and its children. If total + // is set, accumulate total time of the subtree in that variable as + // additional return value. + octave_value get_hierarchical (double* total = NULL) const; + + private: + + tree_node* parent; + octave_idx_type fcn_id; + + typedef std::map child_map; + child_map children; + + // This is only time spent *directly* on this level, excluding children! + double time; + + unsigned calls; + + // No copying! + tree_node (const tree_node&); + tree_node& operator = (const tree_node&); + }; + + // Each function we see in the profiler is given a unique index (which + // simply counts starting from 1). We thus have to map profiler-names to + // those indices. For all other stuff, we identify functions by their index. + + typedef std::vector function_set; + typedef std::map fcn_index_map; + + function_set known_functions; + fcn_index_map fcn_index; + + bool enabled; + + tree_node* call_tree; + tree_node* active_fcn; + + // Store last timestamp we had, when the currently active function was called. + double last_time; + + // These are private as only the unwind-protecting inner class enter + // should be allowed to call them. + void enter_function (const std::string&); + void exit_function (const std::string&); + + // Query a timestamp, used for timing calls (obviously). + // This is not static because in the future, maybe we want a flag + // in the profiler or something to choose between cputime, wall-time, + // user-time, system-time, ... + double query_time () const; + + // Add the time elapsed since last_time to the function we're currently in. + // This is called from two different positions, thus it is useful to have + // it as a seperate function. + void add_current_time (void); + + // No copying! + profile_data_accumulator (const profile_data_accumulator&); + profile_data_accumulator& operator = (const profile_data_accumulator&); +}; + +// The instance used. +extern OCTINTERP_API profile_data_accumulator profiler; + +// Helper macro to profile a block of code. +#define BEGIN_PROFILER_BLOCK(name) \ + { \ + profile_data_accumulator::enter pe (profiler, (name)); +#define END_PROFILER_BLOCK \ + } + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/pt-jit.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/pt-jit.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,2693 @@ +/* + +Copyright (C) 2012 Max Brister + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Author: Max Brister + +#define __STDC_LIMIT_MACROS +#define __STDC_CONSTANT_MACROS + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "debug.h" +#include "defun.h" +#include "ov.h" +#include "pt-all.h" +#include "pt-jit.h" +#include "sighandlers.h" +#include "symtab.h" +#include "variables.h" + +#ifdef HAVE_LLVM + +static bool Vdebug_jit = false; + +static bool Vjit_enable = true; + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +static llvm::IRBuilder<> builder (llvm::getGlobalContext ()); + +static llvm::LLVMContext& context = llvm::getGlobalContext (); + +// -------------------- jit_break_exception -------------------- + +// jit_break is thrown whenever a branch we are converting has only breaks or +// continues. This is because all code that follows a break or continue is dead. +class jit_break_exception : public std::exception {}; + +// -------------------- jit_convert -------------------- +jit_convert::jit_convert (tree &tee, jit_type *for_bounds) + : converting_function (false) +{ + initialize (symbol_table::current_scope ()); + + if (for_bounds) + create_variable (next_for_bounds (false), for_bounds); + + try + { + visit (tee); + } + catch (const jit_break_exception&) + {} + + // breaks must have been handled by the top level loop + assert (breaks.empty ()); + assert (continues.empty ()); + + block->append (factory.create (final_block)); + blocks.push_back (final_block); + + for (variable_map::iterator iter = vmap.begin (); iter != vmap.end (); ++iter) + { + jit_variable *var = iter->second; + const std::string& name = var->name (); + if (name.size () && name[0] != '#') + final_block->append (factory.create (var)); + } + + final_block->append (factory.create ()); +} + +jit_convert::jit_convert (octave_user_function& fcn, + const std::vector& args) + : converting_function (true) +{ + initialize (fcn.scope ()); + + tree_parameter_list *plist = fcn.parameter_list (); + tree_parameter_list *rlist = fcn.return_list (); + if (plist && plist->takes_varargs ()) + throw jit_fail_exception ("varags not supported"); + + if (rlist && (rlist->size () > 1 || rlist->takes_varargs ())) + throw jit_fail_exception ("multiple returns not supported"); + + if (plist) + { + tree_parameter_list::iterator piter = plist->begin (); + for (size_t i = 0; i < args.size (); ++i, ++piter) + { + if (piter == plist->end ()) + throw jit_fail_exception ("Too many parameter to function"); + + tree_decl_elt *elt = *piter; + std::string name = elt->name (); + create_variable (name, args[i]); + } + } + + jit_value *return_value = 0; + bool all_breaking = false; + if (fcn.is_special_expr ()) + { + tree_expression *expr = fcn.special_expr (); + if (expr) + { + jit_variable *retvar = get_variable ("#return"); + jit_value *retval; + try + { + retval = visit (expr); + } + catch (const jit_break_exception&) + {} + + if (breaks.size () || continues.size ()) + throw jit_fail_exception ("break/continue not supported in " + "anonymous functions"); + + block->append (factory.create (retvar, retval)); + return_value = retvar; + } + } + else + { + try + { + visit_statement_list (*fcn.body ()); + } + catch (const jit_break_exception&) + { + all_breaking = true; + } + + // the user may use break or continue to exit the function + finish_breaks (final_block, continues); + finish_breaks (final_block, breaks); + } + + if (! all_breaking) + block->append (factory.create (final_block)); + + blocks.push_back (final_block); + block = final_block; + + if (! return_value && rlist && rlist->size () == 1) + { + tree_decl_elt *elt = rlist->front (); + return_value = get_variable (elt->name ()); + } + + // FIXME: We should use live range analysis to delete variables where needed. + // For now we just delete everything at the end of the function. + for (variable_map::iterator iter = vmap.begin (); iter != vmap.end (); ++iter) + { + if (iter->second != return_value) + { + jit_call *call; + call = factory.create (&jit_typeinfo::destroy, + iter->second); + final_block->append (call); + } + } + + if (return_value) + final_block->append (factory.create (return_value)); + else + final_block->append (factory.create ()); +} + +void +jit_convert::visit_anon_fcn_handle (tree_anon_fcn_handle&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::visit_argument_list (tree_argument_list&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::visit_binary_expression (tree_binary_expression& be) +{ + if (be.op_type () >= octave_value::num_binary_ops) + { + tree_boolean_expression *boole; + boole = dynamic_cast (&be); + assert (boole); + bool is_and = boole->op_type () == tree_boolean_expression::bool_and; + + std::string short_name = next_shortcircut_result (); + jit_variable *short_result = factory.create (short_name); + vmap[short_name] = short_result; + + jit_block *done = factory.create (block->name ()); + tree_expression *lhs = be.lhs (); + jit_value *lhsv = visit (lhs); + lhsv = create_checked (&jit_typeinfo::logically_true, lhsv); + + jit_block *short_early = factory.create ("short_early"); + blocks.push_back (short_early); + + jit_block *short_cont = factory.create ("short_cont"); + + if (is_and) + block->append (factory.create (lhsv, short_cont, short_early)); + else + block->append (factory.create (lhsv, short_early, short_cont)); + + block = short_early; + + jit_value *early_result = factory.create (! is_and); + block->append (factory.create (short_result, early_result)); + block->append (factory.create (done)); + + blocks.push_back (short_cont); + block = short_cont; + + tree_expression *rhs = be.rhs (); + jit_value *rhsv = visit (rhs); + rhsv = create_checked (&jit_typeinfo::logically_true, rhsv); + block->append (factory.create (short_result, rhsv)); + block->append (factory.create (done)); + + blocks.push_back (done); + block = done; + result = short_result; + } + else + { + tree_expression *lhs = be.lhs (); + jit_value *lhsv = visit (lhs); + + tree_expression *rhs = be.rhs (); + jit_value *rhsv = visit (rhs); + + const jit_operation& fn = jit_typeinfo::binary_op (be.op_type ()); + result = create_checked (fn, lhsv, rhsv); + } +} + +void +jit_convert::visit_break_command (tree_break_command&) +{ + breaks.push_back (block); + throw jit_break_exception (); +} + +void +jit_convert::visit_colon_expression (tree_colon_expression& expr) +{ + // in the futher we need to add support for classes and deal with rvalues + jit_value *base = visit (expr.base ()); + jit_value *limit = visit (expr.limit ()); + jit_value *increment; + tree_expression *tinc = expr.increment (); + + if (tinc) + increment = visit (tinc); + else + increment = factory.create (1); + + result = block->append (factory.create (jit_typeinfo::make_range, base, + limit, increment)); +} + +void +jit_convert::visit_continue_command (tree_continue_command&) +{ + continues.push_back (block); + throw jit_break_exception (); +} + +void +jit_convert::visit_global_command (tree_global_command&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::visit_persistent_command (tree_persistent_command&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::visit_decl_elt (tree_decl_elt&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::visit_decl_init_list (tree_decl_init_list&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::visit_simple_for_command (tree_simple_for_command& cmd) +{ + // Note we do an initial check to see if the loop will run atleast once. + // This allows us to get better type inference bounds on variables defined + // and used only inside the for loop (e.g. the index variable) + + // If we are a nested for loop we need to store the previous breaks + unwind_protect prot; + prot.protect_var (breaks); + prot.protect_var (continues); + breaks.clear (); + continues.clear (); + + // we need a variable for our iterator, because it is used in multiple blocks + std::string iter_name = next_iterator (); + jit_variable *iterator = factory.create (iter_name); + factory.create (iter_name); + vmap[iter_name] = iterator; + + jit_block *body = factory.create ("for_body"); + jit_block *tail = factory.create ("for_tail"); + + // do control expression, iter init, and condition check in prev_block (block) + // if we are the top level for loop, the bounds is an input argument. + jit_value *control = find_variable (next_for_bounds ()); + if (! control) + control = visit (cmd.control_expr ()); + jit_call *init_iter = factory.create (jit_typeinfo::for_init, + control); + block->append (init_iter); + block->append (factory.create (iterator, init_iter)); + + jit_call *check = factory.create (jit_typeinfo::for_check, control, + iterator); + block->append (check); + block->append (factory.create (check, body, tail)); + + blocks.push_back (body); + block = body; + + // compute the syntactical iterator + jit_call *idx_rhs = factory.create (jit_typeinfo::for_index, + control, iterator); + block->append (idx_rhs); + do_assign (cmd.left_hand_side (), idx_rhs); + + // do loop + tree_statement_list *pt_body = cmd.body (); + bool all_breaking = false; + try + { + pt_body->accept (*this); + } + catch (const jit_break_exception&) + { + if (continues.empty ()) + { + // WTF are you doing user? Every branch was a break, why did you have + // a loop??? Users are silly people... + finish_breaks (tail, breaks); + blocks.push_back (tail); + block = tail; + return; + } + + all_breaking = true; + } + + // check our condition, continues jump to this block + jit_block *check_block = factory.create ("for_check"); + blocks.push_back (check_block); + + jit_block *interrupt_check = factory.create ("for_interrupt"); + blocks.push_back (interrupt_check); + + if (! all_breaking) + block->append (factory.create (check_block)); + finish_breaks (check_block, continues); + + block = check_block; + const jit_operation& add_fn = jit_typeinfo::binary_op (octave_value::op_add); + jit_value *one = factory.create (1); + jit_call *iter_inc = factory.create (add_fn, iterator, one); + block->append (iter_inc); + block->append (factory.create (iterator, iter_inc)); + check = block->append (factory.create (jit_typeinfo::for_check, + control, iterator)); + block->append (factory.create (check, interrupt_check, + tail)); + + block = interrupt_check; + jit_error_check *ec + = factory.create (jit_error_check::var_interrupt, + body, final_block); + block->append (ec); + + // breaks will go to our tail + blocks.push_back (tail); + finish_breaks (tail, breaks); + block = tail; +} + +void +jit_convert::visit_complex_for_command (tree_complex_for_command&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::visit_octave_user_script (octave_user_script&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::visit_octave_user_function (octave_user_function&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::visit_octave_user_function_header (octave_user_function&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::visit_octave_user_function_trailer (octave_user_function&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::visit_function_def (tree_function_def&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::visit_identifier (tree_identifier& ti) +{ + if (ti.has_magic_end ()) + { + if (!end_context.size ()) + throw jit_fail_exception ("Illegal end"); + result = block->append (factory.create (end_context)); + } + else + { + jit_variable *var = get_variable (ti.name ()); + jit_instruction *instr; + instr = factory.create (&jit_typeinfo::grab, var); + result = block->append (instr); + } +} + +void +jit_convert::visit_if_clause (tree_if_clause&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::visit_if_command (tree_if_command& cmd) +{ + tree_if_command_list *lst = cmd.cmd_list (); + assert (lst); // jwe: Can this be null? + lst->accept (*this); +} + +void +jit_convert::visit_if_command_list (tree_if_command_list& lst) +{ + tree_if_clause *last = lst.back (); + size_t last_else = static_cast (last->is_else_clause ()); + + // entry_blocks represents the block you need to enter in order to execute + // the condition check for the ith clause. For the else, it is simple the + // else body. If there is no else body, then it is padded with the tail + std::vector entry_blocks (lst.size () + 1 - last_else); + std::vector branch_blocks (lst.size (), 0); // final blocks + entry_blocks[0] = block; + + // we need to construct blocks first, because they have jumps to eachother + tree_if_command_list::iterator iter = lst.begin (); + ++iter; + for (size_t i = 1; iter != lst.end (); ++iter, ++i) + { + tree_if_clause *tic = *iter; + if (tic->is_else_clause ()) + entry_blocks[i] = factory.create ("else"); + else + entry_blocks[i] = factory.create ("ifelse_cond"); + } + + jit_block *tail = factory.create ("if_tail"); + if (! last_else) + entry_blocks[entry_blocks.size () - 1] = tail; + + + // each branch in the if statement will have different breaks/continues + block_list current_breaks = breaks; + block_list current_continues = continues; + breaks.clear (); + continues.clear (); + + size_t num_incomming = 0; // number of incomming blocks to our tail + iter = lst.begin (); + for (size_t i = 0; iter != lst.end (); ++iter, ++i) + { + tree_if_clause *tic = *iter; + block = entry_blocks[i]; + assert (block); + + if (i) // the first block is prev_block, so it has already been added + blocks.push_back (entry_blocks[i]); + + if (! tic->is_else_clause ()) + { + tree_expression *expr = tic->condition (); + jit_value *cond = visit (expr); + jit_call *check = create_checked (&jit_typeinfo::logically_true, + cond); + jit_block *body = factory.create (i == 0 ? "if_body" + : "ifelse_body"); + blocks.push_back (body); + + jit_instruction *br = factory.create (check, body, + entry_blocks[i + 1]); + block->append (br); + block = body; + } + + tree_statement_list *stmt_lst = tic->commands (); + assert (stmt_lst); // jwe: Can this be null? + + try + { + stmt_lst->accept (*this); + ++num_incomming; + block->append (factory.create (tail)); + } + catch(const jit_break_exception&) + {} + + current_breaks.splice (current_breaks.end (), breaks); + current_continues.splice (current_continues.end (), continues); + } + + breaks.splice (breaks.end (), current_breaks); + continues.splice (continues.end (), current_continues); + + if (num_incomming || ! last_else) + { + blocks.push_back (tail); + block = tail; + } + else + // every branch broke, so we don't have a tail + throw jit_break_exception (); +} + +void +jit_convert::visit_index_expression (tree_index_expression& exp) +{ + result = resolve (exp); +} + +void +jit_convert::visit_matrix (tree_matrix&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::visit_cell (tree_cell&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::visit_multi_assignment (tree_multi_assignment&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::visit_no_op_command (tree_no_op_command&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::visit_constant (tree_constant& tc) +{ + octave_value v = tc.rvalue1 (); + jit_type *ty = jit_typeinfo::type_of (v); + + if (ty == jit_typeinfo::get_scalar ()) + { + double dv = v.double_value (); + result = factory.create (dv); + } + else if (ty == jit_typeinfo::get_range ()) + { + Range rv = v.range_value (); + result = factory.create (rv); + } + else if (ty == jit_typeinfo::get_complex ()) + { + Complex cv = v.complex_value (); + result = factory.create (cv); + } + else + throw jit_fail_exception ("Unknown constant"); +} + +void +jit_convert::visit_fcn_handle (tree_fcn_handle&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::visit_parameter_list (tree_parameter_list&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::visit_postfix_expression (tree_postfix_expression& tpe) +{ + octave_value::unary_op etype = tpe.op_type (); + tree_expression *operand = tpe.operand (); + jit_value *operandv = visit (operand); + + const jit_operation& fn = jit_typeinfo::unary_op (etype); + result = create_checked (fn, operandv); + + if (etype == octave_value::op_incr || etype == octave_value::op_decr) + { + jit_value *ret = create_checked (&jit_typeinfo::grab, operandv); + do_assign (operand, result); + result = ret; + } +} + +void +jit_convert::visit_prefix_expression (tree_prefix_expression& tpe) +{ + octave_value::unary_op etype = tpe.op_type (); + tree_expression *operand = tpe.operand (); + const jit_operation& fn = jit_typeinfo::unary_op (etype); + result = create_checked (fn, visit (operand)); + + if (etype == octave_value::op_incr || etype == octave_value::op_decr) + do_assign (operand, result); +} + +void +jit_convert::visit_return_command (tree_return_command&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::visit_return_list (tree_return_list&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::visit_simple_assignment (tree_simple_assignment& tsa) +{ + tree_expression *rhs = tsa.right_hand_side (); + jit_value *rhsv = visit (rhs); + octave_value::assign_op op = tsa.op_type (); + + if (op != octave_value::op_asn_eq) + { + // do the equivlent binary operation, then assign. This is always correct, + // but isn't always optimal. + tree_expression *lhs = tsa.left_hand_side (); + jit_value *lhsv = visit (lhs); + octave_value::binary_op bop = octave_value::assign_op_to_binary_op (op); + const jit_operation& fn = jit_typeinfo::binary_op (bop); + rhsv = create_checked (fn, lhsv, rhsv); + } + + result = do_assign (tsa.left_hand_side (), rhsv); +} + +void +jit_convert::visit_statement (tree_statement& stmt) +{ + tree_command *cmd = stmt.command (); + tree_expression *expr = stmt.expression (); + + if (cmd) + visit (cmd); + else + { + // stolen from tree_evaluator::visit_statement + bool do_bind_ans = false; + + if (expr->is_identifier ()) + { + tree_identifier *id = dynamic_cast (expr); + + do_bind_ans = (! id->is_variable ()); + } + else + do_bind_ans = (! expr->is_assignment_expression ()); + + jit_value *expr_result = visit (expr); + + if (do_bind_ans) + do_assign ("ans", expr_result, expr->print_result ()); + else if (expr->is_identifier () && expr->print_result ()) + { + // FIXME: ugly hack, we need to come up with a way to pass + // nargout to visit_identifier + const jit_operation& fn = jit_typeinfo::print_value (); + jit_const_string *name = factory.create (expr->name ()); + block->append (factory.create (fn, name, expr_result)); + } + } +} + +void +jit_convert::visit_statement_list (tree_statement_list& lst) +{ + for (tree_statement_list::iterator iter = lst.begin (); iter != lst.end(); + ++iter) + { + tree_statement *elt = *iter; + // jwe: Can this ever be null? + assert (elt); + elt->accept (*this); + } +} + +void +jit_convert::visit_switch_case (tree_switch_case&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::visit_switch_case_list (tree_switch_case_list&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::visit_switch_command (tree_switch_command&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::visit_try_catch_command (tree_try_catch_command&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::visit_unwind_protect_command (tree_unwind_protect_command&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::visit_while_command (tree_while_command& wc) +{ + unwind_protect prot; + prot.protect_var (breaks); + prot.protect_var (continues); + breaks.clear (); + continues.clear (); + + jit_block *cond_check = factory.create ("while_cond_check"); + block->append (factory.create (cond_check)); + blocks.push_back (cond_check); + block = cond_check; + + tree_expression *expr = wc.condition (); + assert (expr && "While expression can not be null"); + jit_value *check = visit (expr); + check = create_checked (&jit_typeinfo::logically_true, check); + + jit_block *body = factory.create ("while_body"); + blocks.push_back (body); + + jit_block *tail = factory.create ("while_tail"); + block->append (factory.create (check, body, tail)); + block = body; + + tree_statement_list *loop_body = wc.body (); + bool all_breaking = false; + if (loop_body) + { + try + { + loop_body->accept (*this); + } + catch (const jit_break_exception&) + { + all_breaking = true; + } + } + + finish_breaks (tail, breaks); + + if (! all_breaking || continues.size ()) + { + jit_block *interrupt_check + = factory.create ("interrupt_check"); + blocks.push_back (interrupt_check); + finish_breaks (interrupt_check, continues); + if (! all_breaking) + block->append (factory.create (interrupt_check)); + + block = interrupt_check; + jit_error_check *ec + = factory.create (jit_error_check::var_interrupt, + cond_check, final_block); + block->append (ec); + } + + blocks.push_back (tail); + block = tail; +} + +void +jit_convert::visit_do_until_command (tree_do_until_command&) +{ + throw jit_fail_exception (); +} + +void +jit_convert::initialize (symbol_table::scope_id s) +{ + scope = s; + iterator_count = 0; + for_bounds_count = 0; + short_count = 0; + jit_instruction::reset_ids (); + + entry_block = factory.create ("body"); + final_block = factory.create ("final"); + blocks.push_back (entry_block); + entry_block->mark_alive (); + block = entry_block; +} + +jit_call * +jit_convert::create_checked_impl (jit_call *ret) +{ + block->append (ret); + + jit_block *normal = factory.create (block->name ()); + jit_error_check *check + = factory.create (jit_error_check::var_error_state, ret, + normal, final_block); + block->append (check); + blocks.push_back (normal); + block = normal; + + return ret; +} + +jit_variable * +jit_convert::find_variable (const std::string& vname) const +{ + variable_map::const_iterator iter; + iter = vmap.find (vname); + return iter != vmap.end () ? iter->second : 0; +} + +jit_variable * +jit_convert::get_variable (const std::string& vname) +{ + jit_variable *ret = find_variable (vname); + if (ret) + return ret; + + symbol_table::symbol_record record = symbol_table::find_symbol (vname, scope); + if (record.is_persistent () || record.is_global ()) + throw jit_fail_exception ("Persistent and global not yet supported"); + + if (converting_function) + return create_variable (vname, jit_typeinfo::get_any (), false); + else + { + octave_value val = record.varval (); + jit_type *type = jit_typeinfo::type_of (val); + bounds.push_back (type_bound (type, vname)); + + return create_variable (vname, type); + } +} + +jit_variable * +jit_convert::create_variable (const std::string& vname, jit_type *type, + bool isarg) +{ + jit_variable *var = factory.create (vname); + + if (isarg) + { + jit_extract_argument *extract; + extract = factory.create (type, var); + entry_block->prepend (extract); + } + else + { + jit_call *init = factory.create (&jit_typeinfo::create_undef); + jit_assign *assign = factory.create (var, init); + entry_block->prepend (assign); + entry_block->prepend (init); + } + + return vmap[vname] = var; +} + +std::string +jit_convert::next_name (const char *prefix, size_t& count, bool inc) +{ + std::stringstream ss; + ss << prefix << count; + if (inc) + ++count; + return ss.str (); +} + +jit_instruction * +jit_convert::resolve (tree_index_expression& exp, jit_value *extra_arg, + bool lhs) +{ + std::string type = exp.type_tags (); + if (! (type.size () == 1 && type[0] == '(')) + throw jit_fail_exception ("Unsupported index operation"); + + std::list args = exp.arg_lists (); + if (args.size () != 1) + throw jit_fail_exception ("Bad number of arguments in " + "tree_index_expression"); + + tree_argument_list *arg_list = args.front (); + if (! arg_list) + throw jit_fail_exception ("null argument list"); + + if (arg_list->size () < 1) + throw jit_fail_exception ("Empty arg_list"); + + tree_expression *tree_object = exp.expression (); + jit_value *object; + if (lhs) + { + tree_identifier *id = dynamic_cast (tree_object); + if (! id) + throw jit_fail_exception ("expected identifier"); + object = get_variable (id->name ()); + } + else + object = visit (tree_object); + + size_t narg = arg_list->size (); + tree_argument_list::iterator iter = arg_list->begin (); + bool have_extra = extra_arg; + std::vector call_args (narg + 1 + have_extra); + call_args[0] = object; + + for (size_t idx = 0; iter != arg_list->end (); ++idx, ++iter) + { + unwind_protect prot; + prot.add_method (&end_context, + &std::vector::pop_back); + + jit_magic_end::context ctx (factory, object, idx, narg); + end_context.push_back (ctx); + call_args[idx + 1] = visit (*iter); + } + + if (extra_arg) + call_args[call_args.size () - 1] = extra_arg; + + const jit_operation& fres = lhs ? jit_typeinfo::paren_subsasgn () + : jit_typeinfo::paren_subsref (); + + return create_checked (fres, call_args); +} + +jit_value * +jit_convert::do_assign (tree_expression *exp, jit_value *rhs, bool artificial) +{ + if (! exp) + throw jit_fail_exception ("NULL lhs in assign"); + + if (isa (exp)) + return do_assign (exp->name (), rhs, exp->print_result (), artificial); + else if (tree_index_expression *idx + = dynamic_cast (exp)) + { + jit_value *new_object = resolve (*idx, rhs, true); + do_assign (idx->expression (), new_object, true); + + // FIXME: Will not work for values that must be release/grabed + return rhs; + } + else + throw jit_fail_exception ("Unsupported assignment"); +} + +jit_value * +jit_convert::do_assign (const std::string& lhs, jit_value *rhs, + bool print, bool artificial) +{ + jit_variable *var = get_variable (lhs); + jit_assign *assign = block->append (factory.create (var, rhs)); + + if (artificial) + assign->mark_artificial (); + + if (print) + { + const jit_operation& print_fn = jit_typeinfo::print_value (); + jit_const_string *name = factory.create (lhs); + block->append (factory.create (print_fn, name, var)); + } + + return var; +} + +jit_value * +jit_convert::visit (tree& tee) +{ + unwind_protect prot; + prot.protect_var (result); + + tee.accept (*this); + return result; +} + +void +jit_convert::finish_breaks (jit_block *dest, const block_list& lst) +{ + for (block_list::const_iterator iter = lst.begin (); iter != lst.end (); + ++iter) + { + jit_block *b = *iter; + b->append (factory.create (dest)); + } +} + +// -------------------- jit_convert_llvm -------------------- +llvm::Function * +jit_convert_llvm::convert_loop (llvm::Module *module, + const jit_block_list& blocks, + const std::list& constants) +{ + converting_function = false; + + // for now just init arguments from entry, later we will have to do something + // more interesting + jit_block *entry_block = blocks.front (); + for (jit_block::iterator iter = entry_block->begin (); + iter != entry_block->end (); ++iter) + if (jit_extract_argument *extract + = dynamic_cast (*iter)) + argument_vec.push_back (std::make_pair (extract->name (), true)); + + + jit_type *any = jit_typeinfo::get_any (); + + // argument is an array of octave_base_value*, or octave_base_value** + llvm::Type *arg_type = any->to_llvm (); // this is octave_base_value* + arg_type = arg_type->getPointerTo (); + llvm::FunctionType *ft = llvm::FunctionType::get (llvm::Type::getVoidTy (context), + arg_type, false); + function = llvm::Function::Create (ft, llvm::Function::ExternalLinkage, + "foobar", module); + + try + { + prelude = llvm::BasicBlock::Create (context, "prelude", function); + builder.SetInsertPoint (prelude); + + llvm::Value *arg = function->arg_begin (); + for (size_t i = 0; i < argument_vec.size (); ++i) + { + llvm::Value *loaded_arg = builder.CreateConstInBoundsGEP1_32 (arg, i); + arguments[argument_vec[i].first] = loaded_arg; + } + + convert (blocks, constants); + } catch (const jit_fail_exception& e) + { + function->eraseFromParent (); + throw; + } + + return function; +} + + +jit_function +jit_convert_llvm::convert_function (llvm::Module *module, + const jit_block_list& blocks, + const std::list& constants, + octave_user_function& fcn, + const std::vector& args) +{ + converting_function = true; + + jit_block *final_block = blocks.back (); + jit_return *ret = dynamic_cast (final_block->back ()); + assert (ret); + + creating = jit_function (module, jit_convention::internal, + "foobar", ret->result_type (), args); + function = creating.to_llvm (); + + try + { + prelude = creating.new_block ("prelude"); + builder.SetInsertPoint (prelude); + + tree_parameter_list *plist = fcn.parameter_list (); + if (plist) + { + tree_parameter_list::iterator piter = plist->begin (); + tree_parameter_list::iterator pend = plist->end (); + for (size_t i = 0; i < args.size () && piter != pend; ++i, ++piter) + { + tree_decl_elt *elt = *piter; + std::string arg_name = elt->name (); + arguments[arg_name] = creating.argument (builder, i); + } + } + + convert (blocks, constants); + } catch (const jit_fail_exception& e) + { + function->eraseFromParent (); + throw; + } + + return creating; +} + +void +jit_convert_llvm::convert (const jit_block_list& blocks, + const std::list& constants) +{ + std::list::const_iterator biter; + for (biter = blocks.begin (); biter != blocks.end (); ++biter) + { + jit_block *jblock = *biter; + llvm::BasicBlock *block = llvm::BasicBlock::Create (context, + jblock->name (), + function); + jblock->stash_llvm (block); + } + + jit_block *first = *blocks.begin (); + builder.CreateBr (first->to_llvm ()); + + // constants aren't in the IR, we visit those first + for (std::list::const_iterator iter = constants.begin (); + iter != constants.end (); ++iter) + if (! isa (*iter)) + visit (*iter); + + // convert all instructions + for (biter = blocks.begin (); biter != blocks.end (); ++biter) + visit (*biter); + + // now finish phi nodes + for (biter = blocks.begin (); biter != blocks.end (); ++biter) + { + jit_block& block = **biter; + for (jit_block::iterator piter = block.begin (); + piter != block.end () && isa (*piter); ++piter) + { + jit_instruction *phi = *piter; + finish_phi (static_cast (phi)); + } + } +} + +void +jit_convert_llvm::finish_phi (jit_phi *phi) +{ + llvm::PHINode *llvm_phi = phi->to_llvm (); + for (size_t i = 0; i < phi->argument_count (); ++i) + { + llvm::BasicBlock *pred = phi->incomming_llvm (i); + llvm_phi->addIncoming (phi->argument_llvm (i), pred); + } +} + +void +jit_convert_llvm::visit (jit_const_string& cs) +{ + cs.stash_llvm (builder.CreateGlobalStringPtr (cs.value ())); +} + +void +jit_convert_llvm::visit (jit_const_bool& cb) +{ + cb.stash_llvm (llvm::ConstantInt::get (cb.type_llvm (), cb.value ())); +} + +void +jit_convert_llvm::visit (jit_const_scalar& cs) +{ + cs.stash_llvm (llvm::ConstantFP::get (cs.type_llvm (), cs.value ())); +} + +void +jit_convert_llvm::visit (jit_const_complex& cc) +{ + llvm::Type *scalar_t = jit_typeinfo::get_scalar_llvm (); + Complex value = cc.value (); + llvm::Value *real = llvm::ConstantFP::get (scalar_t, value.real ()); + llvm::Value *imag = llvm::ConstantFP::get (scalar_t, value.imag ()); + cc.stash_llvm (jit_typeinfo::create_complex (real, imag)); +} + +void jit_convert_llvm::visit (jit_const_index& ci) +{ + ci.stash_llvm (llvm::ConstantInt::get (ci.type_llvm (), ci.value ())); +} + +void +jit_convert_llvm::visit (jit_const_range& cr) +{ + llvm::StructType *stype = llvm::cast(cr.type_llvm ()); + llvm::Type *scalar_t = jit_typeinfo::get_scalar_llvm (); + llvm::Type *idx = jit_typeinfo::get_index_llvm (); + const jit_range& rng = cr.value (); + + llvm::Constant *constants[4]; + constants[0] = llvm::ConstantFP::get (scalar_t, rng.base); + constants[1] = llvm::ConstantFP::get (scalar_t, rng.limit); + constants[2] = llvm::ConstantFP::get (scalar_t, rng.inc); + constants[3] = llvm::ConstantInt::get (idx, rng.nelem); + + llvm::Value *as_llvm; + as_llvm = llvm::ConstantStruct::get (stype, + llvm::makeArrayRef (constants, 4)); + cr.stash_llvm (as_llvm); +} + +void +jit_convert_llvm::visit (jit_block& b) +{ + llvm::BasicBlock *block = b.to_llvm (); + builder.SetInsertPoint (block); + for (jit_block::iterator iter = b.begin (); iter != b.end (); ++iter) + visit (*iter); +} + +void +jit_convert_llvm::visit (jit_branch& b) +{ + b.stash_llvm (builder.CreateBr (b.successor_llvm ())); +} + +void +jit_convert_llvm::visit (jit_cond_branch& cb) +{ + llvm::Value *cond = cb.cond_llvm (); + llvm::Value *br; + br = builder.CreateCondBr (cond, cb.successor_llvm (0), + cb.successor_llvm (1)); + cb.stash_llvm (br); +} + +void +jit_convert_llvm::visit (jit_call& call) +{ + const jit_function& ol = call.overload (); + + std::vector args (call.arguments ().size ()); + for (size_t i = 0; i < args.size (); ++i) + args[i] = call.argument (i); + + llvm::Value *ret = ol.call (builder, args); + call.stash_llvm (ret); +} + +void +jit_convert_llvm::visit (jit_extract_argument& extract) +{ + llvm::Value *arg = arguments[extract.name ()]; + assert (arg); + + if (converting_function) + extract.stash_llvm (arg); + else + { + arg = builder.CreateLoad (arg); + + const jit_function& ol = extract.overload (); + extract.stash_llvm (ol.call (builder, arg)); + } +} + +void +jit_convert_llvm::visit (jit_store_argument& store) +{ + const jit_function& ol = store.overload (); + llvm::Value *arg_value = ol.call (builder, store.result ()); + llvm::Value *arg = arguments[store.name ()]; + store.stash_llvm (builder.CreateStore (arg_value, arg)); +} + +void +jit_convert_llvm::visit (jit_return& ret) +{ + jit_value *res = ret.result (); + + if (converting_function) + creating.do_return (builder, res->to_llvm (), false); + else + { + if (res) + builder.CreateRet (res->to_llvm ()); + else + builder.CreateRetVoid (); + } +} + +void +jit_convert_llvm::visit (jit_phi& phi) +{ + // we might not have converted all incoming branches, so we don't + // set incomming branches now + llvm::PHINode *node = llvm::PHINode::Create (phi.type_llvm (), + phi.argument_count ()); + builder.Insert (node); + phi.stash_llvm (node); +} + +void +jit_convert_llvm::visit (jit_variable&) +{ + throw jit_fail_exception ("ERROR: SSA construction should remove all variables"); +} + +void +jit_convert_llvm::visit (jit_error_check& check) +{ + llvm::Value *cond; + + switch (check.check_variable ()) + { + case jit_error_check::var_error_state: + cond = jit_typeinfo::insert_error_check (builder); + break; + case jit_error_check::var_interrupt: + cond = jit_typeinfo::insert_interrupt_check (builder); + break; + default: + panic_impossible (); + } + + llvm::Value *br = builder.CreateCondBr (cond, check.successor_llvm (0), + check.successor_llvm (1)); + check.stash_llvm (br); +} + +void +jit_convert_llvm::visit (jit_assign& assign) +{ + jit_value *new_value = assign.src (); + assign.stash_llvm (new_value->to_llvm ()); + + if (assign.artificial ()) + return; + + jit_value *overwrite = assign.overwrite (); + if (isa (overwrite)) + { + const jit_function& ol = jit_typeinfo::get_release (overwrite->type ()); + if (ol.valid ()) + ol.call (builder, overwrite); + } +} + +void +jit_convert_llvm::visit (jit_argument&) +{} + +void +jit_convert_llvm::visit (jit_magic_end& me) +{ + const jit_function& ol = me.overload (); + + jit_magic_end::context ctx = me.resolve_context (); + llvm::Value *ret = ol.call (builder, ctx.value, ctx.index, ctx.count); + me.stash_llvm (ret); +} + +// -------------------- jit_infer -------------------- +jit_infer::jit_infer (jit_factory& afactory, jit_block_list& ablocks, + const variable_map& avmap) + : blocks (ablocks), factory (afactory), vmap (avmap) {} + +void +jit_infer::infer (void) +{ + construct_ssa (); + + // initialize the worklist to instructions derived from constants + const std::list& constants = factory.constants (); + for (std::list::const_iterator iter = constants.begin (); + iter != constants.end (); ++iter) + append_users (*iter); + + // the entry block terminator may be a regular branch statement + if (entry_block ().terminator ()) + push_worklist (entry_block ().terminator ()); + + // FIXME: Describe algorithm here + while (worklist.size ()) + { + jit_instruction *next = worklist.front (); + worklist.pop_front (); + next->stash_in_worklist (false); + + if (next->infer ()) + { + // terminators need to be handles specially + if (jit_terminator *term = dynamic_cast (next)) + append_users_term (term); + else + append_users (next); + } + } + + remove_dead (); + blocks.label (); + place_releases (); + simplify_phi (); +} + +void +jit_infer::append_users (jit_value *v) +{ + for (jit_use *use = v->first_use (); use; use = use->next ()) + push_worklist (use->user ()); +} + +void +jit_infer::append_users_term (jit_terminator *term) +{ + for (size_t i = 0; i < term->successor_count (); ++i) + { + if (term->alive (i)) + { + jit_block *succ = term->successor (i); + for (jit_block::iterator iter = succ->begin (); iter != succ->end () + && isa (*iter); ++iter) + push_worklist (*iter); + + jit_terminator *sterm = succ->terminator (); + if (sterm) + push_worklist (sterm); + } + } +} + +void +jit_infer::construct_ssa (void) +{ + blocks.label (); + final_block ().compute_idom (entry_block ()); + entry_block ().compute_df (); + entry_block ().create_dom_tree (); + + // insert phi nodes where needed, this is done on a per variable basis + for (variable_map::const_iterator iter = vmap.begin (); iter != vmap.end (); + ++iter) + { + jit_block::df_set visited, added_phi; + std::list ssa_worklist; + iter->second->use_blocks (visited); + ssa_worklist.insert (ssa_worklist.begin (), visited.begin (), + visited.end ()); + + while (ssa_worklist.size ()) + { + jit_block *b = ssa_worklist.front (); + ssa_worklist.pop_front (); + + for (jit_block::df_iterator diter = b->df_begin (); + diter != b->df_end (); ++diter) + { + jit_block *dblock = *diter; + if (! added_phi.count (dblock)) + { + jit_phi *phi = factory.create (iter->second, + dblock->use_count ()); + dblock->prepend (phi); + added_phi.insert (dblock); + } + + if (! visited.count (dblock)) + { + ssa_worklist.push_back (dblock); + visited.insert (dblock); + } + } + } + } + + do_construct_ssa (entry_block (), entry_block ().visit_count ()); +} + +void +jit_infer::do_construct_ssa (jit_block& ablock, size_t avisit_count) +{ + if (ablock.visited (avisit_count)) + return; + + // replace variables with their current SSA value + for (jit_block::iterator iter = ablock.begin (); iter != ablock.end (); + ++iter) + { + jit_instruction *instr = *iter; + instr->construct_ssa (); + instr->push_variable (); + } + + // finish phi nodes of successors + for (size_t i = 0; i < ablock.successor_count (); ++i) + { + jit_block *finish = ablock.successor (i); + + for (jit_block::iterator iter = finish->begin (); iter != finish->end () + && isa (*iter);) + { + jit_phi *phi = static_cast (*iter); + jit_variable *var = phi->dest (); + ++iter; + + if (var->has_top ()) + phi->add_incomming (&ablock, var->top ()); + else + { + // temporaries may have extranious phi nodes which can be removed + assert (! phi->use_count ()); + assert (var->name ().size () && var->name ()[0] == '#'); + phi->remove (); + } + } + } + + for (size_t i = 0; i < ablock.dom_successor_count (); ++i) + do_construct_ssa (*ablock.dom_successor (i), avisit_count); + + ablock.pop_all (); +} + +void +jit_infer::place_releases (void) +{ + std::set temporaries; + for (jit_block_list::iterator iter = blocks.begin (); iter != blocks.end (); + ++iter) + { + jit_block& ablock = **iter; + if (ablock.id () != jit_block::NO_ID) + { + release_temp (ablock, temporaries); + release_dead_phi (ablock); + } + } +} + +void +jit_infer::push_worklist (jit_instruction *instr) +{ + if (! instr->in_worklist ()) + { + instr->stash_in_worklist (true); + worklist.push_back (instr); + } +} + +void +jit_infer::remove_dead () +{ + jit_block_list::iterator biter; + for (biter = blocks.begin (); biter != blocks.end (); ++biter) + { + jit_block *b = *biter; + if (b->alive ()) + { + for (jit_block::iterator iter = b->begin (); iter != b->end () + && isa (*iter);) + { + jit_phi *phi = static_cast (*iter); + if (phi->prune ()) + iter = b->remove (iter); + else + ++iter; + } + } + } + + for (biter = blocks.begin (); biter != blocks.end ();) + { + jit_block *b = *biter; + if (b->alive ()) + { + // FIXME: A special case for jit_error_check, if we generalize to + // we will need to change! + jit_terminator *term = b->terminator (); + if (term && term->successor_count () == 2 && ! term->alive (0)) + { + jit_block *succ = term->successor (1); + term->remove (); + jit_branch *abreak = factory.create (succ); + b->append (abreak); + abreak->infer (); + } + + ++biter; + } + else + { + jit_terminator *term = b->terminator (); + if (term) + term->remove (); + biter = blocks.erase (biter); + } + } +} + +void +jit_infer::release_dead_phi (jit_block& ablock) +{ + jit_block::iterator iter = ablock.begin (); + while (iter != ablock.end () && isa (*iter)) + { + jit_phi *phi = static_cast (*iter); + ++iter; + + jit_use *use = phi->first_use (); + if (phi->use_count () == 1 && isa (use->user ())) + { + // instead of releasing on assign, release on all incomming branches, + // this can get rid of casts inside loops + for (size_t i = 0; i < phi->argument_count (); ++i) + { + jit_value *arg = phi->argument (i); + if (! arg->needs_release ()) + continue; + + jit_block *inc = phi->incomming (i); + jit_block *split = inc->maybe_split (factory, blocks, ablock); + jit_terminator *term = split->terminator (); + jit_call *release + = factory.create (jit_typeinfo::release, arg); + release->infer (); + split->insert_before (term, release); + } + + phi->replace_with (0); + phi->remove (); + } + } +} + +void +jit_infer::release_temp (jit_block& ablock, std::set& temp) +{ + for (jit_block::iterator iter = ablock.begin (); iter != ablock.end (); + ++iter) + { + jit_instruction *instr = *iter; + + // check for temporaries that require release and live across + // multiple blocks + if (instr->needs_release ()) + { + jit_block *fu_block = instr->first_use_block (); + if (fu_block && fu_block != &ablock && instr->needs_release ()) + temp.insert (instr); + } + + if (isa (instr)) + { + // place releases for temporary arguments + for (size_t i = 0; i < instr->argument_count (); ++i) + { + jit_value *arg = instr->argument (i); + if (! arg->needs_release ()) + continue; + + jit_call *release + = factory.create (&jit_typeinfo::release, arg); + release->infer (); + ablock.insert_after (iter, release); + ++iter; + temp.erase (arg); + } + } + } + + if (! temp.size () || ! isa (ablock.terminator ())) + return; + + // FIXME: If we support try/catch or unwind_protect final_block may not be the + // destination + jit_block *split = ablock.maybe_split (factory, blocks, final_block ()); + jit_terminator *term = split->terminator (); + for (std::set::const_iterator iter = temp.begin (); + iter != temp.end (); ++iter) + { + jit_value *value = *iter; + jit_call *release + = factory.create (&jit_typeinfo::release, value); + split->insert_before (term, release); + release->infer (); + } +} + +void +jit_infer::simplify_phi (void) +{ + for (jit_block_list::iterator biter = blocks.begin (); biter != blocks.end (); + ++biter) + { + jit_block &ablock = **biter; + for (jit_block::iterator iter = ablock.begin (); iter != ablock.end () + && isa (*iter); ++iter) + simplify_phi (*static_cast (*iter)); + } +} + +void +jit_infer::simplify_phi (jit_phi& phi) +{ + jit_block& pblock = *phi.parent (); + const jit_operation& cast_fn = jit_typeinfo::cast (phi.type ()); + jit_variable *dest = phi.dest (); + for (size_t i = 0; i < phi.argument_count (); ++i) + { + jit_value *arg = phi.argument (i); + if (arg->type () != phi.type ()) + { + jit_block *pred = phi.incomming (i); + jit_block *split = pred->maybe_split (factory, blocks, pblock); + jit_terminator *term = split->terminator (); + jit_instruction *cast = factory.create (cast_fn, arg); + jit_assign *assign = factory.create (dest, cast); + + split->insert_before (term, cast); + split->insert_before (term, assign); + cast->infer (); + assign->infer (); + phi.stash_argument (i, assign); + } + } +} + +// -------------------- tree_jit -------------------- + +tree_jit::tree_jit (void) : module (0), engine (0) +{ +} + +tree_jit::~tree_jit (void) +{} + +bool +tree_jit::execute (tree_simple_for_command& cmd, const octave_value& bounds) +{ + return instance ().do_execute (cmd, bounds); +} + +bool +tree_jit::execute (tree_while_command& cmd) +{ + return instance ().do_execute (cmd); +} + +bool +tree_jit::execute (octave_user_function& fcn, const octave_value_list& args, + octave_value_list& retval) +{ + return instance ().do_execute (fcn, args, retval); +} + +tree_jit& +tree_jit::instance (void) +{ + static tree_jit ret; + return ret; +} + +bool +tree_jit::initialize (void) +{ + if (engine) + return true; + + if (! module) + { + llvm::InitializeNativeTarget (); + module = new llvm::Module ("octave", context); + } + + // sometimes this fails pre main + engine = llvm::ExecutionEngine::createJIT (module); + + if (! engine) + return false; + + module_pass_manager = new llvm::PassManager (); + module_pass_manager->add (llvm::createAlwaysInlinerPass ()); + + pass_manager = new llvm::FunctionPassManager (module); + pass_manager->add (new llvm::TargetData(*engine->getTargetData ())); + pass_manager->add (llvm::createCFGSimplificationPass ()); + pass_manager->add (llvm::createBasicAliasAnalysisPass ()); + pass_manager->add (llvm::createPromoteMemoryToRegisterPass ()); + pass_manager->add (llvm::createInstructionCombiningPass ()); + pass_manager->add (llvm::createReassociatePass ()); + pass_manager->add (llvm::createGVNPass ()); + pass_manager->add (llvm::createCFGSimplificationPass ()); + pass_manager->doInitialization (); + + jit_typeinfo::initialize (module, engine); + + return true; +} + +bool +tree_jit::do_execute (tree_simple_for_command& cmd, const octave_value& bounds) +{ + const size_t MIN_TRIP_COUNT = 1000; + + size_t tc = trip_count (bounds); + if (! tc || ! initialize () || ! enabled ()) + return false; + + jit_info::vmap extra_vars; + extra_vars["#for_bounds0"] = &bounds; + + jit_info *info = cmd.get_info (); + if (! info || ! info->match (extra_vars)) + { + if (tc < MIN_TRIP_COUNT) + return false; + + delete info; + info = new jit_info (*this, cmd, bounds); + cmd.stash_info (info); + } + + return info->execute (extra_vars); +} + +bool +tree_jit::do_execute (tree_while_command& cmd) +{ + if (! initialize () || ! enabled ()) + return false; + + jit_info *info = cmd.get_info (); + if (! info || ! info->match ()) + { + delete info; + info = new jit_info (*this, cmd); + cmd.stash_info (info); + } + + return info->execute (); +} + +bool +tree_jit::do_execute (octave_user_function& fcn, const octave_value_list& args, + octave_value_list& retval) +{ + if (! initialize () || ! enabled ()) + return false; + + jit_function_info *info = fcn.get_info (); + if (! info || ! info->match (args)) + { + delete info; + info = new jit_function_info (*this, fcn, args); + fcn.stash_info (info); + } + + return info->execute (args, retval); +} + +bool +tree_jit::enabled (void) +{ + // Ideally, we should only disable JIT if there is a breakpoint in the code we + // are about to run. However, we can't figure this out in O(1) time, so we + // conservatively check for the existence of any breakpoints. + return Vjit_enable && ! bp_table::have_breakpoints () + && ! Vdebug_on_interrupt && ! Vdebug_on_error; +} + +size_t +tree_jit::trip_count (const octave_value& bounds) const +{ + if (bounds.is_range ()) + { + Range rng = bounds.range_value (); + return rng.nelem (); + } + + // unsupported type + return 0; +} + + +void +tree_jit::optimize (llvm::Function *fn) +{ + if (Vdebug_jit) + llvm::verifyModule (*module); + + module_pass_manager->run (*module); + pass_manager->run (*fn); + + if (Vdebug_jit) + { + std::string error; + llvm::raw_fd_ostream fout ("test.bc", error, + llvm::raw_fd_ostream::F_Binary); + llvm::WriteBitcodeToFile (module, fout); + } +} + +// -------------------- jit_function_info -------------------- +jit_function_info::jit_function_info (tree_jit& tjit, + octave_user_function& fcn, + const octave_value_list& ov_args) + : argument_types (ov_args.length ()), function (0) +{ + size_t nargs = ov_args.length (); + for (size_t i = 0; i < nargs; ++i) + argument_types[i] = jit_typeinfo::type_of (ov_args(i)); + + jit_function raw_fn; + jit_function wrapper; + + try + { + jit_convert conv (fcn, argument_types); + jit_infer infer (conv.get_factory (), conv.get_blocks (), + conv.get_variable_map ()); + infer.infer (); + + if (Vdebug_jit) + { + jit_block_list& blocks = infer.get_blocks (); + blocks.label (); + std::cout << "-------------------- Compiling function "; + std::cout << "--------------------\n"; + + tree_print_code tpc (std::cout); + tpc.visit_octave_user_function_header (fcn); + tpc.visit_statement_list (*fcn.body ()); + tpc.visit_octave_user_function_trailer (fcn); + blocks.print (std::cout, "octave jit ir"); + } + + jit_factory& factory = conv.get_factory (); + llvm::Module *module = tjit.get_module (); + jit_convert_llvm to_llvm; + raw_fn = to_llvm.convert_function (module, infer.get_blocks (), + factory.constants (), fcn, + argument_types); + + if (Vdebug_jit) + { + std::cout << "-------------------- raw function "; + std::cout << "--------------------\n"; + std::cout << *raw_fn.to_llvm () << std::endl; + llvm::verifyFunction (*raw_fn.to_llvm ()); + } + + std::string wrapper_name = fcn.name () + "_wrapper"; + jit_type *any_t = jit_typeinfo::get_any (); + std::vector wrapper_args (1, jit_typeinfo::get_any_ptr ()); + wrapper = jit_function (module, jit_convention::internal, wrapper_name, + any_t, wrapper_args); + + llvm::BasicBlock *wrapper_body = wrapper.new_block (); + builder.SetInsertPoint (wrapper_body); + + llvm::Value *wrapper_arg = wrapper.argument (builder, 0); + std::vector raw_args (nargs); + for (size_t i = 0; i < nargs; ++i) + { + llvm::Value *arg; + arg = builder.CreateConstInBoundsGEP1_32 (wrapper_arg, i); + arg = builder.CreateLoad (arg); + + jit_type *arg_type = argument_types[i]; + const jit_function& cast = jit_typeinfo::cast (arg_type, any_t); + raw_args[i] = cast.call (builder, arg); + } + + llvm::Value *result = raw_fn.call (builder, raw_args); + if (raw_fn.result ()) + { + jit_type *raw_result_t = raw_fn.result (); + const jit_function& cast = jit_typeinfo::cast (any_t, raw_result_t); + result = cast.call (builder, result); + } + else + { + llvm::Value *zero = builder.getInt32 (0); + result = builder.CreateBitCast (zero, any_t->to_llvm ()); + } + + wrapper.do_return (builder, result); + + llvm::Function *llvm_function = wrapper.to_llvm (); + tjit.optimize (llvm_function); + + if (Vdebug_jit) + { + std::cout << "-------------------- optimized and wrapped "; + std::cout << "--------------------\n"; + std::cout << *llvm_function << std::endl; + llvm::verifyFunction (*llvm_function); + } + + llvm::ExecutionEngine* engine = tjit.get_engine (); + void *void_fn = engine->getPointerToFunction (llvm_function); + function = reinterpret_cast (void_fn); + } + catch (const jit_fail_exception& e) + { + argument_types.clear (); + + if (Vdebug_jit) + { + if (e.known ()) + std::cout << "jit fail: " << e.what () << std::endl; + } + + wrapper.erase (); + raw_fn.erase (); + } +} + +bool +jit_function_info::execute (const octave_value_list& ov_args, + octave_value_list& retval) const +{ + if (! function) + return false; + + // TODO figure out a way to delete ov_args so we avoid duplicating refcount + size_t nargs = ov_args.length (); + std::vector args (nargs); + for (size_t i = 0; i < nargs; ++i) + { + octave_base_value *obv = ov_args(i).internal_rep (); + obv->grab (); + args[i] = obv; + } + + octave_base_value *ret = function (&args[0]); + if (ret) + retval(0) = octave_value (ret); + + octave_quit (); + + return true; +} + +bool +jit_function_info::match (const octave_value_list& ov_args) const +{ + if (! function) + return true; + + size_t nargs = ov_args.length (); + if (nargs != argument_types.size ()) + return false; + + for (size_t i = 0; i < nargs; ++i) + if (jit_typeinfo::type_of (ov_args(i)) != argument_types[i]) + return false; + + return true; +} + +// -------------------- jit_info -------------------- +jit_info::jit_info (tree_jit& tjit, tree& tee) + : engine (tjit.get_engine ()), function (0), llvm_function (0) +{ + compile (tjit, tee); +} + +jit_info::jit_info (tree_jit& tjit, tree& tee, const octave_value& for_bounds) + : engine (tjit.get_engine ()), function (0), llvm_function (0) +{ + compile (tjit, tee, jit_typeinfo::type_of (for_bounds)); +} + +jit_info::~jit_info (void) +{ + if (llvm_function) + llvm_function->eraseFromParent (); +} + +bool +jit_info::execute (const vmap& extra_vars) const +{ + if (! function) + return false; + + std::vector real_arguments (arguments.size ()); + for (size_t i = 0; i < arguments.size (); ++i) + { + if (arguments[i].second) + { + octave_value current = find (extra_vars, arguments[i].first); + octave_base_value *obv = current.internal_rep (); + obv->grab (); + real_arguments[i] = obv; + } + } + + function (&real_arguments[0]); + + for (size_t i = 0; i < arguments.size (); ++i) + { + const std::string& name = arguments[i].first; + + // do not store for loop bounds temporary + if (name.size () && name[0] != '#') + symbol_table::assign (arguments[i].first, real_arguments[i]); + } + + octave_quit (); + + return true; +} + +bool +jit_info::match (const vmap& extra_vars) const +{ + if (! function) + return true; + + for (size_t i = 0; i < bounds.size (); ++i) + { + const std::string& arg_name = bounds[i].second; + octave_value value = find (extra_vars, arg_name); + jit_type *type = jit_typeinfo::type_of (value); + + // FIXME: Check for a parent relationship + if (type != bounds[i].first) + return false; + } + + return true; +} + +void +jit_info::compile (tree_jit& tjit, tree& tee, jit_type *for_bounds) +{ + try + { + jit_convert conv (tee, for_bounds); + jit_infer infer (conv.get_factory (), conv.get_blocks (), + conv.get_variable_map ()); + + infer.infer (); + + if (Vdebug_jit) + { + jit_block_list& blocks = infer.get_blocks (); + blocks.label (); + std::cout << "-------------------- Compiling tree --------------------\n"; + std::cout << tee.str_print_code () << std::endl; + blocks.print (std::cout, "octave jit ir"); + } + + jit_factory& factory = conv.get_factory (); + jit_convert_llvm to_llvm; + llvm_function = to_llvm.convert_loop (tjit.get_module (), + infer.get_blocks (), + factory.constants ()); + arguments = to_llvm.get_arguments (); + bounds = conv.get_bounds (); + } + catch (const jit_fail_exception& e) + { + if (Vdebug_jit) + { + if (e.known ()) + std::cout << "jit fail: " << e.what () << std::endl; + } + } + + if (llvm_function) + { + if (Vdebug_jit) + { + std::cout << "-------------------- llvm ir --------------------"; + std::cout << *llvm_function << std::endl; + llvm::verifyFunction (*llvm_function); + } + + tjit.optimize (llvm_function); + + if (Vdebug_jit) + { + std::cout << "-------------------- optimized llvm ir " + << "--------------------\n"; + std::cout << *llvm_function << std::endl; + } + + void *void_fn = engine->getPointerToFunction (llvm_function); + function = reinterpret_cast (void_fn); + } +} + +octave_value +jit_info::find (const vmap& extra_vars, const std::string& vname) const +{ + vmap::const_iterator iter = extra_vars.find (vname); + return iter == extra_vars.end () ? symbol_table::varval (vname) + : *iter->second; +} + +#endif + +DEFUN (debug_jit, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} debug_jit ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} debug_jit (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} debug_jit (@var{new_val}, \"local\")\n\ +Query or set the internal variable that determines whether\n\ +debugging/tracing is enabled for Octave's JIT compiler.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{jit_enable}\n\ +@end deftypefn") +{ +#if defined (HAVE_LLVM) + return SET_INTERNAL_VARIABLE (debug_jit); +#else + warning ("debug_jit: JIT compiling not available in this version of Octave"); + return octave_value (); +#endif +} + +DEFUN (jit_enable, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} jit_enable ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} jit_enable (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} jit_enable (@var{new_val}, \"local\")\n\ +Query or set the internal variable that enables Octave's JIT compiler.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{debug_jit}\n\ +@end deftypefn") +{ +#if defined (HAVE_LLVM) + return SET_INTERNAL_VARIABLE (jit_enable); +#else + warning ("jit_enable: JIT compiling not available in this version of Octave"); + return octave_value (); +#endif +} + +/* +Test some simple cases that compile. + +%!test +%! for i=1:1e6 +%! if i < 5 +%! break +%! else +%! break +%! endif +%! endfor +%! assert (i, 1); + +%!test +%! while 1 +%! if 1 +%! break +%! else +%! break +%! endif +%! endwhile + +%!test +%! for i=1:1e6 +%! if i == 100 +%! break +%! endif +%! endfor +%! assert (i, 100); + +%!test +%! inc = 1e-5; +%! result = 0; +%! for ii = 0:inc:1 +%! result = result + inc * (1/3 * ii * ii); +%! endfor +%! assert (abs (result - 1/9) < 1e-5); + +%!test +%! inc = 1e-5; +%! result = 0; +%! for ii = 0:inc:1 +%! # the ^ operator's result is complex +%! result = result + inc * (1/3 * ii ^ 2); +%! endfor +%! assert (abs (result - 1/9) < 1e-5); + +%!test +%! temp = 1+1i; +%! nan = NaN; +%! while 1 +%! temp = temp - 1i; +%! temp = temp * nan; +%! break; +%! endwhile +%! assert (imag (temp), 0); + +%!test +%! temp = 1+1i; +%! nan = NaN+1i; +%! while 1 +%! nan = nan - 1i; +%! temp = temp - 1i; +%! temp = temp * nan; +%! break; +%! endwhile +%! assert (imag (temp), 0); + +%!test +%! temp = 1+1i; +%! while 1 +%! temp = temp * 5; +%! break; +%! endwhile +%! assert (temp, 5+5i); + +%!test +%! nr = 1001; +%! mat = zeros (1, nr); +%! for i = 1:nr +%! mat(i) = i; +%! endfor +%! assert (mat == 1:nr); + +%!test +%! nr = 1001; +%! mat = 1:nr; +%! mat(end) = 0; # force mat to a matrix +%! total = 0; +%! for i = 1:nr +%! total = mat(i) + total; +%! endfor +%! assert (sum (mat) == total); + +%!test +%! nr = 1001; +%! mat = [3 1 5]; +%! try +%! for i = 1:nr +%! if i > 500 +%! result = mat(100); +%! else +%! result = i; +%! endif +%! endfor +%! catch +%! end +%! assert (result == 500); + +%!function result = gen_test (n) +%! result = double (rand (1, n) > .01); +%!endfunction + +%!function z = vectorized (A, K) +%! temp = ones (1, K); +%! z = conv (A, temp); +%! z = z > K-1; +%! z = conv (z, temp); +%! z = z(K:end-K+1); +%! z = z >= 1; +%!endfunction + +%!function z = loopy (A, K) +%! z = A; +%! n = numel (A); +%! counter = 0; +%! for ii=1:n +%! if z(ii) +%! counter = counter + 1; +%! else +%! if counter > 0 && counter < K +%! z(ii-counter:ii-1) = 0; +%! endif +%! counter = 0; +%! endif +%! endfor +%! +%! if counter > 0 && counter < K +%! z(end-counter+1:end) = 0; +%! endif +%!endfunction + +%!test +%! test_set = gen_test (10000); +%! assert (all (vectorized (test_set, 3) == loopy (test_set, 3))); + +%!test +%! niter = 1001; +%! i = 0; +%! while (i < niter) +%! i = i + 1; +%! endwhile +%! assert (i == niter); + +%!test +%! niter = 1001; +%! result = 0; +%! m = [5 10]; +%! for i=1:niter +%! result = result + m(end); +%! endfor +%! assert (result == m(end) * niter); + +%!test +%! ndim = 100; +%! result = 0; +%! m = zeros (ndim); +%! m(:) = 1:ndim^2; +%! i = 1; +%! while (i <= ndim) +%! for j = 1:ndim +%! result = result + m(i, j); +%! endfor +%! i = i + 1; +%! endwhile +%! assert (result == sum (sum (m))); + +%!test +%! ndim = 100; +%! m = zeros (ndim); +%! i = 1; +%! while (i <= ndim) +%! for j = 1:ndim +%! m(i, j) = (j - 1) * ndim + i; +%! endfor +%! i = i + 1; +%! endwhile +%! m2 = zeros (ndim); +%! m2(:) = 1:(ndim^2); +%! assert (all (m == m2)); + +%!test +%! ndim = 2; +%! m = zeros (ndim, ndim, ndim, ndim); +%! result = 0; +%! i0 = 1; +%! while (i0 <= ndim) +%! for i1 = 1:ndim +%! for i2 = 1:ndim +%! for i3 = 1:ndim +%! m(i0, i1, i2, i3) = 1; +%! m(i0, i1, i2, i3, 1, 1, 1, 1, 1, 1) = 1; +%! result = result + m(i0, i1, i2, i3); +%! endfor +%! endfor +%! endfor +%! i0 = i0 + 1; +%! endwhile +%! expected = ones (ndim, ndim, ndim, ndim); +%! assert (all (m == expected)); +%! assert (result == sum (expected (:))); + +%!function test_divide () +%! state = warning ("query", "Octave:divide-by-zero").state; +%! unwind_protect +%! warning ("error", "Octave:divide-by-zero"); +%! for i=1:1e5 +%! a = 1; +%! a / 0; +%! endfor +%! unwind_protect_cleanup +%! warning (state, "Octave:divide-by-zero"); +%! end_unwind_protect +%!endfunction + +%!error test_divide () + +%!test +%! while 1 +%! a = 0; +%! result = a / 1; +%! break; +%! endwhile +%! assert (result, 0); + +%!test +%! m = zeros (2, 1001); +%! for i=1:1001 +%! m(end, i) = i; +%! m(end - 1, end - i + 1) = i; +%! endfor +%! m2 = zeros (2, 1001); +%! m2(1, :) = fliplr (1:1001); +%! m2(2, :) = 1:1001; +%! assert (m, m2); + +%!test +%! m = [1 2 3]; +%! for i=1:1001 +%! m = sin (m); +%! break; +%! endfor +%! assert (m == sin ([1 2 3])); + +%!test +%! i = 0; +%! while i < 10 +%! i += 1; +%! endwhile +%! assert (i == 10); + +%!test +%! i = 0; +%! while i < 10 +%! a = ++i; +%! endwhile +%! assert (i == 10); +%! assert (a == 10); +%!test +%! i = 0; +%! while i < 10 +%! a = i++; +%! endwhile +%! assert (i == 10); +%! assert (a == 9); + +%!test +%! num = 2; +%! a = zeros (1, num); +%! i = 1; +%! while i <= num +%! a(i) = norm (eye (i)); +%! ++i; +%! endwhile +%! assert (a, ones (1, num)); + +%!function test_compute_idom () +%! while (li <= length (l1) && si <= length (s1)) +%! if (l1 (li) < s1 (si)) +%! if (li == si) +%! break; +%! endif; +%! li++; +%! else +%! si++; +%! endif; +%! endwhile + +%!error test_compute_idom () + +%!function x = test_overload (a) +%! while 1 +%! x = a; +%! break; +%! endwhile +%!endfunction + +%!assert (test_overload (1), 1); +%!assert (test_overload ([1 2]), [1 2]); + +%!function a = bubble (a = [3 2 1]) +%! swapped = 1; +%! n = length (a); +%! while (swapped) +%! swapped = 0; +%! for i = 1:n-1 +%! if a(i) > a(i + 1) +%! swapped = 1; +%! temp = a(i); +%! a(i) = a(i + 1); +%! a(i + 1) = temp; +%! endif +%! endfor +%! endwhile +%!endfunction + +%!assert (bubble (), [1 2 3]); + +%!test +%! a = 0; +%! b = 1; +%! for i=1:1e3 +%! for j=1:2 +%! a = a + b; +%! endfor +%! endfor +%! assert (a, 2000); +%! assert (b, 1); + +%!test +%! a = [1+1i 1+2i]; +%! b = 0; +%! while 1 +%! b = a(1); +%! break; +%! endwhile +%! assert (b, a(1)); + +%!function test_undef () +%! for i=1:1e7 +%! XXX; +%! endfor +%!endfunction + +%!error (test_undef); + +%!shared id +%! id = @(x) x; + +%!assert (id (1), 1); +%!assert (id (1+1i), 1+1i) +%!assert (id (1, 2), 1) +%!error (id ()) + + +*/ diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/pt-jit.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/pt-jit.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,444 @@ +/* + +Copyright (C) 2012 Max Brister + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Author: Max Brister + +#if !defined (octave_tree_jit_h) +#define octave_tree_jit_h 1 + +#ifdef HAVE_LLVM + +#include "jit-ir.h" +#include "pt-walk.h" +#include "symtab.h" + +class octave_value_list; + +// Convert from the parse tree (AST) to the low level Octave IR. +class +jit_convert : public tree_walker +{ +public: + typedef std::pair type_bound; + typedef std::vector type_bound_vector; + typedef std::map variable_map; + + jit_convert (tree &tee, jit_type *for_bounds = 0); + + jit_convert (octave_user_function& fcn, const std::vector& args); + +#define DECL_ARG(n) const ARG ## n& arg ## n +#define JIT_CREATE_CHECKED(N) \ + template \ + jit_call *create_checked (OCT_MAKE_LIST (DECL_ARG, N)) \ + { \ + jit_call *ret = factory.create (OCT_MAKE_ARG_LIST (arg, N)); \ + return create_checked_impl (ret); \ + } + + JIT_CREATE_CHECKED (1) + JIT_CREATE_CHECKED (2) + JIT_CREATE_CHECKED (3) + JIT_CREATE_CHECKED (4) + +#undef JIT_CREATE_CHECKED +#undef DECL_ARG + + jit_block_list& get_blocks (void) { return blocks; } + + const type_bound_vector& get_bounds (void) const { return bounds; } + + jit_factory& get_factory (void) { return factory; } + + llvm::Function *get_function (void) const { return function; } + + const variable_map &get_variable_map (void) const { return vmap; } + + void visit_anon_fcn_handle (tree_anon_fcn_handle&); + + void visit_argument_list (tree_argument_list&); + + void visit_binary_expression (tree_binary_expression&); + + void visit_break_command (tree_break_command&); + + void visit_colon_expression (tree_colon_expression&); + + void visit_continue_command (tree_continue_command&); + + void visit_global_command (tree_global_command&); + + void visit_persistent_command (tree_persistent_command&); + + void visit_decl_elt (tree_decl_elt&); + + void visit_decl_init_list (tree_decl_init_list&); + + void visit_simple_for_command (tree_simple_for_command&); + + void visit_complex_for_command (tree_complex_for_command&); + + void visit_octave_user_script (octave_user_script&); + + void visit_octave_user_function (octave_user_function&); + + void visit_octave_user_function_header (octave_user_function&); + + void visit_octave_user_function_trailer (octave_user_function&); + + void visit_function_def (tree_function_def&); + + void visit_identifier (tree_identifier&); + + void visit_if_clause (tree_if_clause&); + + void visit_if_command (tree_if_command&); + + void visit_if_command_list (tree_if_command_list&); + + void visit_index_expression (tree_index_expression&); + + void visit_matrix (tree_matrix&); + + void visit_cell (tree_cell&); + + void visit_multi_assignment (tree_multi_assignment&); + + void visit_no_op_command (tree_no_op_command&); + + void visit_constant (tree_constant&); + + void visit_fcn_handle (tree_fcn_handle&); + + void visit_parameter_list (tree_parameter_list&); + + void visit_postfix_expression (tree_postfix_expression&); + + void visit_prefix_expression (tree_prefix_expression&); + + void visit_return_command (tree_return_command&); + + void visit_return_list (tree_return_list&); + + void visit_simple_assignment (tree_simple_assignment&); + + void visit_statement (tree_statement&); + + void visit_statement_list (tree_statement_list&); + + void visit_switch_case (tree_switch_case&); + + void visit_switch_case_list (tree_switch_case_list&); + + void visit_switch_command (tree_switch_command&); + + void visit_try_catch_command (tree_try_catch_command&); + + void visit_unwind_protect_command (tree_unwind_protect_command&); + + void visit_while_command (tree_while_command&); + + void visit_do_until_command (tree_do_until_command&); +private: + std::vector > arguments; + type_bound_vector bounds; + + bool converting_function; + + // the scope of the function we are converting, or the current scope + symbol_table::scope_id scope; + + jit_factory factory; + + // used instead of return values from visit_* functions + jit_value *result; + + jit_block *entry_block; + + jit_block *final_block; + + jit_block *block; + + llvm::Function *function; + + jit_block_list blocks; + + std::vector end_context; + + size_t iterator_count; + size_t for_bounds_count; + size_t short_count; + + variable_map vmap; + + void initialize (symbol_table::scope_id s); + + jit_call *create_checked_impl (jit_call *ret); + + // get an existing vairable. If the variable does not exist, it will not be + // created + jit_variable *find_variable (const std::string& vname) const; + + // get a variable, create it if it does not exist. The type will default to + // the variable's current type in the symbol table. + jit_variable *get_variable (const std::string& vname); + + // create a variable of the given name and given type. Will also insert an + // extract statement + jit_variable *create_variable (const std::string& vname, jit_type *type, + bool isarg = true); + + // The name of the next for loop iterator. If inc is false, then the iterator + // counter will not be incremented. + std::string next_iterator (bool inc = true) + { return next_name ("#iter", iterator_count, inc); } + + std::string next_for_bounds (bool inc = true) + { return next_name ("#for_bounds", for_bounds_count, inc); } + + std::string next_shortcircut_result (bool inc = true) + { return next_name ("#shortcircut_result", short_count, inc); } + + std::string next_name (const char *prefix, size_t& count, bool inc); + + jit_instruction *resolve (tree_index_expression& exp, + jit_value *extra_arg = 0, bool lhs = false); + + jit_value *do_assign (tree_expression *exp, jit_value *rhs, + bool artificial = false); + + jit_value *do_assign (const std::string& lhs, jit_value *rhs, bool print, + bool artificial = false); + + jit_value *visit (tree *tee) { return visit (*tee); } + + jit_value *visit (tree& tee); + + typedef std::list block_list; + block_list breaks; + block_list continues; + + void finish_breaks (jit_block *dest, const block_list& lst); +}; + +// Convert from the low level Octave IR to LLVM +class +jit_convert_llvm : public jit_ir_walker +{ +public: + llvm::Function *convert_loop (llvm::Module *module, + const jit_block_list& blocks, + const std::list& constants); + + jit_function convert_function (llvm::Module *module, + const jit_block_list& blocks, + const std::list& constants, + octave_user_function& fcn, + const std::vector& args); + + // arguments to the llvm::Function for loops + const std::vector >& get_arguments(void) const + { return argument_vec; } + +#define JIT_METH(clname) \ + virtual void visit (jit_ ## clname&); + + JIT_VISIT_IR_CLASSES; + +#undef JIT_METH +private: + // name -> argument index (used for compiling functions) + std::map argument_index; + + std::vector > argument_vec; + + // name -> llvm argument (used for compiling loops) + std::map arguments; + + bool converting_function; + + // only used if we are converting a function + jit_function creating; + + llvm::Function *function; + llvm::BasicBlock *prelude; + + void convert (const jit_block_list& blocks, + const std::list& constants); + + void finish_phi (jit_phi *phi); + + void visit (jit_value *jvalue) + { + return visit (*jvalue); + } + + void visit (jit_value &jvalue) + { + jvalue.accept (*this); + } +}; + +// type inference and SSA construction on the low level Octave IR +class +jit_infer +{ +public: + typedef jit_convert::variable_map variable_map; + + jit_infer (jit_factory& afactory, jit_block_list& ablocks, + const variable_map& avmap); + + jit_block_list& get_blocks (void) const { return blocks; } + + jit_factory& get_factory (void) const { return factory; } + + void infer (void); +private: + jit_block_list& blocks; + jit_factory& factory; + const variable_map& vmap; + std::list worklist; + + void append_users (jit_value *v); + + void append_users_term (jit_terminator *term); + + void construct_ssa (void); + + void do_construct_ssa (jit_block& block, size_t avisit_count); + + jit_block& entry_block (void) { return *blocks.front (); } + + jit_block& final_block (void) { return *blocks.back (); } + + void place_releases (void); + + void push_worklist (jit_instruction *instr); + + void remove_dead (); + + void release_dead_phi (jit_block& ablock); + + void release_temp (jit_block& ablock, std::set& temp); + + void simplify_phi (void); + + void simplify_phi (jit_phi& phi); +}; + +class +tree_jit +{ +public: + ~tree_jit (void); + + static bool execute (tree_simple_for_command& cmd, + const octave_value& bounds); + + static bool execute (tree_while_command& cmd); + + static bool execute (octave_user_function& fcn, const octave_value_list& args, + octave_value_list& retval); + + llvm::ExecutionEngine *get_engine (void) const { return engine; } + + llvm::Module *get_module (void) const { return module; } + + void optimize (llvm::Function *fn); + private: + tree_jit (void); + + static tree_jit& instance (void); + + bool initialize (void); + + bool do_execute (tree_simple_for_command& cmd, const octave_value& bounds); + + bool do_execute (tree_while_command& cmd); + + bool do_execute (octave_user_function& fcn, const octave_value_list& args, + octave_value_list& retval); + + bool enabled (void); + + size_t trip_count (const octave_value& bounds) const; + + llvm::Module *module; + llvm::PassManager *module_pass_manager; + llvm::FunctionPassManager *pass_manager; + llvm::ExecutionEngine *engine; +}; + +class +jit_function_info +{ +public: + jit_function_info (tree_jit& tjit, octave_user_function& fcn, + const octave_value_list& ov_args); + + bool execute (const octave_value_list& ov_args, + octave_value_list& retval) const; + + bool match (const octave_value_list& ov_args) const; +private: + typedef octave_base_value *(*jited_function)(octave_base_value**); + + std::vector argument_types; + jited_function function; +}; + +class +jit_info +{ +public: + // we use a pointer here so we don't have to include ov.h + typedef std::map vmap; + + jit_info (tree_jit& tjit, tree& tee); + + jit_info (tree_jit& tjit, tree& tee, const octave_value& for_bounds); + + ~jit_info (void); + + bool execute (const vmap& extra_vars = vmap ()) const; + + bool match (const vmap& extra_vars = vmap ()) const; +private: + typedef jit_convert::type_bound type_bound; + typedef jit_convert::type_bound_vector type_bound_vector; + typedef void (*jited_function)(octave_base_value**); + + void compile (tree_jit& tjit, tree& tee, jit_type *for_bounds = 0); + + octave_value find (const vmap& extra_vars, const std::string& vname) const; + + llvm::ExecutionEngine *engine; + jited_function function; + llvm::Function *llvm_function; + + std::vector > arguments; + type_bound_vector bounds; +}; + +#endif +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/sighandlers.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/sighandlers.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,988 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include +#include + +#include +#include + +#include "cmd-edit.h" +#include "oct-syscalls.h" +#include "quit.h" +#include "singleton-cleanup.h" + +#include "debug.h" +#include "defun.h" +#include "error.h" +#include "input.h" +#include "load-save.h" +#include "oct-map.h" +#include "pager.h" +#include "pt-bp.h" +#include "pt-eval.h" +#include "sighandlers.h" +#include "sysdep.h" +#include "syswait.h" +#include "toplev.h" +#include "utils.h" +#include "variables.h" + +// Nonzero means we have already printed a message for this series of +// SIGPIPES. We assume that the writer will eventually give up. +int pipe_handler_error_count = 0; + +// TRUE means we can be interrupted. +bool can_interrupt = false; + +// TRUE means we should try to enter the debugger on SIGINT. +bool Vdebug_on_interrupt = false; + +// Allow users to avoid writing octave-workspace for SIGHUP (sent by +// closing gnome-terminal, for example). Note that this variable has +// no effect if Vcrash_dumps_octave_core is FALSE. +static bool Vsighup_dumps_octave_core = true; + +// Similar to Vsighup_dumps_octave_core, but for SIGTERM signal. +static bool Vsigterm_dumps_octave_core = true; + +// List of signals we have caught since last call to octave_signal_handler. +static bool octave_signals_caught[NSIG]; + +// Signal handler return type. +#ifndef BADSIG +#define BADSIG (void (*)(int))-1 +#endif + +// The following is a workaround for an apparent bug in GCC 4.1.2 and +// possibly earlier versions. See Octave bug report #30685 for details. +#if defined (__GNUC__) +# if ! (__GNUC__ > 4 \ + || (__GNUC__ == 4 && (__GNUC_MINOR__ > 1 \ + || (__GNUC_MINOR__ == 1 && __GNUC_PATCHLEVEL__ > 2)))) +# undef GNULIB_NAMESPACE +# define GNULIB_NAMESPACE +# warning "disabling GNULIB_NAMESPACE for signal functions -- consider upgrading to a current version of GCC" +# endif +#endif + +#define BLOCK_SIGNAL(sig, nvar, ovar) \ + do \ + { \ + GNULIB_NAMESPACE::sigemptyset (&nvar); \ + GNULIB_NAMESPACE::sigaddset (&nvar, sig); \ + GNULIB_NAMESPACE::sigemptyset (&ovar); \ + GNULIB_NAMESPACE::sigprocmask (SIG_BLOCK, &nvar, &ovar); \ + } \ + while (0) + +#if !defined (SIGCHLD) && defined (SIGCLD) +#define SIGCHLD SIGCLD +#endif + +#define BLOCK_CHILD(nvar, ovar) BLOCK_SIGNAL (SIGCHLD, nvar, ovar) +#define UNBLOCK_CHILD(ovar) GNULIB_NAMESPACE::sigprocmask (SIG_SETMASK, &ovar, 0) + +// Called from octave_quit () to actually do something about the signals +// we have caught. + +void +octave_signal_handler (void) +{ + // The list of signals is relatively short, so we will just go + // linearly through the list. + + for (int i = 0; i < NSIG; i++) + { + if (octave_signals_caught[i]) + { + octave_signals_caught[i] = false; + + switch (i) + { +#ifdef SIGCHLD + case SIGCHLD: + { + volatile octave_interrupt_handler saved_interrupt_handler + = octave_ignore_interrupts (); + + sigset_t set, oset; + + BLOCK_CHILD (set, oset); + + octave_child_list::wait (); + + octave_set_interrupt_handler (saved_interrupt_handler); + + UNBLOCK_CHILD (oset); + + octave_child_list::reap (); + } + break; +#endif + + case SIGFPE: + std::cerr << "warning: floating point exception" << std::endl; + break; + +#ifdef SIGPIPE + case SIGPIPE: + std::cerr << "warning: broken pipe" << std::endl; + break; +#endif + } + } + } +} + +static void +my_friendly_exit (const char *sig_name, int sig_number, + bool save_vars = true) +{ + static bool been_there_done_that = false; + + if (been_there_done_that) + { +#if defined (SIGABRT) + octave_set_signal_handler (SIGABRT, SIG_DFL); +#endif + + std::cerr << "panic: attempted clean up apparently failed -- aborting...\n"; + + MINGW_SIGNAL_CLEANUP (); + + abort (); + } + else + { + been_there_done_that = true; + + std::cerr << "panic: " << sig_name << " -- stopping myself...\n"; + + if (save_vars) + dump_octave_core (); + + if (sig_number < 0) + { + MINGW_SIGNAL_CLEANUP (); + + exit (1); + } + else + { + octave_set_signal_handler (sig_number, SIG_DFL); + + GNULIB_NAMESPACE::raise (sig_number); + } + } +} + +sig_handler * +octave_set_signal_handler (int sig, sig_handler *handler, + bool restart_syscalls) +{ + struct sigaction act, oact; + + act.sa_handler = handler; + act.sa_flags = 0; + +#if defined (SIGALRM) + if (sig == SIGALRM) + { +#if defined (SA_INTERRUPT) + act.sa_flags |= SA_INTERRUPT; +#endif + } +#endif +#if defined (SA_RESTART) +#if defined (SIGALRM) + else +#endif + // FIXME -- Do we also need to explicitly disable SA_RESTART? + if (restart_syscalls) + act.sa_flags |= SA_RESTART; +#endif + + GNULIB_NAMESPACE::sigemptyset (&act.sa_mask); + GNULIB_NAMESPACE::sigemptyset (&oact.sa_mask); + + GNULIB_NAMESPACE::sigaction (sig, &act, &oact); + + return oact.sa_handler; +} + +static void +generic_sig_handler (int sig) +{ + my_friendly_exit (strsignal (sig), sig); +} + +// Handle SIGCHLD. + +#ifdef SIGCHLD +static void +sigchld_handler (int /* sig */) +{ + octave_signal_caught = 1; + + octave_signals_caught[SIGCHLD] = true; +} +#endif /* defined (SIGCHLD) */ + +#ifdef SIGFPE +#if defined (__alpha__) +static void +sigfpe_handler (int /* sig */) +{ + if (can_interrupt && octave_interrupt_state >= 0) + { + octave_signal_caught = 1; + + octave_signals_caught[SIGFPE] = true; + + octave_interrupt_state++; + } +} +#endif /* defined (__alpha__) */ +#endif /* defined (SIGFPE) */ + +#if defined (SIGHUP) || defined (SIGTERM) +static void +sig_hup_or_term_handler (int sig) +{ + switch (sig) + { +#if defined (SIGHUP) + case SIGHUP: + { + if (Vsighup_dumps_octave_core) + dump_octave_core (); + } + break; +#endif + +#if defined (SIGTERM) + case SIGTERM: + { + if (Vsigterm_dumps_octave_core) + dump_octave_core (); + } + break; +#endif + + default: + break; + } + + clean_up_and_exit (0); +} +#endif + +#if 0 +#if defined (SIGWINCH) +static void +sigwinch_handler (int /* sig */) +{ + command_editor::resize_terminal (); +} +#endif +#endif + +// Handle SIGINT by restarting the parser (see octave.cc). +// +// This also has to work for SIGBREAK (on systems that have it), so we +// use the value of sig, instead of just assuming that it is called +// for SIGINT only. + +static void +user_abort (const char *sig_name, int sig_number) +{ + if (! octave_initialized) + exit (1); + + if (can_interrupt) + { + if (Vdebug_on_interrupt) + { + if (! octave_debug_on_interrupt_state) + { + tree_evaluator::debug_mode = true; + octave_debug_on_interrupt_state = true; + + return; + } + else + { + // Clear the flag and do normal interrupt stuff. + + tree_evaluator::debug_mode + = bp_table::have_breakpoints () || Vdebugging; + octave_debug_on_interrupt_state = false; + } + } + + if (octave_interrupt_immediately) + { + if (octave_interrupt_state == 0) + octave_interrupt_state = 1; + + octave_jump_to_enclosing_context (); + } + else + { + // If we are already cleaning up from a previous interrupt, + // take note of the fact that another interrupt signal has + // arrived. + + if (octave_interrupt_state < 0) + octave_interrupt_state = 0; + + octave_signal_caught = 1; + octave_interrupt_state++; + + if (interactive && octave_interrupt_state == 2) + std::cerr << "Press Control-C again to abort." << std::endl; + + if (octave_interrupt_state >= 3) + my_friendly_exit (sig_name, sig_number, true); + } + } + +} + +static void +sigint_handler (int sig) +{ + user_abort (strsignal (sig), sig); +} + +#ifdef SIGPIPE +static void +sigpipe_handler (int /* sig */) +{ + octave_signal_caught = 1; + + octave_signals_caught[SIGPIPE] = true; + + // Don't loop forever on account of this. + + if (pipe_handler_error_count++ > 100 && octave_interrupt_state >= 0) + octave_interrupt_state++; +} +#endif /* defined (SIGPIPE) */ + +octave_interrupt_handler +octave_catch_interrupts (void) +{ + octave_interrupt_handler retval; + +#ifdef SIGINT + retval.int_handler = octave_set_signal_handler (SIGINT, sigint_handler); +#endif + +#ifdef SIGBREAK + retval.brk_handler = octave_set_signal_handler (SIGBREAK, sigint_handler); +#endif + + return retval; +} + +octave_interrupt_handler +octave_ignore_interrupts (void) +{ + octave_interrupt_handler retval; + +#ifdef SIGINT + retval.int_handler = octave_set_signal_handler (SIGINT, SIG_IGN); +#endif + +#ifdef SIGBREAK + retval.brk_handler = octave_set_signal_handler (SIGBREAK, SIG_IGN); +#endif + + return retval; +} + +octave_interrupt_handler +octave_set_interrupt_handler (const volatile octave_interrupt_handler& h, + bool restart_syscalls) +{ + octave_interrupt_handler retval; + +#ifdef SIGINT + retval.int_handler = octave_set_signal_handler (SIGINT, h.int_handler, + restart_syscalls); +#endif + +#ifdef SIGBREAK + retval.brk_handler = octave_set_signal_handler (SIGBREAK, h.brk_handler, + restart_syscalls); +#endif + + return retval; +} + +// Install all the handlers for the signals we might care about. + +void +install_signal_handlers (void) +{ + for (int i = 0; i < NSIG; i++) + octave_signals_caught[i] = false; + + octave_catch_interrupts (); + +#ifdef SIGABRT + octave_set_signal_handler (SIGABRT, generic_sig_handler); +#endif + +#ifdef SIGALRM + octave_set_signal_handler (SIGALRM, generic_sig_handler); +#endif + +#ifdef SIGBUS + octave_set_signal_handler (SIGBUS, generic_sig_handler); +#endif + +#ifdef SIGCHLD + octave_set_signal_handler (SIGCHLD, sigchld_handler); +#endif + + // SIGCLD + // SIGCONT + +#ifdef SIGEMT + octave_set_signal_handler (SIGEMT, generic_sig_handler); +#endif + +#ifdef SIGFPE +#if defined (__alpha__) + octave_set_signal_handler (SIGFPE, sigfpe_handler); +#else + octave_set_signal_handler (SIGFPE, generic_sig_handler); +#endif +#endif + +#ifdef SIGHUP + octave_set_signal_handler (SIGHUP, sig_hup_or_term_handler); +#endif + +#ifdef SIGILL + octave_set_signal_handler (SIGILL, generic_sig_handler); +#endif + + // SIGINFO + // SIGINT + +#ifdef SIGIOT + octave_set_signal_handler (SIGIOT, generic_sig_handler); +#endif + +#ifdef SIGLOST + octave_set_signal_handler (SIGLOST, generic_sig_handler); +#endif + +#ifdef SIGPIPE + octave_set_signal_handler (SIGPIPE, sigpipe_handler); +#endif + +#ifdef SIGPOLL + octave_set_signal_handler (SIGPOLL, SIG_IGN); +#endif + + // SIGPROF + // SIGPWR + +#ifdef SIGQUIT + octave_set_signal_handler (SIGQUIT, generic_sig_handler); +#endif + +#ifdef SIGSEGV + octave_set_signal_handler (SIGSEGV, generic_sig_handler); +#endif + + // SIGSTOP + +#ifdef SIGSYS + octave_set_signal_handler (SIGSYS, generic_sig_handler); +#endif + +#ifdef SIGTERM + octave_set_signal_handler (SIGTERM, sig_hup_or_term_handler); +#endif + +#ifdef SIGTRAP + octave_set_signal_handler (SIGTRAP, generic_sig_handler); +#endif + + // SIGTSTP + // SIGTTIN + // SIGTTOU + // SIGURG + +#ifdef SIGUSR1 + octave_set_signal_handler (SIGUSR1, generic_sig_handler); +#endif + +#ifdef SIGUSR2 + octave_set_signal_handler (SIGUSR2, generic_sig_handler); +#endif + +#ifdef SIGVTALRM + octave_set_signal_handler (SIGVTALRM, generic_sig_handler); +#endif + +#ifdef SIGIO + octave_set_signal_handler (SIGIO, SIG_IGN); +#endif + +#if 0 +#ifdef SIGWINCH + octave_set_signal_handler (SIGWINCH, sigwinch_handler); +#endif +#endif + +#ifdef SIGXCPU + octave_set_signal_handler (SIGXCPU, generic_sig_handler); +#endif + +#ifdef SIGXFSZ + octave_set_signal_handler (SIGXFSZ, generic_sig_handler); +#endif + +} + +static octave_scalar_map +make_sig_struct (void) +{ + octave_scalar_map m; + +#ifdef SIGABRT + m.assign ("ABRT", SIGABRT); +#endif + +#ifdef SIGALRM + m.assign ("ALRM", SIGALRM); +#endif + +#ifdef SIGBUS + m.assign ("BUS", SIGBUS); +#endif + +#ifdef SIGCHLD + m.assign ("CHLD", SIGCHLD); +#endif + +#ifdef SIGCLD + m.assign ("CLD", SIGCLD); +#endif + +#ifdef SIGCONT + m.assign ("CONT", SIGCONT); +#endif + +#ifdef SIGEMT + m.assign ("EMT", SIGEMT); +#endif + +#ifdef SIGFPE + m.assign ("FPE", SIGFPE); +#endif + +#ifdef SIGHUP + m.assign ("HUP", SIGHUP); +#endif + +#ifdef SIGILL + m.assign ("ILL", SIGILL); +#endif + +#ifdef SIGINFO + m.assign ("INFO", SIGINFO); +#endif + +#ifdef SIGINT + m.assign ("INT", SIGINT); +#endif + +#ifdef SIGIO + m.assign ("IO", SIGIO); +#endif + +#ifdef SIGIOT + m.assign ("IOT", SIGIOT); +#endif + +#ifdef SIGKILL + m.assign ("KILL", SIGKILL); +#endif + +#ifdef SIGLOST + m.assign ("LOST", SIGLOST); +#endif + +#ifdef SIGPIPE + m.assign ("PIPE", SIGPIPE); +#endif + +#ifdef SIGPOLL + m.assign ("POLL", SIGPOLL); +#endif + +#ifdef SIGPROF + m.assign ("PROF", SIGPROF); +#endif + +#ifdef SIGPWR + m.assign ("PWR", SIGPWR); +#endif + +#ifdef SIGQUIT + m.assign ("QUIT", SIGQUIT); +#endif + +#ifdef SIGSEGV + m.assign ("SEGV", SIGSEGV); +#endif + +#ifdef SIGSTKFLT + m.assign ("STKFLT", SIGSTKFLT); +#endif + +#ifdef SIGSTOP + m.assign ("STOP", SIGSTOP); +#endif + +#ifdef SIGSYS + m.assign ("SYS", SIGSYS); +#endif + +#ifdef SIGTERM + m.assign ("TERM", SIGTERM); +#endif + +#ifdef SIGTRAP + m.assign ("TRAP", SIGTRAP); +#endif + +#ifdef SIGTSTP + m.assign ("TSTP", SIGTSTP); +#endif + +#ifdef SIGTTIN + m.assign ("TTIN", SIGTTIN); +#endif + +#ifdef SIGTTOU + m.assign ("TTOU", SIGTTOU); +#endif + +#ifdef SIGUNUSED + m.assign ("UNUSED", SIGUNUSED); +#endif + +#ifdef SIGURG + m.assign ("URG", SIGURG); +#endif + +#ifdef SIGUSR1 + m.assign ("USR1", SIGUSR1); +#endif + +#ifdef SIGUSR2 + m.assign ("USR2", SIGUSR2); +#endif + +#ifdef SIGVTALRM + m.assign ("VTALRM", SIGVTALRM); +#endif + +#ifdef SIGWINCH + m.assign ("WINCH", SIGWINCH); +#endif + +#ifdef SIGXCPU + m.assign ("XCPU", SIGXCPU); +#endif + +#ifdef SIGXFSZ + m.assign ("XFSZ", SIGXFSZ); +#endif + + return m; +} + +octave_child_list::octave_child_list_rep *octave_child_list::instance = 0; + +bool +octave_child_list::instance_ok (void) +{ + bool retval = true; + + if (! instance) + { + instance = new octave_child_list_rep (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } + + if (! instance) + { + ::error ("unable to create child list object!"); + + retval = false; + } + + return retval; +} + +void +octave_child_list::insert (pid_t pid, octave_child::child_event_handler f) +{ + if (instance_ok ()) + instance->insert (pid, f); +} + +void +octave_child_list::reap (void) +{ + if (instance_ok ()) + instance->reap (); +} + +bool +octave_child_list::wait (void) +{ + return (instance_ok ()) ? instance->wait () : false; +} + +class pid_equal +{ +public: + + pid_equal (pid_t v) : val (v) { } + + bool operator () (const octave_child& oc) const { return oc.pid == val; } + +private: + + pid_t val; +}; + +void +octave_child_list::remove (pid_t pid) +{ + if (instance_ok ()) + instance->remove_if (pid_equal (pid)); +} + +#define OCL_REP octave_child_list::octave_child_list_rep + +void +OCL_REP::insert (pid_t pid, octave_child::child_event_handler f) +{ + append (octave_child (pid, f)); +} + +void +OCL_REP::reap (void) +{ + // Mark the record for PID invalid. + + for (iterator p = begin (); p != end (); p++) + { + // The call to the octave_child::child_event_handler might + // invalidate the iterator (for example, by calling + // octave_child_list::remove), so we increment the iterator + // here. + + octave_child& oc = *p; + + if (oc.have_status) + { + oc.have_status = 0; + + octave_child::child_event_handler f = oc.handler; + + if (f && f (oc.pid, oc.status)) + oc.pid = -1; + } + } + + remove_if (pid_equal (-1)); +} + +// Wait on our children and record any changes in their status. + +bool +OCL_REP::wait (void) +{ + bool retval = false; + + for (iterator p = begin (); p != end (); p++) + { + octave_child& oc = *p; + + pid_t pid = oc.pid; + + if (pid > 0) + { + int status; + + if (octave_syscalls::waitpid (pid, &status, WNOHANG) > 0) + { + oc.have_status = 1; + + oc.status = status; + + retval = true; + + break; + } + } + } + + return retval; +} + +DEFUN (SIG, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} SIG ()\n\ +Return a structure containing Unix signal names and their defined values.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 0) + { + static octave_scalar_map m = make_sig_struct (); + + retval = m; + } + else + print_usage (); + + return retval; +} + +/* +%!assert (isstruct (SIG ())) +%!assert (! isempty (SIG ())) + +%!error SIG (1) +*/ + +DEFUN (debug_on_interrupt, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} debug_on_interrupt ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} debug_on_interrupt (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} debug_on_interrupt (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave will try\n\ +to enter debugging mode when it receives an interrupt signal (typically\n\ +generated with @kbd{C-c}). If a second interrupt signal is received\n\ +before reaching the debugging mode, a normal interrupt will occur.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{debug_on_error, debug_on_warning}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (debug_on_interrupt); +} + +/* +%!test +%! orig_val = debug_on_interrupt (); +%! old_val = debug_on_interrupt (! orig_val); +%! assert (orig_val, old_val); +%! assert (debug_on_interrupt (), ! orig_val); +%! debug_on_interrupt (orig_val); +%! assert (debug_on_interrupt (), orig_val); + +%!error (debug_on_interrupt (1, 2)) +*/ + +DEFUN (sighup_dumps_octave_core, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} sighup_dumps_octave_core ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} sighup_dumps_octave_core (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} sighup_dumps_octave_core (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave tries\n\ +to save all current variables to the file \"octave-workspace\" if it receives\n\ +a hangup signal.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (sighup_dumps_octave_core); +} + +/* +%!test +%! orig_val = sighup_dumps_octave_core (); +%! old_val = sighup_dumps_octave_core (! orig_val); +%! assert (orig_val, old_val); +%! assert (sighup_dumps_octave_core (), ! orig_val); +%! sighup_dumps_octave_core (orig_val); +%! assert (sighup_dumps_octave_core (), orig_val); + +%!error (sighup_dumps_octave_core (1, 2)) +*/ + +DEFUN (sigterm_dumps_octave_core, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} sigterm_dumps_octave_core ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} sigterm_dumps_octave_core (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} sigterm_dumps_octave_core (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave tries\n\ +to save all current variables to the file \"octave-workspace\" if it receives\n\ +a terminate signal.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (sigterm_dumps_octave_core); +} + +/* +%!test +%! orig_val = sigterm_dumps_octave_core (); +%! old_val = sigterm_dumps_octave_core (! orig_val); +%! assert (orig_val, old_val); +%! assert (sigterm_dumps_octave_core (), ! orig_val); +%! sigterm_dumps_octave_core (orig_val); +%! assert (sigterm_dumps_octave_core (), orig_val); + +%!error (sigterm_dumps_octave_core (1, 2)) +*/ diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/sighandlers.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/sighandlers.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,180 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +/* + +The signal blocking macros defined below were adapted from similar +functions from GNU Bash, the Bourne Again SHell, copyright (C) 1994 +Free Software Foundation, Inc. + +*/ + +// This file should always be included after config.h! + +#if !defined (octave_sighandlers_h) +#define octave_sighandlers_h 1 + +// Include signal.h, not csignal since the latter might only define +// the ANSI standard C signal interface. + +#include + +#include "syswait.h" +#include "siglist.h" + +#include "base-list.h" + +typedef void sig_handler (int); + +// FIXME -- the data should probably be private... + +struct +octave_interrupt_handler +{ +#ifdef SIGINT + sig_handler *int_handler; +#endif + +#ifdef SIGBREAK + sig_handler *brk_handler; +#endif +}; + +// Nonzero means we have already printed a message for this series of +// SIGPIPES. We assume that the writer will eventually give up. +extern int pipe_handler_error_count; + +// TRUE means we can be interrupted. +extern OCTINTERP_API bool can_interrupt; + +extern OCTINTERP_API sig_handler *octave_set_signal_handler (int, sig_handler *, + bool restart_syscalls = true); + +extern OCTINTERP_API void install_signal_handlers (void); + +extern OCTINTERP_API void octave_signal_handler (void); + +extern OCTINTERP_API octave_interrupt_handler octave_catch_interrupts (void); + +extern OCTINTERP_API octave_interrupt_handler octave_ignore_interrupts (void); + +extern OCTINTERP_API octave_interrupt_handler +octave_set_interrupt_handler (const volatile octave_interrupt_handler&, + bool restart_syscalls = true); + +// extern void ignore_sigchld (void); + +// Maybe this should be in a separate file? + +class +OCTINTERP_API +octave_child +{ +public: + + // Do whatever to handle event for child with PID (might not + // actually be dead, could just be stopped). Return true if + // the list element corresponding to PID should be removed from + // list. This function should not call any functions that modify + // the octave_child_list. + + typedef bool (*child_event_handler) (pid_t, int); + + octave_child (pid_t id = -1, child_event_handler f = 0) + : pid (id), handler (f), have_status (0), status (0) { } + + octave_child (const octave_child& oc) + : pid (oc.pid), handler (oc.handler), + have_status (oc.have_status), status (oc.status) { } + + octave_child& operator = (const octave_child& oc) + { + if (&oc != this) + { + pid = oc.pid; + handler = oc.handler; + have_status = oc.have_status; + status = oc.status; + } + return *this; + } + + ~octave_child (void) { } + + // The process id of this child. + pid_t pid; + + // The function we call if an event happens for this child. + child_event_handler handler; + + // Nonzero if this child has stopped or terminated. + sig_atomic_t have_status; + + // The status of this child; 0 if running, otherwise a status value + // from waitpid. + int status; +}; + +class +OCTINTERP_API +octave_child_list +{ +protected: + + octave_child_list (void) { } + + class octave_child_list_rep : public octave_base_list + { + public: + + void insert (pid_t pid, octave_child::child_event_handler f); + + void reap (void); + + bool wait (void); + }; + +public: + + ~octave_child_list (void) { } + + static void insert (pid_t pid, octave_child::child_event_handler f); + + static void reap (void); + + static bool wait (void); + + static void remove (pid_t pid); + +private: + + static bool instance_ok (void); + + static octave_child_list_rep *instance; + + static void cleanup_instance (void) { delete instance; instance = 0; } +}; + +// TRUE means we should try to enter the debugger on SIGINT. +extern OCTINTERP_API bool Vdebug_on_interrupt; + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/siglist.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/siglist.c Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,238 @@ +/* + +Copyright (C) 2000-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "siglist.h" + +/* The following is all borrowed from Emacs. */ + +#if ! (defined HAVE_STRSIGNAL || HAVE_DECL_SYS_SIGLIST) + +static char *my_sys_siglist[NSIG]; + +#ifdef sys_siglist +#undef sys_siglist +#endif +#define sys_siglist my_sys_siglist + +#endif + +void +init_signals (void) +{ +#if ! (defined HAVE_STRSIGNAL || HAVE_DECL_SYS_SIGLIST) + + static int initialized = 0; + + if (! initialized) + { + initialized = 1; + +# ifdef SIGABRT + sys_siglist[SIGABRT] = "Aborted"; +# endif +# ifdef SIGAIO + sys_siglist[SIGAIO] = "LAN I/O interrupt"; +# endif +# ifdef SIGALRM + sys_siglist[SIGALRM] = "Alarm clock"; +# endif +# ifdef SIGBUS + sys_siglist[SIGBUS] = "Bus error"; +# endif +# ifdef SIGCLD + sys_siglist[SIGCLD] = "Child status changed"; +# endif +# ifdef SIGCHLD + sys_siglist[SIGCHLD] = "Child status changed"; +# endif +# ifdef SIGCONT + sys_siglist[SIGCONT] = "Continued"; +# endif +# ifdef SIGDANGER + sys_siglist[SIGDANGER] = "Swap space dangerously low"; +# endif +# ifdef SIGDGNOTIFY + sys_siglist[SIGDGNOTIFY] = "Notification message in queue"; +# endif +# ifdef SIGEMT + sys_siglist[SIGEMT] = "Emulation trap"; +# endif +# ifdef SIGFPE + sys_siglist[SIGFPE] = "Arithmetic exception"; +# endif +# ifdef SIGFREEZE + sys_siglist[SIGFREEZE] = "SIGFREEZE"; +# endif +# ifdef SIGGRANT + sys_siglist[SIGGRANT] = "Monitor mode granted"; +# endif +# ifdef SIGHUP + sys_siglist[SIGHUP] = "Hangup"; +# endif +# ifdef SIGILL + sys_siglist[SIGILL] = "Illegal instruction"; +# endif +# ifdef SIGINT + sys_siglist[SIGINT] = "Interrupt"; +# endif +# ifdef SIGIO + sys_siglist[SIGIO] = "I/O possible"; +# endif +# ifdef SIGIOINT + sys_siglist[SIGIOINT] = "I/O intervention required"; +# endif +# ifdef SIGIOT + sys_siglist[SIGIOT] = "IOT trap"; +# endif +# ifdef SIGKILL + sys_siglist[SIGKILL] = "Killed"; +# endif +# ifdef SIGLOST + sys_siglist[SIGLOST] = "Resource lost"; +# endif +# ifdef SIGLWP + sys_siglist[SIGLWP] = "SIGLWP"; +# endif +# ifdef SIGMSG + sys_siglist[SIGMSG] = "Monitor mode data available"; +# endif +# ifdef SIGPHONE + sys_siglist[SIGPHONE] = "SIGPHONE"; +# endif +# ifdef SIGPIPE + sys_siglist[SIGPIPE] = "Broken pipe"; +# endif +# ifdef SIGPOLL + sys_siglist[SIGPOLL] = "Pollable event occurred"; +# endif +# ifdef SIGPROF + sys_siglist[SIGPROF] = "Profiling timer expired"; +# endif +# ifdef SIGPTY + sys_siglist[SIGPTY] = "PTY I/O interrupt"; +# endif +# ifdef SIGPWR + sys_siglist[SIGPWR] = "Power-fail restart"; +# endif +# ifdef SIGQUIT + sys_siglist[SIGQUIT] = "Quit"; +# endif +# ifdef SIGRETRACT + sys_siglist[SIGRETRACT] = "Need to relinguish monitor mode"; +# endif +# ifdef SIGSAK + sys_siglist[SIGSAK] = "Secure attention"; +# endif +# ifdef SIGSEGV + sys_siglist[SIGSEGV] = "Segmentation violation"; +# endif +# ifdef SIGSOUND + sys_siglist[SIGSOUND] = "Sound completed"; +# endif +# ifdef SIGSTKFLT + sys_siglist[SIGSTKFLT] = "Stack fault"; +# endif +# ifdef SIGSTOP + sys_siglist[SIGSTOP] = "Stopped (signal)"; +# endif +# ifdef SIGSTP + sys_siglist[SIGSTP] = "Stopped (user)"; +# endif +# ifdef SIGSYS + sys_siglist[SIGSYS] = "Bad argument to system call"; +# endif +# ifdef SIGTERM + sys_siglist[SIGTERM] = "Terminated"; +# endif +# ifdef SIGTHAW + sys_siglist[SIGTHAW] = "SIGTHAW"; +# endif +# ifdef SIGTRAP + sys_siglist[SIGTRAP] = "Trace/breakpoint trap"; +# endif +# ifdef SIGTSTP + sys_siglist[SIGTSTP] = "Stopped (user)"; +# endif +# ifdef SIGTTIN + sys_siglist[SIGTTIN] = "Stopped (tty input)"; +# endif +# ifdef SIGTTOU + sys_siglist[SIGTTOU] = "Stopped (tty output)"; +# endif +# ifdef SIGUNUSED + sys_siglist[SIGUNUSED] = "SIGUNUSED"; +# endif +# ifdef SIGURG + sys_siglist[SIGURG] = "Urgent I/O condition"; +# endif +# ifdef SIGUSR1 + sys_siglist[SIGUSR1] = "User defined signal 1"; +# endif +# ifdef SIGUSR2 + sys_siglist[SIGUSR2] = "User defined signal 2"; +# endif +# ifdef SIGVTALRM + sys_siglist[SIGVTALRM] = "Virtual timer expired"; +# endif +# ifdef SIGWAITING + sys_siglist[SIGWAITING] = "Process's LWPs are blocked"; +# endif +# ifdef SIGWINCH + sys_siglist[SIGWINCH] = "Window size changed"; +# endif +# ifdef SIGWIND + sys_siglist[SIGWIND] = "SIGWIND"; +# endif +# ifdef SIGXCPU + sys_siglist[SIGXCPU] = "CPU time limit exceeded"; +# endif +# ifdef SIGXFSZ + sys_siglist[SIGXFSZ] = "File size limit exceeded"; +# endif + } + +#endif +} + +#if ! defined (HAVE_STRSIGNAL) + +char * +strsignal (int code) +{ + char *signame = ""; + + if (0 <= code && code < NSIG) + { + /* Cast to suppress warning if the table has const char *. */ + signame = (char *) sys_siglist[code]; + } + + return signame; +} + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/siglist.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/siglist.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,47 @@ +/* + +Copyright (C) 2000-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_siglist_h) +#define octave_siglist_h 1 + +#ifdef __cplusplus +extern "C" +{ +#endif + +/* This is borrowed from Emacs. */ + +#if ! defined (HAVE_DECL_SYS_SIGLIST) +extern char *sys_siglist[]; +#endif + +extern void init_signals (void); + +#if ! defined (HAVE_STRSIGNAL) +extern char *strsignal (int); +#endif + +#ifdef __cplusplus +} +#endif + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/sparse-xdiv.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/sparse-xdiv.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,633 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "Array-util.h" +#include "oct-cmplx.h" +#include "quit.h" +#include "error.h" +#include "lo-ieee.h" + +#include "dSparse.h" +#include "dDiagMatrix.h" +#include "CSparse.h" +#include "CDiagMatrix.h" +#include "oct-spparms.h" +#include "sparse-xdiv.h" + +static void +solve_singularity_warning (double rcond) +{ + warning ("matrix singular to machine precision, rcond = %g", rcond); + warning ("attempting to find minimum norm solution"); +} + +template +bool +mx_leftdiv_conform (const T1& a, const T2& b) +{ + octave_idx_type a_nr = a.rows (); + octave_idx_type b_nr = b.rows (); + + if (a_nr != b_nr) + { + octave_idx_type a_nc = a.cols (); + octave_idx_type b_nc = b.cols (); + + gripe_nonconformant ("operator \\", a_nr, a_nc, b_nr, b_nc); + return false; + } + + return true; +} + +#define INSTANTIATE_MX_LEFTDIV_CONFORM(T1, T2) \ + template bool mx_leftdiv_conform (const T1&, const T2&) + +INSTANTIATE_MX_LEFTDIV_CONFORM (SparseMatrix, SparseMatrix); +INSTANTIATE_MX_LEFTDIV_CONFORM (SparseMatrix, SparseComplexMatrix); +INSTANTIATE_MX_LEFTDIV_CONFORM (SparseComplexMatrix, SparseMatrix); +INSTANTIATE_MX_LEFTDIV_CONFORM (SparseComplexMatrix, SparseComplexMatrix); +INSTANTIATE_MX_LEFTDIV_CONFORM (SparseMatrix, Matrix); +INSTANTIATE_MX_LEFTDIV_CONFORM (SparseMatrix, ComplexMatrix); +INSTANTIATE_MX_LEFTDIV_CONFORM (SparseComplexMatrix, Matrix); +INSTANTIATE_MX_LEFTDIV_CONFORM (SparseComplexMatrix, ComplexMatrix); +INSTANTIATE_MX_LEFTDIV_CONFORM (DiagMatrix, SparseMatrix); +INSTANTIATE_MX_LEFTDIV_CONFORM (DiagMatrix, SparseComplexMatrix); +INSTANTIATE_MX_LEFTDIV_CONFORM (ComplexDiagMatrix, SparseMatrix); +INSTANTIATE_MX_LEFTDIV_CONFORM (ComplexDiagMatrix, SparseComplexMatrix); + +template +bool +mx_div_conform (const T1& a, const T2& b) +{ + octave_idx_type a_nc = a.cols (); + octave_idx_type b_nc = b.cols (); + + if (a_nc != b_nc) + { + octave_idx_type a_nr = a.rows (); + octave_idx_type b_nr = b.rows (); + + gripe_nonconformant ("operator /", a_nr, a_nc, b_nr, b_nc); + return false; + } + + return true; +} + +#define INSTANTIATE_MX_DIV_CONFORM(T1, T2) \ + template bool mx_div_conform (const T1&, const T2&) + +INSTANTIATE_MX_DIV_CONFORM (SparseMatrix, SparseMatrix); +INSTANTIATE_MX_DIV_CONFORM (SparseMatrix, SparseComplexMatrix); +INSTANTIATE_MX_DIV_CONFORM (SparseComplexMatrix, SparseMatrix); +INSTANTIATE_MX_DIV_CONFORM (SparseComplexMatrix, SparseComplexMatrix); +INSTANTIATE_MX_DIV_CONFORM (Matrix, SparseMatrix); +INSTANTIATE_MX_DIV_CONFORM (Matrix, SparseComplexMatrix); +INSTANTIATE_MX_DIV_CONFORM (ComplexMatrix, SparseMatrix); +INSTANTIATE_MX_DIV_CONFORM (ComplexMatrix, SparseComplexMatrix); +INSTANTIATE_MX_DIV_CONFORM (SparseMatrix, DiagMatrix); +INSTANTIATE_MX_DIV_CONFORM (SparseMatrix, ComplexDiagMatrix); +INSTANTIATE_MX_DIV_CONFORM (SparseComplexMatrix, DiagMatrix); +INSTANTIATE_MX_DIV_CONFORM (SparseComplexMatrix, ComplexDiagMatrix); + +// Right division functions. X / Y = X * inv (Y) = (inv (Y') * X')' +// +// Y / X: m cm sm scm +// +-- +---+----+----+----+ +// sparse matrix | 1 | 3 | 5 | 7 | +// +---+----+----+----+ +// sparse complex_matrix | 2 | 4 | 6 | 8 | +// +---+----+----+----+ +// diagonal matrix | 9 | 11 | +// +----+----+ +// complex diag. matrix | 10 | 12 | +// +----+----+ + +// -*- 1 -*- +Matrix +xdiv (const Matrix& a, const SparseMatrix& b, MatrixType &typ) +{ + if (! mx_div_conform (a, b)) + return Matrix (); + + Matrix atmp = a.transpose (); + SparseMatrix btmp = b.transpose (); + MatrixType btyp = typ.transpose (); + + octave_idx_type info; + double rcond = 0.0; + Matrix result = btmp.solve (btyp, atmp, info, rcond, + solve_singularity_warning); + + typ = btyp.transpose (); + return result.transpose (); +} + +// -*- 2 -*- +ComplexMatrix +xdiv (const Matrix& a, const SparseComplexMatrix& b, MatrixType &typ) +{ + if (! mx_div_conform (a, b)) + return ComplexMatrix (); + + Matrix atmp = a.transpose (); + SparseComplexMatrix btmp = b.hermitian (); + MatrixType btyp = typ.transpose (); + + octave_idx_type info; + double rcond = 0.0; + ComplexMatrix result + = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); + + typ = btyp.transpose (); + return result.hermitian (); +} + +// -*- 3 -*- +ComplexMatrix +xdiv (const ComplexMatrix& a, const SparseMatrix& b, MatrixType &typ) +{ + if (! mx_div_conform (a, b)) + return ComplexMatrix (); + + ComplexMatrix atmp = a.hermitian (); + SparseMatrix btmp = b.transpose (); + MatrixType btyp = typ.transpose (); + + octave_idx_type info; + double rcond = 0.0; + ComplexMatrix result + = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); + + typ = btyp.transpose (); + return result.hermitian (); +} + +// -*- 4 -*- +ComplexMatrix +xdiv (const ComplexMatrix& a, const SparseComplexMatrix& b, MatrixType &typ) +{ + if (! mx_div_conform (a, b)) + return ComplexMatrix (); + + ComplexMatrix atmp = a.hermitian (); + SparseComplexMatrix btmp = b.hermitian (); + MatrixType btyp = typ.transpose (); + + octave_idx_type info; + double rcond = 0.0; + ComplexMatrix result + = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); + + typ = btyp.transpose (); + return result.hermitian (); +} + +// -*- 5 -*- +SparseMatrix +xdiv (const SparseMatrix& a, const SparseMatrix& b, MatrixType &typ) +{ + if (! mx_div_conform (a, b)) + return SparseMatrix (); + + SparseMatrix atmp = a.transpose (); + SparseMatrix btmp = b.transpose (); + MatrixType btyp = typ.transpose (); + + octave_idx_type info; + double rcond = 0.0; + SparseMatrix result = btmp.solve (btyp, atmp, info, rcond, + solve_singularity_warning); + + typ = btyp.transpose (); + return result.transpose (); +} + +// -*- 6 -*- +SparseComplexMatrix +xdiv (const SparseMatrix& a, const SparseComplexMatrix& b, MatrixType &typ) +{ + if (! mx_div_conform (a, b)) + return SparseComplexMatrix (); + + SparseMatrix atmp = a.transpose (); + SparseComplexMatrix btmp = b.hermitian (); + MatrixType btyp = typ.transpose (); + + octave_idx_type info; + double rcond = 0.0; + SparseComplexMatrix result + = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); + + typ = btyp.transpose (); + return result.hermitian (); +} + +// -*- 7 -*- +SparseComplexMatrix +xdiv (const SparseComplexMatrix& a, const SparseMatrix& b, MatrixType &typ) +{ + if (! mx_div_conform (a, b)) + return SparseComplexMatrix (); + + SparseComplexMatrix atmp = a.hermitian (); + SparseMatrix btmp = b.transpose (); + MatrixType btyp = typ.transpose (); + + octave_idx_type info; + double rcond = 0.0; + SparseComplexMatrix result + = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); + + typ = btyp.transpose (); + return result.hermitian (); +} + +// -*- 8 -*- +SparseComplexMatrix +xdiv (const SparseComplexMatrix& a, const SparseComplexMatrix& b, MatrixType &typ) +{ + if (! mx_div_conform (a, b)) + return SparseComplexMatrix (); + + SparseComplexMatrix atmp = a.hermitian (); + SparseComplexMatrix btmp = b.hermitian (); + MatrixType btyp = typ.transpose (); + + octave_idx_type info; + double rcond = 0.0; + SparseComplexMatrix result + = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); + + typ = btyp.transpose (); + return result.hermitian (); +} + +template +RT do_rightdiv_sm_dm (const SM& a, const DM& d) +{ + const octave_idx_type d_nr = d.rows (); + + const octave_idx_type a_nr = a.rows (); + const octave_idx_type a_nc = a.cols (); + + using std::min; + const octave_idx_type nc = min (d_nr, a_nc); + + if ( ! mx_div_conform (a, d)) + return RT (); + + const octave_idx_type nz = a.nnz (); + RT r (a_nr, nc, nz); + + typedef typename DM::element_type DM_elt_type; + const DM_elt_type zero = DM_elt_type (); + + octave_idx_type k_result = 0; + for (octave_idx_type j = 0; j < nc; ++j) + { + octave_quit (); + const DM_elt_type s = d.dgelem (j); + const octave_idx_type colend = a.cidx (j+1); + r.xcidx (j) = k_result; + if (s != zero) + for (octave_idx_type k = a.cidx (j); k < colend; ++k) + { + r.xdata (k_result) = a.data (k) / s; + r.xridx (k_result) = a.ridx (k); + ++k_result; + } + } + r.xcidx (nc) = k_result; + + r.maybe_compress (true); + return r; +} + +// -*- 9 -*- +SparseMatrix +xdiv (const SparseMatrix& a, const DiagMatrix& b, MatrixType &) +{ + return do_rightdiv_sm_dm (a, b); +} + +// -*- 10 -*- +SparseComplexMatrix +xdiv (const SparseMatrix& a, const ComplexDiagMatrix& b, MatrixType &) +{ + return do_rightdiv_sm_dm (a, b); +} + +// -*- 11 -*- +SparseComplexMatrix +xdiv (const SparseComplexMatrix& a, const DiagMatrix& b, MatrixType &) +{ + return do_rightdiv_sm_dm (a, b); +} + +// -*- 12 -*- +SparseComplexMatrix +xdiv (const SparseComplexMatrix& a, const ComplexDiagMatrix& b, MatrixType &) +{ + return do_rightdiv_sm_dm (a, b); +} + +// Funny element by element division operations. +// +// op2 \ op1: s cs +// +-- +---+----+ +// matrix | 1 | 3 | +// +---+----+ +// complex_matrix | 2 | 4 | +// +---+----+ + +Matrix +x_el_div (double a, const SparseMatrix& b) +{ + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.cols (); + + Matrix result; + if (a == 0.) + result = Matrix (nr, nc, octave_NaN); + else if (a > 0.) + result = Matrix (nr, nc, octave_Inf); + else + result = Matrix (nr, nc, -octave_Inf); + + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++) + { + octave_quit (); + result.elem (b.ridx (i), j) = a / b.data (i); + } + + return result; +} + +ComplexMatrix +x_el_div (double a, const SparseComplexMatrix& b) +{ + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.cols (); + + ComplexMatrix result (nr, nc, Complex (octave_NaN, octave_NaN)); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++) + { + octave_quit (); + result.elem (b.ridx (i), j) = a / b.data (i); + } + + return result; +} + +ComplexMatrix +x_el_div (const Complex a, const SparseMatrix& b) +{ + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.cols (); + + ComplexMatrix result (nr, nc, (a / 0.0)); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++) + { + octave_quit (); + result.elem (b.ridx (i), j) = a / b.data (i); + } + + return result; +} + +ComplexMatrix +x_el_div (const Complex a, const SparseComplexMatrix& b) +{ + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.cols (); + + ComplexMatrix result (nr, nc, (a / 0.0)); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++) + { + octave_quit (); + result.elem (b.ridx (i), j) = a / b.data (i); + } + + return result; +} + +// Left division functions. X \ Y = inv (X) * Y +// +// Y \ X : sm scm dm dcm +// +-- +---+----+ +// matrix | 1 | 5 | +// +---+----+ +// complex_matrix | 2 | 6 | +// +---+----+----+----+ +// sparse matrix | 3 | 7 | 9 | 11 | +// +---+----+----+----+ +// sparse complex_matrix | 4 | 8 | 10 | 12 | +// +---+----+----+----+ + +// -*- 1 -*- +Matrix +xleftdiv (const SparseMatrix& a, const Matrix& b, MatrixType &typ) +{ + if (! mx_leftdiv_conform (a, b)) + return Matrix (); + + octave_idx_type info; + double rcond = 0.0; + return a.solve (typ, b, info, rcond, solve_singularity_warning); +} + +// -*- 2 -*- +ComplexMatrix +xleftdiv (const SparseMatrix& a, const ComplexMatrix& b, MatrixType &typ) +{ + if (! mx_leftdiv_conform (a, b)) + return ComplexMatrix (); + + octave_idx_type info; + double rcond = 0.0; + return a.solve (typ, b, info, rcond, solve_singularity_warning); +} + +// -*- 3 -*- +SparseMatrix +xleftdiv (const SparseMatrix& a, const SparseMatrix& b, MatrixType &typ) +{ + if (! mx_leftdiv_conform (a, b)) + return SparseMatrix (); + + octave_idx_type info; + double rcond = 0.0; + return a.solve (typ, b, info, rcond, solve_singularity_warning); +} + +// -*- 4 -*- +SparseComplexMatrix +xleftdiv (const SparseMatrix& a, const SparseComplexMatrix& b, MatrixType &typ) +{ + if (! mx_leftdiv_conform (a, b)) + return SparseComplexMatrix (); + + octave_idx_type info; + double rcond = 0.0; + return a.solve (typ, b, info, rcond, solve_singularity_warning); +} + +// -*- 5 -*- +ComplexMatrix +xleftdiv (const SparseComplexMatrix& a, const Matrix& b, MatrixType &typ) +{ + if (! mx_leftdiv_conform (a, b)) + return ComplexMatrix (); + + octave_idx_type info; + double rcond = 0.0; + return a.solve (typ, b, info, rcond, solve_singularity_warning); +} + +// -*- 6 -*- +ComplexMatrix +xleftdiv (const SparseComplexMatrix& a, const ComplexMatrix& b, MatrixType &typ) +{ + if (! mx_leftdiv_conform (a, b)) + return ComplexMatrix (); + + octave_idx_type info; + double rcond = 0.0; + return a.solve (typ, b, info, rcond, solve_singularity_warning); +} + +// -*- 7 -*- +SparseComplexMatrix +xleftdiv (const SparseComplexMatrix& a, const SparseMatrix& b, MatrixType &typ) +{ + if (! mx_leftdiv_conform (a, b)) + return SparseComplexMatrix (); + + octave_idx_type info; + double rcond = 0.0; + return a.solve (typ, b, info, rcond, solve_singularity_warning); +} + +// -*- 8 -*- +SparseComplexMatrix +xleftdiv (const SparseComplexMatrix& a, const SparseComplexMatrix& b, + MatrixType &typ) +{ + if (! mx_leftdiv_conform (a, b)) + return SparseComplexMatrix (); + + octave_idx_type info; + double rcond = 0.0; + return a.solve (typ, b, info, rcond, solve_singularity_warning); +} + +template +RT do_leftdiv_dm_sm (const DM& d, const SM& a) +{ + const octave_idx_type a_nr = a.rows (); + const octave_idx_type a_nc = a.cols (); + + const octave_idx_type d_nc = d.cols (); + + using std::min; + const octave_idx_type nr = min (d_nc, a_nr); + + if ( ! mx_leftdiv_conform (d, a)) + return RT (); + + const octave_idx_type nz = a.nnz (); + RT r (nr, a_nc, nz); + + typedef typename DM::element_type DM_elt_type; + const DM_elt_type zero = DM_elt_type (); + + octave_idx_type k_result = 0; + for (octave_idx_type j = 0; j < a_nc; ++j) + { + octave_quit (); + const octave_idx_type colend = a.cidx (j+1); + r.xcidx (j) = k_result; + for (octave_idx_type k = a.cidx (j); k < colend; ++k) + { + const octave_idx_type i = a.ridx (k); + if (i < nr) + { + const DM_elt_type s = d.dgelem (i); + if (s != zero) + { + r.xdata (k_result) = a.data (k) / s; + r.xridx (k_result) = i; + ++k_result; + } + } + } + } + r.xcidx (a_nc) = k_result; + + r.maybe_compress (true); + return r; +} + +// -*- 9 -*- +SparseMatrix +xleftdiv (const DiagMatrix& d, const SparseMatrix& a, MatrixType&) +{ + return do_leftdiv_dm_sm (d, a); +} + +// -*- 10 -*- +SparseComplexMatrix +xleftdiv (const DiagMatrix& d, const SparseComplexMatrix& a, MatrixType&) +{ + return do_leftdiv_dm_sm (d, a); +} + +// -*- 11 -*- +SparseComplexMatrix +xleftdiv (const ComplexDiagMatrix& d, const SparseMatrix& a, MatrixType&) +{ + return do_leftdiv_dm_sm (d, a); +} + +// -*- 12 -*- +SparseComplexMatrix +xleftdiv (const ComplexDiagMatrix& d, const SparseComplexMatrix& a, MatrixType&) +{ + return do_leftdiv_dm_sm (d, a); +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/sparse-xdiv.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/sparse-xdiv.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,93 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_sparse_xdiv_h) +#define octave_sparse_xdiv_h 1 + +#include "oct-cmplx.h" +#include "MatrixType.h" + +class DiagMatrix; +class ComplexDiagMatrix; +class SparseMatrix; +class SparseComplexMatrix; + +extern Matrix xdiv (const Matrix& a, const SparseMatrix& b, MatrixType &typ); +extern ComplexMatrix xdiv (const Matrix& a, const SparseComplexMatrix& b, + MatrixType &typ); +extern ComplexMatrix xdiv (const ComplexMatrix& a, const SparseMatrix& b, + MatrixType &typ); +extern ComplexMatrix xdiv (const ComplexMatrix& a, + const SparseComplexMatrix& b, MatrixType &typ); + +extern SparseMatrix xdiv (const SparseMatrix& a, const SparseMatrix& b, + MatrixType &typ); +extern SparseComplexMatrix xdiv (const SparseMatrix& a, + const SparseComplexMatrix& b, MatrixType &typ); +extern SparseComplexMatrix xdiv (const SparseComplexMatrix& a, + const SparseMatrix& b, MatrixType &typ); +extern SparseComplexMatrix xdiv (const SparseComplexMatrix& a, + const SparseComplexMatrix& b, MatrixType &typ); + +extern SparseMatrix xdiv (const SparseMatrix& a, + const DiagMatrix& b, MatrixType &typ); +extern SparseComplexMatrix xdiv (const SparseMatrix& a, + const ComplexDiagMatrix& b, MatrixType &typ); +extern SparseComplexMatrix xdiv (const SparseComplexMatrix& a, + const DiagMatrix& b, MatrixType &typ); +extern SparseComplexMatrix xdiv (const SparseComplexMatrix& a, + const ComplexDiagMatrix& b, MatrixType &typ); + +extern Matrix x_el_div (double a, const SparseMatrix& b); +extern ComplexMatrix x_el_div (double a, const SparseComplexMatrix& b); +extern ComplexMatrix x_el_div (const Complex a, const SparseMatrix& b); +extern ComplexMatrix x_el_div (const Complex a, + const SparseComplexMatrix& b); + +extern Matrix xleftdiv (const SparseMatrix& a, const Matrix& b, + MatrixType& typ); +extern ComplexMatrix xleftdiv (const SparseMatrix& a, const ComplexMatrix& b, + MatrixType &typ); +extern ComplexMatrix xleftdiv (const SparseComplexMatrix& a, const Matrix& b, + MatrixType &typ); +extern ComplexMatrix xleftdiv (const SparseComplexMatrix& a, + const ComplexMatrix& b, MatrixType &typ); + +extern SparseMatrix xleftdiv (const SparseMatrix& a, const SparseMatrix& b, + MatrixType &typ); +extern SparseComplexMatrix xleftdiv (const SparseMatrix& a, + const SparseComplexMatrix& b, MatrixType &typ); +extern SparseComplexMatrix xleftdiv (const SparseComplexMatrix& a, + const SparseMatrix& b, MatrixType &typ); +extern SparseComplexMatrix xleftdiv (const SparseComplexMatrix& a, + const SparseComplexMatrix& b, MatrixType &typ); + +extern SparseMatrix xleftdiv (const DiagMatrix&, const SparseMatrix&, MatrixType&); +extern SparseComplexMatrix xleftdiv (const ComplexDiagMatrix&, const SparseMatrix&, + MatrixType&); +extern SparseComplexMatrix xleftdiv (const DiagMatrix&, const SparseComplexMatrix&, + MatrixType&); +extern SparseComplexMatrix xleftdiv (const ComplexDiagMatrix&, const SparseComplexMatrix&, + MatrixType&); + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/sparse-xpow.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/sparse-xpow.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,766 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include + +#include "Array-util.h" +#include "oct-cmplx.h" +#include "quit.h" + +#include "error.h" +#include "oct-obj.h" +#include "utils.h" + +#include "dSparse.h" +#include "CSparse.h" +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" +#include "sparse-xpow.h" + +static inline int +xisint (double x) +{ + return (D_NINT (x) == x + && ((x >= 0 && x < std::numeric_limits::max ()) + || (x <= 0 && x > std::numeric_limits::min ()))); +} + + +// Safer pow functions. Only two make sense for sparse matrices, the +// others should all promote to full matrices. + +octave_value +xpow (const SparseMatrix& a, double b) +{ + octave_value retval; + + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + if (nr == 0 || nc == 0 || nr != nc) + error ("for A^b, A must be a square matrix"); + else + { + if (static_cast (b) == b) + { + int btmp = static_cast (b); + if (btmp == 0) + { + SparseMatrix tmp = SparseMatrix (nr, nr, nr); + for (octave_idx_type i = 0; i < nr; i++) + { + tmp.data (i) = 1.0; + tmp.ridx (i) = i; + } + for (octave_idx_type i = 0; i < nr + 1; i++) + tmp.cidx (i) = i; + + retval = tmp; + } + else + { + SparseMatrix atmp; + if (btmp < 0) + { + btmp = -btmp; + + octave_idx_type info; + double rcond = 0.0; + MatrixType mattyp (a); + + atmp = a.inverse (mattyp, info, rcond, 1); + + if (info == -1) + warning ("inverse: matrix singular to machine\ + precision, rcond = %g", rcond); + } + else + atmp = a; + + SparseMatrix result (atmp); + + btmp--; + + while (btmp > 0) + { + if (btmp & 1) + result = result * atmp; + + btmp >>= 1; + + if (btmp > 0) + atmp = atmp * atmp; + } + + retval = result; + } + } + else + error ("use full(a) ^ full(b)"); + } + + return retval; +} + +octave_value +xpow (const SparseComplexMatrix& a, double b) +{ + octave_value retval; + + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + if (nr == 0 || nc == 0 || nr != nc) + error ("for A^b, A must be a square matrix"); + else + { + if (static_cast (b) == b) + { + int btmp = static_cast (b); + if (btmp == 0) + { + SparseMatrix tmp = SparseMatrix (nr, nr, nr); + for (octave_idx_type i = 0; i < nr; i++) + { + tmp.data (i) = 1.0; + tmp.ridx (i) = i; + } + for (octave_idx_type i = 0; i < nr + 1; i++) + tmp.cidx (i) = i; + + retval = tmp; + } + else + { + SparseComplexMatrix atmp; + if (btmp < 0) + { + btmp = -btmp; + + octave_idx_type info; + double rcond = 0.0; + MatrixType mattyp (a); + + atmp = a.inverse (mattyp, info, rcond, 1); + + if (info == -1) + warning ("inverse: matrix singular to machine\ + precision, rcond = %g", rcond); + } + else + atmp = a; + + SparseComplexMatrix result (atmp); + + btmp--; + + while (btmp > 0) + { + if (btmp & 1) + result = result * atmp; + + btmp >>= 1; + + if (btmp > 0) + atmp = atmp * atmp; + } + + retval = result; + } + } + else + error ("use full(a) ^ full(b)"); + } + + return retval; +} + +// Safer pow functions that work elementwise for matrices. +// +// op2 \ op1: s m cs cm +// +-- +---+---+----+----+ +// scalar | | * | 3 | * | 9 | +// +---+---+----+----+ +// matrix | 1 | 4 | 7 | 10 | +// +---+---+----+----+ +// complex_scalar | * | 5 | * | 11 | +// +---+---+----+----+ +// complex_matrix | 2 | 6 | 8 | 12 | +// +---+---+----+----+ +// +// * -> not needed. + +// FIXME -- these functions need to be fixed so that things +// like +// +// a = -1; b = [ 0, 0.5, 1 ]; r = a .^ b +// +// and +// +// a = -1; b = [ 0, 0.5, 1 ]; for i = 1:3, r(i) = a .^ b(i), end +// +// produce identical results. Also, it would be nice if -1^0.5 +// produced a pure imaginary result instead of a complex number with a +// small real part. But perhaps that's really a problem with the math +// library... + +// Handle special case of scalar-sparse-matrix .^ sparse-matrix. +// Forwarding to the scalar elem_xpow function and then converting the +// result back to a sparse matrix is a bit wasteful but it does not +// seem worth the effort to optimize -- how often does this case come up +// in practice? + +template +inline octave_value +scalar_xpow (const S& a, const SM& b) +{ + octave_value val = elem_xpow (a, b); + + if (val.is_complex_type ()) + return SparseComplexMatrix (val.complex_matrix_value ()); + else + return SparseMatrix (val.matrix_value ()); +} + +/* +%!assert (sparse (2) .^ [3, 4], sparse ([8, 16])); +%!assert (sparse (2i) .^ [3, 4], sparse ([-0-8i, 16])); +*/ + +// -*- 1 -*- +octave_value +elem_xpow (double a, const SparseMatrix& b) +{ + octave_value retval; + + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.cols (); + + double d1, d2; + + if (a < 0.0 && ! b.all_integers (d1, d2)) + { + Complex atmp (a); + ComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + { + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result(i, j) = std::pow (atmp, b(i,j)); + } + } + + retval = result; + } + else + { + Matrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + { + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result(i, j) = std::pow (a, b(i,j)); + } + } + + retval = result; + } + + return retval; +} + +// -*- 2 -*- +octave_value +elem_xpow (double a, const SparseComplexMatrix& b) +{ + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.cols (); + + Complex atmp (a); + ComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + { + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result(i, j) = std::pow (atmp, b(i,j)); + } + } + + return result; +} + +// -*- 3 -*- +octave_value +elem_xpow (const SparseMatrix& a, double b) +{ + // FIXME What should a .^ 0 give?? Matlab gives a + // sparse matrix with same structure as a, which is strictly + // incorrect. Keep compatiability. + + octave_value retval; + + octave_idx_type nz = a.nnz (); + + if (b <= 0.0) + { + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + if (static_cast (b) != b && a.any_element_is_negative ()) + { + ComplexMatrix result (nr, nc, Complex (std::pow (0.0, b))); + + // FIXME -- avoid apparent GNU libm bug by + // converting A and B to complex instead of just A. + Complex btmp (b); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = a.cidx (j); i < a.cidx (j+1); i++) + { + octave_quit (); + + Complex atmp (a.data (i)); + + result(a.ridx (i), j) = std::pow (atmp, btmp); + } + + retval = octave_value (result); + } + else + { + Matrix result (nr, nc, (std::pow (0.0, b))); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = a.cidx (j); i < a.cidx (j+1); i++) + { + octave_quit (); + result(a.ridx (i), j) = std::pow (a.data (i), b); + } + + retval = octave_value (result); + } + } + else if (static_cast (b) != b && a.any_element_is_negative ()) + { + SparseComplexMatrix result (a); + + for (octave_idx_type i = 0; i < nz; i++) + { + octave_quit (); + + // FIXME -- avoid apparent GNU libm bug by + // converting A and B to complex instead of just A. + + Complex atmp (a.data (i)); + Complex btmp (b); + + result.data (i) = std::pow (atmp, btmp); + } + + result.maybe_compress (true); + + retval = result; + } + else + { + SparseMatrix result (a); + + for (octave_idx_type i = 0; i < nz; i++) + { + octave_quit (); + result.data (i) = std::pow (a.data (i), b); + } + + result.maybe_compress (true); + + retval = result; + } + + return retval; +} + +// -*- 4 -*- +octave_value +elem_xpow (const SparseMatrix& a, const SparseMatrix& b) +{ + octave_value retval; + + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + + if (a.numel () == 1 && b.numel () > 1) + return scalar_xpow (a(0), b); + + if (nr != b_nr || nc != b_nc) + { + gripe_nonconformant ("operator .^", nr, nc, b_nr, b_nc); + return octave_value (); + } + + int convert_to_complex = 0; + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = a.cidx (j); i < a.cidx (j+1); i++) + { + if (a.data(i) < 0.0) + { + double btmp = b (a.ridx (i), j); + if (static_cast (btmp) != btmp) + { + convert_to_complex = 1; + goto done; + } + } + } + +done: + + // This is a dumb operator for sparse matrices anyway, and there is + // no sensible way to handle the 0.^0 versus the 0.^x cases. Therefore + // allocate a full matrix filled for the 0.^0 case and shrink it later + // as needed + + if (convert_to_complex) + { + SparseComplexMatrix complex_result (nr, nc, Complex (1.0, 0.0)); + + for (octave_idx_type j = 0; j < nc; j++) + { + for (octave_idx_type i = a.cidx (j); i < a.cidx (j+1); i++) + { + octave_quit (); + complex_result.xelem (a.ridx (i), j) = + std::pow (Complex (a.data (i)), Complex (b(a.ridx (i), j))); + } + } + complex_result.maybe_compress (true); + retval = complex_result; + } + else + { + SparseMatrix result (nr, nc, 1.0); + + for (octave_idx_type j = 0; j < nc; j++) + { + for (octave_idx_type i = a.cidx (j); i < a.cidx (j+1); i++) + { + octave_quit (); + result.xelem (a.ridx (i), j) = std::pow (a.data (i), + b(a.ridx (i), j)); + } + } + result.maybe_compress (true); + retval = result; + } + + return retval; +} + +// -*- 5 -*- +octave_value +elem_xpow (const SparseMatrix& a, const Complex& b) +{ + octave_value retval; + + if (b == 0.0) + // Can this case ever happen, due to automatic retyping with maybe_mutate? + retval = octave_value (NDArray (a.dims (), 1)); + else + { + octave_idx_type nz = a.nnz (); + SparseComplexMatrix result (a); + + for (octave_idx_type i = 0; i < nz; i++) + { + octave_quit (); + result.data (i) = std::pow (Complex (a.data (i)), b); + } + + result.maybe_compress (true); + + retval = result; + } + + return retval; +} + +// -*- 6 -*- +octave_value +elem_xpow (const SparseMatrix& a, const SparseComplexMatrix& b) +{ + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + + if (a.numel () == 1 && b.numel () > 1) + return scalar_xpow (a(0), b); + + if (nr != b_nr || nc != b_nc) + { + gripe_nonconformant ("operator .^", nr, nc, b_nr, b_nc); + return octave_value (); + } + + SparseComplexMatrix result (nr, nc, Complex (1.0, 0.0)); + for (octave_idx_type j = 0; j < nc; j++) + { + for (octave_idx_type i = a.cidx (j); i < a.cidx (j+1); i++) + { + octave_quit (); + result.xelem (a.ridx(i), j) = std::pow (a.data (i), b(a.ridx (i), j)); + } + } + + result.maybe_compress (true); + + return result; +} + +// -*- 7 -*- +octave_value +elem_xpow (const Complex& a, const SparseMatrix& b) +{ + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.cols (); + + ComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + { + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + double btmp = b (i, j); + if (xisint (btmp)) + result (i, j) = std::pow (a, static_cast (btmp)); + else + result (i, j) = std::pow (a, btmp); + } + } + + return result; +} + +// -*- 8 -*- +octave_value +elem_xpow (const Complex& a, const SparseComplexMatrix& b) +{ + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.cols (); + + ComplexMatrix result (nr, nc); + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = std::pow (a, b (i, j)); + } + + return result; +} + +// -*- 9 -*- +octave_value +elem_xpow (const SparseComplexMatrix& a, double b) +{ + octave_value retval; + + if (b <= 0) + { + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + ComplexMatrix result (nr, nc, Complex (std::pow (0.0, b))); + + if (xisint (b)) + { + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = a.cidx (j); i < a.cidx (j+1); i++) + { + octave_quit (); + result (a.ridx (i), j) = + std::pow (a.data (i), static_cast (b)); + } + } + else + { + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = a.cidx (j); i < a.cidx (j+1); i++) + { + octave_quit (); + result (a.ridx (i), j) = std::pow (a.data (i), b); + } + } + + retval = result; + } + else + { + octave_idx_type nz = a.nnz (); + + SparseComplexMatrix result (a); + + if (xisint (b)) + { + for (octave_idx_type i = 0; i < nz; i++) + { + octave_quit (); + result.data (i) = std::pow (a.data (i), static_cast (b)); + } + } + else + { + for (octave_idx_type i = 0; i < nz; i++) + { + octave_quit (); + result.data (i) = std::pow (a.data (i), b); + } + } + + result.maybe_compress (true); + + retval = result; + } + + return retval; +} + +// -*- 10 -*- +octave_value +elem_xpow (const SparseComplexMatrix& a, const SparseMatrix& b) +{ + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + + if (a.numel () == 1 && b.numel () > 1) + return scalar_xpow (a(0), b); + + if (nr != b_nr || nc != b_nc) + { + gripe_nonconformant ("operator .^", nr, nc, b_nr, b_nc); + return octave_value (); + } + + SparseComplexMatrix result (nr, nc, Complex (1.0, 0.0)); + for (octave_idx_type j = 0; j < nc; j++) + { + for (octave_idx_type i = a.cidx (j); i < a.cidx (j+1); i++) + { + octave_quit (); + double btmp = b(a.ridx (i), j); + Complex tmp; + + if (xisint (btmp)) + result.xelem (a.ridx (i), j) = std::pow (a.data (i), + static_cast (btmp)); + else + result.xelem (a.ridx (i), j) = std::pow (a.data (i), btmp); + } + } + + result.maybe_compress (true); + + return result; +} + +// -*- 11 -*- +octave_value +elem_xpow (const SparseComplexMatrix& a, const Complex& b) +{ + octave_value retval; + + if (b == 0.0) + // Can this case ever happen, due to automatic retyping with maybe_mutate? + retval = octave_value (NDArray (a.dims (), 1)); + else + { + + octave_idx_type nz = a.nnz (); + + SparseComplexMatrix result (a); + + for (octave_idx_type i = 0; i < nz; i++) + { + octave_quit (); + result.data (i) = std::pow (a.data (i), b); + } + + result.maybe_compress (true); + + retval = result; + } + + return retval; +} + +// -*- 12 -*- +octave_value +elem_xpow (const SparseComplexMatrix& a, const SparseComplexMatrix& b) +{ + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + + if (a.numel () == 1 && b.numel () > 1) + return scalar_xpow (a(0), b); + + if (nr != b_nr || nc != b_nc) + { + gripe_nonconformant ("operator .^", nr, nc, b_nr, b_nc); + return octave_value (); + } + + SparseComplexMatrix result (nr, nc, Complex (1.0, 0.0)); + for (octave_idx_type j = 0; j < nc; j++) + { + for (octave_idx_type i = a.cidx (j); i < a.cidx (j+1); i++) + { + octave_quit (); + result.xelem (a.ridx (i), j) = std::pow (a.data (i), b(a.ridx (i), j)); + } + } + result.maybe_compress (true); + + return result; +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/sparse-xpow.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/sparse-xpow.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,57 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_sparse_xpow_h) +#define octave_sparse_xpow_h 1 + +#include "oct-cmplx.h" + +class SparseMatrix; +class SparseComplexMatrix; +class octave_value; + +extern octave_value xpow (const SparseMatrix& a, double b); +extern octave_value xpow (const SparseComplexMatrix& a, double b); + +extern octave_value elem_xpow (double a, const SparseMatrix& b); +extern octave_value elem_xpow (double a, const SparseComplexMatrix& b); + +extern octave_value elem_xpow (const SparseMatrix& a, double b); +extern octave_value elem_xpow (const SparseMatrix& a, const SparseMatrix& b); +extern octave_value elem_xpow (const SparseMatrix& a, const Complex& b); +extern octave_value elem_xpow (const SparseMatrix& a, + const SparseComplexMatrix& b); + +extern octave_value elem_xpow (const Complex& a, const SparseMatrix& b); +extern octave_value elem_xpow (const Complex& a, + const SparseComplexMatrix& b); + +extern octave_value elem_xpow (const SparseComplexMatrix& a, double b); +extern octave_value elem_xpow (const SparseComplexMatrix& a, + const SparseMatrix& b); +extern octave_value elem_xpow (const SparseComplexMatrix& a, + const Complex& b); +extern octave_value elem_xpow (const SparseComplexMatrix& a, + const SparseComplexMatrix& b); + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/symtab.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/symtab.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,1765 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton +Copyright (C) 2009 VZLU Prague, a.s. + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "file-ops.h" +#include "file-stat.h" +#include "oct-env.h" +#include "oct-time.h" +#include "singleton-cleanup.h" + +#include "debug.h" +#include "defun.h" +#include "dirfns.h" +#include "input.h" +#include "load-path.h" +#include "ov-fcn.h" +#include "ov-usr-fcn.h" +#include "pager.h" +#include "parse.h" +#include "pt-arg-list.h" +#include "symtab.h" +#include "unwind-prot.h" +#include "utils.h" + +symbol_table *symbol_table::instance = 0; + +symbol_table::scope_id_cache *symbol_table::scope_id_cache::instance = 0; + +std::map symbol_table::all_instances; + +std::map symbol_table::global_table; + +std::map symbol_table::fcn_table; + +std::map > symbol_table::class_precedence_table; + +std::map > symbol_table::parent_map; + +const symbol_table::scope_id symbol_table::xglobal_scope = 0; +const symbol_table::scope_id symbol_table::xtop_scope = 1; + +symbol_table::scope_id symbol_table::xcurrent_scope = 1; + +symbol_table::context_id symbol_table::xcurrent_context = 0; + +// Should Octave always check to see if function files have changed +// since they were last compiled? +static int Vignore_function_time_stamp = 1; + +void +symbol_table::scope_id_cache::create_instance (void) +{ + instance = new scope_id_cache (); + + singleton_cleanup_list::add (cleanup_instance); +} + +symbol_table::context_id +symbol_table::symbol_record::symbol_record_rep::active_context (void) const +{ + octave_user_function *fcn = curr_fcn; + + // FIXME -- If active_context () == -1, then it does not make much + // sense to use this symbol_record. This means an attempt at accessing + // a variable from a function that has not been called yet is + // happening. This should be cleared up when an implementing closures. + + return fcn && fcn->active_context () != static_cast (-1) + ? fcn->active_context () : xcurrent_context; +} + +void +symbol_table::symbol_record::symbol_record_rep::dump + (std::ostream& os, const std::string& prefix) const +{ + octave_value val = varval (); + + os << prefix << name; + + if (val.is_defined ()) + { + os << " [" + << (is_local () ? "l" : "") + << (is_automatic () ? "a" : "") + << (is_formal () ? "f" : "") + << (is_hidden () ? "h" : "") + << (is_inherited () ? "i" : "") + << (is_global () ? "g" : "") + << (is_persistent () ? "p" : "") + << "] "; + val.dump (os); + } + + os << "\n"; +} + +octave_value +symbol_table::symbol_record::find (const octave_value_list& args) const +{ + octave_value retval; + + if (is_global ()) + retval = symbol_table::global_varval (name ()); + else + { + retval = varval (); + + if (retval.is_undefined ()) + { + // Use cached fcn_info pointer if possible. + if (rep->finfo) + retval = rep->finfo->find (args); + else + { + retval = symbol_table::find_function (name (), args); + + if (retval.is_defined ()) + rep->finfo = get_fcn_info (name ()); + } + } + } + + return retval; +} + +// Check the load path to see if file that defined this is still +// visible. If the file is no longer visible, then erase the +// definition and move on. If the file is visible, then we also +// need to check to see whether the file has changed since the the +// function was loaded/parsed. However, this check should only +// happen once per prompt (for files found from relative path +// elements, we also check if the working directory has changed +// since the last time the function was loaded/parsed). +// +// FIXME -- perhaps this should be done for all loaded functions when +// the prompt is printed or the directory has changed, and then we +// would not check for it when finding symbol definitions. + +static inline bool +load_out_of_date_fcn (const std::string& ff, const std::string& dir_name, + octave_value& function, + const std::string& dispatch_type = std::string ()) +{ + bool retval = false; + + octave_function *fcn = load_fcn_from_file (ff, dir_name, dispatch_type); + + if (fcn) + { + retval = true; + + function = octave_value (fcn); + } + else + function = octave_value (); + + return retval; +} + +bool +out_of_date_check (octave_value& function, + const std::string& dispatch_type, + bool check_relative) +{ + bool retval = false; + + octave_function *fcn = function.function_value (true); + + if (fcn) + { + // FIXME -- we need to handle subfunctions properly here. + + if (! fcn->is_subfunction ()) + { + std::string ff = fcn->fcn_file_name (); + + if (! ff.empty ()) + { + octave_time tc = fcn->time_checked (); + + bool relative = check_relative && fcn->is_relative (); + + if (tc < Vlast_prompt_time + || (relative && tc < Vlast_chdir_time)) + { + bool clear_breakpoints = false; + std::string nm = fcn->name (); + + bool is_same_file = false; + + std::string file; + std::string dir_name; + + if (check_relative) + { + int nm_len = nm.length (); + + if (octave_env::absolute_pathname (nm) + && ((nm_len > 4 && (nm.substr (nm_len-4) == ".oct" + || nm.substr (nm_len-4) == ".mex")) + || (nm_len > 2 && nm.substr (nm_len-2) == ".m"))) + file = nm; + else + { + // We don't want to make this an absolute name, + // because load_fcn_file looks at the name to + // decide whether it came from a relative lookup. + + if (! dispatch_type.empty ()) + { + file = load_path::find_method (dispatch_type, nm, + dir_name); + + if (file.empty ()) + { + const std::list& plist + = symbol_table::parent_classes (dispatch_type); + std::list::const_iterator it + = plist.begin (); + + while (it != plist.end ()) + { + file = load_path::find_method (*it, nm, dir_name); + if (! file.empty ()) + break; + + it++; + } + } + } + + // Maybe it's an autoload? + if (file.empty ()) + file = lookup_autoload (nm); + + if (file.empty ()) + file = load_path::find_fcn (nm, dir_name); + } + + if (! file.empty ()) + is_same_file = same_file (file, ff); + } + else + { + is_same_file = true; + file = ff; + } + + if (file.empty ()) + { + // Can't see this function from current + // directory, so we should clear it. + + function = octave_value (); + + clear_breakpoints = true; + } + else if (is_same_file) + { + // Same file. If it is out of date, then reload it. + + octave_time ottp = fcn->time_parsed (); + time_t tp = ottp.unix_time (); + + fcn->mark_fcn_file_up_to_date (octave_time ()); + + if (! (Vignore_function_time_stamp == 2 + || (Vignore_function_time_stamp + && fcn->is_system_fcn_file ()))) + { + file_stat fs (ff); + + if (fs) + { + if (fs.is_newer (tp)) + { + retval = load_out_of_date_fcn (ff, dir_name, + function, + dispatch_type); + + clear_breakpoints = true; + } + } + else + { + function = octave_value (); + + clear_breakpoints = true; + } + } + } + else + { + // Not the same file, so load the new file in + // place of the old. + + retval = load_out_of_date_fcn (file, dir_name, function, + dispatch_type); + + clear_breakpoints = true; + } + + // If the function has been replaced then clear any + // breakpoints associated with it + if (clear_breakpoints) + bp_table::remove_all_breakpoints_in_file (nm, true); + } + } + } + } + + return retval; +} + +octave_value +symbol_table::fcn_info::fcn_info_rep::load_private_function + (const std::string& dir_name) +{ + octave_value retval; + + std::string file_name = load_path::find_private_fcn (dir_name, name); + + if (! file_name.empty ()) + { + octave_function *fcn = load_fcn_from_file (file_name, dir_name); + + if (fcn) + { + std::string class_name; + + size_t pos = dir_name.find_last_of (file_ops::dir_sep_chars ()); + + if (pos != std::string::npos) + { + std::string tmp = dir_name.substr (pos+1); + + if (tmp[0] == '@') + class_name = tmp.substr (1); + } + + fcn->mark_as_private_function (class_name); + + retval = octave_value (fcn); + + private_functions[dir_name] = retval; + } + } + + return retval; +} + +octave_value +symbol_table::fcn_info::fcn_info_rep::load_class_constructor (void) +{ + octave_value retval; + + std::string dir_name; + + std::string file_name = load_path::find_method (name, name, dir_name); + + if (! file_name.empty ()) + { + octave_function *fcn = load_fcn_from_file (file_name, dir_name, name); + + if (fcn) + { + retval = octave_value (fcn); + + class_constructors[name] = retval; + } + } + + return retval; +} + +octave_value +symbol_table::fcn_info::fcn_info_rep::load_class_method + (const std::string& dispatch_type) +{ + octave_value retval; + + if (name == dispatch_type) + retval = load_class_constructor (); + else + { + std::string dir_name; + + std::string file_name = load_path::find_method (dispatch_type, name, + dir_name); + + if (! file_name.empty ()) + { + octave_function *fcn = load_fcn_from_file (file_name, dir_name, + dispatch_type); + + if (fcn) + { + retval = octave_value (fcn); + + class_methods[dispatch_type] = retval; + } + } + + if (retval.is_undefined ()) + { + // Search parent classes + + const std::list& plist = parent_classes (dispatch_type); + + std::list::const_iterator it = plist.begin (); + + while (it != plist.end ()) + { + retval = find_method (*it); + + if (retval.is_defined ()) + { + class_methods[dispatch_type] = retval; + break; + } + + it++; + } + } + } + + return retval; +} + +void +symbol_table::fcn_info::fcn_info_rep:: mark_subfunction_in_scope_as_private + (scope_id scope, const std::string& class_name) +{ + scope_val_iterator p = subfunctions.find (scope); + + if (p != subfunctions.end ()) + { + octave_function *fcn = p->second.function_value (); + + if (fcn) + fcn->mark_as_private_function (class_name); + } +} + +void +symbol_table::fcn_info::fcn_info_rep::print_dispatch (std::ostream& os) const +{ + if (dispatch_map.empty ()) + os << "dispatch: " << name << " is not overloaded" << std::endl; + else + { + os << "Overloaded function " << name << ":\n\n"; + + for (dispatch_map_const_iterator p = dispatch_map.begin (); + p != dispatch_map.end (); p++) + os << " " << name << " (" << p->first << ", ...) -> " + << p->second << " (" << p->first << ", ...)\n"; + + os << std::endl; + } +} + +std::string +symbol_table::fcn_info::fcn_info_rep::help_for_dispatch (void) const +{ + std::string retval; + + if (! dispatch_map.empty ()) + { + retval = "Overloaded function:\n\n"; + + for (dispatch_map_const_iterator p = dispatch_map.begin (); + p != dispatch_map.end (); p++) + retval += " " + p->second + " (" + p->first + ", ...)\n\n"; + } + + return retval; +} + +// :-) JWE, can you parse this? Returns a 2D array with second dimension equal +// to btyp_num_types (static constant). Only the leftmost dimension can be +// variable in C/C++. Typedefs are boring. + +static builtin_type_t (*build_sup_table (void))[btyp_num_types] +{ + static builtin_type_t sup_table[btyp_num_types][btyp_num_types]; + for (int i = 0; i < btyp_num_types; i++) + for (int j = 0; j < btyp_num_types; j++) + { + builtin_type_t ityp = static_cast (i); + builtin_type_t jtyp = static_cast (j); + // FIXME: Is this really right? + bool use_j = + (jtyp == btyp_func_handle || ityp == btyp_bool + || (btyp_isarray (ityp) + && (! btyp_isarray (jtyp) + || (btyp_isinteger (jtyp) && ! btyp_isinteger (ityp)) + || ((ityp == btyp_double || ityp == btyp_complex || ityp == btyp_char) + && (jtyp == btyp_float || jtyp == btyp_float_complex))))); + + sup_table[i][j] = use_j ? jtyp : ityp; + } + + return sup_table; +} + +std::string +get_dispatch_type (const octave_value_list& args, + builtin_type_t& builtin_type) +{ + static builtin_type_t (*sup_table)[btyp_num_types] = build_sup_table (); + std::string dispatch_type; + + int n = args.length (); + + if (n > 0) + { + int i = 0; + builtin_type = args(0).builtin_type (); + if (builtin_type != btyp_unknown) + { + for (i = 1; i < n; i++) + { + builtin_type_t bti = args(i).builtin_type (); + if (bti != btyp_unknown) + builtin_type = sup_table[builtin_type][bti]; + else + { + builtin_type = btyp_unknown; + break; + } + } + } + + if (builtin_type == btyp_unknown) + { + // There's a non-builtin class in the argument list. + dispatch_type = args(i).class_name (); + + for (int j = i+1; j < n; j++) + { + octave_value arg = args(j); + + if (arg.builtin_type () == btyp_unknown) + { + std::string cname = arg.class_name (); + + // Only switch to type of ARG if it is marked superior + // to the current DISPATCH_TYPE. + if (! symbol_table::is_superiorto (dispatch_type, cname) + && symbol_table::is_superiorto (cname, dispatch_type)) + dispatch_type = cname; + } + } + } + else + dispatch_type = btyp_class_name[builtin_type]; + } + else + builtin_type = btyp_unknown; + + return dispatch_type; +} + +std::string +get_dispatch_type (const octave_value_list& args) +{ + builtin_type_t builtin_type; + return get_dispatch_type (args, builtin_type); +} + +// Find the definition of NAME according to the following precedence +// list: +// +// variable +// subfunction +// private function +// class method +// class constructor +// legacy dispatch +// command-line function +// autoload function +// function on the path +// built-in function +// +// Matlab documentation states that constructors have higher precedence +// than methods, but that does not seem to be the case. + +octave_value +symbol_table::fcn_info::fcn_info_rep::find (const octave_value_list& args, + bool local_funcs) +{ + octave_value retval = xfind (args, local_funcs); + + if (! (error_state || retval.is_defined ())) + { + // It is possible that the user created a file on the fly since + // the last prompt or chdir, so try updating the load path and + // searching again. + + load_path::update (); + + retval = xfind (args, local_funcs); + } + + return retval; +} + +octave_value +symbol_table::fcn_info::fcn_info_rep::xfind (const octave_value_list& args, + bool local_funcs) +{ + if (local_funcs) + { + // Subfunction. I think it only makes sense to check for + // subfunctions if we are currently executing a function defined + // from a .m file. + + octave_user_function *curr_fcn = symbol_table::get_curr_fcn (); + + for (scope_id scope = xcurrent_scope; scope >= 0;) + { + scope_val_iterator r = subfunctions.find (scope); + if (r != subfunctions.end ()) + { + // FIXME -- out-of-date check here. + + return r->second; + } + + octave_user_function *scope_curr_fcn = get_curr_fcn (scope); + if (scope_curr_fcn) + scope = scope_curr_fcn->parent_fcn_scope (); + else + scope = -1; + } + + // Private function. + + if (curr_fcn) + { + std::string dir_name = curr_fcn->dir_name (); + + if (! dir_name.empty ()) + { + str_val_iterator q = private_functions.find (dir_name); + + if (q == private_functions.end ()) + { + octave_value val = load_private_function (dir_name); + + if (val.is_defined ()) + return val; + } + else + { + octave_value& fval = q->second; + + if (fval.is_defined ()) + out_of_date_check (fval, "", false); + + if (fval.is_defined ()) + return fval; + else + { + octave_value val = load_private_function (dir_name); + + if (val.is_defined ()) + return val; + } + } + } + } + } + + // Class methods. + + if (! args.empty ()) + { + std::string dispatch_type = get_dispatch_type (args); + + octave_value fcn = find_method (dispatch_type); + + if (fcn.is_defined ()) + return fcn; + } + + // Class constructors. The class name and function name are the same. + + str_val_iterator q = class_constructors.find (name); + + if (q == class_constructors.end ()) + { + octave_value val = load_class_constructor (); + + if (val.is_defined ()) + return val; + } + else + { + octave_value& fval = q->second; + + if (fval.is_defined ()) + out_of_date_check (fval, name); + + if (fval.is_defined ()) + return fval; + else + { + octave_value val = load_class_constructor (); + + if (val.is_defined ()) + return val; + } + } + + // Legacy dispatch. + + if (! args.empty () && ! dispatch_map.empty ()) + { + std::string dispatch_type = args(0).type_name (); + + std::string fname; + + dispatch_map_iterator p = dispatch_map.find (dispatch_type); + + if (p == dispatch_map.end ()) + p = dispatch_map.find ("any"); + + if (p != dispatch_map.end ()) + { + fname = p->second; + + octave_value fcn + = symbol_table::find_function (fname, args); + + if (fcn.is_defined ()) + return fcn; + } + } + + // Command-line function. + + if (cmdline_function.is_defined ()) + return cmdline_function; + + // Autoload? + + octave_value fcn = find_autoload (); + + if (fcn.is_defined ()) + return fcn; + + // Function on the path. + + fcn = find_user_function (); + + if (fcn.is_defined ()) + return fcn; + + // Built-in function (might be undefined). + + return built_in_function; +} + +// Find the definition of NAME according to the following precedence +// list: +// +// built-in function +// function on the path +// autoload function +// command-line function +// private function +// subfunction + +// This function is used to implement the "builtin" function, which +// searches for "built-in" functions. In Matlab, "builtin" only +// returns functions that are actually built-in to the interpreter. +// But since the list of built-in functions is different in Octave and +// Matlab, we also search up the precedence list until we find +// something that matches. Note that we are only searching by name, +// so class methods, constructors, and legacy dispatch functions are +// skipped. + +octave_value +symbol_table::fcn_info::fcn_info_rep::builtin_find (void) +{ + octave_value retval = x_builtin_find (); + + if (! retval.is_defined ()) + { + // It is possible that the user created a file on the fly since + // the last prompt or chdir, so try updating the load path and + // searching again. + + load_path::update (); + + retval = x_builtin_find (); + } + + return retval; +} + +octave_value +symbol_table::fcn_info::fcn_info_rep::x_builtin_find (void) +{ + // Built-in function. + if (built_in_function.is_defined ()) + return built_in_function; + + // Function on the path. + + octave_value fcn = find_user_function (); + + if (fcn.is_defined ()) + return fcn; + + // Autoload? + + fcn = find_autoload (); + + if (fcn.is_defined ()) + return fcn; + + // Command-line function. + + if (cmdline_function.is_defined ()) + return cmdline_function; + + // Private function. + + octave_user_function *curr_fcn = symbol_table::get_curr_fcn (); + + if (curr_fcn) + { + std::string dir_name = curr_fcn->dir_name (); + + if (! dir_name.empty ()) + { + str_val_iterator q = private_functions.find (dir_name); + + if (q == private_functions.end ()) + { + octave_value val = load_private_function (dir_name); + + if (val.is_defined ()) + return val; + } + else + { + octave_value& fval = q->second; + + if (fval.is_defined ()) + out_of_date_check (fval); + + if (fval.is_defined ()) + return fval; + else + { + octave_value val = load_private_function (dir_name); + + if (val.is_defined ()) + return val; + } + } + } + } + + // Subfunction. I think it only makes sense to check for + // subfunctions if we are currently executing a function defined + // from a .m file. + + for (scope_id scope = xcurrent_scope; scope >= 0;) + { + scope_val_iterator r = subfunctions.find (scope); + if (r != subfunctions.end ()) + { + // FIXME -- out-of-date check here. + + return r->second; + } + + octave_user_function *scope_curr_fcn = get_curr_fcn (scope); + if (scope_curr_fcn) + scope = scope_curr_fcn->parent_fcn_scope (); + else + scope = -1; + } + + return octave_value (); +} + +octave_value +symbol_table::fcn_info::fcn_info_rep::find_method (const std::string& dispatch_type) +{ + octave_value retval; + + str_val_iterator q = class_methods.find (dispatch_type); + + if (q == class_methods.end ()) + { + octave_value val = load_class_method (dispatch_type); + + if (val.is_defined ()) + return val; + } + else + { + octave_value& fval = q->second; + + if (fval.is_defined ()) + out_of_date_check (fval, dispatch_type); + + if (fval.is_defined ()) + return fval; + else + { + octave_value val = load_class_method (dispatch_type); + + if (val.is_defined ()) + return val; + } + } + + return retval; +} + +octave_value +symbol_table::fcn_info::fcn_info_rep::find_autoload (void) +{ + octave_value retval; + + // Autoloaded function. + + if (autoload_function.is_defined ()) + out_of_date_check (autoload_function); + + if (! autoload_function.is_defined ()) + { + std::string file_name = lookup_autoload (name); + + if (! file_name.empty ()) + { + size_t pos = file_name.find_last_of (file_ops::dir_sep_chars ()); + + std::string dir_name = file_name.substr (0, pos); + + octave_function *fcn = load_fcn_from_file (file_name, dir_name, + "", name, true); + + if (fcn) + autoload_function = octave_value (fcn); + } + } + + return autoload_function; +} + +octave_value +symbol_table::fcn_info::fcn_info_rep::find_user_function (void) +{ + // Function on the path. + + if (function_on_path.is_defined ()) + out_of_date_check (function_on_path); + + if (! (error_state || function_on_path.is_defined ())) + { + std::string dir_name; + + std::string file_name = load_path::find_fcn (name, dir_name); + + if (! file_name.empty ()) + { + octave_function *fcn = load_fcn_from_file (file_name, dir_name); + + if (fcn) + function_on_path = octave_value (fcn); + } + } + + return function_on_path; +} + +// Insert INF_CLASS in the set of class names that are considered +// inferior to SUP_CLASS. Return FALSE if INF_CLASS is currently +// marked as superior to SUP_CLASS. + +bool +symbol_table::set_class_relationship (const std::string& sup_class, + const std::string& inf_class) +{ + if (is_superiorto (inf_class, sup_class)) + return false; + + // If sup_class doesn't have an entry in the precedence table, + // this will automatically create it, and associate to it a + // singleton set {inf_class} of inferior classes. + class_precedence_table[sup_class].insert (inf_class); + + return true; +} + +// Has class A been marked as superior to class B? Also returns +// TRUE if B has been marked as inferior to A, since we only keep +// one table, and convert inferiorto information to a superiorto +// relationship. Two calls are required to determine whether there +// is no relationship between two classes: +// +// if (symbol_table::is_superiorto (a, b)) +// // A is superior to B, or B has been marked inferior to A. +// else if (symbol_table::is_superiorto (b, a)) +// // B is superior to A, or A has been marked inferior to B. +// else +// // No relation. + +bool +symbol_table::is_superiorto (const std::string& a, const std::string& b) +{ + class_precedence_table_const_iterator p = class_precedence_table.find (a); + // If a has no entry in the precedence table, return false + if (p == class_precedence_table.end ()) + return false; + + const std::set& inferior_classes = p->second; + std::set::const_iterator q = inferior_classes.find (b); + return (q != inferior_classes.end ()); +} + +static std::string +fcn_file_name (const octave_value& fcn) +{ + const octave_function *f = fcn.function_value (); + + return f ? f->fcn_file_name () : std::string (); +} + +void +symbol_table::fcn_info::fcn_info_rep::dump + (std::ostream& os, const std::string& prefix) const +{ + os << prefix << name + << " [" + << (cmdline_function.is_defined () ? "c" : "") + << (built_in_function.is_defined () ? "b" : "") + << "]\n"; + + std::string tprefix = prefix + " "; + + if (autoload_function.is_defined ()) + os << tprefix << "autoload: " + << fcn_file_name (autoload_function) << "\n"; + + if (function_on_path.is_defined ()) + os << tprefix << "function from path: " + << fcn_file_name (function_on_path) << "\n"; + + if (! subfunctions.empty ()) + { + for (scope_val_const_iterator p = subfunctions.begin (); + p != subfunctions.end (); p++) + os << tprefix << "subfunction: " << fcn_file_name (p->second) + << " [" << p->first << "]\n"; + } + + if (! private_functions.empty ()) + { + for (str_val_const_iterator p = private_functions.begin (); + p != private_functions.end (); p++) + os << tprefix << "private: " << fcn_file_name (p->second) + << " [" << p->first << "]\n"; + } + + if (! class_constructors.empty ()) + { + for (str_val_const_iterator p = class_constructors.begin (); + p != class_constructors.end (); p++) + os << tprefix << "constructor: " << fcn_file_name (p->second) + << " [" << p->first << "]\n"; + } + + if (! class_methods.empty ()) + { + for (str_val_const_iterator p = class_methods.begin (); + p != class_methods.end (); p++) + os << tprefix << "method: " << fcn_file_name (p->second) + << " [" << p->first << "]\n"; + } + + if (! dispatch_map.empty ()) + { + for (dispatch_map_const_iterator p = dispatch_map.begin (); + p != dispatch_map.end (); p++) + os << tprefix << "dispatch: " << fcn_file_name (p->second) + << " [" << p->first << "]\n"; + } +} + +void +symbol_table::install_nestfunction (const std::string& name, + const octave_value& fcn, + scope_id parent_scope) +{ + install_subfunction (name, fcn, parent_scope); + + // Stash the nest_parent for resolving variables after parsing is done. + octave_function *fv = fcn.function_value (); + + symbol_table *fcn_table_loc = get_instance (fv->scope ()); + + symbol_table *parent_table = get_instance (parent_scope); + + parent_table->add_nest_child (*fcn_table_loc); +} + +octave_value +symbol_table::find (const std::string& name, + const octave_value_list& args, + bool skip_variables, + bool local_funcs) +{ + symbol_table *inst = get_instance (xcurrent_scope); + + return inst + ? inst->do_find (name, args, skip_variables, local_funcs) + : octave_value (); +} + +octave_value +symbol_table::builtin_find (const std::string& name) +{ + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_builtin_find (name) : octave_value (); +} + +octave_value +symbol_table::find_function (const std::string& name, + const octave_value_list& args, + bool local_funcs) +{ + octave_value retval; + + if (! name.empty () && name[0] == '@') + { + // Look for a class specific function. + std::string dispatch_type = + name.substr (1, name.find_first_of (file_ops::dir_sep_str ()) - 1); + + std::string method = + name.substr (name.find_last_of (file_ops::dir_sep_str ()) + 1, + std::string::npos); + + retval = find_method (method, dispatch_type); + } + else + { + size_t pos = name.find_first_of (Vfilemarker); + + if (pos == std::string::npos) + retval = find (name, args, true, local_funcs); + else + { + std::string fcn_scope = name.substr (0, pos); + scope_id stored_scope = xcurrent_scope; + xcurrent_scope = xtop_scope; + octave_value parent = find_function (name.substr (0, pos), + octave_value_list (), false); + + if (parent.is_defined ()) + { + octave_function *parent_fcn = parent.function_value (); + + if (parent_fcn) + { + xcurrent_scope = parent_fcn->scope (); + + if (xcurrent_scope > 1) + retval = find_function (name.substr (pos + 1), args); + } + } + + xcurrent_scope = stored_scope; + } + } + + return retval; +} + +void +symbol_table::dump (std::ostream& os, scope_id scope) +{ + if (scope == xglobal_scope) + dump_global (os); + else + { + symbol_table *inst = get_instance (scope, false); + + if (inst) + { + os << "*** dumping symbol table scope " << scope + << " (" << inst->table_name << ")\n\n"; + + std::map sfuns + = symbol_table::subfunctions_defined_in_scope (scope); + + if (! sfuns.empty ()) + { + os << " subfunctions defined in this scope:\n"; + + for (std::map::const_iterator p = sfuns.begin (); + p != sfuns.end (); p++) + os << " " << p->first << "\n"; + + os << "\n"; + } + + inst->do_dump (os); + } + } +} + +void +symbol_table::dump_global (std::ostream& os) +{ + if (! global_table.empty ()) + { + os << "*** dumping global symbol table\n\n"; + + for (global_table_const_iterator p = global_table.begin (); + p != global_table.end (); p++) + { + std::string nm = p->first; + octave_value val = p->second; + + os << " " << nm << " "; + val.dump (os); + os << "\n"; + } + } +} + +void +symbol_table::dump_functions (std::ostream& os) +{ + if (! fcn_table.empty ()) + { + os << "*** dumping globally visible functions from symbol table\n" + << " (c=commandline, b=built-in)\n\n"; + + for (fcn_table_const_iterator p = fcn_table.begin (); + p != fcn_table.end (); p++) + p->second.dump (os, " "); + + os << "\n"; + } +} + +void +symbol_table::stash_dir_name_for_subfunctions (scope_id scope, + const std::string& dir_name) +{ + // FIXME -- is this the best way to do this? Maybe it would be + // better if we had a map from scope to list of subfunctions + // stored with the function. Do we? + + for (fcn_table_const_iterator p = fcn_table.begin (); + p != fcn_table.end (); p++) + { + std::pair tmp + = p->second.subfunction_defined_in_scope (scope); + + std::string nm = tmp.first; + + if (! nm.empty ()) + { + octave_value& fcn = tmp.second; + + octave_user_function *f = fcn.user_function_value (); + + if (f) + f->stash_dir_name (dir_name); + } + } +} + +octave_value +symbol_table::do_find (const std::string& name, + const octave_value_list& args, + bool skip_variables, + bool local_funcs) +{ + octave_value retval; + + // Variable. + + if (! skip_variables) + { + table_iterator p = table.find (name); + + if (p != table.end ()) + { + symbol_record sr = p->second; + + if (sr.is_global ()) + return symbol_table::global_varval (name); + else + { + octave_value val = sr.varval (); + + if (val.is_defined ()) + return val; + } + } + } + + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + return p->second.find (args, local_funcs); + else + { + fcn_info finfo (name); + + octave_value fcn = finfo.find (args, local_funcs); + + if (fcn.is_defined ()) + fcn_table[name] = finfo; + + return fcn; + } + + return retval; +} + +octave_value +symbol_table::do_builtin_find (const std::string& name) +{ + octave_value retval; + + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + return p->second.builtin_find (); + else + { + fcn_info finfo (name); + + octave_value fcn = finfo.builtin_find (); + + if (fcn.is_defined ()) + fcn_table[name] = finfo; + + return fcn; + } + + return retval; +} + +std::list +symbol_table::do_workspace_info (void) const +{ + std::list retval; + + for (table_const_iterator p = table.begin (); p != table.end (); p++) + { + std::string nm = p->first; + symbol_record sr = p->second; + + if (! sr.is_hidden ()) + { + octave_value val = sr.varval (); + + if (val.is_defined ()) + { + dim_vector dv = val.dims (); + + char storage = ' '; + if (sr.is_global ()) + storage = 'g'; + else if (sr.is_persistent ()) + storage = 'p'; + else if (sr.is_automatic ()) + storage = 'a'; + else if (sr.is_formal ()) + storage = 'f'; + else if (sr.is_hidden ()) + storage = 'h'; + else if (sr.is_inherited ()) + storage = 'i'; + + workspace_element elt (storage, nm, val.class_name (), + val.short_disp (), dv.str ()); + + retval.push_back (elt); + } + } + } + + return retval; +} + +void +symbol_table::do_dump (std::ostream& os) +{ + if (! persistent_table.empty ()) + { + os << " persistent variables in this scope:\n\n"; + + for (persistent_table_const_iterator p = persistent_table.begin (); + p != persistent_table.end (); p++) + { + std::string nm = p->first; + octave_value val = p->second; + + os << " " << nm << " "; + val.dump (os); + os << "\n"; + } + + os << "\n"; + } + + if (! table.empty ()) + { + os << " other symbols in this scope (l=local; a=auto; f=formal\n" + << " h=hidden; i=inherited; g=global; p=persistent)\n\n"; + + for (table_const_iterator p = table.begin (); p != table.end (); p++) + p->second.dump (os, " "); + + os << "\n"; + } +} + +void symbol_table::cleanup (void) +{ + clear_all (true); + + // Delete all possibly remaining scopes. + for (all_instances_iterator iter = all_instances.begin (); + iter != all_instances.end (); iter++) + { + // First zero the table entry to avoid possible duplicate delete. + symbol_table *inst = iter->second; + iter->second = 0; + + // Now delete the scope. Note that there may be side effects, such as + // deleting other scopes. + delete inst; + } + + global_table.clear (); + fcn_table.clear (); + class_precedence_table.clear (); + parent_map.clear (); + all_instances.clear (); +} + +void +symbol_table::do_update_nest (void) +{ + if (nest_parent || nest_children.size ()) + curr_fcn->mark_as_nested_function (); + + if (nest_parent) + { + // fix bad symbol_records + for (table_iterator ti = table.begin (); ti != table.end (); ++ti) + { + symbol_record &ours = ti->second; + symbol_record parents; + if (! ours.is_formal () + && nest_parent->look_nonlocal (ti->first, parents)) + { + if (ours.is_global () || ours.is_persistent ()) + ::error ("global and persistent may only be used in the topmost level in which a nested variable is used"); + + if (! ours.is_formal ()) + { + ours.invalidate (); + ti->second = parents; + } + } + else + ours.set_curr_fcn (curr_fcn); + } + } + else if (nest_children.size ()) + { + static_workspace = true; + for (table_iterator ti = table.begin (); ti != table.end (); ++ti) + ti->second.set_curr_fcn (curr_fcn); + } + + for (std::vector::iterator iter = nest_children.begin (); + iter != nest_children.end (); ++iter) + (*iter)->do_update_nest (); +} + +DEFUN (ignore_function_time_stamp, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} ignore_function_time_stamp ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} ignore_function_time_stamp (@var{new_val})\n\ +Query or set the internal variable that controls whether Octave checks\n\ +the time stamp on files each time it looks up functions defined in\n\ +function files. If the internal variable is set to @code{\"system\"},\n\ +Octave will not automatically recompile function files in subdirectories of\n\ +@file{@var{octave-home}/lib/@var{version}} if they have changed since\n\ +they were last compiled, but will recompile other function files in the\n\ +search path if they change. If set to @code{\"all\"}, Octave will not\n\ +recompile any function files unless their definitions are removed with\n\ +@code{clear}. If set to \"none\", Octave will always check time stamps\n\ +on files to determine whether functions defined in function files\n\ +need to recompiled.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargout > 0 || nargin == 0) + { + switch (Vignore_function_time_stamp) + { + case 1: + retval = "system"; + break; + + case 2: + retval = "all"; + break; + + default: + retval = "none"; + break; + } + } + + if (nargin == 1) + { + std::string sval = args(0).string_value (); + + if (! error_state) + { + if (sval == "all") + Vignore_function_time_stamp = 2; + else if (sval == "system") + Vignore_function_time_stamp = 1; + else if (sval == "none") + Vignore_function_time_stamp = 0; + else + error ("ignore_function_time_stamp: expecting argument to be \"all\", \"system\", or \"none\""); + } + else + error ("ignore_function_time_stamp: expecting argument to be character string"); + } + else if (nargin > 1) + print_usage (); + + return retval; +} + +/* +%!shared old_state +%! old_state = ignore_function_time_stamp (); +%!test +%! state = ignore_function_time_stamp ("all"); +%! assert (state, old_state); +%! assert (ignore_function_time_stamp (), "all"); +%! state = ignore_function_time_stamp ("system"); +%! assert (state, "all"); +%! assert (ignore_function_time_stamp (), "system"); +%! ignore_function_time_stamp (old_state); + +## Test input validation +%!error (ignore_function_time_stamp ("all", "all")) +%!error (ignore_function_time_stamp ("UNKNOWN_VALUE")) +%!error (ignore_function_time_stamp (42)) +*/ + +DEFUN (__current_scope__, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{scope}, @var{context}]} __dump_symtab_info__ ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = symbol_table::current_context (); + retval(0) = symbol_table::current_scope (); + + return retval; +} + +DEFUN (__dump_symtab_info__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __dump_symtab_info__ ()\n\ +@deftypefnx {Built-in Function} {} __dump_symtab_info__ (@var{scope})\n\ +@deftypefnx {Built-in Function} {} __dump_symtab_info__ (\"scopes\")\n\ +@deftypefnx {Built-in Function} {} __dump_symtab_info__ (\"functions\")\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + { + symbol_table::dump_functions (octave_stdout); + + symbol_table::dump_global (octave_stdout); + + std::list lst = symbol_table::scopes (); + + for (std::list::const_iterator p = lst.begin (); + p != lst.end (); p++) + symbol_table::dump (octave_stdout, *p); + } + else if (nargin == 1) + { + octave_value arg = args(0); + + if (arg.is_string ()) + { + std::string s_arg = arg.string_value (); + + if (s_arg == "scopes") + { + std::list lst = symbol_table::scopes (); + + RowVector v (lst.size ()); + + octave_idx_type k = 0; + + for (std::list::const_iterator p = lst.begin (); + p != lst.end (); p++) + v.xelem (k++) = *p; + + retval = v; + } + else if (s_arg == "functions") + { + symbol_table::dump_functions (octave_stdout); + } + else + error ("__dump_symtab_info__: expecting \"functions\" or \"scopes\""); + } + else + { + int s = arg.int_value (); + + if (! error_state) + symbol_table::dump (octave_stdout, s); + else + error ("__dump_symtab_info__: expecting string or scope id"); + } + } + else + print_usage (); + + return retval; +} + +#if 0 + +// FIXME -- should we have functions like this in Octave? + +DEFUN (set_variable, args, , "set_variable (NAME, VALUE)") +{ + octave_value retval; + + if (args.length () == 2) + { + std::string name = args(0).string_value (); + + if (! error_state) + symbol_table::assign (name, args(1)); + else + error ("set_variable: expecting variable name as first argument"); + } + else + print_usage (); + + return retval; +} + +DEFUN (variable_value, args, , "VALUE = variable_value (NAME)") +{ + octave_value retval; + + if (args.length () == 1) + { + std::string name = args(0).string_value (); + + if (! error_state) + { + retval = symbol_table::varval (name); + + if (retval.is_undefined ()) + error ("variable_value: '%s' is not a variable in the current scope", + name.c_str ()); + } + else + error ("variable_value: expecting variable name as first argument"); + } + else + print_usage (); + + return retval; +} +#endif + + +/* +bug #34497: 'clear -f' does not work for command line functions + +This test relies on bar being a core function that is implemented in an m-file. +If the first assert fails, this is no longer the case and the tests need to be +updated to use some other function. + +%!assert (! strcmp (which ("bar"), "")); + +%!function x = bar () +%! x = 5; +%!endfunction +%!test +%! assert (bar == 5); +%! assert (strcmp (which ("bar"), "")); +%! clear -f bar; +%! assert (! strcmp (which ("bar"), "")); + +%!function x = bar () +%! x = 5; +%!endfunction +%!test +%! assert (bar == 5); +%! assert (strcmp (which ("bar"), "")); +%! clear bar; +%! assert (! strcmp (which ("bar"), "")); + */ diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/symtab.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/symtab.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,2879 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton +Copyright (C) 2009 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_symtab_h) +#define octave_symtab_h 1 + +#include +#include +#include +#include +#include + +#include "glob-match.h" +#include "regexp.h" + +class tree_argument_list; +class octave_user_function; + +#include "oct-obj.h" +#include "workspace-element.h" +#include "oct-refcount.h" +#include "ov.h" + +class +OCTINTERP_API +symbol_table +{ +public: + + typedef int scope_id; + typedef size_t context_id; + + class + scope_id_cache + { + protected: + + typedef std::set::iterator set_iterator; + typedef std::set::const_iterator set_const_iterator; + + // We start with 2 because we allocate 0 for the global symbols + // and 1 for the top-level workspace. + + scope_id_cache (void) : next_available (2), in_use (), free_list () { } + + public: + + ~scope_id_cache (void) { } + + static scope_id alloc (void) + { + return instance_ok () ? instance->do_alloc () : -1; + } + + static void free (scope_id scope) + { + if (instance_ok ()) + return instance->do_free (scope); + } + + static std::list scopes (void) + { + return instance_ok () ? instance->do_scopes () : std::list (); + } + + static void create_instance (void); + + static bool instance_ok (void) + { + bool retval = true; + + if (! instance) + create_instance (); + + if (! instance) + { + ::error ("unable to create scope_id_cache object!"); + + retval = false; + } + + return retval; + } + + private: + + // No copying! + + scope_id_cache (const scope_id_cache&); + + scope_id_cache& operator = (const scope_id_cache&); + + static scope_id_cache *instance; + + static void cleanup_instance (void) { delete instance; instance = 0; } + + // The next available scope not in the free list. + scope_id next_available; + + // The set of scope IDs that are currently allocated. + std::set in_use; + + // The set of scope IDs that are currently available. + std::set free_list; + + scope_id do_alloc (void) + { + scope_id retval; + + set_iterator p = free_list.begin (); + + if (p != free_list.end ()) + { + retval = *p; + free_list.erase (p); + } + else + retval = next_available++; + + in_use.insert (retval); + + return retval; + } + + void do_free (scope_id scope) + { + set_iterator p = in_use.find (scope); + + if (p != in_use.end ()) + { + in_use.erase (p); + free_list.insert (scope); + } + else + error ("free_scope: scope %d not found!", scope); + } + + std::list do_scopes (void) const + { + std::list retval; + + for (set_const_iterator p = in_use.begin (); p != in_use.end (); p++) + retval.push_back (*p); + + retval.sort (); + + return retval; + } + }; + + class fcn_info; + + class + symbol_record + { + public: + + // generic variable + static const unsigned int local = 1; + + // varargin, argn, .nargin., .nargout. + // (FIXME -- is this really used now?) + static const unsigned int automatic = 2; + + // formal parameter + static const unsigned int formal = 4; + + // not listed or cleared (.nargin., .nargout.) + static const unsigned int hidden = 8; + + // inherited from parent scope; not cleared at function exit + static const unsigned int inherited = 16; + + // global (redirects to global scope) + static const unsigned int global = 32; + + // not cleared at function exit + static const unsigned int persistent = 64; + + // this symbol may NOT become a variable. + // (symbol added to a static workspace) + static const unsigned int added_static = 128; + + private: + + class + symbol_record_rep + { + public: + + symbol_record_rep (scope_id s, const std::string& nm, + const octave_value& v, unsigned int sc) + : decl_scope (s), curr_fcn (0), name (nm), value_stack (), + storage_class (sc), finfo (), valid (true), count (1) + { + value_stack.push_back (v); + } + + void assign (const octave_value& value, + context_id context = xdefault_context) + { + varref (context) = value; + } + + void assign (octave_value::assign_op op, + const std::string& type, + const std::list& idx, + const octave_value& value, + context_id context = xdefault_context) + { + varref(context).assign (op, type, idx, value); + } + + void assign (octave_value::assign_op op, const octave_value& value, + context_id context = xdefault_context) + { + varref(context).assign (op, value); + } + + void do_non_const_unary_op (octave_value::unary_op op, + context_id context = xdefault_context) + { + varref(context).do_non_const_unary_op (op); + } + + void do_non_const_unary_op (octave_value::unary_op op, + const std::string& type, + const std::list& idx, + context_id context = xdefault_context) + { + varref(context).do_non_const_unary_op (op, type, idx); + } + + octave_value& varref (context_id context = xdefault_context) + { + // We duplicate global_varref and persistent_varref here to + // avoid calling deprecated functions. + + if (is_global ()) + { + symbol_table::global_table_iterator p + = symbol_table::global_table.find (name); + + return (p == symbol_table::global_table.end ()) + ? symbol_table::global_table[name] : p->second; + } + else if (is_persistent ()) + { + static octave_value foobar; + + symbol_table *inst + = symbol_table::get_instance (symbol_table::current_scope ()); + + return inst ? inst->do_persistent_varref (name) : foobar; + } + else + { + if (context == xdefault_context) + context = active_context (); + + context_id n = value_stack.size (); + while (n++ <= context) + value_stack.push_back (octave_value ()); + + return value_stack[context]; + } + } + + octave_value varval (context_id context = xdefault_context) const + { + if (is_global ()) + return symbol_table::global_varval (name); + else if (is_persistent ()) + return symbol_table::persistent_varval (name); + else + { + if (context == xdefault_context) + context = active_context (); + + if (context < value_stack.size ()) + return value_stack[context]; + else + return octave_value (); + } + } + + void push_context (scope_id s) + { + if (! (is_persistent () || is_global ()) + && s == scope ()) + value_stack.push_back (octave_value ()); + } + + // If pop_context returns 0, we are out of values and this element + // of the symbol table should be deleted. This can happen for + // functions like + // + // function foo (n) + // if (n > 0) + // foo (n-1); + // else + // eval ("x = 1"); + // endif + // endfunction + // + // Here, X should only exist in the final stack frame. + + size_t pop_context (scope_id s) + { + size_t retval = 1; + + if (! (is_persistent () || is_global ()) + && s == scope ()) + { + value_stack.pop_back (); + retval = value_stack.size (); + } + + return retval; + } + + void clear (void) { clear (scope ()); } + + void clear (scope_id s) + { + if (! (is_hidden () || is_inherited ()) + && s == scope ()) + { + if (is_global ()) + unmark_global (); + + if (is_persistent ()) + { + symbol_table::persistent_assign (name, varval ()); + + unmark_persistent (); + } + + assign (octave_value ()); + } + } + + bool is_defined (context_id context = xdefault_context) const + { + if (context == xdefault_context) + context = active_context (); + + return varval (context).is_defined (); + } + + bool is_valid (void) const + { + return valid; + } + + bool is_variable (context_id context) const + { + if (context == xdefault_context) + context = active_context (); + + return (! is_local () || is_defined (context)); + } + + bool is_local (void) const { return storage_class & local; } + bool is_automatic (void) const { return storage_class & automatic; } + bool is_formal (void) const { return storage_class & formal; } + bool is_hidden (void) const { return storage_class & hidden; } + bool is_inherited (void) const { return storage_class & inherited; } + bool is_global (void) const { return storage_class & global; } + bool is_persistent (void) const { return storage_class & persistent; } + bool is_added_static (void) const {return storage_class & added_static; } + + void mark_local (void) { storage_class |= local; } + void mark_automatic (void) { storage_class |= automatic; } + void mark_formal (void) { storage_class |= formal; } + void mark_hidden (void) { storage_class |= hidden; } + void mark_inherited (void) { storage_class |= inherited; } + void mark_global (void) + { + if (is_persistent ()) + error ("can't make persistent variable %s global", name.c_str ()); + else + storage_class |= global; + } + void mark_persistent (void) + { + if (is_global ()) + error ("can't make global variable %s persistent", name.c_str ()); + else + storage_class |= persistent; + } + void mark_added_static (void) { storage_class |= added_static; } + + void unmark_local (void) { storage_class &= ~local; } + void unmark_automatic (void) { storage_class &= ~automatic; } + void unmark_formal (void) { storage_class &= ~formal; } + void unmark_hidden (void) { storage_class &= ~hidden; } + void unmark_inherited (void) { storage_class &= ~inherited; } + void unmark_global (void) { storage_class &= ~global; } + void unmark_persistent (void) { storage_class &= ~persistent; } + void unmark_added_static (void) { storage_class &= ~added_static; } + + void init_persistent (void) + { + if (! is_defined ()) + { + mark_persistent (); + + assign (symbol_table::persistent_varval (name)); + } + // FIXME -- this causes trouble with recursive calls. + // else + // error ("unable to declare existing variable persistent"); + } + + void invalidate (void) + { + valid = false; + } + + void erase_persistent (void) + { + unmark_persistent (); + symbol_table::erase_persistent (name); + } + + OCTINTERP_API context_id active_context (void) const; + + scope_id scope (void) const { return decl_scope; } + + void set_curr_fcn (octave_user_function *fcn) + { + curr_fcn = fcn; + } + + symbol_record_rep *dup (scope_id new_scope) const + { + return new symbol_record_rep (new_scope, name, varval (), + storage_class); + } + + void dump (std::ostream& os, const std::string& prefix) const; + + scope_id decl_scope; + + octave_user_function* curr_fcn; + + std::string name; + + std::deque value_stack; + + unsigned int storage_class; + + fcn_info *finfo; + + bool valid; + + octave_refcount count; + + private: + + // No copying! + + symbol_record_rep (const symbol_record_rep& ov); + + symbol_record_rep& operator = (const symbol_record_rep&); + }; + + public: + + symbol_record (scope_id s = xcurrent_scope, + const std::string& nm = std::string (), + const octave_value& v = octave_value (), + unsigned int sc = local) + : rep (new symbol_record_rep (s, nm, v, sc)) { } + + symbol_record (const symbol_record& sr) + : rep (sr.rep) + { + rep->count++; + } + + symbol_record& operator = (const symbol_record& sr) + { + if (this != &sr) + { + if (--rep->count == 0) + delete rep; + + rep = sr.rep; + rep->count++; + } + + return *this; + } + + ~symbol_record (void) + { + if (--rep->count == 0) + delete rep; + } + + symbol_record dup (scope_id new_scope) const + { + return symbol_record (rep->dup (new_scope)); + } + + const std::string& name (void) const { return rep->name; } + + void rename (const std::string& new_name) { rep->name = new_name; } + + octave_value + find (const octave_value_list& args = octave_value_list ()) const; + + void assign (const octave_value& value, + context_id context = xdefault_context) + { + rep->assign (value, context); + } + + void assign (octave_value::assign_op op, + const std::string& type, + const std::list& idx, + const octave_value& value, + context_id context = xdefault_context) + { + rep->assign (op, type, idx, value, context); + } + + void assign (octave_value::assign_op op, const octave_value& value, + context_id context = xdefault_context) + { + rep->assign (op, value, context); + } + + void do_non_const_unary_op (octave_value::unary_op op) + { + rep->do_non_const_unary_op (op); + } + + void do_non_const_unary_op (octave_value::unary_op op, + const std::string& type, + const std::list& idx) + { + rep->do_non_const_unary_op (op, type, idx); + } + + // Delete when deprecated varref functions are removed. + octave_value& varref (context_id context = xdefault_context) + { + return rep->varref (context); + } + + octave_value varval (context_id context = xdefault_context) const + { + return rep->varval (context); + } + + void push_context (scope_id s) { rep->push_context (s); } + + size_t pop_context (scope_id s) { return rep->pop_context (s); } + + void clear (void) { rep->clear (); } + + void clear (scope_id s) { rep->clear (s); } + + bool is_defined (context_id context = xdefault_context) const + { + return rep->is_defined (context); + } + + bool is_undefined (context_id context = xdefault_context) const + { + return ! rep->is_defined (context); + } + + bool is_valid (void) const + { + return rep->is_valid (); + } + + bool is_variable (context_id context = xdefault_context) const + { + return rep->is_variable (context); + } + + bool is_local (void) const { return rep->is_local (); } + bool is_automatic (void) const { return rep->is_automatic (); } + bool is_formal (void) const { return rep->is_formal (); } + bool is_global (void) const { return rep->is_global (); } + bool is_hidden (void) const { return rep->is_hidden (); } + bool is_inherited (void) const { return rep->is_inherited (); } + bool is_persistent (void) const { return rep->is_persistent (); } + bool is_added_static (void) const { return rep->is_added_static (); } + + void mark_local (void) { rep->mark_local (); } + void mark_automatic (void) { rep->mark_automatic (); } + void mark_formal (void) { rep->mark_formal (); } + void mark_hidden (void) { rep->mark_hidden (); } + void mark_inherited (void) { rep->mark_inherited (); } + void mark_global (void) { rep->mark_global (); } + void mark_persistent (void) { rep->mark_persistent (); } + void mark_added_static (void) { rep->mark_added_static (); } + + void unmark_local (void) { rep->unmark_local (); } + void unmark_automatic (void) { rep->unmark_automatic (); } + void unmark_formal (void) { rep->unmark_formal (); } + void unmark_hidden (void) { rep->unmark_hidden (); } + void unmark_inherited (void) { rep->unmark_inherited (); } + void unmark_global (void) { rep->unmark_global (); } + void unmark_persistent (void) { rep->unmark_persistent (); } + void unmark_added_static (void) { rep->unmark_added_static (); } + + void init_persistent (void) { rep->init_persistent (); } + + void erase_persistent (void) { rep->erase_persistent (); } + + void invalidate (void) { rep->invalidate (); } + + context_id active_context (void) const { return rep->active_context (); } + + scope_id scope (void) const { return rep->scope (); } + + unsigned int xstorage_class (void) const { return rep->storage_class; } + + void set_curr_fcn (octave_user_function *fcn) { rep->set_curr_fcn (fcn); } + + void + dump (std::ostream& os, const std::string& prefix = std::string ()) const + { + rep->dump (os, prefix); + } + + private: + + symbol_record_rep *rep; + + symbol_record (symbol_record_rep *new_rep) : rep (new_rep) { } + }; + + // Always access a symbol from the current scope. + // Useful for scripts, as they may be executed in more than one scope. + class + symbol_reference + { + public: + + symbol_reference (void) : scope (-1) { } + + symbol_reference (const symbol_record& record, + scope_id curr_scope = symbol_table::current_scope ()) + : scope (curr_scope), sym (record) + { } + + symbol_reference (const symbol_reference& ref) + : scope (ref.scope), sym (ref.sym) + { } + + symbol_reference& operator = (const symbol_reference& ref) + { + if (this != &ref) + { + scope = ref.scope; + sym = ref.sym; + } + return *this; + } + + bool is_black_hole (void) const { return scope < 0; } + + // The name is the same regardless of scope. + const std::string& name (void) const { return sym.name (); } + + symbol_record *operator-> (void) + { + update (); + return &sym; + } + + symbol_record *operator-> (void) const + { + update (); + return &sym; + } + + // can be used to place symbol_reference in maps, we don't overload < as + // it doesn't make any sense for symbol_reference + struct comparator + { + bool operator ()(const symbol_reference& lhs, + const symbol_reference& rhs) const + { + return lhs.name () < rhs.name (); + } + }; + private: + + void update (void) const + { + scope_id curr_scope = symbol_table::current_scope (); + + if (scope != curr_scope || ! sym.is_valid ()) + { + scope = curr_scope; + sym = symbol_table::insert (sym.name ()); + } + } + + mutable scope_id scope; + mutable symbol_record sym; + }; + + class + fcn_info + { + public: + + typedef std::map dispatch_map_type; + + typedef std::map::const_iterator scope_val_const_iterator; + typedef std::map::iterator scope_val_iterator; + + typedef std::map::const_iterator str_val_const_iterator; + typedef std::map::iterator str_val_iterator; + + typedef dispatch_map_type::const_iterator dispatch_map_const_iterator; + typedef dispatch_map_type::iterator dispatch_map_iterator; + + private: + + class + fcn_info_rep + { + public: + + fcn_info_rep (const std::string& nm) + : name (nm), subfunctions (), private_functions (), + class_constructors (), class_methods (), dispatch_map (), + cmdline_function (), autoload_function (), function_on_path (), + built_in_function (), count (1) { } + + octave_value load_private_function (const std::string& dir_name); + + octave_value load_class_constructor (void); + + octave_value load_class_method (const std::string& dispatch_type); + + octave_value find (const octave_value_list& args, bool local_funcs); + + octave_value builtin_find (void); + + octave_value find_method (const std::string& dispatch_type); + + octave_value find_autoload (void); + + octave_value find_user_function (void); + + bool is_user_function_defined (void) const + { + return function_on_path.is_defined (); + } + + octave_value find_function (const octave_value_list& args, bool local_funcs) + { + return find (args, local_funcs); + } + + void lock_subfunction (scope_id scope) + { + scope_val_iterator p = subfunctions.find (scope); + + if (p != subfunctions.end ()) + p->second.lock (); + } + + void unlock_subfunction (scope_id scope) + { + scope_val_iterator p = subfunctions.find (scope); + + if (p != subfunctions.end ()) + p->second.unlock (); + } + + std::pair + subfunction_defined_in_scope (scope_id scope) const + { + scope_val_const_iterator p = subfunctions.find (scope); + + return p == subfunctions.end () + ? std::pair () + : std::pair (name, p->second); + } + + void erase_subfunction (scope_id scope) + { + scope_val_iterator p = subfunctions.find (scope); + + if (p != subfunctions.end ()) + subfunctions.erase (p); + } + + void mark_subfunction_in_scope_as_private (scope_id scope, + const std::string& class_name); + + void install_cmdline_function (const octave_value& f) + { + cmdline_function = f; + } + + void install_subfunction (const octave_value& f, scope_id scope) + { + subfunctions[scope] = f; + } + + void install_user_function (const octave_value& f) + { + function_on_path = f; + } + + void install_built_in_function (const octave_value& f) + { + built_in_function = f; + } + + template + void + clear_map (std::map& map, bool force = false) + { + typename std::map::iterator p = map.begin (); + + while (p != map.end ()) + { + if (force || ! p->second.islocked ()) + map.erase (p++); + else + p++; + } + } + + void clear_autoload_function (bool force = false) + { + if (force || ! autoload_function.islocked ()) + autoload_function = octave_value (); + } + + // We also clear command line functions here, as these are both + // "user defined" + void clear_user_function (bool force = false) + { + if (force || ! function_on_path.islocked ()) + function_on_path = octave_value (); + + if (force || ! cmdline_function.islocked ()) + cmdline_function = octave_value (); + } + + void clear_mex_function (void) + { + if (function_on_path.is_mex_function ()) + clear_user_function (); + } + + void clear (bool force = false) + { + clear_map (subfunctions, force); + clear_map (private_functions, force); + clear_map (class_constructors, force); + clear_map (class_methods, force); + + clear_autoload_function (force); + clear_user_function (force); + } + + void add_dispatch (const std::string& type, const std::string& fname) + { + dispatch_map[type] = fname; + } + + void clear_dispatch (const std::string& type) + { + dispatch_map_iterator p = dispatch_map.find (type); + + if (p != dispatch_map.end ()) + dispatch_map.erase (p); + } + + void print_dispatch (std::ostream& os) const; + + std::string help_for_dispatch (void) const; + + dispatch_map_type get_dispatch (void) const { return dispatch_map; } + + void dump (std::ostream& os, const std::string& prefix) const; + + std::string name; + + // Scope id to function object. + std::map subfunctions; + + // Directory name to function object. + std::map private_functions; + + // Class name to function object. + std::map class_constructors; + + // Dispatch type to function object. + std::map class_methods; + + // Legacy dispatch map (dispatch type name to function name). + dispatch_map_type dispatch_map; + + octave_value cmdline_function; + + octave_value autoload_function; + + octave_value function_on_path; + + octave_value built_in_function; + + octave_refcount count; + + private: + + octave_value xfind (const octave_value_list& args, bool local_funcs); + + octave_value x_builtin_find (void); + + // No copying! + + fcn_info_rep (const fcn_info_rep&); + + fcn_info_rep& operator = (const fcn_info_rep&); + }; + + public: + + fcn_info (const std::string& nm = std::string ()) + : rep (new fcn_info_rep (nm)) { } + + fcn_info (const fcn_info& fi) : rep (fi.rep) + { + rep->count++; + } + + fcn_info& operator = (const fcn_info& fi) + { + if (this != &fi) + { + if (--rep->count == 0) + delete rep; + + rep = fi.rep; + rep->count++; + } + + return *this; + } + + ~fcn_info (void) + { + if (--rep->count == 0) + delete rep; + } + + octave_value find (const octave_value_list& args = octave_value_list (), + bool local_funcs = true) + { + return rep->find (args, local_funcs); + } + + octave_value builtin_find (void) + { + return rep->builtin_find (); + } + + octave_value find_method (const std::string& dispatch_type) const + { + return rep->find_method (dispatch_type); + } + + octave_value find_built_in_function (void) const + { + return rep->built_in_function; + } + + octave_value find_cmdline_function (void) const + { + return rep->cmdline_function; + } + + octave_value find_autoload (void) + { + return rep->find_autoload (); + } + + octave_value find_user_function (void) + { + return rep->find_user_function (); + } + + bool is_user_function_defined (void) const + { + return rep->is_user_function_defined (); + } + + octave_value find_function (const octave_value_list& args = octave_value_list (), + bool local_funcs = true) + { + return rep->find_function (args, local_funcs); + } + + void lock_subfunction (scope_id scope) + { + rep->lock_subfunction (scope); + } + + void unlock_subfunction (scope_id scope) + { + rep->unlock_subfunction (scope); + } + + std::pair + subfunction_defined_in_scope (scope_id scope = xcurrent_scope) const + { + return rep->subfunction_defined_in_scope (scope); + } + + void erase_subfunction (scope_id scope) + { + rep->erase_subfunction (scope); + } + + void mark_subfunction_in_scope_as_private (scope_id scope, + const std::string& class_name) + { + rep->mark_subfunction_in_scope_as_private (scope, class_name); + } + + void install_cmdline_function (const octave_value& f) + { + rep->install_cmdline_function (f); + } + + void install_subfunction (const octave_value& f, scope_id scope) + { + rep->install_subfunction (f, scope); + } + + void install_user_function (const octave_value& f) + { + rep->install_user_function (f); + } + + void install_built_in_function (const octave_value& f) + { + rep->install_built_in_function (f); + } + + void clear (bool force = false) { rep->clear (force); } + + void clear_user_function (bool force = false) + { + rep->clear_user_function (force); + } + + void clear_autoload_function (bool force = false) + { + rep->clear_autoload_function (force); + } + + void clear_mex_function (void) { rep->clear_mex_function (); } + + void add_dispatch (const std::string& type, const std::string& fname) + { + rep->add_dispatch (type, fname); + } + + void clear_dispatch (const std::string& type) + { + rep->clear_dispatch (type); + } + + void print_dispatch (std::ostream& os) const + { + rep->print_dispatch (os); + } + + std::string help_for_dispatch (void) const { return rep->help_for_dispatch (); } + + dispatch_map_type get_dispatch (void) const + { + return rep->get_dispatch (); + } + + void + dump (std::ostream& os, const std::string& prefix = std::string ()) const + { + rep->dump (os, prefix); + } + + private: + + fcn_info_rep *rep; + }; + + static scope_id global_scope (void) { return xglobal_scope; } + static scope_id top_scope (void) { return xtop_scope; } + + static scope_id current_scope (void) { return xcurrent_scope; } + + static context_id current_context (void) { return xcurrent_context; } + + static scope_id alloc_scope (void) { return scope_id_cache::alloc (); } + + static void set_scope (scope_id scope) + { + if (scope == xglobal_scope) + error ("can't set scope to global"); + else if (scope != xcurrent_scope) + { + all_instances_iterator p = all_instances.find (scope); + + if (p == all_instances.end ()) + { + symbol_table *inst = new symbol_table (scope); + + if (inst) + all_instances[scope] = instance = inst; + } + else + instance = p->second; + + xcurrent_scope = scope; + xcurrent_context = 0; + } + } + + static void set_scope_and_context (scope_id scope, context_id context) + { + if (scope == xglobal_scope) + error ("can't set scope to global"); + else + { + if (scope != xcurrent_scope) + { + all_instances_iterator p = all_instances.find (scope); + + if (p == all_instances.end ()) + error ("scope not found!"); + else + { + instance = p->second; + + xcurrent_scope = scope; + + xcurrent_context = context; + } + } + else + xcurrent_context = context; + } + } + + static void erase_scope (scope_id scope) + { + assert (scope != xglobal_scope); + + erase_subfunctions_in_scope (scope); + + all_instances_iterator p = all_instances.find (scope); + + if (p != all_instances.end ()) + { + delete p->second; + + all_instances.erase (p); + + free_scope (scope); + } + } + + static void erase_subfunctions_in_scope (scope_id scope) + { + for (fcn_table_iterator q = fcn_table.begin (); + q != fcn_table.end (); q++) + q->second.erase_subfunction (scope); + } + + static void + mark_subfunctions_in_scope_as_private (scope_id scope, + const std::string& class_name) + { + for (fcn_table_iterator q = fcn_table.begin (); + q != fcn_table.end (); q++) + q->second.mark_subfunction_in_scope_as_private (scope, class_name); + } + + static scope_id dup_scope (scope_id scope) + { + scope_id retval = -1; + + symbol_table *inst = get_instance (scope); + + if (inst) + { + scope_id new_scope = alloc_scope (); + + symbol_table *new_symbol_table = new symbol_table (scope); + + if (new_symbol_table) + { + all_instances[new_scope] = new_symbol_table; + + inst->do_dup_scope (*new_symbol_table); + + retval = new_scope; + } + } + + return retval; + } + + static std::list scopes (void) + { + return scope_id_cache::scopes (); + } + + static symbol_record + find_symbol (const std::string& name, scope_id scope = xcurrent_scope) + { + symbol_table *inst = get_instance (scope); + + return inst ? inst->do_find_symbol (name) : + symbol_record (scope); + } + + static void + inherit (scope_id scope, scope_id donor_scope, context_id donor_context) + { + symbol_table *inst = get_instance (scope); + + if (inst) + { + symbol_table *donor_symbol_table = get_instance (donor_scope); + + if (donor_symbol_table) + inst->do_inherit (*donor_symbol_table, donor_context); + } + } + + static bool at_top_level (void) { return xcurrent_scope == xtop_scope; } + + // Find a value corresponding to the given name in the table. + static octave_value + find (const std::string& name, + const octave_value_list& args = octave_value_list (), + bool skip_variables = false, + bool local_funcs = true); + + static octave_value builtin_find (const std::string& name); + + // Insert a new name in the table. + static symbol_record& insert (const std::string& name, + scope_id scope = xcurrent_scope) + { + static symbol_record foobar; + + symbol_table *inst = get_instance (scope); + + return inst ? inst->do_insert (name) : foobar; + } + + static void rename (const std::string& old_name, + const std::string& new_name, + scope_id scope = xcurrent_scope) + { + symbol_table *inst = get_instance (scope); + + if (inst) + inst->do_rename (old_name, new_name); + } + + static void assign (const std::string& name, + const octave_value& value = octave_value (), + scope_id scope = xcurrent_scope, + context_id context = xdefault_context, + bool force_add = false) + { + static octave_value foobar; + + symbol_table *inst = get_instance (scope); + + if (inst) + inst->do_assign (name, value, context, force_add); + } + + // Use assign (name, value, scope, context, force_add) instead. + static octave_value& + varref (const std::string& name, scope_id scope = xcurrent_scope, + context_id context = xdefault_context, bool force_add = false) + GCC_ATTR_DEPRECATED + { + static octave_value foobar; + + symbol_table *inst = get_instance (scope); + + return inst ? inst->do_varref (name, context, force_add) : foobar; + } + + // Convenience function to simplify + // octave_user_function::bind_automatic_vars + + static void force_assign (const std::string& name, + const octave_value& value = octave_value (), + scope_id scope = xcurrent_scope, + context_id context = xdefault_context) + { + assign (name, value, scope, context, true); + } + + // Use force_assign (name, value, scope, context) instead. + static octave_value& + force_varref (const std::string& name, scope_id scope = xcurrent_scope, + context_id context = xdefault_context) GCC_ATTR_DEPRECATED + { + static octave_value foobar; + + symbol_table *inst = get_instance (scope); + + return inst ? inst->do_varref (name, context, true) : foobar; + } + + static octave_value varval (const std::string& name, + scope_id scope = xcurrent_scope, + context_id context = xdefault_context) + { + symbol_table *inst = get_instance (scope); + + return inst ? inst->do_varval (name, context) : octave_value (); + } + + static void + global_assign (const std::string& name, + const octave_value& value = octave_value ()) + + { + global_table_iterator p = global_table.find (name); + + if (p == global_table.end ()) + global_table[name] = value; + else + p->second = value; + } + + // Use global_assign (name, value) instead. + static octave_value& + global_varref (const std::string& name) GCC_ATTR_DEPRECATED + + { + global_table_iterator p = global_table.find (name); + + return (p == global_table.end ()) ? global_table[name] : p->second; + } + + static octave_value + global_varval (const std::string& name) + { + global_table_const_iterator p = global_table.find (name); + + return (p != global_table.end ()) ? p->second : octave_value (); + } + + static void + top_level_assign (const std::string& name, + const octave_value& value = octave_value ()) + { + assign (name, value, top_scope (), 0); + } + + // Use top_level_assign (name, value) instead. + static octave_value& + top_level_varref (const std::string& name) GCC_ATTR_DEPRECATED + { + static octave_value foobar; + + symbol_table *inst = get_instance (top_scope ()); + + return inst ? inst->do_varref (name, 0, true) : foobar; + } + + static octave_value + top_level_varval (const std::string& name) + { + return varval (name, top_scope (), 0); + } + + static void + persistent_assign (const std::string& name, + const octave_value& value = octave_value ()) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_persistent_assign (name, value); + } + + // Use persistent_assign (name, value) instead. + static octave_value& persistent_varref (const std::string& name) + GCC_ATTR_DEPRECATED + { + static octave_value foobar; + + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_persistent_varref (name) : foobar; + } + + static octave_value persistent_varval (const std::string& name) + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_persistent_varval (name) : octave_value (); + } + + static void erase_persistent (const std::string& name) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_erase_persistent (name); + } + + static bool is_variable (const std::string& name) + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_is_variable (name) : false; + } + + static bool + is_built_in_function_name (const std::string& name) + { + octave_value val = find_built_in_function (name); + + return val.is_defined (); + } + + static octave_value + find_method (const std::string& name, const std::string& dispatch_type) + { + fcn_table_const_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + return p->second.find_method (dispatch_type); + else + { + fcn_info finfo (name); + + octave_value fcn = finfo.find_method (dispatch_type); + + if (fcn.is_defined ()) + fcn_table[name] = finfo; + + return fcn; + } + } + + static octave_value + find_built_in_function (const std::string& name) + { + fcn_table_const_iterator p = fcn_table.find (name); + + return (p != fcn_table.end ()) + ? p->second.find_built_in_function () : octave_value (); + } + + static octave_value + find_autoload (const std::string& name) + { + fcn_table_iterator p = fcn_table.find (name); + + return (p != fcn_table.end ()) + ? p->second.find_autoload () : octave_value (); + } + + static octave_value + find_function (const std::string& name, + const octave_value_list& args = octave_value_list (), + bool local_funcs = true); + + static octave_value find_user_function (const std::string& name) + { + fcn_table_iterator p = fcn_table.find (name); + + return (p != fcn_table.end ()) + ? p->second.find_user_function () : octave_value (); + } + + static void install_cmdline_function (const std::string& name, + const octave_value& fcn) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.install_cmdline_function (fcn); + } + else + { + fcn_info finfo (name); + + finfo.install_cmdline_function (fcn); + + fcn_table[name] = finfo; + } + } + + // Install subfunction FCN named NAME. SCOPE is the scope of the + // primary function corresponding to this subfunction. + + static void install_subfunction (const std::string& name, + const octave_value& fcn, + scope_id scope) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.install_subfunction (fcn, scope); + } + else + { + fcn_info finfo (name); + + finfo.install_subfunction (fcn, scope); + + fcn_table[name] = finfo; + } + } + + static void install_nestfunction (const std::string& name, + const octave_value& fcn, + scope_id parent_scope); + + static void update_nest (scope_id scope) + { + symbol_table *inst = get_instance (scope); + if (inst) + inst->do_update_nest (); + } + + static void install_user_function (const std::string& name, + const octave_value& fcn) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.install_user_function (fcn); + } + else + { + fcn_info finfo (name); + + finfo.install_user_function (fcn); + + fcn_table[name] = finfo; + } + } + + static void install_built_in_function (const std::string& name, + const octave_value& fcn) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.install_built_in_function (fcn); + } + else + { + fcn_info finfo (name); + + finfo.install_built_in_function (fcn); + + fcn_table[name] = finfo; + } + } + + static void clear (const std::string& name) + { + clear_variable (name); + } + + static void clear_all (bool force = false) + { + clear_variables (); + + clear_global_pattern ("*"); + + clear_functions (force); + } + + static void clear_variables (scope_id scope) + { + symbol_table *inst = get_instance (scope); + + if (inst) + inst->do_clear_variables (); + } + + // This is split for unwind_protect. + static void clear_variables (void) + { + clear_variables (xcurrent_scope); + } + + static void clear_objects (scope_id scope = xcurrent_scope) + { + symbol_table *inst = get_instance (scope); + + if (inst) + inst->do_clear_objects (); + } + + static void clear_functions (bool force = false) + { + for (fcn_table_iterator p = fcn_table.begin (); p != fcn_table.end (); p++) + p->second.clear (force); + } + + static void clear_function (const std::string& name) + { + clear_user_function (name); + } + + static void clear_global (const std::string& name) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_clear_global (name); + } + + static void clear_variable (const std::string& name) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_clear_variable (name); + } + + static void clear_symbol (const std::string& name) + { + // FIXME -- are we supposed to do both here? + + clear_variable (name); + clear_function (name); + } + + static void clear_function_pattern (const std::string& pat) + { + glob_match pattern (pat); + + for (fcn_table_iterator p = fcn_table.begin (); p != fcn_table.end (); p++) + { + if (pattern.match (p->first)) + p->second.clear_user_function (); + } + } + + static void clear_global_pattern (const std::string& pat) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_clear_global_pattern (pat); + } + + static void clear_variable_pattern (const std::string& pat) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_clear_variable_pattern (pat); + } + + static void clear_variable_regexp (const std::string& pat) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_clear_variable_regexp (pat); + } + + static void clear_symbol_pattern (const std::string& pat) + { + // FIXME -- are we supposed to do both here? + + clear_variable_pattern (pat); + clear_function_pattern (pat); + } + + static void clear_user_function (const std::string& name) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.clear_user_function (); + } + // FIXME -- is this necessary, or even useful? + // else + // error ("clear: no such function '%s'", name.c_str ()); + } + + // This clears oct and mex files, incl. autoloads. + static void clear_dld_function (const std::string& name) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.clear_autoload_function (); + finfo.clear_user_function (); + } + } + + static void clear_mex_functions (void) + { + for (fcn_table_iterator p = fcn_table.begin (); p != fcn_table.end (); p++) + { + fcn_info& finfo = p->second; + + finfo.clear_mex_function (); + } + } + + static bool set_class_relationship (const std::string& sup_class, + const std::string& inf_class); + + static bool is_superiorto (const std::string& a, const std::string& b); + + static void alias_built_in_function (const std::string& alias, + const std::string& name) + { + octave_value fcn = find_built_in_function (name); + + if (fcn.is_defined ()) + { + fcn_info finfo (alias); + + finfo.install_built_in_function (fcn); + + fcn_table[alias] = finfo; + } + else + panic ("alias: '%s' is undefined", name.c_str ()); + } + + static void add_dispatch (const std::string& name, const std::string& type, + const std::string& fname) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.add_dispatch (type, fname); + } + else + { + fcn_info finfo (name); + + finfo.add_dispatch (type, fname); + + fcn_table[name] = finfo; + } + } + + static void clear_dispatch (const std::string& name, const std::string& type) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.clear_dispatch (type); + } + } + + static void print_dispatch (std::ostream& os, const std::string& name) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.print_dispatch (os); + } + } + + static fcn_info::dispatch_map_type get_dispatch (const std::string& name) + { + fcn_info::dispatch_map_type retval; + + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + retval = finfo.get_dispatch (); + } + + return retval; + } + + static std::string help_for_dispatch (const std::string& name) + { + std::string retval; + + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + retval = finfo.help_for_dispatch (); + } + + return retval; + } + + static void push_context (void) + { + if (xcurrent_scope == xglobal_scope || xcurrent_scope == xtop_scope) + error ("invalid call to xymtab::push_context"); + else + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_push_context (); + } + } + + static void pop_context (void) + { + if (xcurrent_scope == xglobal_scope || xcurrent_scope == xtop_scope) + error ("invalid call to xymtab::pop_context"); + else + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_pop_context (); + } + } + + // For unwind_protect. + static void pop_context (void *) { pop_context (); } + + static void mark_automatic (const std::string& name) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_mark_automatic (name); + } + + static void mark_hidden (const std::string& name) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_mark_hidden (name); + } + + static void mark_global (const std::string& name) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_mark_global (name); + } + + // exclude: Storage classes to exclude, you can OR them together + static std::list + all_variables (scope_id scope = xcurrent_scope, + context_id context = xdefault_context, + bool defined_only = true, + unsigned int exclude = symbol_record::hidden) + { + symbol_table *inst = get_instance (scope); + + return inst + ? inst->do_all_variables (context, defined_only, exclude) + : std::list (); + } + + static std::list glob (const std::string& pattern) + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_glob (pattern) : std::list (); + } + + static std::list regexp (const std::string& pattern) + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_regexp (pattern) : std::list (); + } + + static std::list glob_variables (const std::string& pattern) + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_glob (pattern, true) : std::list (); + } + + static std::list regexp_variables (const std::string& pattern) + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_regexp (pattern, true) : std::list (); + } + + static std::list + glob_global_variables (const std::string& pattern) + { + std::list retval; + + glob_match pat (pattern); + + for (global_table_const_iterator p = global_table.begin (); + p != global_table.end (); p++) + { + // We generate a list of symbol_record objects so that + // the results from glob_variables and glob_global_variables + // may be handled the same way. + + if (pat.match (p->first)) + retval.push_back (symbol_record (xglobal_scope, + p->first, p->second, + symbol_record::global)); + } + + return retval; + } + + static std::list + regexp_global_variables (const std::string& pattern) + { + std::list retval; + + ::regexp pat (pattern); + + for (global_table_const_iterator p = global_table.begin (); + p != global_table.end (); p++) + { + // We generate a list of symbol_record objects so that + // the results from regexp_variables and regexp_global_variables + // may be handled the same way. + + if (pat.is_match (p->first)) + retval.push_back (symbol_record (xglobal_scope, + p->first, p->second, + symbol_record::global)); + } + + return retval; + } + + static std::list glob_variables (const string_vector& patterns) + { + std::list retval; + + size_t len = patterns.length (); + + for (size_t i = 0; i < len; i++) + { + std::list tmp = glob_variables (patterns[i]); + + retval.insert (retval.begin (), tmp.begin (), tmp.end ()); + } + + return retval; + } + + static std::list regexp_variables + (const string_vector& patterns) + { + std::list retval; + + size_t len = patterns.length (); + + for (size_t i = 0; i < len; i++) + { + std::list tmp = regexp_variables (patterns[i]); + + retval.insert (retval.begin (), tmp.begin (), tmp.end ()); + } + + return retval; + } + + static std::list user_function_names (void) + { + std::list retval; + + for (fcn_table_iterator p = fcn_table.begin (); + p != fcn_table.end (); p++) + { + if (p->second.is_user_function_defined ()) + retval.push_back (p->first); + } + + if (! retval.empty ()) + retval.sort (); + + return retval; + } + + static std::list global_variable_names (void) + { + std::list retval; + + for (global_table_const_iterator p = global_table.begin (); + p != global_table.end (); p++) + retval.push_back (p->first); + + retval.sort (); + + return retval; + } + + static std::list top_level_variable_names (void) + { + symbol_table *inst = get_instance (xtop_scope); + + return inst ? inst->do_variable_names () : std::list (); + } + + static std::list variable_names (void) + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_variable_names () : std::list (); + } + + static std::list built_in_function_names (void) + { + std::list retval; + + for (fcn_table_const_iterator p = fcn_table.begin (); + p != fcn_table.end (); p++) + { + octave_value fcn = p->second.find_built_in_function (); + + if (fcn.is_defined ()) + retval.push_back (p->first); + } + + if (! retval.empty ()) + retval.sort (); + + return retval; + } + + static std::list cmdline_function_names (void) + { + std::list retval; + + for (fcn_table_const_iterator p = fcn_table.begin (); + p != fcn_table.end (); p++) + { + octave_value fcn = p->second.find_cmdline_function (); + + if (fcn.is_defined ()) + retval.push_back (p->first); + } + + if (! retval.empty ()) + retval.sort (); + + return retval; + } + + static bool is_local_variable (const std::string& name) + { + if (xcurrent_scope == xglobal_scope) + return false; + else + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_is_local_variable (name) : false; + } + } + + static bool is_global (const std::string& name) + { + if (xcurrent_scope == xglobal_scope) + return true; + else + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_is_global (name) : false; + } + } + + static std::list workspace_info (void) + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst + ? inst->do_workspace_info () : std::list (); + } + + static void dump (std::ostream& os, scope_id scope = xcurrent_scope); + + static void dump_global (std::ostream& os); + + static void dump_functions (std::ostream& os); + + static void cache_name (scope_id scope, const std::string& name) + { + symbol_table *inst = get_instance (scope, false); + + if (inst) + inst->do_cache_name (name); + } + + static void lock_subfunctions (scope_id scope = xcurrent_scope) + { + for (fcn_table_iterator p = fcn_table.begin (); + p != fcn_table.end (); p++) + p->second.lock_subfunction (scope); + } + + static void unlock_subfunctions (scope_id scope = xcurrent_scope) + { + for (fcn_table_iterator p = fcn_table.begin (); + p != fcn_table.end (); p++) + p->second.unlock_subfunction (scope); + } + + static std::map + subfunctions_defined_in_scope (scope_id scope = xcurrent_scope) + { + std::map retval; + + for (fcn_table_const_iterator p = fcn_table.begin (); + p != fcn_table.end (); p++) + { + std::pair tmp + = p->second.subfunction_defined_in_scope (scope); + + std::string nm = tmp.first; + + if (! nm.empty ()) + retval[nm] = tmp.second; + } + + return retval; + } + + static void free_scope (scope_id scope) + { + if (scope == xglobal_scope || scope == xtop_scope) + error ("can't free global or top-level scopes!"); + else + symbol_table::scope_id_cache::free (scope); + } + + static void stash_dir_name_for_subfunctions (scope_id scope, + const std::string& dir_name); + + static void add_to_parent_map (const std::string& classname, + const std::list& parent_list) + { + parent_map[classname] = parent_list; + } + + static std::list + parent_classes (const std::string& dispatch_type) + { + std::list retval; + + const_parent_map_iterator it = parent_map.find (dispatch_type); + + if (it != parent_map.end ()) + retval = it->second; + + for (std::list::const_iterator lit = retval.begin (); + lit != retval.end (); lit++) + { + // Search for parents of parents and append them to the list. + + // FIXME -- should we worry about a circular inheritance graph? + + std::list parents = parent_classes (*lit); + + if (! parents.empty ()) + retval.insert (retval.end (), parents.begin (), parents.end ()); + } + + return retval; + } + + static octave_user_function *get_curr_fcn (scope_id scope = xcurrent_scope) + { + symbol_table *inst = get_instance (scope); + return inst->curr_fcn; + } + + static void set_curr_fcn (octave_user_function *curr_fcn, + scope_id scope = xcurrent_scope) + { + assert (scope != xtop_scope && scope != xglobal_scope); + symbol_table *inst = get_instance (scope); + // FIXME: normally, functions should not usurp each other's scope. + // If for any incredible reason this is needed, call + // set_user_function (0, scope) first. This may cause problems with + // nested functions, as the curr_fcn of symbol_records must be updated. + assert (inst->curr_fcn == 0 || curr_fcn == 0); + inst->curr_fcn = curr_fcn; + } + + static void cleanup (void); + +private: + + // No copying! + + symbol_table (const symbol_table&); + + symbol_table& operator = (const symbol_table&); + + typedef std::map::const_iterator table_const_iterator; + typedef std::map::iterator table_iterator; + + typedef std::map::const_iterator global_table_const_iterator; + typedef std::map::iterator global_table_iterator; + + typedef std::map::const_iterator persistent_table_const_iterator; + typedef std::map::iterator persistent_table_iterator; + + typedef std::map::const_iterator all_instances_const_iterator; + typedef std::map::iterator all_instances_iterator; + + typedef std::map::const_iterator fcn_table_const_iterator; + typedef std::map::iterator fcn_table_iterator; + + // The scope of this symbol table. + scope_id my_scope; + + // Name for this table (usually the file name of the function + // corresponding to the scope); + std::string table_name; + + // Map from symbol names to symbol info. + std::map table; + + // Child nested functions. + std::vector nest_children; + + // Parent nested function (may be null). + symbol_table *nest_parent; + + // The associated user code (may be null). + octave_user_function *curr_fcn; + + // If true then no variables can be added. + bool static_workspace; + + // Map from names of global variables to values. + static std::map global_table; + + // Map from names of persistent variables to values. + std::map persistent_table; + + // Pointer to symbol table for current scope (variables only). + static symbol_table *instance; + + // Map from scope id to symbol table instances. + static std::map all_instances; + + // Map from function names to function info (subfunctions, private + // functions, class constructors, class methods, etc.) + static std::map fcn_table; + + // Mape from class names to set of classes that have lower + // precedence. + static std::map > class_precedence_table; + + typedef std::map >::const_iterator class_precedence_table_const_iterator; + typedef std::map >::iterator class_precedence_table_iterator; + + // Map from class names to parent class names. + static std::map > parent_map; + + typedef std::map >::const_iterator const_parent_map_iterator; + typedef std::map >::iterator parent_map_iterator; + + static const scope_id xglobal_scope; + static const scope_id xtop_scope; + + static scope_id xcurrent_scope; + + static context_id xcurrent_context; + + static const context_id xdefault_context = static_cast (-1); + + symbol_table (scope_id scope) + : my_scope (scope), table_name (), table (), nest_children (), nest_parent (0), + curr_fcn (0), static_workspace (false), persistent_table () { } + + ~symbol_table (void) { } + + static symbol_table *get_instance (scope_id scope, bool create = true) + { + symbol_table *retval = 0; + + bool ok = true; + + if (scope != xglobal_scope) + { + if (scope == xcurrent_scope) + { + if (! instance && create) + { + symbol_table *inst = new symbol_table (scope); + + if (inst) + { + all_instances[scope] = instance = inst; + + if (scope == xtop_scope) + instance->do_cache_name ("top-level"); + } + } + + if (! instance) + ok = false; + + retval = instance; + } + else + { + all_instances_iterator p = all_instances.find (scope); + + if (p == all_instances.end ()) + { + if (create) + { + retval = new symbol_table (scope); + + if (retval) + all_instances[scope] = retval; + else + ok = false; + } + else + ok = false; + } + else + retval = p->second; + } + } + + if (! ok) + error ("unable to %s symbol_table object for scope %d!", + create ? "create" : "find", scope); + + return retval; + } + + void add_nest_child (symbol_table& st) + { + assert (!st.nest_parent); + nest_children.push_back (&st); + st.nest_parent = this; + } + + void insert_symbol_record (const symbol_record& sr) + { + table[sr.name ()] = sr; + } + + void + do_dup_scope (symbol_table& new_symbol_table) const + { + for (table_const_iterator p = table.begin (); p != table.end (); p++) + new_symbol_table.insert_symbol_record (p->second.dup (new_symbol_table.my_scope)); + } + + symbol_record do_find_symbol (const std::string& name) + { + table_iterator p = table.find (name); + + if (p == table.end ()) + return do_insert (name); + else + return p->second; + } + + void do_inherit (symbol_table& donor_table, context_id donor_context) + { + for (table_iterator p = table.begin (); p != table.end (); p++) + { + symbol_record& sr = p->second; + + if (! (sr.is_automatic () || sr.is_formal ())) + { + std::string nm = sr.name (); + + if (nm != "__retval__") + { + octave_value val = donor_table.do_varval (nm, donor_context); + + if (val.is_defined ()) + { + sr.assign (val, 0); + + sr.mark_inherited (); + } + } + } + } + } + + static fcn_info *get_fcn_info (const std::string& name) + { + fcn_table_iterator p = fcn_table.find (name); + return p != fcn_table.end () ? &p->second : 0; + } + + octave_value + do_find (const std::string& name, const octave_value_list& args, + bool skip_variables, bool local_funcs); + + octave_value do_builtin_find (const std::string& name); + + symbol_record& do_insert (const std::string& name, bool force_add = false) + { + table_iterator p = table.find (name); + + if (p == table.end ()) + { + symbol_record ret (my_scope, name); + + if (nest_parent && nest_parent->look_nonlocal (name, ret)) + return table[name] = ret; + else + { + if (static_workspace && ! force_add) + ret.mark_added_static (); + + return table[name] = ret; + } + } + else + return p->second; + } + + void do_rename (const std::string& old_name, const std::string& new_name) + { + table_iterator p = table.find (old_name); + + if (p != table.end ()) + { + symbol_record sr = p->second; + + sr.rename (new_name); + + table.erase (p); + + table[new_name] = sr; + } + } + + void do_assign (const std::string& name, const octave_value& value, + context_id context, bool force_add) + { + table_iterator p = table.find (name); + + if (p == table.end ()) + { + symbol_record& sr = do_insert (name, force_add); + + sr.assign (value, context); + } + else + p->second.assign (value, context); + } + + // Use do_assign (name, value, context, force_add) instead. + // Delete when deprecated varref functions are removed. + octave_value& do_varref (const std::string& name, context_id context, + bool force_add) + { + table_iterator p = table.find (name); + + if (p == table.end ()) + { + symbol_record& sr = do_insert (name, force_add); + + return sr.varref (context); + } + else + return p->second.varref (context); + } + + octave_value do_varval (const std::string& name, context_id context) const + { + table_const_iterator p = table.find (name); + + return (p != table.end ()) ? p->second.varval (context) : octave_value (); + } + + void do_persistent_assign (const std::string& name, + const octave_value& value) + { + persistent_table_iterator p = persistent_table.find (name); + + if (p == persistent_table.end ()) + persistent_table[name] = value; + else + p->second = value; + } + + // Use do_persistent_assign (name, value) instead. + // Delete when deprecated varref functions are removed. + octave_value& do_persistent_varref (const std::string& name) + { + persistent_table_iterator p = persistent_table.find (name); + + return (p == persistent_table.end ()) + ? persistent_table[name] : p->second; + } + + octave_value do_persistent_varval (const std::string& name) + { + persistent_table_const_iterator p = persistent_table.find (name); + + return (p != persistent_table.end ()) ? p->second : octave_value (); + } + + void do_erase_persistent (const std::string& name) + { + persistent_table_iterator p = persistent_table.find (name); + + if (p != persistent_table.end ()) + persistent_table.erase (p); + } + + bool do_is_variable (const std::string& name) const + { + bool retval = false; + + table_const_iterator p = table.find (name); + + if (p != table.end ()) + { + const symbol_record& sr = p->second; + + retval = sr.is_variable (); + } + + return retval; + } + + void do_push_context (void) + { + for (table_iterator p = table.begin (); p != table.end (); p++) + p->second.push_context (my_scope); + } + + void do_pop_context (void) + { + table_iterator p = table.begin (); + + while (p != table.end ()) + { + if (p->second.pop_context (my_scope) == 0) + table.erase (p++); + else + p++; + } + } + + void do_clear_variables (void) + { + for (table_iterator p = table.begin (); p != table.end (); p++) + p->second.clear (my_scope); + } + + void do_clear_objects (void) + { + for (table_iterator p = table.begin (); p != table.end (); p++) + { + symbol_record& sr = p->second; + octave_value val = sr.varval (); + if (val.is_object ()) + p->second.clear (my_scope); + } + } + + void do_clear_global (const std::string& name) + { + table_iterator p = table.find (name); + + if (p != table.end ()) + { + symbol_record& sr = p->second; + + if (sr.is_global ()) + sr.unmark_global (); + } + + global_table_iterator q = global_table.find (name); + + if (q != global_table.end ()) + global_table.erase (q); + + } + + void do_clear_variable (const std::string& name) + { + table_iterator p = table.find (name); + + if (p != table.end ()) + p->second.clear (my_scope); + } + + void do_clear_global_pattern (const std::string& pat) + { + glob_match pattern (pat); + + for (table_iterator p = table.begin (); p != table.end (); p++) + { + symbol_record& sr = p->second; + + if (sr.is_global () && pattern.match (sr.name ())) + sr.unmark_global (); + } + + global_table_iterator q = global_table.begin (); + + while (q != global_table.end ()) + { + if (pattern.match (q->first)) + global_table.erase (q++); + else + q++; + } + + + } + + void do_clear_variable_pattern (const std::string& pat) + { + glob_match pattern (pat); + + for (table_iterator p = table.begin (); p != table.end (); p++) + { + symbol_record& sr = p->second; + + if (sr.is_defined () || sr.is_global ()) + { + if (pattern.match (sr.name ())) + sr.clear (my_scope); + } + } + } + + void do_clear_variable_regexp (const std::string& pat) + { + ::regexp pattern (pat); + + for (table_iterator p = table.begin (); p != table.end (); p++) + { + symbol_record& sr = p->second; + + if (sr.is_defined () || sr.is_global ()) + { + if (pattern.is_match (sr.name ())) + sr.clear (my_scope); + } + } + } + + void do_mark_automatic (const std::string& name) + { + do_insert (name).mark_automatic (); + } + + void do_mark_hidden (const std::string& name) + { + do_insert (name).mark_hidden (); + } + + void do_mark_global (const std::string& name) + { + do_insert (name).mark_global (); + } + + std::list + do_all_variables (context_id context, bool defined_only, + unsigned int exclude) const + { + std::list retval; + + for (table_const_iterator p = table.begin (); p != table.end (); p++) + { + const symbol_record& sr = p->second; + + if ((defined_only && ! sr.is_defined (context)) + || (sr.xstorage_class () & exclude)) + continue; + + retval.push_back (sr); + } + + return retval; + } + + std::list do_glob (const std::string& pattern, + bool vars_only = false) const + { + std::list retval; + + glob_match pat (pattern); + + for (table_const_iterator p = table.begin (); p != table.end (); p++) + { + if (pat.match (p->first)) + { + const symbol_record& sr = p->second; + + if (vars_only && ! sr.is_variable ()) + continue; + + retval.push_back (sr); + } + } + + return retval; + } + + std::list do_regexp (const std::string& pattern, + bool vars_only = false) const + { + std::list retval; + + ::regexp pat (pattern); + + for (table_const_iterator p = table.begin (); p != table.end (); p++) + { + if (pat.is_match (p->first)) + { + const symbol_record& sr = p->second; + + if (vars_only && ! sr.is_variable ()) + continue; + + retval.push_back (sr); + } + } + + return retval; + } + + std::list do_variable_names (void) + { + std::list retval; + + for (table_const_iterator p = table.begin (); p != table.end (); p++) + { + if (p->second.is_variable ()) + retval.push_back (p->first); + } + + retval.sort (); + + return retval; + } + + bool do_is_local_variable (const std::string& name) const + { + table_const_iterator p = table.find (name); + + return (p != table.end () + && ! p->second.is_global () + && p->second.is_defined ()); + } + + bool do_is_global (const std::string& name) const + { + table_const_iterator p = table.find (name); + + return p != table.end () && p->second.is_global (); + } + + std::list do_workspace_info (void) const; + + void do_dump (std::ostream& os); + + void do_cache_name (const std::string& name) { table_name = name; } + + void do_update_nest (void); + + bool look_nonlocal (const std::string& name, symbol_record& result) + { + table_iterator p = table.find (name); + if (p == table.end ()) + { + if (nest_parent) + return nest_parent->look_nonlocal (name, result); + } + else if (! p->second.is_automatic ()) + { + result = p->second; + return true; + } + + return false; + } +}; + +extern bool out_of_date_check (octave_value& function, + const std::string& dispatch_type = std::string (), + bool check_relative = true); + +extern OCTINTERP_API std::string +get_dispatch_type (const octave_value_list& args); +extern OCTINTERP_API std::string +get_dispatch_type (const octave_value_list& args, builtin_type_t& builtin_type); + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/sysdep.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/sysdep.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,908 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include +#include +#include + +#include +#include + +#include +#include + +#if defined (HAVE_TERMIOS_H) +#include +#elif defined (HAVE_TERMIO_H) +#include +#elif defined (HAVE_SGTTY_H) +#include +#endif + +#if defined (HAVE_CONIO_H) +#include +#endif + +#if defined (HAVE_SYS_IOCTL_H) +#include +#endif + +#if defined (HAVE_FLOATINGPOINT_H) +#include +#endif + +#if defined (HAVE_IEEEFP_H) +#include +#endif + +#include "cmd-edit.h" +#include "file-ops.h" +#include "lo-mappers.h" +#include "lo-math.h" +#include "mach-info.h" +#include "oct-env.h" +#include "quit.h" + +#include "Cell.h" +#include "builtins.h" +#include "defun.h" +#include "error.h" +#include "input.h" +#include "oct-obj.h" +#include "ov.h" +#include "pager.h" +#include "parse.h" +#include "sighandlers.h" +#include "sysdep.h" +#include "toplev.h" +#include "utils.h" +#include "file-stat.h" + +#ifndef STDIN_FILENO +#define STDIN_FILENO 1 +#endif + +#if defined (__386BSD__) || defined (__FreeBSD__) || defined (__NetBSD__) +static void +BSD_init (void) +{ +#if defined (HAVE_FLOATINGPOINT_H) + // Disable trapping on common exceptions. +#ifndef FP_X_DNML +#define FP_X_DNML 0 +#endif + fpsetmask (~(FP_X_OFL|FP_X_INV|FP_X_DZ|FP_X_DNML|FP_X_UFL|FP_X_IMP)); +#endif +} +#endif + +#if defined (__WIN32__) && ! defined (_POSIX_VERSION) + +#define WIN32_LEAN_AND_MEAN +#include + +static void +w32_set_octave_home (void) +{ + std::string bin_dir; + + HANDLE h = CreateToolhelp32Snapshot (TH32CS_SNAPMODULE +#ifdef TH32CS_SNAPMODULE32 + | TH32CS_SNAPMODULE32 +#endif + , 0); + + if (h != INVALID_HANDLE_VALUE) + { + MODULEENTRY32 mod_info; + + ZeroMemory (&mod_info, sizeof (mod_info)); + mod_info.dwSize = sizeof (mod_info); + + if (Module32First (h, &mod_info)) + { + do + { + std::string mod_name (mod_info.szModule); + + if (mod_name.find ("octinterp") != std::string::npos) + { + bin_dir = mod_info.szExePath; + if (bin_dir[bin_dir.length () - 1] != '\\') + bin_dir.append (1, '\\'); + break; + } + } + while (Module32Next (h, &mod_info)); + } + + CloseHandle (h); + } + + if (! bin_dir.empty ()) + { + size_t pos = bin_dir.rfind ("\\bin\\"); + + if (pos != std::string::npos) + octave_env::putenv ("OCTAVE_HOME", bin_dir.substr (0, pos)); + } +} + +void +w32_set_quiet_shutdown (void) +{ + // Let the user close the console window or shutdown without the + // pesky dialog. + // + // FIXME -- should this be user configurable? + SetProcessShutdownParameters (0x280, SHUTDOWN_NORETRY); +} + +void +MINGW_signal_cleanup (void) +{ + w32_set_quiet_shutdown (); +} +#endif + +#if defined (__MINGW32__) +static void +MINGW_init (void) +{ + w32_set_octave_home (); +} +#endif + +#if defined (_MSC_VER) +static void +MSVC_init (void) +{ + w32_set_octave_home (); +} +#endif + + +// Return TRUE if FILE1 and FILE2 refer to the same (physical) file. + +bool +same_file_internal (const std::string& file1, const std::string& file2) +{ +#ifdef OCTAVE_USE_WINDOWS_API + + bool retval = false; + + const char *f1 = file1.c_str (); + const char *f2 = file2.c_str (); + + bool f1_is_dir = GetFileAttributes (f1) & FILE_ATTRIBUTE_DIRECTORY; + bool f2_is_dir = GetFileAttributes (f2) & FILE_ATTRIBUTE_DIRECTORY; + + // Windows native code + // Reference: http://msdn2.microsoft.com/en-us/library/aa363788.aspx + + DWORD share = FILE_SHARE_DELETE | FILE_SHARE_READ | FILE_SHARE_WRITE; + + HANDLE hfile1 + = CreateFile (f1, 0, share, 0, OPEN_EXISTING, + f1_is_dir ? FILE_FLAG_BACKUP_SEMANTICS : 0, 0); + + if (hfile1 != INVALID_HANDLE_VALUE) + { + HANDLE hfile2 + = CreateFile (f2, 0, share, 0, OPEN_EXISTING, + f2_is_dir ? FILE_FLAG_BACKUP_SEMANTICS : 0, 0); + + if (hfile2 != INVALID_HANDLE_VALUE) + { + BY_HANDLE_FILE_INFORMATION hfi1; + BY_HANDLE_FILE_INFORMATION hfi2; + + if (GetFileInformationByHandle (hfile1, &hfi1) + && GetFileInformationByHandle (hfile2, &hfi2)) + { + retval = (hfi1.dwVolumeSerialNumber == hfi2.dwVolumeSerialNumber + && hfi1.nFileIndexHigh == hfi2.nFileIndexHigh + && hfi1.nFileIndexLow == hfi2.nFileIndexLow); + } + + CloseHandle (hfile2); + } + + CloseHandle (hfile1); + } + + return retval; + +#else + + // POSIX Code + + file_stat fs_file1 (file1); + file_stat fs_file2 (file2); + + return (fs_file1 && fs_file2 + && fs_file1.ino () == fs_file2.ino () + && fs_file1.dev () == fs_file2.dev ()); + +#endif +} + +void +sysdep_init (void) +{ +#if defined (__386BSD__) || defined (__FreeBSD__) || defined (__NetBSD__) + BSD_init (); +#elif defined (__MINGW32__) + MINGW_init (); +#elif defined (_MSC_VER) + MSVC_init (); +#endif +} + +void +sysdep_cleanup (void) +{ + MINGW_SIGNAL_CLEANUP (); +} + +// Set terminal in raw mode. From less-177. +// +// Change terminal to "raw mode", or restore to "normal" mode. +// "Raw mode" means +// 1. An outstanding read will complete on receipt of a single keystroke. +// 2. Input is not echoed. +// 3. On output, \n is mapped to \r\n. +// 4. \t is NOT expanded into spaces. +// 5. Signal-causing characters such as ctrl-C (interrupt), +// etc. are NOT disabled. +// It doesn't matter whether an input \n is mapped to \r, or vice versa. + +void +raw_mode (bool on, bool wait) +{ + static bool curr_on = false; + + int tty_fd = STDIN_FILENO; + if (! gnulib::isatty (tty_fd)) + { + if (interactive) + error ("stdin is not a tty!"); + return; + } + + if (on == curr_on) + return; + +#if defined (HAVE_TERMIOS_H) + { + struct termios s; + static struct termios save_term; + + if (on) + { + // Get terminal modes. + + tcgetattr (tty_fd, &s); + + // Save modes and set certain variables dependent on modes. + + save_term = s; +// ospeed = s.c_cflag & CBAUD; +// erase_char = s.c_cc[VERASE]; +// kill_char = s.c_cc[VKILL]; + + // Set the modes to the way we want them. + + s.c_lflag &= ~(ICANON|ECHO|ECHOE|ECHOK|ECHONL); + s.c_oflag |= (OPOST|ONLCR); +#if defined (OCRNL) + s.c_oflag &= ~(OCRNL); +#endif +#if defined (ONOCR) + s.c_oflag &= ~(ONOCR); +#endif +#if defined (ONLRET) + s.c_oflag &= ~(ONLRET); +#endif + s.c_cc[VMIN] = wait ? 1 : 0; + s.c_cc[VTIME] = 0; + } + else + { + // Restore saved modes. + + s = save_term; + } + + tcsetattr (tty_fd, wait ? TCSAFLUSH : TCSADRAIN, &s); + } +#elif defined (HAVE_TERMIO_H) + { + struct termio s; + static struct termio save_term; + + if (on) + { + // Get terminal modes. + + ioctl (tty_fd, TCGETA, &s); + + // Save modes and set certain variables dependent on modes. + + save_term = s; +// ospeed = s.c_cflag & CBAUD; +// erase_char = s.c_cc[VERASE]; +// kill_char = s.c_cc[VKILL]; + + // Set the modes to the way we want them. + + s.c_lflag &= ~(ICANON|ECHO|ECHOE|ECHOK|ECHONL); + s.c_oflag |= (OPOST|ONLCR); +#if defined (OCRNL) + s.c_oflag &= ~(OCRNL); +#endif +#if defined (ONOCR) + s.c_oflag &= ~(ONOCR); +#endif +#if defined (ONLRET) + s.c_oflag &= ~(ONLRET); +#endif + s.c_cc[VMIN] = wait ? 1 : 0; + } + else + { + // Restore saved modes. + + s = save_term; + } + + ioctl (tty_fd, TCSETAW, &s); + } +#elif defined (HAVE_SGTTY_H) + { + struct sgttyb s; + static struct sgttyb save_term; + + if (on) + { + // Get terminal modes. + + ioctl (tty_fd, TIOCGETP, &s); + + // Save modes and set certain variables dependent on modes. + + save_term = s; +// ospeed = s.sg_ospeed; +// erase_char = s.sg_erase; +// kill_char = s.sg_kill; + + // Set the modes to the way we want them. + + s.sg_flags |= CBREAK; + s.sg_flags &= ~(ECHO); + } + else + { + // Restore saved modes. + + s = save_term; + } + + ioctl (tty_fd, TIOCSETN, &s); + } +#else + warning ("no support for raw mode console I/O on this system"); + + // Make sure the current mode doesn't toggle. + on = curr_on; +#endif + + curr_on = on; +} + +FILE * +octave_popen (const char *command, const char *mode) +{ +#if defined (__MINGW32__) || defined (_MSC_VER) + if (mode && mode[0] && ! mode[1]) + { + char tmode[3]; + tmode[0] = mode[0]; + tmode[1] = 'b'; + tmode[2] = 0; + + return _popen (command, tmode); + } + else + return _popen (command, mode); +#else + return popen (command, mode); +#endif +} + +int +octave_pclose (FILE *f) +{ +#if defined (__MINGW32__) || defined (_MSC_VER) + return _pclose (f); +#else + return pclose (f); +#endif +} + +// Read one character from the terminal. + +int +octave_kbhit (bool wait) +{ +#ifdef HAVE__KBHIT + int c = (! wait && ! _kbhit ()) ? 0 : std::cin.get (); +#else + raw_mode (true, wait); + + // Get current handler. + octave_interrupt_handler saved_interrupt_handler + = octave_ignore_interrupts (); + + // Restore it, disabling system call restarts (if possible) so the + // read can be interrupted. + + octave_set_interrupt_handler (saved_interrupt_handler, false); + + int c = std::cin.get (); + + if (std::cin.fail () || std::cin.eof ()) + std::cin.clear (); + + // Restore it, enabling system call restarts (if possible). + octave_set_interrupt_handler (saved_interrupt_handler, true); + + raw_mode (false, true); +#endif + + return c; +} + +std::string +get_P_tmpdir (void) +{ +#if defined (__WIN32__) && ! defined (_POSIX_VERSION) + + std::string retval; + +#if defined (P_tmpdir) + retval = P_tmpdir; +#endif + + // Apparently some versions of MinGW and MSVC either don't define + // P_tmpdir, or they define it to a single backslash, neither of which + // is particularly helpful. + + if (retval.empty () || retval == "\\") + { + retval = octave_env::getenv ("TEMP"); + + if (retval.empty ()) + retval = octave_env::getenv ("TMP"); + + if (retval.empty ()) + retval = "c:\\temp"; + } + + return retval; + +#elif defined (P_tmpdir) + + return P_tmpdir; + +#else + + return "/tmp"; + +#endif +} + +DEFUN (clc, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} clc ()\n\ +@deftypefnx {Built-in Function} {} home ()\n\ +Clear the terminal screen and move the cursor to the upper left corner.\n\ +@end deftypefn") +{ + bool skip_redisplay = true; + + command_editor::clear_screen (skip_redisplay); + + return octave_value_list (); +} + +DEFALIAS (home, clc); + +DEFUN (getenv, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} getenv (@var{var})\n\ +Return the value of the environment variable @var{var}. For example,\n\ +\n\ +@example\n\ +getenv (\"PATH\")\n\ +@end example\n\ +\n\ +@noindent\n\ +returns a string containing the value of your path.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + std::string name = args(0).string_value (); + + if (! error_state) + retval = octave_env::getenv (name); + } + else + print_usage (); + + return retval; +} + +DEFUN (putenv, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} putenv (@var{var}, @var{value})\n\ +@deftypefnx {Built-in Function} {} setenv (@var{var}, @var{value})\n\ +Set the value of the environment variable @var{var} to @var{value}.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 2 || nargin == 1) + { + std::string var = args(0).string_value (); + + if (! error_state) + { + std::string val = (nargin == 2 + ? args(1).string_value () : std::string ()); + + if (! error_state) + octave_env::putenv (var, val); + else + error ("putenv: VALUE must be a string"); + } + else + error ("putenv: VAR must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFALIAS (setenv, putenv); + +/* +%!assert (ischar (getenv ("OCTAVE_HOME"))) +%!test +%! setenv ("dummy_variable_that_cannot_matter", "foobar"); +%! assert (getenv ("dummy_variable_that_cannot_matter"), "foobar"); +*/ + +// FIXME -- perhaps kbhit should also be able to print a prompt? + +DEFUN (kbhit, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} kbhit ()\n\ +@deftypefnx {Built-in Function} {} kbhit (1)\n\ +Read a single keystroke from the keyboard. If called with an\n\ +argument, don't wait for a keypress. For example,\n\ +\n\ +@example\n\ +x = kbhit ();\n\ +@end example\n\ +\n\ +@noindent\n\ +will set @var{x} to the next character typed at the keyboard as soon as\n\ +it is typed.\n\ +\n\ +@example\n\ +x = kbhit (1);\n\ +@end example\n\ +\n\ +@noindent\n\ +is identical to the above example, but doesn't wait for a keypress,\n\ +returning the empty string if no key is available.\n\ +@seealso{input}\n\ +@end deftypefn") +{ + octave_value retval; + + // FIXME -- add timeout and default value args? + + if (interactive || forced_interactive) + { + Fdrawnow (); + + int c = octave_kbhit (args.length () == 0); + + if (c == -1) + c = 0; + + char s[2] = { static_cast (c), '\0' }; + + retval = s; + } + + return retval; +} + +DEFUN (pause, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} pause (@var{seconds})\n\ +Suspend the execution of the program. If invoked without any arguments,\n\ +Octave waits until you type a character. With a numeric argument, it\n\ +pauses for the given number of seconds. For example, the following\n\ +statement prints a message and then waits 5 seconds before clearing the\n\ +screen.\n\ +\n\ +@example\n\ +@group\n\ +fprintf (stderr, \"wait please...\\n\");\n\ +pause (5);\n\ +clc;\n\ +@end group\n\ +@end example\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (! (nargin == 0 || nargin == 1)) + { + print_usage (); + return retval; + } + + if (nargin == 1) + { + double dval = args(0).double_value (); + + if (! error_state) + { + if (! xisnan (dval)) + { + Fdrawnow (); + + if (xisinf (dval)) + { + flush_octave_stdout (); + octave_kbhit (); + } + else + octave_sleep (dval); + } + else + warning ("pause: NaN is an invalid delay"); + } + } + else + { + Fdrawnow (); + flush_octave_stdout (); + octave_kbhit (); + } + + return retval; +} + +/* +%!test +%! pause (1); + +%!error (pause (1, 2)) +*/ + +DEFUN (sleep, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} sleep (@var{seconds})\n\ +Suspend the execution of the program for the given number of seconds.\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + double dval = args(0).double_value (); + + if (! error_state) + { + if (xisnan (dval)) + warning ("sleep: NaN is an invalid delay"); + else + { + Fdrawnow (); + octave_sleep (dval); + } + } + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! sleep (1); + +%!error (sleep ()) +%!error (sleep (1, 2)) +*/ + +DEFUN (usleep, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} usleep (@var{microseconds})\n\ +Suspend the execution of the program for the given number of\n\ +microseconds. On systems where it is not possible to sleep for periods\n\ +of time less than one second, @code{usleep} will pause the execution for\n\ +@code{round (@var{microseconds} / 1e6)} seconds.\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + double dval = args(0).double_value (); + + if (! error_state) + { + if (xisnan (dval)) + warning ("usleep: NaN is an invalid delay"); + else + { + Fdrawnow (); + + int delay = NINT (dval); + + if (delay > 0) + octave_usleep (delay); + } + } + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! usleep (1000); + +%!error (usleep ()) +%!error (usleep (1, 2)) +*/ + +// FIXME -- maybe this should only return 1 if IEEE floating +// point functions really work. + +DEFUN (isieee, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isieee ()\n\ +Return true if your computer @emph{claims} to conform to the IEEE standard\n\ +for floating point calculations. No actual tests are performed.\n\ +@end deftypefn") +{ + oct_mach_info::float_format flt_fmt = oct_mach_info::native_float_format (); + + return octave_value (flt_fmt == oct_mach_info::flt_fmt_ieee_little_endian + || flt_fmt == oct_mach_info::flt_fmt_ieee_big_endian); +} + +/* +%!assert (islogical (isieee ())) +*/ + +DEFUN (native_float_format, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} native_float_format ()\n\ +Return the native floating point format as a string\n\ +@end deftypefn") +{ + oct_mach_info::float_format flt_fmt = oct_mach_info::native_float_format (); + + return octave_value (oct_mach_info::float_format_as_string (flt_fmt)); +} + +/* +%!assert (ischar (native_float_format ())) +*/ + +DEFUN (tilde_expand, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} tilde_expand (@var{string})\n\ +Perform tilde expansion on @var{string}. If @var{string} begins with a\n\ +tilde character, (@samp{~}), all of the characters preceding the first\n\ +slash (or all characters, if there is no slash) are treated as a\n\ +possible user name, and the tilde and the following characters up to the\n\ +slash are replaced by the home directory of the named user. If the\n\ +tilde is followed immediately by a slash, the tilde is replaced by the\n\ +home directory of the user running Octave. For example:\n\ +\n\ +@example\n\ +@group\n\ +tilde_expand (\"~joeuser/bin\")\n\ + @result{} \"/home/joeuser/bin\"\n\ +tilde_expand (\"~/bin\")\n\ + @result{} \"/home/jwe/bin\"\n\ +@end group\n\ +@end example\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + octave_value arg = args(0); + + string_vector sv = arg.all_strings (); + + if (! error_state) + { + sv = file_ops::tilde_expand (sv); + + if (arg.is_cellstr ()) + retval = Cell (arg.dims (), sv); + else + retval = sv; + } + else + error ("tilde_expand: expecting argument to be char or cellstr object"); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! if (isempty (getenv ("HOME"))) +%! setenv ("HOME", "foobar"); +%! endif +%! home = getenv ("HOME"); +%! assert (tilde_expand ("~/foobar"), strcat (home, "/foobar")); +%! assert (tilde_expand ("/foo/bar"), "/foo/bar"); +%! assert (tilde_expand ("foo/bar"), "foo/bar"); +*/ diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/sysdep.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/sysdep.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,57 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_sysdep_h) +#define octave_sysdep_h 1 + +#include + +#include + +#include "lo-ieee.h" +#include "lo-sysdep.h" + +extern OCTINTERP_API void sysdep_init (void); + +extern OCTINTERP_API void sysdep_cleanup (void); + +extern OCTINTERP_API void raw_mode (bool, bool wait = true); + +extern OCTINTERP_API FILE *octave_popen (const char *command, const char *mode); +extern OCTINTERP_API int octave_pclose (FILE *f); + +extern OCTINTERP_API int octave_kbhit (bool wait = true); + +extern OCTINTERP_API std::string get_P_tmpdir (void); + +extern void w32_set_quiet_shutdown (void); + +#if defined (__WIN32__) && ! defined (_POSIX_VERSION) +extern void MINGW_signal_cleanup (void); +#define MINGW_SIGNAL_CLEANUP() MINGW_signal_cleanup () +#else +#define MINGW_SIGNAL_CLEANUP() do { } while (0) +#endif + +extern OCTINTERP_API bool same_file_internal (const std::string&, const std::string&); + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/toplev.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/toplev.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,1552 @@ +/* + +Copyright (C) 1995-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include +#include +#include + +#include +#include +#include +#include + +#include +#include +#include + +#include "cmd-edit.h" +#include "cmd-hist.h" +#include "file-ops.h" +#include "lo-error.h" +#include "lo-mappers.h" +#include "oct-env.h" +#include "oct-locbuf.h" +#include "quit.h" +#include "singleton-cleanup.h" +#include "str-vec.h" + +#include "defaults.h" +#include "defun.h" +#include "error.h" +#include "file-io.h" +#include "graphics.h" +#include "input.h" +#include "lex.h" +#include "octave-link.h" +#include "oct-conf.h" +#include "oct-conf-features.h" +#include "oct-hist.h" +#include "oct-map.h" +#include "oct-obj.h" +#include "ov.h" +#include "pager.h" +#include "parse.h" +#include "pathsearch.h" +#include "procstream.h" +#include "pt-eval.h" +#include "pt-jump.h" +#include "pt-stmt.h" +#include "sighandlers.h" +#include "sysdep.h" +#include "syswait.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" +#include "version.h" + +#ifndef SHELL_PATH +#define SHELL_PATH "/bin/sh" +#endif + +void (*octave_exit) (int) = ::exit; + +// TRUE means the quit() call is allowed. +bool quit_allowed = true; + +// TRUE means we are exiting via the builtin exit or quit functions. +bool quitting_gracefully = false; +// This stores the exit status. +int exit_status = 0; + +// TRUE means we are ready to interpret commands, but not everything +// is ready for interactive use. +bool octave_interpreter_ready = false; + +// TRUE means we've processed all the init code and we are good to go. +bool octave_initialized = false; + +octave_call_stack *octave_call_stack::instance = 0; + +void +octave_call_stack::create_instance (void) +{ + instance = new octave_call_stack (); + + if (instance) + { + instance->do_push (0, symbol_table::top_scope (), 0); + + singleton_cleanup_list::add (cleanup_instance); + } +} + +int +octave_call_stack::do_current_line (void) const +{ + int retval = -1; + + if (! cs.empty ()) + { + const call_stack_elt& elt = cs[curr_frame]; + retval = elt.line; + } + + return retval; +} + +int +octave_call_stack::do_current_column (void) const +{ + int retval = -1; + + if (! cs.empty ()) + { + const call_stack_elt& elt = cs[curr_frame]; + retval = elt.column; + } + + return retval; +} + +int +octave_call_stack::do_caller_user_code_line (void) const +{ + int retval = -1; + + const_iterator p = cs.end (); + + while (p != cs.begin ()) + { + const call_stack_elt& elt = *(--p); + + octave_function *f = elt.fcn; + + if (f && f->is_user_code ()) + { + if (elt.line > 0) + { + retval = elt.line; + break; + } + } + } + + return retval; +} + +int +octave_call_stack::do_caller_user_code_column (void) const +{ + int retval = -1; + + const_iterator p = cs.end (); + + while (p != cs.begin ()) + { + const call_stack_elt& elt = *(--p); + + octave_function *f = elt.fcn; + + if (f && f->is_user_code ()) + { + if (elt.column) + { + retval = elt.column; + break; + } + } + } + + return retval; +} + +size_t +octave_call_stack::do_num_user_code_frames (octave_idx_type& curr_user_frame) const +{ + size_t retval = 0; + + curr_user_frame = 0; + + // Look for the caller of dbstack. + size_t frame = cs[curr_frame].prev; + + bool found = false; + + size_t k = cs.size (); + + for (const_reverse_iterator p = cs.rbegin (); p != cs.rend (); p++) + { + octave_function *f = (*p).fcn; + + if (--k == frame) + found = true; + + if (f && f->is_user_code ()) + { + if (! found) + curr_user_frame++; + + retval++; + } + } + + // We counted how many user frames were not the one, in reverse. + // Now set curr_user_frame to be the index in the other direction. + curr_user_frame = retval - curr_user_frame - 1; + + return retval; +} + +octave_user_code * +octave_call_stack::do_caller_user_code (size_t nskip) const +{ + octave_user_code *retval = 0; + + const_iterator p = cs.end (); + + while (p != cs.begin ()) + { + const call_stack_elt& elt = *(--p); + + octave_function *f = elt.fcn; + + if (f && f->is_user_code ()) + { + if (nskip > 0) + nskip--; + else + { + retval = dynamic_cast (f); + break; + } + } + } + + return retval; +} + +// Use static fields for the best efficiency. +// NOTE: C++0x will allow these two to be merged into one. +static const char *bt_fieldnames[] = { "file", "name", "line", + "column", "scope", "context", 0 }; +static const octave_fields bt_fields (bt_fieldnames); + +octave_map +octave_call_stack::empty_backtrace (void) +{ + return octave_map (dim_vector (0, 1), bt_fields); +} + +octave_map +octave_call_stack::do_backtrace (size_t nskip, + octave_idx_type& curr_user_frame) const +{ + size_t user_code_frames = do_num_user_code_frames (curr_user_frame); + + size_t nframes = nskip <= user_code_frames ? user_code_frames - nskip : 0; + + // Our list is reversed. + curr_user_frame = nframes - curr_user_frame - 1; + + octave_map retval (dim_vector (nframes, 1), bt_fields); + + Cell& file = retval.contents (0); + Cell& name = retval.contents (1); + Cell& line = retval.contents (2); + Cell& column = retval.contents (3); + Cell& scope = retval.contents (4); + Cell& context = retval.contents (5); + + if (nframes > 0) + { + int k = 0; + + for (const_reverse_iterator p = cs.rbegin (); p != cs.rend (); p++) + { + const call_stack_elt& elt = *p; + + octave_function *f = elt.fcn; + + if (f && f->is_user_code ()) + { + if (nskip > 0) + nskip--; + else + { + scope(k) = elt.scope; + context(k) = elt.context; + + file(k) = f->fcn_file_name (); + std::string parent_fcn_name = f->parent_fcn_name (); + if (parent_fcn_name == std::string ()) + name(k) = f->name (); + else + name(k) = f->parent_fcn_name () + Vfilemarker + f->name (); + + line(k) = elt.line; + column(k) = elt.column; + + k++; + } + } + } + } + + return retval; +} + +bool +octave_call_stack::do_goto_frame (size_t n, bool verbose) +{ + bool retval = false; + + if (n < cs.size ()) + { + retval = true; + + curr_frame = n; + + const call_stack_elt& elt = cs[n]; + + symbol_table::set_scope_and_context (elt.scope, elt.context); + + if (verbose) + { + octave_function *f = elt.fcn; + std::string nm = f ? f->name () : std::string (""); + + octave_stdout << "stopped in " << nm + << " at line " << elt.line + << " column " << elt.column + << " (" << elt.scope << "[" << elt.context << "])" + << std::endl; + } + } + + return retval; +} + +bool +octave_call_stack::do_goto_frame_relative (int nskip, bool verbose) +{ + bool retval = false; + + int incr = 0; + + if (nskip < 0) + incr = -1; + else if (nskip > 0) + incr = 1; + + // Start looking with the caller of dbup/dbdown/keyboard. + size_t frame = cs[curr_frame].prev; + + while (true) + { + if ((incr < 0 && frame == 0) || (incr > 0 && frame == cs.size () - 1)) + break; + + frame += incr; + + const call_stack_elt& elt = cs[frame]; + + octave_function *f = elt.fcn; + + if (frame == 0 || (f && f->is_user_code ())) + { + if (nskip > 0) + nskip--; + else if (nskip < 0) + nskip++; + + if (nskip == 0) + { + curr_frame = frame; + cs[cs.size () - 1].prev = curr_frame; + + symbol_table::set_scope_and_context (elt.scope, elt.context); + + if (verbose) + { + std::ostringstream buf; + + if (f) + buf << "stopped in " << f->name () + << " at line " << elt.line << std::endl; + else + buf << "at top level" << std::endl; + + octave_stdout << buf.str (); + } + + retval = true; + break; + } + } + + // There is no need to set scope and context here. That will + // happen when the dbup/dbdown/keyboard frame is popped and we + // jump to the new "prev" frame set above. + } + + return retval; +} + +void +octave_call_stack::do_goto_caller_frame (void) +{ + size_t frame = curr_frame; + + bool skipped = false; + + while (frame != 0) + { + frame = cs[frame].prev; + + const call_stack_elt& elt = cs[frame]; + + octave_function *f = elt.fcn; + + if (frame == 0 || (f && f->is_user_code ())) + { + if (! skipped) + // We found the current user code frame, so skip it. + skipped = true; + else + { + // We found the caller user code frame. + call_stack_elt tmp (elt); + tmp.prev = curr_frame; + + curr_frame = cs.size (); + + cs.push_back (tmp); + + symbol_table::set_scope_and_context (tmp.scope, tmp.context); + + break; + } + } + } +} + +void +octave_call_stack::do_goto_base_frame (void) +{ + call_stack_elt tmp (cs[0]); + tmp.prev = curr_frame; + + curr_frame = cs.size (); + + cs.push_back (tmp); + + symbol_table::set_scope_and_context (tmp.scope, tmp.context); +} + +void +octave_call_stack::do_backtrace_error_message (void) const +{ + if (error_state > 0) + { + error_state = -1; + + error ("called from:"); + } + + if (! cs.empty ()) + { + const call_stack_elt& elt = cs.back (); + + octave_function *fcn = elt.fcn; + + std::string fcn_name = "?unknown?"; + + if (fcn) + { + fcn_name = fcn->fcn_file_name (); + + if (fcn_name.empty ()) + fcn_name = fcn->name (); + } + + error (" %s at line %d, column %d", + fcn_name.c_str (), elt.line, elt.column); + } +} + +void +recover_from_exception (void) +{ + can_interrupt = true; + octave_interrupt_immediately = 0; + octave_interrupt_state = 0; + octave_signal_caught = 0; + octave_exception_state = octave_no_exception; + octave_restore_signal_mask (); + octave_catch_interrupts (); +} + +int +main_loop (void) +{ + octave_save_signal_mask (); + + can_interrupt = true; + + octave_signal_hook = octave_signal_handler; + octave_interrupt_hook = 0; + octave_bad_alloc_hook = 0; + + octave_catch_interrupts (); + + octave_initialized = true; + + // The big loop. + + unwind_protect frame; + + // octave_parser constructor sets this for us. + frame.protect_var (LEXER); + + octave_lexer *lxr = ((interactive || forced_interactive) + ? new octave_lexer () + : new octave_lexer (stdin)); + + octave_parser parser (*lxr); + + int retval = 0; + do + { + try + { + unwind_protect inner_frame; + + reset_error_handler (); + + parser.reset (); + + if (symbol_table::at_top_level ()) + tree_evaluator::reset_debug_state (); + + retval = parser.run (); + + if (retval == 0) + { + if (parser.stmt_list) + { + parser.stmt_list->accept (*current_evaluator); + + octave_quit (); + + if (! (interactive || forced_interactive)) + { + bool quit = (tree_return_command::returning + || tree_break_command::breaking); + + if (tree_return_command::returning) + tree_return_command::returning = 0; + + if (tree_break_command::breaking) + tree_break_command::breaking--; + + if (quit) + break; + } + + if (error_state) + { + if (! (interactive || forced_interactive)) + { + // We should exit with a non-zero status. + retval = 1; + break; + } + } + else + { + if (octave_completion_matches_called) + octave_completion_matches_called = false; + else + command_editor::increment_current_command_number (); + } + } + else if (parser.lexer.end_of_input) + break; + } + } + catch (octave_interrupt_exception) + { + recover_from_exception (); + octave_stdout << "\n"; + if (quitting_gracefully) + return exit_status; + } + catch (octave_execution_exception) + { + recover_from_exception (); + std::cerr + << "error: unhandled execution exception -- trying to return to prompt" + << std::endl; + } + catch (std::bad_alloc) + { + recover_from_exception (); + std::cerr + << "error: out of memory -- trying to return to prompt" + << std::endl; + } + } + while (retval == 0); + + return retval; +} + +// Fix up things before exiting. + +static std::list octave_atexit_functions; + +static void +do_octave_atexit (void) +{ + static bool deja_vu = false; + + OCTAVE_SAFE_CALL (remove_input_event_hook_functions, ()); + + while (! octave_atexit_functions.empty ()) + { + std::string fcn = octave_atexit_functions.front (); + + octave_atexit_functions.pop_front (); + + OCTAVE_SAFE_CALL (reset_error_handler, ()); + + OCTAVE_SAFE_CALL (feval, (fcn, octave_value_list (), 0)); + + OCTAVE_SAFE_CALL (flush_octave_stdout, ()); + } + + if (! deja_vu) + { + deja_vu = true; + + // Process pending events and disasble octave_link event + // processing with this call. + + octave_link::process_events (true); + + // Do this explicitly so that destructors for mex file objects + // are called, so that functions registered with mexAtExit are + // called. + OCTAVE_SAFE_CALL (clear_mex_functions, ()); + + OCTAVE_SAFE_CALL (command_editor::restore_terminal_state, ()); + + // FIXME -- is this needed? Can it cause any trouble? + OCTAVE_SAFE_CALL (raw_mode, (0)); + + OCTAVE_SAFE_CALL (octave_history_write_timestamp, ()); + + if (! command_history::ignoring_entries ()) + OCTAVE_SAFE_CALL (command_history::clean_up_and_save, ()); + + OCTAVE_SAFE_CALL (gh_manager::close_all_figures, ()); + + OCTAVE_SAFE_CALL (gtk_manager::unload_all_toolkits, ()); + + OCTAVE_SAFE_CALL (close_files, ()); + + OCTAVE_SAFE_CALL (cleanup_tmp_files, ()); + + OCTAVE_SAFE_CALL (symbol_table::cleanup, ()); + + OCTAVE_SAFE_CALL (sysdep_cleanup, ()); + + OCTAVE_SAFE_CALL (flush_octave_stdout, ()); + + if (! quitting_gracefully && (interactive || forced_interactive)) + { + octave_stdout << "\n"; + + // Yes, we want this to be separate from the call to + // flush_octave_stdout above. + + OCTAVE_SAFE_CALL (flush_octave_stdout, ()); + } + + // Don't call singleton_cleanup_list::cleanup until we have the + // problems with registering/unregistering types worked out. For + // example, uncomment the following line, then use the make_int + // function from the examples directory to create an integer + // object and then exit Octave. Octave should crash with a + // segfault when cleaning up the typinfo singleton. We need some + // way to force new octave_value_X types that are created in + // .oct files to be unregistered when the .oct file shared library + // is unloaded. + // + // OCTAVE_SAFE_CALL (singleton_cleanup_list::cleanup, ()); + + OCTAVE_SAFE_CALL (octave_chunk_buffer::clear, ()); + } +} + +void +clean_up_and_exit (int retval, bool safe_to_return) +{ + do_octave_atexit (); + + if (octave_link::exit (retval)) + { + if (safe_to_return) + return; + else + { + // What should we do here? We might be called from some + // location other than the end of octave_execute_interpreter, + // so it might not be safe to return. + + // We have nothing else to do at this point, and the + // octave_link::exit function is supposed to take care of + // exiting for us. Assume that job won't take more than a + // day... + + gnulib::sleep (86400); + } + } + else + { + if (octave_exit) + (*octave_exit) (retval == EOF ? 0 : retval); + } +} + +DEFUN (quit, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} exit (@var{status})\n\ +@deftypefnx {Built-in Function} {} quit (@var{status})\n\ +Exit the current Octave session. If the optional integer value\n\ +@var{status} is supplied, pass that value to the operating system as the\n\ +Octave's exit status. The default value is zero.\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (! quit_allowed) + error ("quit: not supported in embedded mode"); + else + { + if (args.length () > 0) + { + int tmp = args(0).nint_value (); + + if (! error_state) + exit_status = tmp; + } + + if (! error_state) + { + // Instead of simply calling exit, we simulate an interrupt + // with a request to exit cleanly so that no matter where the + // call to quit occurs, we will run the unwind_protect stack, + // clear the OCTAVE_LOCAL_BUFFER allocations, etc. before + // exiting. + + quitting_gracefully = true; + + octave_interrupt_state = -1; + + octave_throw_interrupt_exception (); + } + } + + return retval; +} + +DEFALIAS (exit, quit); + +DEFUN (warranty, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} warranty ()\n\ +Describe the conditions for copying and distributing Octave.\n\ +@end deftypefn") +{ + octave_value_list retval; + + octave_stdout << "\n" \ + OCTAVE_NAME_VERSION_AND_COPYRIGHT "\n\ +\n\ +GNU Octave free software; you can redistribute it and/or modify\n\ +it under the terms of the GNU General Public License as published by\n\ +the Free Software Foundation; either version 3 of the License, or\n\ +(at your option) any later version.\n\ +\n\ +GNU Octave is distributed in the hope that it will be useful,\n\ +but WITHOUT ANY WARRANTY; without even the implied warranty of\n\ +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n\ +GNU General Public License for more details.\n\ +\n\ +You should have received a copy of the GNU General Public License\n\ +along with this program. If not, see .\n\ +\n"; + + return retval; +} + +// Execute a shell command. + +static int +wait_for_input (int fid) +{ + int retval = -1; + +#if defined (HAVE_SELECT) + if (fid >= 0) + { + fd_set set; + + FD_ZERO (&set); + FD_SET (fid, &set); + + retval = gnulib::select (FD_SETSIZE, &set, 0, 0, 0); + } +#else + retval = 1; +#endif + + return retval; +} + +static octave_value_list +run_command_and_return_output (const std::string& cmd_str) +{ + octave_value_list retval; + unwind_protect frame; + + iprocstream *cmd = new iprocstream (cmd_str.c_str ()); + + frame.add_delete (cmd); + frame.add_fcn (octave_child_list::remove, cmd->pid ()); + + if (*cmd) + { + int fid = cmd->file_number (); + + std::ostringstream output_buf; + + char ch; + + for (;;) + { + if (cmd->get (ch)) + output_buf.put (ch); + else + { + if (! cmd->eof () && errno == EAGAIN) + { + cmd->clear (); + + if (wait_for_input (fid) != 1) + break; + } + else + break; + } + } + + int cmd_status = cmd->close (); + + if (octave_wait::ifexited (cmd_status)) + cmd_status = octave_wait::exitstatus (cmd_status); + else + cmd_status = 127; + + retval(1) = output_buf.str (); + retval(0) = cmd_status; + } + else + error ("unable to start subprocess for '%s'", cmd_str.c_str ()); + + return retval; +} + +enum system_exec_type { et_sync, et_async }; + +DEFUN (system, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} system (\"@var{string}\")\n\ +@deftypefnx {Built-in Function} {} system (\"@var{string}\", @var{return_output})\n\ +@deftypefnx {Built-in Function} {} system (\"@var{string}\", @var{return_output}, @var{type})\n\ +@deftypefnx {Built-in Function} {[@var{status}, @var{output}] =} system (@dots{})\n\ +Execute a shell command specified by @var{string}.\n\ +If the optional argument @var{type} is \"async\", the process\n\ +is started in the background and the process ID of the child process\n\ +is returned immediately. Otherwise, the child process is started and\n\ +Octave waits until it exits. If the @var{type} argument is omitted, it\n\ +defaults to the value \"sync\".\n\ +\n\ +If @var{system} is called with one or more output arguments, or if the\n\ +optional argument @var{return_output} is true and the subprocess is started\n\ +synchronously, then the output from the command is returned as a variable. \n\ +Otherwise, if the subprocess is executed synchronously, its output is sent\n\ +to the standard output. To send the output of a command executed with\n\ +@code{system} through the pager, use a command like\n\ +\n\ +@example\n\ +@group\n\ +[output, text] = system (\"cmd\");\n\ +disp (text);\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +or\n\ +\n\ +@example\n\ +printf (\"%s\\n\", nthargout (2, \"system\", \"cmd\"));\n\ +@end example\n\ +\n\ +The @code{system} function can return two values. The first is the\n\ +exit status of the command and the second is any output from the\n\ +command that was written to the standard output stream. For example,\n\ +\n\ +@example\n\ +[status, output] = system (\"echo foo; exit 2\");\n\ +@end example\n\ +\n\ +@noindent\n\ +will set the variable @code{output} to the string @samp{foo}, and the\n\ +variable @code{status} to the integer @samp{2}.\n\ +\n\ +For commands run asynchronously, @var{status} is the process id of the\n\ +command shell that is started to run the command.\n\ +@seealso{unix, dos}\n\ +@end deftypefn") +{ + octave_value_list retval; + + unwind_protect frame; + + int nargin = args.length (); + + if (nargin > 0 && nargin < 4) + { + bool return_output = (nargin == 1 && nargout > 1); + + system_exec_type type = et_sync; + + if (nargin == 3) + { + std::string type_str = args(2).string_value (); + + if (! error_state) + { + if (type_str == "sync") + type = et_sync; + else if (type_str == "async") + type = et_async; + else + { + error ("system: TYPE must be \"sync\" or \"async\""); + return retval; + } + } + else + { + error ("system: TYPE must be a character string"); + return retval; + } + } + + if (nargin > 1) + { + return_output = args(1).is_true (); + + if (error_state) + { + error ("system: RETURN_OUTPUT must be boolean value true or false"); + return retval; + } + } + + if (return_output && type == et_async) + { + error ("system: can't return output from commands run asynchronously"); + return retval; + } + + std::string cmd_str = args(0).string_value (); + + if (! error_state) + { +#if defined (__WIN32__) && ! defined (__CYGWIN__) + // Work around weird double-quote handling on Windows systems. + if (type == et_sync) + cmd_str = "\"" + cmd_str + "\""; +#endif + + if (type == et_async) + { + // FIXME -- maybe this should go in sysdep.cc? +#ifdef HAVE_FORK + pid_t pid = fork (); + + if (pid < 0) + error ("system: fork failed -- can't create child process"); + else if (pid == 0) + { + // FIXME -- should probably replace this + // call with something portable. + + execl (SHELL_PATH, "sh", "-c", cmd_str.c_str (), + static_cast (0)); + + panic_impossible (); + } + else + retval(0) = pid; +#elif defined (__WIN32__) + STARTUPINFO si; + PROCESS_INFORMATION pi; + ZeroMemory (&si, sizeof (si)); + ZeroMemory (&pi, sizeof (pi)); + OCTAVE_LOCAL_BUFFER (char, xcmd_str, cmd_str.length ()+1); + strcpy (xcmd_str, cmd_str.c_str ()); + + if (! CreateProcess (0, xcmd_str, 0, 0, FALSE, 0, 0, 0, &si, &pi)) + error ("system: CreateProcess failed -- can't create child process"); + else + { + retval(0) = pi.dwProcessId; + CloseHandle (pi.hProcess); + CloseHandle (pi.hThread); + } +#else + error ("asynchronous system calls are not supported"); +#endif + } + else if (return_output) + retval = run_command_and_return_output (cmd_str); + else + { + int status = system (cmd_str.c_str ()); + + // The value in status is as returned by waitpid. If + // the process exited normally, extract the actual exit + // status of the command. Otherwise, return 127 as a + // failure code. + + if (octave_wait::ifexited (status)) + status = octave_wait::exitstatus (status); + + retval(0) = status; + } + } + else + error ("system: expecting string as first argument"); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! cmd = ls_command (); +%! [status, output] = system (cmd); +%! assert (status, 0); +%! assert (ischar (output)); +%! assert (! isempty (output)); + +%!error system () +%!error system (1, 2, 3) +*/ + +void +octave_add_atexit_function (const std::string& fname) +{ + octave_atexit_functions.push_front (fname); +} + +bool +octave_remove_atexit_function (const std::string& fname) +{ + bool found = false; + + for (std::list::iterator p = octave_atexit_functions.begin (); + p != octave_atexit_functions.end (); p++) + { + if (*p == fname) + { + octave_atexit_functions.erase (p); + found = true; + break; + } + } + + return found; +} + + +DEFUN (atexit, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} atexit (@var{fcn})\n\ +@deftypefnx {Built-in Function} {} atexit (@var{fcn}, @var{flag})\n\ +Register a function to be called when Octave exits. For example,\n\ +\n\ +@example\n\ +@group\n\ +function last_words ()\n\ + disp (\"Bye bye\");\n\ +endfunction\n\ +atexit (\"last_words\");\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +will print the message \"Bye bye\" when Octave exits.\n\ +\n\ +The additional argument @var{flag} will register or unregister\n\ +@var{fcn} from the list of functions to be called when Octave\n\ +exits. If @var{flag} is true, the function is registered, and if\n\ +@var{flag} is false, it is unregistered. For example,\n\ +after registering the function @code{last_words} above,\n\ +\n\ +@example\n\ +atexit (\"last_words\", false);\n\ +@end example\n\ +\n\ +@noindent\n\ +will remove the function from the list and Octave will not call\n\ +@code{last_words} when it exits.\n\ +\n\ +Note that @code{atexit} only removes the first occurrence of a function\n\ +from the list, so if a function was placed in the list multiple\n\ +times with @code{atexit}, it must also be removed from the list\n\ +multiple times.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + std::string arg = args(0).string_value (); + + if (! error_state) + { + bool add_mode = true; + + if (nargin == 2) + { + add_mode = args(1).bool_value (); + + if (error_state) + error ("atexit: FLAG argument must be a logical value"); + } + + if (! error_state) + { + if (add_mode) + octave_add_atexit_function (arg); + else + { + bool found = octave_remove_atexit_function (arg); + + if (nargout > 0) + retval(0) = found; + } + } + } + else + error ("atexit: FCN argument must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFUN (octave_config_info, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} octave_config_info ()\n\ +@deftypefnx {Built-in Function} {} octave_config_info (@var{option})\n\ +Return a structure containing configuration and installation\n\ +information for Octave.\n\ +\n\ +If @var{option} is a string, return the configuration information for the\n\ +specified option.\n\ +\n\ +@end deftypefn") +{ + octave_value retval; + +#if defined (ENABLE_DYNAMIC_LINKING) + bool octave_supports_dynamic_linking = true; +#else + bool octave_supports_dynamic_linking = false; +#endif + + static bool initialized = false; + static octave_scalar_map m; + + struct conf_info_struct + { + bool subst_home; + const char *key; + const char *val; + }; + + static const conf_info_struct conf_info[] = + { + { false, "ALL_CFLAGS", OCTAVE_CONF_ALL_CFLAGS }, + { false, "ALL_CXXFLAGS", OCTAVE_CONF_ALL_CXXFLAGS }, + { false, "ALL_FFLAGS", OCTAVE_CONF_ALL_FFLAGS }, + { false, "ALL_LDFLAGS", OCTAVE_CONF_ALL_LDFLAGS }, + { false, "AMD_CPPFLAGS", OCTAVE_CONF_AMD_CPPFLAGS }, + { false, "AMD_LDFLAGS", OCTAVE_CONF_AMD_LDFLAGS }, + { false, "AMD_LIBS", OCTAVE_CONF_AMD_LIBS }, + { false, "AR", OCTAVE_CONF_AR }, + { false, "ARFLAGS", OCTAVE_CONF_ARFLAGS }, + { false, "ARPACK_CPPFLAGS", OCTAVE_CONF_ARPACK_CPPFLAGS }, + { false, "ARPACK_LDFLAGS", OCTAVE_CONF_ARPACK_LDFLAGS }, + { false, "ARPACK_LIBS", OCTAVE_CONF_ARPACK_LIBS }, + { false, "BLAS_LIBS", OCTAVE_CONF_BLAS_LIBS }, + { false, "CAMD_CPPFLAGS", OCTAVE_CONF_CAMD_CPPFLAGS }, + { false, "CAMD_LDFLAGS", OCTAVE_CONF_CAMD_LDFLAGS }, + { false, "CAMD_LIBS", OCTAVE_CONF_CAMD_LIBS }, + { false, "CARBON_LIBS", OCTAVE_CONF_CARBON_LIBS }, + { false, "CC", OCTAVE_CONF_CC }, + // FIXME: CC_VERSION is deprecated. Remove in version 3.12 + { false, "CC_VERSION", OCTAVE_CONF_CC_VERSION }, + { false, "CCOLAMD_CPPFLAGS", OCTAVE_CONF_CCOLAMD_CPPFLAGS }, + { false, "CCOLAMD_LDFLAGS", OCTAVE_CONF_CCOLAMD_LDFLAGS }, + { false, "CCOLAMD_LIBS", OCTAVE_CONF_CCOLAMD_LIBS }, + { false, "CFLAGS", OCTAVE_CONF_CFLAGS }, + { false, "CHOLMOD_CPPFLAGS", OCTAVE_CONF_CHOLMOD_CPPFLAGS }, + { false, "CHOLMOD_LDFLAGS", OCTAVE_CONF_CHOLMOD_LDFLAGS }, + { false, "CHOLMOD_LIBS", OCTAVE_CONF_CHOLMOD_LIBS }, + { false, "COLAMD_CPPFLAGS", OCTAVE_CONF_COLAMD_CPPFLAGS }, + { false, "COLAMD_LDFLAGS", OCTAVE_CONF_COLAMD_LDFLAGS }, + { false, "COLAMD_LIBS", OCTAVE_CONF_COLAMD_LIBS }, + { false, "CPICFLAG", OCTAVE_CONF_CPICFLAG }, + { false, "CPPFLAGS", OCTAVE_CONF_CPPFLAGS }, + { false, "CURL_CPPFLAGS", OCTAVE_CONF_CURL_CPPFLAGS }, + { false, "CURL_LDFLAGS", OCTAVE_CONF_CURL_LDFLAGS }, + { false, "CURL_LIBS", OCTAVE_CONF_CURL_LIBS }, + { false, "CXSPARSE_CPPFLAGS", OCTAVE_CONF_CXSPARSE_CPPFLAGS }, + { false, "CXSPARSE_LDFLAGS", OCTAVE_CONF_CXSPARSE_LDFLAGS }, + { false, "CXSPARSE_LIBS", OCTAVE_CONF_CXSPARSE_LIBS }, + { false, "CXX", OCTAVE_CONF_CXX }, + { false, "CXXCPP", OCTAVE_CONF_CXXCPP }, + { false, "CXXFLAGS", OCTAVE_CONF_CXXFLAGS }, + { false, "CXXPICFLAG", OCTAVE_CONF_CXXPICFLAG }, + // FIXME: CXX_VERSION is deprecated. Remove in version 3.12 + { false, "CXX_VERSION", OCTAVE_CONF_CXX_VERSION }, + { false, "DEFAULT_PAGER", OCTAVE_DEFAULT_PAGER }, + { false, "DEFS", OCTAVE_CONF_DEFS }, + { false, "DL_LD", OCTAVE_CONF_DL_LD }, + { false, "DL_LDFLAGS", OCTAVE_CONF_DL_LDFLAGS }, + { false, "DL_LIBS", OCTAVE_CONF_DL_LIBS }, + { false, "GCC_VERSION", OCTAVE_CONF_GCC_VERSION }, + { false, "GXX_VERSION", OCTAVE_CONF_GXX_VERSION }, + { false, "ENABLE_DYNAMIC_LINKING", OCTAVE_CONF_ENABLE_DYNAMIC_LINKING }, + { false, "EXEEXT", OCTAVE_CONF_EXEEXT }, + { false, "F77", OCTAVE_CONF_F77 }, + { false, "F77_FLOAT_STORE_FLAG", OCTAVE_CONF_F77_FLOAT_STORE_FLAG }, + { false, "F77_INTEGER_8_FLAG", OCTAVE_CONF_F77_INTEGER_8_FLAG }, + { false, "FC", OCTAVE_CONF_FC }, + { false, "FFLAGS", OCTAVE_CONF_FFLAGS }, + { false, "FFTW3_CPPFLAGS", OCTAVE_CONF_FFTW3_CPPFLAGS }, + { false, "FFTW3_LDFLAGS", OCTAVE_CONF_FFTW3_LDFLAGS }, + { false, "FFTW3_LIBS", OCTAVE_CONF_FFTW3_LIBS }, + { false, "FFTW3F_CPPFLAGS", OCTAVE_CONF_FFTW3F_CPPFLAGS }, + { false, "FFTW3F_LDFLAGS", OCTAVE_CONF_FFTW3F_LDFLAGS }, + { false, "FFTW3F_LIBS", OCTAVE_CONF_FFTW3F_LIBS }, + { false, "FLIBS", OCTAVE_CONF_FLIBS }, + { false, "FPICFLAG", OCTAVE_CONF_FPICFLAG }, + { false, "FT2_CFLAGS", OCTAVE_CONF_FT2_CFLAGS }, + { false, "FT2_LIBS", OCTAVE_CONF_FT2_LIBS }, + { false, "GLPK_CPPFLAGS", OCTAVE_CONF_GLPK_CPPFLAGS }, + { false, "GLPK_LDFLAGS", OCTAVE_CONF_GLPK_LDFLAGS }, + { false, "GLPK_LIBS", OCTAVE_CONF_GLPK_LIBS }, + { false, "GNUPLOT", OCTAVE_CONF_GNUPLOT }, + { false, "GRAPHICS_CFLAGS", OCTAVE_CONF_GRAPHICS_CFLAGS }, + { false, "GRAPHICS_LIBS", OCTAVE_CONF_GRAPHICS_LIBS }, + { false, "HDF5_CPPFLAGS", OCTAVE_CONF_HDF5_CPPFLAGS }, + { false, "HDF5_LDFLAGS", OCTAVE_CONF_HDF5_LDFLAGS }, + { false, "HDF5_LIBS", OCTAVE_CONF_HDF5_LIBS }, + { false, "LAPACK_LIBS", OCTAVE_CONF_LAPACK_LIBS }, + { false, "LDFLAGS", OCTAVE_CONF_LDFLAGS }, + { false, "LD_CXX", OCTAVE_CONF_LD_CXX }, + { false, "LD_STATIC_FLAG", OCTAVE_CONF_LD_STATIC_FLAG }, + { false, "LEX", OCTAVE_CONF_LEX }, + { false, "LEXLIB", OCTAVE_CONF_LEXLIB }, + { false, "LFLAGS", OCTAVE_CONF_LFLAGS }, + { false, "LIBEXT", OCTAVE_CONF_LIBEXT }, + { false, "LIBFLAGS", OCTAVE_CONF_LIBFLAGS }, + { false, "LIBOCTAVE", OCTAVE_CONF_LIBOCTAVE }, + { false, "LIBOCTINTERP", OCTAVE_CONF_LIBOCTINTERP }, + { false, "LIBS", OCTAVE_CONF_LIBS }, + { false, "LLVM_CPPFLAGS", OCTAVE_CONF_LLVM_CPPFLAGS }, + { false, "LLVM_LDFLAGS", OCTAVE_CONF_LLVM_LDFLAGS }, + { false, "LLVM_LIBS", OCTAVE_CONF_LLVM_LIBS }, + { false, "LN_S", OCTAVE_CONF_LN_S }, + { false, "MAGICK_CPPFLAGS", OCTAVE_CONF_MAGICK_CPPFLAGS }, + { false, "MAGICK_LDFLAGS", OCTAVE_CONF_MAGICK_LDFLAGS }, + { false, "MAGICK_LIBS", OCTAVE_CONF_MAGICK_LIBS }, + { false, "MKOCTFILE_DL_LDFLAGS", OCTAVE_CONF_MKOCTFILE_DL_LDFLAGS }, + { false, "OCTAVE_LINK_DEPS", OCTAVE_CONF_OCTAVE_LINK_DEPS }, + { false, "OCTAVE_LINK_OPTS", OCTAVE_CONF_OCTAVE_LINK_OPTS }, + { false, "OCT_LINK_DEPS", OCTAVE_CONF_OCT_LINK_DEPS }, + { false, "OCT_LINK_OPTS", OCTAVE_CONF_OCT_LINK_OPTS }, + { false, "OPENGL_LIBS", OCTAVE_CONF_OPENGL_LIBS }, + { false, "PTHREAD_CFLAGS", OCTAVE_CONF_PTHREAD_CFLAGS }, + { false, "PTHREAD_LIBS", OCTAVE_CONF_PTHREAD_LIBS }, + { false, "QHULL_CPPFLAGS", OCTAVE_CONF_QHULL_CPPFLAGS }, + { false, "QHULL_LDFLAGS", OCTAVE_CONF_QHULL_LDFLAGS }, + { false, "QHULL_LIBS", OCTAVE_CONF_QHULL_LIBS }, + { false, "QRUPDATE_CPPFLAGS", OCTAVE_CONF_QRUPDATE_CPPFLAGS }, + { false, "QRUPDATE_LDFLAGS", OCTAVE_CONF_QRUPDATE_LDFLAGS }, + { false, "QRUPDATE_LIBS", OCTAVE_CONF_QRUPDATE_LIBS }, + { false, "QT_CPPFLAGS", OCTAVE_CONF_QT_CPPFLAGS }, + { false, "QT_LDFLAGS", OCTAVE_CONF_QT_LDFLAGS }, + { false, "QT_LIBS", OCTAVE_CONF_QT_LIBS }, + { false, "RANLIB", OCTAVE_CONF_RANLIB }, + { false, "RDYNAMIC_FLAG", OCTAVE_CONF_RDYNAMIC_FLAG }, + { false, "READLINE_LIBS", OCTAVE_CONF_READLINE_LIBS }, + { false, "REGEX_LIBS", OCTAVE_CONF_REGEX_LIBS }, + { false, "SED", OCTAVE_CONF_SED }, + { false, "SHARED_LIBS", OCTAVE_CONF_SHARED_LIBS }, + { false, "SHLEXT", OCTAVE_CONF_SHLEXT }, + { false, "SHLEXT_VER", OCTAVE_CONF_SHLEXT_VER }, + { false, "SH_LD", OCTAVE_CONF_SH_LD }, + { false, "SH_LDFLAGS", OCTAVE_CONF_SH_LDFLAGS }, + { false, "SONAME_FLAGS", OCTAVE_CONF_SONAME_FLAGS }, + { false, "STATIC_LIBS", OCTAVE_CONF_STATIC_LIBS }, + { false, "TERM_LIBS", OCTAVE_CONF_TERM_LIBS }, + { false, "UMFPACK_CPPFLAGS", OCTAVE_CONF_UMFPACK_CPPFLAGS }, + { false, "UMFPACK_LDFLAGS", OCTAVE_CONF_UMFPACK_LDFLAGS }, + { false, "UMFPACK_LIBS", OCTAVE_CONF_UMFPACK_LIBS }, + { false, "USE_64_BIT_IDX_T", OCTAVE_CONF_USE_64_BIT_IDX_T }, + { false, "WARN_CFLAGS", OCTAVE_CONF_WARN_CFLAGS }, + { false, "WARN_CXXFLAGS", OCTAVE_CONF_WARN_CXXFLAGS }, + { false, "X11_INCFLAGS", OCTAVE_CONF_X11_INCFLAGS }, + { false, "X11_LIBS", OCTAVE_CONF_X11_LIBS }, + { false, "XTRA_CFLAGS", OCTAVE_CONF_XTRA_CFLAGS }, + { false, "XTRA_CXXFLAGS", OCTAVE_CONF_XTRA_CXXFLAGS }, + { false, "YACC", OCTAVE_CONF_YACC }, + { false, "YFLAGS", OCTAVE_CONF_YFLAGS }, + { false, "Z_CPPFLAGS", OCTAVE_CONF_Z_CPPFLAGS }, + { false, "Z_LDFLAGS", OCTAVE_CONF_Z_LDFLAGS }, + { false, "Z_LIBS", OCTAVE_CONF_Z_LIBS }, + { false, "api_version", OCTAVE_API_VERSION }, + { true, "archlibdir", OCTAVE_ARCHLIBDIR }, + { true, "bindir", OCTAVE_BINDIR }, + { false, "canonical_host_type", OCTAVE_CANONICAL_HOST_TYPE }, + { false, "config_opts", OCTAVE_CONF_config_opts }, + { true, "datadir", OCTAVE_DATADIR }, + { true, "datarootdir", OCTAVE_DATAROOTDIR }, + { true, "exec_prefix", OCTAVE_EXEC_PREFIX }, + { true, "fcnfiledir", OCTAVE_FCNFILEDIR }, + { true, "imagedir", OCTAVE_IMAGEDIR }, + { true, "includedir", OCTAVE_INCLUDEDIR }, + { true, "infodir", OCTAVE_INFODIR }, + { true, "infofile", OCTAVE_INFOFILE }, + { true, "libdir", OCTAVE_LIBDIR }, + { true, "libexecdir", OCTAVE_LIBEXECDIR }, + { true, "localapiarchlibdir", OCTAVE_LOCALAPIARCHLIBDIR }, + { true, "localapifcnfiledir", OCTAVE_LOCALAPIFCNFILEDIR }, + { true, "localapioctfiledir", OCTAVE_LOCALAPIOCTFILEDIR }, + { true, "localarchlibdir", OCTAVE_LOCALARCHLIBDIR }, + { true, "localfcnfiledir", OCTAVE_LOCALFCNFILEDIR }, + { true, "localoctfiledir", OCTAVE_LOCALOCTFILEDIR }, + { true, "localstartupfiledir", OCTAVE_LOCALSTARTUPFILEDIR }, + { true, "localverarchlibdir", OCTAVE_LOCALVERARCHLIBDIR }, + { true, "localverfcnfiledir", OCTAVE_LOCALVERFCNFILEDIR }, + { true, "localveroctfiledir", OCTAVE_LOCALVEROCTFILEDIR }, + { true, "man1dir", OCTAVE_MAN1DIR }, + { false, "man1ext", OCTAVE_MAN1EXT }, + { true, "mandir", OCTAVE_MANDIR }, + { true, "octfiledir", OCTAVE_OCTFILEDIR }, + { true, "octetcdir", OCTAVE_OCTETCDIR }, + { true, "octincludedir", OCTAVE_OCTINCLUDEDIR }, + { true, "octlibdir", OCTAVE_OCTLIBDIR }, + { true, "octtestsdir", OCTAVE_OCTTESTSDIR }, + { true, "prefix", OCTAVE_PREFIX }, + { true, "startupfiledir", OCTAVE_STARTUPFILEDIR }, + { false, "version", OCTAVE_VERSION }, + { false, 0, 0 } + }; + + if (! initialized) + { + m.assign ("dld", octave_value (octave_supports_dynamic_linking)); + + oct_mach_info::float_format ff = oct_mach_info::native_float_format (); + m.assign ("float_format", + octave_value (oct_mach_info::float_format_as_string (ff))); + + m.assign ("words_big_endian", + octave_value (oct_mach_info::words_big_endian ())); + + m.assign ("words_little_endian", + octave_value (oct_mach_info::words_little_endian ())); + + m.assign ("features", octave_value (octave_config_features ())); + + int i = 0; + + while (true) + { + const conf_info_struct& elt = conf_info[i++]; + + const char *key = elt.key; + + if (key) + { + if (elt.subst_home) + m.assign (key, subst_octave_home (elt.val)); + else + m.assign (key, elt.val); + } + else + break; + } + + bool unix_system = true; + bool mac_system = false; + bool windows_system = false; + +#if defined (WIN32) + windows_system = true; +#if !defined (__CYGWIN__) + unix_system = false; +#endif +#endif + +#if defined (OCTAVE_USE_OS_X_API) + mac_system = true; +#endif + + m.assign ("unix", octave_value (unix_system)); + m.assign ("mac", octave_value (mac_system)); + m.assign ("windows", octave_value (windows_system)); + + initialized = true; + } + + int nargin = args.length (); + + if (nargin == 1) + { + std::string arg = args(0).string_value (); + + if (! error_state) + { + if (m.isfield (arg)) + { + Cell c = m.contents (arg); + + if (c.is_empty ()) + error ("octave_config_info: no info for '%s'", arg.c_str ()); + else + retval = c(0); + } + else + error ("octave_config_info: invalid parameter '%s'", arg.c_str ()); + } + } + else if (nargin == 0) + retval = m; + else + print_usage (); + + return retval; +} + +/* +%!assert (ischar (octave_config_info ("version"))) +%!test +%! x = octave_config_info (); +%! assert (isstruct (x)); +%! assert (! isempty (x)); + +%!error octave_config_info (1, 2) +*/ + +#if defined (__GNUG__) && defined (DEBUG_NEW_DELETE) + +int debug_new_delete = 0; + +typedef void (*vfp)(void); +extern vfp __new_handler; + +void * +__builtin_new (size_t sz) +{ + void *p; + + /* malloc (0) is unpredictable; avoid it. */ + if (sz == 0) + sz = 1; + p = gnulib::malloc (sz); + while (p == 0) + { + (*__new_handler) (); + p = gnulib::malloc (sz); + } + + if (debug_new_delete) + std::cerr << "__builtin_new: " << p << std::endl; + + return p; +} + +void +__builtin_delete (void *ptr) +{ + if (debug_new_delete) + std::cerr << "__builtin_delete: " << ptr << std::endl; + + if (ptr) + free (ptr); +} + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/toplev.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/toplev.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,467 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_toplev_h) +#define octave_toplev_h 1 + +#include + +#include +#include + +class octave_value; +class octave_value_list; +class octave_function; +class octave_user_script; +class tree_statement; +class tree_statement_list; +class charMatrix; + +#include "quit.h" + +#include "input.h" +#include "oct-map.h" + + +typedef void (*octave_exit_func) (int); +extern OCTINTERP_API octave_exit_func octave_exit; + +extern OCTINTERP_API bool quit_allowed; + +extern OCTINTERP_API bool quitting_gracefully; + +extern OCTINTERP_API int exit_status; + +extern OCTINTERP_API void +clean_up_and_exit (int status, bool safe_to_return = false); + +extern OCTINTERP_API void recover_from_exception (void); + +extern OCTINTERP_API int main_loop (void); + +extern OCTINTERP_API void +octave_add_atexit_function (const std::string& fname); + +extern OCTINTERP_API bool +octave_remove_atexit_function (const std::string& fname); + +// TRUE means we are ready to interpret commands, but not everything +// is ready for interactive use. +extern OCTINTERP_API bool octave_interpreter_ready; + +// TRUE means we've processed all the init code and we are good to go. +extern OCTINTERP_API bool octave_initialized; + +class +OCTINTERP_API +octave_call_stack +{ +private: + + struct call_stack_elt + { + call_stack_elt (octave_function *f, symbol_table::scope_id s, + symbol_table::context_id c, size_t p = 0) + : fcn (f), line (-1), column (-1), scope (s), context (c), prev (p) + { } + + call_stack_elt (const call_stack_elt& elt) + : fcn (elt.fcn), line (elt.line), column (elt.column), + scope (elt.scope), context (elt.context), prev (elt.prev) + { } + + octave_function *fcn; + int line; + int column; + symbol_table::scope_id scope; + symbol_table::context_id context; + size_t prev; + }; + +protected: + + octave_call_stack (void) : cs (), curr_frame (0) { } + +public: + + typedef std::deque::iterator iterator; + typedef std::deque::const_iterator const_iterator; + + typedef std::deque::reverse_iterator reverse_iterator; + typedef std::deque::const_reverse_iterator const_reverse_iterator; + + static void create_instance (void); + + static bool instance_ok (void) + { + bool retval = true; + + if (! instance) + create_instance (); + + if (! instance) + { + ::error ("unable to create call stack object!"); + + retval = false; + } + + return retval; + } + + // Current function (top of stack). + static octave_function *current (void) + { + return instance_ok () ? instance->do_current () : 0; + } + + // Current line in current function. + static int current_line (void) + { + return instance_ok () ? instance->do_current_line () : -1; + } + + // Current column in current function. + static int current_column (void) + { + return instance_ok () ? instance->do_current_column () : -1; + } + + // Line in user code caller. + static int caller_user_code_line (void) + { + return instance_ok () ? instance->do_caller_user_code_line () : -1; + } + + // Column in user code caller. + static int caller_user_code_column (void) + { + return instance_ok () ? instance->do_caller_user_code_column () : -1; + } + + // Caller function, may be built-in. + static octave_function *caller (void) + { + return instance_ok () ? instance->do_caller () : 0; + } + + static size_t current_frame (void) + { + return instance_ok () ? instance->do_current_frame () : 0; + } + + static size_t size (void) + { + return instance_ok () ? instance->do_size () : 0; + } + + static size_t num_user_code_frames (octave_idx_type& curr_user_frame) + { + return instance_ok () + ? instance->do_num_user_code_frames (curr_user_frame) : 0; + } + + static symbol_table::scope_id current_scope (void) + { + return instance_ok () ? instance->do_current_scope () : 0; + } + + static symbol_table::context_id current_context (void) + { + return instance_ok () ? instance->do_current_context () : 0; + } + + // Function at location N on the call stack (N == 0 is current), may + // be built-in. + static octave_function *element (size_t n) + { + return instance_ok () ? instance->do_element (n) : 0; + } + + // First user-defined function on the stack. + static octave_user_code *caller_user_code (size_t nskip = 0) + { + return instance_ok () ? instance->do_caller_user_code (nskip) : 0; + } + + static void + push (octave_function *f, + symbol_table::scope_id scope = symbol_table::current_scope (), + symbol_table::context_id context = symbol_table::current_context ()) + { + if (instance_ok ()) + instance->do_push (f, scope, context); + } + + static void + push (symbol_table::scope_id scope = symbol_table::current_scope (), + symbol_table::context_id context = symbol_table::current_context ()) + { + if (instance_ok ()) + instance->do_push (0, scope, context); + } + + static void set_location (int l, int c) + { + if (instance_ok ()) + instance->do_set_location (l, c); + } + + static void set_line (int l) + { + if (instance_ok ()) + instance->do_set_line (l); + } + + static void set_column (int c) + { + if (instance_ok ()) + instance->do_set_column (c); + } + + static bool goto_frame (size_t n = 0, bool verbose = false) + { + return instance_ok () ? instance->do_goto_frame (n, verbose) : false; + } + + static void restore_frame (size_t n) + { + goto_frame (n); + } + + static bool goto_frame_relative (int n, bool verbose = false) + { + return instance_ok () + ? instance->do_goto_frame_relative (n, verbose) : false; + } + + static void goto_caller_frame (void) + { + if (instance_ok ()) + instance->do_goto_caller_frame (); + } + + static void goto_base_frame (void) + { + if (instance_ok ()) + instance->do_goto_base_frame (); + } + + static octave_map backtrace (size_t nskip, octave_idx_type& curr_user_frame) + { + return instance_ok () + ? instance->do_backtrace (nskip, curr_user_frame) : octave_map (); + } + + static octave_map empty_backtrace (void); + + static void pop (void) + { + if (instance_ok ()) + instance->do_pop (); + } + + static void clear (void) + { + if (instance_ok ()) + instance->do_clear (); + } + + static void backtrace_error_message (void) + { + if (instance_ok ()) + instance->do_backtrace_error_message (); + } + +private: + + // The current call stack. + std::deque cs; + + size_t curr_frame; + + static octave_call_stack *instance; + + static void cleanup_instance (void) { delete instance; instance = 0; } + + int do_current_line (void) const; + + int do_current_column (void) const; + + int do_caller_user_code_line (void) const; + + int do_caller_user_code_column (void) const; + + octave_function *do_caller (void) const + { + return curr_frame > 1 ? cs[curr_frame-1].fcn : cs[0].fcn; + } + + size_t do_current_frame (void) { return curr_frame; } + + size_t do_size (void) { return cs.size (); } + + size_t do_num_user_code_frames (octave_idx_type& curr_user_frame) const; + + symbol_table::scope_id do_current_scope (void) const + { + return curr_frame > 0 && curr_frame < cs.size () + ? cs[curr_frame].scope : 0; + } + + symbol_table::context_id do_current_context (void) const + { + return curr_frame > 0 && curr_frame < cs.size () + ? cs[curr_frame].context : 0; + } + + octave_function *do_element (size_t n) + { + octave_function *retval = 0; + + if (cs.size () > n) + { + call_stack_elt& elt = cs[n]; + retval = elt.fcn; + } + + return retval; + } + + octave_user_code *do_caller_user_code (size_t nskip) const; + + void do_push (octave_function *f, symbol_table::scope_id scope, + symbol_table::context_id context) + { + size_t prev_frame = curr_frame; + curr_frame = cs.size (); + cs.push_back (call_stack_elt (f, scope, context, prev_frame)); + symbol_table::set_scope_and_context (scope, context); + } + + octave_function *do_current (void) const + { + octave_function *retval = 0; + + if (! cs.empty ()) + { + const call_stack_elt& elt = cs[curr_frame]; + retval = elt.fcn; + } + + return retval; + } + + void do_set_location (int l, int c) + { + if (! cs.empty ()) + { + call_stack_elt& elt = cs.back (); + + elt.line = l; + elt.column = c; + } + } + + void do_set_line (int l) + { + if (! cs.empty ()) + { + call_stack_elt& elt = cs.back (); + + elt.line = l; + } + } + + void do_set_column (int c) + { + if (! cs.empty ()) + { + call_stack_elt& elt = cs.back (); + + elt.column = c; + } + } + + octave_map do_backtrace (size_t nskip, + octave_idx_type& curr_user_frame) const; + + bool do_goto_frame (size_t n, bool verbose); + + bool do_goto_frame_relative (int n, bool verbose); + + void do_goto_caller_frame (void); + + void do_goto_base_frame (void); + + void do_pop (void) + { + if (cs.size () > 1) + { + const call_stack_elt& elt = cs.back (); + curr_frame = elt.prev; + cs.pop_back (); + const call_stack_elt& new_elt = cs[curr_frame]; + symbol_table::set_scope_and_context (new_elt.scope, new_elt.context); + } + } + + void do_clear (void) { cs.clear (); } + + void do_backtrace_error_message (void) const; +}; + +// Call a function with exceptions handled to avoid problems with +// errors while shutting down. + +#define OCTAVE_IGNORE_EXCEPTION(E) \ + catch (E) \ + { \ + std::cerr << "error: ignoring " #E " while preparing to exit" << std::endl; \ + recover_from_exception (); \ + } + +#define OCTAVE_SAFE_CALL(F, ARGS) \ + do \ + { \ + try \ + { \ + unwind_protect frame; \ + \ + frame.protect_var (Vdebug_on_error); \ + frame.protect_var (Vdebug_on_warning); \ + \ + Vdebug_on_error = false; \ + Vdebug_on_warning = false; \ + \ + F ARGS; \ + } \ + OCTAVE_IGNORE_EXCEPTION (octave_interrupt_exception) \ + OCTAVE_IGNORE_EXCEPTION (octave_execution_exception) \ + OCTAVE_IGNORE_EXCEPTION (std::bad_alloc) \ + \ + if (error_state) \ + error_state = 0; \ + } \ + while (0) + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/txt-eng-ft.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/txt-eng-ft.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,675 @@ +/* + +Copyright (C) 2009-2012 Michael Goffioul + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#if defined (HAVE_FREETYPE) + +#if defined (HAVE_FONTCONFIG) +#include +#endif + +#include + +#include "singleton-cleanup.h" + +#include "error.h" +#include "pr-output.h" +#include "txt-eng-ft.h" + +// FIXME -- maybe issue at most one warning per glyph/font/size/weight +// combination. + +static void +gripe_missing_glyph (char c) +{ + warning_with_id ("Octave:missing-glyph", + "ft_render: skipping missing glyph for character '%c'", + c); +} + +static void +gripe_glyph_render (char c) +{ + warning_with_id ("Octave:glyph-render", + "ft_render: unable to render glyph for character '%c'", + c); +} + +#ifdef _MSC_VER +// This is just a trick to avoid multiply symbols definition. +// PermMatrix.h contains a dllexport'ed Array +// that will make MSVC not to generate new instantiation and +// use the imported one. +#include "PermMatrix.h" +#endif + +class +ft_manager +{ +public: + static bool instance_ok (void) + { + bool retval = true; + + if (! instance) + { + instance = new ft_manager (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } + + if (! instance) + { + ::error ("unable to create ft_manager!"); + + retval = false; + } + + return retval; + } + + static void cleanup_instance (void) { delete instance; instance = 0; } + + static FT_Face get_font (const std::string& name, const std::string& weight, + const std::string& angle, double size) + { return (instance_ok () + ? instance->do_get_font (name, weight, angle, size) + : 0); } + +private: + + static ft_manager *instance; + +private: + + // No copying! + + ft_manager (const ft_manager&); + + ft_manager& operator = (const ft_manager&); + + ft_manager (void) + : library (), freetype_initialized (false), fontconfig_initialized (false) + { + if (FT_Init_FreeType (&library)) + ::error ("unable to initialize freetype library"); + else + freetype_initialized = true; + +#if defined (HAVE_FONTCONFIG) + if (! FcInit ()) + ::error ("unable to initialize fontconfig library"); + else + fontconfig_initialized = true; +#endif + } + + ~ft_manager (void) + { + if (freetype_initialized) + FT_Done_FreeType (library); + +#if defined (HAVE_FONTCONFIG) + // FIXME -- Skip the call to FcFini because it can trigger the + // assertion + // + // octave: fccache.c:507: FcCacheFini: Assertion 'fcCacheChains[i] == ((void *)0)' failed. + // + // if (fontconfig_initialized) + // FcFini (); +#endif + } + + + FT_Face do_get_font (const std::string& name, const std::string& weight, + const std::string& angle, double size) + { + FT_Face retval = 0; + + std::string file; + +#if defined (HAVE_FONTCONFIG) + if (fontconfig_initialized) + { + int fc_weight, fc_angle; + + if (weight == "bold") + fc_weight = FC_WEIGHT_BOLD; + else if (weight == "light") + fc_weight = FC_WEIGHT_LIGHT; + else if (weight == "demi") + fc_weight = FC_WEIGHT_DEMIBOLD; + else + fc_weight = FC_WEIGHT_NORMAL; + + if (angle == "italic") + fc_angle = FC_SLANT_ITALIC; + else if (angle == "oblique") + fc_angle = FC_SLANT_OBLIQUE; + else + fc_angle = FC_SLANT_ROMAN; + + FcPattern *pat = FcPatternCreate (); + + FcPatternAddString (pat, FC_FAMILY, + (reinterpret_cast + (name == "*" ? "sans" : name.c_str ()))); + + FcPatternAddInteger (pat, FC_WEIGHT, fc_weight); + FcPatternAddInteger (pat, FC_SLANT, fc_angle); + FcPatternAddDouble (pat, FC_PIXEL_SIZE, size); + + if (FcConfigSubstitute (0, pat, FcMatchPattern)) + { + FcResult res; + FcPattern *match; + + FcDefaultSubstitute (pat); + match = FcFontMatch (0, pat, &res); + + // FIXME -- originally, this test also required that + // res != FcResultNoMatch. Is that really needed? + if (match) + { + unsigned char *tmp; + + FcPatternGetString (match, FC_FILE, 0, &tmp); + file = reinterpret_cast (tmp); + } + else + ::warning ("could not match any font: %s-%s-%s-%g", + name.c_str (), weight.c_str (), angle.c_str (), + size); + + if (match) + FcPatternDestroy (match); + } + + FcPatternDestroy (pat); + } +#endif + + if (file.empty ()) + { +#ifdef __WIN32__ + file = "C:/WINDOWS/Fonts/verdana.ttf"; +#else + // FIXME: find a "standard" font for UNIX platforms +#endif + } + + if (! file.empty () && FT_New_Face (library, file.c_str (), 0, &retval)) + ::warning ("ft_manager: unable to load font: %s", file.c_str ()); + + return retval; + } + +private: + FT_Library library; + bool freetype_initialized; + bool fontconfig_initialized; +}; + +ft_manager* ft_manager::instance = 0; + +// --------------------------------------------------------------------------- + +ft_render::ft_render (void) + : text_processor (), face (0), bbox (1, 4, 0.0), + xoffset (0), yoffset (0), multiline_halign (0), + multiline_align_xoffsets (), mode (MODE_BBOX), + red (0), green (0), blue (0) +{ +} + +ft_render::~ft_render (void) +{ + if (face) + FT_Done_Face (face); +} + +void +ft_render::set_font (const std::string& name, const std::string& weight, + const std::string& angle, double size) +{ + if (face) + FT_Done_Face (face); + + // FIXME: take "fontunits" into account + face = ft_manager::get_font (name, weight, angle, size); + + if (face) + { + if (FT_Set_Char_Size (face, 0, size*64, 0, 0)) + ::warning ("ft_render: unable to set font size to %d", size); + } + else + ::warning ("ft_render: unable to load appropriate font"); +} + +void +ft_render::set_mode (int m) +{ + mode = m; + + switch (mode) + { + case MODE_BBOX: + xoffset = yoffset = 0; + bbox = Matrix (1, 4, 0.0); + break; + case MODE_RENDER: + if (bbox.numel () != 4) + { + ::warning ("ft_render: invalid bounding box, cannot render"); + + xoffset = yoffset = 0; + pixels = uint8NDArray (); + } + else + { + pixels = uint8NDArray (dim_vector (4, bbox(2), bbox(3)), + static_cast (0)); + xoffset = 0; + yoffset = -bbox(1)-1; + } + break; + default: + ::error ("ft_render: invalid mode '%d'", mode); + break; + } +} + +void +ft_render::visit (text_element_string& e) +{ + if (face) + { + int line_index = 0; + FT_UInt box_line_width = 0; + std::string str = e.string_value (); + FT_UInt glyph_index, previous = 0; + + if (mode == MODE_BBOX) + multiline_align_xoffsets.clear (); + else if (mode == MODE_RENDER) + xoffset += multiline_align_xoffsets[line_index]; + + for (size_t i = 0; i < str.length (); i++) + { + glyph_index = FT_Get_Char_Index (face, str[i]); + + if (str[i] != '\n' + && (! glyph_index + || FT_Load_Glyph (face, glyph_index, FT_LOAD_DEFAULT))) + gripe_missing_glyph (str[i]); + else + { + switch (mode) + { + case MODE_RENDER: + if (str[i] == '\n') + { + glyph_index = FT_Get_Char_Index (face, ' '); + if (!glyph_index || FT_Load_Glyph (face, glyph_index, FT_LOAD_DEFAULT)) + { + gripe_missing_glyph (' '); + } + else + { + line_index++; + xoffset = multiline_align_xoffsets[line_index]; + yoffset -= (face->size->metrics.height >> 6); + } + } + else if (FT_Render_Glyph (face->glyph, FT_RENDER_MODE_NORMAL)) + { + gripe_glyph_render (str[i]); + } + else + { + FT_Bitmap& bitmap = face->glyph->bitmap; + int x0, y0; + + if (previous) + { + FT_Vector delta; + + FT_Get_Kerning (face, previous, glyph_index, FT_KERNING_DEFAULT, &delta); + xoffset += (delta.x >> 6); + } + + x0 = xoffset+face->glyph->bitmap_left; + y0 = yoffset+face->glyph->bitmap_top; + + // 'w' seems to have a negative -1 + // face->glyph->bitmap_left, this is so we don't + // index out of bound, and assumes we we allocated + // the right amount of horizontal space in the bbox. + if (x0 < 0) + x0 = 0; + + for (int r = 0; r < bitmap.rows; r++) + for (int c = 0; c < bitmap.width; c++) + { + unsigned char pix = bitmap.buffer[r*bitmap.width+c]; + if (x0+c < 0 || x0+c >= pixels.dim2 () + || y0-r < 0 || y0-r >= pixels.dim3 ()) + { + //::error ("out-of-bound indexing!!"); + } + else if (pixels(3, x0+c, y0-r).value () == 0) + { + pixels(0, x0+c, y0-r) = red; + pixels(1, x0+c, y0-r) = green; + pixels(2, x0+c, y0-r) = blue; + pixels(3, x0+c, y0-r) = pix; + } + } + + xoffset += (face->glyph->advance.x >> 6); + } + break; + + case MODE_BBOX: + if (str[i] == '\n') + { + glyph_index = FT_Get_Char_Index (face, ' '); + if (! glyph_index + || FT_Load_Glyph (face, glyph_index, FT_LOAD_DEFAULT)) + { + gripe_missing_glyph (' '); + } + else + { + multiline_align_xoffsets.push_back (box_line_width); + // Reset the pixel width for this newline, so we don't + // allocate a bounding box larger than the horizontal + // width of the multi-line + box_line_width = 0; + bbox(1) -= (face->size->metrics.height >> 6); + } + } + else + { + // width + if (previous) + { + FT_Vector delta; + + FT_Get_Kerning (face, previous, glyph_index, + FT_KERNING_DEFAULT, &delta); + + box_line_width += (delta.x >> 6); + } + + box_line_width += (face->glyph->advance.x >> 6); + + int asc, desc; + + if (false /*tight*/) + { + desc = face->glyph->metrics.horiBearingY - face->glyph->metrics.height; + asc = face->glyph->metrics.horiBearingY; + } + else + { + asc = face->size->metrics.ascender; + desc = face->size->metrics.descender; + } + + asc = yoffset + (asc >> 6); + desc = yoffset + (desc >> 6); + + if (desc < bbox(1)) + { + bbox(3) += (bbox(1) - desc); + bbox(1) = desc; + } + if (asc > (bbox(3)+bbox(1))) + bbox(3) = asc-bbox(1); + if (bbox(2) < box_line_width) + bbox(2) = box_line_width; + } + break; + } + if (str[i] == '\n') + previous = 0; + else + previous = glyph_index; + } + } + if (mode == MODE_BBOX) + { + /* Push last the width associated with the last line */ + multiline_align_xoffsets.push_back (box_line_width); + + for (unsigned int i = 0; i < multiline_align_xoffsets.size (); i++) + { + /* Center align */ + if (multiline_halign == 1) + multiline_align_xoffsets[i] = (bbox(2) - multiline_align_xoffsets[i])/2; + /* Right align */ + else if (multiline_halign == 2) + multiline_align_xoffsets[i] = (bbox(2) - multiline_align_xoffsets[i]); + /* Left align */ + else + multiline_align_xoffsets[i] = 0; + } + } + } +} + +void +ft_render::reset (void) +{ + set_mode (MODE_BBOX); + set_color (Matrix (1, 3, 0.0)); +} + +void +ft_render::set_color (Matrix c) +{ + if (c.numel () == 3) + { + red = static_cast (c(0)*255); + green = static_cast (c(1)*255); + blue = static_cast (c(2)*255); + } + else + ::warning ("ft_render::set_color: invalid color"); +} + +uint8NDArray +ft_render::render (text_element* elt, Matrix& box, int rotation) +{ + set_mode (MODE_BBOX); + elt->accept (*this); + box = bbox; + + set_mode (MODE_RENDER); + if (pixels.numel () > 0) + { + elt->accept (*this); + + switch (rotation) + { + case ROTATION_0: + break; + case ROTATION_90: + { + Array perm (dim_vector (3, 1)); + perm(0) = 0; + perm(1) = 2; + perm(2) = 1; + pixels = pixels.permute (perm); + + Array idx (dim_vector (3, 1)); + idx(0) = idx_vector (':'); + idx(1) = idx_vector (pixels.dim2 ()-1, -1, -1); + idx(2) = idx_vector (':'); + pixels = uint8NDArray (pixels.index (idx)); + } + break; + case ROTATION_180: + { + Array idx (dim_vector (3, 1)); + idx(0) = idx_vector (':'); + idx(1) = idx_vector (pixels.dim2 ()-1, -1, -1); + idx(2)= idx_vector (pixels.dim3 ()-1, -1, -1); + pixels = uint8NDArray (pixels.index (idx)); + } + break; + case ROTATION_270: + { + Array perm (dim_vector (3, 1)); + perm(0) = 0; + perm(1) = 2; + perm(2) = 1; + pixels = pixels.permute (perm); + + Array idx (dim_vector (3, 1)); + idx(0) = idx_vector (':'); + idx(1) = idx_vector (':'); + idx(2) = idx_vector (pixels.dim3 ()-1, -1, -1); + pixels = uint8NDArray (pixels.index (idx)); + } + break; + } + } + + return pixels; +} + +// Note: +// x-extent accurately measures width of glyphs. +// y-extent is overly large because it is measured from baseline-to-baseline. +// Calling routines, such as ylabel, may need to account for this mismatch. + +Matrix +ft_render::get_extent (text_element *elt, double rotation) +{ + set_mode (MODE_BBOX); + elt->accept (*this); + + Matrix extent (1, 2, 0.0); + + switch (rotation_to_mode (rotation)) + { + case ROTATION_0: + case ROTATION_180: + extent(0) = bbox(2); + extent(1) = bbox(3); + break; + case ROTATION_90: + case ROTATION_270: + extent(0) = bbox(3); + extent(1) = bbox(2); + } + + return extent; +} + +Matrix +ft_render::get_extent (const std::string& txt, double rotation) +{ + text_element *elt = text_parser_none ().parse (txt); + Matrix extent = get_extent (elt, rotation); + delete elt; + + return extent; +} + +int +ft_render::rotation_to_mode (double rotation) const +{ + if (rotation == 0.0) + return ROTATION_0; + else if (rotation == 90.0) + return ROTATION_90; + else if (rotation == 180.0) + return ROTATION_180; + else if (rotation == 270.0) + return ROTATION_270; + else + return ROTATION_0; +} + +void +ft_render::text_to_pixels (const std::string& txt, + uint8NDArray& pixels_, Matrix& box, + int halign, int valign, double rotation) +{ + // FIXME: clip "rotation" between 0 and 360 + int rot_mode = rotation_to_mode (rotation); + + multiline_halign = halign; + + text_element *elt = text_parser_none ().parse (txt); + pixels_ = render (elt, box, rot_mode); + delete elt; + + if (pixels_.numel () == 0) + { + // nothing to render + return; + } + + switch (halign) + { + default: box(0) = 0; break; + case 1: box(0) = -box(2)/2; break; + case 2: box(0) = -box(2); break; + } + switch (valign) + { + default: box(1) = 0; break; + case 1: box(1) = -box(3)/2; break; + case 2: box(1) = -box(3); break; + case 3: break; + case 4: box(1) = -box(3)-box(1); break; + } + + switch (rot_mode) + { + case ROTATION_90: + std::swap (box(0), box(1)); + std::swap (box(2), box(3)); + box(0) = -box(0)-box(2); + break; + case ROTATION_180: + box(0) = -box(0)-box(2); + box(1) = -box(1)-box(3); + break; + case ROTATION_270: + std::swap (box(0), box(1)); + std::swap (box(2), box(3)); + box(1) = -box(1)-box(3); + break; + } +} + +#endif // HAVE_FREETYPE diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/txt-eng-ft.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/txt-eng-ft.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,107 @@ +/* + +Copyright (C) 2009-2012 Michael Goffioul + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if ! defined (txt_eng_ft_h) +#define txt_eng_ft_h 1 + +#if HAVE_FREETYPE + +#include + +#include +#include FT_FREETYPE_H + +#include +#include +#include "txt-eng.h" + +class +OCTINTERP_API +ft_render : public text_processor +{ +public: + enum { + MODE_BBOX = 0, + MODE_RENDER = 1 + }; + + enum { + ROTATION_0 = 0, + ROTATION_90 = 1, + ROTATION_180 = 2, + ROTATION_270 = 3 + }; + +public: + ft_render (void); + + ~ft_render (void); + + void visit (text_element_string& e); + + void reset (void); + + uint8NDArray get_pixels (void) const { return pixels; } + + Matrix get_boundingbox (void) const { return bbox; } + + uint8NDArray render (text_element* elt, Matrix& box, + int rotation = ROTATION_0); + + Matrix get_extent (text_element *elt, double rotation = 0.0); + Matrix get_extent (const std::string& txt, double rotation = 0.0); + + void set_font (const std::string& name, const std::string& weight, + const std::string& angle, double size); + + void set_color (Matrix c); + + void set_mode (int m); + + void text_to_pixels (const std::string& txt, + uint8NDArray& pixels_, Matrix& bbox, + int halign, int valign, double rotation); + +private: + int rotation_to_mode (double rotation) const; + + // No copying! + + ft_render (const ft_render&); + + ft_render& operator = (const ft_render&); + +private: + FT_Face face; + Matrix bbox; + uint8NDArray pixels; + int xoffset; + int yoffset; + int multiline_halign; + std::vector multiline_align_xoffsets; + int mode; + uint8_t red, green, blue; +}; + +#endif // HAVE_FREETYPE + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/txt-eng.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/txt-eng.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,193 @@ +/* + +Copyright (C) 2009-2012 Michael Goffioul + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if ! defined (txt_eng_h) +#define txt_eng_h 1 + +#include "base-list.h" + +class text_element; +class text_element_string; +class text_element_list; +class text_subscript_element; +class text_superscript_element; + +class text_processor; + +class +OCTINTERP_API +text_element +{ +public: + text_element (void) { } + + virtual ~text_element (void) { } + + virtual void accept (text_processor& p) = 0; + +private: + text_element (const text_element&); +}; + +class +OCTINTERP_API +text_element_string : public text_element +{ +public: + text_element_string (const std::string& s = "") + : text_element (), str (s) { } + + ~text_element_string (void) { } + + std::string string_value (void) const { return str; } + + void accept (text_processor& p); + +private: + std::string str; + +private: + text_element_string (const text_element_string &); +}; + +class +OCTINTERP_API +text_element_list : + public text_element, + public octave_base_list +{ +public: + text_element_list (void) + : text_element (), octave_base_list () { } + + ~text_element_list (void) + { + while (! empty ()) + { + iterator it = begin (); + delete (*it); + erase (it); + } + } + + void accept (text_processor& p); +}; + +class +OCTINTERP_API +text_subscript_element : public text_element_list +{ +public: + text_subscript_element (void) + : text_element_list () { } + + ~text_subscript_element (void) { } + + void accept (text_processor& p); +}; + +class +OCTINTERP_API +text_superscript_element : public text_element_list +{ +public: + text_superscript_element (void) + : text_element_list () { } + + ~text_superscript_element (void) { } + + void accept (text_processor& p); +}; + +class +OCTINTERP_API +text_processor +{ +public: + virtual void visit (text_element_string& e) = 0; + + virtual void visit (text_element_list& e) + { + for (text_element_list::iterator it = e.begin (); + it != e.end (); ++it) + { + (*it)->accept (*this); + } + } + + virtual void visit (text_subscript_element& e) + { visit (dynamic_cast (e)); } + + virtual void visit (text_superscript_element& e) + { visit (dynamic_cast (e)); } + + virtual void reset (void) { } + +protected: + text_processor (void) { } + + virtual ~text_processor (void) { } +}; + +#define TEXT_ELEMENT_ACCEPT(cls) \ +inline void \ +cls::accept (text_processor& p) \ +{ p.visit (*this); } + +TEXT_ELEMENT_ACCEPT(text_element_string) +TEXT_ELEMENT_ACCEPT(text_element_list) +TEXT_ELEMENT_ACCEPT(text_subscript_element) +TEXT_ELEMENT_ACCEPT(text_superscript_element) + +class +OCTINTERP_API +text_parser +{ +public: + text_parser (void) { } + + virtual ~text_parser (void) { } + + virtual text_element* parse (const std::string& s) = 0; +}; + +class +OCTINTERP_API +text_parser_none : public text_parser +{ +public: + text_parser_none (void) : text_parser () { } + + ~text_parser_none (void) { } + + // FIXME: is it possible to use reference counting to manage the + // memory for the object returned by the text parser? That would be + // preferable to having to know when and where to delete the object it + // creates... + + text_element* parse (const std::string& s) + { + return new text_element_string (s); + } +}; + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/unwind-prot.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/unwind-prot.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,35 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton +Copyright (C) 2009 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "error.h" +#include "unwind-prot.h" + +void unwind_protect_safe::gripe_exception (void) +{ + // FIXME: can this throw an exception? + error ("internal: unhandled exception in unwind_protect handler"); +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/unwind-prot.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/unwind-prot.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,143 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_unwind_prot_h) +#define octave_unwind_prot_h 1 + +#include +#include + +#include "action-container.h" + +class +OCTINTERP_API +unwind_protect : public action_container +{ +public: + + unwind_protect (void) : lifo () { } + + // Destructor should not raise an exception, so all actions + // registered should be exception-safe (but setting error_state is + // allowed). If you're not sure, see unwind_protect_safe. + + ~unwind_protect (void) { run (); } + + virtual void add (elem *new_elem) + { + lifo.push (new_elem); + } + + void add (void (*fcn) (void *), void *ptr = 0) GCC_ATTR_DEPRECATED + { + add (new fcn_arg_elem (fcn, ptr)); + } + + operator bool (void) const { return ! empty (); } + + void run_top (void) GCC_ATTR_DEPRECATED { run_first (); } + + void run_first (void) + { + if (! empty ()) + { + // No leak on exception! + std::auto_ptr ptr (lifo.top ()); + lifo.pop (); + ptr->run (); + } + } + + void run_top (int num) GCC_ATTR_DEPRECATED { run (num); } + + void discard_top (void) GCC_ATTR_DEPRECATED { discard_first (); } + + void discard_first (void) + { + if (! empty ()) + { + elem *ptr = lifo.top (); + lifo.pop (); + delete ptr; + } + } + + void discard_top (int num) GCC_ATTR_DEPRECATED { discard (num); } + + size_t size (void) const { return lifo.size (); } + +protected: + + std::stack lifo; + +private: + + // No copying! + + unwind_protect (const unwind_protect&); + + unwind_protect& operator = (const unwind_protect&); +}; + +// Like unwind_protect, but this one will guard against the +// possibility of seeing an exception (or interrupt) in the cleanup +// actions. Not that we can do much about it, but at least we won't +// crash. + +class +OCTINTERP_API +unwind_protect_safe : public unwind_protect +{ +private: + + static void gripe_exception (void); + +public: + + unwind_protect_safe (void) : unwind_protect () { } + + ~unwind_protect_safe (void) + { + while (! empty ()) + { + try + { + run_first (); + } + catch (...) // Yes, the black hole. Remember we're in a dtor. + { + gripe_exception (); + } + } + } + +private: + + // No copying! + + unwind_protect_safe (const unwind_protect_safe&); + + unwind_protect_safe& operator = (const unwind_protect_safe&); +}; + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/utils.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/utils.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,1433 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton +Copyright (C) 2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include +#include +#include +#include + +#include +#include + +#include "vasnprintf.h" + +#include "quit.h" + +#include "dir-ops.h" +#include "file-ops.h" +#include "file-stat.h" +#include "lo-mappers.h" +#include "lo-utils.h" +#include "oct-cmplx.h" +#include "oct-env.h" +#include "pathsearch.h" +#include "str-vec.h" + +#include "Cell.h" +#include +#include "defun.h" +#include "dirfns.h" +#include "error.h" +#include "gripes.h" +#include "input.h" +#include "lex.h" +#include "load-path.h" +#include "oct-errno.h" +#include "oct-hist.h" +#include "oct-obj.h" +#include "ov-range.h" +#include "pager.h" +#include "parse.h" +#include "sysdep.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +// Return TRUE if S is a valid identifier. + +bool +valid_identifier (const char *s) +{ + if (! s || ! (isalpha (*s) || *s == '_' || *s == '$')) + return false; + + while (*++s != '\0') + if (! (isalnum (*s) || *s == '_' || *s == '$')) + return false; + + return true; +} + +bool +valid_identifier (const std::string& s) +{ + return valid_identifier (s.c_str ()); +} + +DEFUN (isvarname, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isvarname (@var{name})\n\ +Return true if @var{name} is a valid variable name.\n\ +@seealso{iskeyword, exist, who}\n\ +@end deftypefn") +{ + octave_value retval = false; + + int nargin = args.length (); + + if (nargin != 1) + print_usage (); + else if (args(0).is_string ()) + { + std::string varname = args(0).string_value (); + retval = valid_identifier (varname) && ! is_keyword (varname); + } + + return retval; +} + +/* +%!assert (isvarname ("foo"), true) +%!assert (isvarname ("_foo"), true) +%!assert (isvarname ("_1"), true) +%!assert (isvarname ("1foo"), false) +%!assert (isvarname (""), false) +%!assert (isvarname (12), false) + +%!error isvarname () +%!error isvarname ("foo", "bar"); +*/ + +// Return TRUE if F and G are both names for the same file. + +bool +same_file (const std::string& f, const std::string& g) +{ + return same_file_internal (f, g); +} + +int +almost_match (const std::string& std, const std::string& s, int min_match_len, + int case_sens) +{ + int stdlen = std.length (); + int slen = s.length (); + + return (slen <= stdlen + && slen >= min_match_len + && (case_sens + ? (strncmp (std.c_str (), s.c_str (), slen) == 0) + : (octave_strncasecmp (std.c_str (), s.c_str (), slen) == 0))); +} + +// Ugh. + +int +keyword_almost_match (const char * const *std, int *min_len, const std::string& s, + int min_toks_to_match, int max_toks) +{ + int status = 0; + int tok_count = 0; + int toks_matched = 0; + + if (s.empty () || max_toks < 1) + return status; + + char *kw = strsave (s.c_str ()); + + char *t = kw; + while (*t != '\0') + { + if (*t == '\t') + *t = ' '; + t++; + } + + char *beg = kw; + while (*beg == ' ') + beg++; + + if (*beg == '\0') + return status; + + + const char **to_match = new const char * [max_toks + 1]; + const char * const *s1 = std; + const char **s2 = to_match; + + if (! s1 || ! s2) + goto done; + + s2[tok_count] = beg; + char *end; + while ((end = strchr (beg, ' ')) != 0) + { + *end = '\0'; + beg = end + 1; + + while (*beg == ' ') + beg++; + + if (*beg == '\0') + break; + + tok_count++; + if (tok_count >= max_toks) + goto done; + + s2[tok_count] = beg; + } + s2[tok_count+1] = 0; + + s2 = to_match; + + for (;;) + { + if (! almost_match (*s1, *s2, min_len[toks_matched], 0)) + goto done; + + toks_matched++; + + s1++; + s2++; + + if (! *s2) + { + status = (toks_matched >= min_toks_to_match); + goto done; + } + + if (! *s1) + goto done; + } + + done: + + delete [] kw; + delete [] to_match; + + return status; +} + +// Return non-zero if either NR or NC is zero. Return -1 if this +// should be considered fatal; return 1 if this is ok. + +int +empty_arg (const char * /* name */, octave_idx_type nr, octave_idx_type nc) +{ + return (nr == 0 || nc == 0); +} + +// See if the given file is in the path. + +std::string +search_path_for_file (const std::string& path, const string_vector& names) +{ + dir_path p (path); + + return octave_env::make_absolute (p.find_first_of (names)); +} + +// Find all locations of the given file in the path. + +string_vector +search_path_for_all_files (const std::string& path, const string_vector& names) +{ + dir_path p (path); + + string_vector sv = p.find_all_first_of (names); + + octave_idx_type len = sv.length (); + + for (octave_idx_type i = 0; i < len; i++) + sv[i] = octave_env::make_absolute (sv[i]); + + return sv; +} + +static string_vector +make_absolute (const string_vector& sv) +{ + octave_idx_type len = sv.length (); + + string_vector retval (len); + + for (octave_idx_type i = 0; i < len; i++) + retval[i] = octave_env::make_absolute (sv[i]); + + return retval; +} + +DEFUN (file_in_loadpath, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} file_in_loadpath (@var{file})\n\ +@deftypefnx {Built-in Function} {} file_in_loadpath (@var{file}, \"all\")\n\ +\n\ +Return the absolute name of @var{file} if it can be found in\n\ +the list of directories specified by @code{path}.\n\ +If no file is found, return an empty character string.\n\ +\n\ +If the first argument is a cell array of strings, search each\n\ +directory of the loadpath for element of the cell array and return\n\ +the first that matches.\n\ +\n\ +If the second optional argument @code{\"all\"} is supplied, return\n\ +a cell array containing the list of all files that have the same\n\ +name in the path. If no files are found, return an empty cell array.\n\ +@seealso{file_in_path, path}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + string_vector names = args(0).all_strings (); + + if (! error_state && names.length () > 0) + { + if (nargin == 1) + retval = octave_env::make_absolute (load_path::find_first_of (names)); + else if (nargin == 2) + { + std::string opt = args(1).string_value (); + + if (! error_state && opt == "all") + retval = Cell (make_absolute + (load_path::find_all_first_of (names))); + else + error ("file_in_loadpath: invalid option"); + } + } + else + error ("file_in_loadpath: FILE argument must be a string"); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! f = file_in_loadpath ("plot.m"); +%! assert (ischar (f)); +%! assert (! isempty (f)); + +%!test +%! f = file_in_loadpath ("$$probably_!!_not_&&_a_!!_file$$"); +%! assert (f, ""); + +%!test +%! lst = file_in_loadpath ("$$probably_!!_not_&&_a_!!_file$$", "all"); +%! assert (lst, {}); + +%!error file_in_loadpath () +%!error file_in_loadpath ("foo", "bar", 1) +*/ + +DEFUN (file_in_path, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} file_in_path (@var{path}, @var{file})\n\ +@deftypefnx {Built-in Function} {} file_in_path (@var{path}, @var{file}, \"all\")\n\ +Return the absolute name of @var{file} if it can be found in\n\ +@var{path}. The value of @var{path} should be a colon-separated list of\n\ +directories in the format described for @code{path}. If no file\n\ +is found, return an empty character string. For example:\n\ +\n\ +@example\n\ +@group\n\ +file_in_path (EXEC_PATH, \"sh\")\n\ + @result{} \"/bin/sh\"\n\ +@end group\n\ +@end example\n\ +\n\ +If the second argument is a cell array of strings, search each\n\ +directory of the path for element of the cell array and return\n\ +the first that matches.\n\ +\n\ +If the third optional argument @code{\"all\"} is supplied, return\n\ +a cell array containing the list of all files that have the same\n\ +name in the path. If no files are found, return an empty cell array.\n\ +@seealso{file_in_loadpath}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2 || nargin == 3) + { + std::string path = args(0).string_value (); + + if (! error_state) + { + string_vector names = args(1).all_strings (); + + if (! error_state && names.length () > 0) + { + if (nargin == 2) + retval = search_path_for_file (path, names); + else if (nargin == 3) + { + std::string opt = args(2).string_value (); + + if (! error_state && opt == "all") + retval = Cell (make_absolute + (search_path_for_all_files (path, names))); + else + error ("file_in_path: invalid option"); + } + } + else + error ("file_in_path: all arguments must be strings"); + } + else + error ("file_in_path: PATH must be a string"); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! f = file_in_path (path (), "plot.m"); +%! assert (ischar (f)); +%! assert (! isempty (f)); + +%!test +%! f = file_in_path (path (), "$$probably_!!_not_&&_a_!!_file$$"); +%! assert (f, ""); + +%!test +%! lst = file_in_path (path (), "$$probably_!!_not_&&_a_!!_file$$", "all"); +%! assert (lst, {}); + +%!error file_in_path () +%!error file_in_path ("foo") +%!error file_in_path ("foo", "bar", "baz", 1) +*/ + +std::string +file_in_path (const std::string& name, const std::string& suffix) +{ + std::string nm = name; + + if (! suffix.empty ()) + nm.append (suffix); + + return octave_env::make_absolute (load_path::find_file (nm)); +} + +// See if there is an function file in the path. If so, return the +// full path to the file. + +std::string +fcn_file_in_path (const std::string& name) +{ + std::string retval; + + int len = name.length (); + + if (len > 0) + { + if (octave_env::absolute_pathname (name)) + { + file_stat fs (name); + + if (fs.exists ()) + retval = name; + } + else if (len > 2 && name[len - 2] == '.' && name[len - 1] == 'm') + retval = load_path::find_fcn_file (name.substr (0, len-2)); + else + { + std::string fname = name; + size_t pos = name.find_first_of (Vfilemarker); + if (pos != std::string::npos) + fname = name.substr (0, pos); + + retval = load_path::find_fcn_file (fname); + } + } + + return retval; +} + +// See if there is a directory called "name" in the path and if it +// contains a Contents.m file return the full path to this file. + +std::string +contents_file_in_path (const std::string& dir) +{ + std::string retval; + + if (dir.length () > 0) + { + std::string tcontents = file_ops::concat (load_path::find_dir (dir), + std::string ("Contents.m")); + + file_stat fs (tcontents); + + if (fs.exists ()) + retval = octave_env::make_absolute (tcontents); + } + + return retval; +} + +// See if there is a .oct file in the path. If so, return the +// full path to the file. + +std::string +oct_file_in_path (const std::string& name) +{ + std::string retval; + + int len = name.length (); + + if (len > 0) + { + if (octave_env::absolute_pathname (name)) + { + file_stat fs (name); + + if (fs.exists ()) + retval = name; + } + else if (len > 4 && name[len - 4] == '.' && name[len - 3] == 'o' + && name[len - 2] == 'c' && name[len - 1] == 't') + retval = load_path::find_oct_file (name.substr (0, len-4)); + else + retval = load_path::find_oct_file (name); + } + + return retval; +} + +// See if there is a .mex file in the path. If so, return the +// full path to the file. + +std::string +mex_file_in_path (const std::string& name) +{ + std::string retval; + + int len = name.length (); + + if (len > 0) + { + if (octave_env::absolute_pathname (name)) + { + file_stat fs (name); + + if (fs.exists ()) + retval = name; + } + else if (len > 4 && name[len - 4] == '.' && name[len - 3] == 'm' + && name[len - 2] == 'e' && name[len - 1] == 'x') + retval = load_path::find_mex_file (name.substr (0, len-4)); + else + retval = load_path::find_mex_file (name); + } + + return retval; +} + +// Replace backslash escapes in a string with the real values. + +std::string +do_string_escapes (const std::string& s) +{ + std::string retval; + + size_t i = 0; + size_t j = 0; + size_t len = s.length (); + + retval.resize (len); + + while (j < len) + { + if (s[j] == '\\' && j+1 < len) + { + switch (s[++j]) + { + case '0': + retval[i] = '\0'; + break; + + case 'a': + retval[i] = '\a'; + break; + + case 'b': // backspace + retval[i] = '\b'; + break; + + case 'f': // formfeed + retval[i] = '\f'; + break; + + case 'n': // newline + retval[i] = '\n'; + break; + + case 'r': // carriage return + retval[i] = '\r'; + break; + + case 't': // horizontal tab + retval[i] = '\t'; + break; + + case 'v': // vertical tab + retval[i] = '\v'; + break; + + case '\\': // backslash + retval[i] = '\\'; + break; + + case '\'': // quote + retval[i] = '\''; + break; + + case '"': // double quote + retval[i] = '"'; + break; + + default: + warning ("unrecognized escape sequence '\\%c' --\ + converting to '%c'", s[j], s[j]); + retval[i] = s[j]; + break; + } + } + else + { + retval[i] = s[j]; + } + + i++; + j++; + } + + retval.resize (i); + + return retval; +} + +DEFUN (do_string_escapes, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} do_string_escapes (@var{string})\n\ +Convert special characters in @var{string} to their escaped forms.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + if (args(0).is_string ()) + retval = do_string_escapes (args(0).string_value ()); + else + error ("do_string_escapes: STRING argument must be of type string"); + } + else + print_usage (); + + return retval; +} + +/* +%!assert (do_string_escapes ('foo\nbar'), "foo\nbar") +%!assert (do_string_escapes ("foo\\nbar"), "foo\nbar") +%!assert (do_string_escapes ("foo\\nbar"), ["foo", char(10), "bar"]) +%!assert ("foo\nbar", ["foo", char(10), "bar"]) + +%!assert (do_string_escapes ('\a\b\f\n\r\t\v'), "\a\b\f\n\r\t\v") +%!assert (do_string_escapes ("\\a\\b\\f\\n\\r\\t\\v"), "\a\b\f\n\r\t\v") +%!assert (do_string_escapes ("\\a\\b\\f\\n\\r\\t\\v"), +%! char ([7, 8, 12, 10, 13, 9, 11])) +%!assert ("\a\b\f\n\r\t\v", char ([7, 8, 12, 10, 13, 9, 11])) + +%!error do_string_escapes () +%!error do_string_escapes ("foo", "bar") +*/ + +const char * +undo_string_escape (char c) +{ + if (! c) + return ""; + + switch (c) + { + case '\0': + return "\\0"; + + case '\a': + return "\\a"; + + case '\b': // backspace + return "\\b"; + + case '\f': // formfeed + return "\\f"; + + case '\n': // newline + return "\\n"; + + case '\r': // carriage return + return "\\r"; + + case '\t': // horizontal tab + return "\\t"; + + case '\v': // vertical tab + return "\\v"; + + case '\\': // backslash + return "\\\\"; + + case '"': // double quote + return "\\\""; + + default: + { + static char retval[2]; + retval[0] = c; + retval[1] = '\0'; + return retval; + } + } +} + +std::string +undo_string_escapes (const std::string& s) +{ + std::string retval; + + for (size_t i = 0; i < s.length (); i++) + retval.append (undo_string_escape (s[i])); + + return retval; +} + +DEFUN (undo_string_escapes, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} undo_string_escapes (@var{s})\n\ +Convert special characters in strings back to their escaped forms. For\n\ +example, the expression\n\ +\n\ +@example\n\ +bell = \"\\a\";\n\ +@end example\n\ +\n\ +@noindent\n\ +assigns the value of the alert character (control-g, ASCII code 7) to\n\ +the string variable @code{bell}. If this string is printed, the\n\ +system will ring the terminal bell (if it is possible). This is\n\ +normally the desired outcome. However, sometimes it is useful to be\n\ +able to print the original representation of the string, with the\n\ +special characters replaced by their escape sequences. For example,\n\ +\n\ +@example\n\ +@group\n\ +octave:13> undo_string_escapes (bell)\n\ +ans = \\a\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +replaces the unprintable alert character with its printable\n\ +representation.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + if (args(0).is_string ()) + retval = undo_string_escapes (args(0).string_value ()); + else + error ("undo_string_escapes: S argument must be a string"); + } + else + print_usage (); + + return retval; +} + +/* +%!assert (undo_string_escapes ("foo\nbar"), 'foo\nbar') +%!assert (undo_string_escapes ("foo\nbar"), "foo\\nbar") +%!assert (undo_string_escapes (["foo", char(10), "bar"]), "foo\\nbar") + +%!assert (undo_string_escapes ("\a\b\f\n\r\t\v"), '\a\b\f\n\r\t\v') +%!assert (undo_string_escapes ("\a\b\f\n\r\t\v"), "\\a\\b\\f\\n\\r\\t\\v") +%!assert (undo_string_escapes (char ([7, 8, 12, 10, 13, 9, 11])), +%! "\\a\\b\\f\\n\\r\\t\\v") + +%!error undo_string_escapes () +%!error undo_string_escapes ("foo", "bar") +*/ + +DEFUN (is_absolute_filename, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} is_absolute_filename (@var{file})\n\ +Return true if @var{file} is an absolute filename.\n\ +@seealso{is_rooted_relative_filename, make_absolute_filename, isdir}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + retval = (args(0).is_string () + && octave_env::absolute_pathname (args(0).string_value ())); + else + print_usage (); + + return retval; +} + +/* +## FIXME: We need system-dependent tests here. + +%!error is_absolute_filename () +%!error is_absolute_filename ("foo", "bar") +*/ + +DEFUN (is_rooted_relative_filename, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} is_rooted_relative_filename (@var{file})\n\ +Return true if @var{file} is a rooted-relative filename.\n\ +@seealso{is_absolute_filename, make_absolute_filename, isdir}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + retval = (args(0).is_string () + && octave_env::rooted_relative_pathname (args(0).string_value ())); + else + print_usage (); + + return retval; +} + +/* +## FIXME: We need system-dependent tests here. + +%!error is_rooted_relative_filename () +%!error is_rooted_relative_filename ("foo", "bar") +*/ + +DEFUN (make_absolute_filename, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} make_absolute_filename (@var{file})\n\ +Return the full name of @var{file} beginning from the root of the file\n\ +system. No check is done for the existence of @var{file}.\n\ +@seealso{canonicalize_file_name, is_absolute_filename, is_rooted_relative_filename, isdir}\n\ +@end deftypefn") +{ + octave_value retval = std::string (); + + if (args.length () == 1) + { + std::string nm = args(0).string_value (); + + if (! error_state) + retval = octave_env::make_absolute (nm); + else + error ("make_absolute_filename: FILE argument must be a file name"); + } + else + print_usage (); + + return retval; +} + +/* +## FIXME: We need system-dependent tests here. + +%!error make_absolute_filename () +%!error make_absolute_filename ("foo", "bar") +*/ + +DEFUN (find_dir_in_path, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} find_dir_in_path (@var{dir})\n\ +@deftypefnx {Built-in Function} {} find_dir_in_path (@var{dir}, \"all\")\n\ +Return the full name of the path element matching @var{dir}. The\n\ +match is performed at the end of each path element. For example, if\n\ +@var{dir} is @code{\"foo/bar\"}, it matches the path element\n\ +@code{\"/some/dir/foo/bar\"}, but not @code{\"/some/dir/foo/bar/baz\"}\n\ +or @code{\"/some/dir/allfoo/bar\"}.\n\ +\n\ +The second argument is optional. If it is supplied, return a cell array\n\ +containing all name matches rather than just the first.\n\ +@end deftypefn") +{ + octave_value retval = std::string (); + + int nargin = args.length (); + + std::string dir; + + if (nargin == 1 || nargin == 2) + { + dir = args(0).string_value (); + + if (! error_state) + { + if (nargin == 1) + retval = load_path::find_dir (dir); + else if (nargin == 2) + retval = Cell (load_path::find_matching_dirs (dir)); + } + else + error ("find_dir_in_path: DIR must be a directory name"); + } + else + print_usage (); + + return retval; +} + +/* +## FIXME: We need system-dependent tests here. + +%!error find_dir_in_path () +%!error find_dir_in_path ("foo", "bar", 1) +*/ + +DEFUNX ("errno", Ferrno, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{err} =} errno ()\n\ +@deftypefnx {Built-in Function} {@var{err} =} errno (@var{val})\n\ +@deftypefnx {Built-in Function} {@var{err} =} errno (@var{name})\n\ +Return the current value of the system-dependent variable errno,\n\ +set its value to @var{val} and return the previous value, or return\n\ +the named error code given @var{name} as a character string, or -1\n\ +if @var{name} is not found.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + if (args(0).is_string ()) + { + std::string nm = args(0).string_value (); + + if (! error_state) + retval = octave_errno::lookup (nm); + else + error ("errno: expecting character string argument"); + } + else + { + int val = args(0).int_value (); + + if (! error_state) + retval = octave_errno::set (val); + else + error ("errno: expecting integer argument"); + } + } + else if (nargin == 0) + retval = octave_errno::get (); + else + print_usage (); + + return retval; +} + +/* +%!assert (isnumeric (errno ())) + +%!test +%! lst = errno_list (); +%! fns = fieldnames (lst); +%! oldval = errno (fns{1}); +%! assert (isnumeric (oldval)); +%! errno (oldval); +%! newval = errno (); +%! assert (oldval, newval); + +%!error errno ("foo", 1) +*/ + +DEFUN (errno_list, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} errno_list ()\n\ +Return a structure containing the system-dependent errno values.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 0) + retval = octave_errno::list (); + else + print_usage (); + + return retval; +} + +/* +%!assert (isstruct (errno_list ())) + +%!error errno_list ("foo") +*/ + +static void +check_dimensions (octave_idx_type& nr, octave_idx_type& nc, const char *warnfor) +{ + if (nr < 0 || nc < 0) + { + warning_with_id ("Octave:neg-dim-as-zero", + "%s: converting negative dimension to zero", warnfor); + + nr = (nr < 0) ? 0 : nr; + nc = (nc < 0) ? 0 : nc; + } +} + +void +check_dimensions (dim_vector& dim, const char *warnfor) +{ + bool neg = false; + + for (int i = 0; i < dim.length (); i++) + { + if (dim(i) < 0) + { + dim(i) = 0; + neg = true; + } + } + + if (neg) + warning_with_id ("Octave:neg-dim-as-zero", + "%s: converting negative dimension to zero", warnfor); +} + + +void +get_dimensions (const octave_value& a, const char *warn_for, + dim_vector& dim) +{ + if (a.is_scalar_type ()) + { + dim.resize (2); + dim(0) = a.int_value (); + dim(1) = dim(0); + } + else + { + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.columns (); + + if (nr == 1 || nc == 1) + { + Array v = a.vector_value (); + + if (error_state) + return; + + octave_idx_type n = v.length (); + dim.resize (n); + for (octave_idx_type i = 0; i < n; i++) + dim(i) = static_cast (fix (v(i))); + } + else + error ("%s (A): use %s (size (A)) instead", warn_for, warn_for); + } + + if (! error_state) + check_dimensions (dim, warn_for); // May set error_state. +} + + +void +get_dimensions (const octave_value& a, const char *warn_for, + octave_idx_type& nr, octave_idx_type& nc) +{ + if (a.is_scalar_type ()) + { + nr = nc = a.int_value (); + } + else + { + nr = a.rows (); + nc = a.columns (); + + if ((nr == 1 && nc == 2) || (nr == 2 && nc == 1)) + { + Array v = a.vector_value (); + + if (error_state) + return; + + nr = static_cast (fix (v (0))); + nc = static_cast (fix (v (1))); + } + else + error ("%s (A): use %s (size (A)) instead", warn_for, warn_for); + } + + if (! error_state) + check_dimensions (nr, nc, warn_for); // May set error_state. +} + +void +get_dimensions (const octave_value& a, const octave_value& b, + const char *warn_for, octave_idx_type& nr, octave_idx_type& nc) +{ + nr = a.is_empty () ? 0 : a.int_value (); + nc = b.is_empty () ? 0 : b.int_value (); + + if (error_state) + error ("%s: expecting two scalar arguments", warn_for); + else + check_dimensions (nr, nc, warn_for); // May set error_state. +} + +octave_idx_type +dims_to_numel (const dim_vector& dims, const octave_value_list& idx) +{ + octave_idx_type retval; + + octave_idx_type len = idx.length (); + + if (len == 0) + retval = dims.numel (); + else + { + const dim_vector dv = dims.redim (len); + retval = 1; + for (octave_idx_type i = 0; i < len; i++) + { + octave_value idxi = idx(i); + if (idxi.is_magic_colon ()) + retval *= dv(i); + else if (idxi.is_numeric_type ()) + retval *= idxi.numel (); + else + { + idx_vector jdx = idxi.index_vector (); + if (error_state) + break; + retval *= jdx.length (dv(i)); + } + } + } + + return retval; +} + +Matrix +identity_matrix (octave_idx_type nr, octave_idx_type nc) +{ + Matrix m (nr, nc, 0.0); + + if (nr > 0 && nc > 0) + { + octave_idx_type n = std::min (nr, nc); + + for (octave_idx_type i = 0; i < n; i++) + m (i, i) = 1.0; + } + + return m; +} + +FloatMatrix +float_identity_matrix (octave_idx_type nr, octave_idx_type nc) +{ + FloatMatrix m (nr, nc, 0.0); + + if (nr > 0 && nc > 0) + { + octave_idx_type n = std::min (nr, nc); + + for (octave_idx_type i = 0; i < n; i++) + m (i, i) = 1.0; + } + + return m; +} + +size_t +octave_format (std::ostream& os, const char *fmt, ...) +{ + size_t retval; + + va_list args; + va_start (args, fmt); + + retval = octave_vformat (os, fmt, args); + + va_end (args); + + return retval; +} + +size_t +octave_vformat (std::ostream& os, const char *fmt, va_list args) +{ + std::string s = octave_vasprintf (fmt, args); + + os << s; + + return s.length (); +} + +std::string +octave_vasprintf (const char *fmt, va_list args) +{ + std::string retval; + + char *result; + + int status = gnulib::vasprintf (&result, fmt, args); + + if (status >= 0) + { + retval = result; + ::free (result); + } + + return retval; +} + +std::string +octave_asprintf (const char *fmt, ...) +{ + std::string retval; + + va_list args; + va_start (args, fmt); + + retval = octave_vasprintf (fmt, args); + + va_end (args); + + return retval; +} + +void +octave_sleep (double seconds) +{ + if (seconds > 0) + { + double t; + + unsigned int usec + = static_cast (modf (seconds, &t) * 1000000); + + unsigned int sec + = ((t > std::numeric_limits::max ()) + ? std::numeric_limits::max () + : static_cast (t)); + + // Versions of these functions that accept unsigned int args are + // defined in cutils.c. + octave_sleep (sec); + octave_usleep (usec); + + octave_quit (); + } +} + +DEFUN (isindex, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isindex (@var{ind})\n\ +@deftypefnx {Built-in Function} {} isindex (@var{ind}, @var{n})\n\ +Return true if @var{ind} is a valid index. Valid indices are\n\ +either positive integers (although possibly of real data type), or logical\n\ +arrays. If present, @var{n} specifies the maximum extent of the dimension\n\ +to be indexed. When possible the internal result is cached so that\n\ +subsequent indexing using @var{ind} will not perform the check again.\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + octave_idx_type n = 0; + + if (nargin == 2) + n = args(1).idx_type_value (); + else if (nargin != 1) + print_usage (); + + if (! error_state) + { + unwind_protect frame; + + frame.protect_var (Vallow_noninteger_range_as_index); + Vallow_noninteger_range_as_index = false; + + frame.protect_var (error_state); + + frame.protect_var (discard_error_messages); + discard_error_messages = true; + + try + { + idx_vector idx = args(0).index_vector (); + if (! error_state) + { + if (nargin == 2) + retval = idx.extent (n) <= n; + else + retval = true; + } + else + retval = false; + } + catch (octave_execution_exception) + { + retval = false; + } + } + + return retval; +} + +/* +%!assert (isindex ([1, 2, 3])) +%!assert (isindex (1:3)) +%!assert (isindex ([1, 2, -3]), false) + +%!error isindex () +*/ + +octave_value_list +do_simple_cellfun (octave_value_list (*fun) (const octave_value_list&, int), + const char *fun_name, const octave_value_list& args, + int nargout) +{ + octave_value_list new_args = args, retval; + int nargin = args.length (); + OCTAVE_LOCAL_BUFFER (bool, iscell, nargin); + OCTAVE_LOCAL_BUFFER (Cell, cells, nargin); + OCTAVE_LOCAL_BUFFER (Cell, rcells, nargout); + + const Cell *ccells = cells; + + octave_idx_type numel = 1; + dim_vector dims (1, 1); + + for (int i = 0; i < nargin; i++) + { + octave_value arg = new_args(i); + iscell[i] = arg.is_cell (); + if (iscell[i]) + { + cells[i] = arg.cell_value (); + octave_idx_type n = ccells[i].numel (); + if (n == 1) + { + iscell[i] = false; + new_args(i) = ccells[i](0); + } + else if (numel == 1) + { + numel = n; + dims = ccells[i].dims (); + } + else if (dims != ccells[i].dims ()) + { + error ("%s: cell arguments must have matching sizes", fun_name); + break; + } + } + } + + if (! error_state) + { + for (int i = 0; i < nargout; i++) + rcells[i].clear (dims); + + for (octave_idx_type j = 0; j < numel; j++) + { + for (int i = 0; i < nargin; i++) + if (iscell[i]) + new_args(i) = ccells[i](j); + + octave_quit (); + + const octave_value_list tmp = fun (new_args, nargout); + + if (tmp.length () < nargout) + { + error ("%s: do_simple_cellfun: internal error", fun_name); + break; + } + else + { + for (int i = 0; i < nargout; i++) + rcells[i](j) = tmp(i); + } + } + } + + if (! error_state) + { + retval.resize (nargout); + for (int i = 0; i < nargout; i++) + retval(i) = rcells[i]; + } + + return retval; +} + +octave_value +do_simple_cellfun (octave_value_list (*fun) (const octave_value_list&, int), + const char *fun_name, const octave_value_list& args) +{ + octave_value retval; + const octave_value_list tmp = do_simple_cellfun (fun, fun_name, args, 1); + if (tmp.length () > 0) + retval = tmp(0); + + return retval; +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/utils.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/utils.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,130 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_utils_h) +#define octave_utils_h 1 + +#include + +#include +#include +#include + +#include "dMatrix.h" +#include "lo-utils.h" + +#include "cutils.h" + +class octave_value; +class octave_value_list; +class string_vector; + +extern OCTINTERP_API bool valid_identifier (const char *s); +extern OCTINTERP_API bool valid_identifier (const std::string& s); + +extern OCTINTERP_API bool +same_file (const std::string& f, const std::string& g); + +extern OCTINTERP_API int almost_match (const std::string& std, + const std::string& s, + int min_match_len = 1, + int case_sens = 1); + +extern OCTINTERP_API int +keyword_almost_match (const char * const *std, int *min_len, + const std::string& s, int min_toks_to_match, + int max_toks); + +extern OCTINTERP_API int empty_arg (const char *name, octave_idx_type nr, + octave_idx_type nc); + +extern OCTINTERP_API std::string +search_path_for_file (const std::string&, const string_vector&); + +extern OCTINTERP_API string_vector +search_path_for_all_files (const std::string&, const string_vector&); + +extern OCTINTERP_API std::string +file_in_path (const std::string&, const std::string&); + +extern OCTINTERP_API std::string contents_file_in_path (const std::string&); + +extern OCTINTERP_API std::string fcn_file_in_path (const std::string&); +extern OCTINTERP_API std::string oct_file_in_path (const std::string&); +extern OCTINTERP_API std::string mex_file_in_path (const std::string&); + +extern OCTINTERP_API std::string do_string_escapes (const std::string& s); + +extern OCTINTERP_API const char *undo_string_escape (char c); + +extern OCTINTERP_API std::string undo_string_escapes (const std::string& s); + +extern OCTINTERP_API void +check_dimensions (dim_vector& dim, const char *warnfor); + +extern OCTINTERP_API void +get_dimensions (const octave_value& a, const char *warn_for, + dim_vector& dim); + +extern OCTINTERP_API void +get_dimensions (const octave_value& a, const octave_value& b, + const char *warn_for, octave_idx_type& nr, + octave_idx_type& nc); + +extern OCTINTERP_API void +get_dimensions (const octave_value& a,const char *warn_for, + octave_idx_type& nr, octave_idx_type& nc); + +extern OCTINTERP_API octave_idx_type +dims_to_numel (const dim_vector& dims, const octave_value_list& idx); + +extern OCTINTERP_API Matrix +identity_matrix (octave_idx_type nr, octave_idx_type nc); + +extern OCTINTERP_API FloatMatrix +float_identity_matrix (octave_idx_type nr, octave_idx_type nc); + +extern OCTINTERP_API size_t +octave_format (std::ostream& os, const char *fmt, ...); + +extern OCTINTERP_API size_t +octave_vformat (std::ostream& os, const char *fmt, va_list args); + +extern OCTINTERP_API std::string +octave_vasprintf (const char *fmt, va_list args); + +extern OCTINTERP_API std::string octave_asprintf (const char *fmt, ...); + +extern OCTINTERP_API void octave_sleep (double seconds); + +extern OCTINTERP_API +octave_value_list +do_simple_cellfun (octave_value_list (*fun) (const octave_value_list&, int), + const char *fun_name, const octave_value_list& args, + int nargout); + +extern OCTINTERP_API +octave_value +do_simple_cellfun (octave_value_list (*fun) (const octave_value_list&, int), + const char *fun_name, const octave_value_list& args); + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/variables.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/variables.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,2606 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include +#include +#include + +#include "file-stat.h" +#include "oct-env.h" +#include "file-ops.h" +#include "glob-match.h" +#include "regexp.h" +#include "str-vec.h" + +#include +#include "Cell.h" +#include "defun.h" +#include "dirfns.h" +#include "error.h" +#include "gripes.h" +#include "help.h" +#include "input.h" +#include "lex.h" +#include "load-path.h" +#include "octave-link.h" +#include "oct-map.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-class.h" +#include "ov-usr-fcn.h" +#include "pager.h" +#include "parse.h" +#include "symtab.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +// Defines layout for the whos/who -long command +static std::string Vwhos_line_format + = " %a:4; %ln:6; %cs:16:6:1; %rb:12; %lc:-1;\n"; + +void +clear_mex_functions (void) +{ + symbol_table::clear_mex_functions (); +} + +void +clear_function (const std::string& nm) +{ + symbol_table::clear_function (nm); +} + +void +clear_variable (const std::string& nm) +{ + symbol_table::clear_variable (nm); +} + +void +clear_symbol (const std::string& nm) +{ + symbol_table::clear_symbol (nm); +} + +// Attributes of variables and functions. + +// Is this octave_value a valid function? + +octave_function * +is_valid_function (const std::string& fcn_name, + const std::string& warn_for, bool warn) +{ + octave_function *ans = 0; + + if (! fcn_name.empty ()) + { + octave_value val = symbol_table::find_function (fcn_name); + + if (val.is_defined ()) + ans = val.function_value (true); + } + + if (! ans && warn) + error ("%s: the symbol '%s' is not valid as a function", + warn_for.c_str (), fcn_name.c_str ()); + + return ans; +} + +octave_function * +is_valid_function (const octave_value& arg, + const std::string& warn_for, bool warn) +{ + octave_function *ans = 0; + + std::string fcn_name; + + if (arg.is_string ()) + { + fcn_name = arg.string_value (); + + if (! error_state) + ans = is_valid_function (fcn_name, warn_for, warn); + else if (warn) + error ("%s: expecting function name as argument", warn_for.c_str ()); + } + else if (warn) + error ("%s: expecting function name as argument", warn_for.c_str ()); + + return ans; +} + +octave_function * +extract_function (const octave_value& arg, const std::string& warn_for, + const std::string& fname, const std::string& header, + const std::string& trailer) +{ + octave_function *retval = 0; + + retval = is_valid_function (arg, warn_for, 0); + + if (! retval) + { + std::string s = arg.string_value (); + + std::string cmd = header; + cmd.append (s); + cmd.append (trailer); + + if (! error_state) + { + int parse_status; + + eval_string (cmd, true, parse_status, 0); + + if (parse_status == 0) + { + retval = is_valid_function (fname, warn_for, 0); + + if (! retval) + { + error ("%s: '%s' is not valid as a function", + warn_for.c_str (), fname.c_str ()); + return retval; + } + + warning ("%s: passing function body as a string is obsolete; please use anonymous functions", + warn_for.c_str ()); + } + else + error ("%s: '%s' is not valid as a function", + warn_for.c_str (), fname.c_str ()); + } + else + error ("%s: expecting first argument to be a string", + warn_for.c_str ()); + } + + return retval; +} + +string_vector +get_struct_elts (const std::string& text) +{ + int n = 1; + + size_t pos = 0; + + size_t len = text.length (); + + while ((pos = text.find ('.', pos)) != std::string::npos) + { + if (++pos == len) + break; + + n++; + } + + string_vector retval (n); + + pos = 0; + + for (int i = 0; i < n; i++) + { + len = text.find ('.', pos); + + if (len != std::string::npos) + len -= pos; + + retval[i] = text.substr (pos, len); + + if (len != std::string::npos) + pos += len + 1; + } + + return retval; +} + +static inline bool +is_variable (const std::string& name) +{ + bool retval = false; + + if (! name.empty ()) + { + octave_value val = symbol_table::varval (name); + + retval = val.is_defined (); + } + + return retval; +} + +string_vector +generate_struct_completions (const std::string& text, + std::string& prefix, std::string& hint) +{ + string_vector names; + + size_t pos = text.rfind ('.'); + + if (pos != std::string::npos) + { + if (pos == text.length ()) + hint = ""; + else + hint = text.substr (pos+1); + + prefix = text.substr (0, pos); + + std::string base_name = prefix; + + pos = base_name.find_first_of ("{(."); + + if (pos != std::string::npos) + base_name = base_name.substr (0, pos); + + if (is_variable (base_name)) + { + int parse_status; + + unwind_protect frame; + + frame.protect_var (error_state); + frame.protect_var (warning_state); + + frame.protect_var (discard_error_messages); + frame.protect_var (discard_warning_messages); + + discard_error_messages = true; + discard_warning_messages = true; + + octave_value tmp = eval_string (prefix, true, parse_status); + + frame.run (); + + if (tmp.is_defined () && (tmp.is_map () || tmp.is_java ())) + names = tmp.map_keys (); + } + } + + return names; +} + +// FIXME -- this will have to be much smarter to work +// "correctly". + +bool +looks_like_struct (const std::string& text) +{ + bool retval = (! text.empty () + && text != "." + && text.find_first_of (file_ops::dir_sep_chars ()) == std::string::npos + && text.find ("..") == std::string::npos + && text.rfind ('.') != std::string::npos); + +#if 0 + symbol_record *sr = curr_sym_tab->lookup (text); + + if (sr && ! sr->is_function ()) + { + int parse_status; + + unwind_protect frame; + + frame.protect_var (discard_error_messages); + frame.protect_var (error_state); + + discard_error_messages = true; + + octave_value tmp = eval_string (text, true, parse_status); + + frame.run (); + + retval = (tmp.is_defined () && tmp.is_map ()); + } +#endif + + return retval; +} + +static octave_value +do_isglobal (const octave_value_list& args) +{ + octave_value retval = false; + + int nargin = args.length (); + + if (nargin != 1) + { + print_usage (); + return retval; + } + + std::string name = args(0).string_value (); + + if (error_state) + { + error ("isglobal: NAME must be a string"); + return retval; + } + + return symbol_table::is_global (name); +} + +DEFUN (isglobal, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isglobal (@var{name})\n\ +Return true if @var{name} is a globally visible variable.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +global x\n\ +isglobal (\"x\")\n\ + @result{} 1\n\ +@end group\n\ +@end example\n\ +@seealso{isvarname, exist}\n\ +@end deftypefn") +{ + return do_isglobal (args); +} + +static octave_value +safe_symbol_lookup (const std::string& symbol_name) +{ + octave_value retval; + + unwind_protect frame; + interpreter_try (frame); + + retval = symbol_table::find (symbol_name); + + error_state = 0; + + return retval; +} + +int +symbol_exist (const std::string& name, const std::string& type) +{ + int retval = 0; + + std::string struct_elts; + std::string symbol_name = name; + + size_t pos = name.find ('.'); + + if (pos != std::string::npos && pos > 0) + { + struct_elts = name.substr (pos+1); + symbol_name = name.substr (0, pos); + } + + // We shouldn't need to look in the global symbol table, since any + // name that is visible in the current scope will be in the local + // symbol table. + + octave_value val = safe_symbol_lookup (symbol_name); + + if (val.is_defined ()) + { + bool not_a_struct = struct_elts.empty (); + bool var_ok = not_a_struct /* || val.is_map_element (struct_elts) */; + + if (! retval + && var_ok + && (type == "any" || type == "var") + && (val.is_constant () || val.is_object () + || val.is_function_handle () + || val.is_anonymous_function () + || val.is_inline_function ())) + { + retval = 1; + } + + if (! retval + && (type == "any" || type == "builtin")) + { + if (not_a_struct && val.is_builtin_function ()) + { + retval = 5; + } + } + + if (! retval + && not_a_struct + && (type == "any" || type == "file") + && (val.is_user_function () || val.is_dld_function ())) + { + octave_function *f = val.function_value (true); + std::string s = f ? f->fcn_file_name () : std::string (); + + retval = s.empty () ? 103 : (val.is_user_function () ? 2 : 3); + } + } + + if (! (type == "var" || type == "builtin")) + { + if (! retval) + { + std::string file_name = lookup_autoload (name); + + if (file_name.empty ()) + file_name = load_path::find_fcn (name); + + size_t len = file_name.length (); + + if (len > 0) + { + if (type == "any" || type == "file") + { + if (len > 4 && (file_name.substr (len-4) == ".oct" + || file_name.substr (len-4) == ".mex")) + retval = 3; + else + retval = 2; + } + } + } + + if (! retval) + { + std::string file_name = file_in_path (name, ""); + + if (file_name.empty ()) + file_name = name; + + file_stat fs (file_name); + + if (fs) + { + if (type == "any" || type == "file") + retval = fs.is_dir () ? 7 : 2; + else if (type == "dir" && fs.is_dir ()) + retval = 7; + } + } + } + + return retval; +} + +#define GET_IDX(LEN) \ + static_cast ((LEN-1) * static_cast (rand ()) / RAND_MAX) + +std::string +unique_symbol_name (const std::string& basename) +{ + static const std::string alpha + = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"; + + static size_t len = alpha.length (); + + std::string nm = basename + alpha[GET_IDX (len)]; + + size_t pos = nm.length (); + + if (nm.substr (0, 2) == "__") + nm.append ("__"); + + while (symbol_exist (nm, "any")) + nm.insert (pos++, 1, alpha[GET_IDX (len)]); + + return nm; +} + +DEFUN (exist, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} exist (@var{name}, @var{type})\n\ +Return 1 if the name exists as a variable, 2 if the name is an\n\ +absolute file name, an ordinary file in Octave's @code{path}, or (after\n\ +appending @samp{.m}) a function file in Octave's @code{path}, 3 if the\n\ +name is a @samp{.oct} or @samp{.mex} file in Octave's @code{path},\n\ +5 if the name is a built-in function, 7 if the name is a directory, or 103\n\ +if the name is a function not associated with a file (entered on\n\ +the command line).\n\ +\n\ +Otherwise, return 0.\n\ +\n\ +This function also returns 2 if a regular file called @var{name}\n\ +exists in Octave's search path. If you want information about\n\ +other types of files, you should use some combination of the functions\n\ +@code{file_in_path} and @code{stat} instead.\n\ +\n\ +If the optional argument @var{type} is supplied, check only for\n\ +symbols of the specified type. Valid types are\n\ +\n\ +@table @asis\n\ +@item \"var\"\n\ +Check only for variables.\n\ +\n\ +@item \"builtin\"\n\ +Check only for built-in functions.\n\ +\n\ +@item \"file\"\n\ +Check only for files and directories.\n\ +\n\ +@item \"dir\"\n\ +Check only for directories.\n\ +@end table\n\ +\n\ +@seealso{file_in_loadpath, file_in_path, stat}\n\ +@end deftypefn") +{ + octave_value retval = false; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + std::string name = args(0).string_value (); + + if (! error_state) + { + std::string type + = (nargin == 2) ? args(1).string_value () : std::string ("any"); + + if (! error_state) + retval = symbol_exist (name, type); + else + error ("exist: TYPE must be a string"); + } + else + error ("exist: NAME must be a string"); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! if (isunix ()) +%! assert (exist ("/tmp") == 7); +%! assert (exist ("/tmp", "file") == 7); +%! assert (exist ("/tmp", "dir") == 7); +%! assert (exist ("/bin/sh") == 2); +%! assert (exist ("/bin/sh", "file") == 2); +%! assert (exist ("/bin/sh", "dir") == 0); +%! assert (exist ("/dev/null") == 2); +%! assert (exist ("/dev/null", "file") == 2); +%! assert (exist ("/dev/null", "dir") == 0); +%! endif +*/ + +octave_value +lookup_function_handle (const std::string& nm) +{ + octave_value val = symbol_table::varval (nm); + + return val.is_function_handle () ? val : octave_value (); +} + +octave_value +get_global_value (const std::string& nm, bool silent) +{ + octave_value val = symbol_table::global_varval (nm); + + if (val.is_undefined () && ! silent) + error ("get_global_value: undefined symbol '%s'", nm.c_str ()); + + return val; +} + +void +set_global_value (const std::string& nm, const octave_value& val) +{ + symbol_table::global_assign (nm, val); +} + +octave_value +get_top_level_value (const std::string& nm, bool silent) +{ + octave_value val = symbol_table::top_level_varval (nm); + + if (val.is_undefined () && ! silent) + error ("get_top_level_value: undefined symbol '%s'", nm.c_str ()); + + return val; +} + +void +set_top_level_value (const std::string& nm, const octave_value& val) +{ + symbol_table::top_level_assign (nm, val); +} + +// Variable values. + +static bool +wants_local_change (const octave_value_list& args, int& nargin) +{ + bool retval = false; + + if (nargin == 2) + { + if (args(1).is_string () && args(1).string_value () == "local") + { + nargin = 1; + retval = true; + } + else + { + error_with_cfn ("expecting second argument to be \"local\""); + nargin = 0; + } + } + + return retval; +} + +template +bool try_local_protect (T& var) +{ + octave_user_code *curr_usr_code = octave_call_stack::caller_user_code (); + octave_user_function *curr_usr_fcn = 0; + if (curr_usr_code && curr_usr_code->is_user_function ()) + curr_usr_fcn = dynamic_cast (curr_usr_code); + + if (curr_usr_fcn && curr_usr_fcn->local_protect (var)) + return true; + else + return false; +} + +octave_value +set_internal_variable (bool& var, const octave_value_list& args, + int nargout, const char *nm) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargout > 0 || nargin == 0) + retval = var; + + if (wants_local_change (args, nargin)) + { + if (! try_local_protect (var)) + warning ("\"local\" has no effect outside a function"); + } + + if (nargin == 1) + { + bool bval = args(0).bool_value (); + + if (! error_state) + var = bval; + else + error ("%s: expecting arg to be a logical value", nm); + } + else if (nargin > 1) + print_usage (); + + return retval; +} + +octave_value +set_internal_variable (char& var, const octave_value_list& args, + int nargout, const char *nm) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargout > 0 || nargin == 0) + retval = var; + + if (wants_local_change (args, nargin)) + { + if (! try_local_protect (var)) + warning ("\"local\" has no effect outside a function"); + } + + if (nargin == 1) + { + std::string sval = args(0).string_value (); + + if (! error_state) + { + switch (sval.length ()) + { + case 1: + var = sval[0]; + break; + + case 0: + var = '\0'; + break; + + default: + error ("%s: argument must be a single character", nm); + break; + } + } + else + error ("%s: argument must be a single character", nm); + } + else if (nargin > 1) + print_usage (); + + return retval; +} + +octave_value +set_internal_variable (int& var, const octave_value_list& args, + int nargout, const char *nm, + int minval, int maxval) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargout > 0 || nargin == 0) + retval = var; + + if (wants_local_change (args, nargin)) + { + if (! try_local_protect (var)) + warning ("\"local\" has no effect outside a function"); + } + + if (nargin == 1) + { + int ival = args(0).int_value (); + + if (! error_state) + { + if (ival < minval) + error ("%s: expecting arg to be greater than %d", nm, minval); + else if (ival > maxval) + error ("%s: expecting arg to be less than or equal to %d", + nm, maxval); + else + var = ival; + } + else + error ("%s: expecting arg to be an integer value", nm); + } + else if (nargin > 1) + print_usage (); + + return retval; +} + +octave_value +set_internal_variable (double& var, const octave_value_list& args, + int nargout, const char *nm, + double minval, double maxval) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargout > 0 || nargin == 0) + retval = var; + + if (wants_local_change (args, nargin)) + { + if (! try_local_protect (var)) + warning ("\"local\" has no effect outside a function"); + } + + if (nargin == 1) + { + double dval = args(0).scalar_value (); + + if (! error_state) + { + if (dval < minval) + error ("%s: expecting arg to be greater than %g", minval); + else if (dval > maxval) + error ("%s: expecting arg to be less than or equal to %g", maxval); + else + var = dval; + } + else + error ("%s: expecting arg to be a scalar value", nm); + } + else if (nargin > 1) + print_usage (); + + return retval; +} + +octave_value +set_internal_variable (std::string& var, const octave_value_list& args, + int nargout, const char *nm, bool empty_ok) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargout > 0 || nargin == 0) + retval = var; + + if (wants_local_change (args, nargin)) + { + if (! try_local_protect (var)) + warning ("\"local\" has no effect outside a function"); + } + + if (nargin == 1) + { + std::string sval = args(0).string_value (); + + if (! error_state) + { + if (empty_ok || ! sval.empty ()) + var = sval; + else + error ("%s: value must not be empty", nm); + } + else + error ("%s: expecting arg to be a character string", nm); + } + else if (nargin > 1) + print_usage (); + + return retval; +} + +octave_value +set_internal_variable (int& var, const octave_value_list& args, + int nargout, const char *nm, const char **choices) +{ + octave_value retval; + int nchoices = 0; + while (choices[nchoices] != 0) + nchoices++; + + int nargin = args.length (); + assert (var < nchoices); + + if (nargout > 0 || nargin == 0) + retval = choices[var]; + + if (wants_local_change (args, nargin)) + { + if (! try_local_protect (var)) + warning ("\"local\" has no effect outside a function"); + } + + if (nargin == 1) + { + std::string sval = args(0).string_value (); + + if (! error_state) + { + int i = 0; + for (; i < nchoices; i++) + { + if (sval == choices[i]) + { + var = i; + break; + } + } + if (i == nchoices) + error ("%s: value not allowed (\"%s\")", nm, sval.c_str ()); + } + else + error ("%s: expecting arg to be a character string", nm); + } + else if (nargin > 1) + print_usage (); + + return retval; +} + +struct +whos_parameter +{ + char command; + char modifier; + int parameter_length; + int first_parameter_length; + int balance; + std::string text; + std::string line; +}; + +static void +print_descriptor (std::ostream& os, std::list params) +{ + // This method prints a line of information on a given symbol + std::list::iterator i = params.begin (); + std::ostringstream param_buf; + + while (i != params.end ()) + { + whos_parameter param = *i; + + if (param.command != '\0') + { + // Do the actual printing + switch (param.modifier) + { + case 'l': + os << std::setiosflags (std::ios::left) << std::setw (param.parameter_length); + param_buf << std::setiosflags (std::ios::left) << std::setw (param.parameter_length); + break; + + case 'r': + os << std::setiosflags (std::ios::right) << std::setw (param.parameter_length); + param_buf << std::setiosflags (std::ios::right) << std::setw (param.parameter_length); + break; + + case 'c': + if (param.command != 's') + { + os << std::setiosflags (std::ios::left) + << std::setw (param.parameter_length); + param_buf << std::setiosflags (std::ios::left) + << std::setw (param.parameter_length); + } + break; + + default: + os << std::setiosflags (std::ios::left) << std::setw (param.parameter_length); + param_buf << std::setiosflags (std::ios::left) << std::setw (param.parameter_length); + } + + if (param.command == 's' && param.modifier == 'c') + { + int a, b; + + if (param.modifier == 'c') + { + a = param.first_parameter_length - param.balance; + a = (a < 0 ? 0 : a); + b = param.parameter_length - a - param.text . length (); + b = (b < 0 ? 0 : b); + os << std::setiosflags (std::ios::left) << std::setw (a) + << "" << std::resetiosflags (std::ios::left) << param.text + << std::setiosflags (std::ios::left) + << std::setw (b) << "" + << std::resetiosflags (std::ios::left); + param_buf << std::setiosflags (std::ios::left) << std::setw (a) + << "" << std::resetiosflags (std::ios::left) << param.line + << std::setiosflags (std::ios::left) + << std::setw (b) << "" + << std::resetiosflags (std::ios::left); + } + } + else + { + os << param.text; + param_buf << param.line; + } + os << std::resetiosflags (std::ios::left) + << std::resetiosflags (std::ios::right); + param_buf << std::resetiosflags (std::ios::left) + << std::resetiosflags (std::ios::right); + i++; + } + else + { + os << param.text; + param_buf << param.line; + i++; + } + } + + os << param_buf.str (); +} + +// FIXME -- This is a bit of a kluge. We'd like to just use val.dims() +// and if val is an object, expect that dims will call size if it is +// overloaded by a user-defined method. But there are currently some +// unresolved const issues that prevent that solution from working. + +std::string +get_dims_str (const octave_value& val) +{ + octave_value tmp = val; + + Matrix sz = tmp.size (); + + dim_vector dv = dim_vector::alloc (sz.numel ()); + + for (octave_idx_type i = 0; i < dv.length (); i++) + dv(i) = sz(i); + + return dv.str (); +} + +class +symbol_info_list +{ +private: + struct symbol_info + { + symbol_info (const symbol_table::symbol_record& sr, + const std::string& expr_str = std::string (), + const octave_value& expr_val = octave_value ()) + : name (expr_str.empty () ? sr.name () : expr_str), + varval (expr_val.is_undefined () ? sr.varval () : expr_val), + is_automatic (sr.is_automatic ()), + is_complex (varval.is_complex_type ()), + is_formal (sr.is_formal ()), + is_global (sr.is_global ()), + is_persistent (sr.is_persistent ()) + { } + + void display_line (std::ostream& os, + const std::list& params) const + { + std::string dims_str = get_dims_str (varval); + + std::list::const_iterator i = params.begin (); + + while (i != params.end ()) + { + whos_parameter param = *i; + + if (param.command != '\0') + { + // Do the actual printing. + + switch (param.modifier) + { + case 'l': + os << std::setiosflags (std::ios::left) + << std::setw (param.parameter_length); + break; + + case 'r': + os << std::setiosflags (std::ios::right) + << std::setw (param.parameter_length); + break; + + case 'c': + if (param.command == 's') + { + int front = param.first_parameter_length + - dims_str.find ('x'); + int back = param.parameter_length + - dims_str.length () + - front; + front = (front > 0) ? front : 0; + back = (back > 0) ? back : 0; + + os << std::setiosflags (std::ios::left) + << std::setw (front) + << "" + << std::resetiosflags (std::ios::left) + << dims_str + << std::setiosflags (std::ios::left) + << std::setw (back) + << "" + << std::resetiosflags (std::ios::left); + } + else + { + os << std::setiosflags (std::ios::left) + << std::setw (param.parameter_length); + } + break; + + default: + error ("whos_line_format: modifier '%c' unknown", + param.modifier); + + os << std::setiosflags (std::ios::right) + << std::setw (param.parameter_length); + } + + switch (param.command) + { + case 'a': + { + char tmp[6]; + + tmp[0] = (is_automatic ? 'a' : ' '); + tmp[1] = (is_complex ? 'c' : ' '); + tmp[2] = (is_formal ? 'f' : ' '); + tmp[3] = (is_global ? 'g' : ' '); + tmp[4] = (is_persistent ? 'p' : ' '); + tmp[5] = 0; + + os << tmp; + } + break; + + case 'b': + os << varval.byte_size (); + break; + + case 'c': + os << varval.class_name (); + break; + + case 'e': + os << varval.capacity (); + break; + + case 'n': + os << name; + break; + + case 's': + if (param.modifier != 'c') + os << dims_str; + break; + + case 't': + os << varval.type_name (); + break; + + default: + error ("whos_line_format: command '%c' unknown", + param.command); + } + + os << std::resetiosflags (std::ios::left) + << std::resetiosflags (std::ios::right); + i++; + } + else + { + os << param.text; + i++; + } + } + } + + std::string name; + octave_value varval; + bool is_automatic; + bool is_complex; + bool is_formal; + bool is_global; + bool is_persistent; + }; + +public: + symbol_info_list (void) : lst () { } + + symbol_info_list (const symbol_info_list& sil) : lst (sil.lst) { } + + symbol_info_list& operator = (const symbol_info_list& sil) + { + if (this != &sil) + lst = sil.lst; + + return *this; + } + + ~symbol_info_list (void) { } + + void append (const symbol_table::symbol_record& sr) + { + lst.push_back (symbol_info (sr)); + } + + void append (const symbol_table::symbol_record& sr, + const std::string& expr_str, + const octave_value& expr_val) + { + lst.push_back (symbol_info (sr, expr_str, expr_val)); + } + + size_t size (void) const { return lst.size (); } + + bool empty (void) const { return lst.empty (); } + + octave_map + map_value (const std::string& caller_function_name, int nesting_level) const + { + size_t len = lst.size (); + + Cell name_info (len, 1); + Cell size_info (len, 1); + Cell bytes_info (len, 1); + Cell class_info (len, 1); + Cell global_info (len, 1); + Cell sparse_info (len, 1); + Cell complex_info (len, 1); + Cell nesting_info (len, 1); + Cell persistent_info (len, 1); + + std::list::const_iterator p = lst.begin (); + + for (size_t j = 0; j < len; j++) + { + const symbol_info& si = *p++; + + octave_scalar_map ni; + + ni.assign ("function", caller_function_name); + ni.assign ("level", nesting_level); + + name_info(j) = si.name; + global_info(j) = si.is_global; + persistent_info(j) = si.is_persistent; + + octave_value val = si.varval; + + size_info(j) = val.size (); + bytes_info(j) = val.byte_size (); + class_info(j) = val.class_name (); + sparse_info(j) = val.is_sparse_type (); + complex_info(j) = val.is_complex_type (); + nesting_info(j) = ni; + } + + octave_map info; + + info.assign ("name", name_info); + info.assign ("size", size_info); + info.assign ("bytes", bytes_info); + info.assign ("class", class_info); + info.assign ("global", global_info); + info.assign ("sparse", sparse_info); + info.assign ("complex", complex_info); + info.assign ("nesting", nesting_info); + info.assign ("persistent", persistent_info); + + return info; + } + + void display (std::ostream& os) + { + if (! lst.empty ()) + { + size_t bytes = 0; + size_t elements = 0; + + std::list params = parse_whos_line_format (); + + print_descriptor (os, params); + + octave_stdout << "\n"; + + for (std::list::const_iterator p = lst.begin (); + p != lst.end (); p++) + { + p->display_line (os, params); + + octave_value val = p->varval; + + elements += val.capacity (); + bytes += val.byte_size (); + } + + os << "\nTotal is " << elements + << (elements == 1 ? " element" : " elements") + << " using " << bytes << (bytes == 1 ? " byte" : " bytes") + << "\n"; + } + } + + // Parse the string whos_line_format, and return a parameter list, + // containing all information needed to print the given + // attributtes of the symbols. + std::list parse_whos_line_format (void) + { + int idx; + size_t format_len = Vwhos_line_format.length (); + char garbage; + std::list params; + + size_t bytes1; + int elements1; + + std::string param_string = "abcenst"; + Array param_length (dim_vector (param_string.length (), 1)); + Array param_names (dim_vector (param_string.length (), 1)); + size_t pos_a, pos_b, pos_c, pos_e, pos_n, pos_s, pos_t; + + pos_a = param_string.find ('a'); // Attributes + pos_b = param_string.find ('b'); // Bytes + pos_c = param_string.find ('c'); // Class + pos_e = param_string.find ('e'); // Elements + pos_n = param_string.find ('n'); // Name + pos_s = param_string.find ('s'); // Size + pos_t = param_string.find ('t'); // Type + + param_names(pos_a) = "Attr"; + param_names(pos_b) = "Bytes"; + param_names(pos_c) = "Class"; + param_names(pos_e) = "Elements"; + param_names(pos_n) = "Name"; + param_names(pos_s) = "Size"; + param_names(pos_t) = "Type"; + + for (size_t i = 0; i < param_string.length (); i++) + param_length(i) = param_names(i).length (); + + // The attribute column needs size 5. + param_length(pos_a) = 5; + + // Calculating necessary spacing for name column, + // bytes column, elements column and class column + + for (std::list::const_iterator p = lst.begin (); + p != lst.end (); p++) + { + std::stringstream ss1, ss2; + std::string str; + + str = p->name; + param_length(pos_n) = ((str.length () + > static_cast (param_length(pos_n))) + ? str.length () : param_length(pos_n)); + + octave_value val = p->varval; + + str = val.type_name (); + param_length(pos_t) = ((str.length () + > static_cast (param_length(pos_t))) + ? str.length () : param_length(pos_t)); + + elements1 = val.capacity (); + ss1 << elements1; + str = ss1.str (); + param_length(pos_e) = ((str.length () + > static_cast (param_length(pos_e))) + ? str.length () : param_length(pos_e)); + + bytes1 = val.byte_size (); + ss2 << bytes1; + str = ss2.str (); + param_length(pos_b) = ((str.length () + > static_cast (param_length(pos_b))) + ? str.length () : param_length (pos_b)); + } + + idx = 0; + while (static_cast (idx) < format_len) + { + whos_parameter param; + param.command = '\0'; + + if (Vwhos_line_format[idx] == '%') + { + bool error_encountered = false; + param.modifier = 'r'; + param.parameter_length = 0; + + int a = 0, b = -1, balance = 1; + unsigned int items; + size_t pos; + std::string cmd; + + // Parse one command from whos_line_format + cmd = Vwhos_line_format.substr (idx, Vwhos_line_format.length ()); + pos = cmd.find (';'); + if (pos != std::string::npos) + cmd = cmd.substr (0, pos+1); + else + error ("parameter without ; in whos_line_format"); + + idx += cmd.length (); + + // FIXME -- use iostream functions instead of sscanf! + + if (cmd.find_first_of ("crl") != 1) + items = sscanf (cmd.c_str (), "%c%c:%d:%d:%d;", + &garbage, ¶m.command, &a, &b, &balance); + else + items = sscanf (cmd.c_str (), "%c%c%c:%d:%d:%d;", + &garbage, ¶m.modifier, ¶m.command, + &a, &b, &balance) - 1; + + if (items < 2) + { + error ("whos_line_format: parameter structure without command in whos_line_format"); + error_encountered = true; + } + + // Insert data into parameter + param.first_parameter_length = 0; + pos = param_string.find (param.command); + if (pos != std::string::npos) + { + param.parameter_length = param_length(pos); + param.text = param_names(pos); + param.line.assign (param_names(pos).length (), '='); + + param.parameter_length = (a > param.parameter_length + ? a : param.parameter_length); + if (param.command == 's' && param.modifier == 'c' && b > 0) + param.first_parameter_length = b; + } + else + { + error ("whos_line_format: '%c' is not a command", + param.command); + error_encountered = true; + } + + if (param.command == 's') + { + // Have to calculate space needed for printing + // matrix dimensions Space needed for Size column is + // hard to determine in prior, because it depends on + // dimensions to be shown. That is why it is + // recalculated for each Size-command int first, + // rest = 0, total; + int rest = 0; + int first = param.first_parameter_length; + int total = param.parameter_length; + + for (std::list::const_iterator p = lst.begin (); + p != lst.end (); p++) + { + octave_value val = p->varval; + std::string dims_str = get_dims_str (val); + int first1 = dims_str.find ('x'); + int total1 = dims_str.length (); + int rest1 = total1 - first1; + rest = (rest1 > rest ? rest1 : rest); + first = (first1 > first ? first1 : first); + total = (total1 > total ? total1 : total); + } + + if (param.modifier == 'c') + { + if (first < balance) + first += balance - first; + if (rest + balance < param.parameter_length) + rest += param.parameter_length - rest - balance; + + param.parameter_length = first + rest; + param.first_parameter_length = first; + param.balance = balance; + } + else + { + param.parameter_length = total; + param.first_parameter_length = 0; + } + } + else if (param.modifier == 'c') + { + error ("whos_line_format: modifier 'c' not available for command '%c'", + param.command); + error_encountered = true; + } + + // What happens if whos_line_format contains negative numbers + // at param_length positions? + param.balance = (b < 0 ? 0 : param.balance); + param.first_parameter_length = (b < 0 ? 0 : + param.first_parameter_length); + param.parameter_length = (a < 0 + ? 0 + : (param.parameter_length + < param_length(pos_s) + ? param_length(pos_s) + : param.parameter_length)); + + // Parameter will not be pushed into parameter list if ... + if (! error_encountered) + params.push_back (param); + } + else + { + // Text string, to be printed as it is ... + std::string text; + size_t pos; + text = Vwhos_line_format.substr (idx, Vwhos_line_format.length ()); + pos = text.find ('%'); + if (pos != std::string::npos) + text = text.substr (0, pos); + + // Push parameter into list ... + idx += text.length (); + param.text=text; + param.line.assign (text.length (), ' '); + params.push_back (param); + } + } + + return params; + } + +private: + std::list lst; + +}; + +static octave_value +do_who (int argc, const string_vector& argv, bool return_list, + bool verbose = false, std::string msg = std::string ()) +{ + octave_value retval; + + std::string my_name = argv[0]; + + bool global_only = false; + bool have_regexp = false; + + int i; + for (i = 1; i < argc; i++) + { + if (argv[i] == "-file") + { + // FIXME. This is an inefficient manner to implement this as the + // variables are loaded in to a temporary context and then treated. + // It would be better to refecat symbol_info_list to not store the + // symbol records and then use it in load-save.cc (do_load) to + // implement this option there so that the variables are never + // stored at all. + if (i == argc - 1) + error ("whos: -file argument must be followed by a file name"); + else + { + std::string nm = argv[i + 1]; + + unwind_protect frame; + + // Set up temporary scope. + + symbol_table::scope_id tmp_scope = symbol_table::alloc_scope (); + frame.add_fcn (symbol_table::erase_scope, tmp_scope); + + symbol_table::set_scope (tmp_scope); + + octave_call_stack::push (tmp_scope, 0); + frame.add_fcn (octave_call_stack::pop); + + frame.add_fcn (symbol_table::clear_variables); + + feval ("load", octave_value (nm), 0); + + if (! error_state) + { + std::string newmsg = std::string ("Variables in the file ") + + nm + ":\n\n"; + + retval = do_who (i, argv, return_list, verbose, newmsg); + } + } + + return retval; + } + else if (argv[i] == "-regexp") + have_regexp = true; + else if (argv[i] == "global") + global_only = true; + else if (argv[i][0] == '-') + warning ("%s: unrecognized option '%s'", my_name.c_str (), + argv[i].c_str ()); + else + break; + } + + int npats = argc - i; + string_vector pats; + if (npats > 0) + { + pats.resize (npats); + for (int j = 0; j < npats; j++) + pats[j] = argv[i+j]; + } + else + { + pats.resize (++npats); + pats[0] = "*"; + } + + symbol_info_list symbol_stats; + std::list symbol_names; + + for (int j = 0; j < npats; j++) + { + std::string pat = pats[j]; + + if (have_regexp) + { + std::list tmp = global_only + ? symbol_table::regexp_global_variables (pat) + : symbol_table::regexp_variables (pat); + + for (std::list::const_iterator p = tmp.begin (); + p != tmp.end (); p++) + { + if (p->is_variable ()) + { + if (verbose) + symbol_stats.append (*p); + else + symbol_names.push_back (p->name ()); + } + } + } + else + { + size_t pos = pat.find_first_of (".({"); + + if (pos != std::string::npos && pos > 0) + { + if (verbose) + { + // NOTE: we can only display information for + // expressions based on global values if the variable is + // global in the current scope because we currently have + // no way of looking up the base value in the global + // scope and then evaluating the arguments in the + // current scope. + + std::string base_name = pat.substr (0, pos); + + if (symbol_table::is_variable (base_name)) + { + symbol_table::symbol_record sr + = symbol_table::find_symbol (base_name); + + if (! global_only || sr.is_global ()) + { + int parse_status; + + octave_value expr_val + = eval_string (pat, true, parse_status); + + if (! error_state) + symbol_stats.append (sr, pat, expr_val); + else + return retval; + } + } + } + } + else + { + std::list tmp = global_only + ? symbol_table::glob_global_variables (pat) + : symbol_table::glob_variables (pat); + + for (std::list::const_iterator p = tmp.begin (); + p != tmp.end (); p++) + { + if (p->is_variable ()) + { + if (verbose) + symbol_stats.append (*p); + else + symbol_names.push_back (p->name ()); + } + } + } + } + } + + if (return_list) + { + if (verbose) + { + std::string caller_function_name; + octave_function *caller = octave_call_stack::caller (); + if (caller) + caller_function_name = caller->name (); + + retval = symbol_stats.map_value (caller_function_name, 1); + } + else + retval = Cell (string_vector (symbol_names)); + } + else if (! (symbol_stats.empty () && symbol_names.empty ())) + { + if (msg.length () == 0) + if (global_only) + octave_stdout << "Global variables:\n\n"; + else + octave_stdout << "Variables in the current scope:\n\n"; + else + octave_stdout << msg; + + if (verbose) + symbol_stats.display (octave_stdout); + else + { + string_vector names (symbol_names); + + names.list_in_columns (octave_stdout); + } + + octave_stdout << "\n"; + } + + return retval; +} + +DEFUN (who, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Command} {} who\n\ +@deftypefnx {Command} {} who pattern @dots{}\n\ +@deftypefnx {Command} {} who option pattern @dots{}\n\ +@deftypefnx {Command} {C =} who (\"pattern\", @dots{})\n\ +List currently defined variables matching the given patterns. Valid\n\ +pattern syntax is the same as described for the @code{clear} command.\n\ +If no patterns are supplied, all variables are listed.\n\ +By default, only variables visible in the local scope are displayed.\n\ +\n\ +The following are valid options but may not be combined.\n\ +\n\ +@table @code\n\ +@item global\n\ +List variables in the global scope rather than the current scope.\n\ +\n\ +@item -regexp\n\ +The patterns are considered to be regular expressions when matching the\n\ +variables to display. The same pattern syntax accepted by\n\ +the @code{regexp} function is used.\n\ +\n\ +@item -file\n\ +The next argument is treated as a filename. All variables found within the\n\ +specified file are listed. No patterns are accepted when reading variables\n\ +from a file.\n\ +@end table\n\ +\n\ +If called as a function, return a cell array of defined variable names\n\ +matching the given patterns.\n\ +@seealso{whos, isglobal, isvarname, exist, regexp}\n\ +@end deftypefn") +{ + octave_value retval; + + if (nargout < 2) + { + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("who"); + + if (! error_state) + retval = do_who (argc, argv, nargout == 1); + } + else + print_usage (); + + return retval; +} + +DEFUN (whos, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Command} {} whos\n\ +@deftypefnx {Command} {} whos pattern @dots{}\n\ +@deftypefnx {Command} {} whos option pattern @dots{}\n\ +@deftypefnx {Command} {S =} whos (\"pattern\", @dots{})\n\ +Provide detailed information on currently defined variables matching the\n\ +given patterns. Options and pattern syntax are the same as for the\n\ +@code{who} command. Extended information about each variable is\n\ +summarized in a table with the following default entries.\n\ +\n\ +@table @asis\n\ +@item Attr\n\ +Attributes of the listed variable. Possible attributes are:\n\ +\n\ +@table @asis\n\ +@item blank\n\ +Variable in local scope\n\ +\n\ +@item @code{a}\n\ +Automatic variable. An automatic variable is one created by the\n\ +interpreter, for example @code{argn}.\n\ +\n\ +@item @code{c}\n\ +Variable of complex type.\n\ +\n\ +@item @code{f}\n\ +Formal parameter (function argument).\n\ +\n\ +@item @code{g}\n\ +Variable with global scope.\n\ +\n\ +@item @code{p}\n\ +Persistent variable.\n\ +@end table\n\ +\n\ +@item Name\n\ +The name of the variable.\n\ +\n\ +@item Size\n\ +The logical size of the variable. A scalar is 1x1, a vector is\n\ +@nospell{1xN} or @nospell{Nx1}, a 2-D matrix is @nospell{MxN}.\n\ +\n\ +@item Bytes\n\ +The amount of memory currently used to store the variable.\n\ +\n\ +@item Class\n\ +The class of the variable. Examples include double, single, char, uint16,\n\ +cell, and struct.\n\ +@end table\n\ +\n\ +The table can be customized to display more or less information through\n\ +the function @code{whos_line_format}.\n\ +\n\ +If @code{whos} is called as a function, return a struct array of defined\n\ +variable names matching the given patterns. Fields in the structure\n\ +describing each variable are: name, size, bytes, class, global, sparse,\n\ +complex, nesting, persistent.\n\ +@seealso{who, whos_line_format}\n\ +@end deftypefn") +{ + octave_value retval; + + if (nargout < 2) + { + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("whos"); + + if (! error_state) + retval = do_who (argc, argv, nargout == 1, true); + } + else + print_usage (); + + return retval; +} + +// Defining variables. + +void +bind_ans (const octave_value& val, bool print) +{ + static std::string ans = "ans"; + + if (val.is_defined ()) + { + if (val.is_cs_list ()) + { + octave_value_list lst = val.list_value (); + + for (octave_idx_type i = 0; i < lst.length (); i++) + bind_ans (lst(i), print); + } + else + { + symbol_table::force_assign (ans, val); + + if (print) + val.print_with_name (octave_stdout, ans); + } + } +} + +void +bind_internal_variable (const std::string& fname, const octave_value& val) +{ + octave_value_list args; + + args(0) = val; + + feval (fname, args, 0); +} + +void +mlock (void) +{ + octave_function *fcn = octave_call_stack::current (); + + if (fcn) + fcn->lock (); + else + error ("mlock: invalid use outside a function"); +} + +void +munlock (const std::string& nm) +{ + octave_value val = symbol_table::find_function (nm); + + if (val.is_defined ()) + { + octave_function *fcn = val.function_value (); + + if (fcn) + fcn->unlock (); + } +} + +bool +mislocked (const std::string& nm) +{ + bool retval = false; + + octave_value val = symbol_table::find_function (nm); + + if (val.is_defined ()) + { + octave_function *fcn = val.function_value (); + + if (fcn) + retval = fcn->islocked (); + } + + return retval; +} + +DEFUN (mlock, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} mlock ()\n\ +Lock the current function into memory so that it can't be cleared.\n\ +@seealso{munlock, mislocked, persistent}\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 0) + { + octave_function *fcn = octave_call_stack::caller (); + + if (fcn) + fcn->lock (); + else + error ("mlock: invalid use outside a function"); + } + else + print_usage (); + + return retval; +} + +DEFUN (munlock, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} munlock ()\n\ +@deftypefnx {Built-in Function} {} munlock (@var{fcn})\n\ +Unlock the named function @var{fcn}. If no function is named\n\ +then unlock the current function.\n\ +@seealso{mlock, mislocked, persistent}\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + std::string name = args(0).string_value (); + + if (! error_state) + munlock (name); + else + error ("munlock: FCN must be a string"); + } + else if (args.length () == 0) + { + octave_function *fcn = octave_call_stack::caller (); + + if (fcn) + fcn->unlock (); + else + error ("munlock: invalid use outside a function"); + } + else + print_usage (); + + return retval; +} + + +DEFUN (mislocked, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} mislocked ()\n\ +@deftypefnx {Built-in Function} {} mislocked (@var{fcn})\n\ +Return true if the named function @var{fcn} is locked. If no function is\n\ +named then return true if the current function is locked.\n\ +@seealso{mlock, munlock, persistent}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + { + std::string name = args(0).string_value (); + + if (! error_state) + retval = mislocked (name); + else + error ("mislocked: FCN must be a string"); + } + else if (args.length () == 0) + { + octave_function *fcn = octave_call_stack::caller (); + + if (fcn) + retval = fcn->islocked (); + else + error ("mislocked: invalid use outside a function"); + } + else + print_usage (); + + return retval; +} + +// Deleting names from the symbol tables. + +static inline bool +name_matches_any_pattern (const std::string& nm, const string_vector& argv, + int argc, int idx, bool have_regexp = false) +{ + bool retval = false; + + for (int k = idx; k < argc; k++) + { + std::string patstr = argv[k]; + if (! patstr.empty ()) + { + if (have_regexp) + { + if (is_regexp_match (patstr, nm)) + { + retval = true; + break; + } + } + else + { + glob_match pattern (patstr); + + if (pattern.match (nm)) + { + retval = true; + break; + } + } + } + } + + return retval; +} + +static inline void +maybe_warn_exclusive (bool exclusive) +{ + if (exclusive) + warning ("clear: ignoring --exclusive option"); +} + +static void +do_clear_functions (const string_vector& argv, int argc, int idx, + bool exclusive = false) +{ + if (idx == argc) + symbol_table::clear_functions (); + else + { + if (exclusive) + { + string_vector fcns = symbol_table::user_function_names (); + + int fcount = fcns.length (); + + for (int i = 0; i < fcount; i++) + { + std::string nm = fcns[i]; + + if (! name_matches_any_pattern (nm, argv, argc, idx)) + symbol_table::clear_function (nm); + } + } + else + { + while (idx < argc) + symbol_table::clear_function_pattern (argv[idx++]); + } + } +} + +static void +do_clear_globals (const string_vector& argv, int argc, int idx, + bool exclusive = false) +{ + if (idx == argc) + { + string_vector gvars = symbol_table::global_variable_names (); + + int gcount = gvars.length (); + + for (int i = 0; i < gcount; i++) + symbol_table::clear_global (gvars[i]); + } + else + { + if (exclusive) + { + string_vector gvars = symbol_table::global_variable_names (); + + int gcount = gvars.length (); + + for (int i = 0; i < gcount; i++) + { + std::string nm = gvars[i]; + + if (! name_matches_any_pattern (nm, argv, argc, idx)) + symbol_table::clear_global (nm); + } + } + else + { + while (idx < argc) + symbol_table::clear_global_pattern (argv[idx++]); + } + } +} + +static void +do_clear_variables (const string_vector& argv, int argc, int idx, + bool exclusive = false, bool have_regexp = false) +{ + if (idx == argc) + symbol_table::clear_variables (); + else + { + if (exclusive) + { + string_vector lvars = symbol_table::variable_names (); + + int lcount = lvars.length (); + + for (int i = 0; i < lcount; i++) + { + std::string nm = lvars[i]; + + if (! name_matches_any_pattern (nm, argv, argc, idx, have_regexp)) + symbol_table::clear_variable (nm); + } + } + else + { + if (have_regexp) + while (idx < argc) + symbol_table::clear_variable_regexp (argv[idx++]); + else + while (idx < argc) + symbol_table::clear_variable_pattern (argv[idx++]); + } + } +} + +static void +do_clear_symbols (const string_vector& argv, int argc, int idx, + bool exclusive = false) +{ + if (idx == argc) + symbol_table::clear_variables (); + else + { + if (exclusive) + { + // FIXME -- is this really what we want, or do we + // somehow want to only clear the functions that are not + // shadowed by local variables? It seems that would be a + // bit harder to do. + + do_clear_variables (argv, argc, idx, exclusive); + do_clear_functions (argv, argc, idx, exclusive); + } + else + { + while (idx < argc) + symbol_table::clear_symbol_pattern (argv[idx++]); + } + } +} + +static void +do_matlab_compatible_clear (const string_vector& argv, int argc, int idx) +{ + // This is supposed to be mostly Matlab compatible. + + for (; idx < argc; idx++) + { + if (argv[idx] == "all" + && ! symbol_table::is_local_variable ("all")) + { + symbol_table::clear_all (); + } + else if (argv[idx] == "functions" + && ! symbol_table::is_local_variable ("functions")) + { + do_clear_functions (argv, argc, ++idx); + } + else if (argv[idx] == "global" + && ! symbol_table::is_local_variable ("global")) + { + do_clear_globals (argv, argc, ++idx); + } + else if (argv[idx] == "variables" + && ! symbol_table::is_local_variable ("variables")) + { + symbol_table::clear_variables (); + } + else if (argv[idx] == "classes" + && ! symbol_table::is_local_variable ("classes")) + { + symbol_table::clear_objects (); + octave_class::clear_exemplar_map (); + } + else + { + symbol_table::clear_symbol_pattern (argv[idx]); + } + } +} + +#define CLEAR_OPTION_ERROR(cond) \ + do \ + { \ + if (cond) \ + { \ + print_usage (); \ + return retval; \ + } \ + } \ + while (0) + +DEFUN (clear, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} clear [options] pattern @dots{}\n\ +Delete the names matching the given patterns from the symbol table. The\n\ +pattern may contain the following special characters:\n\ +\n\ +@table @code\n\ +@item ?\n\ +Match any single character.\n\ +\n\ +@item *\n\ +Match zero or more characters.\n\ +\n\ +@item [ @var{list} ]\n\ +Match the list of characters specified by @var{list}. If the first\n\ +character is @code{!} or @code{^}, match all characters except those\n\ +specified by @var{list}. For example, the pattern @samp{[a-zA-Z]} will\n\ +match all lowercase and uppercase alphabetic characters.\n\ +@end table\n\ +\n\ +For example, the command\n\ +\n\ +@example\n\ +clear foo b*r\n\ +@end example\n\ +\n\ +@noindent\n\ +clears the name @code{foo} and all names that begin with the letter\n\ +@code{b} and end with the letter @code{r}.\n\ +\n\ +If @code{clear} is called without any arguments, all user-defined\n\ +variables (local and global) are cleared from the symbol table. If\n\ +@code{clear} is called with at least one argument, only the visible\n\ +names matching the arguments are cleared. For example, suppose you have\n\ +defined a function @code{foo}, and then hidden it by performing the\n\ +assignment @code{foo = 2}. Executing the command @kbd{clear foo} once\n\ +will clear the variable definition and restore the definition of\n\ +@code{foo} as a function. Executing @kbd{clear foo} a second time will\n\ +clear the function definition.\n\ +\n\ +The following options are available in both long and short form\n\ +\n\ +@table @code\n\ +@item -all, -a\n\ +Clears all local and global user-defined variables and all functions\n\ +from the symbol table.\n\ +\n\ +@item -exclusive, -x\n\ +Clears the variables that don't match the following pattern.\n\ +\n\ +@item -functions, -f\n\ +Clears the function names and the built-in symbols names.\n\ +\n\ +@item -global, -g\n\ +Clears the global symbol names.\n\ +\n\ +@item -variables, -v\n\ +Clears the local variable names.\n\ +\n\ +@item -classes, -c\n\ +Clears the class structure table and clears all objects.\n\ +\n\ +@item -regexp, -r\n\ +The arguments are treated as regular expressions as any variables that\n\ +match will be cleared.\n\ +@end table\n\ +\n\ +With the exception of @code{exclusive}, all long options can be used\n\ +without the dash as well.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("clear"); + + if (! error_state) + { + if (argc == 1) + { + do_clear_globals (argv, argc, true); + do_clear_variables (argv, argc, true); + + octave_link::clear_workspace (); + } + else + { + int idx = 0; + + bool clear_all = false; + bool clear_functions = false; + bool clear_globals = false; + bool clear_variables = false; + bool clear_objects = false; + bool exclusive = false; + bool have_regexp = false; + bool have_dash_option = false; + + while (++idx < argc) + { + if (argv[idx] == "-all" || argv[idx] == "-a") + { + CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); + + have_dash_option = true; + clear_all = true; + } + else if (argv[idx] == "-exclusive" || argv[idx] == "-x") + { + have_dash_option = true; + exclusive = true; + } + else if (argv[idx] == "-functions" || argv[idx] == "-f") + { + CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); + + have_dash_option = true; + clear_functions = true; + } + else if (argv[idx] == "-global" || argv[idx] == "-g") + { + CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); + + have_dash_option = true; + clear_globals = true; + } + else if (argv[idx] == "-variables" || argv[idx] == "-v") + { + CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); + + have_dash_option = true; + clear_variables = true; + } + else if (argv[idx] == "-classes" || argv[idx] == "-c") + { + CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); + + have_dash_option = true; + clear_objects = true; + } + else if (argv[idx] == "-regexp" || argv[idx] == "-r") + { + CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); + + have_dash_option = true; + have_regexp = true; + } + else + break; + } + + if (idx <= argc) + { + if (! have_dash_option) + { + do_matlab_compatible_clear (argv, argc, idx); + } + else + { + if (clear_all) + { + maybe_warn_exclusive (exclusive); + + if (++idx < argc) + warning + ("clear: ignoring extra arguments after -all"); + + symbol_table::clear_all (); + } + else if (have_regexp) + { + do_clear_variables (argv, argc, idx, exclusive, true); + } + else if (clear_functions) + { + do_clear_functions (argv, argc, idx, exclusive); + } + else if (clear_globals) + { + do_clear_globals (argv, argc, idx, exclusive); + } + else if (clear_variables) + { + do_clear_variables (argv, argc, idx, exclusive); + } + else if (clear_objects) + { + symbol_table::clear_objects (); + octave_class::clear_exemplar_map (); + } + else + { + do_clear_symbols (argv, argc, idx, exclusive); + } + } + + octave_link::set_workspace (); + } + } + } + + return retval; +} + +DEFUN (whos_line_format, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} whos_line_format ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} whos_line_format (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} whos_line_format (@var{new_val}, \"local\")\n\ +Query or set the format string used by the command @code{whos}.\n\ +\n\ +A full format string is:\n\ +@c Set example in small font to prevent overfull line\n\ +\n\ +@smallexample\n\ +%[modifier][:width[:left-min[:balance]]];\n\ +@end smallexample\n\ +\n\ +The following command sequences are available:\n\ +\n\ +@table @code\n\ +@item %a\n\ +Prints attributes of variables (g=global, p=persistent,\n\ +f=formal parameter, a=automatic variable).\n\ +\n\ +@item %b\n\ +Prints number of bytes occupied by variables.\n\ +\n\ +@item %c\n\ +Prints class names of variables.\n\ +\n\ +@item %e\n\ +Prints elements held by variables.\n\ +\n\ +@item %n\n\ +Prints variable names.\n\ +\n\ +@item %s\n\ +Prints dimensions of variables.\n\ +\n\ +@item %t\n\ +Prints type names of variables.\n\ +@end table\n\ +\n\ +Every command may also have an alignment modifier:\n\ +\n\ +@table @code\n\ +@item l\n\ +Left alignment.\n\ +\n\ +@item r\n\ +Right alignment (default).\n\ +\n\ +@item c\n\ +Column-aligned (only applicable to command %s).\n\ +@end table\n\ +\n\ +The @code{width} parameter is a positive integer specifying the minimum\n\ +number of columns used for printing. No maximum is needed as the field will\n\ +auto-expand as required.\n\ +\n\ +The parameters @code{left-min} and @code{balance} are only available when the\n\ +column-aligned modifier is used with the command @samp{%s}.\n\ +@code{balance} specifies the column number within the field width which will\n\ +be aligned between entries. Numbering starts from 0 which indicates the\n\ +leftmost column. @code{left-min} specifies the minimum field width to the\n\ +left of the specified balance column.\n\ +\n\ +The default format is\n\ +@code{\" %a:4; %ln:6; %cs:16:6:1; %rb:12; %lc:-1;\\n\"}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{whos}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (whos_line_format); +} + +static std::string Vmissing_function_hook = "__unimplemented__"; + +DEFUN (missing_function_hook, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} missing_function_hook ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} missing_function_hook (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} missing_function_hook (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the function to call when\n\ +an unknown identifier is requested.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (missing_function_hook); +} + +void maybe_missing_function_hook (const std::string& name) +{ + // Don't do this if we're handling errors. + if (buffer_error_messages == 0 && ! Vmissing_function_hook.empty ()) + { + octave_value val = symbol_table::find_function (Vmissing_function_hook); + + if (val.is_defined ()) + { + // Ensure auto-restoration. + unwind_protect frame; + frame.protect_var (Vmissing_function_hook); + + // Clear the variable prior to calling the function. + const std::string func_name = Vmissing_function_hook; + Vmissing_function_hook.clear (); + + // Call. + feval (func_name, octave_value (name)); + } + } +} + +DEFUN (__varval__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __varval__ (@var{name})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + { + std::string name = args(0).string_value (); + + if (! error_state) + retval = symbol_table::varval (args(0).string_value ()); + else + error ("__varval__: expecting argument to be variable name"); + } + else + print_usage (); + + return retval; +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/variables.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/variables.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,152 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_variables_h) +#define octave_variables_h 1 + +class octave_function; +class octave_user_function; + +class tree_identifier; +class octave_value; +class octave_value_list; +class octave_builtin; +class string_vector; + +#include + +#include +#include + +#include "lo-ieee.h" + +#include "ov.h" +#include "ov-builtin.h" +#include "symtab.h" + +extern OCTINTERP_API void clear_mex_functions (void); + +extern OCTINTERP_API octave_function * +is_valid_function (const octave_value&, const std::string& = std::string (), + bool warn = false); + +extern OCTINTERP_API octave_function * +is_valid_function (const std::string&, const std::string& = std::string (), + bool warn = false); + +extern OCTINTERP_API octave_function * +extract_function (const octave_value& arg, const std::string& warn_for, + const std::string& fname, const std::string& header, + const std::string& trailer); + +extern OCTINTERP_API string_vector +get_struct_elts (const std::string& text); + +extern OCTINTERP_API string_vector +generate_struct_completions (const std::string& text, std::string& prefix, + std::string& hint); + +extern OCTINTERP_API bool +looks_like_struct (const std::string& text); + +extern OCTINTERP_API int +symbol_exist (const std::string& name, const std::string& type = "any"); + +extern OCTINTERP_API std::string +unique_symbol_name (const std::string& basename); + +extern OCTINTERP_API octave_value lookup_function_handle (const std::string& nm); + +extern OCTINTERP_API octave_value +get_global_value (const std::string& nm, bool silent = false); + +extern OCTINTERP_API void +set_global_value (const std::string& nm, const octave_value& val); + +extern OCTINTERP_API octave_value +get_top_level_value (const std::string& nm, bool silent = false); + +extern OCTINTERP_API void +set_top_level_value (const std::string& nm, const octave_value& val); + +extern OCTINTERP_API octave_value +set_internal_variable (bool& var, const octave_value_list& args, + int nargout, const char *nm); + +extern OCTINTERP_API octave_value +set_internal_variable (char& var, const octave_value_list& args, + int nargout, const char *nm); + +extern OCTINTERP_API octave_value +set_internal_variable (int& var, const octave_value_list& args, + int nargout, const char *nm, + int minval = std::numeric_limits::min (), + int maxval = std::numeric_limits::max ()); + +extern OCTINTERP_API octave_value +set_internal_variable (double& var, const octave_value_list& args, + int nargout, const char *nm, + double minval = -octave_Inf, + double maxval = octave_Inf); + +extern OCTINTERP_API octave_value +set_internal_variable (std::string& var, const octave_value_list& args, + int nargout, const char *nm, bool empty_ok = true); + +extern OCTINTERP_API octave_value +set_internal_variable (int& var, const octave_value_list& args, + int nargout, const char *nm, const char **choices); + +#define SET_INTERNAL_VARIABLE(NM) \ + set_internal_variable (V ## NM, args, nargout, #NM) + +#define SET_NONEMPTY_INTERNAL_STRING_VARIABLE(NM) \ + set_internal_variable (V ## NM, args, nargout, #NM, false) + +#define SET_INTERNAL_VARIABLE_WITH_LIMITS(NM, MINVAL, MAXVAL) \ + set_internal_variable (V ## NM, args, nargout, #NM, MINVAL, MAXVAL) + +// in the following, CHOICES must be a C string array terminated by null. +#define SET_INTERNAL_VARIABLE_CHOICES(NM, CHOICES) \ + set_internal_variable (V ## NM, args, nargout, #NM, CHOICES) + +extern OCTINTERP_API std::string builtin_string_variable (const std::string&); +extern OCTINTERP_API int builtin_real_scalar_variable (const std::string&, double&); +extern OCTINTERP_API octave_value builtin_any_variable (const std::string&); + +extern OCTINTERP_API void bind_ans (const octave_value& val, bool print); + +extern OCTINTERP_API void +bind_internal_variable (const std::string& fname, + const octave_value& val) GCC_ATTR_DEPRECATED; + +extern OCTINTERP_API void mlock (void); +extern OCTINTERP_API void munlock (const std::string&); +extern OCTINTERP_API bool mislocked (const std::string&); + +extern OCTINTERP_API void clear_function (const std::string& nm); +extern OCTINTERP_API void clear_variable (const std::string& nm); +extern OCTINTERP_API void clear_symbol (const std::string& nm); + +extern OCTINTERP_API void maybe_missing_function_hook (const std::string& name); + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/workspace-element.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/workspace-element.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,84 @@ +/* + +Copyright (C) 2013 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_workspace_element_h) +#define octave_workspace_element_h 1 + +#include + +class workspace_element +{ +public: + + workspace_element (char scope_arg = 'l', + const std::string& symbol_arg = "", + const std::string& class_name_arg = "", + const std::string& value_arg = "", + const std::string& dimension_arg = "") + : xscope (scope_arg), xsymbol (symbol_arg), + xclass_name (class_name_arg), xvalue (value_arg), + xdimension (dimension_arg) + { } + + workspace_element (const workspace_element& ws_elt) + : xscope (ws_elt.xscope), xsymbol (ws_elt.xsymbol), + xclass_name (ws_elt.xclass_name), xvalue (ws_elt.xvalue), + xdimension (ws_elt.xdimension) + { } + + workspace_element operator = (const workspace_element& ws_elt) + { + if (this != &ws_elt) + { + xscope = ws_elt.xscope; + xsymbol = ws_elt.xsymbol; + xclass_name = ws_elt.xclass_name; + xvalue = ws_elt.xvalue; + xdimension = ws_elt.xdimension; + } + + return *this; + } + + ~workspace_element (void) { } + + char scope (void) const { return xscope; } + + std::string symbol (void) const { return xsymbol; } + + std::string class_name (void) const { return xclass_name; } + + std::string value (void) const { return xvalue; } + + std::string dimension (void) const { return xdimension; } + +private: + + // [g]lobal, [p]ersistent, [l]ocal + char xscope; + std::string xsymbol; + std::string xclass_name; + std::string xvalue; + std::string xdimension; +}; + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/xdiv.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/xdiv.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,1000 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton +Copyright (C) 2008 Jaroslav Hajek +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "Array-util.h" +#include "CMatrix.h" +#include "dMatrix.h" +#include "CNDArray.h" +#include "dNDArray.h" +#include "fCMatrix.h" +#include "fMatrix.h" +#include "fCNDArray.h" +#include "fNDArray.h" +#include "oct-cmplx.h" +#include "dDiagMatrix.h" +#include "fDiagMatrix.h" +#include "CDiagMatrix.h" +#include "fCDiagMatrix.h" +#include "quit.h" + +#include "error.h" +#include "xdiv.h" + +static inline bool +result_ok (octave_idx_type info) +{ + assert (info != -1); + + return (info != -2); +} + +static void +solve_singularity_warning (double rcond) +{ + warning_with_id ("Octave:singular-matrix-div", + "matrix singular to machine precision, rcond = %g", rcond); +} + +template +bool +mx_leftdiv_conform (const T1& a, const T2& b, blas_trans_type blas_trans) +{ + octave_idx_type a_nr = blas_trans == blas_no_trans ? a.rows () : a.cols (); + octave_idx_type b_nr = b.rows (); + + if (a_nr != b_nr) + { + octave_idx_type a_nc = blas_trans == blas_no_trans ? a.cols () : a.rows (); + octave_idx_type b_nc = b.cols (); + + gripe_nonconformant ("operator \\", a_nr, a_nc, b_nr, b_nc); + return false; + } + + return true; +} + +#define INSTANTIATE_MX_LEFTDIV_CONFORM(T1, T2) \ + template bool mx_leftdiv_conform (const T1&, const T2&, blas_trans_type) + +INSTANTIATE_MX_LEFTDIV_CONFORM (Matrix, Matrix); +INSTANTIATE_MX_LEFTDIV_CONFORM (Matrix, ComplexMatrix); +INSTANTIATE_MX_LEFTDIV_CONFORM (ComplexMatrix, Matrix); +INSTANTIATE_MX_LEFTDIV_CONFORM (ComplexMatrix, ComplexMatrix); + +template +bool +mx_div_conform (const T1& a, const T2& b) +{ + octave_idx_type a_nc = a.cols (); + octave_idx_type b_nc = b.cols (); + + if (a_nc != b_nc) + { + octave_idx_type a_nr = a.rows (); + octave_idx_type b_nr = b.rows (); + + gripe_nonconformant ("operator /", a_nr, a_nc, b_nr, b_nc); + return false; + } + + return true; +} + +#define INSTANTIATE_MX_DIV_CONFORM(T1, T2) \ + template bool mx_div_conform (const T1&, const T2&) + +INSTANTIATE_MX_DIV_CONFORM (Matrix, Matrix); +INSTANTIATE_MX_DIV_CONFORM (Matrix, ComplexMatrix); +INSTANTIATE_MX_DIV_CONFORM (ComplexMatrix, Matrix); +INSTANTIATE_MX_DIV_CONFORM (ComplexMatrix, ComplexMatrix); + +// Right division functions. +// +// op2 / op1: m cm +// +-- +---+----+ +// matrix | 1 | 3 | +// +---+----+ +// complex_matrix | 2 | 4 | +// +---+----+ + +// -*- 1 -*- +Matrix +xdiv (const Matrix& a, const Matrix& b, MatrixType &typ) +{ + if (! mx_div_conform (a, b)) + return Matrix (); + + octave_idx_type info; + double rcond = 0.0; + + Matrix result + = b.solve (typ, a.transpose (), info, rcond, + solve_singularity_warning, true, blas_trans); + + return result.transpose (); +} + +// -*- 2 -*- +ComplexMatrix +xdiv (const Matrix& a, const ComplexMatrix& b, MatrixType &typ) +{ + if (! mx_div_conform (a, b)) + return ComplexMatrix (); + + octave_idx_type info; + double rcond = 0.0; + + ComplexMatrix result + = b.solve (typ, a.transpose (), info, rcond, + solve_singularity_warning, true, blas_trans); + + return result.transpose (); +} + +// -*- 3 -*- +ComplexMatrix +xdiv (const ComplexMatrix& a, const Matrix& b, MatrixType &typ) +{ + if (! mx_div_conform (a, b)) + return ComplexMatrix (); + + octave_idx_type info; + double rcond = 0.0; + + ComplexMatrix result + = b.solve (typ, a.transpose (), info, rcond, + solve_singularity_warning, true, blas_trans); + + return result.transpose (); +} + +// -*- 4 -*- +ComplexMatrix +xdiv (const ComplexMatrix& a, const ComplexMatrix& b, MatrixType &typ) +{ + if (! mx_div_conform (a, b)) + return ComplexMatrix (); + + octave_idx_type info; + double rcond = 0.0; + + ComplexMatrix result + = b.solve (typ, a.transpose (), info, rcond, + solve_singularity_warning, true, blas_trans); + + return result.transpose (); +} + +// Funny element by element division operations. +// +// op2 \ op1: s cs +// +-- +---+----+ +// matrix | 1 | 3 | +// +---+----+ +// complex_matrix | 2 | 4 | +// +---+----+ + +Matrix +x_el_div (double a, const Matrix& b) +{ + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.columns (); + + Matrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = a / b (i, j); + } + + return result; +} + +ComplexMatrix +x_el_div (double a, const ComplexMatrix& b) +{ + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.columns (); + + ComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = a / b (i, j); + } + + return result; +} + +ComplexMatrix +x_el_div (const Complex a, const Matrix& b) +{ + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.columns (); + + ComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = a / b (i, j); + } + + return result; +} + +ComplexMatrix +x_el_div (const Complex a, const ComplexMatrix& b) +{ + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.columns (); + + ComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = a / b (i, j); + } + + return result; +} + +// Funny element by element division operations. +// +// op2 \ op1: s cs +// +-- +---+----+ +// N-d array | 1 | 3 | +// +---+----+ +// complex N-d array | 2 | 4 | +// +---+----+ + +NDArray +x_el_div (double a, const NDArray& b) +{ + NDArray result (b.dims ()); + + for (octave_idx_type i = 0; i < b.length (); i++) + { + octave_quit (); + result (i) = a / b (i); + } + + return result; +} + +ComplexNDArray +x_el_div (double a, const ComplexNDArray& b) +{ + ComplexNDArray result (b.dims ()); + + for (octave_idx_type i = 0; i < b.length (); i++) + { + octave_quit (); + result (i) = a / b (i); + } + + return result; +} + +ComplexNDArray +x_el_div (const Complex a, const NDArray& b) +{ + ComplexNDArray result (b.dims ()); + + for (octave_idx_type i = 0; i < b.length (); i++) + { + octave_quit (); + result (i) = a / b (i); + } + + return result; +} + +ComplexNDArray +x_el_div (const Complex a, const ComplexNDArray& b) +{ + ComplexNDArray result (b.dims ()); + + for (octave_idx_type i = 0; i < b.length (); i++) + { + octave_quit (); + result (i) = a / b (i); + } + + return result; +} + +// Left division functions. +// +// op2 \ op1: m cm +// +-- +---+----+ +// matrix | 1 | 3 | +// +---+----+ +// complex_matrix | 2 | 4 | +// +---+----+ + +// -*- 1 -*- +Matrix +xleftdiv (const Matrix& a, const Matrix& b, MatrixType &typ, blas_trans_type transt) +{ + if (! mx_leftdiv_conform (a, b, transt)) + return Matrix (); + + octave_idx_type info; + double rcond = 0.0; + return a.solve (typ, b, info, rcond, solve_singularity_warning, true, transt); +} + +// -*- 2 -*- +ComplexMatrix +xleftdiv (const Matrix& a, const ComplexMatrix& b, MatrixType &typ, blas_trans_type transt) +{ + if (! mx_leftdiv_conform (a, b, transt)) + return ComplexMatrix (); + + octave_idx_type info; + double rcond = 0.0; + + return a.solve (typ, b, info, rcond, solve_singularity_warning, true, transt); +} + +// -*- 3 -*- +ComplexMatrix +xleftdiv (const ComplexMatrix& a, const Matrix& b, MatrixType &typ, blas_trans_type transt) +{ + if (! mx_leftdiv_conform (a, b, transt)) + return ComplexMatrix (); + + octave_idx_type info; + double rcond = 0.0; + return a.solve (typ, b, info, rcond, solve_singularity_warning, true, transt); +} + +// -*- 4 -*- +ComplexMatrix +xleftdiv (const ComplexMatrix& a, const ComplexMatrix& b, MatrixType &typ, blas_trans_type transt) +{ + if (! mx_leftdiv_conform (a, b, transt)) + return ComplexMatrix (); + + octave_idx_type info; + double rcond = 0.0; + return a.solve (typ, b, info, rcond, solve_singularity_warning, true, transt); +} + +static void +solve_singularity_warning (float rcond) +{ + warning ("matrix singular to machine precision, rcond = %g", rcond); + warning ("attempting to find minimum norm solution"); +} + +INSTANTIATE_MX_LEFTDIV_CONFORM (FloatMatrix, FloatMatrix); +INSTANTIATE_MX_LEFTDIV_CONFORM (FloatMatrix, FloatComplexMatrix); +INSTANTIATE_MX_LEFTDIV_CONFORM (FloatComplexMatrix, FloatMatrix); +INSTANTIATE_MX_LEFTDIV_CONFORM (FloatComplexMatrix, FloatComplexMatrix); + +INSTANTIATE_MX_DIV_CONFORM (FloatMatrix, FloatMatrix); +INSTANTIATE_MX_DIV_CONFORM (FloatMatrix, FloatComplexMatrix); +INSTANTIATE_MX_DIV_CONFORM (FloatComplexMatrix, FloatMatrix); +INSTANTIATE_MX_DIV_CONFORM (FloatComplexMatrix, FloatComplexMatrix); + +// Right division functions. +// +// op2 / op1: m cm +// +-- +---+----+ +// matrix | 1 | 3 | +// +---+----+ +// complex_matrix | 2 | 4 | +// +---+----+ + +// -*- 1 -*- +FloatMatrix +xdiv (const FloatMatrix& a, const FloatMatrix& b, MatrixType &typ) +{ + if (! mx_div_conform (a, b)) + return FloatMatrix (); + + octave_idx_type info; + float rcond = 0.0; + + FloatMatrix result + = b.solve (typ, a.transpose (), info, rcond, + solve_singularity_warning, true, blas_trans); + + return result.transpose (); +} + +// -*- 2 -*- +FloatComplexMatrix +xdiv (const FloatMatrix& a, const FloatComplexMatrix& b, MatrixType &typ) +{ + if (! mx_div_conform (a, b)) + return FloatComplexMatrix (); + + octave_idx_type info; + float rcond = 0.0; + + FloatComplexMatrix result + = b.solve (typ, a.transpose (), info, rcond, + solve_singularity_warning, true, blas_trans); + + return result.transpose (); +} + +// -*- 3 -*- +FloatComplexMatrix +xdiv (const FloatComplexMatrix& a, const FloatMatrix& b, MatrixType &typ) +{ + if (! mx_div_conform (a, b)) + return FloatComplexMatrix (); + + octave_idx_type info; + float rcond = 0.0; + + FloatComplexMatrix result + = b.solve (typ, a.transpose (), info, rcond, + solve_singularity_warning, true, blas_trans); + + return result.transpose (); +} + +// -*- 4 -*- +FloatComplexMatrix +xdiv (const FloatComplexMatrix& a, const FloatComplexMatrix& b, MatrixType &typ) +{ + if (! mx_div_conform (a, b)) + return FloatComplexMatrix (); + + octave_idx_type info; + float rcond = 0.0; + + FloatComplexMatrix result + = b.solve (typ, a.transpose (), info, rcond, + solve_singularity_warning, true, blas_trans); + + return result.transpose (); +} + +// Funny element by element division operations. +// +// op2 \ op1: s cs +// +-- +---+----+ +// matrix | 1 | 3 | +// +---+----+ +// complex_matrix | 2 | 4 | +// +---+----+ + +FloatMatrix +x_el_div (float a, const FloatMatrix& b) +{ + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.columns (); + + FloatMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = a / b (i, j); + } + + return result; +} + +FloatComplexMatrix +x_el_div (float a, const FloatComplexMatrix& b) +{ + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.columns (); + + FloatComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = a / b (i, j); + } + + return result; +} + +FloatComplexMatrix +x_el_div (const FloatComplex a, const FloatMatrix& b) +{ + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.columns (); + + FloatComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = a / b (i, j); + } + + return result; +} + +FloatComplexMatrix +x_el_div (const FloatComplex a, const FloatComplexMatrix& b) +{ + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.columns (); + + FloatComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = a / b (i, j); + } + + return result; +} + +// Funny element by element division operations. +// +// op2 \ op1: s cs +// +-- +---+----+ +// N-d array | 1 | 3 | +// +---+----+ +// complex N-d array | 2 | 4 | +// +---+----+ + +FloatNDArray +x_el_div (float a, const FloatNDArray& b) +{ + FloatNDArray result (b.dims ()); + + for (octave_idx_type i = 0; i < b.length (); i++) + { + octave_quit (); + result (i) = a / b (i); + } + + return result; +} + +FloatComplexNDArray +x_el_div (float a, const FloatComplexNDArray& b) +{ + FloatComplexNDArray result (b.dims ()); + + for (octave_idx_type i = 0; i < b.length (); i++) + { + octave_quit (); + result (i) = a / b (i); + } + + return result; +} + +FloatComplexNDArray +x_el_div (const FloatComplex a, const FloatNDArray& b) +{ + FloatComplexNDArray result (b.dims ()); + + for (octave_idx_type i = 0; i < b.length (); i++) + { + octave_quit (); + result (i) = a / b (i); + } + + return result; +} + +FloatComplexNDArray +x_el_div (const FloatComplex a, const FloatComplexNDArray& b) +{ + FloatComplexNDArray result (b.dims ()); + + for (octave_idx_type i = 0; i < b.length (); i++) + { + octave_quit (); + result (i) = a / b (i); + } + + return result; +} + +// Left division functions. +// +// op2 \ op1: m cm +// +-- +---+----+ +// matrix | 1 | 3 | +// +---+----+ +// complex_matrix | 2 | 4 | +// +---+----+ + +// -*- 1 -*- +FloatMatrix +xleftdiv (const FloatMatrix& a, const FloatMatrix& b, MatrixType &typ, blas_trans_type transt) +{ + if (! mx_leftdiv_conform (a, b, transt)) + return FloatMatrix (); + + octave_idx_type info; + float rcond = 0.0; + return a.solve (typ, b, info, rcond, solve_singularity_warning, true, transt); +} + +// -*- 2 -*- +FloatComplexMatrix +xleftdiv (const FloatMatrix& a, const FloatComplexMatrix& b, MatrixType &typ, blas_trans_type transt) +{ + if (! mx_leftdiv_conform (a, b, transt)) + return FloatComplexMatrix (); + + octave_idx_type info; + float rcond = 0.0; + + return a.solve (typ, b, info, rcond, solve_singularity_warning, true, transt); +} + +// -*- 3 -*- +FloatComplexMatrix +xleftdiv (const FloatComplexMatrix& a, const FloatMatrix& b, MatrixType &typ, blas_trans_type transt) +{ + if (! mx_leftdiv_conform (a, b, transt)) + return FloatComplexMatrix (); + + octave_idx_type info; + float rcond = 0.0; + return a.solve (typ, b, info, rcond, solve_singularity_warning, true, transt); +} + +// -*- 4 -*- +FloatComplexMatrix +xleftdiv (const FloatComplexMatrix& a, const FloatComplexMatrix& b, MatrixType &typ, blas_trans_type transt) +{ + if (! mx_leftdiv_conform (a, b, transt)) + return FloatComplexMatrix (); + + octave_idx_type info; + float rcond = 0.0; + return a.solve (typ, b, info, rcond, solve_singularity_warning, true, transt); +} + +// Diagonal matrix division. + +template +MT +mdm_div_impl (const MT& a, const DMT& d) +{ + if (! mx_div_conform (a, d)) + return MT (); + + octave_idx_type m = a.rows (), n = d.rows (), l = d.length (); + MT x (m, n); + typedef typename DMT::element_type S; + typedef typename MT::element_type T; + const T *aa = a.data (); + const S *dd = d.data (); + T *xx = x.fortran_vec (); + + for (octave_idx_type j = 0; j < l; j++) + { + const S del = dd[j]; + if (del != S ()) + for (octave_idx_type i = 0; i < m; i++) + xx[i] = aa[i] / del; + else + for (octave_idx_type i = 0; i < m; i++) + xx[i] = T (); + aa += m; xx += m; + } + + for (octave_idx_type i = l*m; i < n*m; i++) + xx[i] = T (); + + return x; +} + +// Right division functions. +// +// op2 / op1: dm cdm +// +-- +---+----+ +// matrix | 1 | | +// +---+----+ +// complex_matrix | 2 | 3 | +// +---+----+ + +// -*- 1 -*- +Matrix +xdiv (const Matrix& a, const DiagMatrix& b) +{ return mdm_div_impl (a, b); } + +// -*- 2 -*- +ComplexMatrix +xdiv (const ComplexMatrix& a, const DiagMatrix& b) +{ return mdm_div_impl (a, b); } + +// -*- 3 -*- +ComplexMatrix +xdiv (const ComplexMatrix& a, const ComplexDiagMatrix& b) +{ return mdm_div_impl (a, b); } + +// Right division functions, float type. +// +// op2 / op1: dm cdm +// +-- +---+----+ +// matrix | 1 | | +// +---+----+ +// complex_matrix | 2 | 3 | +// +---+----+ + +// -*- 1 -*- +FloatMatrix +xdiv (const FloatMatrix& a, const FloatDiagMatrix& b) +{ return mdm_div_impl (a, b); } + +// -*- 2 -*- +FloatComplexMatrix +xdiv (const FloatComplexMatrix& a, const FloatDiagMatrix& b) +{ return mdm_div_impl (a, b); } + +// -*- 3 -*- +FloatComplexMatrix +xdiv (const FloatComplexMatrix& a, const FloatComplexDiagMatrix& b) +{ return mdm_div_impl (a, b); } + +template +MT +dmm_leftdiv_impl (const DMT& d, const MT& a) +{ + if (! mx_leftdiv_conform (d, a, blas_no_trans)) + return MT (); + + octave_idx_type m = d.cols (), n = a.cols (), k = a.rows (), l = d.length (); + MT x (m, n); + typedef typename DMT::element_type S; + typedef typename MT::element_type T; + const T *aa = a.data (); + const S *dd = d.data (); + T *xx = x.fortran_vec (); + + for (octave_idx_type j = 0; j < n; j++) + { + for (octave_idx_type i = 0; i < l; i++) + xx[i] = dd[i] != S () ? aa[i] / dd[i] : T (); + for (octave_idx_type i = l; i < m; i++) + xx[i] = T (); + aa += k; xx += m; + } + + return x; +} + +// Left division functions. +// +// op2 \ op1: m cm +// +---+----+ +// diag_matrix | 1 | 2 | +// +---+----+ +// complex_diag_matrix | | 3 | +// +---+----+ + +// -*- 1 -*- +Matrix +xleftdiv (const DiagMatrix& a, const Matrix& b) +{ return dmm_leftdiv_impl (a, b); } + +// -*- 2 -*- +ComplexMatrix +xleftdiv (const DiagMatrix& a, const ComplexMatrix& b) +{ return dmm_leftdiv_impl (a, b); } + +// -*- 3 -*- +ComplexMatrix +xleftdiv (const ComplexDiagMatrix& a, const ComplexMatrix& b) +{ return dmm_leftdiv_impl (a, b); } + +// Left division functions, float type. +// +// op2 \ op1: m cm +// +---+----+ +// diag_matrix | 1 | 2 | +// +---+----+ +// complex_diag_matrix | | 3 | +// +---+----+ + +// -*- 1 -*- +FloatMatrix +xleftdiv (const FloatDiagMatrix& a, const FloatMatrix& b) +{ return dmm_leftdiv_impl (a, b); } + +// -*- 2 -*- +FloatComplexMatrix +xleftdiv (const FloatDiagMatrix& a, const FloatComplexMatrix& b) +{ return dmm_leftdiv_impl (a, b); } + +// -*- 3 -*- +FloatComplexMatrix +xleftdiv (const FloatComplexDiagMatrix& a, const FloatComplexMatrix& b) +{ return dmm_leftdiv_impl (a, b); } + +// Diagonal by diagonal matrix division. + +template +MT +dmdm_div_impl (const MT& a, const DMT& d) +{ + if (! mx_div_conform (a, d)) + return MT (); + + octave_idx_type m = a.rows (), n = d.rows (), k = d.cols (); + octave_idx_type l = std::min (m, n), lk = std::min (l, k); + MT x (m, n); + typedef typename DMT::element_type S; + typedef typename MT::element_type T; + const T *aa = a.data (); + const S *dd = d.data (); + T *xx = x.fortran_vec (); + + for (octave_idx_type i = 0; i < lk; i++) + xx[i] = dd[i] != S () ? aa[i] / dd[i] : T (); + for (octave_idx_type i = lk; i < l; i++) + xx[i] = T (); + + return x; +} + +// Right division functions. +// +// op2 / op1: dm cdm +// +-- +---+----+ +// diag_matrix | 1 | | +// +---+----+ +// complex_diag_matrix | 2 | 3 | +// +---+----+ + +// -*- 1 -*- +DiagMatrix +xdiv (const DiagMatrix& a, const DiagMatrix& b) +{ return dmdm_div_impl (a, b); } + +// -*- 2 -*- +ComplexDiagMatrix +xdiv (const ComplexDiagMatrix& a, const DiagMatrix& b) +{ return dmdm_div_impl (a, b); } + +// -*- 3 -*- +ComplexDiagMatrix +xdiv (const ComplexDiagMatrix& a, const ComplexDiagMatrix& b) +{ return dmdm_div_impl (a, b); } + +// Right division functions, float type. +// +// op2 / op1: dm cdm +// +-- +---+----+ +// diag_matrix | 1 | | +// +---+----+ +// complex_diag_matrix | 2 | 3 | +// +---+----+ + +// -*- 1 -*- +FloatDiagMatrix +xdiv (const FloatDiagMatrix& a, const FloatDiagMatrix& b) +{ return dmdm_div_impl (a, b); } + +// -*- 2 -*- +FloatComplexDiagMatrix +xdiv (const FloatComplexDiagMatrix& a, const FloatDiagMatrix& b) +{ return dmdm_div_impl (a, b); } + +// -*- 3 -*- +FloatComplexDiagMatrix +xdiv (const FloatComplexDiagMatrix& a, const FloatComplexDiagMatrix& b) +{ return dmdm_div_impl (a, b); } + +template +MT +dmdm_leftdiv_impl (const DMT& d, const MT& a) +{ + if (! mx_leftdiv_conform (d, a, blas_no_trans)) + return MT (); + + octave_idx_type m = d.cols (), n = a.cols (), k = d.rows (); + octave_idx_type l = std::min (m, n), lk = std::min (l, k); + MT x (m, n); + typedef typename DMT::element_type S; + typedef typename MT::element_type T; + const T *aa = a.data (); + const S *dd = d.data (); + T *xx = x.fortran_vec (); + + for (octave_idx_type i = 0; i < lk; i++) + xx[i] = dd[i] != S () ? aa[i] / dd[i] : T (); + for (octave_idx_type i = lk; i < l; i++) + xx[i] = T (); + + return x; +} + +// Left division functions. +// +// op2 \ op1: dm cdm +// +---+----+ +// diag_matrix | 1 | 2 | +// +---+----+ +// complex_diag_matrix | | 3 | +// +---+----+ + +// -*- 1 -*- +DiagMatrix +xleftdiv (const DiagMatrix& a, const DiagMatrix& b) +{ return dmdm_leftdiv_impl (a, b); } + +// -*- 2 -*- +ComplexDiagMatrix +xleftdiv (const DiagMatrix& a, const ComplexDiagMatrix& b) +{ return dmdm_leftdiv_impl (a, b); } + +// -*- 3 -*- +ComplexDiagMatrix +xleftdiv (const ComplexDiagMatrix& a, const ComplexDiagMatrix& b) +{ return dmdm_leftdiv_impl (a, b); } + +// Left division functions, float type. +// +// op2 \ op1: dm cdm +// +---+----+ +// diag_matrix | 1 | 2 | +// +---+----+ +// complex_diag_matrix | | 3 | +// +---+----+ + +// -*- 1 -*- +FloatDiagMatrix +xleftdiv (const FloatDiagMatrix& a, const FloatDiagMatrix& b) +{ return dmdm_leftdiv_impl (a, b); } + +// -*- 2 -*- +FloatComplexDiagMatrix +xleftdiv (const FloatDiagMatrix& a, const FloatComplexDiagMatrix& b) +{ return dmdm_leftdiv_impl (a, b); } + +// -*- 3 -*- +FloatComplexDiagMatrix +xleftdiv (const FloatComplexDiagMatrix& a, const FloatComplexDiagMatrix& b) +{ return dmdm_leftdiv_impl (a, b); } diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/xdiv.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/xdiv.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,129 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton +Copyright (C) 2008 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_xdiv_h) +#define octave_xdiv_h 1 + +#include "mx-defs.h" +#include "MatrixType.h" + +extern Matrix xdiv (const Matrix& a, const Matrix& b, MatrixType &typ); +extern ComplexMatrix xdiv (const Matrix& a, const ComplexMatrix& b, + MatrixType &typ); +extern ComplexMatrix xdiv (const ComplexMatrix& a, const Matrix& b, + MatrixType &typ); +extern ComplexMatrix xdiv (const ComplexMatrix& a, const ComplexMatrix& b, + MatrixType &typ); + +extern Matrix x_el_div (double a, const Matrix& b); +extern ComplexMatrix x_el_div (double a, const ComplexMatrix& b); +extern ComplexMatrix x_el_div (const Complex a, const Matrix& b); +extern ComplexMatrix x_el_div (const Complex a, const ComplexMatrix& b); + +extern NDArray x_el_div (double a, const NDArray& b); +extern ComplexNDArray x_el_div (double a, const ComplexNDArray& b); +extern ComplexNDArray x_el_div (const Complex a, const NDArray& b); +extern ComplexNDArray x_el_div (const Complex a, const ComplexNDArray& b); + +extern Matrix xleftdiv (const Matrix& a, const Matrix& b, MatrixType &typ, + blas_trans_type transt = blas_no_trans); +extern ComplexMatrix xleftdiv (const Matrix& a, const ComplexMatrix& b, + MatrixType &typ, blas_trans_type transt = blas_no_trans); +extern ComplexMatrix xleftdiv (const ComplexMatrix& a, const Matrix& b, + MatrixType &typ, blas_trans_type transt = blas_no_trans); +extern ComplexMatrix xleftdiv (const ComplexMatrix& a, const ComplexMatrix& b, + MatrixType &typ, blas_trans_type transt = blas_no_trans); + +extern FloatMatrix xdiv (const FloatMatrix& a, const FloatMatrix& b, MatrixType &typ); +extern FloatComplexMatrix xdiv (const FloatMatrix& a, const FloatComplexMatrix& b, + MatrixType &typ); +extern FloatComplexMatrix xdiv (const FloatComplexMatrix& a, const FloatMatrix& b, + MatrixType &typ); +extern FloatComplexMatrix xdiv (const FloatComplexMatrix& a, const FloatComplexMatrix& b, + MatrixType &typ); + +extern FloatMatrix x_el_div (float a, const FloatMatrix& b); +extern FloatComplexMatrix x_el_div (float a, const FloatComplexMatrix& b); +extern FloatComplexMatrix x_el_div (const FloatComplex a, const FloatMatrix& b); +extern FloatComplexMatrix x_el_div (const FloatComplex a, const FloatComplexMatrix& b); + +extern FloatNDArray x_el_div (float a, const FloatNDArray& b); +extern FloatComplexNDArray x_el_div (float a, const FloatComplexNDArray& b); +extern FloatComplexNDArray x_el_div (const FloatComplex a, const FloatNDArray& b); +extern FloatComplexNDArray x_el_div (const FloatComplex a, const FloatComplexNDArray& b); + +extern FloatMatrix xleftdiv (const FloatMatrix& a, const FloatMatrix& b, MatrixType &typ, + blas_trans_type transt = blas_no_trans); +extern FloatComplexMatrix xleftdiv (const FloatMatrix& a, const FloatComplexMatrix& b, + MatrixType &typ, blas_trans_type transt = blas_no_trans); +extern FloatComplexMatrix xleftdiv (const FloatComplexMatrix& a, const FloatMatrix& b, + MatrixType &typ, blas_trans_type transt = blas_no_trans); +extern FloatComplexMatrix xleftdiv (const FloatComplexMatrix& a, const FloatComplexMatrix& b, + MatrixType &typ, blas_trans_type transt = blas_no_trans); + + +extern Matrix xdiv (const Matrix& a, const DiagMatrix& b); +extern ComplexMatrix xdiv (const ComplexMatrix& a, const DiagMatrix& b); +extern ComplexMatrix xdiv (const ComplexMatrix& a, const ComplexDiagMatrix& b); + +extern DiagMatrix xdiv (const DiagMatrix& a, const DiagMatrix& b); +extern ComplexDiagMatrix xdiv (const ComplexDiagMatrix& a, const DiagMatrix& b); +extern ComplexDiagMatrix xdiv (const ComplexDiagMatrix& a, const ComplexDiagMatrix& b); + +extern FloatMatrix xdiv (const FloatMatrix& a, const FloatDiagMatrix& b); +extern FloatComplexMatrix xdiv (const FloatComplexMatrix& a, + const FloatDiagMatrix& b); +extern FloatComplexMatrix xdiv (const FloatMatrix& a, + const FloatComplexDiagMatrix& b); +extern FloatComplexMatrix xdiv (const FloatComplexMatrix& a, + const FloatComplexDiagMatrix& b); + +extern FloatDiagMatrix xdiv (const FloatDiagMatrix& a, const FloatDiagMatrix& b); +extern FloatComplexDiagMatrix xdiv (const FloatComplexDiagMatrix& a, + const FloatDiagMatrix& b); +extern FloatComplexDiagMatrix xdiv (const FloatComplexDiagMatrix& a, + const FloatComplexDiagMatrix& b); + +extern Matrix xleftdiv (const DiagMatrix& a, const Matrix& b); +extern ComplexMatrix xleftdiv (const DiagMatrix& a, const ComplexMatrix& b); +extern ComplexMatrix xleftdiv (const ComplexDiagMatrix& a, const ComplexMatrix& b); + +extern DiagMatrix xleftdiv (const DiagMatrix& a, const DiagMatrix& b); +extern ComplexDiagMatrix xleftdiv (const DiagMatrix& a, const ComplexDiagMatrix& b); +extern ComplexDiagMatrix xleftdiv (const ComplexDiagMatrix& a, const ComplexDiagMatrix& b); + +extern FloatMatrix xleftdiv (const FloatDiagMatrix& a, + const FloatMatrix& b); +extern FloatComplexMatrix xleftdiv (const FloatDiagMatrix& a, + const FloatComplexMatrix& b); +extern FloatComplexMatrix xleftdiv (const FloatComplexDiagMatrix& a, + const FloatComplexMatrix& b); + +extern FloatDiagMatrix xleftdiv (const FloatDiagMatrix& a, + const FloatDiagMatrix& b); +extern FloatComplexDiagMatrix xleftdiv (const FloatDiagMatrix& a, + const FloatComplexDiagMatrix& b); +extern FloatComplexDiagMatrix xleftdiv (const FloatComplexDiagMatrix& a, + const FloatComplexDiagMatrix& b); + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/xgl2ps.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/xgl2ps.c Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,36 @@ +/* + +Copyright (C) 2009-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +/* + * Wrapper for "imported" file gl2ps.c so that config.h will be included + * before any other system or gnulib headers. + */ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#if defined (HAVE_OPENGL) + +#include "gl2ps.c" + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/xnorm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/xnorm.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,212 @@ +/* + +Copyright (C) 2008-2012 VZLU Prague, a.s. + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// author: Jaroslav Hajek + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include "oct-norm.h" + +#include "error.h" +#include "xnorm.h" +#include "ov.h" +#include "gripes.h" + +octave_value xnorm (const octave_value& x, const octave_value& p) +{ + octave_value retval; + + bool isvector = (x.columns () == 1 || x.rows () == 1); + bool iscomplex = x.is_complex_type (); + bool issparse = x.is_sparse_type (); + bool isfloat = x.is_single_type (); + + if (isfloat || x.is_double_type ()) + { + if (isvector) + { + if (isfloat & iscomplex) + retval = xnorm (x.float_complex_column_vector_value (), + p.float_value ()); + else if (isfloat) + retval = xnorm (x.float_column_vector_value (), + p.float_value ()); + else if (iscomplex) + retval = xnorm (x.complex_column_vector_value (), + p.double_value ()); + else + retval = xnorm (x.column_vector_value (), + p.double_value ()); + } + else if (issparse) + { + if (iscomplex) + retval = xnorm (x.sparse_complex_matrix_value (), + p.double_value ()); + else + retval = xnorm (x.sparse_matrix_value (), + p.double_value ()); + } + else + { + if (isfloat & iscomplex) + retval = xnorm (x.float_complex_matrix_value (), + p.float_value ()); + else if (isfloat) + retval = xnorm (x.float_matrix_value (), + p.float_value ()); + else if (iscomplex) + retval = xnorm (x.complex_matrix_value (), + p.double_value ()); + else + retval = xnorm (x.matrix_value (), + p.double_value ()); + } + } + else + gripe_wrong_type_arg ("xnorm", x, true); + + return retval; +} + +octave_value xcolnorms (const octave_value& x, const octave_value& p) +{ + octave_value retval; + + bool iscomplex = x.is_complex_type (); + bool issparse = x.is_sparse_type (); + bool isfloat = x.is_single_type (); + + if (isfloat || x.is_double_type ()) + { + if (issparse) + { + if (iscomplex) + retval = xcolnorms (x.sparse_complex_matrix_value (), + p.double_value ()); + else + retval = xcolnorms (x.sparse_matrix_value (), + p.double_value ()); + } + else + { + if (isfloat & iscomplex) + retval = xcolnorms (x.float_complex_matrix_value (), + p.float_value ()); + else if (isfloat) + retval = xcolnorms (x.float_matrix_value (), + p.float_value ()); + else if (iscomplex) + retval = xcolnorms (x.complex_matrix_value (), + p.double_value ()); + else + retval = xcolnorms (x.matrix_value (), + p.double_value ()); + } + } + else + gripe_wrong_type_arg ("xcolnorms", x, true); + + return retval; +} + +octave_value xrownorms (const octave_value& x, const octave_value& p) +{ + octave_value retval; + + bool iscomplex = x.is_complex_type (); + bool issparse = x.is_sparse_type (); + bool isfloat = x.is_single_type (); + + if (isfloat || x.is_double_type ()) + { + if (issparse) + { + if (iscomplex) + retval = xrownorms (x.sparse_complex_matrix_value (), + p.double_value ()); + else + retval = xrownorms (x.sparse_matrix_value (), + p.double_value ()); + } + else + { + if (isfloat & iscomplex) + retval = xrownorms (x.float_complex_matrix_value (), + p.float_value ()); + else if (isfloat) + retval = xrownorms (x.float_matrix_value (), + p.float_value ()); + else if (iscomplex) + retval = xrownorms (x.complex_matrix_value (), + p.double_value ()); + else + retval = xrownorms (x.matrix_value (), + p.double_value ()); + } + } + else + gripe_wrong_type_arg ("xrownorms", x, true); + + return retval; +} + +octave_value xfrobnorm (const octave_value& x) +{ + octave_value retval; + + bool iscomplex = x.is_complex_type (); + bool issparse = x.is_sparse_type (); + bool isfloat = x.is_single_type (); + + if (isfloat || x.is_double_type ()) + { + if (issparse) + { + if (iscomplex) + retval = xfrobnorm (x.sparse_complex_matrix_value ()); + else + retval = xfrobnorm (x.sparse_matrix_value ()); + } + else + { + if (isfloat & iscomplex) + retval = xfrobnorm (x.float_complex_matrix_value ()); + else if (isfloat) + retval = xfrobnorm (x.float_matrix_value ()); + else if (iscomplex) + retval = xfrobnorm (x.complex_matrix_value ()); + else + retval = xfrobnorm (x.matrix_value ()); + } + } + else + gripe_wrong_type_arg ("xfrobnorm", x, true); + + return retval; +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/xnorm.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/xnorm.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,37 @@ +/* + +Copyright (C) 2008-2012 VZLU Prague, a.s. + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// author: Jaroslav Hajek + +#if !defined (octave_xnorm_h) +#define octave_xnorm_h 1 + +#include "oct-norm.h" + +class octave_value; + +extern OCTINTERP_API octave_value xnorm (const octave_value& x, const octave_value& p); +extern OCTINTERP_API octave_value xcolnorms (const octave_value& x, const octave_value& p); +extern OCTINTERP_API octave_value xrownorms (const octave_value& x, const octave_value& p); +extern OCTINTERP_API octave_value xfrobnorm (const octave_value& x); + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/xpow.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/xpow.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,2859 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include + +#include "Array-util.h" +#include "CColVector.h" +#include "CDiagMatrix.h" +#include "fCDiagMatrix.h" +#include "CMatrix.h" +#include "EIG.h" +#include "fEIG.h" +#include "dDiagMatrix.h" +#include "fDiagMatrix.h" +#include "dMatrix.h" +#include "PermMatrix.h" +#include "mx-cm-cdm.h" +#include "oct-cmplx.h" +#include "Range.h" +#include "quit.h" + +#include "error.h" +#include "oct-obj.h" +#include "utils.h" +#include "xpow.h" + +#include "bsxfun.h" + +#ifdef _OPENMP +#include +#endif + +static inline int +xisint (double x) +{ + return (D_NINT (x) == x + && ((x >= 0 && x < std::numeric_limits::max ()) + || (x <= 0 && x > std::numeric_limits::min ()))); +} + +// Safer pow functions. +// +// op2 \ op1: s m cs cm +// +-- +---+---+----+----+ +// scalar | | 1 | 5 | 7 | 11 | +// +---+---+----+----+ +// matrix | 2 | * | 8 | * | +// +---+---+----+----+ +// complex_scalar | 3 | 6 | 9 | 12 | +// +---+---+----+----+ +// complex_matrix | 4 | * | 10 | * | +// +---+---+----+----+ + +// -*- 1 -*- +octave_value +xpow (double a, double b) +{ + double retval; + + if (a < 0.0 && ! xisint (b)) + { + Complex atmp (a); + + return std::pow (atmp, b); + } + else + retval = std::pow (a, b); + + return retval; +} + +// -*- 2 -*- +octave_value +xpow (double a, const Matrix& b) +{ + octave_value retval; + + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.cols (); + + if (nr == 0 || nc == 0 || nr != nc) + error ("for x^A, A must be a square matrix"); + else + { + EIG b_eig (b); + + if (! error_state) + { + ComplexColumnVector lambda (b_eig.eigenvalues ()); + ComplexMatrix Q (b_eig.eigenvectors ()); + + for (octave_idx_type i = 0; i < nr; i++) + { + Complex elt = lambda(i); + if (std::imag (elt) == 0.0) + lambda(i) = std::pow (a, std::real (elt)); + else + lambda(i) = std::pow (a, elt); + } + ComplexDiagMatrix D (lambda); + + ComplexMatrix C = Q * D * Q.inverse (); + if (a > 0) + retval = real (C); + else + retval = C; + } + else + error ("xpow: matrix diagonalization failed"); + } + + return retval; +} + +// -*- 3 -*- +octave_value +xpow (double a, const Complex& b) +{ + Complex result = std::pow (a, b); + return result; +} + +// -*- 4 -*- +octave_value +xpow (double a, const ComplexMatrix& b) +{ + octave_value retval; + + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.cols (); + + if (nr == 0 || nc == 0 || nr != nc) + error ("for x^A, A must be a square matrix"); + else + { + EIG b_eig (b); + + if (! error_state) + { + ComplexColumnVector lambda (b_eig.eigenvalues ()); + ComplexMatrix Q (b_eig.eigenvectors ()); + + for (octave_idx_type i = 0; i < nr; i++) + { + Complex elt = lambda(i); + if (std::imag (elt) == 0.0) + lambda(i) = std::pow (a, std::real (elt)); + else + lambda(i) = std::pow (a, elt); + } + ComplexDiagMatrix D (lambda); + + retval = ComplexMatrix (Q * D * Q.inverse ()); + } + else + error ("xpow: matrix diagonalization failed"); + } + + return retval; +} + +// -*- 5 -*- +octave_value +xpow (const Matrix& a, double b) +{ + octave_value retval; + + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + if (nr == 0 || nc == 0 || nr != nc) + error ("for A^b, A must be a square matrix"); + else + { + if (static_cast (b) == b) + { + int btmp = static_cast (b); + if (btmp == 0) + { + retval = DiagMatrix (nr, nr, 1.0); + } + else + { + // Too much copying? + // FIXME -- we shouldn't do this if the exponent is + // large... + + Matrix atmp; + if (btmp < 0) + { + btmp = -btmp; + + octave_idx_type info; + double rcond = 0.0; + MatrixType mattype (a); + + atmp = a.inverse (mattype, info, rcond, 1); + + if (info == -1) + warning ("inverse: matrix singular to machine\ + precision, rcond = %g", rcond); + } + else + atmp = a; + + Matrix result (atmp); + + btmp--; + + while (btmp > 0) + { + if (btmp & 1) + result = result * atmp; + + btmp >>= 1; + + if (btmp > 0) + atmp = atmp * atmp; + } + + retval = result; + } + } + else + { + EIG a_eig (a); + + if (! error_state) + { + ComplexColumnVector lambda (a_eig.eigenvalues ()); + ComplexMatrix Q (a_eig.eigenvectors ()); + + for (octave_idx_type i = 0; i < nr; i++) + lambda(i) = std::pow (lambda(i), b); + + ComplexDiagMatrix D (lambda); + + retval = ComplexMatrix (Q * D * Q.inverse ()); + } + else + error ("xpow: matrix diagonalization failed"); + } + } + + return retval; +} + +// -*- 5d -*- +octave_value +xpow (const DiagMatrix& a, double b) +{ + octave_value retval; + + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + if (nr == 0 || nc == 0 || nr != nc) + error ("for A^b, A must be a square matrix"); + else + { + if (static_cast (b) == b) + { + DiagMatrix r (nr, nc); + for (octave_idx_type i = 0; i < nc; i++) + r.dgelem (i) = std::pow (a.dgelem (i), b); + retval = r; + } + else + { + ComplexDiagMatrix r (nr, nc); + for (octave_idx_type i = 0; i < nc; i++) + r.dgelem (i) = std::pow (static_cast (a.dgelem (i)), b); + retval = r; + } + } + + return retval; +} + +// -*- 5p -*- +octave_value +xpow (const PermMatrix& a, double b) +{ + octave_value retval; + int btmp = static_cast (b); + if (btmp == b) + return a.power (btmp); + else + return xpow (Matrix (a), b); +} + +// -*- 6 -*- +octave_value +xpow (const Matrix& a, const Complex& b) +{ + octave_value retval; + + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + if (nr == 0 || nc == 0 || nr != nc) + error ("for A^b, A must be a square matrix"); + else + { + EIG a_eig (a); + + if (! error_state) + { + ComplexColumnVector lambda (a_eig.eigenvalues ()); + ComplexMatrix Q (a_eig.eigenvectors ()); + + for (octave_idx_type i = 0; i < nr; i++) + lambda(i) = std::pow (lambda(i), b); + + ComplexDiagMatrix D (lambda); + + retval = ComplexMatrix (Q * D * Q.inverse ()); + } + else + error ("xpow: matrix diagonalization failed"); + } + + return retval; +} + +// -*- 7 -*- +octave_value +xpow (const Complex& a, double b) +{ + Complex result; + + if (xisint (b)) + result = std::pow (a, static_cast (b)); + else + result = std::pow (a, b); + + return result; +} + +// -*- 8 -*- +octave_value +xpow (const Complex& a, const Matrix& b) +{ + octave_value retval; + + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.cols (); + + if (nr == 0 || nc == 0 || nr != nc) + error ("for x^A, A must be a square matrix"); + else + { + EIG b_eig (b); + + if (! error_state) + { + ComplexColumnVector lambda (b_eig.eigenvalues ()); + ComplexMatrix Q (b_eig.eigenvectors ()); + + for (octave_idx_type i = 0; i < nr; i++) + { + Complex elt = lambda(i); + if (std::imag (elt) == 0.0) + lambda(i) = std::pow (a, std::real (elt)); + else + lambda(i) = std::pow (a, elt); + } + ComplexDiagMatrix D (lambda); + + retval = ComplexMatrix (Q * D * Q.inverse ()); + } + else + error ("xpow: matrix diagonalization failed"); + } + + return retval; +} + +// -*- 9 -*- +octave_value +xpow (const Complex& a, const Complex& b) +{ + Complex result; + result = std::pow (a, b); + return result; +} + +// -*- 10 -*- +octave_value +xpow (const Complex& a, const ComplexMatrix& b) +{ + octave_value retval; + + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.cols (); + + if (nr == 0 || nc == 0 || nr != nc) + error ("for x^A, A must be a square matrix"); + else + { + EIG b_eig (b); + + if (! error_state) + { + ComplexColumnVector lambda (b_eig.eigenvalues ()); + ComplexMatrix Q (b_eig.eigenvectors ()); + + for (octave_idx_type i = 0; i < nr; i++) + { + Complex elt = lambda(i); + if (std::imag (elt) == 0.0) + lambda(i) = std::pow (a, std::real (elt)); + else + lambda(i) = std::pow (a, elt); + } + ComplexDiagMatrix D (lambda); + + retval = ComplexMatrix (Q * D * Q.inverse ()); + } + else + error ("xpow: matrix diagonalization failed"); + } + + return retval; +} + +// -*- 11 -*- +octave_value +xpow (const ComplexMatrix& a, double b) +{ + octave_value retval; + + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + if (nr == 0 || nc == 0 || nr != nc) + error ("for A^b, A must be a square matrix"); + else + { + if (static_cast (b) == b) + { + int btmp = static_cast (b); + if (btmp == 0) + { + retval = DiagMatrix (nr, nr, 1.0); + } + else + { + // Too much copying? + // FIXME -- we shouldn't do this if the exponent is + // large... + + ComplexMatrix atmp; + if (btmp < 0) + { + btmp = -btmp; + + octave_idx_type info; + double rcond = 0.0; + MatrixType mattype (a); + + atmp = a.inverse (mattype, info, rcond, 1); + + if (info == -1) + warning ("inverse: matrix singular to machine\ + precision, rcond = %g", rcond); + } + else + atmp = a; + + ComplexMatrix result (atmp); + + btmp--; + + while (btmp > 0) + { + if (btmp & 1) + result = result * atmp; + + btmp >>= 1; + + if (btmp > 0) + atmp = atmp * atmp; + } + + retval = result; + } + } + else + { + EIG a_eig (a); + + if (! error_state) + { + ComplexColumnVector lambda (a_eig.eigenvalues ()); + ComplexMatrix Q (a_eig.eigenvectors ()); + + for (octave_idx_type i = 0; i < nr; i++) + lambda(i) = std::pow (lambda(i), b); + + ComplexDiagMatrix D (lambda); + + retval = ComplexMatrix (Q * D * Q.inverse ()); + } + else + error ("xpow: matrix diagonalization failed"); + } + } + + return retval; +} + +// -*- 12 -*- +octave_value +xpow (const ComplexMatrix& a, const Complex& b) +{ + octave_value retval; + + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + if (nr == 0 || nc == 0 || nr != nc) + error ("for A^b, A must be a square matrix"); + else + { + EIG a_eig (a); + + if (! error_state) + { + ComplexColumnVector lambda (a_eig.eigenvalues ()); + ComplexMatrix Q (a_eig.eigenvectors ()); + + for (octave_idx_type i = 0; i < nr; i++) + lambda(i) = std::pow (lambda(i), b); + + ComplexDiagMatrix D (lambda); + + retval = ComplexMatrix (Q * D * Q.inverse ()); + } + else + error ("xpow: matrix diagonalization failed"); + } + + return retval; +} + +// -*- 12d -*- +octave_value +xpow (const ComplexDiagMatrix& a, const Complex& b) +{ + octave_value retval; + + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + if (nr == 0 || nc == 0 || nr != nc) + error ("for A^b, A must be a square matrix"); + else + { + ComplexDiagMatrix r (nr, nc); + for (octave_idx_type i = 0; i < nc; i++) + r(i, i) = std::pow (a(i, i), b); + retval = r; + } + + return retval; +} + +// mixed +octave_value +xpow (const ComplexDiagMatrix& a, double b) +{ + return xpow (a, static_cast (b)); +} + +octave_value +xpow (const DiagMatrix& a, const Complex& b) +{ + return xpow (ComplexDiagMatrix (a), b); +} + + +// Safer pow functions that work elementwise for matrices. +// +// op2 \ op1: s m cs cm +// +-- +---+---+----+----+ +// scalar | | * | 3 | * | 9 | +// +---+---+----+----+ +// matrix | 1 | 4 | 7 | 10 | +// +---+---+----+----+ +// complex_scalar | * | 5 | * | 11 | +// +---+---+----+----+ +// complex_matrix | 2 | 6 | 8 | 12 | +// +---+---+----+----+ +// +// * -> not needed. + +// FIXME -- these functions need to be fixed so that things +// like +// +// a = -1; b = [ 0, 0.5, 1 ]; r = a .^ b +// +// and +// +// a = -1; b = [ 0, 0.5, 1 ]; for i = 1:3, r(i) = a .^ b(i), end +// +// produce identical results. Also, it would be nice if -1^0.5 +// produced a pure imaginary result instead of a complex number with a +// small real part. But perhaps that's really a problem with the math +// library... + +// -*- 1 -*- +octave_value +elem_xpow (double a, const Matrix& b) +{ + octave_value retval; + + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.cols (); + + double d1, d2; + + if (a < 0.0 && ! b.all_integers (d1, d2)) + { + Complex atmp (a); + ComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = std::pow (atmp, b (i, j)); + } + + retval = result; + } + else + { + Matrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = std::pow (a, b (i, j)); + } + + retval = result; + } + + return retval; +} + +// -*- 2 -*- +octave_value +elem_xpow (double a, const ComplexMatrix& b) +{ + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.cols (); + + ComplexMatrix result (nr, nc); + Complex atmp (a); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = std::pow (atmp, b (i, j)); + } + + return result; +} + +static inline bool +same_sign (double a, double b) +{ + return (a >= 0 && b >= 0) || (a <= 0 && b <= 0); +} + +octave_value +elem_xpow (double a, const Range& r) +{ + octave_value retval; + + // Only optimize powers with ranges that are integer and monotonic in + // magnitude. + if (r.nelem () > 1 && r.all_elements_are_ints () + && same_sign (r.base (), r.limit ())) + { + octave_idx_type n = r.nelem (); + Matrix result (1, n); + if (same_sign (r.base (), r.inc ())) + { + double base = std::pow (a, r.base ()); + double inc = std::pow (a, r.inc ()); + result(0) = base; + for (octave_idx_type i = 1; i < n; i++) + result(i) = (base *= inc); + } + else + { + // Don't use Range::limit () here. + double limit = std::pow (a, r.base () + (n-1) * r.inc ()); + double inc = std::pow (a, -r.inc ()); + result(n-1) = limit; + for (octave_idx_type i = n-2; i >= 0; i--) + result(i) = (limit *= inc); + } + + retval = result; + } + else + retval = elem_xpow (a, r.matrix_value ()); + + return retval; +} + +// -*- 3 -*- +octave_value +elem_xpow (const Matrix& a, double b) +{ + octave_value retval; + + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + if (! xisint (b) && a.any_element_is_negative ()) + { + ComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + + Complex atmp (a (i, j)); + + result (i, j) = std::pow (atmp, b); + } + + retval = result; + } + else + { + Matrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = std::pow (a (i, j), b); + } + + retval = result; + } + + return retval; +} + +// -*- 4 -*- +octave_value +elem_xpow (const Matrix& a, const Matrix& b) +{ + octave_value retval; + + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + + if (nr != b_nr || nc != b_nc) + { + gripe_nonconformant ("operator .^", nr, nc, b_nr, b_nc); + return octave_value (); + } + + int convert_to_complex = 0; + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + double atmp = a (i, j); + double btmp = b (i, j); + if (atmp < 0.0 && static_cast (btmp) != btmp) + { + convert_to_complex = 1; + goto done; + } + } + +done: + + if (convert_to_complex) + { + ComplexMatrix complex_result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + Complex atmp (a (i, j)); + Complex btmp (b (i, j)); + complex_result (i, j) = std::pow (atmp, btmp); + } + + retval = complex_result; + } + else + { + Matrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = std::pow (a (i, j), b (i, j)); + } + + retval = result; + } + + return retval; +} + +// -*- 5 -*- +octave_value +elem_xpow (const Matrix& a, const Complex& b) +{ + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + ComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = std::pow (Complex (a (i, j)), b); + } + + return result; +} + +// -*- 6 -*- +octave_value +elem_xpow (const Matrix& a, const ComplexMatrix& b) +{ + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + + if (nr != b_nr || nc != b_nc) + { + gripe_nonconformant ("operator .^", nr, nc, b_nr, b_nc); + return octave_value (); + } + + ComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = std::pow (Complex (a (i, j)), b (i, j)); + } + + return result; +} + +// -*- 7 -*- +octave_value +elem_xpow (const Complex& a, const Matrix& b) +{ + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.cols (); + + ComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + double btmp = b (i, j); + if (xisint (btmp)) + result (i, j) = std::pow (a, static_cast (btmp)); + else + result (i, j) = std::pow (a, btmp); + } + + return result; +} + +// -*- 8 -*- +octave_value +elem_xpow (const Complex& a, const ComplexMatrix& b) +{ + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.cols (); + + ComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = std::pow (a, b (i, j)); + } + + return result; +} + +octave_value +elem_xpow (const Complex& a, const Range& r) +{ + octave_value retval; + + // Only optimize powers with ranges that are integer and monotonic in + // magnitude. + if (r.nelem () > 1 && r.all_elements_are_ints () + && same_sign (r.base (), r.limit ())) + { + octave_idx_type n = r.nelem (); + ComplexMatrix result (1, n); + + if (same_sign (r.base (), r.inc ())) + { + Complex base = std::pow (a, r.base ()); + Complex inc = std::pow (a, r.inc ()); + result(0) = base; + for (octave_idx_type i = 1; i < n; i++) + result(i) = (base *= inc); + } + else + { + // Don't use Range::limit () here. + Complex limit = std::pow (a, r.base () + (n-1) * r.inc ()); + Complex inc = std::pow (a, -r.inc ()); + result(n-1) = limit; + for (octave_idx_type i = n-2; i >= 0; i--) + result(i) = (limit *= inc); + } + + retval = result; + } + else + retval = elem_xpow (a, r.matrix_value ()); + + + return retval; +} + +// -*- 9 -*- +octave_value +elem_xpow (const ComplexMatrix& a, double b) +{ + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + ComplexMatrix result (nr, nc); + + if (xisint (b)) + { + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = std::pow (a (i, j), static_cast (b)); + } + } + else + { + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = std::pow (a (i, j), b); + } + } + + return result; +} + +// -*- 10 -*- +octave_value +elem_xpow (const ComplexMatrix& a, const Matrix& b) +{ + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + + if (nr != b_nr || nc != b_nc) + { + gripe_nonconformant ("operator .^", nr, nc, b_nr, b_nc); + return octave_value (); + } + + ComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + double btmp = b (i, j); + if (xisint (btmp)) + result (i, j) = std::pow (a (i, j), static_cast (btmp)); + else + result (i, j) = std::pow (a (i, j), btmp); + } + + return result; +} + +// -*- 11 -*- +octave_value +elem_xpow (const ComplexMatrix& a, const Complex& b) +{ + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + ComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = std::pow (a (i, j), b); + } + + return result; +} + +// -*- 12 -*- +octave_value +elem_xpow (const ComplexMatrix& a, const ComplexMatrix& b) +{ + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + + if (nr != b_nr || nc != b_nc) + { + gripe_nonconformant ("operator .^", nr, nc, b_nr, b_nc); + return octave_value (); + } + + ComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = std::pow (a (i, j), b (i, j)); + } + + return result; +} + +// Safer pow functions that work elementwise for N-d arrays. +// +// op2 \ op1: s nd cs cnd +// +-- +---+---+----+----+ +// scalar | | * | 3 | * | 9 | +// +---+---+----+----+ +// N_d | 1 | 4 | 7 | 10 | +// +---+---+----+----+ +// complex_scalar | * | 5 | * | 11 | +// +---+---+----+----+ +// complex_N_d | 2 | 6 | 8 | 12 | +// +---+---+----+----+ +// +// * -> not needed. + +// FIXME -- these functions need to be fixed so that things +// like +// +// a = -1; b = [ 0, 0.5, 1 ]; r = a .^ b +// +// and +// +// a = -1; b = [ 0, 0.5, 1 ]; for i = 1:3, r(i) = a .^ b(i), end +// +// produce identical results. Also, it would be nice if -1^0.5 +// produced a pure imaginary result instead of a complex number with a +// small real part. But perhaps that's really a problem with the math +// library... + +// -*- 1 -*- +octave_value +elem_xpow (double a, const NDArray& b) +{ + octave_value retval; + + if (a < 0.0 && ! b.all_integers ()) + { + Complex atmp (a); + ComplexNDArray result (b.dims ()); + for (octave_idx_type i = 0; i < b.length (); i++) + { + octave_quit (); + result(i) = std::pow (atmp, b(i)); + } + + retval = result; + } + else + { + NDArray result (b.dims ()); + for (octave_idx_type i = 0; i < b.length (); i++) + { + octave_quit (); + result (i) = std::pow (a, b(i)); + } + + retval = result; + } + + return retval; +} + +// -*- 2 -*- +octave_value +elem_xpow (double a, const ComplexNDArray& b) +{ + ComplexNDArray result (b.dims ()); + + for (octave_idx_type i = 0; i < b.length (); i++) + { + octave_quit (); + result(i) = std::pow (a, b(i)); + } + + return result; +} + +// -*- 3 -*- +octave_value +elem_xpow (const NDArray& a, double b) +{ + octave_value retval; + + if (! xisint (b)) + { + if (a.any_element_is_negative ()) + { + ComplexNDArray result (a.dims ()); + + for (octave_idx_type i = 0; i < a.length (); i++) + { + octave_quit (); + + Complex atmp (a (i)); + + result(i) = std::pow (atmp, b); + } + + retval = result; + } + else + { + NDArray result (a.dims ()); + for (octave_idx_type i = 0; i < a.length (); i++) + { + octave_quit (); + result(i) = std::pow (a(i), b); + } + + retval = result; + } + } + else + { + NoAlias result (a.dims ()); + + int ib = static_cast (b); + if (ib == 2) + { + for (octave_idx_type i = 0; i < a.length (); i++) + result(i) = a(i) * a(i); + } + else if (ib == 3) + { + for (octave_idx_type i = 0; i < a.length (); i++) + result(i) = a(i) * a(i) * a(i); + } + else if (ib == -1) + { + for (octave_idx_type i = 0; i < a.length (); i++) + result(i) = 1.0 / a(i); + } + else + { + for (octave_idx_type i = 0; i < a.length (); i++) + { + octave_quit (); + result(i) = std::pow (a(i), ib); + } + } + + retval = result; + } + + return retval; +} + +// -*- 4 -*- +octave_value +elem_xpow (const NDArray& a, const NDArray& b) +{ + octave_value retval; + + dim_vector a_dims = a.dims (); + dim_vector b_dims = b.dims (); + + if (a_dims != b_dims) + { + if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) + { + //Potentially complex results + NDArray xa = octave_value_extract (a); + NDArray xb = octave_value_extract (b); + if (! xb.all_integers () && xa.any_element_is_negative ()) + return octave_value (bsxfun_pow (ComplexNDArray (xa), xb)); + else + return octave_value (bsxfun_pow (xa, xb)); + } + else + { + gripe_nonconformant ("operator .^", a_dims, b_dims); + return octave_value (); + } + } + + int len = a.length (); + + bool convert_to_complex = false; + + for (octave_idx_type i = 0; i < len; i++) + { + octave_quit (); + double atmp = a(i); + double btmp = b(i); + if (atmp < 0.0 && static_cast (btmp) != btmp) + { + convert_to_complex = true; + goto done; + } + } + +done: + + if (convert_to_complex) + { + ComplexNDArray complex_result (a_dims); + + for (octave_idx_type i = 0; i < len; i++) + { + octave_quit (); + Complex atmp (a(i)); + complex_result(i) = std::pow (atmp, b(i)); + } + + retval = complex_result; + } + else + { + NDArray result (a_dims); + + for (octave_idx_type i = 0; i < len; i++) + { + octave_quit (); + result(i) = std::pow (a(i), b(i)); + } + + retval = result; + } + + return retval; +} + +// -*- 5 -*- +octave_value +elem_xpow (const NDArray& a, const Complex& b) +{ + ComplexNDArray result (a.dims ()); + + for (octave_idx_type i = 0; i < a.length (); i++) + { + octave_quit (); + result(i) = std::pow (a(i), b); + } + + return result; +} + +// -*- 6 -*- +octave_value +elem_xpow (const NDArray& a, const ComplexNDArray& b) +{ + dim_vector a_dims = a.dims (); + dim_vector b_dims = b.dims (); + + if (a_dims != b_dims) + { + if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) + { + return bsxfun_pow (a, b); + } + else + { + gripe_nonconformant ("operator .^", a_dims, b_dims); + return octave_value (); + } + } + + ComplexNDArray result (a_dims); + + for (octave_idx_type i = 0; i < a.length (); i++) + { + octave_quit (); + result(i) = std::pow (a(i), b(i)); + } + + return result; +} + +// -*- 7 -*- +octave_value +elem_xpow (const Complex& a, const NDArray& b) +{ + ComplexNDArray result (b.dims ()); + + for (octave_idx_type i = 0; i < b.length (); i++) + { + octave_quit (); + double btmp = b(i); + if (xisint (btmp)) + result(i) = std::pow (a, static_cast (btmp)); + else + result(i) = std::pow (a, btmp); + } + + return result; +} + +// -*- 8 -*- +octave_value +elem_xpow (const Complex& a, const ComplexNDArray& b) +{ + ComplexNDArray result (b.dims ()); + + for (octave_idx_type i = 0; i < b.length (); i++) + { + octave_quit (); + result(i) = std::pow (a, b(i)); + } + + return result; +} + +// -*- 9 -*- +octave_value +elem_xpow (const ComplexNDArray& a, double b) +{ + ComplexNDArray result (a.dims ()); + + if (xisint (b)) + { + if (b == -1) + { + for (octave_idx_type i = 0; i < a.length (); i++) + result.xelem (i) = 1.0 / a(i); + } + else + { + for (octave_idx_type i = 0; i < a.length (); i++) + { + octave_quit (); + result(i) = std::pow (a(i), static_cast (b)); + } + } + } + else + { + for (octave_idx_type i = 0; i < a.length (); i++) + { + octave_quit (); + result(i) = std::pow (a(i), b); + } + } + + return result; +} + +// -*- 10 -*- +octave_value +elem_xpow (const ComplexNDArray& a, const NDArray& b) +{ + dim_vector a_dims = a.dims (); + dim_vector b_dims = b.dims (); + + if (a_dims != b_dims) + { + if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) + { + return bsxfun_pow (a, b); + } + else + { + gripe_nonconformant ("operator .^", a_dims, b_dims); + return octave_value (); + } + } + + ComplexNDArray result (a_dims); + + for (octave_idx_type i = 0; i < a.length (); i++) + { + octave_quit (); + double btmp = b(i); + if (xisint (btmp)) + result(i) = std::pow (a(i), static_cast (btmp)); + else + result(i) = std::pow (a(i), btmp); + } + + return result; +} + +// -*- 11 -*- +octave_value +elem_xpow (const ComplexNDArray& a, const Complex& b) +{ + ComplexNDArray result (a.dims ()); + + for (octave_idx_type i = 0; i < a.length (); i++) + { + octave_quit (); + result(i) = std::pow (a(i), b); + } + + return result; +} + +// -*- 12 -*- +octave_value +elem_xpow (const ComplexNDArray& a, const ComplexNDArray& b) +{ + dim_vector a_dims = a.dims (); + dim_vector b_dims = b.dims (); + + if (a_dims != b_dims) + { + if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) + { + return bsxfun_pow (a, b); + } + else + { + gripe_nonconformant ("operator .^", a_dims, b_dims); + return octave_value (); + } + } + + ComplexNDArray result (a_dims); + + for (octave_idx_type i = 0; i < a.length (); i++) + { + octave_quit (); + result(i) = std::pow (a(i), b(i)); + } + + return result; +} + +static inline int +xisint (float x) +{ + return (D_NINT (x) == x + && ((x >= 0 && x < std::numeric_limits::max ()) + || (x <= 0 && x > std::numeric_limits::min ()))); +} + +// Safer pow functions. +// +// op2 \ op1: s m cs cm +// +-- +---+---+----+----+ +// scalar | | 1 | 5 | 7 | 11 | +// +---+---+----+----+ +// matrix | 2 | * | 8 | * | +// +---+---+----+----+ +// complex_scalar | 3 | 6 | 9 | 12 | +// +---+---+----+----+ +// complex_matrix | 4 | * | 10 | * | +// +---+---+----+----+ + +// -*- 1 -*- +octave_value +xpow (float a, float b) +{ + float retval; + + if (a < 0.0 && ! xisint (b)) + { + FloatComplex atmp (a); + + return std::pow (atmp, b); + } + else + retval = std::pow (a, b); + + return retval; +} + +// -*- 2 -*- +octave_value +xpow (float a, const FloatMatrix& b) +{ + octave_value retval; + + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.cols (); + + if (nr == 0 || nc == 0 || nr != nc) + error ("for x^A, A must be a square matrix"); + else + { + FloatEIG b_eig (b); + + if (! error_state) + { + FloatComplexColumnVector lambda (b_eig.eigenvalues ()); + FloatComplexMatrix Q (b_eig.eigenvectors ()); + + for (octave_idx_type i = 0; i < nr; i++) + { + FloatComplex elt = lambda(i); + if (std::imag (elt) == 0.0) + lambda(i) = std::pow (a, std::real (elt)); + else + lambda(i) = std::pow (a, elt); + } + FloatComplexDiagMatrix D (lambda); + + FloatComplexMatrix C = Q * D * Q.inverse (); + + if (a > 0) + retval = real (C); + else + retval = C; + } + else + error ("xpow: matrix diagonalization failed"); + } + + return retval; +} + +// -*- 3 -*- +octave_value +xpow (float a, const FloatComplex& b) +{ + FloatComplex result = std::pow (a, b); + return result; +} + +// -*- 4 -*- +octave_value +xpow (float a, const FloatComplexMatrix& b) +{ + octave_value retval; + + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.cols (); + + if (nr == 0 || nc == 0 || nr != nc) + error ("for x^A, A must be a square matrix"); + else + { + FloatEIG b_eig (b); + + if (! error_state) + { + FloatComplexColumnVector lambda (b_eig.eigenvalues ()); + FloatComplexMatrix Q (b_eig.eigenvectors ()); + + for (octave_idx_type i = 0; i < nr; i++) + { + FloatComplex elt = lambda(i); + if (std::imag (elt) == 0.0) + lambda(i) = std::pow (a, std::real (elt)); + else + lambda(i) = std::pow (a, elt); + } + FloatComplexDiagMatrix D (lambda); + + retval = FloatComplexMatrix (Q * D * Q.inverse ()); + } + else + error ("xpow: matrix diagonalization failed"); + } + + return retval; +} + +// -*- 5 -*- +octave_value +xpow (const FloatMatrix& a, float b) +{ + octave_value retval; + + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + if (nr == 0 || nc == 0 || nr != nc) + error ("for A^b, A must be a square matrix"); + else + { + if (static_cast (b) == b) + { + int btmp = static_cast (b); + if (btmp == 0) + { + retval = FloatDiagMatrix (nr, nr, 1.0); + } + else + { + // Too much copying? + // FIXME -- we shouldn't do this if the exponent is + // large... + + FloatMatrix atmp; + if (btmp < 0) + { + btmp = -btmp; + + octave_idx_type info; + float rcond = 0.0; + MatrixType mattype (a); + + atmp = a.inverse (mattype, info, rcond, 1); + + if (info == -1) + warning ("inverse: matrix singular to machine\ + precision, rcond = %g", rcond); + } + else + atmp = a; + + FloatMatrix result (atmp); + + btmp--; + + while (btmp > 0) + { + if (btmp & 1) + result = result * atmp; + + btmp >>= 1; + + if (btmp > 0) + atmp = atmp * atmp; + } + + retval = result; + } + } + else + { + FloatEIG a_eig (a); + + if (! error_state) + { + FloatComplexColumnVector lambda (a_eig.eigenvalues ()); + FloatComplexMatrix Q (a_eig.eigenvectors ()); + + for (octave_idx_type i = 0; i < nr; i++) + lambda(i) = std::pow (lambda(i), b); + + FloatComplexDiagMatrix D (lambda); + + retval = FloatComplexMatrix (Q * D * Q.inverse ()); + } + else + error ("xpow: matrix diagonalization failed"); + } + } + + return retval; +} + +// -*- 5d -*- +octave_value +xpow (const FloatDiagMatrix& a, float b) +{ + octave_value retval; + + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + if (nr == 0 || nc == 0 || nr != nc) + error ("for A^b, A must be a square matrix"); + else + { + if (static_cast (b) == b) + { + FloatDiagMatrix r (nr, nc); + for (octave_idx_type i = 0; i < nc; i++) + r.dgelem (i) = std::pow (a.dgelem (i), b); + retval = r; + } + else + { + FloatComplexDiagMatrix r (nr, nc); + for (octave_idx_type i = 0; i < nc; i++) + r.dgelem (i) = std::pow (static_cast (a.dgelem (i)), b); + retval = r; + } + } + + return retval; +} + +// -*- 6 -*- +octave_value +xpow (const FloatMatrix& a, const FloatComplex& b) +{ + octave_value retval; + + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + if (nr == 0 || nc == 0 || nr != nc) + error ("for A^b, A must be a square matrix"); + else + { + FloatEIG a_eig (a); + + if (! error_state) + { + FloatComplexColumnVector lambda (a_eig.eigenvalues ()); + FloatComplexMatrix Q (a_eig.eigenvectors ()); + + for (octave_idx_type i = 0; i < nr; i++) + lambda(i) = std::pow (lambda(i), b); + + FloatComplexDiagMatrix D (lambda); + + retval = FloatComplexMatrix (Q * D * Q.inverse ()); + } + else + error ("xpow: matrix diagonalization failed"); + } + + return retval; +} + +// -*- 7 -*- +octave_value +xpow (const FloatComplex& a, float b) +{ + FloatComplex result; + + if (xisint (b)) + result = std::pow (a, static_cast (b)); + else + result = std::pow (a, b); + + return result; +} + +// -*- 8 -*- +octave_value +xpow (const FloatComplex& a, const FloatMatrix& b) +{ + octave_value retval; + + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.cols (); + + if (nr == 0 || nc == 0 || nr != nc) + error ("for x^A, A must be a square matrix"); + else + { + FloatEIG b_eig (b); + + if (! error_state) + { + FloatComplexColumnVector lambda (b_eig.eigenvalues ()); + FloatComplexMatrix Q (b_eig.eigenvectors ()); + + for (octave_idx_type i = 0; i < nr; i++) + { + FloatComplex elt = lambda(i); + if (std::imag (elt) == 0.0) + lambda(i) = std::pow (a, std::real (elt)); + else + lambda(i) = std::pow (a, elt); + } + FloatComplexDiagMatrix D (lambda); + + retval = FloatComplexMatrix (Q * D * Q.inverse ()); + } + else + error ("xpow: matrix diagonalization failed"); + } + + return retval; +} + +// -*- 9 -*- +octave_value +xpow (const FloatComplex& a, const FloatComplex& b) +{ + FloatComplex result; + result = std::pow (a, b); + return result; +} + +// -*- 10 -*- +octave_value +xpow (const FloatComplex& a, const FloatComplexMatrix& b) +{ + octave_value retval; + + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.cols (); + + if (nr == 0 || nc == 0 || nr != nc) + error ("for x^A, A must be a square matrix"); + else + { + FloatEIG b_eig (b); + + if (! error_state) + { + FloatComplexColumnVector lambda (b_eig.eigenvalues ()); + FloatComplexMatrix Q (b_eig.eigenvectors ()); + + for (octave_idx_type i = 0; i < nr; i++) + { + FloatComplex elt = lambda(i); + if (std::imag (elt) == 0.0) + lambda(i) = std::pow (a, std::real (elt)); + else + lambda(i) = std::pow (a, elt); + } + FloatComplexDiagMatrix D (lambda); + + retval = FloatComplexMatrix (Q * D * Q.inverse ()); + } + else + error ("xpow: matrix diagonalization failed"); + } + + return retval; +} + +// -*- 11 -*- +octave_value +xpow (const FloatComplexMatrix& a, float b) +{ + octave_value retval; + + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + if (nr == 0 || nc == 0 || nr != nc) + error ("for A^b, A must be a square matrix"); + else + { + if (static_cast (b) == b) + { + int btmp = static_cast (b); + if (btmp == 0) + { + retval = FloatDiagMatrix (nr, nr, 1.0); + } + else + { + // Too much copying? + // FIXME -- we shouldn't do this if the exponent is + // large... + + FloatComplexMatrix atmp; + if (btmp < 0) + { + btmp = -btmp; + + octave_idx_type info; + float rcond = 0.0; + MatrixType mattype (a); + + atmp = a.inverse (mattype, info, rcond, 1); + + if (info == -1) + warning ("inverse: matrix singular to machine\ + precision, rcond = %g", rcond); + } + else + atmp = a; + + FloatComplexMatrix result (atmp); + + btmp--; + + while (btmp > 0) + { + if (btmp & 1) + result = result * atmp; + + btmp >>= 1; + + if (btmp > 0) + atmp = atmp * atmp; + } + + retval = result; + } + } + else + { + FloatEIG a_eig (a); + + if (! error_state) + { + FloatComplexColumnVector lambda (a_eig.eigenvalues ()); + FloatComplexMatrix Q (a_eig.eigenvectors ()); + + for (octave_idx_type i = 0; i < nr; i++) + lambda(i) = std::pow (lambda(i), b); + + FloatComplexDiagMatrix D (lambda); + + retval = FloatComplexMatrix (Q * D * Q.inverse ()); + } + else + error ("xpow: matrix diagonalization failed"); + } + } + + return retval; +} + +// -*- 12 -*- +octave_value +xpow (const FloatComplexMatrix& a, const FloatComplex& b) +{ + octave_value retval; + + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + if (nr == 0 || nc == 0 || nr != nc) + error ("for A^b, A must be a square matrix"); + else + { + FloatEIG a_eig (a); + + if (! error_state) + { + FloatComplexColumnVector lambda (a_eig.eigenvalues ()); + FloatComplexMatrix Q (a_eig.eigenvectors ()); + + for (octave_idx_type i = 0; i < nr; i++) + lambda(i) = std::pow (lambda(i), b); + + FloatComplexDiagMatrix D (lambda); + + retval = FloatComplexMatrix (Q * D * Q.inverse ()); + } + else + error ("xpow: matrix diagonalization failed"); + } + + return retval; +} + +// -*- 12d -*- +octave_value +xpow (const FloatComplexDiagMatrix& a, const FloatComplex& b) +{ + octave_value retval; + + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + if (nr == 0 || nc == 0 || nr != nc) + error ("for A^b, A must be a square matrix"); + else + { + FloatComplexDiagMatrix r (nr, nc); + for (octave_idx_type i = 0; i < nc; i++) + r(i, i) = std::pow (a(i, i), b); + retval = r; + } + + return retval; +} + +// mixed +octave_value +xpow (const FloatComplexDiagMatrix& a, float b) +{ + return xpow (a, static_cast (b)); +} + +octave_value +xpow (const FloatDiagMatrix& a, const FloatComplex& b) +{ + return xpow (FloatComplexDiagMatrix (a), b); +} + +// Safer pow functions that work elementwise for matrices. +// +// op2 \ op1: s m cs cm +// +-- +---+---+----+----+ +// scalar | | * | 3 | * | 9 | +// +---+---+----+----+ +// matrix | 1 | 4 | 7 | 10 | +// +---+---+----+----+ +// complex_scalar | * | 5 | * | 11 | +// +---+---+----+----+ +// complex_matrix | 2 | 6 | 8 | 12 | +// +---+---+----+----+ +// +// * -> not needed. + +// FIXME -- these functions need to be fixed so that things +// like +// +// a = -1; b = [ 0, 0.5, 1 ]; r = a .^ b +// +// and +// +// a = -1; b = [ 0, 0.5, 1 ]; for i = 1:3, r(i) = a .^ b(i), end +// +// produce identical results. Also, it would be nice if -1^0.5 +// produced a pure imaginary result instead of a complex number with a +// small real part. But perhaps that's really a problem with the math +// library... + +// -*- 1 -*- +octave_value +elem_xpow (float a, const FloatMatrix& b) +{ + octave_value retval; + + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.cols (); + + float d1, d2; + + if (a < 0.0 && ! b.all_integers (d1, d2)) + { + FloatComplex atmp (a); + FloatComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = std::pow (atmp, b (i, j)); + } + + retval = result; + } + else + { + FloatMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = std::pow (a, b (i, j)); + } + + retval = result; + } + + return retval; +} + +// -*- 2 -*- +octave_value +elem_xpow (float a, const FloatComplexMatrix& b) +{ + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.cols (); + + FloatComplexMatrix result (nr, nc); + FloatComplex atmp (a); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = std::pow (atmp, b (i, j)); + } + + return result; +} + +// -*- 3 -*- +octave_value +elem_xpow (const FloatMatrix& a, float b) +{ + octave_value retval; + + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + if (! xisint (b) && a.any_element_is_negative ()) + { + FloatComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + + FloatComplex atmp (a (i, j)); + + result (i, j) = std::pow (atmp, b); + } + + retval = result; + } + else + { + FloatMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = std::pow (a (i, j), b); + } + + retval = result; + } + + return retval; +} + +// -*- 4 -*- +octave_value +elem_xpow (const FloatMatrix& a, const FloatMatrix& b) +{ + octave_value retval; + + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + + if (nr != b_nr || nc != b_nc) + { + gripe_nonconformant ("operator .^", nr, nc, b_nr, b_nc); + return octave_value (); + } + + int convert_to_complex = 0; + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + float atmp = a (i, j); + float btmp = b (i, j); + if (atmp < 0.0 && static_cast (btmp) != btmp) + { + convert_to_complex = 1; + goto done; + } + } + +done: + + if (convert_to_complex) + { + FloatComplexMatrix complex_result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + FloatComplex atmp (a (i, j)); + FloatComplex btmp (b (i, j)); + complex_result (i, j) = std::pow (atmp, btmp); + } + + retval = complex_result; + } + else + { + FloatMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = std::pow (a (i, j), b (i, j)); + } + + retval = result; + } + + return retval; +} + +// -*- 5 -*- +octave_value +elem_xpow (const FloatMatrix& a, const FloatComplex& b) +{ + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + FloatComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = std::pow (FloatComplex (a (i, j)), b); + } + + return result; +} + +// -*- 6 -*- +octave_value +elem_xpow (const FloatMatrix& a, const FloatComplexMatrix& b) +{ + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + + if (nr != b_nr || nc != b_nc) + { + gripe_nonconformant ("operator .^", nr, nc, b_nr, b_nc); + return octave_value (); + } + + FloatComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = std::pow (FloatComplex (a (i, j)), b (i, j)); + } + + return result; +} + +// -*- 7 -*- +octave_value +elem_xpow (const FloatComplex& a, const FloatMatrix& b) +{ + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.cols (); + + FloatComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + float btmp = b (i, j); + if (xisint (btmp)) + result (i, j) = std::pow (a, static_cast (btmp)); + else + result (i, j) = std::pow (a, btmp); + } + + return result; +} + +// -*- 8 -*- +octave_value +elem_xpow (const FloatComplex& a, const FloatComplexMatrix& b) +{ + octave_idx_type nr = b.rows (); + octave_idx_type nc = b.cols (); + + FloatComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = std::pow (a, b (i, j)); + } + + return result; +} + +// -*- 9 -*- +octave_value +elem_xpow (const FloatComplexMatrix& a, float b) +{ + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + FloatComplexMatrix result (nr, nc); + + if (xisint (b)) + { + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = std::pow (a (i, j), static_cast (b)); + } + } + else + { + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = std::pow (a (i, j), b); + } + } + + return result; +} + +// -*- 10 -*- +octave_value +elem_xpow (const FloatComplexMatrix& a, const FloatMatrix& b) +{ + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + + if (nr != b_nr || nc != b_nc) + { + gripe_nonconformant ("operator .^", nr, nc, b_nr, b_nc); + return octave_value (); + } + + FloatComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + float btmp = b (i, j); + if (xisint (btmp)) + result (i, j) = std::pow (a (i, j), static_cast (btmp)); + else + result (i, j) = std::pow (a (i, j), btmp); + } + + return result; +} + +// -*- 11 -*- +octave_value +elem_xpow (const FloatComplexMatrix& a, const FloatComplex& b) +{ + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + FloatComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = std::pow (a (i, j), b); + } + + return result; +} + +// -*- 12 -*- +octave_value +elem_xpow (const FloatComplexMatrix& a, const FloatComplexMatrix& b) +{ + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + + if (nr != b_nr || nc != b_nc) + { + gripe_nonconformant ("operator .^", nr, nc, b_nr, b_nc); + return octave_value (); + } + + FloatComplexMatrix result (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + result (i, j) = std::pow (a (i, j), b (i, j)); + } + + return result; +} + +// Safer pow functions that work elementwise for N-d arrays. +// +// op2 \ op1: s nd cs cnd +// +-- +---+---+----+----+ +// scalar | | * | 3 | * | 9 | +// +---+---+----+----+ +// N_d | 1 | 4 | 7 | 10 | +// +---+---+----+----+ +// complex_scalar | * | 5 | * | 11 | +// +---+---+----+----+ +// complex_N_d | 2 | 6 | 8 | 12 | +// +---+---+----+----+ +// +// * -> not needed. + +// FIXME -- these functions need to be fixed so that things +// like +// +// a = -1; b = [ 0, 0.5, 1 ]; r = a .^ b +// +// and +// +// a = -1; b = [ 0, 0.5, 1 ]; for i = 1:3, r(i) = a .^ b(i), end +// +// produce identical results. Also, it would be nice if -1^0.5 +// produced a pure imaginary result instead of a complex number with a +// small real part. But perhaps that's really a problem with the math +// library... + +// -*- 1 -*- +octave_value +elem_xpow (float a, const FloatNDArray& b) +{ + octave_value retval; + + if (a < 0.0 && ! b.all_integers ()) + { + FloatComplex atmp (a); + FloatComplexNDArray result (b.dims ()); + for (octave_idx_type i = 0; i < b.length (); i++) + { + octave_quit (); + result(i) = std::pow (atmp, b(i)); + } + + retval = result; + } + else + { + FloatNDArray result (b.dims ()); + for (octave_idx_type i = 0; i < b.length (); i++) + { + octave_quit (); + result (i) = std::pow (a, b(i)); + } + + retval = result; + } + + return retval; +} + +// -*- 2 -*- +octave_value +elem_xpow (float a, const FloatComplexNDArray& b) +{ + FloatComplexNDArray result (b.dims ()); + + for (octave_idx_type i = 0; i < b.length (); i++) + { + octave_quit (); + result(i) = std::pow (a, b(i)); + } + + return result; +} + +// -*- 3 -*- +octave_value +elem_xpow (const FloatNDArray& a, float b) +{ + octave_value retval; + + if (! xisint (b)) + { + if (a.any_element_is_negative ()) + { + FloatComplexNDArray result (a.dims ()); + + for (octave_idx_type i = 0; i < a.length (); i++) + { + octave_quit (); + + FloatComplex atmp (a (i)); + + result(i) = std::pow (atmp, b); + } + + retval = result; + } + else + { + FloatNDArray result (a.dims ()); + for (octave_idx_type i = 0; i < a.length (); i++) + { + octave_quit (); + result(i) = std::pow (a(i), b); + } + + retval = result; + } + } + else + { + NoAlias result (a.dims ()); + + int ib = static_cast (b); + if (ib == 2) + { + for (octave_idx_type i = 0; i < a.length (); i++) + result(i) = a(i) * a(i); + } + else if (ib == 3) + { + for (octave_idx_type i = 0; i < a.length (); i++) + result(i) = a(i) * a(i) * a(i); + } + else if (ib == -1) + { + for (octave_idx_type i = 0; i < a.length (); i++) + result(i) = 1.0f / a(i); + } + else + { + for (octave_idx_type i = 0; i < a.length (); i++) + { + octave_quit (); + result(i) = std::pow (a(i), ib); + } + } + + retval = result; + } + + return retval; +} + +// -*- 4 -*- +octave_value +elem_xpow (const FloatNDArray& a, const FloatNDArray& b) +{ + octave_value retval; + + dim_vector a_dims = a.dims (); + dim_vector b_dims = b.dims (); + + if (a_dims != b_dims) + { + if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) + { + //Potentially complex results + FloatNDArray xa = octave_value_extract (a); + FloatNDArray xb = octave_value_extract (b); + if (! xb.all_integers () && xa.any_element_is_negative ()) + return octave_value (bsxfun_pow (FloatComplexNDArray (xa), xb)); + else + return octave_value (bsxfun_pow (xa, xb)); + } + else + { + gripe_nonconformant ("operator .^", a_dims, b_dims); + return octave_value (); + } + } + + int len = a.length (); + + bool convert_to_complex = false; + + for (octave_idx_type i = 0; i < len; i++) + { + octave_quit (); + float atmp = a(i); + float btmp = b(i); + if (atmp < 0.0 && static_cast (btmp) != btmp) + { + convert_to_complex = true; + goto done; + } + } + +done: + + if (convert_to_complex) + { + FloatComplexNDArray complex_result (a_dims); + + for (octave_idx_type i = 0; i < len; i++) + { + octave_quit (); + FloatComplex atmp (a(i)); + complex_result(i) = std::pow (atmp, b(i)); + } + + retval = complex_result; + } + else + { + FloatNDArray result (a_dims); + + for (octave_idx_type i = 0; i < len; i++) + { + octave_quit (); + result(i) = std::pow (a(i), b(i)); + } + + retval = result; + } + + return retval; +} + +// -*- 5 -*- +octave_value +elem_xpow (const FloatNDArray& a, const FloatComplex& b) +{ + FloatComplexNDArray result (a.dims ()); + + for (octave_idx_type i = 0; i < a.length (); i++) + { + octave_quit (); + result(i) = std::pow (a(i), b); + } + + return result; +} + +// -*- 6 -*- +octave_value +elem_xpow (const FloatNDArray& a, const FloatComplexNDArray& b) +{ + dim_vector a_dims = a.dims (); + dim_vector b_dims = b.dims (); + + if (a_dims != b_dims) + { + if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) + { + return bsxfun_pow (a, b); + } + else + { + gripe_nonconformant ("operator .^", a_dims, b_dims); + return octave_value (); + } + } + + FloatComplexNDArray result (a_dims); + + for (octave_idx_type i = 0; i < a.length (); i++) + { + octave_quit (); + result(i) = std::pow (a(i), b(i)); + } + + return result; +} + +// -*- 7 -*- +octave_value +elem_xpow (const FloatComplex& a, const FloatNDArray& b) +{ + FloatComplexNDArray result (b.dims ()); + + for (octave_idx_type i = 0; i < b.length (); i++) + { + octave_quit (); + float btmp = b(i); + if (xisint (btmp)) + result(i) = std::pow (a, static_cast (btmp)); + else + result(i) = std::pow (a, btmp); + } + + return result; +} + +// -*- 8 -*- +octave_value +elem_xpow (const FloatComplex& a, const FloatComplexNDArray& b) +{ + FloatComplexNDArray result (b.dims ()); + + for (octave_idx_type i = 0; i < b.length (); i++) + { + octave_quit (); + result(i) = std::pow (a, b(i)); + } + + return result; +} + +// -*- 9 -*- +octave_value +elem_xpow (const FloatComplexNDArray& a, float b) +{ + FloatComplexNDArray result (a.dims ()); + + if (xisint (b)) + { + if (b == -1) + { + for (octave_idx_type i = 0; i < a.length (); i++) + result.xelem (i) = 1.0f / a(i); + } + else + { + for (octave_idx_type i = 0; i < a.length (); i++) + { + octave_quit (); + result(i) = std::pow (a(i), static_cast (b)); + } + } + } + else + { + for (octave_idx_type i = 0; i < a.length (); i++) + { + octave_quit (); + result(i) = std::pow (a(i), b); + } + } + + return result; +} + +// -*- 10 -*- +octave_value +elem_xpow (const FloatComplexNDArray& a, const FloatNDArray& b) +{ + dim_vector a_dims = a.dims (); + dim_vector b_dims = b.dims (); + + if (a_dims != b_dims) + { + if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) + { + return bsxfun_pow (a, b); + } + else + { + gripe_nonconformant ("operator .^", a_dims, b_dims); + return octave_value (); + } + } + + FloatComplexNDArray result (a_dims); + + for (octave_idx_type i = 0; i < a.length (); i++) + { + octave_quit (); + float btmp = b(i); + if (xisint (btmp)) + result(i) = std::pow (a(i), static_cast (btmp)); + else + result(i) = std::pow (a(i), btmp); + } + + return result; +} + +// -*- 11 -*- +octave_value +elem_xpow (const FloatComplexNDArray& a, const FloatComplex& b) +{ + FloatComplexNDArray result (a.dims ()); + + for (octave_idx_type i = 0; i < a.length (); i++) + { + octave_quit (); + result(i) = std::pow (a(i), b); + } + + return result; +} + +// -*- 12 -*- +octave_value +elem_xpow (const FloatComplexNDArray& a, const FloatComplexNDArray& b) +{ + dim_vector a_dims = a.dims (); + dim_vector b_dims = b.dims (); + + if (a_dims != b_dims) + { + if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) + { + return bsxfun_pow (a, b); + } + else + { + gripe_nonconformant ("operator .^", a_dims, b_dims); + return octave_value (); + } + } + + FloatComplexNDArray result (a_dims); + + for (octave_idx_type i = 0; i < a.length (); i++) + { + octave_quit (); + result(i) = std::pow (a(i), b(i)); + } + + return result; +} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/xpow.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/xpow.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,158 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_xpow_h) +#define octave_xpow_h 1 + +#include "oct-cmplx.h" + +class Matrix; +class ComplexMatrix; +class FloatMatrix; +class FloatComplexMatrix; +class DiagMatrix; +class ComplexDiagMatrix; +class FloatDiagMatrix; +class FloatComplexDiagMatrix; +class PermMatrix; +class NDArray; +class FloatNDArray; +class ComplexNDArray; +class FloatComplexNDArray; +class octave_value; +class Range; + +extern OCTINTERP_API octave_value xpow (double a, double b); +extern OCTINTERP_API octave_value xpow (double a, const Matrix& b); +extern OCTINTERP_API octave_value xpow (double a, const Complex& b); +extern OCTINTERP_API octave_value xpow (double a, const ComplexMatrix& b); + +extern OCTINTERP_API octave_value xpow (const Matrix& a, double b); +extern OCTINTERP_API octave_value xpow (const Matrix& a, const Complex& b); + +extern OCTINTERP_API octave_value xpow (const DiagMatrix& a, double b); +extern OCTINTERP_API octave_value xpow (const DiagMatrix& a, const Complex& b); + +extern OCTINTERP_API octave_value xpow (const PermMatrix& a, double b); + +extern OCTINTERP_API octave_value xpow (const Complex& a, double b); +extern OCTINTERP_API octave_value xpow (const Complex& a, const Matrix& b); +extern OCTINTERP_API octave_value xpow (const Complex& a, const Complex& b); +extern OCTINTERP_API octave_value xpow (const Complex& a, const ComplexMatrix& b); + +extern OCTINTERP_API octave_value xpow (const ComplexMatrix& a, double b); +extern OCTINTERP_API octave_value xpow (const ComplexMatrix& a, const Complex& b); + +extern OCTINTERP_API octave_value xpow (const ComplexDiagMatrix& a, double b); +extern OCTINTERP_API octave_value xpow (const ComplexDiagMatrix& a, const Complex& b); + +extern OCTINTERP_API octave_value elem_xpow (double a, const Matrix& b); +extern OCTINTERP_API octave_value elem_xpow (double a, const ComplexMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (double a, const Range& r); + +extern OCTINTERP_API octave_value elem_xpow (const Matrix& a, double b); +extern OCTINTERP_API octave_value elem_xpow (const Matrix& a, const Matrix& b); +extern OCTINTERP_API octave_value elem_xpow (const Matrix& a, const Complex& b); +extern OCTINTERP_API octave_value elem_xpow (const Matrix& a, const ComplexMatrix& b); + +extern OCTINTERP_API octave_value elem_xpow (const Complex& a, const Matrix& b); +extern OCTINTERP_API octave_value elem_xpow (const Complex& a, const ComplexMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (const Complex& a, const Range& r); + +extern OCTINTERP_API octave_value elem_xpow (const ComplexMatrix& a, double b); +extern OCTINTERP_API octave_value elem_xpow (const ComplexMatrix& a, const Matrix& b); +extern OCTINTERP_API octave_value elem_xpow (const ComplexMatrix& a, const Complex& b); +extern OCTINTERP_API octave_value elem_xpow (const ComplexMatrix& a, const ComplexMatrix& b); + + +extern OCTINTERP_API octave_value elem_xpow (double a, const NDArray& b); +extern OCTINTERP_API octave_value elem_xpow (double a, const ComplexNDArray& b); + +extern OCTINTERP_API octave_value elem_xpow (const NDArray& a, double b); +extern OCTINTERP_API octave_value elem_xpow (const NDArray& a, const NDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const NDArray& a, const Complex& b); +extern OCTINTERP_API octave_value elem_xpow (const NDArray& a, const ComplexNDArray& b); + +extern OCTINTERP_API octave_value elem_xpow (const Complex& a, const NDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const Complex& a, const ComplexNDArray& b); + +extern OCTINTERP_API octave_value elem_xpow (const ComplexNDArray& a, double b); +extern OCTINTERP_API octave_value elem_xpow (const ComplexNDArray& a, const NDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const ComplexNDArray& a, const Complex& b); +extern OCTINTERP_API octave_value elem_xpow (const ComplexNDArray& a, const ComplexNDArray& b); + +extern OCTINTERP_API octave_value xpow (float a, float b); +extern OCTINTERP_API octave_value xpow (float a, const FloatMatrix& b); +extern OCTINTERP_API octave_value xpow (float a, const FloatComplex& b); +extern OCTINTERP_API octave_value xpow (float a, const FloatComplexMatrix& b); + +extern OCTINTERP_API octave_value xpow (const FloatMatrix& a, float b); +extern OCTINTERP_API octave_value xpow (const FloatMatrix& a, const FloatComplex& b); + +extern OCTINTERP_API octave_value xpow (const FloatDiagMatrix& a, float b); +extern OCTINTERP_API octave_value xpow (const FloatDiagMatrix& a, const FloatComplex& b); + +extern OCTINTERP_API octave_value xpow (const FloatComplex& a, float b); +extern OCTINTERP_API octave_value xpow (const FloatComplex& a, const FloatMatrix& b); +extern OCTINTERP_API octave_value xpow (const FloatComplex& a, const FloatComplex& b); +extern OCTINTERP_API octave_value xpow (const FloatComplex& a, const FloatComplexMatrix& b); + +extern OCTINTERP_API octave_value xpow (const FloatComplexMatrix& a, float b); +extern OCTINTERP_API octave_value xpow (const FloatComplexMatrix& a, const FloatComplex& b); + +extern OCTINTERP_API octave_value xpow (const FloatComplexDiagMatrix& a, float b); +extern OCTINTERP_API octave_value xpow (const FloatComplexDiagMatrix& a, const FloatComplex& b); + +extern OCTINTERP_API octave_value elem_xpow (float a, const FloatMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (float a, const FloatComplexMatrix& b); + +extern OCTINTERP_API octave_value elem_xpow (const FloatMatrix& a, float b); +extern OCTINTERP_API octave_value elem_xpow (const FloatMatrix& a, const FloatMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatMatrix& a, const FloatComplex& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatMatrix& a, const FloatComplexMatrix& b); + +extern OCTINTERP_API octave_value elem_xpow (const FloatComplex& a, const FloatMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplex& a, const FloatComplexMatrix& b); + +extern OCTINTERP_API octave_value elem_xpow (const FloatComplexMatrix& a, float b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplexMatrix& a, const FloatMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplexMatrix& a, const FloatComplex& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplexMatrix& a, const FloatComplexMatrix& b); + + +extern OCTINTERP_API octave_value elem_xpow (float a, const FloatNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (float a, const FloatComplexNDArray& b); + +extern OCTINTERP_API octave_value elem_xpow (const FloatNDArray& a, float b); +extern OCTINTERP_API octave_value elem_xpow (const FloatNDArray& a, const FloatNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatNDArray& a, const FloatComplex& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatNDArray& a, const FloatComplexNDArray& b); + +extern OCTINTERP_API octave_value elem_xpow (const FloatComplex& a, const FloatNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplex& a, const FloatComplexNDArray& b); + +extern OCTINTERP_API octave_value elem_xpow (const FloatComplexNDArray& a, float b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplexNDArray& a, const FloatNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplexNDArray& a, const FloatComplex& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplexNDArray& a, const FloatComplexNDArray& b); + +#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/zfstream.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/zfstream.cc Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,630 @@ +/* + +Copyright (C) 2005-2012 Ludwig Schwardt, Kevin Ruland + + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +/* + + This file is adapted from the zlib 1.2.2 contrib/iostream3 code, + written by + + Ludwig Schwardt + original version by Kevin Ruland + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "zfstream.h" + +#ifdef HAVE_ZLIB + +#include // for strcpy, strcat, strlen (mode strings) +#include // for BUFSIZ + +// Internal buffer sizes (default and "unbuffered" versions) +#define STASHED_CHARACTERS 16 +#define BIGBUFSIZE (256 * 1024 + STASHED_CHARACTERS) +#define SMALLBUFSIZE 1 + +/*****************************************************************************/ + +// Default constructor +gzfilebuf::gzfilebuf () +: file(0), io_mode(std::ios_base::openmode(0)), own_fd(false), + buffer(0), buffer_size(BIGBUFSIZE), own_buffer(true) +{ + // No buffers to start with + this->disable_buffer (); +} + +// Destructor +gzfilebuf::~gzfilebuf () +{ + // Sync output buffer and close only if responsible for file + // (i.e. attached streams should be left open at this stage) + this->sync (); + if (own_fd) + this->close (); + // Make sure internal buffer is deallocated + this->disable_buffer (); +} + +// Set compression level and strategy +int +gzfilebuf::setcompression (int comp_level, + int comp_strategy) +{ + return gzsetparams (file, comp_level, comp_strategy); +} + +// Open gzipped file +gzfilebuf* +gzfilebuf::open (const char *name, + std::ios_base::openmode mode) +{ + // Fail if file already open + if (this->is_open ()) + return 0; + // Don't support simultaneous read/write access (yet) + if ((mode & std::ios_base::in) && (mode & std::ios_base::out)) + return 0; + + // Build mode string for gzopen and check it [27.8.1.3.2] + char char_mode[6] = "\0\0\0\0\0"; + if (! this->open_mode (mode, char_mode)) + return 0; + + // Attempt to open file + if ((file = gzopen (name, char_mode)) == 0) + return 0; + + // On success, allocate internal buffer and set flags + this->enable_buffer (); + io_mode = mode; + own_fd = true; + return this; +} + +// Attach to gzipped file +gzfilebuf* +gzfilebuf::attach (int fd, + std::ios_base::openmode mode) +{ + // Fail if file already open + if (this->is_open ()) + return 0; + // Don't support simultaneous read/write access (yet) + if ((mode & std::ios_base::in) && (mode & std::ios_base::out)) + return 0; + + // Build mode string for gzdopen and check it [27.8.1.3.2] + char char_mode[6] = "\0\0\0\0\0"; + if (! this->open_mode (mode, char_mode)) + return 0; + + // Attempt to attach to file + if ((file = gzdopen (fd, char_mode)) == 0) + return 0; + + // On success, allocate internal buffer and set flags + this->enable_buffer (); + io_mode = mode; + own_fd = false; + return this; +} + +// Close gzipped file +gzfilebuf* +gzfilebuf::close () +{ + // Fail immediately if no file is open + if (! this->is_open ()) + return 0; + // Assume success + gzfilebuf* retval = this; + // Attempt to sync and close gzipped file + if (this->sync () == -1) + retval = 0; + if (gzclose (file) < 0) + retval = 0; + // File is now gone anyway (postcondition [27.8.1.3.8]) + file = 0; + own_fd = false; + // Destroy internal buffer if it exists + this->disable_buffer (); + return retval; +} + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ + +// Convert int open mode to mode string +bool +gzfilebuf::open_mode (std::ios_base::openmode mode, + char* c_mode) const +{ + // FIXME -- do we need testb? + // bool testb = mode & std::ios_base::binary; + bool testi = mode & std::ios_base::in; + bool testo = mode & std::ios_base::out; + bool testt = mode & std::ios_base::trunc; + bool testa = mode & std::ios_base::app; + + // Check for valid flag combinations - see [27.8.1.3.2] (Table 92) + // Original zfstream hardcoded the compression level to maximum here... + // Double the time for less than 1% size improvement seems + // excessive though - keeping it at the default level + // To change back, just append "9" to the next three mode strings + if (!testi && testo && !testt && !testa) + strcpy (c_mode, "w"); + if (!testi && testo && !testt && testa) + strcpy (c_mode, "a"); + if (!testi && testo && testt && !testa) + strcpy (c_mode, "w"); + if (testi && !testo && !testt && !testa) + strcpy (c_mode, "r"); + // No read/write mode yet +// if (testi && testo && !testt && !testa) +// strcpy(c_mode, "r+"); +// if (testi && testo && testt && !testa) +// strcpy(c_mode, "w+"); + + // Mode string should be empty for invalid combination of flags + if (strlen (c_mode) == 0) + return false; + + strcat (c_mode, "b"); + + return true; +} + +// Determine number of characters in internal get buffer +std::streamsize +gzfilebuf::showmanyc () +{ + // Calls to underflow will fail if file not opened for reading + if (! this->is_open () || !(io_mode & std::ios_base::in)) + return -1; + // Make sure get area is in use + if (this->gptr () && (this->gptr () < this->egptr ())) + return std::streamsize (this->egptr () - this->gptr ()); + else + return 0; +} + +// Puts back a character to the stream in two cases. Firstly, when there +// is no putback position available, and secondly when the character putback +// differs from the one in the file. We can only support the first case +// with gzipped files. +gzfilebuf::int_type +gzfilebuf::pbackfail (gzfilebuf::int_type c) +{ + if (this->is_open ()) + { + if (gzseek (file, this->gptr () - this->egptr () - 1, SEEK_CUR) < 0) + return traits_type::eof (); + + // Invalidates contents of the buffer + enable_buffer (); + + // Attempt to fill internal buffer from gzipped file + // (buffer must be guaranteed to exist...) + int bytes_read = gzread (file, buffer, buffer_size); + // Indicates error or EOF + if (bytes_read <= 0) + { + // Reset get area + this->setg (buffer, buffer, buffer); + return traits_type::eof (); + } + + // Make all bytes read from file available as get area + this->setg (buffer, buffer, buffer + bytes_read); + + // If next character in get area differs from putback character + // flag a failure + gzfilebuf::int_type ret = traits_type::to_int_type (*(this->gptr ())); + if (ret != c) + return traits_type::eof (); + else + return ret; + } + else + return traits_type::eof (); +} + +// Fill get area from gzipped file +gzfilebuf::int_type +gzfilebuf::underflow () +{ + // If something is left in the get area by chance, return it + // (this shouldn't normally happen, as underflow is only supposed + // to be called when gptr >= egptr, but it serves as error check) + if (this->gptr () && (this->gptr () < this->egptr ())) + return traits_type::to_int_type (*(this->gptr ())); + + // If the file hasn't been opened for reading, produce error + if (! this->is_open () || !(io_mode & std::ios_base::in)) + return traits_type::eof (); + + // Copy the final characters to the front of the buffer + int stash = 0; + if (this->eback () && buffer && buffer_size > STASHED_CHARACTERS) + { + char_type *ptr1 = buffer; + char_type *ptr2 = this->egptr () - STASHED_CHARACTERS + 1; + if (ptr2 > this->eback ()) + while (stash++ <= STASHED_CHARACTERS) + *ptr1++ = *ptr2++; + } + + // Attempt to fill internal buffer from gzipped file + // (buffer must be guaranteed to exist...) + int bytes_read = gzread (file, buffer + stash, buffer_size - stash); + + // Indicates error or EOF + if (bytes_read <= 0) + { + // Reset get area + this->setg (buffer, buffer, buffer); + return traits_type::eof (); + } + // Make all bytes read from file plus the stash available as get area + this->setg (buffer, buffer + stash, buffer + bytes_read + stash); + + // Return next character in get area + return traits_type::to_int_type (*(this->gptr ())); +} + +// Write put area to gzipped file +gzfilebuf::int_type +gzfilebuf::overflow (int_type c) +{ + // Determine whether put area is in use + if (this->pbase ()) + { + // Double-check pointer range + if (this->pptr () > this->epptr () || this->pptr () < this->pbase ()) + return traits_type::eof (); + // Add extra character to buffer if not EOF + if (! traits_type::eq_int_type (c, traits_type::eof ())) + { + *(this->pptr ()) = traits_type::to_char_type (c); + this->pbump (1); + } + // Number of characters to write to file + int bytes_to_write = this->pptr () - this->pbase (); + // Overflow doesn't fail if nothing is to be written + if (bytes_to_write > 0) + { + // If the file hasn't been opened for writing, produce error + if (! this->is_open () || !(io_mode & std::ios_base::out)) + return traits_type::eof (); + // If gzipped file won't accept all bytes written to it, fail + if (gzwrite (file, this->pbase (), bytes_to_write) != bytes_to_write) + return traits_type::eof (); + // Reset next pointer to point to pbase on success + this->pbump (-bytes_to_write); + } + } + // Write extra character to file if not EOF + else if (! traits_type::eq_int_type (c, traits_type::eof ())) + { + // If the file hasn't been opened for writing, produce error + if (! this->is_open () || !(io_mode & std::ios_base::out)) + return traits_type::eof (); + // Impromptu char buffer (allows "unbuffered" output) + char_type last_char = traits_type::to_char_type (c); + // If gzipped file won't accept this character, fail + if (gzwrite (file, &last_char, 1) != 1) + return traits_type::eof (); + } + + // If you got here, you have succeeded (even if c was EOF) + // The return value should therefore be non-EOF + if (traits_type::eq_int_type (c, traits_type::eof ())) + return traits_type::not_eof (c); + else + return c; +} + +// Assign new buffer +std::streambuf* +gzfilebuf::setbuf (char_type* p, + std::streamsize n) +{ + // First make sure stuff is sync'ed, for safety + if (this->sync () == -1) + return 0; + // If buffering is turned off on purpose via setbuf(0,0), still allocate one... + // "Unbuffered" only really refers to put [27.8.1.4.10], while get needs at + // least a buffer of size 1 (very inefficient though, therefore make it bigger?) + // This follows from [27.5.2.4.3]/12 (gptr needs to point at something, it seems) + if (!p || !n) + { + // Replace existing buffer (if any) with small internal buffer + this->disable_buffer (); + buffer = 0; + buffer_size = 0; + own_buffer = true; + this->enable_buffer (); + } + else + { + // Replace existing buffer (if any) with external buffer + this->disable_buffer (); + buffer = p; + buffer_size = n; + own_buffer = false; + this->enable_buffer (); + } + return this; +} + +// Write put area to gzipped file (i.e. ensures that put area is empty) +int +gzfilebuf::sync () +{ + return traits_type::eq_int_type (this->overflow (), traits_type::eof ()) ? -1 : 0; +} + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ + +// Allocate internal buffer +void +gzfilebuf::enable_buffer () +{ + // If internal buffer required, allocate one + if (own_buffer && !buffer) + { + // Check for buffered vs. "unbuffered" + if (buffer_size > 0) + { + // Allocate internal buffer + buffer = new char_type [buffer_size]; + // Get area starts empty and will be expanded by underflow as need arises + this->setg (buffer, buffer, buffer); + // Setup entire internal buffer as put area. + // The one-past-end pointer actually points to the last element of the buffer, + // so that overflow(c) can safely add the extra character c to the sequence. + // These pointers remain in place for the duration of the buffer + this->setp (buffer, buffer + buffer_size - 1); + } + else + { + // Even in "unbuffered" case, (small?) get buffer is still required + buffer_size = SMALLBUFSIZE; + buffer = new char_type [buffer_size]; + this->setg (buffer, buffer, buffer); + // "Unbuffered" means no put buffer + this->setp (0, 0); + } + } + else + { + // If buffer already allocated, reset buffer pointers just to make sure no + // stale chars are lying around + this->setg (buffer, buffer, buffer); + this->setp (buffer, buffer + buffer_size - 1); + } +} + +// Destroy internal buffer +void +gzfilebuf::disable_buffer () +{ + // If internal buffer exists, deallocate it + if (own_buffer && buffer) + { + // Preserve unbuffered status by zeroing size + if (! this->pbase ()) + buffer_size = 0; + delete[] buffer; + buffer = 0; + this->setg (0, 0, 0); + this->setp (0, 0); + } + else + { + // Reset buffer pointers to initial state if external buffer exists + this->setg (buffer, buffer, buffer); + if (buffer) + this->setp (buffer, buffer + buffer_size - 1); + else + this->setp (0, 0); + } +} + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ + +// Seek functions +gzfilebuf::pos_type +gzfilebuf::seekoff (off_type off, std::ios_base::seekdir way, + std::ios_base::openmode) +{ + pos_type ret = pos_type (off_type (-1)); + + if (this->is_open ()) + { + off_type computed_off = off; + + if ((io_mode & std::ios_base::in) && way == std::ios_base::cur) + computed_off += this->gptr () - this->egptr (); + + // Handle tellg/tellp as a special case up front, no need to seek + // or invalidate get/put buffers + if (off == 0 && way == std::ios_base::cur) + return pos_type (gztell (file) + computed_off); + + if (way == std::ios_base::beg) + ret = pos_type (gzseek (file, computed_off, SEEK_SET)); + else if (way == std::ios_base::cur) + ret = pos_type (gzseek (file, computed_off, SEEK_CUR)); + else + // Can't seek from end of a gzipped file, so this will give -1 + ret = pos_type (gzseek (file, computed_off, SEEK_END)); + + if (io_mode & std::ios_base::in) + // Invalidates contents of the buffer + enable_buffer (); + else + // flush contents of buffer to file + overflow (); + } + + return ret; +} + +gzfilebuf::pos_type +gzfilebuf::seekpos (pos_type sp, std::ios_base::openmode) +{ + pos_type ret = pos_type (off_type (-1)); + + if (this->is_open ()) + { + ret = pos_type (gzseek (file, sp, SEEK_SET)); + + if (io_mode & std::ios_base::in) + // Invalidates contents of the buffer + enable_buffer (); + else + // flush contents of buffer to file + overflow (); + } + + return ret; +} + +/*****************************************************************************/ + +// Default constructor initializes stream buffer +gzifstream::gzifstream () +: std::istream (0), sb () +{ this->init (&sb); } + +// Initialize stream buffer and open file +gzifstream::gzifstream (const char* name, + std::ios_base::openmode mode) +: std::istream (0), sb () +{ + this->init (&sb); + this->open (name, mode); +} + +// Initialize stream buffer and attach to file +gzifstream::gzifstream (int fd, + std::ios_base::openmode mode) +: std::istream (0), sb () +{ + this->init (&sb); + this->attach (fd, mode); +} + +// Open file and go into fail() state if unsuccessful +void +gzifstream::open (const char* name, + std::ios_base::openmode mode) +{ + if (! sb.open (name, mode | std::ios_base::in)) + this->setstate (std::ios_base::failbit); + else + this->clear (); +} + +// Attach to file and go into fail() state if unsuccessful +void +gzifstream::attach (int fd, + std::ios_base::openmode mode) +{ + if (! sb.attach (fd, mode | std::ios_base::in)) + this->setstate (std::ios_base::failbit); + else + this->clear (); +} + +// Close file +void +gzifstream::close () +{ + if (! sb.close ()) + this->setstate (std::ios_base::failbit); +} + +/*****************************************************************************/ + +// Default constructor initializes stream buffer +gzofstream::gzofstream () +: std::ostream (0), sb () +{ this->init (&sb); } + +// Initialize stream buffer and open file +gzofstream::gzofstream (const char* name, + std::ios_base::openmode mode) +: std::ostream (0), sb () +{ + this->init (&sb); + this->open (name, mode); +} + +// Initialize stream buffer and attach to file +gzofstream::gzofstream (int fd, + std::ios_base::openmode mode) +: std::ostream (0), sb () +{ + this->init (&sb); + this->attach (fd, mode); +} + +// Open file and go into fail() state if unsuccessful +void +gzofstream::open (const char* name, + std::ios_base::openmode mode) +{ + if (! sb.open (name, mode | std::ios_base::out)) + this->setstate (std::ios_base::failbit); + else + this->clear (); +} + +// Attach to file and go into fail() state if unsuccessful +void +gzofstream::attach (int fd, + std::ios_base::openmode mode) +{ + if (! sb.attach (fd, mode | std::ios_base::out)) + this->setstate (std::ios_base::failbit); + else + this->clear (); +} + +// Close file +void +gzofstream::close () +{ + if (! sb.close ()) + this->setstate (std::ios_base::failbit); +} + +#endif // HAVE_ZLIB diff -r 486c3e2731ff -r 68fc671a9339 libinterp/corefcn/zfstream.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/corefcn/zfstream.h Wed Jul 03 17:43:48 2013 -0700 @@ -0,0 +1,515 @@ +/* + +Copyright (C) 2005-2012 Ludwig Schwardt, Kevin Ruland + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +/* + + This file is adapted from the zlib 1.2.2 contrib/iostream3 code, + written by + + Ludwig Schwardt + original version by Kevin Ruland + +*/ + +#ifndef ZFSTREAM_H +#define ZFSTREAM_H + +#ifdef HAVE_ZLIB + +#include + +#include "zlib.h" + +/*****************************************************************************/ + +/** + * @brief Gzipped file stream buffer class. + * + * This class implements basic_filebuf for gzipped files. It doesn't yet support + * seeking (allowed by zlib but slow/limited), putback and read/write access + * (tricky). Otherwise, it attempts to be a drop-in replacement for the standard + * file streambuf. +*/ +class gzfilebuf : public std::streambuf +{ +public: + // Default constructor. + gzfilebuf (); + + // Destructor. + virtual + ~gzfilebuf (); + + /** + * @brief Set compression level and strategy on the fly. + * @param comp_level Compression level (see zlib.h for allowed values) + * @param comp_strategy Compression strategy (see zlib.h for allowed values) + * @return Z_OK on success, Z_STREAM_ERROR otherwise. + * + * Unfortunately, these parameters cannot be modified separately, as the + * previous zfstream version assumed. Since the strategy is seldom changed, + * it can default and setcompression(level) then becomes like the old + * setcompressionlevel(level). + */ + int + setcompression (int comp_level, + int comp_strategy = Z_DEFAULT_STRATEGY); + + /** + * @brief Check if file is open. + * @return True if file is open. + */ + bool + is_open () const { return (file != 0); } + + /** + * @brief Open gzipped file. + * @param name File name. + * @param mode Open mode flags. + * @return @c this on success, NULL on failure. + */ + gzfilebuf* + open (const char* name, + std::ios_base::openmode mode); + + /** + * @brief Attach to already open gzipped file. + * @param fd File descriptor. + * @param mode Open mode flags. + * @return @c this on success, NULL on failure. + */ + gzfilebuf* + attach (int fd, + std::ios_base::openmode mode); + + /** + * @brief Close gzipped file. + * @return @c this on success, NULL on failure. + */ + gzfilebuf* + close (); + +protected: + /** + * @brief Convert ios open mode int to mode string used by zlib. + * @return True if valid mode flag combination. + */ + bool + open_mode (std::ios_base::openmode mode, + char* c_mode) const; + + /** + * @brief Number of characters available in stream buffer. + * @return Number of characters. + * + * This indicates number of characters in get area of stream buffer. + * These characters can be read without accessing the gzipped file. + */ + virtual std::streamsize + showmanyc (); + + /** + * @brief Fill get area from gzipped file. + * @return First character in get area on success, EOF on error. + * + * This actually reads characters from gzipped file to stream + * buffer. Always buffered. + */ + virtual int_type + underflow (); + + /** + * @brief Write put area to gzipped file. + * @param c Extra character to add to buffer contents. + * @return Non-EOF on success, EOF on error. + * + * This actually writes characters in stream buffer to + * gzipped file. With unbuffered output this is done one + * character at a time. + */ + virtual int_type + overflow (int_type c = traits_type::eof ()); + + /** + * @brief Installs external stream buffer. + * @param p Pointer to char buffer. + * @param n Size of external buffer. + * @return @c this on success, NULL on failure. + * + * Call setbuf(0,0) to enable unbuffered output. + */ + virtual std::streambuf* + setbuf (char_type* p, + std::streamsize n); + + /** + * @brief Flush stream buffer to file. + * @return 0 on success, -1 on error. + * + * This calls underflow(EOF) to do the job. + */ + virtual int + sync (); + + /** + * @brief Alters the stream positions. + * + * Each derived class provides its own appropriate behavior. + */ + virtual pos_type + seekoff (off_type off, std::ios_base::seekdir way, + std::ios_base::openmode mode = + std::ios_base::in|std::ios_base::out); + + /** + * @brief Alters the stream positions. + * + * Each derived class provides its own appropriate behavior. + */ + virtual pos_type + seekpos (pos_type sp, std::ios_base::openmode mode = + std::ios_base::in|std::ios_base::out); + + virtual int_type + pbackfail (int_type c = traits_type::eof ()); + +// +// Some future enhancements +// +// virtual int_type uflow(); +// virtual int_type pbackfail(int_type c = traits_type::eof()); + +private: + + // No copying! + + gzfilebuf (const gzfilebuf&); + + gzfilebuf& operator = (const gzfilebuf&); + + /** + * @brief Allocate internal buffer. + * + * This function is safe to call multiple times. It will ensure + * that a proper internal buffer exists if it is required. If the + * buffer already exists or is external, the buffer pointers will be + * reset to their original state. + */ + void + enable_buffer (); + + /** + * @brief Destroy internal buffer. + * + * This function is safe to call multiple times. It will ensure + * that the internal buffer is deallocated if it exists. In any + * case, it will also reset the buffer pointers. + */ + void + disable_buffer (); + + /** + * Underlying file pointer. + */ + gzFile file; + + /** + * Mode in which file was opened. + */ + std::ios_base::openmode io_mode; + + /** + * @brief True if this object owns file descriptor. + * + * This makes the class responsible for closing the file + * upon destruction. + */ + bool own_fd; + + /** + * @brief Stream buffer. + * + * For simplicity this remains allocated on the free store for the + * entire life span of the gzfilebuf object, unless replaced by setbuf. + */ + char_type* buffer; + + /** + * @brief Stream buffer size. + * + * Defaults to system default buffer size (typically 8192 bytes). + * Modified by setbuf. + */ + std::streamsize buffer_size; + + /** + * @brief True if this object owns stream buffer. + * + * This makes the class responsible for deleting the buffer + * upon destruction. + */ + bool own_buffer; +}; + +/*****************************************************************************/ + +/** + * @brief Gzipped file input stream class. + * + * This class implements ifstream for gzipped files. Seeking and putback + * is not supported yet. +*/ +class gzifstream : public std::istream +{ +public: + // Default constructor + gzifstream (); + + /** + * @brief Construct stream on gzipped file to be opened. + * @param name File name. + * @param mode Open mode flags (forced to contain ios::in). + */ + explicit + gzifstream (const char* name, + std::ios_base::openmode mode = std::ios_base::in); + + /** + * @brief Construct stream on already open gzipped file. + * @param fd File descriptor. + * @param mode Open mode flags (forced to contain ios::in). + */ + explicit + gzifstream (int fd, + std::ios_base::openmode mode = std::ios_base::in); + + /** + * Obtain underlying stream buffer. + */ + gzfilebuf* + rdbuf () const + { return const_cast(&sb); } + + /** + * @brief Check if file is open. + * @return True if file is open. + */ + bool + is_open () { return sb.is_open (); } + + /** + * @brief Open gzipped file. + * @param name File name. + * @param mode Open mode flags (forced to contain ios::in). + * + * Stream will be in state good() if file opens successfully; + * otherwise in state fail(). This differs from the behavior of + * ifstream, which never sets the state to good() and therefore + * won't allow you to reuse the stream for a second file unless + * you manually clear() the state. The choice is a matter of + * convenience. + */ + void + open (const char* name, + std::ios_base::openmode mode = std::ios_base::in); + + /** + * @brief Attach to already open gzipped file. + * @param fd File descriptor. + * @param mode Open mode flags (forced to contain ios::in). + * + * Stream will be in state good() if attach succeeded; otherwise + * in state fail(). + */ + void + attach (int fd, + std::ios_base::openmode mode = std::ios_base::in); + + /** + * @brief Close gzipped file. + * + * Stream will be in state fail() if close failed. + */ + void + close (); + +private: + /** + * Underlying stream buffer. + */ + gzfilebuf sb; +}; + +/*****************************************************************************/ + +/** + * @brief Gzipped file output stream class. + * + * This class implements ofstream for gzipped files. Seeking and putback + * is not supported yet. +*/ +class gzofstream : public std::ostream +{ +public: + // Default constructor + gzofstream (); + + /** + * @brief Construct stream on gzipped file to be opened. + * @param name File name. + * @param mode Open mode flags (forced to contain ios::out). + */ + explicit + gzofstream (const char* name, + std::ios_base::openmode mode = std::ios_base::out); + + /** + * @brief Construct stream on already open gzipped file. + * @param fd File descriptor. + * @param mode Open mode flags (forced to contain ios::out). + */ + explicit + gzofstream (int fd, + std::ios_base::openmode mode = std::ios_base::out); + + /** + * Obtain underlying stream buffer. + */ + gzfilebuf* + rdbuf () const + { return const_cast(&sb); } + + /** + * @brief Check if file is open. + * @return True if file is open. + */ + bool + is_open () { return sb.is_open (); } + + /** + * @brief Open gzipped file. + * @param name File name. + * @param mode Open mode flags (forced to contain ios::out). + * + * Stream will be in state good() if file opens successfully; + * otherwise in state fail(). This differs from the behavior of + * ofstream, which never sets the state to good() and therefore + * won't allow you to reuse the stream for a second file unless + * you manually clear() the state. The choice is a matter of + * convenience. + */ + void + open (const char* name, + std::ios_base::openmode mode = std::ios_base::out); + + /** + * @brief Attach to already open gzipped file. + * @param fd File descriptor. + * @param mode Open mode flags (forced to contain ios::out). + * + * Stream will be in state good() if attach succeeded; otherwise + * in state fail(). + */ + void + attach (int fd, + std::ios_base::openmode mode = std::ios_base::out); + + /** + * @brief Close gzipped file. + * + * Stream will be in state fail() if close failed. + */ + void + close (); + +private: + /** + * Underlying stream buffer. + */ + gzfilebuf sb; +}; + +/*****************************************************************************/ + +/** + * @brief Gzipped file output stream manipulator class. + * + * This class defines a two-argument manipulator for gzofstream. It is used + * as base for the setcompression(int,int) manipulator. +*/ +template + class gzomanip2 + { + public: + // Allows insertor to peek at internals + template + friend gzofstream& + operator<<(gzofstream&, + const gzomanip2&); + + // Constructor + gzomanip2 (gzofstream& (*f)(gzofstream&, T1, T2), + T1 v1, + T2 v2); + private: + // Underlying manipulator function + gzofstream& + (*func)(gzofstream&, T1, T2); + + // Arguments for manipulator function + T1 val1; + T2 val2; + }; + +/*****************************************************************************/ + +// Manipulator function thunks through to stream buffer +inline gzofstream& +setcompression (gzofstream &gzs, int l, int s = Z_DEFAULT_STRATEGY) +{ + (gzs.rdbuf ())->setcompression (l, s); + return gzs; +} + +// Manipulator constructor stores arguments +template + inline + gzomanip2::gzomanip2 (gzofstream &(*f)(gzofstream &, T1, T2), + T1 v1, + T2 v2) + : func(f), val1(v1), val2(v2) + { } + +// Insertor applies underlying manipulator function to stream +template + inline gzofstream& + operator<<(gzofstream& s, const gzomanip2& m) + { return (*m.func)(s, m.val1, m.val2); } + +// Insert this onto stream to simplify setting of compression level +inline gzomanip2 +setcompression (int l, int s = Z_DEFAULT_STRATEGY) +{ return gzomanip2(&setcompression, l, s); } + +#endif // HAVE_ZLIB + +#endif // ZFSTREAM_H diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/Cell.cc --- a/libinterp/interp-core/Cell.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,320 +0,0 @@ -/* - -Copyright (C) 1999-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "idx-vector.h" - -#include "Cell.h" -#include "error.h" -#include "gripes.h" -#include "oct-obj.h" - -Cell::Cell (const octave_value_list& ovl) - : Array (ovl.cell_value ()) -{ -} - -Cell::Cell (const string_vector& sv, bool trim) - : Array () -{ - octave_idx_type n = sv.length (); - - if (n > 0) - { - resize (dim_vector (n, 1)); - - for (octave_idx_type i = 0; i < n; i++) - { - std::string s = sv[i]; - - if (trim) - { - size_t pos = s.find_last_not_of (' '); - - s = (pos == std::string::npos) ? "" : s.substr (0, pos+1); - } - - elem(i,0) = s; - } - } -} - -Cell::Cell (const std::list& lst) - : Array () -{ - size_t n = lst.size (); - - if (n > 0) - { - resize (dim_vector (n, 1)); - - octave_idx_type i = 0; - - for (std::list::const_iterator it = lst.begin (); - it != lst.end (); it++) - { - elem(i++,0) = *it; - } - } -} - -Cell::Cell (const Array& sa) - : Array (sa.dims ()) -{ - octave_idx_type n = sa.numel (); - - octave_value *dst = fortran_vec (); - const std::string *src = sa.data (); - - for (octave_idx_type i = 0; i < n; i++) - dst[i] = src[i]; -} - -// Set size to DV, filling with []. Then fill with as many elements of -// SV as possible. - -Cell::Cell (const dim_vector& dv, const string_vector& sv, bool trim) - : Array (dv, Matrix ()) -{ - octave_idx_type n = sv.length (); - - if (n > 0) - { - octave_idx_type m = numel (); - - octave_idx_type len = n > m ? m : n; - - for (octave_idx_type i = 0; i < len; i++) - { - std::string s = sv[i]; - - if (trim) - { - size_t pos = s.find_last_not_of (' '); - - s = (pos == std::string::npos) ? "" : s.substr (0, pos+1); - } - - elem(i) = s; - } - } -} - -bool -Cell::is_cellstr (void) const -{ - bool retval = true; - - octave_idx_type n = numel (); - - for (octave_idx_type i = 0; i < n; i++) - { - if (! elem(i).is_string ()) - { - retval = false; - break; - } - } - - return retval; -} - -Array -Cell::cellstr_value (void) const -{ - Array retval (dims ()); - - octave_idx_type n = numel (); - - for (octave_idx_type i = 0; i < n; i++) - retval.xelem (i) = elem (i).string_value (); - - return retval; -} - -Cell -Cell::index (const octave_value_list& idx_arg, bool resize_ok) const -{ - Cell retval; - - octave_idx_type n = idx_arg.length (); - - switch (n) - { - case 0: - retval = *this; - break; - - case 1: - { - idx_vector i = idx_arg(0).index_vector (); - - if (! error_state) - retval = Array::index (i, resize_ok, Matrix ()); - } - break; - - case 2: - { - idx_vector i = idx_arg(0).index_vector (); - - if (! error_state) - { - idx_vector j = idx_arg(1).index_vector (); - - if (! error_state) - retval = Array::index (i, j, resize_ok, Matrix ()); - } - } - break; - - default: - { - Array iv (dim_vector (n, 1)); - - for (octave_idx_type i = 0; i < n; i++) - { - iv(i) = idx_arg(i).index_vector (); - - if (error_state) - break; - } - - if (!error_state) - retval = Array::index (iv, resize_ok, Matrix ()); - } - break; - } - - return retval; -} - -void -Cell::assign (const octave_value_list& idx_arg, const Cell& rhs, - const octave_value& fill_val) - -{ - octave_idx_type len = idx_arg.length (); - - Array ra_idx (dim_vector (len, 1)); - - for (octave_idx_type i = 0; i < len; i++) - ra_idx(i) = idx_arg(i).index_vector (); - - Array::assign (ra_idx, rhs, fill_val); -} - -void -Cell::delete_elements (const octave_value_list& idx_arg) - -{ - octave_idx_type len = idx_arg.length (); - - Array ra_idx (dim_vector (len, 1)); - - for (octave_idx_type i = 0; i < len; i++) - ra_idx.xelem (i) = idx_arg(i).index_vector (); - - Array::delete_elements (ra_idx); -} - -octave_idx_type -Cell::nnz (void) const -{ - gripe_wrong_type_arg ("nnz", "cell array"); - return -1; -} - -Cell -Cell::column (octave_idx_type i) const -{ - Cell retval; - - if (ndims () < 3) - { - if (i < 0 || i >= cols ()) - error ("invalid column selection"); - else - { - octave_idx_type nr = rows (); - - retval.resize (dim_vector (nr, 1)); - - for (octave_idx_type j = 0; j < nr; j++) - retval.xelem (j) = elem (j, i); - } - } - else - error ("Cell::column: requires 2-d cell array"); - - return retval; -} - -Cell -Cell::concat (const Cell& rb, const Array& ra_idx) -{ - return insert (rb, ra_idx); -} - -Cell& -Cell::insert (const Cell& a, octave_idx_type r, octave_idx_type c) -{ - Array::insert (a, r, c); - return *this; -} - -Cell& -Cell::insert (const Cell& a, const Array& ra_idx) -{ - Array::insert (a, ra_idx); - return *this; -} - -Cell -Cell::map (ctype_mapper fcn) const -{ - Cell retval (dims ()); - octave_value *r = retval.fortran_vec (); - - const octave_value *p = data (); - - for (octave_idx_type i = 0; i < numel (); i++) - r[i] = ((p++)->*fcn) (); - - return retval; -} - -Cell -Cell::diag (octave_idx_type k) const -{ - return Array::diag (k); -} - -Cell -Cell::diag (octave_idx_type m, octave_idx_type n) const -{ - return Array::diag (m, n); -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/Cell.h --- a/libinterp/interp-core/Cell.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,150 +0,0 @@ -/* - -Copyright (C) 1999-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (Cell_h) -#define Cell_h 1 - -#include - -#include "Array.h" -#include "oct-alloc.h" -#include "str-vec.h" -#include "ov.h" - -class octave_value_list; - -class -OCTINTERP_API -Cell : public Array -{ -public: - - Cell (void) - : Array (dim_vector (0, 0)) { } - - Cell (const octave_value& val) - : Array (dim_vector (1, 1), val) { } - - Cell (const octave_value_list& ovl); - - Cell (octave_idx_type n, octave_idx_type m, - const octave_value& val = Matrix ()) - : Array (dim_vector (n, m), val) { } - - Cell (const dim_vector& dv, const octave_value& val = Matrix ()) - : Array (dv, val) { } - - Cell (const Array& c) - : Array (c) { } - - Cell (const Array& c, octave_idx_type nr, octave_idx_type nc) - : Array (c, dim_vector (nr, nc)) { } - - Cell (const string_vector& sv, bool trim = false); - - Cell (const std::list& lst); - - Cell (const Array& sa); - - Cell (const dim_vector& dv, const string_vector& sv, bool trim = false); - - Cell (const Cell& c) - : Array (c) { } - - bool is_cellstr (void) const; - - Array cellstr_value (void) const; - - using Array::index; - - Cell index (const octave_value_list& idx, bool resize_ok = false) const; - - using Array::delete_elements; - - void delete_elements (const octave_value_list& idx); - - using Array::assign; - - void assign (const octave_value_list& idx, const Cell& rhs, - const octave_value& fill_val = Matrix ()); - - Cell reshape (const dim_vector& new_dims) const - { return Array::reshape (new_dims); } - - octave_idx_type nnz (void) const; - - Cell column (octave_idx_type i) const; - - // FIXME - boolMatrix all (int /* dim */ = 0) const { return boolMatrix (); } - - // FIXME - boolMatrix any (int /* dim */ = 0) const { return boolMatrix (); } - - Cell concat (const Cell& rb, const Array& ra_idx); - - Cell& insert (const Cell& a, octave_idx_type r, octave_idx_type c); - Cell& insert (const Cell& a, const Array& ra_idx); - - // FIXME - bool any_element_is_nan (void) const { return false; } - bool is_true (void) const { return false; } - - octave_value resize_fill_value (void) const - { - static Matrix rfv; - return rfv; - } - - Cell diag (octave_idx_type k = 0) const; - - Cell diag (octave_idx_type m, octave_idx_type n) const; - - Cell xisalnum (void) const { return map (&octave_value::xisalnum); } - Cell xisalpha (void) const { return map (&octave_value::xisalpha); } - Cell xisascii (void) const { return map (&octave_value::xisascii); } - Cell xiscntrl (void) const { return map (&octave_value::xiscntrl); } - Cell xisdigit (void) const { return map (&octave_value::xisdigit); } - Cell xisgraph (void) const { return map (&octave_value::xisgraph); } - Cell xislower (void) const { return map (&octave_value::xislower); } - Cell xisprint (void) const { return map (&octave_value::xisprint); } - Cell xispunct (void) const { return map (&octave_value::xispunct); } - Cell xisspace (void) const { return map (&octave_value::xisspace); } - Cell xisupper (void) const { return map (&octave_value::xisupper); } - Cell xisxdigit (void) const { return map (&octave_value::xisxdigit); } - Cell xtoascii (void) const { return map (&octave_value::xtoascii); } - Cell xtolower (void) const { return map (&octave_value::xtolower); } - Cell xtoupper (void) const { return map (&octave_value::xtoupper); } - -private: - - typedef octave_value (octave_value::*ctype_mapper) (void) const; - - Cell map (ctype_mapper) const; -}; - -template<> -inline Cell octave_value_extract (const octave_value& v) - { return v.cell_value (); } - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/action-container.h --- a/libinterp/interp-core/action-container.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,341 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_action_container_h) -#define octave_action_container_h 1 - -// This class allows registering actions in a list for later -// execution, either explicitly or when the container goes out of -// scope. - -// FIXME -- is there a better name for this class? - -class -action_container -{ -public: - - // A generic unwind_protect element. Knows how to run itself and - // discard itself. Also, contains a pointer to the next element. - class elem - { - public: - elem (void) { } - - virtual void run (void) { } - - virtual ~elem (void) { } - - friend class action_container; - - private: - - // No copying! - - elem (const elem&); - - elem& operator = (const elem&); - }; - - // An element that merely runs a void (*)(void) function. - - class fcn_elem : public elem - { - public: - fcn_elem (void (*fptr) (void)) - : e_fptr (fptr) { } - - void run (void) { e_fptr (); } - - private: - void (*e_fptr) (void); - }; - - // An element that stores a variable of type T along with a void (*) (T) - // function pointer, and calls the function with the parameter. - - template - class fcn_arg_elem : public elem - { - public: - fcn_arg_elem (void (*fcn) (T), T arg) - : e_fcn (fcn), e_arg (arg) { } - - void run (void) { e_fcn (e_arg); } - - private: - - // No copying! - - fcn_arg_elem (const fcn_arg_elem&); - - fcn_arg_elem& operator = (const fcn_arg_elem&); - - void (*e_fcn) (T); - T e_arg; - }; - - // An element that stores a variable of type T along with a - // void (*) (const T&) function pointer, and calls the function with - // the parameter. - - template - class fcn_crefarg_elem : public elem - { - public: - fcn_crefarg_elem (void (*fcn) (const T&), const T& arg) - : e_fcn (fcn), e_arg (arg) { } - - void run (void) { e_fcn (e_arg); } - - private: - void (*e_fcn) (const T&); - T e_arg; - }; - - // An element for calling a member function. - - template - class method_elem : public elem - { - public: - method_elem (T *obj, void (T::*method) (void)) - : e_obj (obj), e_method (method) { } - - void run (void) { (e_obj->*e_method) (); } - - private: - - T *e_obj; - void (T::*e_method) (void); - - // No copying! - - method_elem (const method_elem&); - - method_elem operator = (const method_elem&); - }; - - // An element for calling a member function with a single argument - - template - class method_arg_elem : public elem - { - public: - method_arg_elem (T *obj, void (T::*method) (A), A arg) - : e_obj (obj), e_method (method), e_arg (arg) { } - - void run (void) { (e_obj->*e_method) (e_arg); } - - private: - - T *e_obj; - void (T::*e_method) (A); - A e_arg; - - // No copying! - - method_arg_elem (const method_arg_elem&); - - method_arg_elem operator = (const method_arg_elem&); - }; - - // An element for calling a member function with a single argument - - template - class method_crefarg_elem : public elem - { - public: - method_crefarg_elem (T *obj, void (T::*method) (const A&), const A& arg) - : e_obj (obj), e_method (method), e_arg (arg) { } - - void run (void) { (e_obj->*e_method) (e_arg); } - - private: - - T *e_obj; - void (T::*e_method) (const A&); - A e_arg; - - // No copying! - - method_crefarg_elem (const method_crefarg_elem&); - - method_crefarg_elem operator = (const method_crefarg_elem&); - }; - - // An element that stores arbitrary variable, and restores it. - - template - class restore_var_elem : public elem - { - public: - restore_var_elem (T& ref, const T& val) - : e_ptr (&ref), e_val (val) { } - - void run (void) { *e_ptr = e_val; } - - private: - - // No copying! - - restore_var_elem (const restore_var_elem&); - - restore_var_elem& operator = (const restore_var_elem&); - - T *e_ptr, e_val; - }; - - // Deletes a class allocated using new. - - template - class delete_ptr_elem : public elem - { - public: - delete_ptr_elem (T *ptr) - : e_ptr (ptr) { } - - void run (void) { delete e_ptr; } - - private: - - T *e_ptr; - - // No copying! - - delete_ptr_elem (const delete_ptr_elem&); - - delete_ptr_elem operator = (const delete_ptr_elem&); - }; - - action_container (void) { } - - virtual ~action_container (void) { } - - virtual void add (elem *new_elem) = 0; - - // Call to void func (void). - void add_fcn (void (*fcn) (void)) - { - add (new fcn_elem (fcn)); - } - - // Call to void func (T). - template - void add_fcn (void (*action) (T), T val) - { - add (new fcn_arg_elem (action, val)); - } - - // Call to void func (const T&). - template - void add_fcn (void (*action) (const T&), const T& val) - { - add (new fcn_crefarg_elem (action, val)); - } - - // Call to T::method (void). - template - void add_method (T *obj, void (T::*method) (void)) - { - add (new method_elem (obj, method)); - } - - // Call to T::method (A). - template - void add_method (T *obj, void (T::*method) (A), A arg) - { - add (new method_arg_elem (obj, method, arg)); - } - - // Call to T::method (const A&). - template - void add_method (T *obj, void (T::*method) (const A&), const A& arg) - { - add (new method_crefarg_elem (obj, method, arg)); - } - - // Call to delete (T*). - - template - void add_delete (T *obj) - { - add (new delete_ptr_elem (obj)); - } - - // Protect any variable. - template - void protect_var (T& var) - { - add (new restore_var_elem (var, var)); - } - - // Protect any variable, value given. - template - void protect_var (T& var, const T& val) - { - add (new restore_var_elem (var, val)); - } - - operator bool (void) const { return ! empty (); } - - virtual void run_first (void) = 0; - - void run (size_t num) - { - if (num > size ()) - num = size (); - - for (size_t i = 0; i < num; i++) - run_first (); - } - - void run (void) { run (size ()); } - - virtual void discard_first (void) = 0; - - void discard (size_t num) - { - if (num > size ()) - num = size (); - - for (size_t i = 0; i < num; i++) - discard_first (); - } - - void discard (void) { discard (size ()); } - - virtual size_t size (void) const = 0; - - bool empty (void) const { return size () == 0; } - -private: - - // No copying! - - action_container (const action_container&); - - action_container& operator = (const action_container&); -}; - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/c-file-ptr-stream.cc --- a/libinterp/interp-core/c-file-ptr-stream.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,362 +0,0 @@ -/* - -Copyright (C) 2000-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "c-file-ptr-stream.h" - -#ifndef SEEK_SET -#define SEEK_SET 0 -#endif - -#ifndef SEEK_CUR -#define SEEK_CUR 1 -#endif - -#ifndef SEEK_END -#define SEEK_END 2 -#endif - -c_file_ptr_buf::~c_file_ptr_buf (void) -{ - buf_close (); -} - -// FIXME -- I'm sure there is room for improvement here... - -c_file_ptr_buf::int_type -c_file_ptr_buf::overflow (int_type c) -{ -#if defined (CXX_ISO_COMPLIANT_LIBRARY) - if (f) - return (c != traits_type::eof ()) ? gnulib::fputc (c, f) : flush (); - else - return traits_type::not_eof (c); -#else - if (f) - return (c != EOF) ? gnulib::fputc (c, f) : flush (); - else - return EOF; -#endif -} - -c_file_ptr_buf::int_type -c_file_ptr_buf::underflow_common (bool bump) -{ - if (f) - { - int_type c = gnulib::fgetc (f); - - if (! bump -#if defined (CXX_ISO_COMPLIANT_LIBRARY) - && c != traits_type::eof ()) -#else - && c != EOF) -#endif - ungetc (c, f); - - return c; - } - else -#if defined (CXX_ISO_COMPLIANT_LIBRARY) - return traits_type::eof (); -#else - return EOF; -#endif -} - -c_file_ptr_buf::int_type -c_file_ptr_buf::pbackfail (int_type c) -{ -#if defined (CXX_ISO_COMPLIANT_LIBRARY) - return (c != traits_type::eof () && f) ? ungetc (c, f) : - traits_type::not_eof (c); -#else - return (c != EOF && f) ? ungetc (c, f) : EOF; -#endif -} - -std::streamsize -c_file_ptr_buf::xsputn (const char* s, std::streamsize n) -{ - if (f) - return gnulib::fwrite (s, 1, n, f); - else - return 0; -} - -std::streamsize -c_file_ptr_buf::xsgetn (char *s, std::streamsize n) -{ - if (f) - return gnulib::fread (s, 1, n, f); - else - return 0; -} - -static inline int -seekdir_to_whence (std::ios::seekdir dir) -{ - return ((dir == std::ios::beg) ? SEEK_SET : - (dir == std::ios::cur) ? SEEK_CUR : - (dir == std::ios::end) ? SEEK_END : - dir); -} - -std::streampos -c_file_ptr_buf::seekoff (std::streamoff /* offset */, - std::ios::seekdir /* dir */, - std::ios::openmode) -{ - // FIXME -#if 0 - if (f) - { - fseek (f, offset, seekdir_to_whence (dir)); - - return ftell (f); - } - else - return 0; -#endif - return -1; -} - -std::streampos -c_file_ptr_buf::seekpos (std::streampos /* offset */, std::ios::openmode) -{ - // FIXME -#if 0 - if (f) - { - fseek (f, offset, SEEK_SET); - - return ftell (f); - } - else - return 0; -#endif - return -1; -} - -int -c_file_ptr_buf::sync (void) -{ - flush (); - - return 0; -} - -int -c_file_ptr_buf::flush (void) -{ - return f ? gnulib::fflush (f) : EOF; -} - -int -c_file_ptr_buf::buf_close (void) -{ - int retval = -1; - - flush (); - - if (f) - { - retval = cf (f); - f = 0; - } - - return retval; -} - -int -c_file_ptr_buf::seek (off_t offset, int origin) -{ - return f ? gnulib::fseeko (f, offset, origin) : -1; -} - -off_t -c_file_ptr_buf::tell (void) -{ - return f ? gnulib::ftello (f) : -1; -} - -int -c_file_ptr_buf::file_close (FILE *f) -{ - return gnulib::fclose (f); -} - -#ifdef HAVE_ZLIB - -c_zfile_ptr_buf::~c_zfile_ptr_buf (void) -{ - buf_close (); -} - -// FIXME -- I'm sure there is room for improvement here... - -c_zfile_ptr_buf::int_type -c_zfile_ptr_buf::overflow (int_type c) -{ -#if defined (CXX_ISO_COMPLIANT_LIBRARY) - if (f) - return (c != traits_type::eof ()) ? gzputc (f, c) : flush (); - else - return traits_type::not_eof (c); -#else - if (f) - return (c != EOF) ? gzputc (f, c) : flush (); - else - return EOF; -#endif -} - -c_zfile_ptr_buf::int_type -c_zfile_ptr_buf::underflow_common (bool bump) -{ - if (f) - { - int_type c = gzgetc (f); - - if (! bump -#if defined (CXX_ISO_COMPLIANT_LIBRARY) - && c != traits_type::eof ()) -#else - && c != EOF) -#endif - gzungetc (c, f); - - return c; - } - else -#if defined (CXX_ISO_COMPLIANT_LIBRARY) - return traits_type::eof (); -#else - return EOF; -#endif -} - -c_zfile_ptr_buf::int_type -c_zfile_ptr_buf::pbackfail (int_type c) -{ -#if defined (CXX_ISO_COMPLIANT_LIBRARY) - return (c != traits_type::eof () && f) ? gzungetc (c, f) : - traits_type::not_eof (c); -#else - return (c != EOF && f) ? gzungetc (c, f) : EOF; -#endif -} - -std::streamsize -c_zfile_ptr_buf::xsputn (const char* s, std::streamsize n) -{ - if (f) - return gzwrite (f, s, n); - else - return 0; -} - -std::streamsize -c_zfile_ptr_buf::xsgetn (char *s, std::streamsize n) -{ - if (f) - return gzread (f, s, n); - else - return 0; -} - -std::streampos -c_zfile_ptr_buf::seekoff (std::streamoff /* offset */, - std::ios::seekdir /* dir */, - std::ios::openmode) -{ - // FIXME -#if 0 - if (f) - { - gzseek (f, offset, seekdir_to_whence (dir)); - - return gztell (f); - } - else - return 0; -#endif - return -1; -} - -std::streampos -c_zfile_ptr_buf::seekpos (std::streampos /* offset */, std::ios::openmode) -{ - // FIXME -#if 0 - if (f) - { - gzseek (f, offset, SEEK_SET); - - return gztell (f); - } - else - return 0; -#endif - return -1; -} - -int -c_zfile_ptr_buf::sync (void) -{ - flush (); - - return 0; -} - -int -c_zfile_ptr_buf::flush (void) -{ - // FIXME -- do we need something more complex here, passing - // something other than 0 for the second argument to gzflush and - // checking the return value, etc.? - - return f ? gzflush (f, 0) : EOF; -} - -int -c_zfile_ptr_buf::buf_close (void) -{ - int retval = -1; - - flush (); - - if (f) - { - retval = cf (f); - f = 0; - } - - return retval; -} - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/c-file-ptr-stream.h --- a/libinterp/interp-core/c-file-ptr-stream.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,227 +0,0 @@ -/* - -Copyright (C) 2000-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_c_file_ptr_stream_h) -#define octave_c_file_ptr_stream_h 1 - -#include - -#include - -class -c_file_ptr_buf : public std::streambuf -{ -public: - -#if !defined (CXX_ISO_COMPLIANT_LIBRARY) - typedef int int_type; -#else - typedef std::streambuf::int_type int_type; -#endif - - typedef int (*close_fcn) (FILE *); - - FILE* stdiofile (void) { return f; } - - c_file_ptr_buf (FILE *f_arg, close_fcn cf_arg = file_close) - : std::streambuf (), f (f_arg), cf (cf_arg) - { } - - ~c_file_ptr_buf (void); - - int_type overflow (int_type); - - int_type underflow (void) { return underflow_common (false); } - - int_type uflow (void) { return underflow_common (true); } - - int_type pbackfail (int_type); - - std::streamsize xsputn (const char*, std::streamsize); - - std::streamsize xsgetn (char *, std::streamsize); - - std::streampos seekoff (std::streamoff, std::ios::seekdir, - std::ios::openmode = std::ios::in | std::ios::out); - - std::streampos seekpos (std::streampos, - std::ios::openmode = std::ios::in | std::ios::out); - - int sync (void); - - int flush (void); - - int buf_close (void); - - int file_number () const { return f ? fileno (f) : -1; } - - int seek (off_t offset, int origin); - - off_t tell (void); - - void clear (void) { if (f) clearerr (f); } - - static int file_close (FILE *f); - -protected: - - FILE *f; - - close_fcn cf; - -private: - - int_type underflow_common (bool); - - // No copying! - - c_file_ptr_buf (const c_file_ptr_buf&); - - c_file_ptr_buf& operator = (const c_file_ptr_buf&); -}; - -// FIXME -- the following three classes could probably share -// some code... - -template -class -c_file_ptr_stream : public STREAM_T -{ -public: - - c_file_ptr_stream (FILE_T f, typename BUF_T::close_fcn cf = BUF_T::file_close) - : STREAM_T (0), buf (new BUF_T (f, cf)) { STREAM_T::init (buf); } - - ~c_file_ptr_stream (void) { delete buf; buf = 0; } - - BUF_T *rdbuf (void) { return buf; } - - void stream_close (void) { if (buf) buf->buf_close (); } - - int seek (off_t offset, int origin) - { return buf ? buf->seek (offset, origin) : -1; } - - off_t tell (void) { return buf ? buf->tell () : -1; } - - void clear (void) { if (buf) buf->clear (); STREAM_T::clear (); } - -private: - - BUF_T *buf; - - // No copying! - - c_file_ptr_stream (const c_file_ptr_stream&); - - c_file_ptr_stream& operator = (const c_file_ptr_stream&); -}; - -typedef c_file_ptr_stream i_c_file_ptr_stream; -typedef c_file_ptr_stream o_c_file_ptr_stream; -typedef c_file_ptr_stream io_c_file_ptr_stream; - -#ifdef HAVE_ZLIB - -#ifdef HAVE_ZLIB_H -#include -#endif - -class -c_zfile_ptr_buf : public std::streambuf -{ -public: - -#if !defined (CXX_ISO_COMPLIANT_LIBRARY) - typedef int int_type; -#else - typedef std::streambuf::int_type int_type; -#endif - - typedef int (*close_fcn) (gzFile); - - gzFile stdiofile (void) { return f; } - - c_zfile_ptr_buf (gzFile f_arg, close_fcn cf_arg = file_close) - : std::streambuf (), f (f_arg), cf (cf_arg) - { } - - ~c_zfile_ptr_buf (void); - - int_type overflow (int_type); - - int_type underflow (void) { return underflow_common (false); } - - int_type uflow (void) { return underflow_common (true); } - - int_type pbackfail (int_type); - - std::streamsize xsputn (const char*, std::streamsize); - - std::streamsize xsgetn (char *, std::streamsize); - - std::streampos seekoff (std::streamoff, std::ios::seekdir, - std::ios::openmode = std::ios::in | std::ios::out); - - std::streampos seekpos (std::streampos, - std::ios::openmode = std::ios::in | std::ios::out); - - int sync (void); - - int flush (void); - - int buf_close (void); - - int file_number () const { return -1; } - - int seek (off_t offset, int origin) - { return f ? gzseek (f, offset, origin) >= 0 : -1; } - - off_t tell (void) { return f ? gztell (f) : -1; } - - void clear (void) { if (f) gzclearerr (f); } - - static int file_close (gzFile f) { return ::gzclose (f); } - -protected: - - gzFile f; - - close_fcn cf; - -private: - - int_type underflow_common (bool); - - // No copying! - - c_zfile_ptr_buf (const c_zfile_ptr_buf&); - - c_zfile_ptr_buf& operator = (const c_zfile_ptr_buf&); -}; - -typedef c_file_ptr_stream i_c_zfile_ptr_stream; -typedef c_file_ptr_stream o_c_zfile_ptr_stream; -typedef c_file_ptr_stream io_c_zfile_ptr_stream; - -#endif - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/comment-list.cc --- a/libinterp/interp-core/comment-list.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,106 +0,0 @@ -/* - -Copyright (C) 2000-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "lo-utils.h" -#include "singleton-cleanup.h" - -#include "comment-list.h" -#include "error.h" - -octave_comment_buffer *octave_comment_buffer::instance = 0; - -octave_comment_list * -octave_comment_list::dup (void) const -{ - octave_comment_list *new_cl = new octave_comment_list (); - - for (const_iterator p = begin (); p != end (); p++) - { - const octave_comment_elt elt = *p; - - new_cl->append (elt); - } - - return new_cl; -} - -bool -octave_comment_buffer::instance_ok (void) -{ - bool retval = true; - - if (! instance) - { - instance = new octave_comment_buffer (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); - } - - if (! instance) - { - ::error ("unable to create comment buffer object"); - - retval = false; - } - - return retval; -} - -void -octave_comment_buffer::append (const std::string& s, - octave_comment_elt::comment_type t) -{ - if (instance_ok ()) - instance->do_append (s, t); -} - -octave_comment_list * -octave_comment_buffer::get_comment (void) -{ - return (instance_ok ()) ? instance->do_get_comment () : 0; -} - -void -octave_comment_buffer::do_append (const std::string& s, - octave_comment_elt::comment_type t) -{ - comment_list->append (s, t); -} - -octave_comment_list * -octave_comment_buffer::do_get_comment (void) -{ - octave_comment_list *retval = 0; - - if (comment_list && comment_list->length () > 0) - { - retval = comment_list; - comment_list = new octave_comment_list (); - } - - return retval; -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/comment-list.h --- a/libinterp/interp-core/comment-list.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,132 +0,0 @@ -/* - -Copyright (C) 2000-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_comment_list_h) -#define octave_comment_list_h 1 - -#include - -#include - -extern std::string get_comment_text (void); - -extern char *get_comment_text_c_str (void); - -extern void save_comment_text (const std::string& text); - -class -octave_comment_elt -{ -public: - - enum comment_type - { - unknown, - block, - full_line, - end_of_line, - doc_string, - copyright - }; - - octave_comment_elt (const std::string& s = std::string (), - comment_type t = unknown) - : txt (s), typ (t) { } - - octave_comment_elt (const octave_comment_elt& oc) - : txt (oc.txt), typ (oc.typ) { } - - octave_comment_elt& operator = (const octave_comment_elt& oc) - { - if (this != &oc) - { - txt = oc.txt; - typ = oc.typ; - } - - return *this; - } - - std::string text (void) const { return txt; } - - comment_type type (void) const { return typ; } - - ~octave_comment_elt (void) { } - -private: - - // The text of the comment. - std::string txt; - - // The type of comment. - comment_type typ; -}; - -class -octave_comment_list : public octave_base_list -{ -public: - - octave_comment_list (void) { } - - void append (const octave_comment_elt& elt) - { octave_base_list::append (elt); } - - void append (const std::string& s, - octave_comment_elt::comment_type t = octave_comment_elt::unknown) - { append (octave_comment_elt (s, t)); } - - octave_comment_list *dup (void) const; -}; - -class -octave_comment_buffer -{ -public: - - octave_comment_buffer (void) - : comment_list (new octave_comment_list ()) { } - - ~octave_comment_buffer (void) { delete comment_list; } - - static bool instance_ok (void); - - static void append - (const std::string& s, - octave_comment_elt::comment_type t = octave_comment_elt::unknown); - - static octave_comment_list *get_comment (void); - -private: - - void do_append (const std::string& s, octave_comment_elt::comment_type t); - - octave_comment_list *do_get_comment (void); - - octave_comment_list *comment_list; - - static octave_comment_buffer *instance; - - static void cleanup_instance (void) { delete instance; instance = 0; } -}; - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/cutils.c --- a/libinterp/interp-core/cutils.c Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,60 +0,0 @@ -/* - -Copyright (C) 1999-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include -#include - -#include "cutils.h" - -void -octave_sleep (unsigned int seconds) -{ - sleep (seconds); -} - -void -octave_usleep (unsigned int useconds) -{ - struct timespec delay; - struct timespec remaining; - - unsigned int sec = useconds / 1000000; - unsigned int usec = useconds % 1000000; - - delay.tv_sec = sec; - delay.tv_nsec = usec * 1000; - - nanosleep (&delay, &remaining); -} - -int -octave_raw_vsnprintf (char *buf, size_t n, const char *fmt, va_list args) -{ - return vsnprintf (buf, n, fmt, args); -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/cutils.h --- a/libinterp/interp-core/cutils.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,43 +0,0 @@ -/* - -Copyright (C) 2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_cutils_h) -#define octave_cutils_h 1 - -#include - -#ifdef __cplusplus -extern "C" { -#endif - -OCTINTERP_API void octave_sleep (unsigned int seconds); - -OCTINTERP_API void octave_usleep (unsigned int useconds); - -OCTINTERP_API int -octave_raw_vsnprintf (char *buf, size_t n, const char *fmt, va_list args); - -#ifdef __cplusplus -} -#endif - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/defun-dld.h --- a/libinterp/interp-core/defun-dld.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,71 +0,0 @@ -/* - -Copyright (C) 1994-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_defun_dld_h) -#define octave_defun_dld_h 1 - -#if defined (octave_defun_h) -#error defun.h and defun-dld.h both included in same file! -#endif - -#include "defun-int.h" - -// Define a builtin function that may be loaded dynamically at run -// time. -// -// If Octave is not configured for dynamic linking of builtin -// functions, this is the same as DEFUN, except that it will generate -// an extra externally visible function. -// -// The first DECLARE_FUN is for the benefit of the installer function -// and the second is for the definition of the function. - -#if defined (MAKE_BUILTINS) - -#define DEFUN_DLD(name, args_name, nargout_name, doc) \ - DEFUN_DLD_INTERNAL (name, args_name, nargout_name, doc) - -// This one can be used when 'name' cannot be used directly (if it is -// already defined as a macro). In that case, name is already a -// quoted string, and the internal name of the function must be passed -// too (the convention is to use a prefix of "F", so "foo" becomes -// "Ffoo") as well as the name of the generated installer function -// (the convention is to use a prefix of "G", so "foo" becomes "Gfoo"). - -#define DEFUNX_DLD(name, fname, gname, args_name, nargout_name, doc) \ - DEFUNX_DLD_INTERNAL (name, fname, args_name, nargout_name, doc) - -#else - -#define DEFUN_DLD(name, args_name, nargout_name, doc) \ - DECLARE_FUN (name, args_name, nargout_name); \ - DEFINE_FUN_INSTALLER_FUN (name, doc) \ - DECLARE_FUN (name, args_name, nargout_name) - -#define DEFUNX_DLD(name, fname, gname, args_name, nargout_name, doc) \ - DECLARE_FUNX (fname, args_name, nargout_name); \ - DEFINE_FUNX_INSTALLER_FUN (name, fname, gname, doc) \ - DECLARE_FUNX (fname, args_name, nargout_name) - -#endif - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/defun-int.h --- a/libinterp/interp-core/defun-int.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,187 +0,0 @@ -/* - -Copyright (C) 1994-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_defun_int_h) -#define octave_defun_int_h 1 - -#include - -#include "ov-builtin.h" -#include "ov-dld-fcn.h" -#include "symtab.h" -#include "version.h" - -class octave_value; - -extern OCTINTERP_API void print_usage (void); -extern OCTINTERP_API void print_usage (const std::string&); - -extern OCTINTERP_API void check_version (const std::string& version, const std::string& fcn); - -extern OCTINTERP_API void -install_builtin_function (octave_builtin::fcn f, const std::string& name, - const std::string& file, const std::string& doc, - bool can_hide_function = true); - -extern OCTINTERP_API void -install_dld_function (octave_dld_function::fcn f, const std::string& name, - const octave_shlib& shl, const std::string& doc, - bool relative = false); - -extern OCTINTERP_API void -install_mex_function (void *fptr, bool fmex, const std::string& name, - const octave_shlib& shl, bool relative = false); - -extern OCTINTERP_API void -alias_builtin (const std::string& alias, const std::string& name); - -// Gets the shlib of the currently executing DLD function, if any. -extern OCTINTERP_API octave_shlib -get_current_shlib (void); - -// This is a convenience class that calls the above function automatically at -// construction time. When deriving new classes, you can either use it as a field -// or as a parent (with multiple inheritance). - -class octave_auto_shlib : public octave_shlib -{ -public: - octave_auto_shlib (void) - : octave_shlib (get_current_shlib ()) { } - octave_auto_shlib (const octave_shlib& shl) - : octave_shlib (shl) { } -}; - -extern OCTINTERP_API bool -defun_isargout (int, int); - -extern OCTINTERP_API void -defun_isargout (int, int, bool *); - -#define DECLARE_FUNX(name, args_name, nargout_name) \ - OCTAVE_EXPORT octave_value_list \ - name (const octave_value_list& args_name, int nargout_name) - -#define DECLARE_FUN(name, args_name, nargout_name) \ - DECLARE_FUNX (F ## name, args_name, nargout_name) - -// Define the code that will be used to insert the new function into -// the symbol table. We look for this name instead of the actual -// function so that we can easily install the doc std::string too. - -typedef bool (*octave_dld_fcn_installer) (const octave_shlib&, bool relative); - -typedef octave_function * (*octave_dld_fcn_getter) (const octave_shlib&, bool relative); - -#define DEFINE_FUN_INSTALLER_FUN(name, doc) \ - DEFINE_FUNX_INSTALLER_FUN(#name, F ## name, G ## name, doc) - -#define DEFINE_FUNX_INSTALLER_FUN(name, fname, gname, doc) \ - extern "C" \ - OCTAVE_EXPORT \ - octave_function * \ - gname (const octave_shlib& shl, bool relative) \ - { \ - octave_function *retval = 0; \ - \ - check_version (OCTAVE_API_VERSION, name); \ - \ - if (! error_state) \ - { \ - octave_dld_function *fcn = octave_dld_function::create (fname, shl, name, doc); \ - \ - if (relative) \ - fcn->mark_relative (); \ - \ - retval = fcn; \ - } \ - \ - return retval; \ - } - -// MAKE_BUILTINS is defined to extract function names and related -// information and create the *.df files that are eventually used to -// create the builtins.cc file. - -#if defined (MAKE_BUILTINS) - -// Generate code to install name in the symbol table. The script -// mkdefs will create a .def file for every .cc file that uses DEFUN, -// or DEFCMD. - -#define DEFUN_INTERNAL(name, args_name, nargout_name, doc) \ - BEGIN_INSTALL_BUILTIN \ - XDEFUN_INTERNAL (name, args_name, nargout_name, doc) \ - END_INSTALL_BUILTIN - -#define DEFCONSTFUN_INTERNAL(name, args_name, nargout_name, doc) \ - BEGIN_INSTALL_BUILTIN \ - XDEFCONSTFUN_INTERNAL (name, args_name, nargout_name, doc) \ - END_INSTALL_BUILTIN - -#define DEFUNX_INTERNAL(name, fname, args_name, nargout_name, doc) \ - BEGIN_INSTALL_BUILTIN \ - XDEFUNX_INTERNAL (name, fname, args_name, nargout_name, doc) \ - END_INSTALL_BUILTIN - -// Generate code to install name in the symbol table. The script -// mkdefs will create a .def file for every .cc file that uses -// DEFUN_DLD. - -#define DEFUN_DLD_INTERNAL(name, args_name, nargout_name, doc) \ - BEGIN_INSTALL_BUILTIN \ - XDEFUN_DLD_INTERNAL (name, args_name, nargout_name, doc) \ - END_INSTALL_BUILTIN - -#define DEFUNX_DLD_INTERNAL(name, fname, args_name, nargout_name, doc) \ - BEGIN_INSTALL_BUILTIN \ - XDEFUNX_DLD_INTERNAL (name, fname, args_name, nargout_name, doc) \ - END_INSTALL_BUILTIN - -// Generate code for making another name for an existing function. - -#define DEFALIAS_INTERNAL(alias, name) \ - BEGIN_INSTALL_BUILTIN \ - XDEFALIAS_INTERNAL(alias, name) \ - END_INSTALL_BUILTIN - -#else /* ! MAKE_BUILTINS */ - -// Generate the first line of the function definition. This ensures -// that the internal functions all have the same signature. - -#define DEFUN_INTERNAL(name, args_name, nargout_name, doc) \ - DECLARE_FUN (name, args_name, nargout_name) - -#define DEFCONSTFUN_INTERNAL(name, args_name, nargout_name, doc) \ - DECLARE_FUN (name, args_name, nargout_name) - -#define DEFUNX_INTERNAL(name, fname, args_name, nargout_name, doc) \ - DECLARE_FUNX (fname, args_name, nargout_name) - -// No definition is required for an alias. - -#define DEFALIAS_INTERNAL(alias, name) - -#endif /* ! MAKE_BUILTINS */ - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/display.cc --- a/libinterp/interp-core/display.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,188 +0,0 @@ -/* - -Copyright (C) 2009-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#if defined (OCTAVE_USE_WINDOWS_API) -#include -#elif defined (HAVE_FRAMEWORK_CARBON) -#include -#elif defined (HAVE_X_WINDOWS) -#include -#endif - -#include "singleton-cleanup.h" - -#include "display.h" -#include "error.h" - -display_info *display_info::instance = 0; - -#if defined (HAVE_FRAMEWORK_CARBON) && ! defined (HAVE_CARBON_CGDISPLAYBITSPERPIXEL) -// FIXME - This will only work for MacOS > 10.5. For earlier versions -// this code is not needed (use CGDisplayBitsPerPixel instead). -size_t DisplayBitsPerPixel (CGDirectDisplayID display) -{ - CGDisplayModeRef mode = CGDisplayCopyDisplayMode (display); - CFStringRef pixelEncoding = CGDisplayModeCopyPixelEncoding (mode); - - if (CFStringCompare (pixelEncoding, CFSTR (IO32BitDirectPixels), 0) == 0) - return 32; - else if (CFStringCompare (pixelEncoding, CFSTR (IO16BitDirectPixels), 0) == 0) - return 16; - else - return 8; -} -#endif - -void -display_info::init (bool query) -{ - if (query) - { -#if defined (OCTAVE_USE_WINDOWS_API) - - HDC hdc = GetDC (0); - - if (hdc) - { - dp = GetDeviceCaps (hdc, BITSPIXEL); - - ht = GetDeviceCaps (hdc, VERTRES); - wd = GetDeviceCaps (hdc, HORZRES); - - double ht_mm = GetDeviceCaps (hdc, VERTSIZE); - double wd_mm = GetDeviceCaps (hdc, HORZSIZE); - - rx = wd * 25.4 / wd_mm; - ry = ht * 25.4 / ht_mm; - - dpy_avail = true; - } - else - warning ("no graphical display found"); - -#elif defined (HAVE_FRAMEWORK_CARBON) - - CGDirectDisplayID display = CGMainDisplayID (); - - if (display) - { -# if defined (HAVE_CARBON_CGDISPLAYBITSPERPIXEL) - // For MacOS < 10.7 use the line below - dp = CGDisplayBitsPerPixel (display); -# else - // For MacOS > 10.5 use the line below - dp = DisplayBitsPerPixel (display); -# endif - - ht = CGDisplayPixelsHigh (display); - wd = CGDisplayPixelsWide (display); - - CGSize sz_mm = CGDisplayScreenSize (display); - // For MacOS >= 10.6, CGSize is a struct keeping 2 CGFloat values, - // but the CGFloat typedef is not present on older systems, - // so use double instead. - double ht_mm = sz_mm.height; - double wd_mm = sz_mm.width; - - rx = wd * 25.4 / wd_mm; - ry = ht * 25.4 / ht_mm; - - dpy_avail = true; - } - else - warning ("no graphical display found"); - -#elif defined (HAVE_X_WINDOWS) - - const char *display_name = getenv ("DISPLAY"); - - if (display_name && *display_name) - { - Display *display = XOpenDisplay (display_name); - - if (display) - { - Screen *screen = DefaultScreenOfDisplay (display); - - if (screen) - { - dp = DefaultDepthOfScreen (screen); - - ht = HeightOfScreen (screen); - wd = WidthOfScreen (screen); - - int screen_number = XScreenNumberOfScreen (screen); - - double ht_mm = DisplayHeightMM (display, screen_number); - double wd_mm = DisplayWidthMM (display, screen_number); - - rx = wd * 25.4 / wd_mm; - ry = ht * 25.4 / ht_mm; - } - else - warning ("X11 display has no default screen"); - - XCloseDisplay (display); - - dpy_avail = true; - } - else - warning ("unable to open X11 DISPLAY"); - } - else - warning ("X11 DISPLAY environment variable not set"); -#else - - warning ("no graphical display found"); - -#endif - } -} - -bool -display_info::instance_ok (bool query) -{ - bool retval = true; - - if (! instance) - { - instance = new display_info (query); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); - } - - if (! instance) - { - ::error ("unable to create display_info object!"); - - retval = false; - } - - return retval; -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/display.h --- a/libinterp/interp-core/display.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,108 +0,0 @@ -/* - -Copyright (C) 2009-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_display_h) -#define octave_display_h 1 - -class Matrix; - -class display_info -{ -protected: - - display_info (bool query = true) - : ht (1), wd (1), dp (0), rx (72), ry (72), dpy_avail (false) - { - init (query); - } - -public: - - static int height (void) - { - return instance_ok () ? instance->do_height () : 0; - } - - static int width (void) - { - return instance_ok () ? instance->do_width () : 0; - } - - static int depth (void) - { - return instance_ok () ? instance->do_depth () : 0; - } - - static double x_dpi (void) - { - return instance_ok () ? instance->do_x_dpi () : 0; - } - - static double y_dpi (void) - { - return instance_ok () ? instance->do_y_dpi () : 0; - } - - static bool display_available (void) - { - return instance_ok () ? instance->do_display_available () : false; - } - - // To disable querying the window system for defaults, this function - // must be called before any other display_info function. - static void no_window_system (void) - { - instance_ok (false); - } - -private: - - static display_info *instance; - - static void cleanup_instance (void) { delete instance; instance = 0; } - - // Height, width, and depth of the display. - int ht; - int wd; - int dp; - - // X- and Y- Resolution of the display in dots (pixels) per inch. - double rx; - double ry; - - bool dpy_avail; - - int do_height (void) const { return ht; } - int do_width (void) const { return wd; } - int do_depth (void) const { return dp; } - - double do_x_dpi (void) const { return rx; } - double do_y_dpi (void) const { return ry; } - - bool do_display_available (void) const { return dpy_avail; } - - void init (bool query = true); - - static bool instance_ok (bool query = true); -}; - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/dynamic-ld.cc --- a/libinterp/interp-core/dynamic-ld.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,477 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include "file-stat.h" -#include "oct-env.h" -#include "oct-time.h" -#include "singleton-cleanup.h" - -#include - -#include "defun.h" -#include "dynamic-ld.h" -#include "ov-fcn.h" -#include "ov-dld-fcn.h" -#include "ov-mex-fcn.h" -#include "parse.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" - -#define STRINGIFY(s) STRINGIFY1(s) -#define STRINGIFY1(s) #s - -class -octave_shlib_list -{ -public: - - typedef std::list::iterator iterator; - typedef std::list::const_iterator const_iterator; - - static void append (const octave_shlib& shl); - - static void remove (octave_shlib& shl, octave_shlib::close_hook cl_hook = 0); - - static octave_shlib find_file (const std::string& file_name); - - static void display (void); - -private: - - octave_shlib_list (void) : lib_list () { } - - ~octave_shlib_list (void) { } - - void do_append (const octave_shlib& shl); - - void do_remove (octave_shlib& shl, octave_shlib::close_hook cl_hook = 0); - - octave_shlib do_find_file (const std::string& file_name) const; - - void do_display (void) const; - - static octave_shlib_list *instance; - - static void cleanup_instance (void) { delete instance; instance = 0; } - - static bool instance_ok (void); - - // List of libraries we have loaded. - std::list lib_list; - - // No copying! - - octave_shlib_list (const octave_shlib_list&); - - octave_shlib_list& operator = (const octave_shlib_list&); -}; - -octave_shlib_list *octave_shlib_list::instance = 0; - -void -octave_shlib_list::do_append (const octave_shlib& shl) -{ - lib_list.push_back (shl); -} - -void -octave_shlib_list::do_remove (octave_shlib& shl, - octave_shlib::close_hook cl_hook) -{ - for (iterator p = lib_list.begin (); p != lib_list.end (); p++) - { - if (*p == shl) - { - // Erase first to avoid potentially invalidating the pointer by the - // following hooks. - lib_list.erase (p); - - shl.close (cl_hook); - - break; - } - } -} - -octave_shlib -octave_shlib_list::do_find_file (const std::string& file_name) const -{ - octave_shlib retval; - - for (const_iterator p = lib_list.begin (); p != lib_list.end (); p++) - { - if (p->file_name () == file_name) - { - retval = *p; - break; - } - } - - return retval; -} - -void -octave_shlib_list::do_display (void) const -{ - std::cerr << "current shared libraries:" << std::endl; - for (const_iterator p = lib_list.begin (); p != lib_list.end (); p++) - std::cerr << " " << p->file_name () << std::endl; -} - -bool -octave_shlib_list::instance_ok (void) -{ - bool retval = true; - - if (! instance) - { - instance = new octave_shlib_list (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); - } - - if (! instance) - { - ::error ("unable to create shared library list object!"); - - retval = false; - } - - return retval; -} - -void -octave_shlib_list::append (const octave_shlib& shl) -{ - if (instance_ok ()) - instance->do_append (shl); -} - -void -octave_shlib_list::remove (octave_shlib& shl, - octave_shlib::close_hook cl_hook) -{ - if (instance_ok ()) - instance->do_remove (shl, cl_hook); -} - -octave_shlib -octave_shlib_list::find_file (const std::string& file_name) -{ - return (instance_ok ()) - ? instance->do_find_file (file_name) : octave_shlib (); -} - -void -octave_shlib_list::display (void) -{ - if (instance_ok ()) - instance->do_display (); -} - -octave_dynamic_loader *octave_dynamic_loader::instance = 0; - -bool octave_dynamic_loader::doing_load = false; - -bool -octave_dynamic_loader::instance_ok (void) -{ - bool retval = true; - - if (! instance) - { - instance = new octave_dynamic_loader (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); - } - - if (! instance) - { - ::error ("unable to create dynamic loader object!"); - - retval = false; - } - - return retval; -} - -static void -do_clear_function (const std::string& fcn_name) -{ - warning_with_id ("Octave:reload-forces-clear", " %s", fcn_name.c_str ()); - - symbol_table::clear_dld_function (fcn_name); -} - -static void -clear (octave_shlib& oct_file) -{ - if (oct_file.number_of_functions_loaded () > 1) - { - warning_with_id ("Octave:reload-forces-clear", - "reloading %s clears the following functions:", - oct_file.file_name ().c_str ()); - - octave_shlib_list::remove (oct_file, do_clear_function); - } - else - octave_shlib_list::remove (oct_file, symbol_table::clear_dld_function); -} - -octave_function * -octave_dynamic_loader::do_load_oct (const std::string& fcn_name, - const std::string& file_name, - bool relative) -{ - octave_function *retval = 0; - - unwind_protect frame; - - frame.protect_var (octave_dynamic_loader::doing_load); - - doing_load = true; - - octave_shlib oct_file = octave_shlib_list::find_file (file_name); - - if (oct_file && oct_file.is_out_of_date ()) - clear (oct_file); - - if (! oct_file) - { - oct_file.open (file_name); - - if (! error_state && oct_file) - octave_shlib_list::append (oct_file); - } - - if (! error_state) - { - if (oct_file) - { - void *function = oct_file.search (fcn_name, name_mangler); - - if (! function) - { - // FIXME -- can we determine this C mangling scheme - // automatically at run time or configure time? - - function = oct_file.search (fcn_name, name_uscore_mangler); - } - - if (function) - { - octave_dld_fcn_getter f - = FCN_PTR_CAST (octave_dld_fcn_getter, function); - - retval = f (oct_file, relative); - - if (! retval) - ::error ("failed to install .oct file function '%s'", - fcn_name.c_str ()); - } - } - else - ::error ("%s is not a valid shared library", - file_name.c_str ()); - } - - return retval; -} - -octave_function * -octave_dynamic_loader::do_load_mex (const std::string& fcn_name, - const std::string& file_name, - bool /*relative*/) -{ - octave_function *retval = 0; - - unwind_protect frame; - - frame.protect_var (octave_dynamic_loader::doing_load); - - doing_load = true; - - octave_shlib mex_file = octave_shlib_list::find_file (file_name); - - if (mex_file && mex_file.is_out_of_date ()) - clear (mex_file); - - if (! mex_file) - { - mex_file.open (file_name); - - if (! error_state && mex_file) - octave_shlib_list::append (mex_file); - } - - if (! error_state) - { - if (mex_file) - { - void *function = 0; - - bool have_fmex = false; - - function = mex_file.search (fcn_name, mex_mangler); - - if (! function) - { - // FIXME -- can we determine this C mangling scheme - // automatically at run time or configure time? - - function = mex_file.search (fcn_name, mex_uscore_mangler); - - if (! function) - { - function = mex_file.search (fcn_name, mex_f77_mangler); - - if (function) - have_fmex = true; - } - } - - if (function) - retval = new octave_mex_function (function, have_fmex, - mex_file, fcn_name); - else - ::error ("failed to install .mex file function '%s'", - fcn_name.c_str ()); - } - else - ::error ("%s is not a valid shared library", - file_name.c_str ()); - } - - return retval; -} - -bool -octave_dynamic_loader::do_remove_oct (const std::string& fcn_name, - octave_shlib& shl) -{ - bool retval = false; - - // We don't need to do anything if this is called because we are in - // the process of reloading a .oct file that has changed. - - if (! doing_load) - { - retval = shl.remove (fcn_name); - - if (shl.number_of_functions_loaded () == 0) - octave_shlib_list::remove (shl); - } - - return retval; -} - -bool -octave_dynamic_loader::do_remove_mex (const std::string& fcn_name, - octave_shlib& shl) -{ - bool retval = false; - - // We don't need to do anything if this is called because we are in - // the process of reloading a .oct file that has changed. - - if (! doing_load) - { - retval = shl.remove (fcn_name); - - if (shl.number_of_functions_loaded () == 0) - octave_shlib_list::remove (shl); - } - - return retval; -} - -octave_function * -octave_dynamic_loader::load_oct (const std::string& fcn_name, - const std::string& file_name, - bool relative) -{ - return (instance_ok ()) - ? instance->do_load_oct (fcn_name, file_name, relative) : 0; -} - -octave_function * -octave_dynamic_loader::load_mex (const std::string& fcn_name, - const std::string& file_name, - bool relative) -{ - return (instance_ok ()) - ? instance->do_load_mex (fcn_name, file_name, relative) : 0; -} - -bool -octave_dynamic_loader::remove_oct (const std::string& fcn_name, - octave_shlib& shl) -{ - return (instance_ok ()) ? instance->do_remove_oct (fcn_name, shl) : false; -} - -bool -octave_dynamic_loader::remove_mex (const std::string& fcn_name, - octave_shlib& shl) -{ - return (instance_ok ()) ? instance->do_remove_mex (fcn_name, shl) : false; -} - -std::string -octave_dynamic_loader::name_mangler (const std::string& name) -{ - return "G" + name; -} - -std::string -octave_dynamic_loader::name_uscore_mangler (const std::string& name) -{ - return "_G" + name; -} - -std::string -octave_dynamic_loader::mex_mangler (const std::string&) -{ - return "mexFunction"; -} - -std::string -octave_dynamic_loader::mex_uscore_mangler (const std::string&) -{ - return "_mexFunction"; -} - -std::string -octave_dynamic_loader::mex_f77_mangler (const std::string&) -{ - return STRINGIFY (F77_FUNC (mexfunction, MEXFUNCTION)); -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/dynamic-ld.h --- a/libinterp/interp-core/dynamic-ld.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,100 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_dynamic_ld_h) -#define octave_dynamic_ld_h 1 - -#include - -#include "oct-shlib.h" - -class octave_function; - -class -octave_dynamic_loader -{ -protected: - - octave_dynamic_loader (void) { } - -public: - - virtual ~octave_dynamic_loader (void) { } - - static octave_function * - load_oct (const std::string& fcn_name, - const std::string& file_name = std::string (), - bool relative = false); - - static octave_function * - load_mex (const std::string& fcn_name, - const std::string& file_name = std::string (), - bool relative = false); - - static bool remove_oct (const std::string& fcn_name, octave_shlib& shl); - - static bool remove_mex (const std::string& fcn_name, octave_shlib& shl); - -private: - - // No copying! - - octave_dynamic_loader (const octave_dynamic_loader&); - - octave_dynamic_loader& operator = (const octave_dynamic_loader&); - - static octave_dynamic_loader *instance; - - static void cleanup_instance (void) { delete instance; instance = 0; } - - static bool instance_ok (void); - - octave_function * - do_load_oct (const std::string& fcn_name, - const std::string& file_name = std::string (), - bool relative = false); - - octave_function * - do_load_mex (const std::string& fcn_name, - const std::string& file_name = std::string (), - bool relative = false); - - bool do_remove_oct (const std::string& fcn_name, octave_shlib& shl); - - bool do_remove_mex (const std::string& fcn_name, octave_shlib& shl); - - static bool doing_load; - -protected: - - static std::string name_mangler (const std::string& name); - - static std::string name_uscore_mangler (const std::string& name); - - static std::string mex_mangler (const std::string& name); - - static std::string mex_uscore_mangler (const std::string& name); - - static std::string mex_f77_mangler (const std::string& name); -}; - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/event-queue.h --- a/libinterp/interp-core/event-queue.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,125 +0,0 @@ -/* - -Copyright (C) 2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_event_queue_h) -#define octave_event_queue_h 1 - -#include -#include - -#include "action-container.h" - -class -event_queue : public action_container -{ -public: - - event_queue (void) : fifo () { } - - // Destructor should not raise an exception, so all actions - // registered should be exception-safe (but setting error_state is - // allowed). If you're not sure, see event_queue_safe. - - ~event_queue (void) { run (); } - - void add (elem *new_elem) - { - fifo.push (new_elem); - } - - void run_first (void) - { - if (! empty ()) - { - // No leak on exception! - std::auto_ptr ptr (fifo.front ()); - fifo.pop (); - ptr->run (); - } - } - - void discard_first (void) - { - if (! empty ()) - { - elem *ptr = fifo.front (); - fifo.pop (); - delete ptr; - } - } - - size_t size (void) const { return fifo.size (); } - -protected: - - std::queue fifo; - -private: - - // No copying! - - event_queue (const event_queue&); - - event_queue& operator = (const event_queue&); -}; - -// Like event_queue, but this one will guard against the -// possibility of seeing an exception (or interrupt) in the cleanup -// actions. Not that we can do much about it, but at least we won't -// crash. - -class -event_queue_safe : public event_queue -{ -private: - - static void gripe_exception (void); - -public: - - event_queue_safe (void) : event_queue () { } - - ~event_queue_safe (void) - { - while (! empty ()) - { - try - { - run_first (); - } - catch (...) // Yes, the black hole. Remember we're in a dtor. - { - gripe_exception (); - } - } - } - -private: - - // No copying! - - event_queue_safe (const event_queue_safe&); - - event_queue_safe& operator = (const event_queue_safe&); -}; - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/gl-render.cc --- a/libinterp/interp-core/gl-render.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,3048 +0,0 @@ -/* - -Copyright (C) 2008-2012 Michael Goffioul - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#if defined (HAVE_OPENGL) - -#include - -#include -#include "oct-locbuf.h" -#include "oct-refcount.h" -#include "gl-render.h" -#include "txt-eng.h" -#include "txt-eng-ft.h" - -#define LIGHT_MODE GL_FRONT_AND_BACK - -// Win32 API requires the CALLBACK attributes for -// GLU callback functions. Define it to empty on -// other platforms. -#ifndef CALLBACK -#define CALLBACK -#endif - -static octave_idx_type -xmin (octave_idx_type x, octave_idx_type y) -{ - return x < y ? x : y; -} - -class -opengl_texture -{ -protected: - class texture_rep - { - public: - texture_rep (void) - : id (), w (), h (), tw (), th (), tx (), ty (), - valid (false), count (1) - { } - - texture_rep (GLuint id_arg, int w_arg, int h_arg, int tw_arg, int th_arg) - : id (id_arg), w (w_arg), h (h_arg), tw (tw_arg), th (th_arg), - tx (double(w)/tw), ty (double(h)/th), valid (true), - count (1) { } - - ~texture_rep (void) - { - if (valid) - glDeleteTextures (1, &id); - } - - void bind (int mode) const - { if (valid) glBindTexture (mode, id); } - - void tex_coord (double q, double r) const - { if (valid) glTexCoord2d (q*tx, r*ty); } - - GLuint id; - int w, h; - int tw, th; - double tx, ty; - bool valid; - octave_refcount count; - }; - - texture_rep *rep; - -private: - opengl_texture (texture_rep *_rep) : rep (_rep) { } - -public: - opengl_texture (void) : rep (new texture_rep ()) { } - - opengl_texture (const opengl_texture& tx) - : rep (tx.rep) - { - rep->count++; - } - - ~opengl_texture (void) - { - if (--rep->count == 0) - delete rep; - } - - opengl_texture& operator = (const opengl_texture& tx) - { - if (--rep->count == 0) - delete rep; - - rep = tx.rep; - rep->count++; - - return *this; - } - - static opengl_texture create (const octave_value& data); - - void bind (int mode = GL_TEXTURE_2D) const - { rep->bind (mode); } - - void tex_coord (double q, double r) const - { rep->tex_coord (q, r); } - - bool is_valid (void) const - { return rep->valid; } -}; - -static int -next_power_of_2 (int n) -{ - int m = 1; - - while (m < n && m < std::numeric_limits::max ()) - m <<= 1; - - return m; -} - -opengl_texture -opengl_texture::create (const octave_value& data) -{ - opengl_texture retval; - - dim_vector dv (data.dims ()); - - // Expect RGB data - if (dv.length () == 3 && dv(2) == 3) - { - // FIXME -- dim_vectors hold octave_idx_type values. Should we - // check for dimensions larger than intmax? - int h = dv(0), w = dv(1), tw, th; - GLuint id; - bool ok = true; - - tw = next_power_of_2 (w); - th = next_power_of_2 (w); - - glGenTextures (1, &id); - glBindTexture (GL_TEXTURE_2D, id); - - if (data.is_double_type ()) - { - const NDArray xdata = data.array_value (); - - OCTAVE_LOCAL_BUFFER (float, a, (3*tw*th)); - - for (int i = 0; i < h; i++) - { - for (int j = 0, idx = i*tw*3; j < w; j++, idx += 3) - { - a[idx] = xdata(i,j,0); - a[idx+1] = xdata(i,j,1); - a[idx+2] = xdata(i,j,2); - } - } - - glTexImage2D (GL_TEXTURE_2D, 0, 3, tw, th, 0, - GL_RGB, GL_FLOAT, a); - } - else if (data.is_uint8_type ()) - { - const uint8NDArray xdata = data.uint8_array_value (); - - OCTAVE_LOCAL_BUFFER (octave_uint8, a, (3*tw*th)); - - for (int i = 0; i < h; i++) - { - for (int j = 0, idx = i*tw*3; j < w; j++, idx += 3) - { - a[idx] = xdata(i,j,0); - a[idx+1] = xdata(i,j,1); - a[idx+2] = xdata(i,j,2); - } - } - - glTexImage2D (GL_TEXTURE_2D, 0, 3, tw, th, 0, - GL_RGB, GL_UNSIGNED_BYTE, a); - } - else - { - ok = false; - warning ("opengl_texture::create: invalid texture data type (expected double or uint8)"); - } - - if (ok) - { - glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST); - glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST); - - if (glGetError () != GL_NO_ERROR) - warning ("opengl_texture::create: OpenGL error while generating texture data"); - else - retval = opengl_texture (new texture_rep (id, w, h, tw, th)); - } - } - else - warning ("opengl_texture::create: invalid texture data size"); - - return retval; -} - -class -opengl_tesselator -{ -public: -#if defined (HAVE_FRAMEWORK_OPENGL) && defined (HAVE_GLUTESSCALLBACK_THREEDOTS) - typedef GLvoid (CALLBACK *fcn) (...); -#else - typedef void (CALLBACK *fcn) (void); -#endif - -public: - - opengl_tesselator (void) : glu_tess (0), fill () { init (); } - - virtual ~opengl_tesselator (void) - { if (glu_tess) gluDeleteTess (glu_tess); } - - void begin_polygon (bool filled = true) - { - gluTessProperty (glu_tess, GLU_TESS_BOUNDARY_ONLY, - (filled ? GL_FALSE : GL_TRUE)); - fill = filled; - gluTessBeginPolygon (glu_tess, this); - } - - void end_polygon (void) const - { gluTessEndPolygon (glu_tess); } - - void begin_contour (void) const - { gluTessBeginContour (glu_tess); } - - void end_contour (void) const - { gluTessEndContour (glu_tess); } - - void add_vertex (double *loc, void *data) const - { gluTessVertex (glu_tess, loc, data); } - -protected: - virtual void begin (GLenum /*type*/) { } - - virtual void end (void) { } - - virtual void vertex (void */*data*/) { } - - virtual void combine (GLdouble /*c*/[3], void */*data*/[4], - GLfloat /*w*/[4], void **/*out_data*/) { } - - virtual void edge_flag (GLboolean /*flag*/) { } - - virtual void error (GLenum err) - { ::error ("OpenGL tesselation error (%d)", err); } - - virtual void init (void) - { - glu_tess = gluNewTess (); - - gluTessCallback (glu_tess, GLU_TESS_BEGIN_DATA, - reinterpret_cast (tess_begin)); - gluTessCallback (glu_tess, GLU_TESS_END_DATA, - reinterpret_cast (tess_end)); - gluTessCallback (glu_tess, GLU_TESS_VERTEX_DATA, - reinterpret_cast (tess_vertex)); - gluTessCallback (glu_tess, GLU_TESS_COMBINE_DATA, - reinterpret_cast (tess_combine)); - gluTessCallback (glu_tess, GLU_TESS_EDGE_FLAG_DATA, - reinterpret_cast (tess_edge_flag)); - gluTessCallback (glu_tess, GLU_TESS_ERROR_DATA, - reinterpret_cast (tess_error)); - } - - bool is_filled (void) const { return fill; } - -private: - static void CALLBACK tess_begin (GLenum type, void *t) - { reinterpret_cast (t)->begin (type); } - - static void CALLBACK tess_end (void *t) - { reinterpret_cast (t)->end (); } - - static void CALLBACK tess_vertex (void *v, void *t) - { reinterpret_cast (t)->vertex (v); } - - static void CALLBACK tess_combine (GLdouble c[3], void *v[4], GLfloat w[4], - void **out, void *t) - { reinterpret_cast (t)->combine (c, v, w, out); } - - static void CALLBACK tess_edge_flag (GLboolean flag, void *t) - { reinterpret_cast (t)->edge_flag (flag); } - - static void CALLBACK tess_error (GLenum err, void *t) - { reinterpret_cast (t)->error (err); } - -private: - - // No copying! - - opengl_tesselator (const opengl_tesselator&); - - opengl_tesselator operator = (const opengl_tesselator&); - - GLUtesselator *glu_tess; - bool fill; -}; - -class -vertex_data -{ -public: - class vertex_data_rep - { - public: - Matrix coords; - Matrix color; - Matrix normal; - double alpha; - float ambient; - float diffuse; - float specular; - float specular_exp; - - // reference counter - octave_refcount count; - - vertex_data_rep (void) - : coords (), color (), normal (), alpha (), - ambient (), diffuse (), specular (), specular_exp (),count (1) { } - - vertex_data_rep (const Matrix& c, const Matrix& col, const Matrix& n, - double a, float as, float ds, float ss, float se) - : coords (c), color (col), normal (n), alpha (a), - ambient (as), diffuse (ds), specular (ss), specular_exp (se), - count (1) { } - }; - -private: - vertex_data_rep *rep; - - vertex_data_rep *nil_rep (void) const - { - static vertex_data_rep *nr = new vertex_data_rep (); - - return nr; - } - -public: - vertex_data (void) : rep (nil_rep ()) - { rep->count++; } - - vertex_data (const vertex_data& v) : rep (v.rep) - { rep->count++; } - - vertex_data (const Matrix& c, const Matrix& col, const Matrix& n, - double a, float as, float ds, float ss, float se) - : rep (new vertex_data_rep (c, col, n, a, as, ds, ss, se)) - { } - - vertex_data (vertex_data_rep *new_rep) - : rep (new_rep) { } - - ~vertex_data (void) - { - if (--rep->count == 0) - delete rep; - } - - vertex_data& operator = (const vertex_data& v) - { - if (--rep->count == 0) - delete rep; - - rep = v.rep; - rep->count++; - - return *this; - } - - vertex_data_rep *get_rep (void) const { return rep; } -}; - -class -opengl_renderer::patch_tesselator : public opengl_tesselator -{ -public: - patch_tesselator (opengl_renderer *r, int cmode, int lmode, int idx = 0) - : opengl_tesselator (), renderer (r), - color_mode (cmode), light_mode (lmode), index (idx), - first (true), tmp_vdata () - { } - -protected: - void begin (GLenum type) - { - //printf ("patch_tesselator::begin (%d)\n", type); - first = true; - - if (color_mode == 2 || light_mode == 2) - glShadeModel (GL_SMOOTH); - else - glShadeModel (GL_FLAT); - - if (is_filled ()) - renderer->set_polygon_offset (true, 1+index); - - glBegin (type); - } - - void end (void) - { - //printf ("patch_tesselator::end\n"); - glEnd (); - renderer->set_polygon_offset (false); - } - - void vertex (void *data) - { - vertex_data::vertex_data_rep *v - = reinterpret_cast (data); - //printf ("patch_tesselator::vertex (%g, %g, %g)\n", v->coords(0), v->coords(1), v->coords(2)); - - // FIXME: why did I need to keep the first vertex of the face - // in JHandles? I think it's related to the fact that the - // tessellation process might re-order the vertices, such that - // the first one you get here might not be the first one of the face; - // but I can't figure out the actual reason. - if (color_mode > 0 && (first || color_mode == 2)) - { - Matrix col = v->color; - - if (col.numel () == 3) - { - glColor3dv (col.data ()); - if (light_mode > 0) - { - float buf[4] = { 0, 0, 0, 1 }; - - for (int k = 0; k < 3; k++) - buf[k] = (v->ambient * col(k)); - glMaterialfv (LIGHT_MODE, GL_AMBIENT, buf); - - for (int k = 0; k < 3; k++) - buf[k] = (v->diffuse * col(k)); - glMaterialfv (LIGHT_MODE, GL_AMBIENT, buf); - } - } - } - - if (light_mode > 0 && (first || light_mode == 2)) - glNormal3dv (v->normal.data ()); - - glVertex3dv (v->coords.data ()); - - first = false; - } - - void combine (GLdouble xyz[3], void *data[4], GLfloat w[4], - void **out_data) - { - //printf ("patch_tesselator::combine\n"); - - vertex_data::vertex_data_rep *v[4]; - int vmax = 4; - - for (int i = 0; i < 4; i++) - { - v[i] = reinterpret_cast (data[i]); - - if (vmax == 4 && ! v[i]) - vmax = i; - } - - Matrix vv (1, 3, 0.0); - Matrix cc; - Matrix nn (1, 3, 0.0); - double aa = 0.0; - - vv(0) = xyz[0]; - vv(1) = xyz[1]; - vv(2) = xyz[2]; - - if (v[0]->color.numel ()) - { - cc.resize (1, 3, 0.0); - for (int ic = 0; ic < 3; ic++) - for (int iv = 0; iv < vmax; iv++) - cc(ic) += (w[iv] * v[iv]->color (ic)); - } - - if (v[0]->normal.numel () > 0) - { - for (int in = 0; in < 3; in++) - for (int iv = 0; iv < vmax; iv++) - nn(in) += (w[iv] * v[iv]->normal (in)); - } - - for (int iv = 0; iv < vmax; iv++) - aa += (w[iv] * v[iv]->alpha); - - vertex_data new_v (vv, cc, nn, aa, v[0]->ambient, v[0]->diffuse, - v[0]->specular, v[0]->specular_exp); - tmp_vdata.push_back (new_v); - - *out_data = new_v.get_rep (); - } - -private: - - // No copying! - - patch_tesselator (const patch_tesselator&); - - patch_tesselator& operator = (const patch_tesselator&); - - opengl_renderer *renderer; - int color_mode; // 0: uni, 1: flat, 2: interp - int light_mode; // 0: none, 1: flat, 2: gouraud - int index; - bool first; - std::list tmp_vdata; -}; - -void -opengl_renderer::draw (const graphics_object& go, bool toplevel) -{ - if (! go.valid_object ()) - return; - - const base_properties& props = go.get_properties (); - - if (! toolkit) - toolkit = props.get_toolkit (); - - if (go.isa ("figure")) - draw_figure (dynamic_cast (props)); - else if (go.isa ("axes")) - draw_axes (dynamic_cast (props)); - else if (go.isa ("line")) - draw_line (dynamic_cast (props)); - else if (go.isa ("surface")) - draw_surface (dynamic_cast (props)); - else if (go.isa ("patch")) - draw_patch (dynamic_cast (props)); - else if (go.isa ("hggroup")) - draw_hggroup (dynamic_cast (props)); - else if (go.isa ("text")) - draw_text (dynamic_cast (props)); - else if (go.isa ("image")) - draw_image (dynamic_cast (props)); - else if (go.isa ("uimenu") || go.isa ("uicontrol") - || go.isa ("uicontextmenu") || go.isa ("uitoolbar") - || go.isa ("uipushtool") || go.isa ("uitoggletool")) - /* SKIP */; - else if (go.isa ("uipanel")) - { - if (toplevel) - draw_uipanel (dynamic_cast (props), go); - } - else - { - warning ("opengl_renderer: cannot render object of type '%s'", - props.graphics_object_name ().c_str ()); - } -} - -void -opengl_renderer::draw_figure (const figure::properties& props) -{ - // Initialize OpenGL context - - init_gl_context (props.is___enhanced__ (), props.get_color_rgb ()); - - // Draw children - - draw (props.get_all_children (), false); -} - -void -opengl_renderer::draw_uipanel (const uipanel::properties& props, - const graphics_object& go) -{ - graphics_object fig = go.get_ancestor ("figure"); - const figure::properties& figProps = - dynamic_cast (fig.get_properties ()); - - // Initialize OpenGL context - - init_gl_context (figProps.is___enhanced__ (), - props.get_backgroundcolor_rgb ()); - - // Draw children - - draw (props.get_all_children (), false); -} - -void -opengl_renderer::init_gl_context (bool enhanced, const Matrix& c) -{ - // Initialize OpenGL context - - glEnable (GL_DEPTH_TEST); - glDepthFunc (GL_LEQUAL); - glBlendFunc (GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glAlphaFunc (GL_GREATER, 0.0f); - glEnable (GL_NORMALIZE); - - if (enhanced) - { - glEnable (GL_BLEND); - glEnable (GL_LINE_SMOOTH); - } - else - { - glDisable (GL_BLEND); - glDisable (GL_LINE_SMOOTH); - } - - // Clear background - - if (c.length () >= 3) - { - glClearColor (c(0), c(1), c(2), 1); - glClear (GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT); - } -} - -void -opengl_renderer::render_grid (const std::string& gridstyle, - const Matrix& ticks, double lim1, double lim2, - double p1, double p1N, double p2, double p2N, - int xyz, bool is_3D) -{ - set_linestyle (gridstyle, true); - glBegin (GL_LINES); - for (int i = 0; i < ticks.numel (); i++) - { - double val = ticks(i); - if (lim1 <= val && val <= lim2) - { - if (xyz == 0) // X - { - glVertex3d (val, p1N, p2); - glVertex3d (val, p1, p2); - if (is_3D) - { - glVertex3d (val, p1, p2N); - glVertex3d (val, p1, p2); - } - } - else if (xyz == 1) // Y - { - glVertex3d (p1N, val, p2); - glVertex3d (p1, val, p2); - if (is_3D) - { - glVertex3d (p1, val, p2N); - glVertex3d (p1, val, p2); - } - } - else if (xyz == 2) // Z - { - glVertex3d (p1N, p2, val); - glVertex3d (p1, p2, val); - glVertex3d (p1, p2N, val); - glVertex3d (p1, p2, val); - } - } - } - glEnd (); - set_linestyle ("-", true); -} - -void -opengl_renderer::render_tickmarks (const Matrix& ticks, - double lim1, double lim2, - double p1, double p1N, - double p2, double p2N, - double dx, double dy, double dz, - int xyz, bool mirror) -{ - glBegin (GL_LINES); - - for (int i = 0; i < ticks.numel (); i++) - { - double val = ticks(i); - - if (lim1 <= val && val <= lim2) - { - if (xyz == 0) // X - { - glVertex3d (val, p1, p2); - glVertex3d (val, p1+dy, p2+dz); - if (mirror) - { - glVertex3d (val, p1N, p2N); - glVertex3d (val, p1N-dy, p2N-dz); - } - } - else if (xyz == 1) // Y - { - glVertex3d (p1, val, p2); - glVertex3d (p1+dx, val, p2+dz); - if (mirror) - { - glVertex3d (p1N, val, p2N); - glVertex3d (p1N-dx, val, p2N-dz); - } - } - else if (xyz == 2) // Z - { - glVertex3d (p1, p2, val); - glVertex3d (p1+dx, p2+dy, val); - if (mirror) - { - glVertex3d (p1N, p2N, val); - glVertex3d (p1N-dx, p2N-dy, val); - } - } - } - } - - glEnd (); -} - -void -opengl_renderer::render_ticktexts (const Matrix& ticks, - const string_vector& ticklabels, - double lim1, double lim2, - double p1, double p2, - int xyz, int ha, int va, - int& wmax, int& hmax) -{ - int nticks = ticks.numel (); - int nlabels = ticklabels.numel (); - - if (nlabels == 0) - return; - - for (int i = 0; i < nticks; i++) - { - double val = ticks(i); - - if (lim1 <= val && val <= lim2) - { - Matrix b; - - std::string label (ticklabels(i % nlabels)); - label.erase (0, label.find_first_not_of (" ")); - label = label.substr (0, label.find_last_not_of (" ")+1); - - // FIXME: as tick text is transparent, shouldn't it be - // drawn after axes object, for correct rendering? - if (xyz == 0) // X - { - b = render_text (label, val, p1, p2, ha, va); - } - else if (xyz == 1) // Y - { - b = render_text (label, p1, val, p2, ha, va); - } - else if (xyz == 2) // Z - { - b = render_text (label, p1, p2, val, ha, va); - } - - wmax = std::max (wmax, static_cast (b(2))); - hmax = std::max (hmax, static_cast (b(3))); - } - } -} - -void -opengl_renderer::setup_opengl_transformation (const axes::properties& props) -{ - // setup OpenGL transformation - - Matrix x_zlim = props.get_transform_zlim (); - - xZ1 = x_zlim(0)-(x_zlim(1)-x_zlim(0))/2; - xZ2 = x_zlim(1)+(x_zlim(1)-x_zlim(0))/2; - - Matrix x_mat1 = props.get_opengl_matrix_1 (); - Matrix x_mat2 = props.get_opengl_matrix_2 (); - -#if defined (HAVE_FRAMEWORK_OPENGL) - GLint vw[4]; -#else - int vw[4]; -#endif - - glGetIntegerv (GL_VIEWPORT, vw); - - glMatrixMode (GL_MODELVIEW); - glLoadIdentity (); - glScaled (1, 1, -1); - glMultMatrixd (x_mat1.data ()); - glMatrixMode (GL_PROJECTION); - glLoadIdentity (); - glOrtho (0, vw[2], vw[3], 0, xZ1, xZ2); - glMultMatrixd (x_mat2.data ()); - glMatrixMode (GL_MODELVIEW); - - glClear (GL_DEPTH_BUFFER_BIT); - - glDisable (GL_LINE_SMOOTH); - - // store axes transformation data - - xform = props.get_transform (); -} - -void -opengl_renderer::draw_axes_planes (const axes::properties& props) -{ - double xPlane = props.get_xPlane (); - double yPlane = props.get_yPlane (); - double zPlane = props.get_zPlane (); - double xPlaneN = props.get_xPlaneN (); - double yPlaneN = props.get_yPlaneN (); - double zPlaneN = props.get_zPlaneN (); - - // Axes planes - Matrix axe_color = props.get_color_rgb (); - if (axe_color.numel () > 0 && props.is_visible ()) - { - set_color (axe_color); - set_polygon_offset (true, 2.5); - - glBegin (GL_QUADS); - - // X plane - glVertex3d (xPlane, yPlaneN, zPlaneN); - glVertex3d (xPlane, yPlane, zPlaneN); - glVertex3d (xPlane, yPlane, zPlane); - glVertex3d (xPlane, yPlaneN, zPlane); - - // Y plane - glVertex3d (xPlaneN, yPlane, zPlaneN); - glVertex3d (xPlane, yPlane, zPlaneN); - glVertex3d (xPlane, yPlane, zPlane); - glVertex3d (xPlaneN, yPlane, zPlane); - - // Z plane - glVertex3d (xPlaneN, yPlaneN, zPlane); - glVertex3d (xPlane, yPlaneN, zPlane); - glVertex3d (xPlane, yPlane, zPlane); - glVertex3d (xPlaneN, yPlane, zPlane); - - glEnd (); - - set_polygon_offset (false); - } -} - -void -opengl_renderer::draw_axes_boxes (const axes::properties& props) -{ - bool xySym = props.get_xySym (); - double xPlane = props.get_xPlane (); - double yPlane = props.get_yPlane (); - double zPlane = props.get_zPlane (); - double xPlaneN = props.get_xPlaneN (); - double yPlaneN = props.get_yPlaneN (); - double zPlaneN = props.get_zPlaneN (); - double xpTick = props.get_xpTick (); - double ypTick = props.get_ypTick (); - double zpTick = props.get_zpTick (); - double xpTickN = props.get_xpTickN (); - double ypTickN = props.get_ypTickN (); - double zpTickN = props.get_zpTickN (); - - bool plotyy = (props.has_property ("__plotyy_axes__")); - - // Axes box - - set_linestyle ("-", true); - set_linewidth (props.get_linewidth ()); - - if (props.is_visible ()) - { - glBegin (GL_LINES); - - // X box - set_color (props.get_xcolor_rgb ()); - glVertex3d (xPlaneN, ypTick, zpTick); - glVertex3d (xPlane, ypTick, zpTick); - - if (props.is_box ()) - { - glVertex3d (xPlaneN, ypTickN, zpTick); - glVertex3d (xPlane, ypTickN, zpTick); - glVertex3d (xPlaneN, ypTickN, zpTickN); - glVertex3d (xPlane, ypTickN, zpTickN); - glVertex3d (xPlaneN, ypTick, zpTickN); - glVertex3d (xPlane, ypTick, zpTickN); - } - - // Y box - set_color (props.get_ycolor_rgb ()); - glVertex3d (xpTick, yPlaneN, zpTick); - glVertex3d (xpTick, yPlane, zpTick); - - if (props.is_box () && ! plotyy) - { - glVertex3d (xpTickN, yPlaneN, zpTick); - glVertex3d (xpTickN, yPlane, zpTick); - glVertex3d (xpTickN, yPlaneN, zpTickN); - glVertex3d (xpTickN, yPlane, zpTickN); - glVertex3d (xpTick, yPlaneN, zpTickN); - glVertex3d (xpTick, yPlane, zpTickN); - } - - // Z box - set_color (props.get_zcolor_rgb ()); - - if (xySym) - { - glVertex3d (xPlaneN, yPlane, zPlaneN); - glVertex3d (xPlaneN, yPlane, zPlane); - } - else - { - glVertex3d (xPlane, yPlaneN, zPlaneN); - glVertex3d (xPlane, yPlaneN, zPlane); - } - - if (props.is_box ()) - { - glVertex3d (xPlane, yPlane, zPlaneN); - glVertex3d (xPlane, yPlane, zPlane); - - if (xySym) - { - glVertex3d (xPlane, yPlaneN, zPlaneN); - glVertex3d (xPlane, yPlaneN, zPlane); - } - else - { - glVertex3d (xPlaneN, yPlane, zPlaneN); - glVertex3d (xPlaneN, yPlane, zPlane); - } - - glVertex3d (xPlaneN, yPlaneN, zPlaneN); - glVertex3d (xPlaneN, yPlaneN, zPlane); - } - - glEnd (); - } -} - -void -opengl_renderer::draw_axes_x_grid (const axes::properties& props) -{ - int xstate = props.get_xstate (); - int zstate = props.get_zstate (); - bool x2Dtop = props.get_x2Dtop (); - bool layer2Dtop = props.get_layer2Dtop (); - bool xyzSym = props.get_xyzSym (); - bool nearhoriz = props.get_nearhoriz (); - double xticklen = props.get_xticklen (); - double xtickoffset = props.get_xtickoffset (); - double fy = props.get_fy (); - double fz = props.get_fz (); - double x_min = props.get_x_min (); - double x_max = props.get_x_max (); - double yPlane = props.get_yPlane (); - double yPlaneN = props.get_yPlaneN (); - double ypTick = props.get_ypTick (); - double ypTickN = props.get_ypTickN (); - double zPlane = props.get_zPlane (); - double zPlaneN = props.get_zPlaneN (); - double zpTick = props.get_zpTick (); - double zpTickN = props.get_zpTickN (); - - // X grid - - if (props.is_visible () && xstate != AXE_DEPTH_DIR) - { - std::string gridstyle = props.get_gridlinestyle (); - std::string minorgridstyle = props.get_minorgridlinestyle (); - bool do_xgrid = (props.is_xgrid () && (gridstyle != "none")); - bool do_xminorgrid = (props.is_xminorgrid () && (minorgridstyle != "none")); - bool do_xminortick = props.is_xminortick (); - Matrix xticks = xform.xscale (props.get_xtick ().matrix_value ()); - Matrix xmticks = xform.xscale (props.get_xmtick ().matrix_value ()); - string_vector xticklabels = props.get_xticklabel ().all_strings (); - int wmax = 0, hmax = 0; - bool tick_along_z = nearhoriz || xisinf (fy); - bool mirror = props.is_box () && xstate != AXE_ANY_DIR; - - set_color (props.get_xcolor_rgb ()); - - // grid lines - if (do_xgrid) - render_grid (gridstyle, xticks, x_min, x_max, - yPlane, yPlaneN, layer2Dtop ? zPlaneN : zPlane, - zPlaneN, 0, (zstate != AXE_DEPTH_DIR)); - - // tick marks - if (tick_along_z) - { - render_tickmarks (xticks, x_min, x_max, ypTick, ypTick, - zpTick, zpTickN, 0., 0., - signum (zpTick-zpTickN)*fz*xticklen, - 0, mirror); - } - else - { - render_tickmarks (xticks, x_min, x_max, ypTick, ypTickN, - zpTick, zpTick, 0., - signum (ypTick-ypTickN)*fy*xticklen, - 0., 0, mirror); - } - - // tick texts - if (xticklabels.numel () > 0) - { - int halign = (xstate == AXE_HORZ_DIR ? 1 : (xyzSym ? 0 : 2)); - int valign = (xstate == AXE_VERT_DIR ? 1 : (x2Dtop ? 0 : 2)); - - if (tick_along_z) - render_ticktexts (xticks, xticklabels, x_min, x_max, ypTick, - zpTick+signum (zpTick-zpTickN)*fz*xtickoffset, - 0, halign, valign, wmax, hmax); - else - render_ticktexts (xticks, xticklabels, x_min, x_max, - ypTick+signum (ypTick-ypTickN)*fy*xtickoffset, - zpTick, 0, halign, valign, wmax, hmax); - } - - // minor grid lines - if (do_xminorgrid) - render_grid (minorgridstyle, xmticks, x_min, x_max, - yPlane, yPlaneN, layer2Dtop ? zPlaneN : zPlane, - zPlaneN, 0, (zstate != AXE_DEPTH_DIR)); - - // minor tick marks - if (do_xminortick) - { - if (tick_along_z) - render_tickmarks (xmticks, x_min, x_max, ypTick, ypTick, - zpTick, zpTickN, 0., 0., - signum (zpTick-zpTickN)*fz*xticklen/2, - 0, mirror); - else - render_tickmarks (xmticks, x_min, x_max, ypTick, ypTickN, - zpTick, zpTick, 0., - signum (ypTick-ypTickN)*fy*xticklen/2, - 0., 0, mirror); - } - - gh_manager::get_object (props.get_xlabel ()).set ("visible", "on"); - } - else - gh_manager::get_object (props.get_xlabel ()).set ("visible", "off"); -} - -void -opengl_renderer::draw_axes_y_grid (const axes::properties& props) -{ - int ystate = props.get_ystate (); - int zstate = props.get_zstate (); - bool y2Dright = props.get_y2Dright (); - bool layer2Dtop = props.get_layer2Dtop (); - bool xyzSym = props.get_xyzSym (); - bool nearhoriz = props.get_nearhoriz (); - double yticklen = props.get_yticklen (); - double ytickoffset = props.get_ytickoffset (); - double fx = props.get_fx (); - double fz = props.get_fz (); - double xPlane = props.get_xPlane (); - double xPlaneN = props.get_xPlaneN (); - double xpTick = props.get_xpTick (); - double xpTickN = props.get_xpTickN (); - double y_min = props.get_y_min (); - double y_max = props.get_y_max (); - double zPlane = props.get_zPlane (); - double zPlaneN = props.get_zPlaneN (); - double zpTick = props.get_zpTick (); - double zpTickN = props.get_zpTickN (); - - // Y grid - - if (ystate != AXE_DEPTH_DIR && props.is_visible ()) - { - std::string gridstyle = props.get_gridlinestyle (); - std::string minorgridstyle = props.get_minorgridlinestyle (); - bool do_ygrid = (props.is_ygrid () && (gridstyle != "none")); - bool do_yminorgrid = (props.is_yminorgrid () && (minorgridstyle != "none")); - bool do_yminortick = props.is_yminortick (); - Matrix yticks = xform.yscale (props.get_ytick ().matrix_value ()); - Matrix ymticks = xform.yscale (props.get_ymtick ().matrix_value ()); - string_vector yticklabels = props.get_yticklabel ().all_strings (); - int wmax = 0, hmax = 0; - bool tick_along_z = nearhoriz || xisinf (fx); - bool mirror = props.is_box () && ystate != AXE_ANY_DIR - && (! props.has_property ("__plotyy_axes__")); - - set_color (props.get_ycolor_rgb ()); - - // grid lines - if (do_ygrid) - render_grid (gridstyle, yticks, y_min, y_max, - xPlane, xPlaneN, layer2Dtop ? zPlaneN : zPlane, - zPlaneN, 1, (zstate != AXE_DEPTH_DIR)); - - // tick marks - if (tick_along_z) - render_tickmarks (yticks, y_min, y_max, xpTick, xpTick, - zpTick, zpTickN, 0., 0., - signum (zpTick-zpTickN)*fz*yticklen, - 1, mirror); - else - render_tickmarks (yticks, y_min, y_max, xpTick, xpTickN, - zpTick, zpTick, - signum (xPlaneN-xPlane)*fx*yticklen, - 0., 0., 1, mirror); - - // tick texts - if (yticklabels.numel () > 0) - { - int halign = (ystate == AXE_HORZ_DIR - ? 1 : (!xyzSym || y2Dright ? 0 : 2)); - int valign = (ystate == AXE_VERT_DIR ? 1 : 2); - - if (tick_along_z) - render_ticktexts (yticks, yticklabels, y_min, y_max, xpTick, - zpTick+signum (zpTick-zpTickN)*fz*ytickoffset, - 1, halign, valign, wmax, hmax); - else - render_ticktexts (yticks, yticklabels, y_min, y_max, - xpTick+signum (xpTick-xpTickN)*fx*ytickoffset, - zpTick, 1, halign, valign, wmax, hmax); - } - - // minor grid lines - if (do_yminorgrid) - render_grid (minorgridstyle, ymticks, y_min, y_max, - xPlane, xPlaneN, layer2Dtop ? zPlaneN : zPlane, - zPlaneN, 1, (zstate != AXE_DEPTH_DIR)); - - // minor tick marks - if (do_yminortick) - { - if (tick_along_z) - render_tickmarks (ymticks, y_min, y_max, xpTick, xpTick, - zpTick, zpTickN, 0., 0., - signum (zpTick-zpTickN)*fz*yticklen/2, - 1, mirror); - else - render_tickmarks (ymticks, y_min, y_max, xpTick, xpTickN, - zpTick, zpTick, - signum (xpTick-xpTickN)*fx*yticklen/2, - 0., 0., 1, mirror); - } - - gh_manager::get_object (props.get_ylabel ()).set ("visible", "on"); - } - else - gh_manager::get_object (props.get_ylabel ()).set ("visible", "off"); -} - -void -opengl_renderer::draw_axes_z_grid (const axes::properties& props) -{ - int zstate = props.get_zstate (); - bool xySym = props.get_xySym (); - bool zSign = props.get_zSign (); - double zticklen = props.get_zticklen (); - double ztickoffset = props.get_ztickoffset (); - double fx = props.get_fx (); - double fy = props.get_fy (); - double xPlane = props.get_xPlane (); - double xPlaneN = props.get_xPlaneN (); - double yPlane = props.get_yPlane (); - double yPlaneN = props.get_yPlaneN (); - double z_min = props.get_z_min (); - double z_max = props.get_z_max (); - - // Z Grid - - if (zstate != AXE_DEPTH_DIR && props.is_visible ()) - { - std::string gridstyle = props.get_gridlinestyle (); - std::string minorgridstyle = props.get_minorgridlinestyle (); - bool do_zgrid = (props.is_zgrid () && (gridstyle != "none")); - bool do_zminorgrid = (props.is_zminorgrid () && (minorgridstyle != "none")); - bool do_zminortick = props.is_zminortick (); - Matrix zticks = xform.zscale (props.get_ztick ().matrix_value ()); - Matrix zmticks = xform.zscale (props.get_zmtick ().matrix_value ()); - string_vector zticklabels = props.get_zticklabel ().all_strings (); - int wmax = 0, hmax = 0; - bool mirror = props.is_box () && zstate != AXE_ANY_DIR; - - set_color (props.get_zcolor_rgb ()); - - // grid lines - if (do_zgrid) - render_grid (gridstyle, zticks, z_min, z_max, - xPlane, xPlaneN, yPlane, yPlaneN, 2, true); - - // tick marks - if (xySym) - { - if (xisinf (fy)) - render_tickmarks (zticks, z_min, z_max, xPlaneN, xPlane, - yPlane, yPlane, - signum (xPlaneN-xPlane)*fx*zticklen, - 0., 0., 2, mirror); - else - render_tickmarks (zticks, z_min, z_max, xPlaneN, xPlaneN, - yPlane, yPlane, 0., - signum (yPlane-yPlaneN)*fy*zticklen, - 0., 2, false); - } - else - { - if (xisinf (fx)) - render_tickmarks (zticks, z_min, z_max, xPlaneN, xPlane, - yPlaneN, yPlane, 0., - signum (yPlaneN-yPlane)*fy*zticklen, - 0., 2, mirror); - else - render_tickmarks (zticks, z_min, z_max, xPlane, xPlane, - yPlaneN, yPlane, - signum (xPlane-xPlaneN)*fx*zticklen, - 0., 0., 2, false); - } - - // FIXME: tick texts - if (zticklabels.numel () > 0) - { - int halign = 2; - int valign = (zstate == AXE_VERT_DIR ? 1 : (zSign ? 3 : 2)); - - if (xySym) - { - if (xisinf (fy)) - render_ticktexts (zticks, zticklabels, z_min, z_max, - xPlaneN+signum (xPlaneN-xPlane)*fx*ztickoffset, - yPlane, 2, halign, valign, wmax, hmax); - else - render_ticktexts (zticks, zticklabels, z_min, z_max, xPlaneN, - yPlane+signum (yPlane-yPlaneN)*fy*ztickoffset, - 2, halign, valign, wmax, hmax); - } - else - { - if (xisinf (fx)) - render_ticktexts (zticks, zticklabels, z_min, z_max, xPlane, - yPlaneN+signum (yPlaneN-yPlane)*fy*ztickoffset, - 2, halign, valign, wmax, hmax); - else - render_ticktexts (zticks, zticklabels, z_min, z_max, - xPlane+signum (xPlane-xPlaneN)*fx*ztickoffset, - yPlaneN, 2, halign, valign, wmax, hmax); - } - } - - // minor grid lines - if (do_zminorgrid) - render_grid (minorgridstyle, zmticks, z_min, z_max, - xPlane, xPlaneN, yPlane, yPlaneN, 2, true); - - // minor tick marks - if (do_zminortick) - { - if (xySym) - { - if (xisinf (fy)) - render_tickmarks (zmticks, z_min, z_max, xPlaneN, xPlane, - yPlane, yPlane, - signum (xPlaneN-xPlane)*fx*zticklen/2, - 0., 0., 2, mirror); - else - render_tickmarks (zmticks, z_min, z_max, xPlaneN, xPlaneN, - yPlane, yPlane, 0., - signum (yPlane-yPlaneN)*fy*zticklen/2, - 0., 2, false); - } - else - { - if (xisinf (fx)) - render_tickmarks (zmticks, z_min, z_max, xPlane, xPlane, - yPlaneN, yPlane, 0., - signum (yPlaneN-yPlane)*fy*zticklen/2, - 0., 2, mirror); - else - render_tickmarks (zmticks, z_min, z_max, xPlane, xPlane, - yPlaneN, yPlaneN, - signum (xPlane-xPlaneN)*fx*zticklen/2, - 0., 0., 2, false); - } - } - - gh_manager::get_object (props.get_zlabel ()).set ("visible", "on"); - } - else - gh_manager::get_object (props.get_zlabel ()).set ("visible", "off"); -} - -void -opengl_renderer::draw_axes_children (const axes::properties& props) -{ - // Children - - GLboolean antialias; - glGetBooleanv (GL_LINE_SMOOTH, &antialias); - - if (antialias == GL_TRUE) - glEnable (GL_LINE_SMOOTH); - - Matrix children = props.get_all_children (); - std::list obj_list; - std::list::iterator it; - - // 1st pass: draw light objects - - // Start with the last element of the array of child objects to - // display them in the oder they were added to the array. - - for (octave_idx_type i = children.numel () - 1; i >= 0; i--) - { - graphics_object go = gh_manager::get_object (children (i)); - - if (go.get_properties ().is_visible ()) - { - if (go.isa ("light")) - draw (go); - else - obj_list.push_back (go); - } - } - - // 2nd pass: draw other objects (with units set to "data") - - it = obj_list.begin (); - while (it != obj_list.end ()) - { - graphics_object go = (*it); - - // FIXME: check whether object has "units" property and it is set - // to "data" - if (! go.isa ("text") || go.get ("units").string_value () == "data") - { - set_clipping (go.get_properties ().is_clipping ()); - draw (go); - - it = obj_list.erase (it); - } - else - it++; - } - - // 3rd pass: draw remaining objects - - glDisable (GL_DEPTH_TEST); - - for (it = obj_list.begin (); it != obj_list.end (); it++) - { - graphics_object go = (*it); - - set_clipping (go.get_properties ().is_clipping ()); - draw (go); - } - - glEnable (GL_DEPTH_TEST); - - set_clipping (false); - - // FIXME: finalize rendering (transparency processing) - // FIXME: draw zoom box, if needed -} - -void -opengl_renderer::draw_axes (const axes::properties& props) -{ - double x_min = props.get_x_min (); - double x_max = props.get_x_max (); - double y_min = props.get_y_min (); - double y_max = props.get_y_max (); - double z_min = props.get_z_min (); - double z_max = props.get_z_max (); - - setup_opengl_transformation (props); - - // draw axes object - - draw_axes_planes (props); - draw_axes_boxes (props); - - set_font (props); - - draw_axes_x_grid (props); - draw_axes_y_grid (props); - draw_axes_z_grid (props); - - set_linestyle ("-"); - - set_clipbox (x_min, x_max, y_min, y_max, z_min, z_max); - - draw_axes_children (props); -} - -void -opengl_renderer::draw_line (const line::properties& props) -{ - Matrix x = xform.xscale (props.get_xdata ().matrix_value ()); - Matrix y = xform.yscale (props.get_ydata ().matrix_value ()); - Matrix z = xform.zscale (props.get_zdata ().matrix_value ()); - - bool has_z = (z.numel () > 0); - int n = static_cast (::xmin (::xmin (x.numel (), y.numel ()), (has_z ? z.numel () : std::numeric_limits::max ()))); - octave_uint8 clip_mask = (props.is_clipping () ? 0x7F : 0x40), clip_ok (0x40); - - std::vector clip (n); - - if (has_z) - for (int i = 0; i < n; i++) - clip[i] = (clip_code (x(i), y(i), z(i)) & clip_mask); - else - { - double z_mid = (zmin+zmax)/2; - - for (int i = 0; i < n; i++) - clip[i] = (clip_code (x(i), y(i), z_mid) & clip_mask); - } - - if (! props.linestyle_is ("none")) - { - set_color (props.get_color_rgb ()); - set_linestyle (props.get_linestyle (), false); - set_linewidth (props.get_linewidth ()); - - if (has_z) - { - bool flag = false; - - for (int i = 1; i < n; i++) - { - if ((clip[i-1] & clip[i]) == clip_ok) - { - if (! flag) - { - flag = true; - glBegin (GL_LINE_STRIP); - glVertex3d (x(i-1), y(i-1), z(i-1)); - } - glVertex3d (x(i), y(i), z(i)); - } - else if (flag) - { - flag = false; - glEnd (); - } - } - - if (flag) - glEnd (); - } - else - { - bool flag = false; - - for (int i = 1; i < n; i++) - { - if ((clip[i-1] & clip[i]) == clip_ok) - { - if (! flag) - { - flag = true; - glBegin (GL_LINE_STRIP); - glVertex2d (x(i-1), y(i-1)); - } - glVertex2d (x(i), y(i)); - } - else if (flag) - { - flag = false; - glEnd (); - } - } - - if (flag) - glEnd (); - } - - set_linewidth (0.5); - set_linestyle ("-"); - } - - set_clipping (false); - - if (! props.marker_is ("none") && - ! (props.markeredgecolor_is ("none") - && props.markerfacecolor_is ("none"))) - { - Matrix lc, fc; - - if (props.markeredgecolor_is ("auto")) - lc = props.get_color_rgb (); - else if (! props.markeredgecolor_is ("none")) - lc = props.get_markeredgecolor_rgb (); - - if (props.markerfacecolor_is ("auto")) - fc = props.get_color_rgb (); - else if (! props.markerfacecolor_is ("none")) - fc = props.get_markerfacecolor_rgb (); - - init_marker (props.get_marker (), props.get_markersize (), - props.get_linewidth ()); - - for (int i = 0; i < n; i++) - { - if (clip[i] == clip_ok) - draw_marker (x(i), y(i), - has_z ? z(i) : static_cast (i) / n, - lc, fc); - } - - end_marker (); - } - - set_clipping (props.is_clipping ()); -} - -void -opengl_renderer::draw_surface (const surface::properties& props) -{ - const Matrix x = xform.xscale (props.get_xdata ().matrix_value ()); - const Matrix y = xform.yscale (props.get_ydata ().matrix_value ()); - const Matrix z = xform.zscale (props.get_zdata ().matrix_value ()); - - int zr = z.rows (), zc = z.columns (); - - NDArray c; - const NDArray n = props.get_vertexnormals ().array_value (); - - // FIXME: handle transparency - Matrix a; - - if (props.facelighting_is ("phong") || props.edgelighting_is ("phong")) - warning ("opengl_renderer::draw: phong light model not supported"); - - int fc_mode = (props.facecolor_is_rgb () ? 0 : - (props.facecolor_is ("flat") ? 1 : - (props.facecolor_is ("interp") ? 2 : - (props.facecolor_is ("texturemap") ? 3 : -1)))); - int fl_mode = (props.facelighting_is ("none") ? 0 : - (props.facelighting_is ("flat") ? 1 : 2)); - int fa_mode = (props.facealpha_is_double () ? 0 : - (props.facealpha_is ("flat") ? 1 : 2)); - int ec_mode = (props.edgecolor_is_rgb () ? 0 : - (props.edgecolor_is ("flat") ? 1 : - (props.edgecolor_is ("interp") ? 2 : -1))); - int el_mode = (props.edgelighting_is ("none") ? 0 : - (props.edgelighting_is ("flat") ? 1 : 2)); - int ea_mode = (props.edgealpha_is_double () ? 0 : - (props.edgealpha_is ("flat") ? 1 : 2)); - - Matrix fcolor = (fc_mode == 3 ? Matrix (1, 3, 1.0) : props.get_facecolor_rgb ()); - Matrix ecolor = props.get_edgecolor_rgb (); - - float as = props.get_ambientstrength (); - float ds = props.get_diffusestrength (); - float ss = props.get_specularstrength (); - float se = props.get_specularexponent (); - float cb[4] = { 0.0, 0.0, 0.0, 1.0 }; - double d = 1.0; - - opengl_texture tex; - - int i1, i2, j1, j2; - bool x_mat = (x.rows () == z.rows ()); - bool y_mat = (y.columns () == z.columns ()); - - i1 = i2 = j1 = j2 = 0; - - boolMatrix clip (z.dims (), false); - - for (int i = 0; i < zr; i++) - { - if (x_mat) - i1 = i; - - for (int j = 0; j < zc; j++) - { - if (y_mat) - j1 = j; - - clip(i,j) = is_nan_or_inf (x(i1,j), y(i,j1), z(i,j)); - } - } - - if ((fc_mode > 0 && fc_mode < 3) || ec_mode > 0) - c = props.get_color_data ().array_value (); - - if (fa_mode > 0 || ea_mode > 0) - { - // FIXME: implement alphadata conversion - //a = props.get_alpha_data (); - } - - if (fl_mode > 0 || el_mode > 0) - { - float buf[4] = { ss, ss, ss, 1 }; - - glMaterialfv (LIGHT_MODE, GL_SPECULAR, buf); - glMaterialf (LIGHT_MODE, GL_SHININESS, se); - } - - // FIXME: good candidate for caching, transfering pixel - // data to OpenGL is time consuming. - if (fc_mode == 3) - tex = opengl_texture::create (props.get_color_data ()); - - if (! props.facecolor_is ("none")) - { - if (props.get_facealpha_double () == 1) - { - if (fc_mode == 0 || fc_mode == 3) - { - glColor3dv (fcolor.data ()); - if (fl_mode > 0) - { - for (int i = 0; i < 3; i++) - cb[i] = as * fcolor(i); - glMaterialfv (LIGHT_MODE, GL_AMBIENT, cb); - - for (int i = 0; i < 3; i++) - cb[i] = ds * fcolor(i); - glMaterialfv (LIGHT_MODE, GL_DIFFUSE, cb); - } - } - - if (fl_mode > 0) - glEnable (GL_LIGHTING); - glShadeModel ((fc_mode == 2 || fl_mode == 2) ? GL_SMOOTH : GL_FLAT); - set_polygon_offset (true, 1); - if (fc_mode == 3) - glEnable (GL_TEXTURE_2D); - - for (int i = 1; i < zc; i++) - { - if (y_mat) - { - i1 = i-1; - i2 = i; - } - - for (int j = 1; j < zr; j++) - { - if (clip(j-1, i-1) || clip (j, i-1) - || clip (j-1, i) || clip (j, i)) - continue; - - if (x_mat) - { - j1 = j-1; - j2 = j; - } - - glBegin (GL_QUADS); - - // Vertex 1 - if (fc_mode == 3) - tex.tex_coord (double (i-1) / (zc-1), double (j-1) / (zr-1)); - else if (fc_mode > 0) - { - // FIXME: is there a smarter way to do this? - for (int k = 0; k < 3; k++) - cb[k] = c(j-1, i-1, k); - glColor3fv (cb); - - if (fl_mode > 0) - { - for (int k = 0; k < 3; k++) - cb[k] *= as; - glMaterialfv (LIGHT_MODE, GL_AMBIENT, cb); - - for (int k = 0; k < 3; k++) - cb[k] = ds * c(j-1, i-1, k); - glMaterialfv (LIGHT_MODE, GL_DIFFUSE, cb); - } - } - if (fl_mode > 0) - { - d = sqrt (n(j-1,i-1,0) * n(j-1,i-1,0) - + n(j-1,i-1,1) * n(j-1,i-1,1) - + n(j-1,i-1,2) * n(j-1,i-1,2)); - glNormal3d (n(j-1,i-1,0)/d, n(j-1,i-1,1)/d, n(j-1,i-1,2)/d); - } - glVertex3d (x(j1,i-1), y(j-1,i1), z(j-1,i-1)); - - // Vertex 2 - if (fc_mode == 3) - tex.tex_coord (double (i) / (zc-1), double (j-1) / (zr-1)); - else if (fc_mode == 2) - { - for (int k = 0; k < 3; k++) - cb[k] = c(j-1, i, k); - glColor3fv (cb); - - if (fl_mode > 0) - { - for (int k = 0; k < 3; k++) - cb[k] *= as; - glMaterialfv (LIGHT_MODE, GL_AMBIENT, cb); - - for (int k = 0; k < 3; k++) - cb[k] = ds * c(j-1, i, k); - glMaterialfv (LIGHT_MODE, GL_DIFFUSE, cb); - } - } - - if (fl_mode == 2) - { - d = sqrt (n(j-1,i,0) * n(j-1,i,0) - + n(j-1,i,1) * n(j-1,i,1) - + n(j-1,i,2) * n(j-1,i,2)); - glNormal3d (n(j-1,i,0)/d, n(j-1,i,1)/d, n(j-1,i,2)/d); - } - - glVertex3d (x(j1,i), y(j-1,i2), z(j-1,i)); - - // Vertex 3 - if (fc_mode == 3) - tex.tex_coord (double (i) / (zc-1), double (j) / (zr-1)); - else if (fc_mode == 2) - { - for (int k = 0; k < 3; k++) - cb[k] = c(j, i, k); - glColor3fv (cb); - - if (fl_mode > 0) - { - for (int k = 0; k < 3; k++) - cb[k] *= as; - glMaterialfv (LIGHT_MODE, GL_AMBIENT, cb); - - for (int k = 0; k < 3; k++) - cb[k] = ds * c(j, i, k); - glMaterialfv (LIGHT_MODE, GL_DIFFUSE, cb); - } - } - if (fl_mode == 2) - { - d = sqrt (n(j,i,0) * n(j,i,0) - + n(j,i,1) * n(j,i,1) - + n(j,i,2) * n(j,i,2)); - glNormal3d (n(j,i,0)/d, n(j,i,1)/d, n(j,i,2)/d); - } - glVertex3d (x(j2,i), y(j,i2), z(j,i)); - - // Vertex 4 - if (fc_mode == 3) - tex.tex_coord (double (i-1) / (zc-1), double (j) / (zr-1)); - else if (fc_mode == 2) - { - for (int k = 0; k < 3; k++) - cb[k] = c(j, i-1, k); - glColor3fv (cb); - - if (fl_mode > 0) - { - for (int k = 0; k < 3; k++) - cb[k] *= as; - glMaterialfv (LIGHT_MODE, GL_AMBIENT, cb); - - for (int k = 0; k < 3; k++) - cb[k] = ds * c(j, i-1, k); - glMaterialfv (LIGHT_MODE, GL_DIFFUSE, cb); - } - } - if (fl_mode == 2) - { - d = sqrt (n(j,i-1,0) * n(j,i-1,0) - + n(j,i-1,1) * n(j,i-1,1) - + n(j,i-1,2) * n(j,i-1,2)); - glNormal3d (n(j,i-1,0)/d, n(j,i-1,1)/d, n(j,i-1,2)/d); - } - glVertex3d (x(j2,i-1), y(j,i1), z(j,i-1)); - - glEnd (); - } - } - - set_polygon_offset (false); - if (fc_mode == 3) - glDisable (GL_TEXTURE_2D); - - if (fl_mode > 0) - glDisable (GL_LIGHTING); - } - else - { - // FIXME: implement transparency - } - } - - if (! props.edgecolor_is ("none")) - { - if (props.get_edgealpha_double () == 1) - { - if (ec_mode == 0) - { - glColor3dv (ecolor.data ()); - if (fl_mode > 0) - { - for (int i = 0; i < 3; i++) - cb[i] = as * ecolor(i); - glMaterialfv (LIGHT_MODE, GL_AMBIENT, cb); - - for (int i = 0; i < 3; i++) - cb[i] = ds * ecolor(i); - glMaterialfv (LIGHT_MODE, GL_DIFFUSE, cb); - } - } - - if (el_mode > 0) - glEnable (GL_LIGHTING); - glShadeModel ((ec_mode == 2 || el_mode == 2) ? GL_SMOOTH : GL_FLAT); - - set_linestyle (props.get_linestyle (), false); - set_linewidth (props.get_linewidth ()); - - // Mesh along Y-axis - - if (props.meshstyle_is ("both") || props.meshstyle_is ("column")) - { - for (int i = 0; i < zc; i++) - { - if (y_mat) - { - i1 = i-1; - i2 = i; - } - - for (int j = 1; j < zr; j++) - { - if (clip(j-1,i) || clip(j,i)) - continue; - - if (x_mat) - { - j1 = j-1; - j2 = j; - } - - glBegin (GL_LINES); - - // Vertex 1 - if (ec_mode > 0) - { - for (int k = 0; k < 3; k++) - cb[k] = c(j-1, i, k); - glColor3fv (cb); - - if (fl_mode > 0) - { - for (int k = 0; k < 3; k++) - cb[k] *= as; - glMaterialfv (LIGHT_MODE, GL_AMBIENT, cb); - - for (int k = 0; k < 3; k++) - cb[k] = ds * c(j-1, i, k); - glMaterialfv (LIGHT_MODE, GL_DIFFUSE, cb); - } - } - if (el_mode > 0) - { - d = sqrt (n(j-1,i,0) * n(j-1,i,0) - + n(j-1,i,1) * n(j-1,i,1) - + n(j-1,i,2) * n(j-1,i,2)); - glNormal3d (n(j-1,i,0)/d, n(j-1,i,1)/d, n(j-1,i,2)/d); - } - glVertex3d (x(j1,i), y(j-1,i2), z(j-1,i)); - - // Vertex 2 - if (ec_mode == 2) - { - for (int k = 0; k < 3; k++) - cb[k] = c(j, i, k); - glColor3fv (cb); - - if (fl_mode > 0) - { - for (int k = 0; k < 3; k++) - cb[k] *= as; - glMaterialfv (LIGHT_MODE, GL_AMBIENT, cb); - - for (int k = 0; k < 3; k++) - cb[k] = ds * c(j, i, k); - glMaterialfv (LIGHT_MODE, GL_DIFFUSE, cb); - } - } - if (el_mode == 2) - { - d = sqrt (n(j,i,0) * n(j,i,0) - + n(j,i,1) * n(j,i,1) - + n(j,i,2) * n(j,i,2)); - glNormal3d (n(j,i,0)/d, n(j,i,1)/d, n(j,i,2)/d); - } - glVertex3d (x(j2,i), y(j,i2), z(j,i)); - - glEnd (); - } - } - } - - // Mesh along X-axis - - if (props.meshstyle_is ("both") || props.meshstyle_is ("row")) - { - for (int j = 0; j < zr; j++) - { - if (x_mat) - { - j1 = j-1; - j2 = j; - } - - for (int i = 1; i < zc; i++) - { - if (clip(j,i-1) || clip(j,i)) - continue; - - if (y_mat) - { - i1 = i-1; - i2 = i; - } - - glBegin (GL_LINES); - - // Vertex 1 - if (ec_mode > 0) - { - for (int k = 0; k < 3; k++) - cb[k] = c(j, i-1, k); - glColor3fv (cb); - - if (fl_mode > 0) - { - for (int k = 0; k < 3; k++) - cb[k] *= as; - glMaterialfv (LIGHT_MODE, GL_AMBIENT, cb); - - for (int k = 0; k < 3; k++) - cb[k] = ds * c(j, i-1, k); - glMaterialfv (LIGHT_MODE, GL_DIFFUSE, cb); - } - } - if (el_mode > 0) - { - d = sqrt (n(j,i-1,0) * n(j,i-1,0) - + n(j,i-1,1) * n(j,i-1,1) - + n(j,i-1,2) * n(j,i-1,2)); - glNormal3d (n(j,i-1,0)/d, n(j,i-1,1)/d, n(j,i-1,2)/d); - } - glVertex3d (x(j2,i-1), y(j,i1), z(j,i-1)); - - // Vertex 2 - if (ec_mode == 2) - { - for (int k = 0; k < 3; k++) - cb[k] = c(j, i, k); - glColor3fv (cb); - - if (fl_mode > 0) - { - for (int k = 0; k < 3; k++) - cb[k] *= as; - glMaterialfv (LIGHT_MODE, GL_AMBIENT, cb); - - for (int k = 0; k < 3; k++) - cb[k] = ds * c(j, i, k); - glMaterialfv (LIGHT_MODE, GL_DIFFUSE, cb); - } - } - if (el_mode == 2) - { - d = sqrt (n(j,i,0) * n(j,i,0) - + n(j,i,1) * n(j,i,1) - + n(j,i,2) * n(j,i,2)); - glNormal3d (n(j,i,0)/d, n(j,i,1)/d, n(j,i,2)/d); - } - glVertex3d (x(j2,i), y(j,i2), z(j,i)); - - glEnd (); - } - } - } - - set_linestyle ("-"); - set_linewidth (0.5); - - if (el_mode > 0) - glDisable (GL_LIGHTING); - } - else - { - // FIXME: implement transparency - } - } - - if (! props.marker_is ("none") && - ! (props.markeredgecolor_is ("none") - && props.markerfacecolor_is ("none"))) - { - // FIXME: check how transparency should be handled in markers - // FIXME: check what to do with marker facecolor set to auto - // and facecolor set to none. - - bool do_edge = ! props.markeredgecolor_is ("none"); - bool do_face = ! props.markerfacecolor_is ("none"); - - Matrix mecolor = props.get_markeredgecolor_rgb (); - Matrix mfcolor = props.get_markerfacecolor_rgb (); - Matrix cc (1, 3, 0.0); - - if (mecolor.numel () == 0 && props.markeredgecolor_is ("auto")) - { - mecolor = props.get_edgecolor_rgb (); - do_edge = ! props.edgecolor_is ("none"); - } - - if (mfcolor.numel () == 0 && props.markerfacecolor_is ("auto")) - { - mfcolor = props.get_facecolor_rgb (); - do_face = ! props.facecolor_is ("none"); - } - - if ((mecolor.numel () == 0 || mfcolor.numel () == 0) - && c.numel () == 0) - c = props.get_color_data ().array_value (); - - init_marker (props.get_marker (), props.get_markersize (), - props.get_linewidth ()); - - for (int i = 0; i < zc; i++) - { - if (y_mat) - i1 = i; - - for (int j = 0; j < zr; j++) - { - if (clip(j,i)) - continue; - - if (x_mat) - j1 = j; - - if ((do_edge && mecolor.numel () == 0) - || (do_face && mfcolor.numel () == 0)) - { - for (int k = 0; k < 3; k++) - cc(k) = c(j,i,k); - } - - Matrix lc = (do_edge ? (mecolor.numel () == 0 ? cc : mecolor) : Matrix ()); - Matrix fc = (do_face ? (mfcolor.numel () == 0 ? cc : mfcolor) : Matrix ()); - - draw_marker (x(j1,i), y(j,i1), z(j,i), lc, fc); - } - } - - end_marker (); - } -} - -// FIXME: global optimization (rendering, data structures...), there -// is probably a smarter/faster/less-memory-consuming way to do this. -void -opengl_renderer::draw_patch (const patch::properties &props) -{ - const Matrix f = props.get_faces ().matrix_value (); - const Matrix v = xform.scale (props.get_vertices ().matrix_value ()); - Matrix c; - const Matrix n = props.get_vertexnormals ().matrix_value (); - Matrix a; - - int nv = v.rows (); - // int vmax = v.columns (); - int nf = f.rows (); - int fcmax = f.columns (); - - bool has_z = (v.columns () > 2); - bool has_facecolor = false; - bool has_facealpha = false; - - int fc_mode = ((props.facecolor_is ("none") - || props.facecolor_is_rgb ()) ? 0 : - (props.facecolor_is ("flat") ? 1 : 2)); - int fl_mode = (props.facelighting_is ("none") ? 0 : - (props.facelighting_is ("flat") ? 1 : 2)); - int fa_mode = (props.facealpha_is_double () ? 0 : - (props.facealpha_is ("flat") ? 1 : 2)); - int ec_mode = ((props.edgecolor_is ("none") - || props.edgecolor_is_rgb ()) ? 0 : - (props.edgecolor_is ("flat") ? 1 : 2)); - int el_mode = (props.edgelighting_is ("none") ? 0 : - (props.edgelighting_is ("flat") ? 1 : 2)); - int ea_mode = (props.edgealpha_is_double () ? 0 : - (props.edgealpha_is ("flat") ? 1 : 2)); - - Matrix fcolor = props.get_facecolor_rgb (); - Matrix ecolor = props.get_edgecolor_rgb (); - - float as = props.get_ambientstrength (); - float ds = props.get_diffusestrength (); - float ss = props.get_specularstrength (); - float se = props.get_specularexponent (); - - boolMatrix clip (1, nv, false); - - if (has_z) - for (int i = 0; i < nv; i++) - clip(i) = is_nan_or_inf (v(i,0), v(i,1), v(i,2)); - else - for (int i = 0; i < nv; i++) - clip(i) = is_nan_or_inf (v(i,0), v(i,1), 0); - - boolMatrix clip_f (1, nf, false); - Array count_f (dim_vector (nf, 1), 0); - - for (int i = 0; i < nf; i++) - { - bool fclip = false; - int count = 0; - - for (int j = 0; j < fcmax && ! xisnan (f(i,j)); j++, count++) - fclip = (fclip || clip(int (f(i,j) - 1))); - - clip_f(i) = fclip; - count_f(i) = count; - } - - if (fc_mode > 0 || ec_mode > 0) - { - c = props.get_color_data ().matrix_value (); - - if (c.rows () == 1) - { - // Single color specifications, we can simplify a little bit - - if (fc_mode > 0) - { - fcolor = c; - fc_mode = 0; - } - - if (ec_mode > 0) - { - ecolor = c; - ec_mode = 0; - } - - c = Matrix (); - } - else - has_facecolor = ((c.numel () > 0) && (c.rows () == f.rows ())); - } - - if (fa_mode > 0 || ea_mode > 0) - { - // FIXME: retrieve alpha data from patch object - //a = props.get_alpha_data (); - has_facealpha = ((a.numel () > 0) && (a.rows () == f.rows ())); - } - - octave_idx_type fr = f.rows (); - std::vector vdata (f.numel ()); - - for (int i = 0; i < nf; i++) - for (int j = 0; j < count_f(i); j++) - { - int idx = int (f(i,j) - 1); - - Matrix vv (1, 3, 0.0); - Matrix cc; - Matrix nn(1, 3, 0.0); - double aa = 1.0; - - vv(0) = v(idx,0); vv(1) = v(idx,1); - if (has_z) - vv(2) = v(idx,2); - // FIXME: uncomment when patch object has normal computation - //nn(0) = n(idx,0); nn(1) = n(idx,1); nn(2) = n(idx,2); - if (c.numel () > 0) - { - cc.resize (1, 3); - if (has_facecolor) - cc(0) = c(i,0), cc(1) = c(i,1), cc(2) = c(i,2); - else - cc(0) = c(idx,0), cc(1) = c(idx,1), cc(2) = c(idx,2); - } - if (a.numel () > 0) - { - if (has_facealpha) - aa = a(i); - else - aa = a(idx); - } - - vdata[i+j*fr] = - vertex_data (vv, cc, nn, aa, as, ds, ss, se); - } - - if (fl_mode > 0 || el_mode > 0) - { - float buf[4] = { ss, ss, ss, 1 }; - - glMaterialfv (LIGHT_MODE, GL_SPECULAR, buf); - glMaterialf (LIGHT_MODE, GL_SHININESS, se); - } - - if (! props.facecolor_is ("none")) - { - // FIXME: adapt to double-radio property - if (props.get_facealpha_double () == 1) - { - if (fc_mode == 0) - { - glColor3dv (fcolor.data ()); - if (fl_mode > 0) - { - float cb[4] = { 0, 0, 0, 1 }; - - for (int i = 0; i < 3; i++) - cb[i] = (as * fcolor(i)); - glMaterialfv (LIGHT_MODE, GL_AMBIENT, cb); - - for (int i = 0; i < 3; i++) - cb[i] = ds * fcolor(i); - glMaterialfv (LIGHT_MODE, GL_DIFFUSE, cb); - } - } - - if (fl_mode > 0) - glEnable (GL_LIGHTING); - - // FIXME: use __index__ property from patch object - patch_tesselator tess (this, fc_mode, fl_mode, 0); - - for (int i = 0; i < nf; i++) - { - if (clip_f(i)) - continue; - - tess.begin_polygon (true); - tess.begin_contour (); - - for (int j = 0; j < count_f(i); j++) - { - vertex_data::vertex_data_rep *vv = vdata[i+j*fr].get_rep (); - - tess.add_vertex (vv->coords.fortran_vec (), vv); - } - - tess.end_contour (); - tess.end_polygon (); - } - - if (fl_mode > 0) - glDisable (GL_LIGHTING); - } - else - { - // FIXME: implement transparency - } - } - - if (! props.edgecolor_is ("none")) - { - // FIXME: adapt to double-radio property - if (props.get_edgealpha_double () == 1) - { - if (ec_mode == 0) - { - glColor3dv (ecolor.data ()); - if (el_mode > 0) - { - float cb[4] = { 0, 0, 0, 1 }; - - for (int i = 0; i < 3; i++) - cb[i] = (as * ecolor(i)); - glMaterialfv (LIGHT_MODE, GL_AMBIENT, cb); - - for (int i = 0; i < 3; i++) - cb[i] = ds * ecolor(i); - glMaterialfv (LIGHT_MODE, GL_DIFFUSE, cb); - } - } - - if (el_mode > 0) - glEnable (GL_LIGHTING); - - set_linestyle (props.get_linestyle (), false); - set_linewidth (props.get_linewidth ()); - - - // FIXME: use __index__ property from patch object; should we - // offset patch contour as well? - patch_tesselator tess (this, ec_mode, el_mode); - - for (int i = 0; i < nf; i++) - { - if (clip_f(i)) - { - // This is an unclosed contour. Draw it as a line - bool flag = false; - - for (int j = 0; j < count_f(i); j++) - { - if (! clip(int (f(i,j) - 1))) - { - vertex_data::vertex_data_rep *vv = vdata[i+j*fr].get_rep (); - const Matrix m = vv->coords; - if (! flag) - { - flag = true; - glBegin (GL_LINE_STRIP); - } - glVertex3d (m(0), m(1), m(2)); - } - else if (flag) - { - flag = false; - glEnd (); - } - } - - if (flag) - glEnd (); - } - else - { - tess.begin_polygon (false); - tess.begin_contour (); - - for (int j = 0; j < count_f(i); j++) - { - vertex_data::vertex_data_rep *vv = vdata[i+j*fr].get_rep (); - tess.add_vertex (vv->coords.fortran_vec (), vv); - } - - tess.end_contour (); - tess.end_polygon (); - } - } - - set_linestyle ("-"); - set_linewidth (0.5); - - if (el_mode > 0) - glDisable (GL_LIGHTING); - } - else - { - // FIXME: implement transparency - } - } - - if (! props.marker_is ("none") && - ! (props.markeredgecolor_is ("none") && props.markerfacecolor_is ("none"))) - { - bool do_edge = ! props.markeredgecolor_is ("none"); - bool do_face = ! props.markerfacecolor_is ("none"); - - Matrix mecolor = props.get_markeredgecolor_rgb (); - Matrix mfcolor = props.get_markerfacecolor_rgb (); - - bool has_markerfacecolor = false; - - if ((mecolor.numel () == 0 && ! props.markeredgecolor_is ("none")) - || (mfcolor.numel () == 0 && ! props.markerfacecolor_is ("none"))) - { - Matrix mc = props.get_color_data ().matrix_value (); - - if (mc.rows () == 1) - { - // Single color specifications, we can simplify a little bit - - if (mfcolor.numel () == 0 - && ! props.markerfacecolor_is ("none")) - mfcolor = mc; - - if (mecolor.numel () == 0 - && ! props.markeredgecolor_is ("none")) - mecolor = mc; - } - else - { - if (c.numel () == 0) - c = props.get_color_data ().matrix_value (); - has_markerfacecolor = ((c.numel () > 0) - && (c.rows () == f.rows ())); - } - } - - - init_marker (props.get_marker (), props.get_markersize (), - props.get_linewidth ()); - - for (int i = 0; i < nf; i++) - for (int j = 0; j < count_f(i); j++) - { - int idx = int (f(i,j) - 1); - - if (clip(idx)) - continue; - - Matrix cc; - if (c.numel () > 0) - { - cc.resize (1, 3); - if (has_markerfacecolor) - cc(0) = c(i,0), cc(1) = c(i,1), cc(2) = c(i,2); - else - cc(0) = c(idx,0), cc(1) = c(idx,1), cc(2) = c(idx,2); - } - - Matrix lc = (do_edge ? (mecolor.numel () == 0 ? cc : mecolor) - : Matrix ()); - Matrix fc = (do_face ? (mfcolor.numel () == 0 ? cc : mfcolor) - : Matrix ()); - - draw_marker (v(idx,0), v(idx,1), (has_z ? v(idx,2) : 0), lc, fc); - } - - end_marker (); - } -} - -void -opengl_renderer::draw_hggroup (const hggroup::properties &props) -{ - draw (props.get_children ()); -} - -void -opengl_renderer::draw_text (const text::properties& props) -{ - if (props.get_string ().is_empty ()) - return; - - Matrix pos = xform.scale (props.get_data_position ()); - const Matrix bbox = props.get_extent_matrix (); - - // FIXME: handle margin and surrounding box - bool blend = glIsEnabled (GL_BLEND); - - glEnable (GL_BLEND); - glEnable (GL_ALPHA_TEST); - glRasterPos3d (pos(0), pos(1), pos.numel () > 2 ? pos(2) : 0.0); - glBitmap (0, 0, 0, 0, bbox(0), bbox(1), 0); - glDrawPixels (bbox(2), bbox(3), - GL_RGBA, GL_UNSIGNED_BYTE, props.get_pixels ().data ()); - glDisable (GL_ALPHA_TEST); - if (! blend) - glDisable (GL_BLEND); - -} - -void -opengl_renderer::draw_image (const image::properties& props) -{ - octave_value cdata = props.get_color_data (); - dim_vector dv (cdata.dims ()); - int h = dv(0), w = dv(1); - - Matrix x = props.get_xdata ().matrix_value (); - Matrix y = props.get_ydata ().matrix_value (); - - // Someone wants us to draw an empty image? No way. - if (x.is_empty () || y.is_empty ()) - return; - - if (w > 1 && x(1) == x(0)) - x(1) = x(1) + (w-1); - - if (h > 1 && y(1) == y(0)) - y(1) = y(1) + (h-1); - - const ColumnVector p0 = xform.transform (x(0), y(0), 0); - const ColumnVector p1 = xform.transform (x(1), y(1), 0); - - // image pixel size in screen pixel units - float pix_dx, pix_dy; - // image pixel size in normalized units - float nor_dx, nor_dy; - - if (w > 1) - { - pix_dx = (p1(0) - p0(0))/(w-1); - nor_dx = (x(1) - x(0))/(w-1); - } - else - { - const ColumnVector p1w = xform.transform (x(1) + 1, y(1), 0); - pix_dx = p1w(0) - p0(0); - nor_dx = 1; - } - - if (h > 1) - { - pix_dy = (p1(1) - p0(1))/(h-1); - nor_dy = (y(1) - y(0))/(h-1); - } - else - { - const ColumnVector p1h = xform.transform (x(1), y(1) + 1, 0); - pix_dy = p1h(1) - p0(1); - nor_dy = 1; - } - - - // OpenGL won't draw the image if it's origin is outside the - // viewport/clipping plane so we must do the clipping - // ourselfes - only draw part of the image - - int j0 = 0, j1 = w; - int i0 = 0, i1 = h; - - float im_xmin = x(0) - nor_dx/2; - float im_xmax = x(1) + nor_dx/2; - float im_ymin = y(0) - nor_dy/2; - float im_ymax = y(1) + nor_dy/2; - if (props.is_clipping ()) // clip to axes - { - if (im_xmin < xmin) - j0 += (xmin - im_xmin)/nor_dx + 1; - if (im_xmax > xmax) - j1 -= (im_xmax - xmax)/nor_dx ; - - if (im_ymin < ymin) - i0 += (ymin - im_ymin)/nor_dy + 1; - if (im_ymax > ymax) - i1 -= (im_ymax - ymax)/nor_dy; - } - else // clip to viewport - { - GLfloat vp[4]; - glGetFloatv (GL_VIEWPORT, vp); - // FIXME -- actually add the code to do it! - - } - - if (i0 >= i1 || j0 >= j1) - return; - - glPixelZoom (pix_dx, -pix_dy); - glRasterPos3d (im_xmin + nor_dx*j0, im_ymin + nor_dy*i0, 0); - - // by default this is 4 - glPixelStorei (GL_UNPACK_ALIGNMENT,1); - - // Expect RGB data - if (dv.length () == 3 && dv(2) == 3) - { - if (cdata.is_double_type ()) - { - const NDArray xcdata = cdata.array_value (); - - OCTAVE_LOCAL_BUFFER (GLfloat, a, 3*(j1-j0)*(i1-i0)); - - for (int i = i0; i < i1; i++) - { - for (int j = j0, idx = (i-i0)*(j1-j0)*3; j < j1; j++, idx += 3) - { - a[idx] = xcdata(i,j,0); - a[idx+1] = xcdata(i,j,1); - a[idx+2] = xcdata(i,j,2); - } - } - - draw_pixels (j1-j0, i1-i0, GL_RGB, GL_FLOAT, a); - - } - else if (cdata.is_uint16_type ()) - { - const uint16NDArray xcdata = cdata.uint16_array_value (); - - OCTAVE_LOCAL_BUFFER (GLushort, a, 3*(j1-j0)*(i1-i0)); - - for (int i = i0; i < i1; i++) - { - for (int j = j0, idx = (i-i0)*(j1-j0)*3; j < j1; j++, idx += 3) - { - a[idx] = xcdata(i,j,0); - a[idx+1] = xcdata(i,j,1); - a[idx+2] = xcdata(i,j,2); - } - } - - draw_pixels (j1-j0, i1-i0, GL_RGB, GL_UNSIGNED_SHORT, a); - - } - else if (cdata.is_uint8_type ()) - { - const uint8NDArray xcdata = cdata.uint8_array_value (); - - OCTAVE_LOCAL_BUFFER (GLubyte, a, 3*(j1-j0)*(i1-i0)); - - for (int i = i0; i < i1; i++) - { - for (int j = j0, idx = (i-i0)*(j1-j0)*3; j < j1; j++, idx += 3) - { - a[idx] = xcdata(i,j,0); - a[idx+1] = xcdata(i,j,1); - a[idx+2] = xcdata(i,j,2); - } - } - - draw_pixels (j1-j0, i1-i0, GL_RGB, GL_UNSIGNED_BYTE, a); - } - else - warning ("opengl_texture::draw: invalid image data type (expected double, uint16, or uint8)"); - } - else - warning ("opengl_texture::draw: invalid image size (expected n*m*3 or n*m)"); - - glPixelZoom (1, 1); -} - -void -opengl_renderer::set_viewport (int w, int h) -{ - glViewport (0, 0, w, h); -} - -void -opengl_renderer::draw_pixels (GLsizei width, GLsizei height, GLenum format, - GLenum type, const GLvoid *data) -{ - glDrawPixels (width, height, format, type, data); -} - -void -opengl_renderer::set_color (const Matrix& c) -{ - glColor3dv (c.data ()); -#if HAVE_FREETYPE - text_renderer.set_color (c); -#endif -} - -void -opengl_renderer::set_font (const base_properties& props) -{ -#if HAVE_FREETYPE - text_renderer.set_font (props.get ("fontname").string_value (), - props.get ("fontweight").string_value (), - props.get ("fontangle").string_value (), - props.get ("fontsize").double_value ()); -#endif -} - -void -opengl_renderer::set_polygon_offset (bool on, double offset) -{ - if (on) - { - glPolygonOffset (offset, offset); - glEnable (GL_POLYGON_OFFSET_FILL); - glEnable (GL_POLYGON_OFFSET_LINE); - } - else - { - glDisable (GL_POLYGON_OFFSET_FILL); - glDisable (GL_POLYGON_OFFSET_LINE); - } -} - -void -opengl_renderer::set_linewidth (float w) -{ - glLineWidth (w); -} - -void -opengl_renderer::set_linestyle (const std::string& s, bool use_stipple) -{ - bool solid = false; - - if (s == "-") - { - glLineStipple (1, static_cast (0xFFFF)); - solid = true; - } - else if (s == ":") - glLineStipple (1, static_cast (0x8888)); - else if (s == "--") - glLineStipple (1, static_cast (0x0FFF)); - else if (s == "-.") - glLineStipple (1, static_cast (0x020F)); - else - glLineStipple (1, static_cast (0x0000)); - - if (solid && ! use_stipple) - glDisable (GL_LINE_STIPPLE); - else - glEnable (GL_LINE_STIPPLE); -} - -void -opengl_renderer::set_clipbox (double x1, double x2, double y1, double y2, - double z1, double z2) -{ - double dx = (x2-x1); - double dy = (y2-y1); - double dz = (z2-z1); - - x1 -= 0.001*dx; x2 += 0.001*dx; - y1 -= 0.001*dy; y2 += 0.001*dy; - z1 -= 0.001*dz; z2 += 0.001*dz; - - ColumnVector p (4, 0.0); - - p(0) = -1; p(3) = x2; - glClipPlane (GL_CLIP_PLANE0, p.data ()); - p(0) = 1; p(3) = -x1; - glClipPlane (GL_CLIP_PLANE1, p.data ()); - p(0) = 0; p(1) = -1; p(3) = y2; - glClipPlane (GL_CLIP_PLANE2, p.data ()); - p(1) = 1; p(3) = -y1; - glClipPlane (GL_CLIP_PLANE3, p.data ()); - p(1) = 0; p(2) = -1; p(3) = z2; - glClipPlane (GL_CLIP_PLANE4, p.data ()); - p(2) = 1; p(3) = -z1; - glClipPlane (GL_CLIP_PLANE5, p.data ()); - - xmin = x1; xmax = x2; - ymin = y1; ymax = y2; - zmin = z1; zmax = z2; -} - -void -opengl_renderer::set_clipping (bool enable) -{ - bool has_clipping = (glIsEnabled (GL_CLIP_PLANE0) == GL_TRUE); - - if (enable != has_clipping) - { - if (enable) - for (int i = 0; i < 6; i++) - glEnable (GL_CLIP_PLANE0+i); - else - for (int i = 0; i < 6; i++) - glDisable (GL_CLIP_PLANE0+i); - } -} - -void -opengl_renderer::init_marker (const std::string& m, double size, float width) -{ -#if defined (HAVE_FRAMEWORK_OPENGL) - GLint vw[4]; -#else - int vw[4]; -#endif - - glGetIntegerv (GL_VIEWPORT, vw); - - glMatrixMode (GL_PROJECTION); - glPushMatrix (); - glLoadIdentity (); - glOrtho (0, vw[2], vw[3], 0, xZ1, xZ2); - glMatrixMode (GL_MODELVIEW); - glPushMatrix (); - - set_clipping (false); - set_linewidth (width); - - marker_id = make_marker_list (m, size, false); - filled_marker_id = make_marker_list (m, size, true); -} - -void -opengl_renderer::end_marker (void) -{ - glDeleteLists (marker_id, 1); - glDeleteLists (filled_marker_id, 1); - - glMatrixMode (GL_MODELVIEW); - glPopMatrix (); - glMatrixMode (GL_PROJECTION); - glPopMatrix (); - set_linewidth (0.5f); -} - -void -opengl_renderer::draw_marker (double x, double y, double z, - const Matrix& lc, const Matrix& fc) -{ - ColumnVector tmp = xform.transform (x, y, z, false); - - glLoadIdentity (); - glTranslated (tmp(0), tmp(1), -tmp(2)); - - if (filled_marker_id > 0 && fc.numel () > 0) - { - glColor3dv (fc.data ()); - set_polygon_offset (true, -1.0); - glCallList (filled_marker_id); - if (lc.numel () > 0) - { - glColor3dv (lc.data ()); - glPolygonMode (GL_FRONT_AND_BACK, GL_LINE); - glEdgeFlag (GL_TRUE); - set_polygon_offset (true, -2.0); - glCallList (filled_marker_id); - glPolygonMode (GL_FRONT_AND_BACK, GL_FILL); - } - set_polygon_offset (false); - } - else if (marker_id > 0 && lc.numel () > 0) - { - glColor3dv (lc.data ()); - glCallList (marker_id); - } -} - -unsigned int -opengl_renderer::make_marker_list (const std::string& marker, double size, - bool filled) const -{ - char c = marker[0]; - - if (filled && (c == '+' || c == 'x' || c == '*' || c == '.')) - return 0; - - unsigned int ID = glGenLists (1); - double sz = size * toolkit.get_screen_resolution () / 72.0; - - // constants for the * marker - const double sqrt2d4 = 0.35355339059327; - double tt = sz*sqrt2d4; - - glNewList (ID, GL_COMPILE); - - switch (marker[0]) - { - case '+': - glBegin (GL_LINES); - glVertex2f (-sz/2, 0); - glVertex2f (sz/2, 0); - glVertex2f (0, -sz/2); - glVertex2f (0, sz/2); - glEnd (); - break; - case 'x': - glBegin (GL_LINES); - glVertex2f (-sz/2, -sz/2); - glVertex2f (sz/2, sz/2); - glVertex2f (-sz/2, sz/2); - glVertex2f (sz/2, -sz/2); - glEnd (); - break; - case '*': - glBegin (GL_LINES); - glVertex2f (-sz/2, 0); - glVertex2f (sz/2, 0); - glVertex2f (0, -sz/2); - glVertex2f (0, sz/2); - glVertex2f (-tt, -tt); - glVertex2f (+tt, +tt); - glVertex2f (-tt, +tt); - glVertex2f (+tt, -tt); - glEnd (); - break; - case '.': - { - double ang_step = M_PI / 5; - - glBegin (GL_POLYGON); - for (double ang = 0; ang < (2*M_PI); ang += ang_step) - glVertex2d (sz*cos (ang)/3, sz*sin (ang)/3); - glEnd (); - } - break; - case 's': - glBegin ((filled ? GL_POLYGON : GL_LINE_LOOP)); - glVertex2d (-sz/2, -sz/2); - glVertex2d (-sz/2, sz/2); - glVertex2d (sz/2, sz/2); - glVertex2d (sz/2, -sz/2); - glEnd (); - break; - case 'o': - { - double ang_step = M_PI / 5; - - glBegin ((filled ? GL_POLYGON : GL_LINE_LOOP)); - for (double ang = 0; ang < (2*M_PI); ang += ang_step) - glVertex2d (sz*cos (ang)/2, sz*sin (ang)/2); - glEnd (); - } - break; - case 'd': - glBegin ((filled ? GL_POLYGON : GL_LINE_LOOP)); - glVertex2d (0, -sz/2); - glVertex2d (sz/2, 0); - glVertex2d (0, sz/2); - glVertex2d (-sz/2, 0); - glEnd (); - break; - case 'v': - glBegin ((filled ? GL_POLYGON : GL_LINE_LOOP)); - glVertex2f (0, sz/2); - glVertex2f (sz/2, -sz/2); - glVertex2f (-sz/2, -sz/2); - glEnd (); - break; - case '^': - glBegin ((filled ? GL_POLYGON : GL_LINE_LOOP)); - glVertex2f (0, -sz/2); - glVertex2f (-sz/2, sz/2); - glVertex2f (sz/2, sz/2); - glEnd (); - break; - case '>': - glBegin ((filled ? GL_POLYGON : GL_LINE_LOOP)); - glVertex2f (sz/2, 0); - glVertex2f (-sz/2, sz/2); - glVertex2f (-sz/2, -sz/2); - glEnd (); - break; - case '<': - glBegin ((filled ? GL_POLYGON : GL_LINE_LOOP)); - glVertex2f (-sz/2, 0); - glVertex2f (sz/2, -sz/2); - glVertex2f (sz/2, sz/2); - glEnd (); - break; - case 'p': - { - double ang; - double r; - double dr = 1.0 - sin (M_PI/10)/sin (3*M_PI/10)*1.02; - - glBegin ((filled ? GL_POLYGON : GL_LINE_LOOP)); - for (int i = 0; i < 2*5; i++) - { - ang = (-0.5 + double(i+1)/5) * M_PI; - r = 1.0 - (dr * fmod (double(i+1), 2.0)); - glVertex2d (sz*r*cos (ang)/2, sz*r*sin (ang)/2); - } - glEnd (); - } - break; - case 'h': - { - double ang; - double r; - double dr = 1.0 - 0.5/sin (M_PI/3)*1.02; - - glBegin ((filled ? GL_POLYGON : GL_LINE_LOOP)); - for (int i = 0; i < 2*6; i++) - { - ang = (0.5 + double(i+1)/6.0) * M_PI; - r = 1.0 - (dr * fmod (double(i+1), 2.0)); - glVertex2d (sz*r*cos (ang)/2, sz*r*sin (ang)/2); - } - glEnd (); - } - break; - default: - warning ("opengl_renderer: unsupported marker '%s'", - marker.c_str ()); - break; - } - - glEndList (); - - return ID; -} - -void -opengl_renderer::text_to_pixels (const std::string& txt, - uint8NDArray& pixels, - Matrix& bbox, - int halign, int valign, double rotation) -{ -#if HAVE_FREETYPE - text_renderer.text_to_pixels (txt, pixels, bbox, - halign, valign, rotation); -#endif -} - -Matrix -opengl_renderer::render_text (const std::string& txt, - double x, double y, double z, - int halign, int valign, double rotation) -{ -#if HAVE_FREETYPE - if (txt.empty ()) - return Matrix (1, 4, 0.0); - - uint8NDArray pixels; - Matrix bbox; - text_to_pixels (txt, pixels, bbox, halign, valign, rotation); - - bool blend = glIsEnabled (GL_BLEND); - - glEnable (GL_BLEND); - glEnable (GL_ALPHA_TEST); - glRasterPos3d (x, y, z); - glBitmap(0, 0, 0, 0, bbox(0), bbox(1), 0); - glDrawPixels (bbox(2), bbox(3), - GL_RGBA, GL_UNSIGNED_BYTE, pixels.data ()); - glDisable (GL_ALPHA_TEST); - if (! blend) - glDisable (GL_BLEND); - - return bbox; -#else - ::warning ("render_text: cannot render text, Freetype library not available"); - return Matrix (1, 4, 0.0); -#endif -} - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/gl-render.h --- a/libinterp/interp-core/gl-render.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,211 +0,0 @@ -/* - -Copyright (C) 2008-2012 Michael Goffioul - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (gl_render_h) -#define gl_render_h 1 - -#ifdef HAVE_WINDOWS_H -#define WIN32_LEAN_AND_MEAN -#include -#endif - -#ifdef HAVE_GL_GL_H -#include -#elif defined HAVE_OPENGL_GL_H || defined HAVE_FRAMEWORK_OPENGL -#include -#endif - -#ifdef HAVE_GL_GLU_H -#include -#elif defined HAVE_OPENGL_GLU_H || defined HAVE_FRAMEWORK_OPENGL -#include -#endif - -#include "graphics.h" -#include "txt-eng-ft.h" - -class -OCTINTERP_API -opengl_renderer -{ -public: - opengl_renderer (void) - : toolkit (), xform (), xmin (), xmax (), ymin (), ymax (), - zmin (), zmax (), xZ1 (), xZ2 (), marker_id (), filled_marker_id (), - camera_pos (), camera_dir () -#if HAVE_FREETYPE - , text_renderer () -#endif - { } - - virtual ~opengl_renderer (void) { } - - virtual void draw (const graphics_object& go, bool toplevel = true); - - virtual void draw (const Matrix& hlist, bool toplevel = false) - { - int len = hlist.length (); - - for (int i = len-1; i >= 0; i--) - { - graphics_object obj = gh_manager::get_object (hlist(i)); - - if (obj) - draw (obj, toplevel); - } - } - - virtual void set_viewport (int w, int h); - virtual graphics_xform get_transform (void) const { return xform; } - -protected: - virtual void draw_figure (const figure::properties& props); - virtual void draw_axes (const axes::properties& props); - virtual void draw_line (const line::properties& props); - virtual void draw_surface (const surface::properties& props); - virtual void draw_patch (const patch::properties& props); - virtual void draw_hggroup (const hggroup::properties& props); - virtual void draw_text (const text::properties& props); - virtual void draw_image (const image::properties& props); - virtual void draw_uipanel (const uipanel::properties& props, - const graphics_object& go); - - virtual void init_gl_context (bool enhanced, const Matrix& backgroundColor); - virtual void setup_opengl_transformation (const axes::properties& props); - - virtual void set_color (const Matrix& c); - virtual void set_polygon_offset (bool on, double offset = 0.0); - virtual void set_linewidth (float w); - virtual void set_linestyle (const std::string& s, bool stipple = false); - virtual void set_clipbox (double x1, double x2, double y1, double y2, - double z1, double z2); - virtual void set_clipping (bool on); - virtual void set_font (const base_properties& props); - - virtual void init_marker (const std::string& m, double size, float width); - virtual void end_marker (void); - virtual void draw_marker (double x, double y, double z, - const Matrix& lc, const Matrix& fc); - - virtual void text_to_pixels (const std::string& txt, - uint8NDArray& pixels, - Matrix& bbox, - int halign = 0, int valign = 0, - double rotation = 0.0); - - virtual Matrix render_text (const std::string& txt, - double x, double y, double z, - int halign, int valign, double rotation = 0.0); - - virtual void draw_pixels (GLsizei w, GLsizei h, GLenum format, - GLenum type, const GLvoid *data); - - virtual void render_grid (const std::string& gridstyle, const Matrix& ticks, - double lim1, double lim2, - double p1, double p1N, double p2, double p2N, - int xyz, bool is_3D); - - virtual void render_tickmarks (const Matrix& ticks, double lim1, double lim2, - double p1, double p1N, double p2, double p2N, - double dx, double dy, double dz, - int xyz, bool doubleside); - - virtual void render_ticktexts (const Matrix& ticks, - const string_vector& ticklabels, - double lim1, double lim2, - double p1, double p2, - int xyz, int ha, int va, - int& wmax, int& hmax); - -private: - opengl_renderer (const opengl_renderer&) - : toolkit (), xform (), xmin (), xmax (), ymin (), ymax (), - zmin (), zmax (), xZ1 (), xZ2 (), marker_id (), filled_marker_id (), - camera_pos (), camera_dir () -#if HAVE_FREETYPE - , text_renderer () -#endif - { } - - opengl_renderer& operator = (const opengl_renderer&) - { return *this; } - - bool is_nan_or_inf (double x, double y, double z) const - { - return (xisnan (x) || xisnan (y) || xisnan (z) - || xisinf (x) || xisinf (y) || xisinf (z)); - } - - octave_uint8 clip_code (double x, double y, double z) const - { - return ((x < xmin ? 1 : 0) - | (x > xmax ? 1 : 0) << 1 - | (y < ymin ? 1 : 0) << 2 - | (y > ymax ? 1 : 0) << 3 - | (z < zmin ? 1 : 0) << 4 - | (z > zmax ? 1 : 0) << 5 - | (is_nan_or_inf (x, y, z) ? 0 : 1) << 6); - } - - unsigned int make_marker_list (const std::string& m, double size, - bool filled) const; - - void draw_axes_planes (const axes::properties& props); - void draw_axes_boxes (const axes::properties& props); - - void draw_axes_x_grid (const axes::properties& props); - void draw_axes_y_grid (const axes::properties& props); - void draw_axes_z_grid (const axes::properties& props); - - void draw_axes_children (const axes::properties& props); - -private: - // The graphics toolkit associated with the figure being rendered. - graphics_toolkit toolkit; - - // axes transformation data - graphics_xform xform; - - // axis limits in model scaled coordinate - double xmin, xmax; - double ymin, ymax; - double zmin, zmax; - - // Z projection limits in windows coordinate - double xZ1, xZ2; - - // call lists identifiers for markers - unsigned int marker_id, filled_marker_id; - - // camera information for primitive sorting - ColumnVector camera_pos, camera_dir; - -#if HAVE_FREETYPE - // freetype render, used for text rendering - ft_render text_renderer; -#endif - -private: - class patch_tesselator; -}; - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/gl2ps-renderer.cc --- a/libinterp/interp-core/gl2ps-renderer.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,251 +0,0 @@ -/* - -Copyright (C) 2009-2012 Shai Ayal - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#if defined (HAVE_OPENGL) - -#include - -#include "lo-mappers.h" -#include "oct-locbuf.h" - -#include "gl2ps-renderer.h" -#include "gl2ps.h" - -void -glps_renderer::draw (const graphics_object& go, const std::string print_cmd) -{ - static bool in_draw = false; - static std::string old_print_cmd; - - if (!in_draw) - { - in_draw = true; - - GLint buffsize = 0, state = GL2PS_OVERFLOW; - GLint viewport[4]; - - glGetIntegerv (GL_VIEWPORT, viewport); - - GLint gl2ps_term; - if (term.find ("eps") != std::string::npos) gl2ps_term = GL2PS_EPS; - else if (term.find ("pdf") != std::string::npos) gl2ps_term = GL2PS_PDF; - else if (term.find ("svg") != std::string::npos) gl2ps_term = GL2PS_SVG; - else if (term.find ("ps") != std::string::npos) gl2ps_term = GL2PS_PS; - else if (term.find ("pgf") != std::string::npos) gl2ps_term = GL2PS_PGF; - else if (term.find ("tex") != std::string::npos) gl2ps_term = GL2PS_TEX; - else - { - error ("gl2ps-renderer:: Unknown terminal"); - return; - } - - GLint gl2ps_text = 0; - if (term.find ("notxt") != std::string::npos) gl2ps_text = GL2PS_NO_TEXT; - - // Default sort order optimizes for 3D plots - GLint gl2ps_sort = GL2PS_BSP_SORT; - if (term.find ("is2D") != std::string::npos) gl2ps_sort = GL2PS_NO_SORT; - - while (state == GL2PS_OVERFLOW) - { - // For LaTeX output the fltk print process uses two drawnow() commands. - // The first one is for the pdf/ps/eps graph to be included. The print_cmd - // is saved as old_print_cmd. Then the second drawnow() outputs the tex-file - // and the graphic filename to be included is extracted from old_print_cmd. - std::string include_graph; - std::size_t found_redirect = old_print_cmd.find (">"); - if (found_redirect != std::string::npos) - include_graph = old_print_cmd.substr (found_redirect + 1); - else - include_graph = old_print_cmd; - std::size_t n_begin = include_graph.find_first_not_of (" "); - if (n_begin != std::string::npos) - { - std::size_t n_end = include_graph.find_last_not_of (" "); - include_graph = include_graph.substr (n_begin, n_end - n_begin + 1); - } - else - include_graph = "foobar-inc"; - buffsize += 1024*1024; - gl2psBeginPage ("glps_renderer figure", "Octave", viewport, - gl2ps_term, gl2ps_sort, - (GL2PS_SILENT | GL2PS_SIMPLE_LINE_OFFSET - | GL2PS_NO_BLENDING | GL2PS_OCCLUSION_CULL - | GL2PS_BEST_ROOT | gl2ps_text - | GL2PS_NO_PS3_SHADING), - GL_RGBA, 0, NULL, 0, 0, 0, - buffsize, fp, include_graph.c_str ()); - old_print_cmd = print_cmd; - opengl_renderer::draw (go); - state = gl2psEndPage (); - } - - in_draw = 0; - } - else - opengl_renderer::draw (go); -} - -int -glps_renderer::alignment_to_mode (int ha, int va) const -{ - int gl2psa=GL2PS_TEXT_BL; - if (ha == 0) - { - if (va == 0 || va == 3) - gl2psa=GL2PS_TEXT_BL; - else if (va == 2) - gl2psa=GL2PS_TEXT_TL; - else if (va == 1) - gl2psa=GL2PS_TEXT_CL; - } - else if (ha == 2) - { - if (va == 0 || va == 3) - gl2psa=GL2PS_TEXT_BR; - else if (va == 2) - gl2psa=GL2PS_TEXT_TR; - else if (va == 1) - gl2psa=GL2PS_TEXT_CR; - } - else if (ha == 1) - { - if (va == 0 || va == 3) - gl2psa=GL2PS_TEXT_B; - else if (va == 2) - gl2psa=GL2PS_TEXT_T; - else if (va == 1) - gl2psa=GL2PS_TEXT_C; - } - return gl2psa; -} - -Matrix -glps_renderer::render_text (const std::string& txt, - double x, double y, double z, - int ha, int va, double rotation) -{ - if (txt.empty ()) - return Matrix (1, 4, 0.0); - - glRasterPos3d (x, y, z); - gl2psTextOpt (txt.c_str (), fontname.c_str (), fontsize, - alignment_to_mode (ha, va), rotation); - - // FIXME? -- we have no way of getting a bounding box from gl2ps, so - // we use freetype - Matrix bbox; - uint8NDArray pixels; - text_to_pixels (txt, pixels, bbox, 0, 0, rotation); - return bbox; -} - -void -glps_renderer::set_font (const base_properties& props) -{ - opengl_renderer::set_font (props); - - fontsize = props.get ("fontsize").double_value (); - - caseless_str fn = props.get ("fontname").string_value (); - fontname = ""; - if (fn == "times" || fn == "times-roman") - fontname = "Times-Roman"; - else if (fn == "courier") - fontname = "Courier"; - else if (fn == "symbol") - fontname = "Symbol"; - else if (fn == "zapfdingbats") - fontname = "ZapfDingbats"; - else - fontname = "Helvetica"; - - // FIXME -- add support for bold and italic -} - -template -static void -draw_pixels (GLsizei w, GLsizei h, GLenum format, const T *data) -{ - OCTAVE_LOCAL_BUFFER (GLfloat, a, 3*w*h); - - for (int i = 0; i < 3*w*h; i++) - a[i] = data[i]; - - gl2psDrawPixels (w, h, 0, 0, format, GL_FLOAT, a); -} - -void -glps_renderer::draw_pixels (GLsizei w, GLsizei h, GLenum format, - GLenum type, const GLvoid *data) -{ - if (type == GL_UNSIGNED_SHORT) - ::draw_pixels (w, h, format, static_cast (data)); - else if (type == GL_UNSIGNED_BYTE) - ::draw_pixels (w, h, format, static_cast (data)); - else - gl2psDrawPixels (w, h, 0, 0, format, type, data); -} - -void -glps_renderer::draw_text (const text::properties& props) -{ - if (props.get_string ().is_empty ()) - return; - - set_font (props); - set_color (props.get_color_rgb ()); - - const Matrix pos = get_transform ().scale (props.get_data_position ()); - int halign = 0, valign = 0; - - if (props.horizontalalignment_is ("center")) - halign = 1; - else if (props.horizontalalignment_is ("right")) - halign = 2; - - if (props.verticalalignment_is ("top")) - valign = 2; - else if (props.verticalalignment_is ("baseline")) - valign = 3; - else if (props.verticalalignment_is ("middle")) - valign = 1; - - // FIXME: handle margin and surrounding box - - glRasterPos3d (pos(0), pos(1), pos.numel () > 2 ? pos(2) : 0.0); - - octave_value string_prop = props.get_string (); - - string_vector sv = string_prop.all_strings (); - - std::string s = sv.join ("\n"); - - gl2psTextOpt (s.c_str (), fontname.c_str (), fontsize, - alignment_to_mode (halign, valign), props.get_rotation ()); -} - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/gl2ps-renderer.h --- a/libinterp/interp-core/gl2ps-renderer.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,87 +0,0 @@ -/* - -Copyright (C) 2009-2012 Shai Ayal - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (gl2ps_renderer_h) -#define gl2ps_renderer_h 1 - -#include "gl-render.h" -#include "gl2ps.h" - -class -OCTINTERP_API -glps_renderer : public opengl_renderer -{ -public: - glps_renderer (FILE *_fp, const std::string& _term) - : opengl_renderer () , fp (_fp), term (_term), - fontsize (), fontname () { } - - ~glps_renderer (void) { } - - void draw (const graphics_object& go, const std::string print_cmd); - -protected: - - Matrix render_text (const std::string& txt, - double x, double y, double z, - int halign, int valign, double rotation = 0.0); - - - void set_font (const base_properties& props); - - void draw_text (const text::properties& props); - void draw_pixels (GLsizei w, GLsizei h, GLenum format, - GLenum type, const GLvoid *data); - - void set_linestyle (const std::string& s, bool use_stipple = false) - { - opengl_renderer::set_linestyle (s, use_stipple); - - if (s == "-" && ! use_stipple) - gl2psDisable (GL2PS_LINE_STIPPLE); - else - gl2psEnable (GL2PS_LINE_STIPPLE); - } - - void set_polygon_offset (bool on, double offset = 0.0) - { - opengl_renderer::set_polygon_offset (on, offset); - if (on) - gl2psEnable (GL2PS_POLYGON_OFFSET_FILL); - else - gl2psDisable (GL2PS_POLYGON_OFFSET_FILL); - } - - void set_linewidth (float w) - { - gl2psLineWidth (w); - } - -private: - int alignment_to_mode (int ha, int va) const; - FILE *fp; - caseless_str term; - double fontsize; - std::string fontname; -}; - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/gl2ps.c --- a/libinterp/interp-core/gl2ps.c Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,6078 +0,0 @@ -/* - * GL2PS, an OpenGL to PostScript Printing Library - * Copyright (C) 1999-2011 C. Geuzaine - * - * This program is free software; you can redistribute it and/or - * modify it under the terms of either: - * - * a) the GNU Library General Public License as published by the Free - * Software Foundation, either version 2 of the License, or (at your - * option) any later version; or - * - * b) the GL2PS License as published by Christophe Geuzaine, either - * version 2 of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, but - * WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either - * the GNU Library General Public License or the GL2PS License for - * more details. - * - * You should have received a copy of the GNU Library General Public - * License along with this library in the file named "COPYING.LGPL"; - * if not, write to the Free Software Foundation, Inc., 675 Mass Ave, - * Cambridge, MA 02139, USA. - * - * You should have received a copy of the GL2PS License with this - * library in the file named "COPYING.GL2PS"; if not, I will be glad - * to provide one. - * - * For the latest info about gl2ps and a full list of contributors, - * see http://www.geuz.org/gl2ps/. - * - * Please report all bugs and problems to . - */ - -#include "gl2ps.h" - -#include -#include -#include -#include -#include -#include - -#if defined(GL2PS_HAVE_ZLIB) -#include -#endif - -#if defined(GL2PS_HAVE_LIBPNG) -#include -#endif - -/********************************************************************* - * - * Private definitions, data structures and prototypes - * - *********************************************************************/ - -/* Magic numbers (assuming that the order of magnitude of window - coordinates is 10^3) */ - -#define GL2PS_EPSILON 5.0e-3F -#define GL2PS_ZSCALE 1000.0F -#define GL2PS_ZOFFSET 5.0e-2F -#define GL2PS_ZOFFSET_LARGE 20.0F -#define GL2PS_ZERO(arg) (fabs(arg) < 1.e-20) - -/* Primitive types */ - -#define GL2PS_NO_TYPE -1 -#define GL2PS_TEXT 1 -#define GL2PS_POINT 2 -#define GL2PS_LINE 3 -#define GL2PS_QUADRANGLE 4 -#define GL2PS_TRIANGLE 5 -#define GL2PS_PIXMAP 6 -#define GL2PS_IMAGEMAP 7 -#define GL2PS_IMAGEMAP_WRITTEN 8 -#define GL2PS_IMAGEMAP_VISIBLE 9 -#define GL2PS_SPECIAL 10 - -/* BSP tree primitive comparison */ - -#define GL2PS_COINCIDENT 1 -#define GL2PS_IN_FRONT_OF 2 -#define GL2PS_IN_BACK_OF 3 -#define GL2PS_SPANNING 4 - -/* 2D BSP tree primitive comparison */ - -#define GL2PS_POINT_COINCIDENT 0 -#define GL2PS_POINT_INFRONT 1 -#define GL2PS_POINT_BACK 2 - -/* Internal feedback buffer pass-through tokens */ - -#define GL2PS_BEGIN_OFFSET_TOKEN 1 -#define GL2PS_END_OFFSET_TOKEN 2 -#define GL2PS_BEGIN_BOUNDARY_TOKEN 3 -#define GL2PS_END_BOUNDARY_TOKEN 4 -#define GL2PS_BEGIN_STIPPLE_TOKEN 5 -#define GL2PS_END_STIPPLE_TOKEN 6 -#define GL2PS_POINT_SIZE_TOKEN 7 -#define GL2PS_LINE_WIDTH_TOKEN 8 -#define GL2PS_BEGIN_BLEND_TOKEN 9 -#define GL2PS_END_BLEND_TOKEN 10 -#define GL2PS_SRC_BLEND_TOKEN 11 -#define GL2PS_DST_BLEND_TOKEN 12 -#define GL2PS_IMAGEMAP_TOKEN 13 -#define GL2PS_DRAW_PIXELS_TOKEN 14 -#define GL2PS_TEXT_TOKEN 15 - -typedef enum { - T_UNDEFINED = -1, - T_CONST_COLOR = 1, - T_VAR_COLOR = 1<<1, - T_ALPHA_1 = 1<<2, - T_ALPHA_LESS_1 = 1<<3, - T_VAR_ALPHA = 1<<4 -} GL2PS_TRIANGLE_PROPERTY; - -typedef GLfloat GL2PSxyz[3]; -typedef GLfloat GL2PSplane[4]; - -typedef struct _GL2PSbsptree2d GL2PSbsptree2d; - -struct _GL2PSbsptree2d { - GL2PSplane plane; - GL2PSbsptree2d *front, *back; -}; - -typedef struct { - GLint nmax, size, incr, n; - char *array; -} GL2PSlist; - -typedef struct _GL2PSbsptree GL2PSbsptree; - -struct _GL2PSbsptree { - GL2PSplane plane; - GL2PSlist *primitives; - GL2PSbsptree *front, *back; -}; - -typedef struct { - GL2PSxyz xyz; - GL2PSrgba rgba; -} GL2PSvertex; - -typedef struct { - GL2PSvertex vertex[3]; - int prop; -} GL2PStriangle; - -typedef struct { - GLshort fontsize; - char *str, *fontname; - /* Note: for a 'special' string, 'alignment' holds the format - (PostScript, PDF, etc.) of the special string */ - GLint alignment; - GLfloat angle; -} GL2PSstring; - -typedef struct { - GLsizei width, height; - /* Note: for an imagemap, 'type' indicates if it has already been - written to the file or not, and 'format' indicates if it is - visible or not */ - GLenum format, type; - GLfloat zoom_x, zoom_y; - GLfloat *pixels; -} GL2PSimage; - -typedef struct _GL2PSimagemap GL2PSimagemap; - -struct _GL2PSimagemap { - GL2PSimage *image; - GL2PSimagemap *next; -}; - -typedef struct { - GLshort type, numverts; - GLushort pattern; - char boundary, offset, culled; - GLint factor; - GLfloat width; - GL2PSvertex *verts; - union { - GL2PSstring *text; - GL2PSimage *image; - } data; -} GL2PSprimitive; - -typedef struct { -#if defined(GL2PS_HAVE_ZLIB) - Bytef *dest, *src, *start; - uLongf destLen, srcLen; -#else - int dummy; -#endif -} GL2PScompress; - -typedef struct{ - GL2PSlist* ptrlist; - int gsno, fontno, imno, shno, maskshno, trgroupno; - int gsobjno, fontobjno, imobjno, shobjno, maskshobjno, trgroupobjno; -} GL2PSpdfgroup; - -typedef struct { - /* General */ - GLint format, sort, options, colorsize, colormode, buffersize; - char *title, *producer, *filename; - GLboolean boundary, blending; - GLfloat *feedback, offset[2], lastlinewidth; - GLint viewport[4], blendfunc[2], lastfactor; - GL2PSrgba *colormap, lastrgba, threshold, bgcolor; - GLushort lastpattern; - GL2PSvertex lastvertex; - GL2PSlist *primitives, *auxprimitives; - FILE *stream; - GL2PScompress *compress; - GLboolean header; - - /* BSP-specific */ - GLint maxbestroot; - - /* Occlusion culling-specific */ - GLboolean zerosurfacearea; - GL2PSbsptree2d *imagetree; - GL2PSprimitive *primitivetoadd; - - /* PDF-specific */ - int streamlength; - GL2PSlist *pdfprimlist, *pdfgrouplist; - int *xreflist; - int objects_stack; /* available objects */ - int extgs_stack; /* graphics state object number */ - int font_stack; /* font object number */ - int im_stack; /* image object number */ - int trgroupobjects_stack; /* xobject numbers */ - int shader_stack; /* shader object numbers */ - int mshader_stack; /* mask shader object numbers */ - - /* for image map list */ - GL2PSimagemap *imagemap_head; - GL2PSimagemap *imagemap_tail; -} GL2PScontext; - -typedef struct { - void (*printHeader)(void); - void (*printFooter)(void); - void (*beginViewport)(GLint viewport[4]); - GLint (*endViewport)(void); - void (*printPrimitive)(void *data); - void (*printFinalPrimitive)(void); - const char *file_extension; - const char *description; -} GL2PSbackend; - -/* The gl2ps context. gl2ps is not thread safe (we should create a - local GL2PScontext during gl2psBeginPage) */ - -static GL2PScontext *gl2ps = NULL; - -/* Need to forward-declare this one */ - -static GLint gl2psPrintPrimitives(void); - -/********************************************************************* - * - * Utility routines - * - *********************************************************************/ - -static void gl2psMsg(GLint level, const char *fmt, ...) -{ - va_list args; - - if(!(gl2ps->options & GL2PS_SILENT)){ - switch(level){ - case GL2PS_INFO : fprintf(stderr, "GL2PS info: "); break; - case GL2PS_WARNING : fprintf(stderr, "GL2PS warning: "); break; - case GL2PS_ERROR : fprintf(stderr, "GL2PS error: "); break; - } - va_start(args, fmt); - vfprintf(stderr, fmt, args); - va_end(args); - fprintf(stderr, "\n"); - } - /* if(level == GL2PS_ERROR) exit(1); */ -} - -static void *gl2psMalloc(size_t size) -{ - void *ptr; - - if(!size) return NULL; - ptr = malloc(size); - if(!ptr){ - gl2psMsg(GL2PS_ERROR, "Couldn't allocate requested memory"); - return NULL; - } - return ptr; -} - -static void *gl2psRealloc(void *ptr, size_t size) -{ - void *orig = ptr; - if(!size) return NULL; - ptr = realloc(orig, size); - if(!ptr){ - gl2psMsg(GL2PS_ERROR, "Couldn't reallocate requested memory"); - free(orig); - return NULL; - } - return ptr; -} - -static void gl2psFree(void *ptr) -{ - if(!ptr) return; - free(ptr); -} - -static int gl2psWriteBigEndian(unsigned long data, int bytes) -{ - int i; - int size = sizeof(unsigned long); - for(i = 1; i <= bytes; ++i){ - fputc(0xff & (data >> (size - i) * 8), gl2ps->stream); - } - return bytes; -} - -/* zlib compression helper routines */ - -#if defined(GL2PS_HAVE_ZLIB) - -static void gl2psSetupCompress(void) -{ - gl2ps->compress = (GL2PScompress*)gl2psMalloc(sizeof(GL2PScompress)); - gl2ps->compress->src = NULL; - gl2ps->compress->start = NULL; - gl2ps->compress->dest = NULL; - gl2ps->compress->srcLen = 0; - gl2ps->compress->destLen = 0; -} - -static void gl2psFreeCompress(void) -{ - if(!gl2ps->compress) - return; - gl2psFree(gl2ps->compress->start); - gl2psFree(gl2ps->compress->dest); - gl2ps->compress->src = NULL; - gl2ps->compress->start = NULL; - gl2ps->compress->dest = NULL; - gl2ps->compress->srcLen = 0; - gl2ps->compress->destLen = 0; -} - -static int gl2psAllocCompress(unsigned int srcsize) -{ - gl2psFreeCompress(); - - if(!gl2ps->compress || !srcsize) - return GL2PS_ERROR; - - gl2ps->compress->srcLen = srcsize; - gl2ps->compress->destLen = (int)ceil(1.001 * gl2ps->compress->srcLen + 12); - gl2ps->compress->src = (Bytef*)gl2psMalloc(gl2ps->compress->srcLen); - gl2ps->compress->start = gl2ps->compress->src; - gl2ps->compress->dest = (Bytef*)gl2psMalloc(gl2ps->compress->destLen); - - return GL2PS_SUCCESS; -} - -static void *gl2psReallocCompress(unsigned int srcsize) -{ - if(!gl2ps->compress || !srcsize) - return NULL; - - if(srcsize < gl2ps->compress->srcLen) - return gl2ps->compress->start; - - gl2ps->compress->srcLen = srcsize; - gl2ps->compress->destLen = (int)ceil(1.001 * gl2ps->compress->srcLen + 12); - gl2ps->compress->src = (Bytef*)gl2psRealloc(gl2ps->compress->src, - gl2ps->compress->srcLen); - gl2ps->compress->start = gl2ps->compress->src; - gl2ps->compress->dest = (Bytef*)gl2psRealloc(gl2ps->compress->dest, - gl2ps->compress->destLen); - - return gl2ps->compress->start; -} - -static int gl2psWriteBigEndianCompress(unsigned long data, int bytes) -{ - int i; - int size = sizeof(unsigned long); - for(i = 1; i <= bytes; ++i){ - *gl2ps->compress->src = (Bytef)(0xff & (data >> (size-i) * 8)); - ++gl2ps->compress->src; - } - return bytes; -} - -static int gl2psDeflate(void) -{ - /* For compatibility with older zlib versions, we use compress(...) - instead of compress2(..., Z_BEST_COMPRESSION) */ - return compress(gl2ps->compress->dest, &gl2ps->compress->destLen, - gl2ps->compress->start, gl2ps->compress->srcLen); -} - -#endif - -static int gl2psPrintf(const char* fmt, ...) -{ - int ret; - va_list args; - -#if defined(GL2PS_HAVE_ZLIB) - unsigned int oldsize = 0; - static char buf[1000]; - if(gl2ps->options & GL2PS_COMPRESS){ - va_start(args, fmt); - ret = vsprintf(buf, fmt, args); - va_end(args); - oldsize = gl2ps->compress->srcLen; - gl2ps->compress->start = (Bytef*)gl2psReallocCompress(oldsize + ret); - memcpy(gl2ps->compress->start+oldsize, buf, ret); - ret = 0; - } - else{ -#endif - va_start(args, fmt); - ret = vfprintf(gl2ps->stream, fmt, args); - va_end(args); -#if defined(GL2PS_HAVE_ZLIB) - } -#endif - return ret; -} - -static void gl2psPrintGzipHeader(void) -{ -#if defined(GL2PS_HAVE_ZLIB) - char tmp[10] = {'\x1f', '\x8b', /* magic numbers: 0x1f, 0x8b */ - 8, /* compression method: Z_DEFLATED */ - 0, /* flags */ - 0, 0, 0, 0, /* time */ - 2, /* extra flags: max compression */ - '\x03'}; /* OS code: 0x03 (Unix) */ - - if(gl2ps->options & GL2PS_COMPRESS){ - gl2psSetupCompress(); - /* add the gzip file header */ - fwrite(tmp, 10, 1, gl2ps->stream); - } -#endif -} - -static void gl2psPrintGzipFooter(void) -{ -#if defined(GL2PS_HAVE_ZLIB) - int n; - uLong crc, len; - char tmp[8]; - - if(gl2ps->options & GL2PS_COMPRESS){ - if(Z_OK != gl2psDeflate()){ - gl2psMsg(GL2PS_ERROR, "Zlib deflate error"); - } - else{ - /* determine the length of the header in the zlib stream */ - n = 2; /* CMF+FLG */ - if(gl2ps->compress->dest[1] & (1<<5)){ - n += 4; /* DICTID */ - } - /* write the data, without the zlib header and footer */ - fwrite(gl2ps->compress->dest+n, gl2ps->compress->destLen-(n+4), - 1, gl2ps->stream); - /* add the gzip file footer */ - crc = crc32(0L, gl2ps->compress->start, gl2ps->compress->srcLen); - for(n = 0; n < 4; ++n){ - tmp[n] = (char)(crc & 0xff); - crc >>= 8; - } - len = gl2ps->compress->srcLen; - for(n = 4; n < 8; ++n){ - tmp[n] = (char)(len & 0xff); - len >>= 8; - } - fwrite(tmp, 8, 1, gl2ps->stream); - } - gl2psFreeCompress(); - gl2psFree(gl2ps->compress); - gl2ps->compress = NULL; - } -#endif -} - -/* The list handling routines */ - -static void gl2psListRealloc(GL2PSlist *list, GLint n) -{ - if(!list){ - gl2psMsg(GL2PS_ERROR, "Cannot reallocate NULL list"); - return; - } - if(n <= 0) return; - if(!list->array){ - list->nmax = n; - list->array = (char*)gl2psMalloc(list->nmax * list->size); - } - else{ - if(n > list->nmax){ - list->nmax = ((n - 1) / list->incr + 1) * list->incr; - list->array = (char*)gl2psRealloc(list->array, - list->nmax * list->size); - } - } -} - -static GL2PSlist *gl2psListCreate(GLint n, GLint incr, GLint size) -{ - GL2PSlist *list; - - if(n < 0) n = 0; - if(incr <= 0) incr = 1; - list = (GL2PSlist*)gl2psMalloc(sizeof(GL2PSlist)); - list->nmax = 0; - list->incr = incr; - list->size = size; - list->n = 0; - list->array = NULL; - gl2psListRealloc(list, n); - return list; -} - -static void gl2psListReset(GL2PSlist *list) -{ - if(!list) return; - list->n = 0; -} - -static void gl2psListDelete(GL2PSlist *list) -{ - if(!list) return; - gl2psFree(list->array); - gl2psFree(list); -} - -static void gl2psListAdd(GL2PSlist *list, void *data) -{ - if(!list){ - gl2psMsg(GL2PS_ERROR, "Cannot add into unallocated list"); - return; - } - list->n++; - gl2psListRealloc(list, list->n); - memcpy(&list->array[(list->n - 1) * list->size], data, list->size); -} - -static int gl2psListNbr(GL2PSlist *list) -{ - if(!list) - return 0; - return list->n; -} - -static void *gl2psListPointer(GL2PSlist *list, GLint index) -{ - if(!list){ - gl2psMsg(GL2PS_ERROR, "Cannot point into unallocated list"); - return NULL; - } - if((index < 0) || (index >= list->n)){ - gl2psMsg(GL2PS_ERROR, "Wrong list index in gl2psListPointer"); - return NULL; - } - return &list->array[index * list->size]; -} - -static void gl2psListSort(GL2PSlist *list, - int (*fcmp)(const void *a, const void *b)) -{ - if(!list) - return; - qsort(list->array, list->n, list->size, fcmp); -} - -static void gl2psListAction(GL2PSlist *list, void (*action)(void *data)) -{ - GLint i; - - for(i = 0; i < gl2psListNbr(list); i++){ - (*action)(gl2psListPointer(list, i)); - } -} - -static void gl2psListActionInverse(GL2PSlist *list, void (*action)(void *data)) -{ - GLint i; - - for(i = gl2psListNbr(list); i > 0; i--){ - (*action)(gl2psListPointer(list, i-1)); - } -} - -#if defined(GL2PS_HAVE_LIBPNG) - -static void gl2psListRead(GL2PSlist *list, int index, void *data) -{ - if((index < 0) || (index >= list->n)) - gl2psMsg(GL2PS_ERROR, "Wrong list index in gl2psListRead"); - memcpy(data, &list->array[index * list->size], list->size); -} - -static void gl2psEncodeBase64Block(unsigned char in[3], unsigned char out[4], int len) -{ - static const char cb64[] = - "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"; - - out[0] = cb64[ in[0] >> 2 ]; - out[1] = cb64[ ((in[0] & 0x03) << 4) | ((in[1] & 0xf0) >> 4) ]; - out[2] = (len > 1) ? cb64[ ((in[1] & 0x0f) << 2) | ((in[2] & 0xc0) >> 6) ] : '='; - out[3] = (len > 2) ? cb64[ in[2] & 0x3f ] : '='; -} - -static void gl2psListEncodeBase64(GL2PSlist *list) -{ - unsigned char *buffer, in[3], out[4]; - int i, n, index, len; - - n = list->n * list->size; - buffer = (unsigned char*)gl2psMalloc(n * sizeof(unsigned char)); - memcpy(buffer, list->array, n * sizeof(unsigned char)); - gl2psListReset(list); - - index = 0; - while(index < n) { - len = 0; - for(i = 0; i < 3; i++) { - if(index < n){ - in[i] = buffer[index]; - len++; - } - else{ - in[i] = 0; - } - index++; - } - if(len) { - gl2psEncodeBase64Block(in, out, len); - for(i = 0; i < 4; i++) - gl2psListAdd(list, &out[i]); - } - } - gl2psFree(buffer); -} - -#endif - -/* Helpers for rgba colors */ - -static GLboolean gl2psSameColor(GL2PSrgba rgba1, GL2PSrgba rgba2) -{ - if(!GL2PS_ZERO(rgba1[0] - rgba2[0]) || - !GL2PS_ZERO(rgba1[1] - rgba2[1]) || - !GL2PS_ZERO(rgba1[2] - rgba2[2])) - return GL_FALSE; - return GL_TRUE; -} - -static GLboolean gl2psVertsSameColor(const GL2PSprimitive *prim) -{ - int i; - - for(i = 1; i < prim->numverts; i++){ - if(!gl2psSameColor(prim->verts[0].rgba, prim->verts[i].rgba)){ - return GL_FALSE; - } - } - return GL_TRUE; -} - -static GLboolean gl2psSameColorThreshold(int n, GL2PSrgba rgba[], - GL2PSrgba threshold) -{ - int i; - - if(n < 2) return GL_TRUE; - - for(i = 1; i < n; i++){ - if(fabs(rgba[0][0] - rgba[i][0]) > threshold[0] || - fabs(rgba[0][1] - rgba[i][1]) > threshold[1] || - fabs(rgba[0][2] - rgba[i][2]) > threshold[2]) - return GL_FALSE; - } - - return GL_TRUE; -} - -static void gl2psSetLastColor(GL2PSrgba rgba) -{ - int i; - for(i = 0; i < 3; ++i){ - gl2ps->lastrgba[i] = rgba[i]; - } -} - -static GLfloat gl2psGetRGB(GL2PSimage *im, GLuint x, GLuint y, - GLfloat *red, GLfloat *green, GLfloat *blue) -{ - - GLsizei width = im->width; - GLsizei height = im->height; - GLfloat *pixels = im->pixels; - GLfloat *pimag; - - /* OpenGL image is from down to up, PS image is up to down */ - switch(im->format){ - case GL_RGBA: - pimag = pixels + 4 * (width * (height - 1 - y) + x); - break; - case GL_RGB: - default: - pimag = pixels + 3 * (width * (height - 1 - y) + x); - break; - } - *red = *pimag; pimag++; - *green = *pimag; pimag++; - *blue = *pimag; pimag++; - - return (im->format == GL_RGBA) ? *pimag : 1.0F; -} - -/* Helper routines for pixmaps */ - -static GL2PSimage *gl2psCopyPixmap(GL2PSimage *im) -{ - int size; - GL2PSimage *image = (GL2PSimage*)gl2psMalloc(sizeof(GL2PSimage)); - - image->width = im->width; - image->height = im->height; - image->format = im->format; - image->type = im->type; - image->zoom_x = im->zoom_x; - image->zoom_y = im->zoom_y; - - switch(image->format){ - case GL_RGBA: - size = image->height * image->width * 4 * sizeof(GLfloat); - break; - case GL_RGB: - default: - size = image->height * image->width * 3 * sizeof(GLfloat); - break; - } - - image->pixels = (GLfloat*)gl2psMalloc(size); - memcpy(image->pixels, im->pixels, size); - - return image; -} - -static void gl2psFreePixmap(GL2PSimage *im) -{ - if(!im) - return; - gl2psFree(im->pixels); - gl2psFree(im); -} - -#if defined(GL2PS_HAVE_LIBPNG) - -#if !defined(png_jmpbuf) -# define png_jmpbuf(png_ptr) ((png_ptr)->jmpbuf) -#endif - -static void gl2psUserWritePNG(png_structp png_ptr, png_bytep data, png_size_t length) -{ - unsigned int i; - GL2PSlist *png = (GL2PSlist*)png_get_io_ptr(png_ptr); - for(i = 0; i < length; i++) - gl2psListAdd(png, &data[i]); -} - -static void gl2psUserFlushPNG(png_structp png_ptr) -{ - (void) png_ptr; /* not used */ -} - -static void gl2psConvertPixmapToPNG(GL2PSimage *pixmap, GL2PSlist *png) -{ - png_structp png_ptr; - png_infop info_ptr; - unsigned char *row_data; - GLfloat dr, dg, db; - int row, col; - - if(!(png_ptr = png_create_write_struct(PNG_LIBPNG_VER_STRING, NULL, NULL, NULL))) - return; - - if(!(info_ptr = png_create_info_struct(png_ptr))){ - png_destroy_write_struct(&png_ptr, NULL); - return; - } - - if(setjmp(png_jmpbuf(png_ptr))) { - png_destroy_write_struct(&png_ptr, &info_ptr); - return; - } - - png_set_write_fn(png_ptr, (void *)png, gl2psUserWritePNG, gl2psUserFlushPNG); - png_set_compression_level(png_ptr, Z_DEFAULT_COMPRESSION); - png_set_IHDR(png_ptr, info_ptr, pixmap->width, pixmap->height, 8, - PNG_COLOR_TYPE_RGB, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_BASE, - PNG_FILTER_TYPE_BASE); - png_write_info(png_ptr, info_ptr); - - row_data = (unsigned char*)gl2psMalloc(3 * pixmap->width * sizeof(unsigned char)); - for(row = 0; row < pixmap->height; row++){ - for(col = 0; col < pixmap->width; col++){ - gl2psGetRGB(pixmap, col, row, &dr, &dg, &db); - row_data[3*col] = (unsigned char)(255. * dr); - row_data[3*col+1] = (unsigned char)(255. * dg); - row_data[3*col+2] = (unsigned char)(255. * db); - } - png_write_row(png_ptr, (png_bytep)row_data); - } - gl2psFree(row_data); - - png_write_end(png_ptr, info_ptr); - png_destroy_write_struct(&png_ptr, &info_ptr); -} - -#endif - -/* Helper routines for text strings */ - -static GLint gl2psAddText(GLint type, const char *str, const char *fontname, - GLshort fontsize, GLint alignment, GLfloat angle) -{ - GLfloat pos[4]; - GL2PSprimitive *prim; - GLboolean valid; - - if(!gl2ps || !str || !fontname) return GL2PS_UNINITIALIZED; - - if(gl2ps->options & GL2PS_NO_TEXT) return GL2PS_SUCCESS; - - glGetBooleanv(GL_CURRENT_RASTER_POSITION_VALID, &valid); - if(GL_FALSE == valid) return GL2PS_SUCCESS; /* the primitive is culled */ - - glGetFloatv(GL_CURRENT_RASTER_POSITION, pos); - - prim = (GL2PSprimitive*)gl2psMalloc(sizeof(GL2PSprimitive)); - prim->type = type; - prim->boundary = 0; - prim->numverts = 1; - prim->verts = (GL2PSvertex*)gl2psMalloc(sizeof(GL2PSvertex)); - prim->verts[0].xyz[0] = pos[0]; - prim->verts[0].xyz[1] = pos[1]; - prim->verts[0].xyz[2] = pos[2]; - prim->culled = 0; - prim->offset = 0; - prim->pattern = 0; - prim->factor = 0; - prim->width = 1; - glGetFloatv(GL_CURRENT_RASTER_COLOR, prim->verts[0].rgba); - prim->data.text = (GL2PSstring*)gl2psMalloc(sizeof(GL2PSstring)); - prim->data.text->str = (char*)gl2psMalloc((strlen(str)+1)*sizeof(char)); - strcpy(prim->data.text->str, str); - prim->data.text->fontname = (char*)gl2psMalloc((strlen(fontname)+1)*sizeof(char)); - strcpy(prim->data.text->fontname, fontname); - prim->data.text->fontsize = fontsize; - prim->data.text->alignment = alignment; - prim->data.text->angle = angle; - - gl2psListAdd(gl2ps->auxprimitives, &prim); - glPassThrough(GL2PS_TEXT_TOKEN); - - return GL2PS_SUCCESS; -} - -static GL2PSstring *gl2psCopyText(GL2PSstring *t) -{ - GL2PSstring *text = (GL2PSstring*)gl2psMalloc(sizeof(GL2PSstring)); - text->str = (char*)gl2psMalloc((strlen(t->str)+1)*sizeof(char)); - strcpy(text->str, t->str); - text->fontname = (char*)gl2psMalloc((strlen(t->fontname)+1)*sizeof(char)); - strcpy(text->fontname, t->fontname); - text->fontsize = t->fontsize; - text->alignment = t->alignment; - text->angle = t->angle; - - return text; -} - -static void gl2psFreeText(GL2PSstring *text) -{ - if(!text) - return; - gl2psFree(text->str); - gl2psFree(text->fontname); - gl2psFree(text); -} - -/* Helpers for blending modes */ - -static GLboolean gl2psSupportedBlendMode(GLenum sfactor, GLenum dfactor) -{ - /* returns TRUE if gl2ps supports the argument combination: only two - blending modes have been implemented so far */ - - if( (sfactor == GL_SRC_ALPHA && dfactor == GL_ONE_MINUS_SRC_ALPHA) || - (sfactor == GL_ONE && dfactor == GL_ZERO) ) - return GL_TRUE; - return GL_FALSE; -} - -static void gl2psAdaptVertexForBlending(GL2PSvertex *v) -{ - /* Transforms vertex depending on the actual blending function - - currently the vertex v is considered as source vertex and his - alpha value is changed to 1.0 if source blending GL_ONE is - active. This might be extended in the future */ - - if(!v || !gl2ps) - return; - - if(gl2ps->options & GL2PS_NO_BLENDING || !gl2ps->blending){ - v->rgba[3] = 1.0F; - return; - } - - switch(gl2ps->blendfunc[0]){ - case GL_ONE: - v->rgba[3] = 1.0F; - break; - default: - break; - } -} - -static void gl2psAssignTriangleProperties(GL2PStriangle *t) -{ - /* int i; */ - - t->prop = T_VAR_COLOR; - - /* Uncommenting the following lines activates an even more fine - grained distinction between triangle types - please don't delete, - a remarkable amount of PDF handling code inside this file depends - on it if activated */ - /* - t->prop = T_CONST_COLOR; - for(i = 0; i < 3; ++i){ - if(!GL2PS_ZERO(t->vertex[0].rgba[i] - t->vertex[1].rgba[i]) || - !GL2PS_ZERO(t->vertex[1].rgba[i] - t->vertex[2].rgba[i])){ - t->prop = T_VAR_COLOR; - break; - } - } - */ - - if(!GL2PS_ZERO(t->vertex[0].rgba[3] - t->vertex[1].rgba[3]) || - !GL2PS_ZERO(t->vertex[1].rgba[3] - t->vertex[2].rgba[3])){ - t->prop |= T_VAR_ALPHA; - } - else{ - if(t->vertex[0].rgba[3] < 1) - t->prop |= T_ALPHA_LESS_1; - else - t->prop |= T_ALPHA_1; - } -} - -static void gl2psFillTriangleFromPrimitive(GL2PStriangle *t, GL2PSprimitive *p, - GLboolean assignprops) -{ - t->vertex[0] = p->verts[0]; - t->vertex[1] = p->verts[1]; - t->vertex[2] = p->verts[2]; - if(GL_TRUE == assignprops) - gl2psAssignTriangleProperties(t); -} - -static void gl2psInitTriangle(GL2PStriangle *t) -{ - int i; - GL2PSvertex vertex = { {-1.0F, -1.0F, -1.0F}, {-1.0F, -1.0F, -1.0F, -1.0F} }; - for(i = 0; i < 3; i++) - t->vertex[i] = vertex; - t->prop = T_UNDEFINED; -} - -/* Miscellaneous helper routines */ - -static GL2PSprimitive *gl2psCopyPrimitive(GL2PSprimitive *p) -{ - GL2PSprimitive *prim; - - if(!p){ - gl2psMsg(GL2PS_ERROR, "Trying to copy an empty primitive"); - return NULL; - } - - prim = (GL2PSprimitive*)gl2psMalloc(sizeof(GL2PSprimitive)); - - prim->type = p->type; - prim->numverts = p->numverts; - prim->boundary = p->boundary; - prim->offset = p->offset; - prim->pattern = p->pattern; - prim->factor = p->factor; - prim->culled = p->culled; - prim->width = p->width; - prim->verts = (GL2PSvertex*)gl2psMalloc(p->numverts*sizeof(GL2PSvertex)); - memcpy(prim->verts, p->verts, p->numverts * sizeof(GL2PSvertex)); - - switch(prim->type){ - case GL2PS_PIXMAP : - prim->data.image = gl2psCopyPixmap(p->data.image); - break; - case GL2PS_TEXT : - case GL2PS_SPECIAL : - prim->data.text = gl2psCopyText(p->data.text); - break; - default: - break; - } - - return prim; -} - -static GLboolean gl2psSamePosition(GL2PSxyz p1, GL2PSxyz p2) -{ - if(!GL2PS_ZERO(p1[0] - p2[0]) || - !GL2PS_ZERO(p1[1] - p2[1]) || - !GL2PS_ZERO(p1[2] - p2[2])) - return GL_FALSE; - return GL_TRUE; -} - -/********************************************************************* - * - * 3D sorting routines - * - *********************************************************************/ - -static GLfloat gl2psComparePointPlane(GL2PSxyz point, GL2PSplane plane) -{ - return (plane[0] * point[0] + - plane[1] * point[1] + - plane[2] * point[2] + - plane[3]); -} - -static GLfloat gl2psPsca(GLfloat *a, GLfloat *b) -{ - return (a[0]*b[0] + a[1]*b[1] + a[2]*b[2]); -} - -static void gl2psPvec(GLfloat *a, GLfloat *b, GLfloat *c) -{ - c[0] = a[1]*b[2] - a[2]*b[1]; - c[1] = a[2]*b[0] - a[0]*b[2]; - c[2] = a[0]*b[1] - a[1]*b[0]; -} - -static GLfloat gl2psNorm(GLfloat *a) -{ - return (GLfloat)sqrt(a[0]*a[0] + a[1]*a[1] + a[2]*a[2]); -} - -static void gl2psGetNormal(GLfloat *a, GLfloat *b, GLfloat *c) -{ - GLfloat norm; - - gl2psPvec(a, b, c); - if(!GL2PS_ZERO(norm = gl2psNorm(c))){ - c[0] = c[0] / norm; - c[1] = c[1] / norm; - c[2] = c[2] / norm; - } - else{ - /* The plane is still wrong despite our tests in gl2psGetPlane. - Let's return a dummy value for now (this is a hack: we should - do more intelligent tests in GetPlane) */ - c[0] = c[1] = 0.0F; - c[2] = 1.0F; - } -} - -static void gl2psGetPlane(GL2PSprimitive *prim, GL2PSplane plane) -{ - GL2PSxyz v = {0.0F, 0.0F, 0.0F}, w = {0.0F, 0.0F, 0.0F}; - - switch(prim->type){ - case GL2PS_TRIANGLE : - case GL2PS_QUADRANGLE : - v[0] = prim->verts[1].xyz[0] - prim->verts[0].xyz[0]; - v[1] = prim->verts[1].xyz[1] - prim->verts[0].xyz[1]; - v[2] = prim->verts[1].xyz[2] - prim->verts[0].xyz[2]; - w[0] = prim->verts[2].xyz[0] - prim->verts[0].xyz[0]; - w[1] = prim->verts[2].xyz[1] - prim->verts[0].xyz[1]; - w[2] = prim->verts[2].xyz[2] - prim->verts[0].xyz[2]; - if((GL2PS_ZERO(v[0]) && GL2PS_ZERO(v[1]) && GL2PS_ZERO(v[2])) || - (GL2PS_ZERO(w[0]) && GL2PS_ZERO(w[1]) && GL2PS_ZERO(w[2]))){ - plane[0] = plane[1] = 0.0F; - plane[2] = 1.0F; - plane[3] = -prim->verts[0].xyz[2]; - } - else{ - gl2psGetNormal(v, w, plane); - plane[3] = - - plane[0] * prim->verts[0].xyz[0] - - plane[1] * prim->verts[0].xyz[1] - - plane[2] * prim->verts[0].xyz[2]; - } - break; - case GL2PS_LINE : - v[0] = prim->verts[1].xyz[0] - prim->verts[0].xyz[0]; - v[1] = prim->verts[1].xyz[1] - prim->verts[0].xyz[1]; - v[2] = prim->verts[1].xyz[2] - prim->verts[0].xyz[2]; - if(GL2PS_ZERO(v[0]) && GL2PS_ZERO(v[1]) && GL2PS_ZERO(v[2])){ - plane[0] = plane[1] = 0.0F; - plane[2] = 1.0F; - plane[3] = -prim->verts[0].xyz[2]; - } - else{ - if(GL2PS_ZERO(v[0])) w[0] = 1.0F; - else if(GL2PS_ZERO(v[1])) w[1] = 1.0F; - else w[2] = 1.0F; - gl2psGetNormal(v, w, plane); - plane[3] = - - plane[0] * prim->verts[0].xyz[0] - - plane[1] * prim->verts[0].xyz[1] - - plane[2] * prim->verts[0].xyz[2]; - } - break; - case GL2PS_POINT : - case GL2PS_PIXMAP : - case GL2PS_TEXT : - case GL2PS_SPECIAL : - case GL2PS_IMAGEMAP: - plane[0] = plane[1] = 0.0F; - plane[2] = 1.0F; - plane[3] = -prim->verts[0].xyz[2]; - break; - default : - gl2psMsg(GL2PS_ERROR, "Unknown primitive type in BSP tree"); - plane[0] = plane[1] = plane[3] = 0.0F; - plane[2] = 1.0F; - break; - } -} - -static void gl2psCutEdge(GL2PSvertex *a, GL2PSvertex *b, GL2PSplane plane, - GL2PSvertex *c) -{ - GL2PSxyz v; - GLfloat sect, psca; - - v[0] = b->xyz[0] - a->xyz[0]; - v[1] = b->xyz[1] - a->xyz[1]; - v[2] = b->xyz[2] - a->xyz[2]; - - if(!GL2PS_ZERO(psca = gl2psPsca(plane, v))) - sect = -gl2psComparePointPlane(a->xyz, plane) / psca; - else - sect = 0.0F; - - c->xyz[0] = a->xyz[0] + v[0] * sect; - c->xyz[1] = a->xyz[1] + v[1] * sect; - c->xyz[2] = a->xyz[2] + v[2] * sect; - - c->rgba[0] = (1 - sect) * a->rgba[0] + sect * b->rgba[0]; - c->rgba[1] = (1 - sect) * a->rgba[1] + sect * b->rgba[1]; - c->rgba[2] = (1 - sect) * a->rgba[2] + sect * b->rgba[2]; - c->rgba[3] = (1 - sect) * a->rgba[3] + sect * b->rgba[3]; -} - -static void gl2psCreateSplitPrimitive(GL2PSprimitive *parent, GL2PSplane plane, - GL2PSprimitive *child, GLshort numverts, - GLshort *index0, GLshort *index1) -{ - GLshort i; - - if(parent->type == GL2PS_IMAGEMAP){ - child->type = GL2PS_IMAGEMAP; - child->data.image = parent->data.image; - } - else{ - if(numverts > 4){ - gl2psMsg(GL2PS_WARNING, "%d vertices in polygon", numverts); - numverts = 4; - } - switch(numverts){ - case 1 : child->type = GL2PS_POINT; break; - case 2 : child->type = GL2PS_LINE; break; - case 3 : child->type = GL2PS_TRIANGLE; break; - case 4 : child->type = GL2PS_QUADRANGLE; break; - default: child->type = GL2PS_NO_TYPE; break; - } - } - - child->boundary = 0; /* FIXME: not done! */ - child->culled = parent->culled; - child->offset = parent->offset; - child->pattern = parent->pattern; - child->factor = parent->factor; - child->width = parent->width; - child->numverts = numverts; - child->verts = (GL2PSvertex*)gl2psMalloc(numverts * sizeof(GL2PSvertex)); - - for(i = 0; i < numverts; i++){ - if(index1[i] < 0){ - child->verts[i] = parent->verts[index0[i]]; - } - else{ - gl2psCutEdge(&parent->verts[index0[i]], &parent->verts[index1[i]], - plane, &child->verts[i]); - } - } -} - -static void gl2psAddIndex(GLshort *index0, GLshort *index1, GLshort *nb, - GLshort i, GLshort j) -{ - GLint k; - - for(k = 0; k < *nb; k++){ - if((index0[k] == i && index1[k] == j) || - (index1[k] == i && index0[k] == j)) return; - } - index0[*nb] = i; - index1[*nb] = j; - (*nb)++; -} - -static GLshort gl2psGetIndex(GLshort i, GLshort num) -{ - return (i < num - 1) ? i + 1 : 0; -} - -static GLint gl2psTestSplitPrimitive(GL2PSprimitive *prim, GL2PSplane plane) -{ - GLint type = GL2PS_COINCIDENT; - GLshort i, j; - GLfloat d[5]; - - for(i = 0; i < prim->numverts; i++){ - d[i] = gl2psComparePointPlane(prim->verts[i].xyz, plane); - } - - if(prim->numverts < 2){ - return 0; - } - else{ - for(i = 0; i < prim->numverts; i++){ - j = gl2psGetIndex(i, prim->numverts); - if(d[j] > GL2PS_EPSILON){ - if(type == GL2PS_COINCIDENT) type = GL2PS_IN_BACK_OF; - else if(type != GL2PS_IN_BACK_OF) return 1; - if(d[i] < -GL2PS_EPSILON) return 1; - } - else if(d[j] < -GL2PS_EPSILON){ - if(type == GL2PS_COINCIDENT) type = GL2PS_IN_FRONT_OF; - else if(type != GL2PS_IN_FRONT_OF) return 1; - if(d[i] > GL2PS_EPSILON) return 1; - } - } - } - return 0; -} - -static GLint gl2psSplitPrimitive(GL2PSprimitive *prim, GL2PSplane plane, - GL2PSprimitive **front, GL2PSprimitive **back) -{ - GLshort i, j, in = 0, out = 0, in0[5], in1[5], out0[5], out1[5]; - GLint type; - GLfloat d[5]; - - type = GL2PS_COINCIDENT; - - for(i = 0; i < prim->numverts; i++){ - d[i] = gl2psComparePointPlane(prim->verts[i].xyz, plane); - } - - switch(prim->type){ - case GL2PS_POINT : - if(d[0] > GL2PS_EPSILON) type = GL2PS_IN_BACK_OF; - else if(d[0] < -GL2PS_EPSILON) type = GL2PS_IN_FRONT_OF; - else type = GL2PS_COINCIDENT; - break; - default : - for(i = 0; i < prim->numverts; i++){ - j = gl2psGetIndex(i, prim->numverts); - if(d[j] > GL2PS_EPSILON){ - if(type == GL2PS_COINCIDENT) type = GL2PS_IN_BACK_OF; - else if(type != GL2PS_IN_BACK_OF) type = GL2PS_SPANNING; - if(d[i] < -GL2PS_EPSILON){ - gl2psAddIndex(in0, in1, &in, i, j); - gl2psAddIndex(out0, out1, &out, i, j); - type = GL2PS_SPANNING; - } - gl2psAddIndex(out0, out1, &out, j, -1); - } - else if(d[j] < -GL2PS_EPSILON){ - if(type == GL2PS_COINCIDENT) type = GL2PS_IN_FRONT_OF; - else if(type != GL2PS_IN_FRONT_OF) type = GL2PS_SPANNING; - if(d[i] > GL2PS_EPSILON){ - gl2psAddIndex(in0, in1, &in, i, j); - gl2psAddIndex(out0, out1, &out, i, j); - type = GL2PS_SPANNING; - } - gl2psAddIndex(in0, in1, &in, j, -1); - } - else{ - gl2psAddIndex(in0, in1, &in, j, -1); - gl2psAddIndex(out0, out1, &out, j, -1); - } - } - break; - } - - if(type == GL2PS_SPANNING){ - *back = (GL2PSprimitive*)gl2psMalloc(sizeof(GL2PSprimitive)); - *front = (GL2PSprimitive*)gl2psMalloc(sizeof(GL2PSprimitive)); - gl2psCreateSplitPrimitive(prim, plane, *back, out, out0, out1); - gl2psCreateSplitPrimitive(prim, plane, *front, in, in0, in1); - } - - return type; -} - -static void gl2psDivideQuad(GL2PSprimitive *quad, - GL2PSprimitive **t1, GL2PSprimitive **t2) -{ - *t1 = (GL2PSprimitive*)gl2psMalloc(sizeof(GL2PSprimitive)); - *t2 = (GL2PSprimitive*)gl2psMalloc(sizeof(GL2PSprimitive)); - (*t1)->type = (*t2)->type = GL2PS_TRIANGLE; - (*t1)->numverts = (*t2)->numverts = 3; - (*t1)->culled = (*t2)->culled = quad->culled; - (*t1)->offset = (*t2)->offset = quad->offset; - (*t1)->pattern = (*t2)->pattern = quad->pattern; - (*t1)->factor = (*t2)->factor = quad->factor; - (*t1)->width = (*t2)->width = quad->width; - (*t1)->verts = (GL2PSvertex*)gl2psMalloc(3 * sizeof(GL2PSvertex)); - (*t2)->verts = (GL2PSvertex*)gl2psMalloc(3 * sizeof(GL2PSvertex)); - (*t1)->verts[0] = quad->verts[0]; - (*t1)->verts[1] = quad->verts[1]; - (*t1)->verts[2] = quad->verts[2]; - (*t1)->boundary = ((quad->boundary & 1) ? 1 : 0) | ((quad->boundary & 2) ? 2 : 0); - (*t2)->verts[0] = quad->verts[0]; - (*t2)->verts[1] = quad->verts[2]; - (*t2)->verts[2] = quad->verts[3]; - (*t2)->boundary = ((quad->boundary & 4) ? 2 : 0) | ((quad->boundary & 8) ? 4 : 0); -} - -static int gl2psCompareDepth(const void *a, const void *b) -{ - const GL2PSprimitive *q, *w; - GLfloat dq = 0.0F, dw = 0.0F, diff; - int i; - - q = *(const GL2PSprimitive* const*)a; - w = *(const GL2PSprimitive* const*)b; - - for(i = 0; i < q->numverts; i++){ - dq += q->verts[i].xyz[2]; - } - dq /= (GLfloat)q->numverts; - - for(i = 0; i < w->numverts; i++){ - dw += w->verts[i].xyz[2]; - } - dw /= (GLfloat)w->numverts; - - diff = dq - dw; - if(diff > 0.){ - return -1; - } - else if(diff < 0.){ - return 1; - } - else{ - return 0; - } -} - -static int gl2psTrianglesFirst(const void *a, const void *b) -{ - const GL2PSprimitive *q, *w; - - q = *(const GL2PSprimitive* const*)a; - w = *(const GL2PSprimitive* const*)b; - return (q->type < w->type ? 1 : -1); -} - -static GLint gl2psFindRoot(GL2PSlist *primitives, GL2PSprimitive **root) -{ - GLint i, j, count, best = 1000000, index = 0; - GL2PSprimitive *prim1, *prim2; - GL2PSplane plane; - GLint maxp; - - if(!gl2psListNbr(primitives)){ - gl2psMsg(GL2PS_ERROR, "Cannot fint root in empty primitive list"); - return 0; - } - - *root = *(GL2PSprimitive**)gl2psListPointer(primitives, 0); - - if(gl2ps->options & GL2PS_BEST_ROOT){ - maxp = gl2psListNbr(primitives); - if(maxp > gl2ps->maxbestroot){ - maxp = gl2ps->maxbestroot; - } - for(i = 0; i < maxp; i++){ - prim1 = *(GL2PSprimitive**)gl2psListPointer(primitives, i); - gl2psGetPlane(prim1, plane); - count = 0; - for(j = 0; j < gl2psListNbr(primitives); j++){ - if(j != i){ - prim2 = *(GL2PSprimitive**)gl2psListPointer(primitives, j); - count += gl2psTestSplitPrimitive(prim2, plane); - } - if(count > best) break; - } - if(count < best){ - best = count; - index = i; - *root = prim1; - if(!count) return index; - } - } - /* if(index) gl2psMsg(GL2PS_INFO, "GL2PS_BEST_ROOT was worth it: %d", index); */ - return index; - } - else{ - return 0; - } -} - -static void gl2psFreeImagemap(GL2PSimagemap *list) -{ - GL2PSimagemap *next; - while(list != NULL){ - next = list->next; - gl2psFree(list->image->pixels); - gl2psFree(list->image); - gl2psFree(list); - list = next; - } -} - -static void gl2psFreePrimitive(void *data) -{ - GL2PSprimitive *q; - - q = *(GL2PSprimitive**)data; - gl2psFree(q->verts); - if(q->type == GL2PS_TEXT || q->type == GL2PS_SPECIAL){ - gl2psFreeText(q->data.text); - } - else if(q->type == GL2PS_PIXMAP){ - gl2psFreePixmap(q->data.image); - } - gl2psFree(q); -} - -static void gl2psAddPrimitiveInList(GL2PSprimitive *prim, GL2PSlist *list) -{ - GL2PSprimitive *t1, *t2; - - if(prim->type != GL2PS_QUADRANGLE){ - gl2psListAdd(list, &prim); - } - else{ - gl2psDivideQuad(prim, &t1, &t2); - gl2psListAdd(list, &t1); - gl2psListAdd(list, &t2); - gl2psFreePrimitive(&prim); - } - -} - -static void gl2psFreeBspTree(GL2PSbsptree **tree) -{ - if(*tree){ - if((*tree)->back) gl2psFreeBspTree(&(*tree)->back); - if((*tree)->primitives){ - gl2psListAction((*tree)->primitives, gl2psFreePrimitive); - gl2psListDelete((*tree)->primitives); - } - if((*tree)->front) gl2psFreeBspTree(&(*tree)->front); - gl2psFree(*tree); - *tree = NULL; - } -} - -static GLboolean gl2psGreater(GLfloat f1, GLfloat f2) -{ - if(f1 > f2) return GL_TRUE; - else return GL_FALSE; -} - -static GLboolean gl2psLess(GLfloat f1, GLfloat f2) -{ - if(f1 < f2) return GL_TRUE; - else return GL_FALSE; -} - -static void gl2psBuildBspTree(GL2PSbsptree *tree, GL2PSlist *primitives) -{ - GL2PSprimitive *prim, *frontprim = NULL, *backprim = NULL; - GL2PSlist *frontlist, *backlist; - GLint i, index; - - tree->front = NULL; - tree->back = NULL; - tree->primitives = gl2psListCreate(1, 2, sizeof(GL2PSprimitive*)); - index = gl2psFindRoot(primitives, &prim); - gl2psGetPlane(prim, tree->plane); - gl2psAddPrimitiveInList(prim, tree->primitives); - - frontlist = gl2psListCreate(1, 2, sizeof(GL2PSprimitive*)); - backlist = gl2psListCreate(1, 2, sizeof(GL2PSprimitive*)); - - for(i = 0; i < gl2psListNbr(primitives); i++){ - if(i != index){ - prim = *(GL2PSprimitive**)gl2psListPointer(primitives,i); - switch(gl2psSplitPrimitive(prim, tree->plane, &frontprim, &backprim)){ - case GL2PS_COINCIDENT: - gl2psAddPrimitiveInList(prim, tree->primitives); - break; - case GL2PS_IN_BACK_OF: - gl2psAddPrimitiveInList(prim, backlist); - break; - case GL2PS_IN_FRONT_OF: - gl2psAddPrimitiveInList(prim, frontlist); - break; - case GL2PS_SPANNING: - gl2psAddPrimitiveInList(backprim, backlist); - gl2psAddPrimitiveInList(frontprim, frontlist); - gl2psFreePrimitive(&prim); - break; - } - } - } - - if(gl2psListNbr(tree->primitives)){ - gl2psListSort(tree->primitives, gl2psTrianglesFirst); - } - - if(gl2psListNbr(frontlist)){ - gl2psListSort(frontlist, gl2psTrianglesFirst); - tree->front = (GL2PSbsptree*)gl2psMalloc(sizeof(GL2PSbsptree)); - gl2psBuildBspTree(tree->front, frontlist); - } - else{ - gl2psListDelete(frontlist); - } - - if(gl2psListNbr(backlist)){ - gl2psListSort(backlist, gl2psTrianglesFirst); - tree->back = (GL2PSbsptree*)gl2psMalloc(sizeof(GL2PSbsptree)); - gl2psBuildBspTree(tree->back, backlist); - } - else{ - gl2psListDelete(backlist); - } - - gl2psListDelete(primitives); -} - -static void gl2psTraverseBspTree(GL2PSbsptree *tree, GL2PSxyz eye, GLfloat epsilon, - GLboolean (*compare)(GLfloat f1, GLfloat f2), - void (*action)(void *data), int inverse) -{ - GLfloat result; - - if(!tree) return; - - result = gl2psComparePointPlane(eye, tree->plane); - - if(GL_TRUE == compare(result, epsilon)){ - gl2psTraverseBspTree(tree->back, eye, epsilon, compare, action, inverse); - if(inverse){ - gl2psListActionInverse(tree->primitives, action); - } - else{ - gl2psListAction(tree->primitives, action); - } - gl2psTraverseBspTree(tree->front, eye, epsilon, compare, action, inverse); - } - else if(GL_TRUE == compare(-epsilon, result)){ - gl2psTraverseBspTree(tree->front, eye, epsilon, compare, action, inverse); - if(inverse){ - gl2psListActionInverse(tree->primitives, action); - } - else{ - gl2psListAction(tree->primitives, action); - } - gl2psTraverseBspTree(tree->back, eye, epsilon, compare, action, inverse); - } - else{ - gl2psTraverseBspTree(tree->front, eye, epsilon, compare, action, inverse); - gl2psTraverseBspTree(tree->back, eye, epsilon, compare, action, inverse); - } -} - -static void gl2psRescaleAndOffset(void) -{ - GL2PSprimitive *prim; - GLfloat minZ, maxZ, rangeZ, scaleZ; - GLfloat factor, units, area, dZ, dZdX, dZdY, maxdZ; - int i, j; - - if(!gl2psListNbr(gl2ps->primitives)) - return; - - /* get z-buffer range */ - prim = *(GL2PSprimitive**)gl2psListPointer(gl2ps->primitives, 0); - minZ = maxZ = prim->verts[0].xyz[2]; - for(i = 1; i < prim->numverts; i++){ - if(prim->verts[i].xyz[2] < minZ) minZ = prim->verts[i].xyz[2]; - if(prim->verts[i].xyz[2] > maxZ) maxZ = prim->verts[i].xyz[2]; - } - for(i = 1; i < gl2psListNbr(gl2ps->primitives); i++){ - prim = *(GL2PSprimitive**)gl2psListPointer(gl2ps->primitives, i); - for(j = 0; j < prim->numverts; j++){ - if(prim->verts[j].xyz[2] < minZ) minZ = prim->verts[j].xyz[2]; - if(prim->verts[j].xyz[2] > maxZ) maxZ = prim->verts[j].xyz[2]; - } - } - rangeZ = (maxZ - minZ); - - /* rescale z-buffer coordinate in [0,GL2PS_ZSCALE], to make it of - the same order of magnitude as the x and y coordinates */ - scaleZ = GL2PS_ZERO(rangeZ) ? GL2PS_ZSCALE : (GL2PS_ZSCALE / rangeZ); - /* avoid precision loss (we use floats!) */ - if(scaleZ > 100000.F) scaleZ = 100000.F; - - /* apply offsets */ - for(i = 0; i < gl2psListNbr(gl2ps->primitives); i++){ - prim = *(GL2PSprimitive**)gl2psListPointer(gl2ps->primitives, i); - for(j = 0; j < prim->numverts; j++){ - prim->verts[j].xyz[2] = (prim->verts[j].xyz[2] - minZ) * scaleZ; - } - if((gl2ps->options & GL2PS_SIMPLE_LINE_OFFSET) && - (prim->type == GL2PS_LINE)){ - if(gl2ps->sort == GL2PS_SIMPLE_SORT){ - prim->verts[0].xyz[2] -= GL2PS_ZOFFSET_LARGE; - prim->verts[1].xyz[2] -= GL2PS_ZOFFSET_LARGE; - } - else{ - prim->verts[0].xyz[2] -= GL2PS_ZOFFSET; - prim->verts[1].xyz[2] -= GL2PS_ZOFFSET; - } - } - else if(prim->offset && (prim->type == GL2PS_TRIANGLE)){ - factor = gl2ps->offset[0]; - units = gl2ps->offset[1]; - area = - (prim->verts[1].xyz[0] - prim->verts[0].xyz[0]) * - (prim->verts[2].xyz[1] - prim->verts[1].xyz[1]) - - (prim->verts[2].xyz[0] - prim->verts[1].xyz[0]) * - (prim->verts[1].xyz[1] - prim->verts[0].xyz[1]); - if(!GL2PS_ZERO(area)){ - dZdX = - ((prim->verts[2].xyz[1] - prim->verts[1].xyz[1]) * - (prim->verts[1].xyz[2] - prim->verts[0].xyz[2]) - - (prim->verts[1].xyz[1] - prim->verts[0].xyz[1]) * - (prim->verts[2].xyz[2] - prim->verts[1].xyz[2])) / area; - dZdY = - ((prim->verts[1].xyz[0] - prim->verts[0].xyz[0]) * - (prim->verts[2].xyz[2] - prim->verts[1].xyz[2]) - - (prim->verts[2].xyz[0] - prim->verts[1].xyz[0]) * - (prim->verts[1].xyz[2] - prim->verts[0].xyz[2])) / area; - maxdZ = (GLfloat)sqrt(dZdX * dZdX + dZdY * dZdY); - } - else{ - maxdZ = 0.0F; - } - dZ = factor * maxdZ + units; - prim->verts[0].xyz[2] += dZ; - prim->verts[1].xyz[2] += dZ; - prim->verts[2].xyz[2] += dZ; - } - } -} - -/********************************************************************* - * - * 2D sorting routines (for occlusion culling) - * - *********************************************************************/ - -static GLint gl2psGetPlaneFromPoints(GL2PSxyz a, GL2PSxyz b, GL2PSplane plane) -{ - GLfloat n; - - plane[0] = b[1] - a[1]; - plane[1] = a[0] - b[0]; - n = (GLfloat)sqrt(plane[0]*plane[0] + plane[1]*plane[1]); - plane[2] = 0.0F; - if(!GL2PS_ZERO(n)){ - plane[0] /= n; - plane[1] /= n; - plane[3] = -plane[0]*a[0]-plane[1]*a[1]; - return 1; - } - else{ - plane[0] = -1.0F; - plane[1] = 0.0F; - plane[3] = a[0]; - return 0; - } -} - -static void gl2psFreeBspImageTree(GL2PSbsptree2d **tree) -{ - if(*tree){ - if((*tree)->back) gl2psFreeBspImageTree(&(*tree)->back); - if((*tree)->front) gl2psFreeBspImageTree(&(*tree)->front); - gl2psFree(*tree); - *tree = NULL; - } -} - -static GLint gl2psCheckPoint(GL2PSxyz point, GL2PSplane plane) -{ - GLfloat pt_dis; - - pt_dis = gl2psComparePointPlane(point, plane); - if(pt_dis > GL2PS_EPSILON) return GL2PS_POINT_INFRONT; - else if(pt_dis < -GL2PS_EPSILON) return GL2PS_POINT_BACK; - else return GL2PS_POINT_COINCIDENT; -} - -static void gl2psAddPlanesInBspTreeImage(GL2PSprimitive *prim, - GL2PSbsptree2d **tree) -{ - GLint ret = 0; - GLint i; - GLint offset = 0; - GL2PSbsptree2d *head = NULL, *cur = NULL; - - if((*tree == NULL) && (prim->numverts > 2)){ - /* don't cull if transparent - for(i = 0; i < prim->numverts - 1; i++) - if(prim->verts[i].rgba[3] < 1.0F) return; - */ - head = (GL2PSbsptree2d*)gl2psMalloc(sizeof(GL2PSbsptree2d)); - for(i = 0; i < prim->numverts-1; i++){ - if(!gl2psGetPlaneFromPoints(prim->verts[i].xyz, - prim->verts[i+1].xyz, - head->plane)){ - if(prim->numverts-i > 3){ - offset++; - } - else{ - gl2psFree(head); - return; - } - } - else{ - break; - } - } - head->back = NULL; - head->front = NULL; - for(i = 2+offset; i < prim->numverts; i++){ - ret = gl2psCheckPoint(prim->verts[i].xyz, head->plane); - if(ret != GL2PS_POINT_COINCIDENT) break; - } - switch(ret){ - case GL2PS_POINT_INFRONT : - cur = head; - for(i = 1+offset; i < prim->numverts-1; i++){ - if(cur->front == NULL){ - cur->front = (GL2PSbsptree2d*)gl2psMalloc(sizeof(GL2PSbsptree2d)); - } - if(gl2psGetPlaneFromPoints(prim->verts[i].xyz, - prim->verts[i+1].xyz, - cur->front->plane)){ - cur = cur->front; - cur->front = NULL; - cur->back = NULL; - } - } - if(cur->front == NULL){ - cur->front = (GL2PSbsptree2d*)gl2psMalloc(sizeof(GL2PSbsptree2d)); - } - if(gl2psGetPlaneFromPoints(prim->verts[i].xyz, - prim->verts[offset].xyz, - cur->front->plane)){ - cur->front->front = NULL; - cur->front->back = NULL; - } - else{ - gl2psFree(cur->front); - cur->front = NULL; - } - break; - case GL2PS_POINT_BACK : - for(i = 0; i < 4; i++){ - head->plane[i] = -head->plane[i]; - } - cur = head; - for(i = 1+offset; i < prim->numverts-1; i++){ - if(cur->front == NULL){ - cur->front = (GL2PSbsptree2d*)gl2psMalloc(sizeof(GL2PSbsptree2d)); - } - if(gl2psGetPlaneFromPoints(prim->verts[i+1].xyz, - prim->verts[i].xyz, - cur->front->plane)){ - cur = cur->front; - cur->front = NULL; - cur->back = NULL; - } - } - if(cur->front == NULL){ - cur->front = (GL2PSbsptree2d*)gl2psMalloc(sizeof(GL2PSbsptree2d)); - } - if(gl2psGetPlaneFromPoints(prim->verts[offset].xyz, - prim->verts[i].xyz, - cur->front->plane)){ - cur->front->front = NULL; - cur->front->back = NULL; - } - else{ - gl2psFree(cur->front); - cur->front = NULL; - } - break; - default: - gl2psFree(head); - return; - } - (*tree) = head; - } -} - -static GLint gl2psCheckPrimitive(GL2PSprimitive *prim, GL2PSplane plane) -{ - GLint i; - GLint pos; - - pos = gl2psCheckPoint(prim->verts[0].xyz, plane); - for(i = 1; i < prim->numverts; i++){ - pos |= gl2psCheckPoint(prim->verts[i].xyz, plane); - if(pos == (GL2PS_POINT_INFRONT | GL2PS_POINT_BACK)) return GL2PS_SPANNING; - } - if(pos & GL2PS_POINT_INFRONT) return GL2PS_IN_FRONT_OF; - else if(pos & GL2PS_POINT_BACK) return GL2PS_IN_BACK_OF; - else return GL2PS_COINCIDENT; -} - -static GL2PSprimitive *gl2psCreateSplitPrimitive2D(GL2PSprimitive *parent, - GLshort numverts, - GL2PSvertex *vertx) -{ - GLint i; - GL2PSprimitive *child = (GL2PSprimitive*)gl2psMalloc(sizeof(GL2PSprimitive)); - - if(parent->type == GL2PS_IMAGEMAP){ - child->type = GL2PS_IMAGEMAP; - child->data.image = parent->data.image; - } - else { - switch(numverts){ - case 1 : child->type = GL2PS_POINT; break; - case 2 : child->type = GL2PS_LINE; break; - case 3 : child->type = GL2PS_TRIANGLE; break; - case 4 : child->type = GL2PS_QUADRANGLE; break; - default: child->type = GL2PS_NO_TYPE; break; /* FIXME */ - } - } - child->boundary = 0; /* FIXME: not done! */ - child->culled = parent->culled; - child->offset = parent->offset; - child->pattern = parent->pattern; - child->factor = parent->factor; - child->width = parent->width; - child->numverts = numverts; - child->verts = (GL2PSvertex*)gl2psMalloc(numverts * sizeof(GL2PSvertex)); - for(i = 0; i < numverts; i++){ - child->verts[i] = vertx[i]; - } - return child; -} - -static void gl2psSplitPrimitive2D(GL2PSprimitive *prim, - GL2PSplane plane, - GL2PSprimitive **front, - GL2PSprimitive **back) -{ - /* cur will hold the position of the current vertex - prev will hold the position of the previous vertex - prev0 will hold the position of the vertex number 0 - v1 and v2 represent the current and previous vertices, respectively - flag is set if the current vertex should be checked against the plane */ - GLint cur = -1, prev = -1, i, v1 = 0, v2 = 0, flag = 1, prev0 = -1; - - /* list of vertices that will go in front and back primitive */ - GL2PSvertex *front_list = NULL, *back_list = NULL; - - /* number of vertices in front and back list */ - GLshort front_count = 0, back_count = 0; - - for(i = 0; i <= prim->numverts; i++){ - v1 = i; - if(v1 == prim->numverts){ - if(prim->numverts < 3) break; - v1 = 0; - v2 = prim->numverts - 1; - cur = prev0; - } - else if(flag){ - cur = gl2psCheckPoint(prim->verts[v1].xyz, plane); - if(i == 0){ - prev0 = cur; - } - } - if(((prev == -1) || (prev == cur) || (prev == 0) || (cur == 0)) && - (i < prim->numverts)){ - if(cur == GL2PS_POINT_INFRONT){ - front_count++; - front_list = (GL2PSvertex*)gl2psRealloc(front_list, - sizeof(GL2PSvertex)*front_count); - front_list[front_count-1] = prim->verts[v1]; - } - else if(cur == GL2PS_POINT_BACK){ - back_count++; - back_list = (GL2PSvertex*)gl2psRealloc(back_list, - sizeof(GL2PSvertex)*back_count); - back_list[back_count-1] = prim->verts[v1]; - } - else{ - front_count++; - front_list = (GL2PSvertex*)gl2psRealloc(front_list, - sizeof(GL2PSvertex)*front_count); - front_list[front_count-1] = prim->verts[v1]; - back_count++; - back_list = (GL2PSvertex*)gl2psRealloc(back_list, - sizeof(GL2PSvertex)*back_count); - back_list[back_count-1] = prim->verts[v1]; - } - flag = 1; - } - else if((prev != cur) && (cur != 0) && (prev != 0)){ - if(v1 != 0){ - v2 = v1-1; - i--; - } - front_count++; - front_list = (GL2PSvertex*)gl2psRealloc(front_list, - sizeof(GL2PSvertex)*front_count); - gl2psCutEdge(&prim->verts[v2], &prim->verts[v1], - plane, &front_list[front_count-1]); - back_count++; - back_list = (GL2PSvertex*)gl2psRealloc(back_list, - sizeof(GL2PSvertex)*back_count); - back_list[back_count-1] = front_list[front_count-1]; - flag = 0; - } - prev = cur; - } - *front = gl2psCreateSplitPrimitive2D(prim, front_count, front_list); - *back = gl2psCreateSplitPrimitive2D(prim, back_count, back_list); - gl2psFree(front_list); - gl2psFree(back_list); -} - -static GLint gl2psAddInBspImageTree(GL2PSprimitive *prim, GL2PSbsptree2d **tree) -{ - GLint ret = 0; - GL2PSprimitive *frontprim = NULL, *backprim = NULL; - - /* FIXME: until we consider the actual extent of text strings and - pixmaps, never cull them. Otherwise the whole string/pixmap gets - culled as soon as the reference point is hidden */ - if(prim->type == GL2PS_PIXMAP || - prim->type == GL2PS_TEXT || - prim->type == GL2PS_SPECIAL){ - return 1; - } - - if(*tree == NULL){ - if((prim->type != GL2PS_IMAGEMAP) && (GL_FALSE == gl2ps->zerosurfacearea)){ - gl2psAddPlanesInBspTreeImage(gl2ps->primitivetoadd, tree); - } - return 1; - } - else{ - switch(gl2psCheckPrimitive(prim, (*tree)->plane)){ - case GL2PS_IN_BACK_OF: return gl2psAddInBspImageTree(prim, &(*tree)->back); - case GL2PS_IN_FRONT_OF: - if((*tree)->front != NULL) return gl2psAddInBspImageTree(prim, &(*tree)->front); - else return 0; - case GL2PS_SPANNING: - gl2psSplitPrimitive2D(prim, (*tree)->plane, &frontprim, &backprim); - ret = gl2psAddInBspImageTree(backprim, &(*tree)->back); - if((*tree)->front != NULL){ - if(gl2psAddInBspImageTree(frontprim, &(*tree)->front)){ - ret = 1; - } - } - gl2psFree(frontprim->verts); - gl2psFree(frontprim); - gl2psFree(backprim->verts); - gl2psFree(backprim); - return ret; - case GL2PS_COINCIDENT: - if((*tree)->back != NULL){ - gl2ps->zerosurfacearea = GL_TRUE; - ret = gl2psAddInBspImageTree(prim, &(*tree)->back); - gl2ps->zerosurfacearea = GL_FALSE; - if(ret) return ret; - } - if((*tree)->front != NULL){ - gl2ps->zerosurfacearea = GL_TRUE; - ret = gl2psAddInBspImageTree(prim, &(*tree)->front); - gl2ps->zerosurfacearea = GL_FALSE; - if(ret) return ret; - } - if(prim->type == GL2PS_LINE) return 1; - else return 0; - } - } - return 0; -} - -static void gl2psAddInImageTree(void *data) -{ - GL2PSprimitive *prim = *(GL2PSprimitive **)data; - gl2ps->primitivetoadd = prim; - if(prim->type == GL2PS_IMAGEMAP && prim->data.image->format == GL2PS_IMAGEMAP_VISIBLE){ - prim->culled = 1; - } - else if(!gl2psAddInBspImageTree(prim, &gl2ps->imagetree)){ - prim->culled = 1; - } - else if(prim->type == GL2PS_IMAGEMAP){ - prim->data.image->format = GL2PS_IMAGEMAP_VISIBLE; - } -} - -/* Boundary construction */ - -static void gl2psAddBoundaryInList(GL2PSprimitive *prim, GL2PSlist *list) -{ - GL2PSprimitive *b; - GLshort i; - GL2PSxyz c; - - c[0] = c[1] = c[2] = 0.0F; - for(i = 0; i < prim->numverts; i++){ - c[0] += prim->verts[i].xyz[0]; - c[1] += prim->verts[i].xyz[1]; - } - c[0] /= prim->numverts; - c[1] /= prim->numverts; - - for(i = 0; i < prim->numverts; i++){ - if(prim->boundary & (GLint)pow(2., i)){ - b = (GL2PSprimitive*)gl2psMalloc(sizeof(GL2PSprimitive)); - b->type = GL2PS_LINE; - b->offset = prim->offset; - b->pattern = prim->pattern; - b->factor = prim->factor; - b->culled = prim->culled; - b->width = prim->width; - b->boundary = 0; - b->numverts = 2; - b->verts = (GL2PSvertex*)gl2psMalloc(2 * sizeof(GL2PSvertex)); - -#if 0 /* FIXME: need to work on boundary offset... */ - v[0] = c[0] - prim->verts[i].xyz[0]; - v[1] = c[1] - prim->verts[i].xyz[1]; - v[2] = 0.0F; - norm = gl2psNorm(v); - v[0] /= norm; - v[1] /= norm; - b->verts[0].xyz[0] = prim->verts[i].xyz[0] +0.1*v[0]; - b->verts[0].xyz[1] = prim->verts[i].xyz[1] +0.1*v[1]; - b->verts[0].xyz[2] = prim->verts[i].xyz[2]; - v[0] = c[0] - prim->verts[gl2psGetIndex(i, prim->numverts)].xyz[0]; - v[1] = c[1] - prim->verts[gl2psGetIndex(i, prim->numverts)].xyz[1]; - norm = gl2psNorm(v); - v[0] /= norm; - v[1] /= norm; - b->verts[1].xyz[0] = prim->verts[gl2psGetIndex(i, prim->numverts)].xyz[0] +0.1*v[0]; - b->verts[1].xyz[1] = prim->verts[gl2psGetIndex(i, prim->numverts)].xyz[1] +0.1*v[1]; - b->verts[1].xyz[2] = prim->verts[gl2psGetIndex(i, prim->numverts)].xyz[2]; -#else - b->verts[0].xyz[0] = prim->verts[i].xyz[0]; - b->verts[0].xyz[1] = prim->verts[i].xyz[1]; - b->verts[0].xyz[2] = prim->verts[i].xyz[2]; - b->verts[1].xyz[0] = prim->verts[gl2psGetIndex(i, prim->numverts)].xyz[0]; - b->verts[1].xyz[1] = prim->verts[gl2psGetIndex(i, prim->numverts)].xyz[1]; - b->verts[1].xyz[2] = prim->verts[gl2psGetIndex(i, prim->numverts)].xyz[2]; -#endif - - b->verts[0].rgba[0] = 0.0F; - b->verts[0].rgba[1] = 0.0F; - b->verts[0].rgba[2] = 0.0F; - b->verts[0].rgba[3] = 0.0F; - b->verts[1].rgba[0] = 0.0F; - b->verts[1].rgba[1] = 0.0F; - b->verts[1].rgba[2] = 0.0F; - b->verts[1].rgba[3] = 0.0F; - gl2psListAdd(list, &b); - } - } - -} - -static void gl2psBuildPolygonBoundary(GL2PSbsptree *tree) -{ - GLint i; - GL2PSprimitive *prim; - - if(!tree) return; - gl2psBuildPolygonBoundary(tree->back); - for(i = 0; i < gl2psListNbr(tree->primitives); i++){ - prim = *(GL2PSprimitive**)gl2psListPointer(tree->primitives, i); - if(prim->boundary) gl2psAddBoundaryInList(prim, tree->primitives); - } - gl2psBuildPolygonBoundary(tree->front); -} - -/********************************************************************* - * - * Feedback buffer parser - * - *********************************************************************/ - -static void gl2psAddPolyPrimitive(GLshort type, GLshort numverts, - GL2PSvertex *verts, GLint offset, - GLushort pattern, GLint factor, - GLfloat width, char boundary) -{ - GL2PSprimitive *prim; - - prim = (GL2PSprimitive*)gl2psMalloc(sizeof(GL2PSprimitive)); - prim->type = type; - prim->numverts = numverts; - prim->verts = (GL2PSvertex*)gl2psMalloc(numverts * sizeof(GL2PSvertex)); - memcpy(prim->verts, verts, numverts * sizeof(GL2PSvertex)); - prim->boundary = boundary; - prim->offset = offset; - prim->pattern = pattern; - prim->factor = factor; - prim->width = width; - prim->culled = 0; - - /* FIXME: here we should have an option to split stretched - tris/quads to enhance SIMPLE_SORT */ - - gl2psListAdd(gl2ps->primitives, &prim); -} - -static GLint gl2psGetVertex(GL2PSvertex *v, GLfloat *p) -{ - GLint i; - - v->xyz[0] = p[0]; - v->xyz[1] = p[1]; - v->xyz[2] = p[2]; - - if(gl2ps->colormode == GL_COLOR_INDEX && gl2ps->colorsize > 0){ - i = (GLint)(p[3] + 0.5); - v->rgba[0] = gl2ps->colormap[i][0]; - v->rgba[1] = gl2ps->colormap[i][1]; - v->rgba[2] = gl2ps->colormap[i][2]; - v->rgba[3] = gl2ps->colormap[i][3]; - return 4; - } - else{ - v->rgba[0] = p[3]; - v->rgba[1] = p[4]; - v->rgba[2] = p[5]; - v->rgba[3] = p[6]; - return 7; - } -} - -static void gl2psParseFeedbackBuffer(GLint used) -{ - char flag; - GLushort pattern = 0; - GLboolean boundary; - GLint i, sizeoffloat, count, v, vtot, offset = 0, factor = 0, auxindex = 0; - GLfloat lwidth = 1.0F, psize = 1.0F; - GLfloat *current; - GL2PSvertex vertices[3]; - GL2PSprimitive *prim; - GL2PSimagemap *node; - - current = gl2ps->feedback; - boundary = gl2ps->boundary = GL_FALSE; - - while(used > 0){ - - if(GL_TRUE == boundary) gl2ps->boundary = GL_TRUE; - - switch((GLint)*current){ - case GL_POINT_TOKEN : - current ++; - used --; - i = gl2psGetVertex(&vertices[0], current); - current += i; - used -= i; - gl2psAddPolyPrimitive(GL2PS_POINT, 1, vertices, 0, - pattern, factor, psize, 0); - break; - case GL_LINE_TOKEN : - case GL_LINE_RESET_TOKEN : - current ++; - used --; - i = gl2psGetVertex(&vertices[0], current); - current += i; - used -= i; - i = gl2psGetVertex(&vertices[1], current); - current += i; - used -= i; - gl2psAddPolyPrimitive(GL2PS_LINE, 2, vertices, 0, - pattern, factor, lwidth, 0); - break; - case GL_POLYGON_TOKEN : - count = (GLint)current[1]; - current += 2; - used -= 2; - v = vtot = 0; - while(count > 0 && used > 0){ - i = gl2psGetVertex(&vertices[v], current); - gl2psAdaptVertexForBlending(&vertices[v]); - current += i; - used -= i; - count --; - vtot++; - if(v == 2){ - if(GL_TRUE == boundary){ - if(!count && vtot == 2) flag = 1|2|4; - else if(!count) flag = 2|4; - else if(vtot == 2) flag = 1|2; - else flag = 2; - } - else - flag = 0; - gl2psAddPolyPrimitive(GL2PS_TRIANGLE, 3, vertices, offset, - pattern, factor, 1, flag); - vertices[1] = vertices[2]; - } - else - v ++; - } - break; - case GL_BITMAP_TOKEN : - case GL_DRAW_PIXEL_TOKEN : - case GL_COPY_PIXEL_TOKEN : - current ++; - used --; - i = gl2psGetVertex(&vertices[0], current); - current += i; - used -= i; - break; - case GL_PASS_THROUGH_TOKEN : - switch((GLint)current[1]){ - case GL2PS_BEGIN_OFFSET_TOKEN : offset = 1; break; - case GL2PS_END_OFFSET_TOKEN : offset = 0; break; - case GL2PS_BEGIN_BOUNDARY_TOKEN : boundary = GL_TRUE; break; - case GL2PS_END_BOUNDARY_TOKEN : boundary = GL_FALSE; break; - case GL2PS_END_STIPPLE_TOKEN : pattern = factor = 0; break; - case GL2PS_BEGIN_BLEND_TOKEN : gl2ps->blending = GL_TRUE; break; - case GL2PS_END_BLEND_TOKEN : gl2ps->blending = GL_FALSE; break; - case GL2PS_BEGIN_STIPPLE_TOKEN : - current += 2; - used -= 2; - pattern = (GLushort)current[1]; - current += 2; - used -= 2; - factor = (GLint)current[1]; - break; - case GL2PS_SRC_BLEND_TOKEN : - current += 2; - used -= 2; - gl2ps->blendfunc[0] = (GLint)current[1]; - break; - case GL2PS_DST_BLEND_TOKEN : - current += 2; - used -= 2; - gl2ps->blendfunc[1] = (GLint)current[1]; - break; - case GL2PS_POINT_SIZE_TOKEN : - current += 2; - used -= 2; - psize = current[1]; - break; - case GL2PS_LINE_WIDTH_TOKEN : - current += 2; - used -= 2; - lwidth = current[1]; - break; - case GL2PS_IMAGEMAP_TOKEN : - prim = (GL2PSprimitive *)gl2psMalloc(sizeof(GL2PSprimitive)); - prim->type = GL2PS_IMAGEMAP; - prim->boundary = 0; - prim->numverts = 4; - prim->verts = (GL2PSvertex *)gl2psMalloc(4 * sizeof(GL2PSvertex)); - prim->culled = 0; - prim->offset = 0; - prim->pattern = 0; - prim->factor = 0; - prim->width = 1; - - node = (GL2PSimagemap*)gl2psMalloc(sizeof(GL2PSimagemap)); - node->image = (GL2PSimage*)gl2psMalloc(sizeof(GL2PSimage)); - node->image->type = 0; - node->image->format = 0; - node->image->zoom_x = 1.0F; - node->image->zoom_y = 1.0F; - node->next = NULL; - - if(gl2ps->imagemap_head == NULL) - gl2ps->imagemap_head = node; - else - gl2ps->imagemap_tail->next = node; - gl2ps->imagemap_tail = node; - prim->data.image = node->image; - - current += 2; used -= 2; - i = gl2psGetVertex(&prim->verts[0], ¤t[1]); - current += i; used -= i; - - node->image->width = (GLint)current[2]; - current += 2; used -= 2; - node->image->height = (GLint)current[2]; - prim->verts[0].xyz[0] = prim->verts[0].xyz[0] - (int)(node->image->width / 2) + 0.5F; - prim->verts[0].xyz[1] = prim->verts[0].xyz[1] - (int)(node->image->height / 2) + 0.5F; - for(i = 1; i < 4; i++){ - for(v = 0; v < 3; v++){ - prim->verts[i].xyz[v] = prim->verts[0].xyz[v]; - prim->verts[i].rgba[v] = prim->verts[0].rgba[v]; - } - prim->verts[i].rgba[v] = prim->verts[0].rgba[v]; - } - prim->verts[1].xyz[0] = prim->verts[1].xyz[0] + node->image->width; - prim->verts[2].xyz[0] = prim->verts[1].xyz[0]; - prim->verts[2].xyz[1] = prim->verts[2].xyz[1] + node->image->height; - prim->verts[3].xyz[1] = prim->verts[2].xyz[1]; - - sizeoffloat = sizeof(GLfloat); - v = 2 * sizeoffloat; - vtot = node->image->height + node->image->height * - ((node->image->width - 1) / 8); - node->image->pixels = (GLfloat*)gl2psMalloc(v + vtot); - node->image->pixels[0] = prim->verts[0].xyz[0]; - node->image->pixels[1] = prim->verts[0].xyz[1]; - - for(i = 0; i < vtot; i += sizeoffloat){ - current += 2; used -= 2; - if((vtot - i) >= 4) - memcpy(&(((char*)(node->image->pixels))[i + v]), &(current[2]), sizeoffloat); - else - memcpy(&(((char*)(node->image->pixels))[i + v]), &(current[2]), vtot - i); - } - current++; used--; - gl2psListAdd(gl2ps->primitives, &prim); - break; - case GL2PS_DRAW_PIXELS_TOKEN : - case GL2PS_TEXT_TOKEN : - if(auxindex < gl2psListNbr(gl2ps->auxprimitives)) - gl2psListAdd(gl2ps->primitives, - gl2psListPointer(gl2ps->auxprimitives, auxindex++)); - else - gl2psMsg(GL2PS_ERROR, "Wrong number of auxiliary tokens in buffer"); - break; - } - current += 2; - used -= 2; - break; - default : - gl2psMsg(GL2PS_WARNING, "Unknown token in buffer"); - current ++; - used --; - break; - } - } - - gl2psListReset(gl2ps->auxprimitives); -} - -/********************************************************************* - * - * PostScript routines - * - *********************************************************************/ - -static void gl2psWriteByte(unsigned char byte) -{ - unsigned char h = byte / 16; - unsigned char l = byte % 16; - gl2psPrintf("%x%x", h, l); -} - -static void gl2psPrintPostScriptPixmap(GLfloat x, GLfloat y, GL2PSimage *im) -{ - GLuint nbhex, nbyte, nrgb, nbits; - GLuint row, col, ibyte, icase; - GLfloat dr, dg, db, fgrey; - unsigned char red = 0, green = 0, blue = 0, b, grey; - GLuint width = (GLuint)im->width; - GLuint height = (GLuint)im->height; - - /* FIXME: should we define an option for these? Or just keep the - 8-bit per component case? */ - int greyscale = 0; /* set to 1 to output greyscale image */ - int nbit = 8; /* number of bits per color compoment (2, 4 or 8) */ - - if((width <= 0) || (height <= 0)) return; - - gl2psPrintf("gsave\n"); - gl2psPrintf("%.2f %.2f translate\n", x, y); - gl2psPrintf("%.2f %.2f scale\n", width * im->zoom_x, height * im->zoom_y); - - if(greyscale){ /* greyscale */ - gl2psPrintf("/picstr %d string def\n", width); - gl2psPrintf("%d %d %d\n", width, height, 8); - gl2psPrintf("[ %d 0 0 -%d 0 %d ]\n", width, height, height); - gl2psPrintf("{ currentfile picstr readhexstring pop }\n"); - gl2psPrintf("image\n"); - for(row = 0; row < height; row++){ - for(col = 0; col < width; col++){ - gl2psGetRGB(im, col, row, &dr, &dg, &db); - fgrey = (0.30F * dr + 0.59F * dg + 0.11F * db); - grey = (unsigned char)(255. * fgrey); - gl2psWriteByte(grey); - } - gl2psPrintf("\n"); - } - nbhex = width * height * 2; - gl2psPrintf("%%%% nbhex digit :%d\n", nbhex); - } - else if(nbit == 2){ /* color, 2 bits for r and g and b; rgbs following each other */ - nrgb = width * 3; - nbits = nrgb * nbit; - nbyte = nbits / 8; - if((nbyte * 8) != nbits) nbyte++; - gl2psPrintf("/rgbstr %d string def\n", nbyte); - gl2psPrintf("%d %d %d\n", width, height, nbit); - gl2psPrintf("[ %d 0 0 -%d 0 %d ]\n", width, height, height); - gl2psPrintf("{ currentfile rgbstr readhexstring pop }\n"); - gl2psPrintf("false 3\n"); - gl2psPrintf("colorimage\n"); - for(row = 0; row < height; row++){ - icase = 1; - col = 0; - b = 0; - for(ibyte = 0; ibyte < nbyte; ibyte++){ - if(icase == 1) { - if(col < width) { - gl2psGetRGB(im, col, row, &dr, &dg, &db); - } - else { - dr = dg = db = 0; - } - col++; - red = (unsigned char)(3. * dr); - green = (unsigned char)(3. * dg); - blue = (unsigned char)(3. * db); - b = red; - b = (b<<2) + green; - b = (b<<2) + blue; - if(col < width) { - gl2psGetRGB(im, col, row, &dr, &dg, &db); - } - else { - dr = dg = db = 0; - } - col++; - red = (unsigned char)(3. * dr); - green = (unsigned char)(3. * dg); - blue = (unsigned char)(3. * db); - b = (b<<2) + red; - gl2psWriteByte(b); - b = 0; - icase++; - } - else if(icase == 2) { - b = green; - b = (b<<2) + blue; - if(col < width) { - gl2psGetRGB(im, col, row, &dr, &dg, &db); - } - else { - dr = dg = db = 0; - } - col++; - red = (unsigned char)(3. * dr); - green = (unsigned char)(3. * dg); - blue = (unsigned char)(3. * db); - b = (b<<2) + red; - b = (b<<2) + green; - gl2psWriteByte(b); - b = 0; - icase++; - } - else if(icase == 3) { - b = blue; - if(col < width) { - gl2psGetRGB(im, col, row, &dr, &dg, &db); - } - else { - dr = dg = db = 0; - } - col++; - red = (unsigned char)(3. * dr); - green = (unsigned char)(3. * dg); - blue = (unsigned char)(3. * db); - b = (b<<2) + red; - b = (b<<2) + green; - b = (b<<2) + blue; - gl2psWriteByte(b); - b = 0; - icase = 1; - } - } - gl2psPrintf("\n"); - } - } - else if(nbit == 4){ /* color, 4 bits for r and g and b; rgbs following each other */ - nrgb = width * 3; - nbits = nrgb * nbit; - nbyte = nbits / 8; - if((nbyte * 8) != nbits) nbyte++; - gl2psPrintf("/rgbstr %d string def\n", nbyte); - gl2psPrintf("%d %d %d\n", width, height, nbit); - gl2psPrintf("[ %d 0 0 -%d 0 %d ]\n", width, height, height); - gl2psPrintf("{ currentfile rgbstr readhexstring pop }\n"); - gl2psPrintf("false 3\n"); - gl2psPrintf("colorimage\n"); - for(row = 0; row < height; row++){ - col = 0; - icase = 1; - for(ibyte = 0; ibyte < nbyte; ibyte++){ - if(icase == 1) { - if(col < width) { - gl2psGetRGB(im, col, row, &dr, &dg, &db); - } - else { - dr = dg = db = 0; - } - col++; - red = (unsigned char)(15. * dr); - green = (unsigned char)(15. * dg); - gl2psPrintf("%x%x", red, green); - icase++; - } - else if(icase == 2) { - blue = (unsigned char)(15. * db); - if(col < width) { - gl2psGetRGB(im, col, row, &dr, &dg, &db); - } - else { - dr = dg = db = 0; - } - col++; - red = (unsigned char)(15. * dr); - gl2psPrintf("%x%x", blue, red); - icase++; - } - else if(icase == 3) { - green = (unsigned char)(15. * dg); - blue = (unsigned char)(15. * db); - gl2psPrintf("%x%x", green, blue); - icase = 1; - } - } - gl2psPrintf("\n"); - } - } - else{ /* 8 bit for r and g and b */ - nbyte = width * 3; - gl2psPrintf("/rgbstr %d string def\n", nbyte); - gl2psPrintf("%d %d %d\n", width, height, 8); - gl2psPrintf("[ %d 0 0 -%d 0 %d ]\n", width, height, height); - gl2psPrintf("{ currentfile rgbstr readhexstring pop }\n"); - gl2psPrintf("false 3\n"); - gl2psPrintf("colorimage\n"); - for(row = 0; row < height; row++){ - for(col = 0; col < width; col++){ - gl2psGetRGB(im, col, row, &dr, &dg, &db); - red = (unsigned char)(255. * dr); - gl2psWriteByte(red); - green = (unsigned char)(255. * dg); - gl2psWriteByte(green); - blue = (unsigned char)(255. * db); - gl2psWriteByte(blue); - } - gl2psPrintf("\n"); - } - } - - gl2psPrintf("grestore\n"); -} - -static void gl2psPrintPostScriptImagemap(GLfloat x, GLfloat y, - GLsizei width, GLsizei height, - const unsigned char *imagemap){ - int i, size; - - if((width <= 0) || (height <= 0)) return; - - size = height + height * (width - 1) / 8; - - gl2psPrintf("gsave\n"); - gl2psPrintf("%.2f %.2f translate\n", x, y); - gl2psPrintf("%d %d scale\n%d %d\ntrue\n", width, height,width, height); - gl2psPrintf("[ %d 0 0 -%d 0 %d ] {<", width, height); - for(i = 0; i < size; i++){ - gl2psWriteByte(*imagemap); - imagemap++; - } - gl2psPrintf(">} imagemask\ngrestore\n"); -} - -static void gl2psPrintPostScriptHeader(void) -{ - time_t now; - - /* Since compression is not part of the PostScript standard, - compressed PostScript files are just gzipped PostScript files - ("ps.gz" or "eps.gz") */ - gl2psPrintGzipHeader(); - - time(&now); - - if(gl2ps->format == GL2PS_PS){ - gl2psPrintf("%%!PS-Adobe-3.0\n"); - } - else{ - gl2psPrintf("%%!PS-Adobe-3.0 EPSF-3.0\n"); - } - - gl2psPrintf("%%%%Title: %s\n" - "%%%%Creator: GL2PS %d.%d.%d%s, %s\n" - "%%%%For: %s\n" - "%%%%CreationDate: %s" - "%%%%LanguageLevel: 3\n" - "%%%%DocumentData: Clean7Bit\n" - "%%%%Pages: 1\n", - gl2ps->title, GL2PS_MAJOR_VERSION, GL2PS_MINOR_VERSION, - GL2PS_PATCH_VERSION, GL2PS_EXTRA_VERSION, GL2PS_COPYRIGHT, - gl2ps->producer, ctime(&now)); - - if(gl2ps->format == GL2PS_PS){ - gl2psPrintf("%%%%Orientation: %s\n" - "%%%%DocumentMedia: Default %d %d 0 () ()\n", - (gl2ps->options & GL2PS_LANDSCAPE) ? "Landscape" : "Portrait", - (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[3] : - (int)gl2ps->viewport[2], - (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[2] : - (int)gl2ps->viewport[3]); - } - - gl2psPrintf("%%%%BoundingBox: %d %d %d %d\n" - "%%%%EndComments\n", - (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[1] : - (int)gl2ps->viewport[0], - (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[0] : - (int)gl2ps->viewport[1], - (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[3] : - (int)gl2ps->viewport[2], - (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[2] : - (int)gl2ps->viewport[3]); - - /* RGB color: r g b C (replace C by G in output to change from rgb to gray) - Grayscale: r g b G - Font choose: size fontname FC - Text string: (string) x y size fontname S?? - Rotated text string: (string) angle x y size fontname S??R - Point primitive: x y size P - Line width: width W - Line start: x y LS - Line joining last point: x y L - Line end: x y LE - Flat-shaded triangle: x3 y3 x2 y2 x1 y1 T - Smooth-shaded triangle: x3 y3 r3 g3 b3 x2 y2 r2 g2 b2 x1 y1 r1 g1 b1 ST */ - - gl2psPrintf("%%%%BeginProlog\n" - "/gl2psdict 64 dict def gl2psdict begin\n" - "0 setlinecap 0 setlinejoin\n" - "/tryPS3shading %s def %% set to false to force subdivision\n" - "/rThreshold %g def %% red component subdivision threshold\n" - "/gThreshold %g def %% green component subdivision threshold\n" - "/bThreshold %g def %% blue component subdivision threshold\n", - (gl2ps->options & GL2PS_NO_PS3_SHADING) ? "false" : "true", - gl2ps->threshold[0], gl2ps->threshold[1], gl2ps->threshold[2]); - - gl2psPrintf("/BD { bind def } bind def\n" - "/C { setrgbcolor } BD\n" - "/G { 0.082 mul exch 0.6094 mul add exch 0.3086 mul add neg 1.0 add setgray } BD\n" - "/W { setlinewidth } BD\n"); - - gl2psPrintf("/FC { findfont exch /SH exch def SH scalefont setfont } BD\n" - "/SW { dup stringwidth pop } BD\n" - "/S { FC moveto show } BD\n" - "/SBC{ FC moveto SW -2 div 0 rmoveto show } BD\n" - "/SBR{ FC moveto SW neg 0 rmoveto show } BD\n" - "/SCL{ FC moveto 0 SH -2 div rmoveto show } BD\n" - "/SCC{ FC moveto SW -2 div SH -2 div rmoveto show } BD\n" - "/SCR{ FC moveto SW neg SH -2 div rmoveto show } BD\n" - "/STL{ FC moveto 0 SH neg rmoveto show } BD\n" - "/STC{ FC moveto SW -2 div SH neg rmoveto show } BD\n" - "/STR{ FC moveto SW neg SH neg rmoveto show } BD\n"); - - /* rotated text routines: same nameanem with R appended */ - - gl2psPrintf("/FCT { FC translate 0 0 } BD\n" - "/SR { gsave FCT moveto rotate show grestore } BD\n" - "/SBCR{ gsave FCT moveto rotate SW -2 div 0 rmoveto show grestore } BD\n" - "/SBRR{ gsave FCT moveto rotate SW neg 0 rmoveto show grestore } BD\n" - "/SCLR{ gsave FCT moveto rotate 0 SH -2 div rmoveto show grestore} BD\n"); - gl2psPrintf("/SCCR{ gsave FCT moveto rotate SW -2 div SH -2 div rmoveto show grestore} BD\n" - "/SCRR{ gsave FCT moveto rotate SW neg SH -2 div rmoveto show grestore} BD\n" - "/STLR{ gsave FCT moveto rotate 0 SH neg rmoveto show grestore } BD\n" - "/STCR{ gsave FCT moveto rotate SW -2 div SH neg rmoveto show grestore } BD\n" - "/STRR{ gsave FCT moveto rotate SW neg SH neg rmoveto show grestore } BD\n"); - - gl2psPrintf("/P { newpath 0.0 360.0 arc closepath fill } BD\n" - "/LS { newpath moveto } BD\n" - "/L { lineto } BD\n" - "/LE { lineto stroke } BD\n" - "/T { newpath moveto lineto lineto closepath fill } BD\n"); - - /* Smooth-shaded triangle with PostScript level 3 shfill operator: - x3 y3 r3 g3 b3 x2 y2 r2 g2 b2 x1 y1 r1 g1 b1 STshfill */ - - gl2psPrintf("/STshfill {\n" - " /b1 exch def /g1 exch def /r1 exch def /y1 exch def /x1 exch def\n" - " /b2 exch def /g2 exch def /r2 exch def /y2 exch def /x2 exch def\n" - " /b3 exch def /g3 exch def /r3 exch def /y3 exch def /x3 exch def\n" - " gsave << /ShadingType 4 /ColorSpace [/DeviceRGB]\n" - " /DataSource [ 0 x1 y1 r1 g1 b1 0 x2 y2 r2 g2 b2 0 x3 y3 r3 g3 b3 ] >>\n" - " shfill grestore } BD\n"); - - /* Flat-shaded triangle with middle color: - x3 y3 r3 g3 b3 x2 y2 r2 g2 b2 x1 y1 r1 g1 b1 Tm */ - - gl2psPrintf(/* stack : x3 y3 r3 g3 b3 x2 y2 r2 g2 b2 x1 y1 r1 g1 b1 */ - "/Tm { 3 -1 roll 8 -1 roll 13 -1 roll add add 3 div\n" /* r = (r1+r2+r3)/3 */ - /* stack : x3 y3 g3 b3 x2 y2 g2 b2 x1 y1 g1 b1 r */ - " 3 -1 roll 7 -1 roll 11 -1 roll add add 3 div\n" /* g = (g1+g2+g3)/3 */ - /* stack : x3 y3 b3 x2 y2 b2 x1 y1 b1 r g b */ - " 3 -1 roll 6 -1 roll 9 -1 roll add add 3 div" /* b = (b1+b2+b3)/3 */ - /* stack : x3 y3 x2 y2 x1 y1 r g b */ - " C T } BD\n"); - - /* Split triangle in four sub-triangles (at sides middle points) and call the - STnoshfill procedure on each, interpolating the colors in RGB space: - x3 y3 r3 g3 b3 x2 y2 r2 g2 b2 x1 y1 r1 g1 b1 STsplit - (in procedure comments key: (Vi) = xi yi ri gi bi) */ - - gl2psPrintf("/STsplit {\n" - " 4 index 15 index add 0.5 mul\n" /* x13 = (x1+x3)/2 */ - " 4 index 15 index add 0.5 mul\n" /* y13 = (y1+y3)/2 */ - " 4 index 15 index add 0.5 mul\n" /* r13 = (r1+r3)/2 */ - " 4 index 15 index add 0.5 mul\n" /* g13 = (g1+g3)/2 */ - " 4 index 15 index add 0.5 mul\n" /* b13 = (b1+b3)/2 */ - " 5 copy 5 copy 25 15 roll\n"); - - /* at his point, stack = (V3) (V13) (V13) (V13) (V2) (V1) */ - - gl2psPrintf(" 9 index 30 index add 0.5 mul\n" /* x23 = (x2+x3)/2 */ - " 9 index 30 index add 0.5 mul\n" /* y23 = (y2+y3)/2 */ - " 9 index 30 index add 0.5 mul\n" /* r23 = (r2+r3)/2 */ - " 9 index 30 index add 0.5 mul\n" /* g23 = (g2+g3)/2 */ - " 9 index 30 index add 0.5 mul\n" /* b23 = (b2+b3)/2 */ - " 5 copy 5 copy 35 5 roll 25 5 roll 15 5 roll\n"); - - /* stack = (V3) (V13) (V23) (V13) (V23) (V13) (V23) (V2) (V1) */ - - gl2psPrintf(" 4 index 10 index add 0.5 mul\n" /* x12 = (x1+x2)/2 */ - " 4 index 10 index add 0.5 mul\n" /* y12 = (y1+y2)/2 */ - " 4 index 10 index add 0.5 mul\n" /* r12 = (r1+r2)/2 */ - " 4 index 10 index add 0.5 mul\n" /* g12 = (g1+g2)/2 */ - " 4 index 10 index add 0.5 mul\n" /* b12 = (b1+b2)/2 */ - " 5 copy 5 copy 40 5 roll 25 5 roll 15 5 roll 25 5 roll\n"); - - /* stack = (V3) (V13) (V23) (V13) (V12) (V23) (V13) (V1) (V12) (V23) (V12) (V2) */ - - gl2psPrintf(" STnoshfill STnoshfill STnoshfill STnoshfill } BD\n"); - - /* Gouraud shaded triangle using recursive subdivision until the difference - between corner colors does not exceed the thresholds: - x3 y3 r3 g3 b3 x2 y2 r2 g2 b2 x1 y1 r1 g1 b1 STnoshfill */ - - gl2psPrintf("/STnoshfill {\n" - " 2 index 8 index sub abs rThreshold gt\n" /* |r1-r2|>rth */ - " { STsplit }\n" - " { 1 index 7 index sub abs gThreshold gt\n" /* |g1-g2|>gth */ - " { STsplit }\n" - " { dup 6 index sub abs bThreshold gt\n" /* |b1-b2|>bth */ - " { STsplit }\n" - " { 2 index 13 index sub abs rThreshold gt\n" /* |r1-r3|>rht */ - " { STsplit }\n" - " { 1 index 12 index sub abs gThreshold gt\n" /* |g1-g3|>gth */ - " { STsplit }\n" - " { dup 11 index sub abs bThreshold gt\n" /* |b1-b3|>bth */ - " { STsplit }\n" - " { 7 index 13 index sub abs rThreshold gt\n"); /* |r2-r3|>rht */ - gl2psPrintf(" { STsplit }\n" - " { 6 index 12 index sub abs gThreshold gt\n" /* |g2-g3|>gth */ - " { STsplit }\n" - " { 5 index 11 index sub abs bThreshold gt\n" /* |b2-b3|>bth */ - " { STsplit }\n" - " { Tm }\n" /* all colors sufficiently similar */ - " ifelse }\n" - " ifelse }\n" - " ifelse }\n" - " ifelse }\n" - " ifelse }\n" - " ifelse }\n" - " ifelse }\n" - " ifelse }\n" - " ifelse } BD\n"); - - gl2psPrintf("tryPS3shading\n" - "{ /shfill where\n" - " { /ST { STshfill } BD }\n" - " { /ST { STnoshfill } BD }\n" - " ifelse }\n" - "{ /ST { STnoshfill } BD }\n" - "ifelse\n"); - - gl2psPrintf("end\n" - "%%%%EndProlog\n" - "%%%%BeginSetup\n" - "/DeviceRGB setcolorspace\n" - "gl2psdict begin\n" - "%%%%EndSetup\n" - "%%%%Page: 1 1\n" - "%%%%BeginPageSetup\n"); - - if(gl2ps->options & GL2PS_LANDSCAPE){ - gl2psPrintf("%d 0 translate 90 rotate\n", - (int)gl2ps->viewport[3]); - } - - gl2psPrintf("%%%%EndPageSetup\n" - "mark\n" - "gsave\n" - "1.0 1.0 scale\n"); - - if(gl2ps->options & GL2PS_DRAW_BACKGROUND){ - gl2psPrintf("%g %g %g C\n" - "newpath %d %d moveto %d %d lineto %d %d lineto %d %d lineto\n" - "closepath fill\n", - gl2ps->bgcolor[0], gl2ps->bgcolor[1], gl2ps->bgcolor[2], - (int)gl2ps->viewport[0], (int)gl2ps->viewport[1], (int)gl2ps->viewport[2], - (int)gl2ps->viewport[1], (int)gl2ps->viewport[2], (int)gl2ps->viewport[3], - (int)gl2ps->viewport[0], (int)gl2ps->viewport[3]); - } -} - -static void gl2psPrintPostScriptColor(GL2PSrgba rgba) -{ - if(!gl2psSameColor(gl2ps->lastrgba, rgba)){ - gl2psSetLastColor(rgba); - gl2psPrintf("%g %g %g C\n", rgba[0], rgba[1], rgba[2]); - } -} - -static void gl2psResetPostScriptColor(void) -{ - gl2ps->lastrgba[0] = gl2ps->lastrgba[1] = gl2ps->lastrgba[2] = -1.; -} - -static void gl2psEndPostScriptLine(void) -{ - int i; - if(gl2ps->lastvertex.rgba[0] >= 0.){ - gl2psPrintf("%g %g LE\n", gl2ps->lastvertex.xyz[0], gl2ps->lastvertex.xyz[1]); - for(i = 0; i < 3; i++) - gl2ps->lastvertex.xyz[i] = -1.; - for(i = 0; i < 4; i++) - gl2ps->lastvertex.rgba[i] = -1.; - } -} - -static void gl2psParseStipplePattern(GLushort pattern, GLint factor, - int *nb, int array[10]) -{ - int i, n; - int on[8] = {0, 0, 0, 0, 0, 0, 0, 0}; - int off[8] = {0, 0, 0, 0, 0, 0, 0, 0}; - char tmp[16]; - - /* extract the 16 bits from the OpenGL stipple pattern */ - for(n = 15; n >= 0; n--){ - tmp[n] = (char)(pattern & 0x01); - pattern >>= 1; - } - /* compute the on/off pixel sequence */ - n = 0; - for(i = 0; i < 8; i++){ - while(n < 16 && !tmp[n]){ off[i]++; n++; } - while(n < 16 && tmp[n]){ on[i]++; n++; } - if(n >= 15){ i++; break; } - } - - /* store the on/off array from right to left, starting with off - pixels. The PostScript specification allows for at most 11 - elements in the on/off array, so we limit ourselves to 5 on/off - couples (our longest possible array is thus [on4 off4 on3 off3 - on2 off2 on1 off1 on0 off0]) */ - *nb = 0; - for(n = i - 1; n >= 0; n--){ - array[(*nb)++] = factor * on[n]; - array[(*nb)++] = factor * off[n]; - if(*nb == 10) break; - } -} - -static int gl2psPrintPostScriptDash(GLushort pattern, GLint factor, const char *str) -{ - int len = 0, i, n, array[10]; - - if(pattern == gl2ps->lastpattern && factor == gl2ps->lastfactor) - return 0; - - gl2ps->lastpattern = pattern; - gl2ps->lastfactor = factor; - - if(!pattern || !factor){ - /* solid line */ - len += gl2psPrintf("[] 0 %s\n", str); - } - else{ - gl2psParseStipplePattern(pattern, factor, &n, array); - len += gl2psPrintf("["); - for(i = 0; i < n; i++){ - if(i) len += gl2psPrintf(" "); - len += gl2psPrintf("%d", array[i]); - } - len += gl2psPrintf("] 0 %s\n", str); - } - - return len; -} - -static void gl2psPrintPostScriptPrimitive(void *data) -{ - int newline; - GL2PSprimitive *prim; - - prim = *(GL2PSprimitive**)data; - - if((gl2ps->options & GL2PS_OCCLUSION_CULL) && prim->culled) return; - - /* Every effort is made to draw lines as connected segments (i.e., - using a single PostScript path): this is the only way to get nice - line joins and to not restart the stippling for every line - segment. So if the primitive to print is not a line we must first - finish the current line (if any): */ - if(prim->type != GL2PS_LINE) gl2psEndPostScriptLine(); - - switch(prim->type){ - case GL2PS_POINT : - gl2psPrintPostScriptColor(prim->verts[0].rgba); - gl2psPrintf("%g %g %g P\n", - prim->verts[0].xyz[0], prim->verts[0].xyz[1], 0.5 * prim->width); - break; - case GL2PS_LINE : - if(!gl2psSamePosition(gl2ps->lastvertex.xyz, prim->verts[0].xyz) || - !gl2psSameColor(gl2ps->lastrgba, prim->verts[0].rgba) || - gl2ps->lastlinewidth != prim->width || - gl2ps->lastpattern != prim->pattern || - gl2ps->lastfactor != prim->factor){ - /* End the current line if the new segment does not start where - the last one ended, or if the color, the width or the - stippling have changed (multi-stroking lines with changing - colors is necessary until we use /shfill for lines; - unfortunately this means that at the moment we can screw up - line stippling for smooth-shaded lines) */ - gl2psEndPostScriptLine(); - newline = 1; - } - else{ - newline = 0; - } - if(gl2ps->lastlinewidth != prim->width){ - gl2ps->lastlinewidth = prim->width; - gl2psPrintf("%g W\n", gl2ps->lastlinewidth); - } - gl2psPrintPostScriptDash(prim->pattern, prim->factor, "setdash"); - gl2psPrintPostScriptColor(prim->verts[0].rgba); - gl2psPrintf("%g %g %s\n", prim->verts[0].xyz[0], prim->verts[0].xyz[1], - newline ? "LS" : "L"); - gl2ps->lastvertex = prim->verts[1]; - break; - case GL2PS_TRIANGLE : - if(!gl2psVertsSameColor(prim)){ - gl2psResetPostScriptColor(); - gl2psPrintf("%g %g %g %g %g %g %g %g %g %g %g %g %g %g %g ST\n", - prim->verts[2].xyz[0], prim->verts[2].xyz[1], - prim->verts[2].rgba[0], prim->verts[2].rgba[1], - prim->verts[2].rgba[2], prim->verts[1].xyz[0], - prim->verts[1].xyz[1], prim->verts[1].rgba[0], - prim->verts[1].rgba[1], prim->verts[1].rgba[2], - prim->verts[0].xyz[0], prim->verts[0].xyz[1], - prim->verts[0].rgba[0], prim->verts[0].rgba[1], - prim->verts[0].rgba[2]); - } - else{ - gl2psPrintPostScriptColor(prim->verts[0].rgba); - gl2psPrintf("%g %g %g %g %g %g T\n", - prim->verts[2].xyz[0], prim->verts[2].xyz[1], - prim->verts[1].xyz[0], prim->verts[1].xyz[1], - prim->verts[0].xyz[0], prim->verts[0].xyz[1]); - } - break; - case GL2PS_QUADRANGLE : - gl2psMsg(GL2PS_WARNING, "There should not be any quad left to print"); - break; - case GL2PS_PIXMAP : - gl2psPrintPostScriptPixmap(prim->verts[0].xyz[0], prim->verts[0].xyz[1], - prim->data.image); - break; - case GL2PS_IMAGEMAP : - if(prim->data.image->type != GL2PS_IMAGEMAP_WRITTEN){ - gl2psPrintPostScriptColor(prim->verts[0].rgba); - gl2psPrintPostScriptImagemap(prim->data.image->pixels[0], - prim->data.image->pixels[1], - prim->data.image->width, prim->data.image->height, - (const unsigned char*)(&(prim->data.image->pixels[2]))); - prim->data.image->type = GL2PS_IMAGEMAP_WRITTEN; - } - break; - case GL2PS_TEXT : - gl2psPrintPostScriptColor(prim->verts[0].rgba); - gl2psPrintf("(%s) ", prim->data.text->str); - if(prim->data.text->angle) - gl2psPrintf("%g ", prim->data.text->angle); - gl2psPrintf("%g %g %d /%s ", - prim->verts[0].xyz[0], prim->verts[0].xyz[1], - prim->data.text->fontsize, prim->data.text->fontname); - switch(prim->data.text->alignment){ - case GL2PS_TEXT_C: - gl2psPrintf(prim->data.text->angle ? "SCCR\n" : "SCC\n"); - break; - case GL2PS_TEXT_CL: - gl2psPrintf(prim->data.text->angle ? "SCLR\n" : "SCL\n"); - break; - case GL2PS_TEXT_CR: - gl2psPrintf(prim->data.text->angle ? "SCRR\n" : "SCR\n"); - break; - case GL2PS_TEXT_B: - gl2psPrintf(prim->data.text->angle ? "SBCR\n" : "SBC\n"); - break; - case GL2PS_TEXT_BR: - gl2psPrintf(prim->data.text->angle ? "SBRR\n" : "SBR\n"); - break; - case GL2PS_TEXT_T: - gl2psPrintf(prim->data.text->angle ? "STCR\n" : "STC\n"); - break; - case GL2PS_TEXT_TL: - gl2psPrintf(prim->data.text->angle ? "STLR\n" : "STL\n"); - break; - case GL2PS_TEXT_TR: - gl2psPrintf(prim->data.text->angle ? "STRR\n" : "STR\n"); - break; - case GL2PS_TEXT_BL: - default: - gl2psPrintf(prim->data.text->angle ? "SR\n" : "S\n"); - break; - } - break; - case GL2PS_SPECIAL : - /* alignment contains the format for which the special output text - is intended */ - if(prim->data.text->alignment == GL2PS_PS || - prim->data.text->alignment == GL2PS_EPS) - gl2psPrintf("%s\n", prim->data.text->str); - break; - default : - break; - } -} - -static void gl2psPrintPostScriptFooter(void) -{ - gl2psPrintf("grestore\n" - "showpage\n" - "cleartomark\n" - "%%%%PageTrailer\n" - "%%%%Trailer\n" - "end\n" - "%%%%EOF\n"); - - gl2psPrintGzipFooter(); -} - -static void gl2psPrintPostScriptBeginViewport(GLint viewport[4]) -{ - GLint index; - GLfloat rgba[4]; - int x = viewport[0], y = viewport[1], w = viewport[2], h = viewport[3]; - - glRenderMode(GL_FEEDBACK); - - if(gl2ps->header){ - gl2psPrintPostScriptHeader(); - gl2ps->header = GL_FALSE; - } - - gl2psPrintf("gsave\n" - "1.0 1.0 scale\n"); - - if(gl2ps->options & GL2PS_DRAW_BACKGROUND){ - if(gl2ps->colormode == GL_RGBA || gl2ps->colorsize == 0){ - glGetFloatv(GL_COLOR_CLEAR_VALUE, rgba); - } - else{ - glGetIntegerv(GL_INDEX_CLEAR_VALUE, &index); - rgba[0] = gl2ps->colormap[index][0]; - rgba[1] = gl2ps->colormap[index][1]; - rgba[2] = gl2ps->colormap[index][2]; - rgba[3] = 1.0F; - } - gl2psPrintf("%g %g %g C\n" - "newpath %d %d moveto %d %d lineto %d %d lineto %d %d lineto\n" - "closepath fill\n", - rgba[0], rgba[1], rgba[2], - x, y, x+w, y, x+w, y+h, x, y+h); - } - - gl2psPrintf("newpath %d %d moveto %d %d lineto %d %d lineto %d %d lineto\n" - "closepath clip\n", - x, y, x+w, y, x+w, y+h, x, y+h); - -} - -static GLint gl2psPrintPostScriptEndViewport(void) -{ - GLint res; - - res = gl2psPrintPrimitives(); - gl2psPrintf("grestore\n"); - return res; -} - -static void gl2psPrintPostScriptFinalPrimitive(void) -{ - /* End any remaining line, if any */ - gl2psEndPostScriptLine(); -} - -/* definition of the PostScript and Encapsulated PostScript backends */ - -static GL2PSbackend gl2psPS = { - gl2psPrintPostScriptHeader, - gl2psPrintPostScriptFooter, - gl2psPrintPostScriptBeginViewport, - gl2psPrintPostScriptEndViewport, - gl2psPrintPostScriptPrimitive, - gl2psPrintPostScriptFinalPrimitive, - "ps", - "Postscript" -}; - -static GL2PSbackend gl2psEPS = { - gl2psPrintPostScriptHeader, - gl2psPrintPostScriptFooter, - gl2psPrintPostScriptBeginViewport, - gl2psPrintPostScriptEndViewport, - gl2psPrintPostScriptPrimitive, - gl2psPrintPostScriptFinalPrimitive, - "eps", - "Encapsulated Postscript" -}; - -/********************************************************************* - * - * LaTeX routines - * - *********************************************************************/ - -static void gl2psPrintTeXHeader(void) -{ - char name[256]; - time_t now; - int i; - - if(gl2ps->filename && strlen(gl2ps->filename) < 256){ - for(i = (int)strlen(gl2ps->filename) - 1; i >= 0; i--){ - if(gl2ps->filename[i] == '.'){ - strncpy(name, gl2ps->filename, i); - name[i] = '\0'; - break; - } - } - if(i <= 0) strcpy(name, gl2ps->filename); - } - else{ - strcpy(name, "untitled"); - } - - time(&now); - - fprintf(gl2ps->stream, - "%% Title: %s\n" - "%% Creator: GL2PS %d.%d.%d%s, %s\n" - "%% For: %s\n" - "%% CreationDate: %s", - gl2ps->title, GL2PS_MAJOR_VERSION, GL2PS_MINOR_VERSION, - GL2PS_PATCH_VERSION, GL2PS_EXTRA_VERSION, GL2PS_COPYRIGHT, - gl2ps->producer, ctime(&now)); - - fprintf(gl2ps->stream, - "\\setlength{\\unitlength}{1pt}\n" - "\\begin{picture}(0,0)\n" - "\\includegraphics{%s}\n" - "\\end{picture}%%\n" - "%s\\begin{picture}(%d,%d)(0,0)\n", - name, (gl2ps->options & GL2PS_LANDSCAPE) ? "\\rotatebox{90}{" : "", - (int)gl2ps->viewport[2], (int)gl2ps->viewport[3]); -} - -static void gl2psPrintTeXPrimitive(void *data) -{ - GL2PSprimitive *prim; - - prim = *(GL2PSprimitive**)data; - - switch(prim->type){ - case GL2PS_TEXT : - fprintf(gl2ps->stream, "\\fontsize{%d}{0}\n\\selectfont", - prim->data.text->fontsize); - fprintf(gl2ps->stream, "\\put(%g,%g)", - prim->verts[0].xyz[0], prim->verts[0].xyz[1]); - if(prim->data.text->angle) - fprintf(gl2ps->stream, "{\\rotatebox{%g}", prim->data.text->angle); - fprintf(gl2ps->stream, "{\\makebox(0,0)"); - switch(prim->data.text->alignment){ - case GL2PS_TEXT_C: - fprintf(gl2ps->stream, "{"); - break; - case GL2PS_TEXT_CL: - fprintf(gl2ps->stream, "[l]{"); - break; - case GL2PS_TEXT_CR: - fprintf(gl2ps->stream, "[r]{"); - break; - case GL2PS_TEXT_B: - fprintf(gl2ps->stream, "[b]{"); - break; - case GL2PS_TEXT_BR: - fprintf(gl2ps->stream, "[br]{"); - break; - case GL2PS_TEXT_T: - fprintf(gl2ps->stream, "[t]{"); - break; - case GL2PS_TEXT_TL: - fprintf(gl2ps->stream, "[tl]{"); - break; - case GL2PS_TEXT_TR: - fprintf(gl2ps->stream, "[tr]{"); - break; - case GL2PS_TEXT_BL: - default: - fprintf(gl2ps->stream, "[bl]{"); - break; - } - fprintf(gl2ps->stream, "\\textcolor[rgb]{%g,%g,%g}{{%s}}", - prim->verts[0].rgba[0], prim->verts[0].rgba[1], prim->verts[0].rgba[2], - prim->data.text->str); - if(prim->data.text->angle) - fprintf(gl2ps->stream, "}"); - fprintf(gl2ps->stream, "}}\n"); - break; - case GL2PS_SPECIAL : - /* alignment contains the format for which the special output text - is intended */ - if (prim->data.text->alignment == GL2PS_TEX) - fprintf(gl2ps->stream, "%s\n", prim->data.text->str); - break; - default : - break; - } -} - -static void gl2psPrintTeXFooter(void) -{ - fprintf(gl2ps->stream, "\\end{picture}%s\n", - (gl2ps->options & GL2PS_LANDSCAPE) ? "}" : ""); -} - -static void gl2psPrintTeXBeginViewport(GLint viewport[4]) -{ - (void) viewport; /* not used */ - glRenderMode(GL_FEEDBACK); - - if(gl2ps->header){ - gl2psPrintTeXHeader(); - gl2ps->header = GL_FALSE; - } -} - -static GLint gl2psPrintTeXEndViewport(void) -{ - return gl2psPrintPrimitives(); -} - -static void gl2psPrintTeXFinalPrimitive(void) -{ -} - -/* definition of the LaTeX backend */ - -static GL2PSbackend gl2psTEX = { - gl2psPrintTeXHeader, - gl2psPrintTeXFooter, - gl2psPrintTeXBeginViewport, - gl2psPrintTeXEndViewport, - gl2psPrintTeXPrimitive, - gl2psPrintTeXFinalPrimitive, - "tex", - "LaTeX text" -}; - -/********************************************************************* - * - * PDF routines - * - *********************************************************************/ - -static int gl2psPrintPDFCompressorType(void) -{ -#if defined(GL2PS_HAVE_ZLIB) - if(gl2ps->options & GL2PS_COMPRESS){ - return fprintf(gl2ps->stream, "/Filter [/FlateDecode]\n"); - } -#endif - return 0; -} - -static int gl2psPrintPDFStrokeColor(GL2PSrgba rgba) -{ - int i, offs = 0; - - gl2psSetLastColor(rgba); - for(i = 0; i < 3; ++i){ - if(GL2PS_ZERO(rgba[i])) - offs += gl2psPrintf("%.0f ", 0.); - else if(rgba[i] < 1e-4 || rgba[i] > 1e6) /* avoid %e formatting */ - offs += gl2psPrintf("%f ", rgba[i]); - else - offs += gl2psPrintf("%g ", rgba[i]); - } - offs += gl2psPrintf("RG\n"); - return offs; -} - -static int gl2psPrintPDFFillColor(GL2PSrgba rgba) -{ - int i, offs = 0; - - for(i = 0; i < 3; ++i){ - if(GL2PS_ZERO(rgba[i])) - offs += gl2psPrintf("%.0f ", 0.); - else if(rgba[i] < 1e-4 || rgba[i] > 1e6) /* avoid %e formatting */ - offs += gl2psPrintf("%f ", rgba[i]); - else - offs += gl2psPrintf("%g ", rgba[i]); - } - offs += gl2psPrintf("rg\n"); - return offs; -} - -static int gl2psPrintPDFLineWidth(GLfloat lw) -{ - if(GL2PS_ZERO(lw)) - return gl2psPrintf("%.0f w\n", 0.); - else if(lw < 1e-4 || lw > 1e6) /* avoid %e formatting */ - return gl2psPrintf("%f w\n", lw); - else - return gl2psPrintf("%g w\n", lw); -} - -static void gl2psPutPDFText(GL2PSstring *text, int cnt, GLfloat x, GLfloat y) -{ - GLfloat rad, crad, srad; - - if(text->angle == 0.0F){ - gl2ps->streamlength += gl2psPrintf - ("BT\n" - "/F%d %d Tf\n" - "%f %f Td\n" - "(%s) Tj\n" - "ET\n", - cnt, text->fontsize, x, y, text->str); - } - else{ - rad = (GLfloat)(M_PI * text->angle / 180.0F); - srad = (GLfloat)sin(rad); - crad = (GLfloat)cos(rad); - gl2ps->streamlength += gl2psPrintf - ("BT\n" - "/F%d %d Tf\n" - "%f %f %f %f %f %f Tm\n" - "(%s) Tj\n" - "ET\n", - cnt, text->fontsize, crad, srad, -srad, crad, x, y, text->str); - } -} - -static void gl2psPutPDFImage(GL2PSimage *image, int cnt, GLfloat x, GLfloat y) -{ - gl2ps->streamlength += gl2psPrintf - ("q\n" - "%d 0 0 %d %f %f cm\n" - "/Im%d Do\n" - "Q\n", - (int)image->width, (int)image->height, x, y, cnt); -} - -static void gl2psPDFstacksInit(void) -{ - gl2ps->objects_stack = 7 /* FIXED_XREF_ENTRIES */ + 1; - gl2ps->extgs_stack = 0; - gl2ps->font_stack = 0; - gl2ps->im_stack = 0; - gl2ps->trgroupobjects_stack = 0; - gl2ps->shader_stack = 0; - gl2ps->mshader_stack = 0; -} - -static void gl2psPDFgroupObjectInit(GL2PSpdfgroup *gro) -{ - if(!gro) - return; - - gro->ptrlist = NULL; - gro->fontno = gro->gsno = gro->imno = gro->maskshno = gro->shno - = gro->trgroupno = gro->fontobjno = gro->imobjno = gro->shobjno - = gro->maskshobjno = gro->gsobjno = gro->trgroupobjno = -1; -} - -/* Build up group objects and assign name and object numbers */ - -static void gl2psPDFgroupListInit(void) -{ - int i; - GL2PSprimitive *p = NULL; - GL2PSpdfgroup gro; - int lasttype = GL2PS_NO_TYPE; - GL2PSrgba lastrgba = {-1.0F, -1.0F, -1.0F, -1.0F}; - GLushort lastpattern = 0; - GLint lastfactor = 0; - GLfloat lastwidth = 1; - GL2PStriangle lastt, tmpt; - int lastTriangleWasNotSimpleWithSameColor = 0; - - if(!gl2ps->pdfprimlist) - return; - - gl2ps->pdfgrouplist = gl2psListCreate(500, 500, sizeof(GL2PSpdfgroup)); - gl2psInitTriangle(&lastt); - - for(i = 0; i < gl2psListNbr(gl2ps->pdfprimlist); ++i){ - p = *(GL2PSprimitive**)gl2psListPointer(gl2ps->pdfprimlist, i); - switch(p->type){ - case GL2PS_PIXMAP: - gl2psPDFgroupObjectInit(&gro); - gro.ptrlist = gl2psListCreate(1, 2, sizeof(GL2PSprimitive*)); - gro.imno = gl2ps->im_stack++; - gl2psListAdd(gro.ptrlist, &p); - gl2psListAdd(gl2ps->pdfgrouplist, &gro); - break; - case GL2PS_TEXT: - gl2psPDFgroupObjectInit(&gro); - gro.ptrlist = gl2psListCreate(1, 2, sizeof(GL2PSprimitive*)); - gro.fontno = gl2ps->font_stack++; - gl2psListAdd(gro.ptrlist, &p); - gl2psListAdd(gl2ps->pdfgrouplist, &gro); - break; - case GL2PS_LINE: - if(lasttype != p->type || lastwidth != p->width || - lastpattern != p->pattern || lastfactor != p->factor || - !gl2psSameColor(p->verts[0].rgba, lastrgba)){ - gl2psPDFgroupObjectInit(&gro); - gro.ptrlist = gl2psListCreate(1, 2, sizeof(GL2PSprimitive*)); - gl2psListAdd(gro.ptrlist, &p); - gl2psListAdd(gl2ps->pdfgrouplist, &gro); - } - else{ - gl2psListAdd(gro.ptrlist, &p); - } - lastpattern = p->pattern; - lastfactor = p->factor; - lastwidth = p->width; - lastrgba[0] = p->verts[0].rgba[0]; - lastrgba[1] = p->verts[0].rgba[1]; - lastrgba[2] = p->verts[0].rgba[2]; - break; - case GL2PS_POINT: - if(lasttype != p->type || lastwidth != p->width || - !gl2psSameColor(p->verts[0].rgba, lastrgba)){ - gl2psPDFgroupObjectInit(&gro); - gro.ptrlist = gl2psListCreate(1,2,sizeof(GL2PSprimitive*)); - gl2psListAdd(gro.ptrlist, &p); - gl2psListAdd(gl2ps->pdfgrouplist, &gro); - } - else{ - gl2psListAdd(gro.ptrlist, &p); - } - lastwidth = p->width; - lastrgba[0] = p->verts[0].rgba[0]; - lastrgba[1] = p->verts[0].rgba[1]; - lastrgba[2] = p->verts[0].rgba[2]; - break; - case GL2PS_TRIANGLE: - gl2psFillTriangleFromPrimitive(&tmpt, p, GL_TRUE); - lastTriangleWasNotSimpleWithSameColor = - !(tmpt.prop & T_CONST_COLOR && tmpt.prop & T_ALPHA_1) || - !gl2psSameColor(tmpt.vertex[0].rgba, lastt.vertex[0].rgba); - if(lasttype == p->type && tmpt.prop == lastt.prop && - lastTriangleWasNotSimpleWithSameColor){ - /* TODO Check here for last alpha */ - gl2psListAdd(gro.ptrlist, &p); - } - else{ - gl2psPDFgroupObjectInit(&gro); - gro.ptrlist = gl2psListCreate(1, 2, sizeof(GL2PSprimitive*)); - gl2psListAdd(gro.ptrlist, &p); - gl2psListAdd(gl2ps->pdfgrouplist, &gro); - } - lastt = tmpt; - break; - default: - break; - } - lasttype = p->type; - } -} - -static void gl2psSortOutTrianglePDFgroup(GL2PSpdfgroup *gro) -{ - GL2PStriangle t; - GL2PSprimitive *prim = NULL; - - if(!gro) - return; - - if(!gl2psListNbr(gro->ptrlist)) - return; - - prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, 0); - - if(prim->type != GL2PS_TRIANGLE) - return; - - gl2psFillTriangleFromPrimitive(&t, prim, GL_TRUE); - - if(t.prop & T_CONST_COLOR && t.prop & T_ALPHA_LESS_1){ - gro->gsno = gl2ps->extgs_stack++; - gro->gsobjno = gl2ps->objects_stack ++; - } - else if(t.prop & T_CONST_COLOR && t.prop & T_VAR_ALPHA){ - gro->gsno = gl2ps->extgs_stack++; - gro->gsobjno = gl2ps->objects_stack++; - gro->trgroupno = gl2ps->trgroupobjects_stack++; - gro->trgroupobjno = gl2ps->objects_stack++; - gro->maskshno = gl2ps->mshader_stack++; - gro->maskshobjno = gl2ps->objects_stack++; - } - else if(t.prop & T_VAR_COLOR && t.prop & T_ALPHA_1){ - gro->shno = gl2ps->shader_stack++; - gro->shobjno = gl2ps->objects_stack++; - } - else if(t.prop & T_VAR_COLOR && t.prop & T_ALPHA_LESS_1){ - gro->gsno = gl2ps->extgs_stack++; - gro->gsobjno = gl2ps->objects_stack++; - gro->shno = gl2ps->shader_stack++; - gro->shobjno = gl2ps->objects_stack++; - } - else if(t.prop & T_VAR_COLOR && t.prop & T_VAR_ALPHA){ - gro->gsno = gl2ps->extgs_stack++; - gro->gsobjno = gl2ps->objects_stack++; - gro->shno = gl2ps->shader_stack++; - gro->shobjno = gl2ps->objects_stack++; - gro->trgroupno = gl2ps->trgroupobjects_stack++; - gro->trgroupobjno = gl2ps->objects_stack++; - gro->maskshno = gl2ps->mshader_stack++; - gro->maskshobjno = gl2ps->objects_stack++; - } -} - -/* Main stream data */ - -static void gl2psPDFgroupListWriteMainStream(void) -{ - int i, j, lastel; - GL2PSprimitive *prim = NULL, *prev = NULL; - GL2PSpdfgroup *gro; - GL2PStriangle t; - - if(!gl2ps->pdfgrouplist) - return; - - for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){ - gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i); - - lastel = gl2psListNbr(gro->ptrlist) - 1; - if(lastel < 0) - continue; - - prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, 0); - - switch(prim->type){ - case GL2PS_POINT: - gl2ps->streamlength += gl2psPrintf("1 J\n"); - gl2ps->streamlength += gl2psPrintPDFLineWidth(prim->width); - gl2ps->streamlength += gl2psPrintPDFStrokeColor(prim->verts[0].rgba); - for(j = 0; j <= lastel; ++j){ - prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j); - gl2ps->streamlength += - gl2psPrintf("%f %f m %f %f l\n", - prim->verts[0].xyz[0], prim->verts[0].xyz[1], - prim->verts[0].xyz[0], prim->verts[0].xyz[1]); - } - gl2ps->streamlength += gl2psPrintf("S\n"); - gl2ps->streamlength += gl2psPrintf("0 J\n"); - break; - case GL2PS_LINE: - /* We try to use as few paths as possible to draw lines, in - order to get nice stippling even when the individual segments - are smaller than the stipple */ - gl2ps->streamlength += gl2psPrintPDFLineWidth(prim->width); - gl2ps->streamlength += gl2psPrintPDFStrokeColor(prim->verts[0].rgba); - gl2ps->streamlength += gl2psPrintPostScriptDash(prim->pattern, prim->factor, "d"); - /* start new path */ - gl2ps->streamlength += - gl2psPrintf("%f %f m\n", - prim->verts[0].xyz[0], prim->verts[0].xyz[1]); - - for(j = 1; j <= lastel; ++j){ - prev = prim; - prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j); - if(!gl2psSamePosition(prim->verts[0].xyz, prev->verts[1].xyz)){ - /* the starting point of the new segment does not match the - end point of the previous line, so we end the current - path and start a new one */ - gl2ps->streamlength += - gl2psPrintf("%f %f l\n", - prev->verts[1].xyz[0], prev->verts[1].xyz[1]); - gl2ps->streamlength += - gl2psPrintf("%f %f m\n", - prim->verts[0].xyz[0], prim->verts[0].xyz[1]); - } - else{ - /* the two segements are connected, so we just append to the - current path */ - gl2ps->streamlength += - gl2psPrintf("%f %f l\n", - prim->verts[0].xyz[0], prim->verts[0].xyz[1]); - } - } - /* end last path */ - gl2ps->streamlength += - gl2psPrintf("%f %f l\n", - prim->verts[1].xyz[0], prim->verts[1].xyz[1]); - gl2ps->streamlength += gl2psPrintf("S\n"); - break; - case GL2PS_TRIANGLE: - gl2psFillTriangleFromPrimitive(&t, prim, GL_TRUE); - gl2psSortOutTrianglePDFgroup(gro); - - /* No alpha and const color: Simple PDF draw orders */ - if(t.prop & T_CONST_COLOR && t.prop & T_ALPHA_1){ - gl2ps->streamlength += gl2psPrintPDFFillColor(t.vertex[0].rgba); - for(j = 0; j <= lastel; ++j){ - prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j); - gl2psFillTriangleFromPrimitive(&t, prim, GL_FALSE); - gl2ps->streamlength - += gl2psPrintf("%f %f m\n" - "%f %f l\n" - "%f %f l\n" - "h f\n", - t.vertex[0].xyz[0], t.vertex[0].xyz[1], - t.vertex[1].xyz[0], t.vertex[1].xyz[1], - t.vertex[2].xyz[0], t.vertex[2].xyz[1]); - } - } - /* Const alpha < 1 and const color: Simple PDF draw orders - and an extra extended Graphics State for the alpha const */ - else if(t.prop & T_CONST_COLOR && t.prop & T_ALPHA_LESS_1){ - gl2ps->streamlength += gl2psPrintf("q\n" - "/GS%d gs\n", - gro->gsno); - gl2ps->streamlength += gl2psPrintPDFFillColor(prim->verts[0].rgba); - for(j = 0; j <= lastel; ++j){ - prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j); - gl2psFillTriangleFromPrimitive(&t, prim, GL_FALSE); - gl2ps->streamlength - += gl2psPrintf("%f %f m\n" - "%f %f l\n" - "%f %f l\n" - "h f\n", - t.vertex[0].xyz[0], t.vertex[0].xyz[1], - t.vertex[1].xyz[0], t.vertex[1].xyz[1], - t.vertex[2].xyz[0], t.vertex[2].xyz[1]); - } - gl2ps->streamlength += gl2psPrintf("Q\n"); - } - /* Variable alpha and const color: Simple PDF draw orders - and an extra extended Graphics State + Xobject + Shader - object for the alpha mask */ - else if(t.prop & T_CONST_COLOR && t.prop & T_VAR_ALPHA){ - gl2ps->streamlength += gl2psPrintf("q\n" - "/GS%d gs\n" - "/TrG%d Do\n", - gro->gsno, gro->trgroupno); - gl2ps->streamlength += gl2psPrintPDFFillColor(prim->verts[0].rgba); - for(j = 0; j <= lastel; ++j){ - prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j); - gl2psFillTriangleFromPrimitive(&t, prim, GL_FALSE); - gl2ps->streamlength - += gl2psPrintf("%f %f m\n" - "%f %f l\n" - "%f %f l\n" - "h f\n", - t.vertex[0].xyz[0], t.vertex[0].xyz[1], - t.vertex[1].xyz[0], t.vertex[1].xyz[1], - t.vertex[2].xyz[0], t.vertex[2].xyz[1]); - } - gl2ps->streamlength += gl2psPrintf("Q\n"); - } - /* Variable color and no alpha: Shader Object for the colored - triangle(s) */ - else if(t.prop & T_VAR_COLOR && t.prop & T_ALPHA_1){ - gl2ps->streamlength += gl2psPrintf("/Sh%d sh\n", gro->shno); - } - /* Variable color and const alpha < 1: Shader Object for the - colored triangle(s) and an extra extended Graphics State - for the alpha const */ - else if(t.prop & T_VAR_COLOR && t.prop & T_ALPHA_LESS_1){ - gl2ps->streamlength += gl2psPrintf("q\n" - "/GS%d gs\n" - "/Sh%d sh\n" - "Q\n", - gro->gsno, gro->shno); - } - /* Variable alpha and color: Shader Object for the colored - triangle(s) and an extra extended Graphics State - + Xobject + Shader object for the alpha mask */ - else if(t.prop & T_VAR_COLOR && t.prop & T_VAR_ALPHA){ - gl2ps->streamlength += gl2psPrintf("q\n" - "/GS%d gs\n" - "/TrG%d Do\n" - "/Sh%d sh\n" - "Q\n", - gro->gsno, gro->trgroupno, gro->shno); - } - break; - case GL2PS_PIXMAP: - for(j = 0; j <= lastel; ++j){ - prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j); - gl2psPutPDFImage(prim->data.image, gro->imno, prim->verts[0].xyz[0], - prim->verts[0].xyz[1]); - } - break; - case GL2PS_TEXT: - for(j = 0; j <= lastel; ++j){ - prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j); - gl2ps->streamlength += gl2psPrintPDFFillColor(prim->verts[0].rgba); - gl2psPutPDFText(prim->data.text, gro->fontno, prim->verts[0].xyz[0], - prim->verts[0].xyz[1]); - } - break; - default: - break; - } - } -} - -/* Graphics State names */ - -static int gl2psPDFgroupListWriteGStateResources(void) -{ - GL2PSpdfgroup *gro; - int offs = 0; - int i; - - offs += fprintf(gl2ps->stream, - "/ExtGState\n" - "<<\n" - "/GSa 7 0 R\n"); - for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){ - gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i); - if(gro->gsno >= 0) - offs += fprintf(gl2ps->stream, "/GS%d %d 0 R\n", gro->gsno, gro->gsobjno); - } - offs += fprintf(gl2ps->stream, ">>\n"); - return offs; -} - -/* Main Shader names */ - -static int gl2psPDFgroupListWriteShaderResources(void) -{ - GL2PSpdfgroup *gro; - int offs = 0; - int i; - - offs += fprintf(gl2ps->stream, - "/Shading\n" - "<<\n"); - for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){ - gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i); - if(gro->shno >= 0) - offs += fprintf(gl2ps->stream, "/Sh%d %d 0 R\n", gro->shno, gro->shobjno); - if(gro->maskshno >= 0) - offs += fprintf(gl2ps->stream, "/TrSh%d %d 0 R\n", gro->maskshno, gro->maskshobjno); - } - offs += fprintf(gl2ps->stream,">>\n"); - return offs; -} - -/* Images & Mask Shader XObject names */ - -static int gl2psPDFgroupListWriteXObjectResources(void) -{ - int i; - GL2PSprimitive *p = NULL; - GL2PSpdfgroup *gro; - int offs = 0; - - offs += fprintf(gl2ps->stream, - "/XObject\n" - "<<\n"); - - for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){ - gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i); - if(!gl2psListNbr(gro->ptrlist)) - continue; - p = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, 0); - switch(p->type){ - case GL2PS_PIXMAP: - gro->imobjno = gl2ps->objects_stack++; - if(GL_RGBA == p->data.image->format) /* reserve one object for image mask */ - gl2ps->objects_stack++; - offs += fprintf(gl2ps->stream, "/Im%d %d 0 R\n", gro->imno, gro->imobjno); - case GL2PS_TRIANGLE: - if(gro->trgroupno >=0) - offs += fprintf(gl2ps->stream, "/TrG%d %d 0 R\n", gro->trgroupno, gro->trgroupobjno); - break; - default: - break; - } - } - offs += fprintf(gl2ps->stream,">>\n"); - return offs; -} - -/* Font names */ - -static int gl2psPDFgroupListWriteFontResources(void) -{ - int i; - GL2PSpdfgroup *gro; - int offs = 0; - - offs += fprintf(gl2ps->stream, "/Font\n<<\n"); - - for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){ - gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i); - if(gro->fontno < 0) - continue; - gro->fontobjno = gl2ps->objects_stack++; - offs += fprintf(gl2ps->stream, "/F%d %d 0 R\n", gro->fontno, gro->fontobjno); - } - offs += fprintf(gl2ps->stream, ">>\n"); - - return offs; -} - -static void gl2psPDFgroupListDelete(void) -{ - int i; - GL2PSpdfgroup *gro = NULL; - - if(!gl2ps->pdfgrouplist) - return; - - for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){ - gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist,i); - gl2psListDelete(gro->ptrlist); - } - - gl2psListDelete(gl2ps->pdfgrouplist); - gl2ps->pdfgrouplist = NULL; -} - -/* Print 1st PDF object - file info */ - -static int gl2psPrintPDFInfo(void) -{ - int offs; - time_t now; - struct tm *newtime; - - time(&now); - newtime = gmtime(&now); - - offs = fprintf(gl2ps->stream, - "1 0 obj\n" - "<<\n" - "/Title (%s)\n" - "/Creator (GL2PS %d.%d.%d%s, %s)\n" - "/Producer (%s)\n", - gl2ps->title, GL2PS_MAJOR_VERSION, GL2PS_MINOR_VERSION, - GL2PS_PATCH_VERSION, GL2PS_EXTRA_VERSION, GL2PS_COPYRIGHT, - gl2ps->producer); - - if(!newtime){ - offs += fprintf(gl2ps->stream, - ">>\n" - "endobj\n"); - return offs; - } - - offs += fprintf(gl2ps->stream, - "/CreationDate (D:%d%02d%02d%02d%02d%02d)\n" - ">>\n" - "endobj\n", - newtime->tm_year+1900, - newtime->tm_mon+1, - newtime->tm_mday, - newtime->tm_hour, - newtime->tm_min, - newtime->tm_sec); - return offs; -} - -/* Create catalog and page structure - 2nd and 3th PDF object */ - -static int gl2psPrintPDFCatalog(void) -{ - return fprintf(gl2ps->stream, - "2 0 obj\n" - "<<\n" - "/Type /Catalog\n" - "/Pages 3 0 R\n" - ">>\n" - "endobj\n"); -} - -static int gl2psPrintPDFPages(void) -{ - return fprintf(gl2ps->stream, - "3 0 obj\n" - "<<\n" - "/Type /Pages\n" - "/Kids [6 0 R]\n" - "/Count 1\n" - ">>\n" - "endobj\n"); -} - -/* Open stream for data - graphical objects, fonts etc. PDF object 4 */ - -static int gl2psOpenPDFDataStream(void) -{ - int offs = 0; - - offs += fprintf(gl2ps->stream, - "4 0 obj\n" - "<<\n" - "/Length 5 0 R\n" ); - offs += gl2psPrintPDFCompressorType(); - offs += fprintf(gl2ps->stream, - ">>\n" - "stream\n"); - return offs; -} - -/* Stream setup - Graphics state, fill background if allowed */ - -static int gl2psOpenPDFDataStreamWritePreface(void) -{ - int offs; - - offs = gl2psPrintf("/GSa gs\n"); - - if(gl2ps->options & GL2PS_DRAW_BACKGROUND){ - offs += gl2psPrintPDFFillColor(gl2ps->bgcolor); - offs += gl2psPrintf("%d %d %d %d re\n", - (int)gl2ps->viewport[0], (int)gl2ps->viewport[1], - (int)gl2ps->viewport[2], (int)gl2ps->viewport[3]); - offs += gl2psPrintf("f\n"); - } - return offs; -} - -/* Use the functions above to create the first part of the PDF*/ - -static void gl2psPrintPDFHeader(void) -{ - int offs = 0; - gl2ps->pdfprimlist = gl2psListCreate(500, 500, sizeof(GL2PSprimitive*)); - gl2psPDFstacksInit(); - - gl2ps->xreflist = (int*)gl2psMalloc(sizeof(int) * gl2ps->objects_stack); - -#if defined(GL2PS_HAVE_ZLIB) - if(gl2ps->options & GL2PS_COMPRESS){ - gl2psSetupCompress(); - } -#endif - gl2ps->xreflist[0] = 0; - offs += fprintf(gl2ps->stream, "%%PDF-1.4\n"); - gl2ps->xreflist[1] = offs; - - offs += gl2psPrintPDFInfo(); - gl2ps->xreflist[2] = offs; - - offs += gl2psPrintPDFCatalog(); - gl2ps->xreflist[3] = offs; - - offs += gl2psPrintPDFPages(); - gl2ps->xreflist[4] = offs; - - offs += gl2psOpenPDFDataStream(); - gl2ps->xreflist[5] = offs; /* finished in gl2psPrintPDFFooter */ - gl2ps->streamlength = gl2psOpenPDFDataStreamWritePreface(); -} - -/* The central primitive drawing */ - -static void gl2psPrintPDFPrimitive(void *data) -{ - GL2PSprimitive *prim = *(GL2PSprimitive**)data; - - if((gl2ps->options & GL2PS_OCCLUSION_CULL) && prim->culled) - return; - - prim = gl2psCopyPrimitive(prim); /* deep copy */ - gl2psListAdd(gl2ps->pdfprimlist, &prim); -} - -/* close stream and ... */ - -static int gl2psClosePDFDataStream(void) -{ - int offs = 0; - -#if defined(GL2PS_HAVE_ZLIB) - if(gl2ps->options & GL2PS_COMPRESS){ - if(Z_OK != gl2psDeflate()) - gl2psMsg(GL2PS_ERROR, "Zlib deflate error"); - else - fwrite(gl2ps->compress->dest, gl2ps->compress->destLen, 1, gl2ps->stream); - gl2ps->streamlength += gl2ps->compress->destLen; - - offs += gl2ps->streamlength; - gl2psFreeCompress(); - } -#endif - - offs += fprintf(gl2ps->stream, - "endstream\n" - "endobj\n"); - return offs; -} - -/* ... write the now known length object */ - -static int gl2psPrintPDFDataStreamLength(int val) -{ - return fprintf(gl2ps->stream, - "5 0 obj\n" - "%d\n" - "endobj\n", val); -} - -/* Put the info created before in PDF objects */ - -static int gl2psPrintPDFOpenPage(void) -{ - int offs; - - /* Write fixed part */ - - offs = fprintf(gl2ps->stream, - "6 0 obj\n" - "<<\n" - "/Type /Page\n" - "/Parent 3 0 R\n" - "/MediaBox [%d %d %d %d]\n", - (int)gl2ps->viewport[0], (int)gl2ps->viewport[1], - (int)gl2ps->viewport[2], (int)gl2ps->viewport[3]); - - if(gl2ps->options & GL2PS_LANDSCAPE) - offs += fprintf(gl2ps->stream, "/Rotate -90\n"); - - offs += fprintf(gl2ps->stream, - "/Contents 4 0 R\n" - "/Resources\n" - "<<\n" - "/ProcSet [/PDF /Text /ImageB /ImageC] %%/ImageI\n"); - - return offs; - - /* End fixed part, proceeds in gl2psPDFgroupListWriteVariableResources() */ -} - -static int gl2psPDFgroupListWriteVariableResources(void) -{ - int offs = 0; - - /* a) Graphics States for shader alpha masks*/ - offs += gl2psPDFgroupListWriteGStateResources(); - - /* b) Shader and shader masks */ - offs += gl2psPDFgroupListWriteShaderResources(); - - /* c) XObjects (Images & Shader Masks) */ - offs += gl2psPDFgroupListWriteXObjectResources(); - - /* d) Fonts */ - offs += gl2psPDFgroupListWriteFontResources(); - - /* End resources and page */ - offs += fprintf(gl2ps->stream, - ">>\n" - ">>\n" - "endobj\n"); - return offs; -} - -/* Standard Graphics State */ - -static int gl2psPrintPDFGSObject(void) -{ - return fprintf(gl2ps->stream, - "7 0 obj\n" - "<<\n" - "/Type /ExtGState\n" - "/SA false\n" - "/SM 0.02\n" - "/OP false\n" - "/op false\n" - "/OPM 0\n" - "/BG2 /Default\n" - "/UCR2 /Default\n" - "/TR2 /Default\n" - ">>\n" - "endobj\n"); -} - -/* Put vertex' edge flag (8bit) and coordinates (32bit) in shader stream */ - -static int gl2psPrintPDFShaderStreamDataCoord(GL2PSvertex *vertex, - int (*action)(unsigned long data, int size), - GLfloat dx, GLfloat dy, - GLfloat xmin, GLfloat ymin) -{ - int offs = 0; - unsigned long imap; - GLfloat diff; - double dmax = ~1UL; - char edgeflag = 0; - - /* FIXME: temp bux fix for 64 bit archs: */ - if(sizeof(unsigned long) == 8) dmax = dmax - 2048.; - - offs += (*action)(edgeflag, 1); - - /* The Shader stream in PDF requires to be in a 'big-endian' - order */ - - if(GL2PS_ZERO(dx * dy)){ - offs += (*action)(0, 4); - offs += (*action)(0, 4); - } - else{ - diff = (vertex->xyz[0] - xmin) / dx; - if(diff > 1) - diff = 1.0F; - else if(diff < 0) - diff = 0.0F; - imap = (unsigned long)(diff * dmax); - offs += (*action)(imap, 4); - - diff = (vertex->xyz[1] - ymin) / dy; - if(diff > 1) - diff = 1.0F; - else if(diff < 0) - diff = 0.0F; - imap = (unsigned long)(diff * dmax); - offs += (*action)(imap, 4); - } - - return offs; -} - -/* Put vertex' rgb value (8bit for every component) in shader stream */ - -static int gl2psPrintPDFShaderStreamDataRGB(GL2PSvertex *vertex, - int (*action)(unsigned long data, int size)) -{ - int offs = 0; - unsigned long imap; - double dmax = ~1UL; - - /* FIXME: temp bux fix for 64 bit archs: */ - if(sizeof(unsigned long) == 8) dmax = dmax - 2048.; - - imap = (unsigned long)((vertex->rgba[0]) * dmax); - offs += (*action)(imap, 1); - - imap = (unsigned long)((vertex->rgba[1]) * dmax); - offs += (*action)(imap, 1); - - imap = (unsigned long)((vertex->rgba[2]) * dmax); - offs += (*action)(imap, 1); - - return offs; -} - -/* Put vertex' alpha (8/16bit) in shader stream */ - -static int gl2psPrintPDFShaderStreamDataAlpha(GL2PSvertex *vertex, - int (*action)(unsigned long data, int size), - int sigbyte) -{ - int offs = 0; - unsigned long imap; - double dmax = ~1UL; - - /* FIXME: temp bux fix for 64 bit archs: */ - if(sizeof(unsigned long) == 8) dmax = dmax - 2048.; - - if(sigbyte != 8 && sigbyte != 16) - sigbyte = 8; - - sigbyte /= 8; - - imap = (unsigned long)((vertex->rgba[3]) * dmax); - - offs += (*action)(imap, sigbyte); - - return offs; -} - -/* Put a triangles raw data in shader stream */ - -static int gl2psPrintPDFShaderStreamData(GL2PStriangle *triangle, - GLfloat dx, GLfloat dy, - GLfloat xmin, GLfloat ymin, - int (*action)(unsigned long data, int size), - int gray) -{ - int i, offs = 0; - GL2PSvertex v; - - if(gray && gray != 8 && gray != 16) - gray = 8; - - for(i = 0; i < 3; ++i){ - offs += gl2psPrintPDFShaderStreamDataCoord(&triangle->vertex[i], action, - dx, dy, xmin, ymin); - if(gray){ - v = triangle->vertex[i]; - offs += gl2psPrintPDFShaderStreamDataAlpha(&v, action, gray); - } - else{ - offs += gl2psPrintPDFShaderStreamDataRGB(&triangle->vertex[i], action); - } - } - - return offs; -} - -static void gl2psPDFRectHull(GLfloat *xmin, GLfloat *xmax, - GLfloat *ymin, GLfloat *ymax, - GL2PStriangle *triangles, int cnt) -{ - int i, j; - - *xmin = triangles[0].vertex[0].xyz[0]; - *xmax = triangles[0].vertex[0].xyz[0]; - *ymin = triangles[0].vertex[0].xyz[1]; - *ymax = triangles[0].vertex[0].xyz[1]; - - for(i = 0; i < cnt; ++i){ - for(j = 0; j < 3; ++j){ - if(*xmin > triangles[i].vertex[j].xyz[0]) - *xmin = triangles[i].vertex[j].xyz[0]; - if(*xmax < triangles[i].vertex[j].xyz[0]) - *xmax = triangles[i].vertex[j].xyz[0]; - if(*ymin > triangles[i].vertex[j].xyz[1]) - *ymin = triangles[i].vertex[j].xyz[1]; - if(*ymax < triangles[i].vertex[j].xyz[1]) - *ymax = triangles[i].vertex[j].xyz[1]; - } - } -} - -/* Writes shaded triangle - gray == 0 means write RGB triangles - gray == 8 8bit-grayscale (for alpha masks) - gray == 16 16bit-grayscale (for alpha masks) */ - -static int gl2psPrintPDFShader(int obj, GL2PStriangle *triangles, - int size, int gray) -{ - int i, offs = 0, vertexbytes, done = 0; - GLfloat xmin, xmax, ymin, ymax; - - switch(gray){ - case 0: - vertexbytes = 1+4+4+1+1+1; - break; - case 8: - vertexbytes = 1+4+4+1; - break; - case 16: - vertexbytes = 1+4+4+2; - break; - default: - gray = 8; - vertexbytes = 1+4+4+1; - break; - } - - gl2psPDFRectHull(&xmin, &xmax, &ymin, &ymax, triangles, size); - - offs += fprintf(gl2ps->stream, - "%d 0 obj\n" - "<< " - "/ShadingType 4 " - "/ColorSpace %s " - "/BitsPerCoordinate 32 " - "/BitsPerComponent %d " - "/BitsPerFlag 8 " - "/Decode [%f %f %f %f 0 1 %s] ", - obj, - (gray) ? "/DeviceGray" : "/DeviceRGB", - (gray) ? gray : 8, - xmin, xmax, ymin, ymax, - (gray) ? "" : "0 1 0 1"); - -#if defined(GL2PS_HAVE_ZLIB) - if(gl2ps->options & GL2PS_COMPRESS){ - gl2psAllocCompress(vertexbytes * size * 3); - - for(i = 0; i < size; ++i) - gl2psPrintPDFShaderStreamData(&triangles[i], - xmax-xmin, ymax-ymin, xmin, ymin, - gl2psWriteBigEndianCompress, gray); - - if(Z_OK == gl2psDeflate() && 23 + gl2ps->compress->destLen < gl2ps->compress->srcLen){ - offs += gl2psPrintPDFCompressorType(); - offs += fprintf(gl2ps->stream, - "/Length %d " - ">>\n" - "stream\n", - (int)gl2ps->compress->destLen); - offs += gl2ps->compress->destLen * fwrite(gl2ps->compress->dest, - gl2ps->compress->destLen, - 1, gl2ps->stream); - done = 1; - } - gl2psFreeCompress(); - } -#endif - - if(!done){ - /* no compression, or too long after compression, or compress error - -> write non-compressed entry */ - offs += fprintf(gl2ps->stream, - "/Length %d " - ">>\n" - "stream\n", - vertexbytes * 3 * size); - for(i = 0; i < size; ++i) - offs += gl2psPrintPDFShaderStreamData(&triangles[i], - xmax-xmin, ymax-ymin, xmin, ymin, - gl2psWriteBigEndian, gray); - } - - offs += fprintf(gl2ps->stream, - "\nendstream\n" - "endobj\n"); - - return offs; -} - -/* Writes a XObject for a shaded triangle mask */ - -static int gl2psPrintPDFShaderMask(int obj, int childobj) -{ - int offs = 0, len; - - offs += fprintf(gl2ps->stream, - "%d 0 obj\n" - "<<\n" - "/Type /XObject\n" - "/Subtype /Form\n" - "/BBox [ %d %d %d %d ]\n" - "/Group \n<<\n/S /Transparency /CS /DeviceRGB\n" - ">>\n", - obj, - (int)gl2ps->viewport[0], (int)gl2ps->viewport[1], - (int)gl2ps->viewport[2], (int)gl2ps->viewport[3]); - - len = (childobj>0) - ? strlen("/TrSh sh\n") + (int)log10((double)childobj)+1 - : strlen("/TrSh0 sh\n"); - - offs += fprintf(gl2ps->stream, - "/Length %d\n" - ">>\n" - "stream\n", - len); - offs += fprintf(gl2ps->stream, - "/TrSh%d sh\n", - childobj); - offs += fprintf(gl2ps->stream, - "endstream\n" - "endobj\n"); - - return offs; -} - -/* Writes a Extended graphics state for a shaded triangle mask if - simplealpha ist true the childobj argument is ignored and a /ca - statement will be written instead */ - -static int gl2psPrintPDFShaderExtGS(int obj, int childobj) -{ - int offs = 0; - - offs += fprintf(gl2ps->stream, - "%d 0 obj\n" - "<<\n", - obj); - - offs += fprintf(gl2ps->stream, - "/SMask << /S /Alpha /G %d 0 R >> ", - childobj); - - offs += fprintf(gl2ps->stream, - ">>\n" - "endobj\n"); - return offs; -} - -/* a simple graphics state */ - -static int gl2psPrintPDFShaderSimpleExtGS(int obj, GLfloat alpha) -{ - int offs = 0; - - offs += fprintf(gl2ps->stream, - "%d 0 obj\n" - "<<\n" - "/ca %g" - ">>\n" - "endobj\n", - obj, alpha); - return offs; -} - -/* Similar groups of functions for pixmaps and text */ - -static int gl2psPrintPDFPixmapStreamData(GL2PSimage *im, - int (*action)(unsigned long data, int size), - int gray) -{ - int x, y, shift; - GLfloat r, g, b, a; - - if(im->format != GL_RGBA && gray) - return 0; - - if(gray && gray != 8 && gray != 16) - gray = 8; - - gray /= 8; - - shift = (sizeof(unsigned long) - 1) * 8; - - for(y = 0; y < im->height; ++y){ - for(x = 0; x < im->width; ++x){ - a = gl2psGetRGB(im, x, y, &r, &g, &b); - if(im->format == GL_RGBA && gray){ - (*action)((unsigned long)(a * 255) << shift, gray); - } - else{ - (*action)((unsigned long)(r * 255) << shift, 1); - (*action)((unsigned long)(g * 255) << shift, 1); - (*action)((unsigned long)(b * 255) << shift, 1); - } - } - } - - switch(gray){ - case 0: return 3 * im->width * im->height; - case 1: return im->width * im->height; - case 2: return 2 * im->width * im->height; - default: return 3 * im->width * im->height; - } -} - -static int gl2psPrintPDFPixmap(int obj, int childobj, GL2PSimage *im, int gray) -{ - int offs = 0, done = 0, sigbytes = 3; - - if(gray && gray !=8 && gray != 16) - gray = 8; - - if(gray) - sigbytes = gray / 8; - - offs += fprintf(gl2ps->stream, - "%d 0 obj\n" - "<<\n" - "/Type /XObject\n" - "/Subtype /Image\n" - "/Width %d\n" - "/Height %d\n" - "/ColorSpace %s \n" - "/BitsPerComponent 8\n", - obj, - (int)im->width, (int)im->height, - (gray) ? "/DeviceGray" : "/DeviceRGB" ); - if(GL_RGBA == im->format && gray == 0){ - offs += fprintf(gl2ps->stream, - "/SMask %d 0 R\n", - childobj); - } - -#if defined(GL2PS_HAVE_ZLIB) - if(gl2ps->options & GL2PS_COMPRESS){ - gl2psAllocCompress((int)(im->width * im->height * sigbytes)); - - gl2psPrintPDFPixmapStreamData(im, gl2psWriteBigEndianCompress, gray); - - if(Z_OK == gl2psDeflate() && 23 + gl2ps->compress->destLen < gl2ps->compress->srcLen){ - offs += gl2psPrintPDFCompressorType(); - offs += fprintf(gl2ps->stream, - "/Length %d " - ">>\n" - "stream\n", - (int)gl2ps->compress->destLen); - offs += gl2ps->compress->destLen * fwrite(gl2ps->compress->dest, gl2ps->compress->destLen, - 1, gl2ps->stream); - done = 1; - } - gl2psFreeCompress(); - } -#endif - - if(!done){ - /* no compression, or too long after compression, or compress error - -> write non-compressed entry */ - offs += fprintf(gl2ps->stream, - "/Length %d " - ">>\n" - "stream\n", - (int)(im->width * im->height * sigbytes)); - offs += gl2psPrintPDFPixmapStreamData(im, gl2psWriteBigEndian, gray); - } - - offs += fprintf(gl2ps->stream, - "\nendstream\n" - "endobj\n"); - - return offs; -} - -static int gl2psPrintPDFText(int obj, GL2PSstring *s, int fontnumber) -{ - int offs = 0; - - offs += fprintf(gl2ps->stream, - "%d 0 obj\n" - "<<\n" - "/Type /Font\n" - "/Subtype /Type1\n" - "/Name /F%d\n" - "/BaseFont /%s\n" - "/Encoding /MacRomanEncoding\n" - ">>\n" - "endobj\n", - obj, fontnumber, s->fontname); - return offs; -} - -/* Write the physical objects */ - -static int gl2psPDFgroupListWriteObjects(int entryoffs) -{ - int i,j; - GL2PSprimitive *p = NULL; - GL2PSpdfgroup *gro; - int offs = entryoffs; - GL2PStriangle *triangles; - int size = 0; - - if(!gl2ps->pdfgrouplist) - return offs; - - for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){ - gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i); - if(!gl2psListNbr(gro->ptrlist)) - continue; - p = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, 0); - switch(p->type){ - case GL2PS_POINT: - break; - case GL2PS_LINE: - break; - case GL2PS_TRIANGLE: - size = gl2psListNbr(gro->ptrlist); - triangles = (GL2PStriangle*)gl2psMalloc(sizeof(GL2PStriangle) * size); - for(j = 0; j < size; ++j){ - p = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j); - gl2psFillTriangleFromPrimitive(&triangles[j], p, GL_TRUE); - } - if(triangles[0].prop & T_VAR_COLOR){ - gl2ps->xreflist[gro->shobjno] = offs; - offs += gl2psPrintPDFShader(gro->shobjno, triangles, size, 0); - } - if(triangles[0].prop & T_ALPHA_LESS_1){ - gl2ps->xreflist[gro->gsobjno] = offs; - offs += gl2psPrintPDFShaderSimpleExtGS(gro->gsobjno, triangles[0].vertex[0].rgba[3]); - } - if(triangles[0].prop & T_VAR_ALPHA){ - gl2ps->xreflist[gro->gsobjno] = offs; - offs += gl2psPrintPDFShaderExtGS(gro->gsobjno, gro->trgroupobjno); - gl2ps->xreflist[gro->trgroupobjno] = offs; - offs += gl2psPrintPDFShaderMask(gro->trgroupobjno, gro->maskshno); - gl2ps->xreflist[gro->maskshobjno] = offs; - offs += gl2psPrintPDFShader(gro->maskshobjno, triangles, size, 8); - } - gl2psFree(triangles); - break; - case GL2PS_PIXMAP: - gl2ps->xreflist[gro->imobjno] = offs; - offs += gl2psPrintPDFPixmap(gro->imobjno, gro->imobjno+1, p->data.image, 0); - if(p->data.image->format == GL_RGBA){ - gl2ps->xreflist[gro->imobjno+1] = offs; - offs += gl2psPrintPDFPixmap(gro->imobjno+1, -1, p->data.image, 8); - } - break; - case GL2PS_TEXT: - gl2ps->xreflist[gro->fontobjno] = offs; - offs += gl2psPrintPDFText(gro->fontobjno,p->data.text,gro->fontno); - break; - case GL2PS_SPECIAL : - /* alignment contains the format for which the special output text - is intended */ - if(p->data.text->alignment == GL2PS_PDF) - offs += fprintf(gl2ps->stream, "%s\n", p->data.text->str); - break; - default: - break; - } - } - return offs; -} - -/* All variable data has been written at this point and all required - functioninality has been gathered, so we can write now file footer - with cross reference table and trailer */ - -static void gl2psPrintPDFFooter(void) -{ - int i, offs; - - gl2psPDFgroupListInit(); - gl2psPDFgroupListWriteMainStream(); - - offs = gl2ps->xreflist[5] + gl2ps->streamlength; - offs += gl2psClosePDFDataStream(); - gl2ps->xreflist[5] = offs; - - offs += gl2psPrintPDFDataStreamLength(gl2ps->streamlength); - gl2ps->xreflist[6] = offs; - gl2ps->streamlength = 0; - - offs += gl2psPrintPDFOpenPage(); - offs += gl2psPDFgroupListWriteVariableResources(); - gl2ps->xreflist = (int*)gl2psRealloc(gl2ps->xreflist, - sizeof(int) * (gl2ps->objects_stack + 1)); - gl2ps->xreflist[7] = offs; - - offs += gl2psPrintPDFGSObject(); - gl2ps->xreflist[8] = offs; - - gl2ps->xreflist[gl2ps->objects_stack] = - gl2psPDFgroupListWriteObjects(gl2ps->xreflist[8]); - - /* Start cross reference table. The file has to been opened in - binary mode to preserve the 20 digit string length! */ - fprintf(gl2ps->stream, - "xref\n" - "0 %d\n" - "%010d 65535 f \n", gl2ps->objects_stack, 0); - - for(i = 1; i < gl2ps->objects_stack; ++i) - fprintf(gl2ps->stream, "%010d 00000 n \n", gl2ps->xreflist[i]); - - fprintf(gl2ps->stream, - "trailer\n" - "<<\n" - "/Size %d\n" - "/Info 1 0 R\n" - "/Root 2 0 R\n" - ">>\n" - "startxref\n%d\n" - "%%%%EOF\n", - gl2ps->objects_stack, gl2ps->xreflist[gl2ps->objects_stack]); - - /* Free auxiliary lists and arrays */ - gl2psFree(gl2ps->xreflist); - gl2psListAction(gl2ps->pdfprimlist, gl2psFreePrimitive); - gl2psListDelete(gl2ps->pdfprimlist); - gl2psPDFgroupListDelete(); - -#if defined(GL2PS_HAVE_ZLIB) - if(gl2ps->options & GL2PS_COMPRESS){ - gl2psFreeCompress(); - gl2psFree(gl2ps->compress); - gl2ps->compress = NULL; - } -#endif -} - -/* PDF begin viewport */ - -static void gl2psPrintPDFBeginViewport(GLint viewport[4]) -{ - int offs = 0; - GLint index; - GLfloat rgba[4]; - int x = viewport[0], y = viewport[1], w = viewport[2], h = viewport[3]; - - glRenderMode(GL_FEEDBACK); - - if(gl2ps->header){ - gl2psPrintPDFHeader(); - gl2ps->header = GL_FALSE; - } - - offs += gl2psPrintf("q\n"); - - if(gl2ps->options & GL2PS_DRAW_BACKGROUND){ - if(gl2ps->colormode == GL_RGBA || gl2ps->colorsize == 0){ - glGetFloatv(GL_COLOR_CLEAR_VALUE, rgba); - } - else{ - glGetIntegerv(GL_INDEX_CLEAR_VALUE, &index); - rgba[0] = gl2ps->colormap[index][0]; - rgba[1] = gl2ps->colormap[index][1]; - rgba[2] = gl2ps->colormap[index][2]; - rgba[3] = 1.0F; - } - offs += gl2psPrintPDFFillColor(rgba); - offs += gl2psPrintf("%d %d %d %d re\n" - "W\n" - "f\n", - x, y, w, h); - } - else{ - offs += gl2psPrintf("%d %d %d %d re\n" - "W\n" - "n\n", - x, y, w, h); - } - - gl2ps->streamlength += offs; -} - -static GLint gl2psPrintPDFEndViewport(void) -{ - GLint res; - - res = gl2psPrintPrimitives(); - gl2ps->streamlength += gl2psPrintf("Q\n"); - return res; -} - -static void gl2psPrintPDFFinalPrimitive(void) -{ -} - -/* definition of the PDF backend */ - -static GL2PSbackend gl2psPDF = { - gl2psPrintPDFHeader, - gl2psPrintPDFFooter, - gl2psPrintPDFBeginViewport, - gl2psPrintPDFEndViewport, - gl2psPrintPDFPrimitive, - gl2psPrintPDFFinalPrimitive, - "pdf", - "Portable Document Format" -}; - -/********************************************************************* - * - * SVG routines - * - *********************************************************************/ - -static void gl2psSVGGetCoordsAndColors(int n, GL2PSvertex *verts, - GL2PSxyz *xyz, GL2PSrgba *rgba) -{ - int i, j; - - for(i = 0; i < n; i++){ - xyz[i][0] = verts[i].xyz[0]; - xyz[i][1] = gl2ps->viewport[3] - verts[i].xyz[1]; - xyz[i][2] = 0.0F; - for(j = 0; j < 4; j++) - rgba[i][j] = verts[i].rgba[j]; - } -} - -static void gl2psSVGGetColorString(GL2PSrgba rgba, char str[32]) -{ - int r = (int)(255. * rgba[0]); - int g = (int)(255. * rgba[1]); - int b = (int)(255. * rgba[2]); - int rc = (r < 0) ? 0 : (r > 255) ? 255 : r; - int gc = (g < 0) ? 0 : (g > 255) ? 255 : g; - int bc = (b < 0) ? 0 : (b > 255) ? 255 : b; - sprintf(str, "#%2.2x%2.2x%2.2x", rc, gc, bc); -} - -static void gl2psPrintSVGHeader(void) -{ - int x, y, width, height; - char col[32]; - time_t now; - - time(&now); - - if (gl2ps->options & GL2PS_LANDSCAPE){ - x = (int)gl2ps->viewport[1]; - y = (int)gl2ps->viewport[0]; - width = (int)gl2ps->viewport[3]; - height = (int)gl2ps->viewport[2]; - } - else{ - x = (int)gl2ps->viewport[0]; - y = (int)gl2ps->viewport[1]; - width = (int)gl2ps->viewport[2]; - height = (int)gl2ps->viewport[3]; - } - - /* Compressed SVG files (.svgz) are simply gzipped SVG files */ - gl2psPrintGzipHeader(); - - gl2psPrintf("\n"); - gl2psPrintf("\n", - width, height, x, y, width, height); - gl2psPrintf("%s\n", gl2ps->title); - gl2psPrintf("\n"); - gl2psPrintf("Creator: GL2PS %d.%d.%d%s, %s\n" - "For: %s\n" - "CreationDate: %s", - GL2PS_MAJOR_VERSION, GL2PS_MINOR_VERSION, GL2PS_PATCH_VERSION, - GL2PS_EXTRA_VERSION, GL2PS_COPYRIGHT, gl2ps->producer, ctime(&now)); - gl2psPrintf("\n"); - gl2psPrintf("\n"); - gl2psPrintf("\n"); - - if(gl2ps->options & GL2PS_DRAW_BACKGROUND){ - gl2psSVGGetColorString(gl2ps->bgcolor, col); - gl2psPrintf("\n", col, - (int)gl2ps->viewport[0], (int)gl2ps->viewport[1], - (int)gl2ps->viewport[2], (int)gl2ps->viewport[1], - (int)gl2ps->viewport[2], (int)gl2ps->viewport[3], - (int)gl2ps->viewport[0], (int)gl2ps->viewport[3]); - } - - /* group all the primitives and disable antialiasing */ - gl2psPrintf("\n"); -} - -static void gl2psPrintSVGSmoothTriangle(GL2PSxyz xyz[3], GL2PSrgba rgba[3]) -{ - int i; - GL2PSxyz xyz2[3]; - GL2PSrgba rgba2[3]; - char col[32]; - - /* Apparently there is no easy way to do Gouraud shading in SVG - without explicitly pre-defining gradients, so for now we just do - recursive subdivision */ - - if(gl2psSameColorThreshold(3, rgba, gl2ps->threshold)){ - gl2psSVGGetColorString(rgba[0], col); - gl2psPrintf("\n", xyz[0][0], xyz[0][1], - xyz[1][0], xyz[1][1], xyz[2][0], xyz[2][1]); - } - else{ - /* subdivide into 4 subtriangles */ - for(i = 0; i < 3; i++){ - xyz2[0][i] = xyz[0][i]; - xyz2[1][i] = 0.5F * (xyz[0][i] + xyz[1][i]); - xyz2[2][i] = 0.5F * (xyz[0][i] + xyz[2][i]); - } - for(i = 0; i < 4; i++){ - rgba2[0][i] = rgba[0][i]; - rgba2[1][i] = 0.5F * (rgba[0][i] + rgba[1][i]); - rgba2[2][i] = 0.5F * (rgba[0][i] + rgba[2][i]); - } - gl2psPrintSVGSmoothTriangle(xyz2, rgba2); - for(i = 0; i < 3; i++){ - xyz2[0][i] = 0.5F * (xyz[0][i] + xyz[1][i]); - xyz2[1][i] = xyz[1][i]; - xyz2[2][i] = 0.5F * (xyz[1][i] + xyz[2][i]); - } - for(i = 0; i < 4; i++){ - rgba2[0][i] = 0.5F * (rgba[0][i] + rgba[1][i]); - rgba2[1][i] = rgba[1][i]; - rgba2[2][i] = 0.5F * (rgba[1][i] + rgba[2][i]); - } - gl2psPrintSVGSmoothTriangle(xyz2, rgba2); - for(i = 0; i < 3; i++){ - xyz2[0][i] = 0.5F * (xyz[0][i] + xyz[2][i]); - xyz2[1][i] = xyz[2][i]; - xyz2[2][i] = 0.5F * (xyz[1][i] + xyz[2][i]); - } - for(i = 0; i < 4; i++){ - rgba2[0][i] = 0.5F * (rgba[0][i] + rgba[2][i]); - rgba2[1][i] = rgba[2][i]; - rgba2[2][i] = 0.5F * (rgba[1][i] + rgba[2][i]); - } - gl2psPrintSVGSmoothTriangle(xyz2, rgba2); - for(i = 0; i < 3; i++){ - xyz2[0][i] = 0.5F * (xyz[0][i] + xyz[1][i]); - xyz2[1][i] = 0.5F * (xyz[1][i] + xyz[2][i]); - xyz2[2][i] = 0.5F * (xyz[0][i] + xyz[2][i]); - } - for(i = 0; i < 4; i++){ - rgba2[0][i] = 0.5F * (rgba[0][i] + rgba[1][i]); - rgba2[1][i] = 0.5F * (rgba[1][i] + rgba[2][i]); - rgba2[2][i] = 0.5F * (rgba[0][i] + rgba[2][i]); - } - gl2psPrintSVGSmoothTriangle(xyz2, rgba2); - } -} - -static void gl2psPrintSVGDash(GLushort pattern, GLint factor) -{ - int i, n, array[10]; - - if(!pattern || !factor) return; /* solid line */ - - gl2psParseStipplePattern(pattern, factor, &n, array); - gl2psPrintf("stroke-dasharray=\""); - for(i = 0; i < n; i++){ - if(i) gl2psPrintf(","); - gl2psPrintf("%d", array[i]); - } - gl2psPrintf("\" "); -} - -static void gl2psEndSVGLine(void) -{ - int i; - if(gl2ps->lastvertex.rgba[0] >= 0.){ - gl2psPrintf("%g,%g\"/>\n", gl2ps->lastvertex.xyz[0], - gl2ps->viewport[3] - gl2ps->lastvertex.xyz[1]); - for(i = 0; i < 3; i++) - gl2ps->lastvertex.xyz[i] = -1.; - for(i = 0; i < 4; i++) - gl2ps->lastvertex.rgba[i] = -1.; - } -} - -static void gl2psPrintSVGPixmap(GLfloat x, GLfloat y, GL2PSimage *pixmap) -{ -#if defined(GL2PS_HAVE_LIBPNG) - GL2PSlist *png; - unsigned char c; - int i; - - /* The only image types supported by the SVG standard are JPEG, PNG - and SVG. Here we choose PNG, and since we want to embed the image - directly in the SVG stream (and not link to an external image - file), we need to encode the pixmap into PNG in memory, then - encode it into base64. */ - - png = gl2psListCreate(pixmap->width * pixmap->height * 3, 1000, - sizeof(unsigned char)); - gl2psConvertPixmapToPNG(pixmap, png); - gl2psListEncodeBase64(png); - gl2psPrintf("height, pixmap->width, pixmap->height); - gl2psPrintf("xlink:href=\"data:image/png;base64,"); - for(i = 0; i < gl2psListNbr(png); i++){ - gl2psListRead(png, i, &c); - gl2psPrintf("%c", c); - } - gl2psPrintf("\"/>\n"); - gl2psListDelete(png); -#else - (void) x; (void) y; (void) pixmap; /* not used */ - gl2psMsg(GL2PS_WARNING, "GL2PS must be compiled with PNG support in " - "order to embed images in SVG streams"); -#endif -} - -static void gl2psPrintSVGPrimitive(void *data) -{ - GL2PSprimitive *prim; - GL2PSxyz xyz[4]; - GL2PSrgba rgba[4]; - char col[32]; - int newline; - - prim = *(GL2PSprimitive**)data; - - if((gl2ps->options & GL2PS_OCCLUSION_CULL) && prim->culled) return; - - /* We try to draw connected lines as a single path to get nice line - joins and correct stippling. So if the primitive to print is not - a line we must first finish the current line (if any): */ - if(prim->type != GL2PS_LINE) gl2psEndSVGLine(); - - gl2psSVGGetCoordsAndColors(prim->numverts, prim->verts, xyz, rgba); - - switch(prim->type){ - case GL2PS_POINT : - gl2psSVGGetColorString(rgba[0], col); - gl2psPrintf("\n", - xyz[0][0], xyz[0][1], 0.5 * prim->width); - break; - case GL2PS_LINE : - if(!gl2psSamePosition(gl2ps->lastvertex.xyz, prim->verts[0].xyz) || - !gl2psSameColor(gl2ps->lastrgba, prim->verts[0].rgba) || - gl2ps->lastlinewidth != prim->width || - gl2ps->lastpattern != prim->pattern || - gl2ps->lastfactor != prim->factor){ - /* End the current line if the new segment does not start where - the last one ended, or if the color, the width or the - stippling have changed (we will need to use multi-point - gradients for smooth-shaded lines) */ - gl2psEndSVGLine(); - newline = 1; - } - else{ - newline = 0; - } - gl2ps->lastvertex = prim->verts[1]; - gl2psSetLastColor(prim->verts[0].rgba); - gl2ps->lastlinewidth = prim->width; - gl2ps->lastpattern = prim->pattern; - gl2ps->lastfactor = prim->factor; - if(newline){ - gl2psSVGGetColorString(rgba[0], col); - gl2psPrintf("width); - if(rgba[0][3] < 1.0F) gl2psPrintf("stroke-opacity=\"%g\" ", rgba[0][3]); - gl2psPrintSVGDash(prim->pattern, prim->factor); - gl2psPrintf("points=\"%g,%g ", xyz[0][0], xyz[0][1]); - } - else{ - gl2psPrintf("%g,%g ", xyz[0][0], xyz[0][1]); - } - break; - case GL2PS_TRIANGLE : - gl2psPrintSVGSmoothTriangle(xyz, rgba); - break; - case GL2PS_QUADRANGLE : - gl2psMsg(GL2PS_WARNING, "There should not be any quad left to print"); - break; - case GL2PS_PIXMAP : - gl2psPrintSVGPixmap(xyz[0][0], xyz[0][1], prim->data.image); - break; - case GL2PS_TEXT : - gl2psSVGGetColorString(prim->verts[0].rgba, col); - gl2psPrintf("data.text->fontsize); - if(prim->data.text->angle) - gl2psPrintf("transform=\"rotate(%g, %g, %g)\" ", - -prim->data.text->angle, xyz[0][0], xyz[0][1]); - switch(prim->data.text->alignment){ - case GL2PS_TEXT_C: - gl2psPrintf("text-anchor=\"middle\" baseline-shift=\"%d\" ", - -prim->data.text->fontsize / 2); - break; - case GL2PS_TEXT_CL: - gl2psPrintf("text-anchor=\"start\" baseline-shift=\"%d\" ", - -prim->data.text->fontsize / 2); - break; - case GL2PS_TEXT_CR: - gl2psPrintf("text-anchor=\"end\" baseline-shift=\"%d\" ", - -prim->data.text->fontsize / 2); - break; - case GL2PS_TEXT_B: - gl2psPrintf("text-anchor=\"middle\" baseline-shift=\"0\" "); - break; - case GL2PS_TEXT_BR: - gl2psPrintf("text-anchor=\"end\" baseline-shift=\"0\" "); - break; - case GL2PS_TEXT_T: - gl2psPrintf("text-anchor=\"middle\" baseline-shift=\"%d\" ", - -prim->data.text->fontsize); - break; - case GL2PS_TEXT_TL: - gl2psPrintf("text-anchor=\"start\" baseline-shift=\"%d\" ", - -prim->data.text->fontsize); - break; - case GL2PS_TEXT_TR: - gl2psPrintf("text-anchor=\"end\" baseline-shift=\"%d\" ", - -prim->data.text->fontsize); - break; - case GL2PS_TEXT_BL: - default: /* same as GL2PS_TEXT_BL */ - gl2psPrintf("text-anchor=\"start\" baseline-shift=\"0\" "); - break; - } - if(!strcmp(prim->data.text->fontname, "Times-Roman")) - gl2psPrintf("font-family=\"Times\">"); - else if(!strcmp(prim->data.text->fontname, "Times-Bold")) - gl2psPrintf("font-family=\"Times\" font-weight=\"bold\">"); - else if(!strcmp(prim->data.text->fontname, "Times-Italic")) - gl2psPrintf("font-family=\"Times\" font-style=\"italic\">"); - else if(!strcmp(prim->data.text->fontname, "Times-BoldItalic")) - gl2psPrintf("font-family=\"Times\" font-style=\"italic\" font-weight=\"bold\">"); - else if(!strcmp(prim->data.text->fontname, "Helvetica-Bold")) - gl2psPrintf("font-family=\"Helvetica\" font-weight=\"bold\">"); - else if(!strcmp(prim->data.text->fontname, "Helvetica-Oblique")) - gl2psPrintf("font-family=\"Helvetica\" font-style=\"oblique\">"); - else if(!strcmp(prim->data.text->fontname, "Helvetica-BoldOblique")) - gl2psPrintf("font-family=\"Helvetica\" font-style=\"oblique\" font-weight=\"bold\">"); - else if(!strcmp(prim->data.text->fontname, "Courier-Bold")) - gl2psPrintf("font-family=\"Courier\" font-weight=\"bold\">"); - else if(!strcmp(prim->data.text->fontname, "Courier-Oblique")) - gl2psPrintf("font-family=\"Courier\" font-style=\"oblique\">"); - else if(!strcmp(prim->data.text->fontname, "Courier-BoldOblique")) - gl2psPrintf("font-family=\"Courier\" font-style=\"oblique\" font-weight=\"bold\">"); - else - gl2psPrintf("font-family=\"%s\">", prim->data.text->fontname); - gl2psPrintf("%s\n", prim->data.text->str); - break; - case GL2PS_SPECIAL : - /* alignment contains the format for which the special output text - is intended */ - if(prim->data.text->alignment == GL2PS_SVG) - gl2psPrintf("%s\n", prim->data.text->str); - break; - default : - break; - } -} - -static void gl2psPrintSVGFooter(void) -{ - gl2psPrintf("\n"); - gl2psPrintf("\n"); - - gl2psPrintGzipFooter(); -} - -static void gl2psPrintSVGBeginViewport(GLint viewport[4]) -{ - GLint index; - char col[32]; - GLfloat rgba[4]; - int x = viewport[0], y = viewport[1], w = viewport[2], h = viewport[3]; - - glRenderMode(GL_FEEDBACK); - - if(gl2ps->header){ - gl2psPrintSVGHeader(); - gl2ps->header = GL_FALSE; - } - - if(gl2ps->options & GL2PS_DRAW_BACKGROUND){ - if(gl2ps->colormode == GL_RGBA || gl2ps->colorsize == 0){ - glGetFloatv(GL_COLOR_CLEAR_VALUE, rgba); - } - else{ - glGetIntegerv(GL_INDEX_CLEAR_VALUE, &index); - rgba[0] = gl2ps->colormap[index][0]; - rgba[1] = gl2ps->colormap[index][1]; - rgba[2] = gl2ps->colormap[index][2]; - rgba[3] = 1.0F; - } - gl2psSVGGetColorString(rgba, col); - gl2psPrintf("\n", col, - x, gl2ps->viewport[3] - y, - x + w, gl2ps->viewport[3] - y, - x + w, gl2ps->viewport[3] - (y + h), - x, gl2ps->viewport[3] - (y + h)); - } - - gl2psPrintf("\n", x, y, w, h); - gl2psPrintf(" \n", - x, gl2ps->viewport[3] - y, - x + w, gl2ps->viewport[3] - y, - x + w, gl2ps->viewport[3] - (y + h), - x, gl2ps->viewport[3] - (y + h)); - gl2psPrintf("\n"); - gl2psPrintf("\n", x, y, w, h); -} - -static GLint gl2psPrintSVGEndViewport(void) -{ - GLint res; - - res = gl2psPrintPrimitives(); - gl2psPrintf("\n"); - return res; -} - -static void gl2psPrintSVGFinalPrimitive(void) -{ - /* End any remaining line, if any */ - gl2psEndSVGLine(); -} - -/* definition of the SVG backend */ - -static GL2PSbackend gl2psSVG = { - gl2psPrintSVGHeader, - gl2psPrintSVGFooter, - gl2psPrintSVGBeginViewport, - gl2psPrintSVGEndViewport, - gl2psPrintSVGPrimitive, - gl2psPrintSVGFinalPrimitive, - "svg", - "Scalable Vector Graphics" -}; - -/********************************************************************* - * - * PGF routines - * - *********************************************************************/ - -static void gl2psPrintPGFColor(GL2PSrgba rgba) -{ - if(!gl2psSameColor(gl2ps->lastrgba, rgba)){ - gl2psSetLastColor(rgba); - fprintf(gl2ps->stream, "\\color[rgb]{%f,%f,%f}\n", rgba[0], rgba[1], rgba[2]); - } -} - -static void gl2psPrintPGFHeader(void) -{ - time_t now; - - time(&now); - - fprintf(gl2ps->stream, - "%% Title: %s\n" - "%% Creator: GL2PS %d.%d.%d%s, %s\n" - "%% For: %s\n" - "%% CreationDate: %s", - gl2ps->title, GL2PS_MAJOR_VERSION, GL2PS_MINOR_VERSION, - GL2PS_PATCH_VERSION, GL2PS_EXTRA_VERSION, GL2PS_COPYRIGHT, - gl2ps->producer, ctime(&now)); - - fprintf(gl2ps->stream, "\\begin{pgfpicture}\n"); - if(gl2ps->options & GL2PS_DRAW_BACKGROUND){ - gl2psPrintPGFColor(gl2ps->bgcolor); - fprintf(gl2ps->stream, - "\\pgfpathrectanglecorners{" - "\\pgfpoint{%dpt}{%dpt}}{\\pgfpoint{%dpt}{%dpt}}\n" - "\\pgfusepath{fill}\n", - (int)gl2ps->viewport[0], (int)gl2ps->viewport[1], - (int)gl2ps->viewport[2], (int)gl2ps->viewport[3]); - } -} - -static void gl2psPrintPGFDash(GLushort pattern, GLint factor) -{ - int i, n, array[10]; - - if(pattern == gl2ps->lastpattern && factor == gl2ps->lastfactor) - return; - - gl2ps->lastpattern = pattern; - gl2ps->lastfactor = factor; - - if(!pattern || !factor){ - /* solid line */ - fprintf(gl2ps->stream, "\\pgfsetdash{}{0pt}\n"); - } - else{ - gl2psParseStipplePattern(pattern, factor, &n, array); - fprintf(gl2ps->stream, "\\pgfsetdash{"); - for(i = 0; i < n; i++) fprintf(gl2ps->stream, "{%dpt}", array[i]); - fprintf(gl2ps->stream, "}{0pt}\n"); - } -} - -static const char *gl2psPGFTextAlignment(int align) -{ - switch(align){ - case GL2PS_TEXT_C : return "center"; - case GL2PS_TEXT_CL : return "west"; - case GL2PS_TEXT_CR : return "east"; - case GL2PS_TEXT_B : return "south"; - case GL2PS_TEXT_BR : return "south east"; - case GL2PS_TEXT_T : return "north"; - case GL2PS_TEXT_TL : return "north west"; - case GL2PS_TEXT_TR : return "north east"; - case GL2PS_TEXT_BL : - default : return "south west"; - } -} - -static void gl2psPrintPGFPrimitive(void *data) -{ - GL2PSprimitive *prim; - - prim = *(GL2PSprimitive**)data; - - switch(prim->type){ - case GL2PS_POINT : - /* Points in openGL are rectangular */ - gl2psPrintPGFColor(prim->verts[0].rgba); - fprintf(gl2ps->stream, - "\\pgfpathrectangle{\\pgfpoint{%fpt}{%fpt}}" - "{\\pgfpoint{%fpt}{%fpt}}\n\\pgfusepath{fill}\n", - prim->verts[0].xyz[0]-0.5*prim->width, - prim->verts[0].xyz[1]-0.5*prim->width, - prim->width,prim->width); - break; - case GL2PS_LINE : - gl2psPrintPGFColor(prim->verts[0].rgba); - if(gl2ps->lastlinewidth != prim->width){ - gl2ps->lastlinewidth = prim->width; - fprintf(gl2ps->stream, "\\pgfsetlinewidth{%fpt}\n", gl2ps->lastlinewidth); - } - gl2psPrintPGFDash(prim->pattern, prim->factor); - fprintf(gl2ps->stream, - "\\pgfpathmoveto{\\pgfpoint{%fpt}{%fpt}}\n" - "\\pgflineto{\\pgfpoint{%fpt}{%fpt}}\n" - "\\pgfusepath{stroke}\n", - prim->verts[1].xyz[0], prim->verts[1].xyz[1], - prim->verts[0].xyz[0], prim->verts[0].xyz[1]); - break; - case GL2PS_TRIANGLE : - if(gl2ps->lastlinewidth != 0){ - gl2ps->lastlinewidth = 0; - fprintf(gl2ps->stream, "\\pgfsetlinewidth{0.01pt}\n"); - } - gl2psPrintPGFColor(prim->verts[0].rgba); - fprintf(gl2ps->stream, - "\\pgfpathmoveto{\\pgfpoint{%fpt}{%fpt}}\n" - "\\pgflineto{\\pgfpoint{%fpt}{%fpt}}\n" - "\\pgflineto{\\pgfpoint{%fpt}{%fpt}}\n" - "\\pgfpathclose\n" - "\\pgfusepath{fill,stroke}\n", - prim->verts[2].xyz[0], prim->verts[2].xyz[1], - prim->verts[1].xyz[0], prim->verts[1].xyz[1], - prim->verts[0].xyz[0], prim->verts[0].xyz[1]); - break; - case GL2PS_TEXT : - fprintf(gl2ps->stream, "{\n\\pgftransformshift{\\pgfpoint{%fpt}{%fpt}}\n", - prim->verts[0].xyz[0], prim->verts[0].xyz[1]); - - if(prim->data.text->angle) - fprintf(gl2ps->stream, "\\pgftransformrotate{%f}{", prim->data.text->angle); - - fprintf(gl2ps->stream, "\\pgfnode{rectangle}{%s}{\\fontsize{%d}{0}\\selectfont", - gl2psPGFTextAlignment(prim->data.text->alignment), - prim->data.text->fontsize); - - fprintf(gl2ps->stream, "\\textcolor[rgb]{%g,%g,%g}{{%s}}", - prim->verts[0].rgba[0], prim->verts[0].rgba[1], - prim->verts[0].rgba[2], prim->data.text->str); - - fprintf(gl2ps->stream, "}{}{\\pgfusepath{discard}}}\n"); - break; - case GL2PS_SPECIAL : - /* alignment contains the format for which the special output text - is intended */ - if (prim->data.text->alignment == GL2PS_PGF) - fprintf(gl2ps->stream, "%s\n", prim->data.text->str); - break; - default : - break; - } -} - -static void gl2psPrintPGFFooter(void) -{ - fprintf(gl2ps->stream, "\\end{pgfpicture}\n"); -} - -static void gl2psPrintPGFBeginViewport(GLint viewport[4]) -{ - GLint index; - GLfloat rgba[4]; - int x = viewport[0], y = viewport[1], w = viewport[2], h = viewport[3]; - - glRenderMode(GL_FEEDBACK); - - if(gl2ps->header){ - gl2psPrintPGFHeader(); - gl2ps->header = GL_FALSE; - } - - fprintf(gl2ps->stream, "\\begin{pgfscope}\n"); - if(gl2ps->options & GL2PS_DRAW_BACKGROUND){ - if(gl2ps->colormode == GL_RGBA || gl2ps->colorsize == 0){ - glGetFloatv(GL_COLOR_CLEAR_VALUE, rgba); - } - else{ - glGetIntegerv(GL_INDEX_CLEAR_VALUE, &index); - rgba[0] = gl2ps->colormap[index][0]; - rgba[1] = gl2ps->colormap[index][1]; - rgba[2] = gl2ps->colormap[index][2]; - rgba[3] = 1.0F; - } - gl2psPrintPGFColor(rgba); - fprintf(gl2ps->stream, - "\\pgfpathrectangle{\\pgfpoint{%dpt}{%dpt}}" - "{\\pgfpoint{%dpt}{%dpt}}\n" - "\\pgfusepath{fill}\n", - x, y, w, h); - } - - fprintf(gl2ps->stream, - "\\pgfpathrectangle{\\pgfpoint{%dpt}{%dpt}}" - "{\\pgfpoint{%dpt}{%dpt}}\n" - "\\pgfusepath{clip}\n", - x, y, w, h); -} - -static GLint gl2psPrintPGFEndViewport(void) -{ - GLint res; - res = gl2psPrintPrimitives(); - fprintf(gl2ps->stream, "\\end{pgfscope}\n"); - return res; -} - -static void gl2psPrintPGFFinalPrimitive(void) -{ -} - -/* definition of the PGF backend */ - -static GL2PSbackend gl2psPGF = { - gl2psPrintPGFHeader, - gl2psPrintPGFFooter, - gl2psPrintPGFBeginViewport, - gl2psPrintPGFEndViewport, - gl2psPrintPGFPrimitive, - gl2psPrintPGFFinalPrimitive, - "tex", - "PGF Latex Graphics" -}; - -/********************************************************************* - * - * General primitive printing routine - * - *********************************************************************/ - -/* Warning: the ordering of the backends must match the format - #defines in gl2ps.h */ - -static GL2PSbackend *gl2psbackends[] = { - &gl2psPS, /* 0 */ - &gl2psEPS, /* 1 */ - &gl2psTEX, /* 2 */ - &gl2psPDF, /* 3 */ - &gl2psSVG, /* 4 */ - &gl2psPGF /* 5 */ -}; - -static void gl2psComputeTightBoundingBox(void *data) -{ - GL2PSprimitive *prim; - int i; - - prim = *(GL2PSprimitive**)data; - - for(i = 0; i < prim->numverts; i++){ - if(prim->verts[i].xyz[0] < gl2ps->viewport[0]) - gl2ps->viewport[0] = (GLint)prim->verts[i].xyz[0]; - if(prim->verts[i].xyz[0] > gl2ps->viewport[2]) - gl2ps->viewport[2] = (GLint)(prim->verts[i].xyz[0] + 0.5F); - if(prim->verts[i].xyz[1] < gl2ps->viewport[1]) - gl2ps->viewport[1] = (GLint)prim->verts[i].xyz[1]; - if(prim->verts[i].xyz[1] > gl2ps->viewport[3]) - gl2ps->viewport[3] = (GLint)(prim->verts[i].xyz[1] + 0.5F); - } -} - -static GLint gl2psPrintPrimitives(void) -{ - GL2PSbsptree *root; - GL2PSxyz eye = {0.0F, 0.0F, 100.0F * GL2PS_ZSCALE}; - GLint used; - - used = glRenderMode(GL_RENDER); - - if(used < 0){ - gl2psMsg(GL2PS_INFO, "OpenGL feedback buffer overflow"); - return GL2PS_OVERFLOW; - } - - if(used > 0) - gl2psParseFeedbackBuffer(used); - - gl2psRescaleAndOffset(); - - if(gl2ps->header){ - if(gl2psListNbr(gl2ps->primitives) && - (gl2ps->options & GL2PS_TIGHT_BOUNDING_BOX)){ - gl2ps->viewport[0] = gl2ps->viewport[1] = 100000; - gl2ps->viewport[2] = gl2ps->viewport[3] = -100000; - gl2psListAction(gl2ps->primitives, gl2psComputeTightBoundingBox); - } - (gl2psbackends[gl2ps->format]->printHeader)(); - gl2ps->header = GL_FALSE; - } - - if(!gl2psListNbr(gl2ps->primitives)){ - /* empty feedback buffer and/or nothing else to print */ - return GL2PS_NO_FEEDBACK; - } - - switch(gl2ps->sort){ - case GL2PS_NO_SORT : - gl2psListAction(gl2ps->primitives, gl2psbackends[gl2ps->format]->printPrimitive); - gl2psListAction(gl2ps->primitives, gl2psFreePrimitive); - /* reset the primitive list, waiting for the next viewport */ - gl2psListReset(gl2ps->primitives); - break; - case GL2PS_SIMPLE_SORT : - gl2psListSort(gl2ps->primitives, gl2psCompareDepth); - if(gl2ps->options & GL2PS_OCCLUSION_CULL){ - gl2psListActionInverse(gl2ps->primitives, gl2psAddInImageTree); - gl2psFreeBspImageTree(&gl2ps->imagetree); - } - gl2psListAction(gl2ps->primitives, gl2psbackends[gl2ps->format]->printPrimitive); - gl2psListAction(gl2ps->primitives, gl2psFreePrimitive); - /* reset the primitive list, waiting for the next viewport */ - gl2psListReset(gl2ps->primitives); - break; - case GL2PS_BSP_SORT : - root = (GL2PSbsptree*)gl2psMalloc(sizeof(GL2PSbsptree)); - gl2psBuildBspTree(root, gl2ps->primitives); - if(GL_TRUE == gl2ps->boundary) gl2psBuildPolygonBoundary(root); - if(gl2ps->options & GL2PS_OCCLUSION_CULL){ - gl2psTraverseBspTree(root, eye, -GL2PS_EPSILON, gl2psLess, - gl2psAddInImageTree, 1); - gl2psFreeBspImageTree(&gl2ps->imagetree); - } - gl2psTraverseBspTree(root, eye, GL2PS_EPSILON, gl2psGreater, - gl2psbackends[gl2ps->format]->printPrimitive, 0); - gl2psFreeBspTree(&root); - /* reallocate the primitive list (it's been deleted by - gl2psBuildBspTree) in case there is another viewport */ - gl2ps->primitives = gl2psListCreate(500, 500, sizeof(GL2PSprimitive*)); - break; - } - gl2psbackends[gl2ps->format]->printFinalPrimitive(); - - return GL2PS_SUCCESS; -} - -/********************************************************************* - * - * Public routines - * - *********************************************************************/ - -GL2PSDLL_API GLint gl2psBeginPage(const char *title, const char *producer, - GLint viewport[4], GLint format, GLint sort, - GLint options, GLint colormode, - GLint colorsize, GL2PSrgba *colormap, - GLint nr, GLint ng, GLint nb, GLint buffersize, - FILE *stream, const char *filename) -{ - GLint index; - int i; - - if(gl2ps){ - gl2psMsg(GL2PS_ERROR, "gl2psBeginPage called in wrong program state"); - return GL2PS_ERROR; - } - - gl2ps = (GL2PScontext*)gl2psMalloc(sizeof(GL2PScontext)); - - if(format >= 0 && format < (GLint)(sizeof(gl2psbackends) / sizeof(gl2psbackends[0]))){ - gl2ps->format = format; - } - else { - gl2psMsg(GL2PS_ERROR, "Unknown output format: %d", format); - gl2psFree(gl2ps); - gl2ps = NULL; - return GL2PS_ERROR; - } - - switch(sort){ - case GL2PS_NO_SORT : - case GL2PS_SIMPLE_SORT : - case GL2PS_BSP_SORT : - gl2ps->sort = sort; - break; - default : - gl2psMsg(GL2PS_ERROR, "Unknown sorting algorithm: %d", sort); - gl2psFree(gl2ps); - gl2ps = NULL; - return GL2PS_ERROR; - } - - if(stream){ - gl2ps->stream = stream; - } - else{ - gl2psMsg(GL2PS_ERROR, "Bad file pointer"); - gl2psFree(gl2ps); - gl2ps = NULL; - return GL2PS_ERROR; - } - - gl2ps->header = GL_TRUE; - gl2ps->maxbestroot = 10; - gl2ps->options = options; - gl2ps->compress = NULL; - gl2ps->imagemap_head = NULL; - gl2ps->imagemap_tail = NULL; - - if(gl2ps->options & GL2PS_USE_CURRENT_VIEWPORT){ - glGetIntegerv(GL_VIEWPORT, gl2ps->viewport); - } - else{ - for(i = 0; i < 4; i++){ - gl2ps->viewport[i] = viewport[i]; - } - } - - if(!gl2ps->viewport[2] || !gl2ps->viewport[3]){ - gl2psMsg(GL2PS_ERROR, "Incorrect viewport (x=%d, y=%d, width=%d, height=%d)", - gl2ps->viewport[0], gl2ps->viewport[1], - gl2ps->viewport[2], gl2ps->viewport[3]); - gl2psFree(gl2ps); - gl2ps = NULL; - return GL2PS_ERROR; - } - - gl2ps->threshold[0] = nr ? 1.0F / (GLfloat)nr : 0.064F; - gl2ps->threshold[1] = ng ? 1.0F / (GLfloat)ng : 0.034F; - gl2ps->threshold[2] = nb ? 1.0F / (GLfloat)nb : 0.100F; - gl2ps->colormode = colormode; - gl2ps->buffersize = buffersize > 0 ? buffersize : 2048 * 2048; - for(i = 0; i < 3; i++){ - gl2ps->lastvertex.xyz[i] = -1.0F; - } - for(i = 0; i < 4; i++){ - gl2ps->lastvertex.rgba[i] = -1.0F; - gl2ps->lastrgba[i] = -1.0F; - } - gl2ps->lastlinewidth = -1.0F; - gl2ps->lastpattern = 0; - gl2ps->lastfactor = 0; - gl2ps->imagetree = NULL; - gl2ps->primitivetoadd = NULL; - gl2ps->zerosurfacearea = GL_FALSE; - gl2ps->pdfprimlist = NULL; - gl2ps->pdfgrouplist = NULL; - gl2ps->xreflist = NULL; - - /* get default blending mode from current OpenGL state (enabled by - default for SVG) */ - gl2ps->blending = (gl2ps->format == GL2PS_SVG) ? GL_TRUE : glIsEnabled(GL_BLEND); - glGetIntegerv(GL_BLEND_SRC, &gl2ps->blendfunc[0]); - glGetIntegerv(GL_BLEND_DST, &gl2ps->blendfunc[1]); - - if(gl2ps->colormode == GL_RGBA){ - gl2ps->colorsize = 0; - gl2ps->colormap = NULL; - glGetFloatv(GL_COLOR_CLEAR_VALUE, gl2ps->bgcolor); - } - else if(gl2ps->colormode == GL_COLOR_INDEX){ - if(!colorsize || !colormap){ - gl2psMsg(GL2PS_ERROR, "Missing colormap for GL_COLOR_INDEX rendering"); - gl2psFree(gl2ps); - gl2ps = NULL; - return GL2PS_ERROR; - } - gl2ps->colorsize = colorsize; - gl2ps->colormap = (GL2PSrgba*)gl2psMalloc(gl2ps->colorsize * sizeof(GL2PSrgba)); - memcpy(gl2ps->colormap, colormap, gl2ps->colorsize * sizeof(GL2PSrgba)); - glGetIntegerv(GL_INDEX_CLEAR_VALUE, &index); - gl2ps->bgcolor[0] = gl2ps->colormap[index][0]; - gl2ps->bgcolor[1] = gl2ps->colormap[index][1]; - gl2ps->bgcolor[2] = gl2ps->colormap[index][2]; - gl2ps->bgcolor[3] = 1.0F; - } - else{ - gl2psMsg(GL2PS_ERROR, "Unknown color mode in gl2psBeginPage"); - gl2psFree(gl2ps); - gl2ps = NULL; - return GL2PS_ERROR; - } - - if(!title){ - gl2ps->title = (char*)gl2psMalloc(sizeof(char)); - gl2ps->title[0] = '\0'; - } - else{ - gl2ps->title = (char*)gl2psMalloc((strlen(title)+1)*sizeof(char)); - strcpy(gl2ps->title, title); - } - - if(!producer){ - gl2ps->producer = (char*)gl2psMalloc(sizeof(char)); - gl2ps->producer[0] = '\0'; - } - else{ - gl2ps->producer = (char*)gl2psMalloc((strlen(producer)+1)*sizeof(char)); - strcpy(gl2ps->producer, producer); - } - - if(!filename){ - gl2ps->filename = (char*)gl2psMalloc(sizeof(char)); - gl2ps->filename[0] = '\0'; - } - else{ - gl2ps->filename = (char*)gl2psMalloc((strlen(filename)+1)*sizeof(char)); - strcpy(gl2ps->filename, filename); - } - - gl2ps->primitives = gl2psListCreate(500, 500, sizeof(GL2PSprimitive*)); - gl2ps->auxprimitives = gl2psListCreate(100, 100, sizeof(GL2PSprimitive*)); - gl2ps->feedback = (GLfloat*)gl2psMalloc(gl2ps->buffersize * sizeof(GLfloat)); - glFeedbackBuffer(gl2ps->buffersize, GL_3D_COLOR, gl2ps->feedback); - glRenderMode(GL_FEEDBACK); - - return GL2PS_SUCCESS; -} - -GL2PSDLL_API GLint gl2psEndPage(void) -{ - GLint res; - - if(!gl2ps) return GL2PS_UNINITIALIZED; - - res = gl2psPrintPrimitives(); - - if(res != GL2PS_OVERFLOW) - (gl2psbackends[gl2ps->format]->printFooter)(); - - fflush(gl2ps->stream); - - gl2psListDelete(gl2ps->primitives); - gl2psListDelete(gl2ps->auxprimitives); - gl2psFreeImagemap(gl2ps->imagemap_head); - gl2psFree(gl2ps->colormap); - gl2psFree(gl2ps->title); - gl2psFree(gl2ps->producer); - gl2psFree(gl2ps->filename); - gl2psFree(gl2ps->feedback); - gl2psFree(gl2ps); - gl2ps = NULL; - - return res; -} - -GL2PSDLL_API GLint gl2psBeginViewport(GLint viewport[4]) -{ - if(!gl2ps) return GL2PS_UNINITIALIZED; - - (gl2psbackends[gl2ps->format]->beginViewport)(viewport); - - return GL2PS_SUCCESS; -} - -GL2PSDLL_API GLint gl2psEndViewport(void) -{ - GLint res; - - if(!gl2ps) return GL2PS_UNINITIALIZED; - - res = (gl2psbackends[gl2ps->format]->endViewport)(); - - /* reset last used colors, line widths */ - gl2ps->lastlinewidth = -1.0F; - - return res; -} - -GL2PSDLL_API GLint gl2psTextOpt(const char *str, const char *fontname, - GLshort fontsize, GLint alignment, GLfloat angle) -{ - return gl2psAddText(GL2PS_TEXT, str, fontname, fontsize, alignment, angle); -} - -GL2PSDLL_API GLint gl2psText(const char *str, const char *fontname, GLshort fontsize) -{ - return gl2psAddText(GL2PS_TEXT, str, fontname, fontsize, GL2PS_TEXT_BL, 0.0F); -} - -GL2PSDLL_API GLint gl2psSpecial(GLint format, const char *str) -{ - return gl2psAddText(GL2PS_SPECIAL, str, "", 0, format, 0.0F); -} - -GL2PSDLL_API GLint gl2psDrawPixels(GLsizei width, GLsizei height, - GLint xorig, GLint yorig, - GLenum format, GLenum type, - const void *pixels) -{ - int size, i; - const GLfloat *piv; - GLfloat pos[4], zoom_x, zoom_y; - GL2PSprimitive *prim; - GLboolean valid; - - if(!gl2ps || !pixels) return GL2PS_UNINITIALIZED; - - if((width <= 0) || (height <= 0)) return GL2PS_ERROR; - - if(gl2ps->options & GL2PS_NO_PIXMAP) return GL2PS_SUCCESS; - - if((format != GL_RGB && format != GL_RGBA) || type != GL_FLOAT){ - gl2psMsg(GL2PS_ERROR, "gl2psDrawPixels only implemented for " - "GL_RGB/GL_RGBA, GL_FLOAT pixels"); - return GL2PS_ERROR; - } - - glGetBooleanv(GL_CURRENT_RASTER_POSITION_VALID, &valid); - if(GL_FALSE == valid) return GL2PS_SUCCESS; /* the primitive is culled */ - - glGetFloatv(GL_CURRENT_RASTER_POSITION, pos); - glGetFloatv(GL_ZOOM_X, &zoom_x); - glGetFloatv(GL_ZOOM_Y, &zoom_y); - - prim = (GL2PSprimitive*)gl2psMalloc(sizeof(GL2PSprimitive)); - prim->type = GL2PS_PIXMAP; - prim->boundary = 0; - prim->numverts = 1; - prim->verts = (GL2PSvertex*)gl2psMalloc(sizeof(GL2PSvertex)); - prim->verts[0].xyz[0] = pos[0] + xorig; - prim->verts[0].xyz[1] = pos[1] + yorig; - prim->verts[0].xyz[2] = pos[2]; - prim->culled = 0; - prim->offset = 0; - prim->pattern = 0; - prim->factor = 0; - prim->width = 1; - glGetFloatv(GL_CURRENT_RASTER_COLOR, prim->verts[0].rgba); - prim->data.image = (GL2PSimage*)gl2psMalloc(sizeof(GL2PSimage)); - prim->data.image->width = width; - prim->data.image->height = height; - prim->data.image->zoom_x = zoom_x; - prim->data.image->zoom_y = zoom_y; - prim->data.image->format = format; - prim->data.image->type = type; - - switch(format){ - case GL_RGBA: - if(gl2ps->options & GL2PS_NO_BLENDING || !gl2ps->blending){ - /* special case: blending turned off */ - prim->data.image->format = GL_RGB; - size = height * width * 3; - prim->data.image->pixels = (GLfloat*)gl2psMalloc(size * sizeof(GLfloat)); - piv = (const GLfloat*)pixels; - for(i = 0; i < size; ++i, ++piv){ - prim->data.image->pixels[i] = *piv; - if(!((i + 1) % 3)) - ++piv; - } - } - else{ - size = height * width * 4; - prim->data.image->pixels = (GLfloat*)gl2psMalloc(size * sizeof(GLfloat)); - memcpy(prim->data.image->pixels, pixels, size * sizeof(GLfloat)); - } - break; - case GL_RGB: - default: - size = height * width * 3; - prim->data.image->pixels = (GLfloat*)gl2psMalloc(size * sizeof(GLfloat)); - memcpy(prim->data.image->pixels, pixels, size * sizeof(GLfloat)); - break; - } - - gl2psListAdd(gl2ps->auxprimitives, &prim); - glPassThrough(GL2PS_DRAW_PIXELS_TOKEN); - - return GL2PS_SUCCESS; -} - -GL2PSDLL_API GLint gl2psDrawImageMap(GLsizei width, GLsizei height, - const GLfloat position[3], - const unsigned char *imagemap){ - int size, i; - int sizeoffloat = sizeof(GLfloat); - - if(!gl2ps || !imagemap) return GL2PS_UNINITIALIZED; - - if((width <= 0) || (height <= 0)) return GL2PS_ERROR; - - size = height + height * ((width - 1) / 8); - glPassThrough(GL2PS_IMAGEMAP_TOKEN); - glBegin(GL_POINTS); - glVertex3f(position[0], position[1],position[2]); - glEnd(); - glPassThrough((GLfloat)width); - glPassThrough((GLfloat)height); - for(i = 0; i < size; i += sizeoffloat){ - const float *value = (const float*)imagemap; - glPassThrough(*value); - imagemap += sizeoffloat; - } - return GL2PS_SUCCESS; -} - -GL2PSDLL_API GLint gl2psEnable(GLint mode) -{ - GLint tmp; - - if(!gl2ps) return GL2PS_UNINITIALIZED; - - switch(mode){ - case GL2PS_POLYGON_OFFSET_FILL : - glPassThrough(GL2PS_BEGIN_OFFSET_TOKEN); - glGetFloatv(GL_POLYGON_OFFSET_FACTOR, &gl2ps->offset[0]); - glGetFloatv(GL_POLYGON_OFFSET_UNITS, &gl2ps->offset[1]); - break; - case GL2PS_POLYGON_BOUNDARY : - glPassThrough(GL2PS_BEGIN_BOUNDARY_TOKEN); - break; - case GL2PS_LINE_STIPPLE : - glPassThrough(GL2PS_BEGIN_STIPPLE_TOKEN); - glGetIntegerv(GL_LINE_STIPPLE_PATTERN, &tmp); - glPassThrough((GLfloat)tmp); - glGetIntegerv(GL_LINE_STIPPLE_REPEAT, &tmp); - glPassThrough((GLfloat)tmp); - break; - case GL2PS_BLEND : - glPassThrough(GL2PS_BEGIN_BLEND_TOKEN); - break; - default : - gl2psMsg(GL2PS_WARNING, "Unknown mode in gl2psEnable: %d", mode); - return GL2PS_WARNING; - } - - return GL2PS_SUCCESS; -} - -GL2PSDLL_API GLint gl2psDisable(GLint mode) -{ - if(!gl2ps) return GL2PS_UNINITIALIZED; - - switch(mode){ - case GL2PS_POLYGON_OFFSET_FILL : - glPassThrough(GL2PS_END_OFFSET_TOKEN); - break; - case GL2PS_POLYGON_BOUNDARY : - glPassThrough(GL2PS_END_BOUNDARY_TOKEN); - break; - case GL2PS_LINE_STIPPLE : - glPassThrough(GL2PS_END_STIPPLE_TOKEN); - break; - case GL2PS_BLEND : - glPassThrough(GL2PS_END_BLEND_TOKEN); - break; - default : - gl2psMsg(GL2PS_WARNING, "Unknown mode in gl2psDisable: %d", mode); - return GL2PS_WARNING; - } - - return GL2PS_SUCCESS; -} - -GL2PSDLL_API GLint gl2psPointSize(GLfloat value) -{ - if(!gl2ps) return GL2PS_UNINITIALIZED; - - glPassThrough(GL2PS_POINT_SIZE_TOKEN); - glPassThrough(value); - - return GL2PS_SUCCESS; -} - -GL2PSDLL_API GLint gl2psLineWidth(GLfloat value) -{ - if(!gl2ps) return GL2PS_UNINITIALIZED; - - glPassThrough(GL2PS_LINE_WIDTH_TOKEN); - glPassThrough(value); - - return GL2PS_SUCCESS; -} - -GL2PSDLL_API GLint gl2psBlendFunc(GLenum sfactor, GLenum dfactor) -{ - if(!gl2ps) return GL2PS_UNINITIALIZED; - - if(GL_FALSE == gl2psSupportedBlendMode(sfactor, dfactor)) - return GL2PS_WARNING; - - glPassThrough(GL2PS_SRC_BLEND_TOKEN); - glPassThrough((GLfloat)sfactor); - glPassThrough(GL2PS_DST_BLEND_TOKEN); - glPassThrough((GLfloat)dfactor); - - return GL2PS_SUCCESS; -} - -GL2PSDLL_API GLint gl2psSetOptions(GLint options) -{ - if(!gl2ps) return GL2PS_UNINITIALIZED; - - gl2ps->options = options; - - return GL2PS_SUCCESS; -} - -GL2PSDLL_API GLint gl2psGetOptions(GLint *options) -{ - if(!gl2ps) { - *options = 0; - return GL2PS_UNINITIALIZED; - } - - *options = gl2ps->options; - - return GL2PS_SUCCESS; -} - -GL2PSDLL_API const char *gl2psGetFileExtension(GLint format) -{ - if(format >= 0 && format < (GLint)(sizeof(gl2psbackends) / sizeof(gl2psbackends[0]))) - return gl2psbackends[format]->file_extension; - else - return "Unknown format"; -} - -GL2PSDLL_API const char *gl2psGetFormatDescription(GLint format) -{ - if(format >= 0 && format < (GLint)(sizeof(gl2psbackends) / sizeof(gl2psbackends[0]))) - return gl2psbackends[format]->description; - else - return "Unknown format"; -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/gl2ps.h --- a/libinterp/interp-core/gl2ps.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,200 +0,0 @@ -/* - * GL2PS, an OpenGL to PostScript Printing Library - * Copyright (C) 1999-2011 C. Geuzaine - * - * This program is free software; you can redistribute it and/or - * modify it under the terms of either: - * - * a) the GNU Library General Public License as published by the Free - * Software Foundation, either version 2 of the License, or (at your - * option) any later version; or - * - * b) the GL2PS License as published by Christophe Geuzaine, either - * version 2 of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, but - * WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either - * the GNU Library General Public License or the GL2PS License for - * more details. - * - * You should have received a copy of the GNU Library General Public - * License along with this library in the file named "COPYING.LGPL"; - * if not, write to the Free Software Foundation, Inc., 675 Mass Ave, - * Cambridge, MA 02139, USA. - * - * You should have received a copy of the GL2PS License with this - * library in the file named "COPYING.GL2PS"; if not, I will be glad - * to provide one. - * - * For the latest info about gl2ps and a full list of contributors, - * see http://www.geuz.org/gl2ps/. - * - * Please report all bugs and problems to . - */ - -#ifndef __GL2PS_H__ -#define __GL2PS_H__ - -#include -#include - -/* Define GL2PSDLL at compile time to build a Windows DLL */ - -#if defined(WIN32) || defined(_WIN32) || defined(__WIN32__) || defined(__NT__) -# if defined(_MSC_VER) -# pragma warning(disable:4115) -# pragma warning(disable:4996) -# endif -# define WIN32_LEAN_AND_MEAN -# include -# if defined(GL2PSDLL) -# if defined(GL2PSDLL_EXPORTS) -# define GL2PSDLL_API __declspec(dllexport) -# else -# define GL2PSDLL_API __declspec(dllimport) -# endif -# else -# define GL2PSDLL_API -# endif -#else -# define GL2PSDLL_API -#endif - -#if defined(__APPLE__) || defined(HAVE_OPENGL_GL_H) -# include -#else -# include -#endif - -/* Support for compressed PostScript/PDF/SVG and for embedded PNG - images in SVG */ - -#if defined(HAVE_ZLIB) || defined(HAVE_LIBZ) -# define GL2PS_HAVE_ZLIB -# if defined(HAVE_LIBPNG) || defined(HAVE_PNG) -# define GL2PS_HAVE_LIBPNG -# endif -#endif - -/* Version number */ - -#define GL2PS_MAJOR_VERSION 1 -#define GL2PS_MINOR_VERSION 3 -#define GL2PS_PATCH_VERSION 6 -#define GL2PS_EXTRA_VERSION "" - -#define GL2PS_VERSION (GL2PS_MAJOR_VERSION + \ - 0.01 * GL2PS_MINOR_VERSION + \ - 0.0001 * GL2PS_PATCH_VERSION) - -#define GL2PS_COPYRIGHT "(C) 1999-2011 C. Geuzaine" - -/* Output file formats (the values and the ordering are important!) */ - -#define GL2PS_PS 0 -#define GL2PS_EPS 1 -#define GL2PS_TEX 2 -#define GL2PS_PDF 3 -#define GL2PS_SVG 4 -#define GL2PS_PGF 5 - -/* Sorting algorithms */ - -#define GL2PS_NO_SORT 1 -#define GL2PS_SIMPLE_SORT 2 -#define GL2PS_BSP_SORT 3 - -/* Message levels and error codes */ - -#define GL2PS_SUCCESS 0 -#define GL2PS_INFO 1 -#define GL2PS_WARNING 2 -#define GL2PS_ERROR 3 -#define GL2PS_NO_FEEDBACK 4 -#define GL2PS_OVERFLOW 5 -#define GL2PS_UNINITIALIZED 6 - -/* Options for gl2psBeginPage */ - -#define GL2PS_NONE 0 -#define GL2PS_DRAW_BACKGROUND (1<<0) -#define GL2PS_SIMPLE_LINE_OFFSET (1<<1) -#define GL2PS_SILENT (1<<2) -#define GL2PS_BEST_ROOT (1<<3) -#define GL2PS_OCCLUSION_CULL (1<<4) -#define GL2PS_NO_TEXT (1<<5) -#define GL2PS_LANDSCAPE (1<<6) -#define GL2PS_NO_PS3_SHADING (1<<7) -#define GL2PS_NO_PIXMAP (1<<8) -#define GL2PS_USE_CURRENT_VIEWPORT (1<<9) -#define GL2PS_COMPRESS (1<<10) -#define GL2PS_NO_BLENDING (1<<11) -#define GL2PS_TIGHT_BOUNDING_BOX (1<<12) - -/* Arguments for gl2psEnable/gl2psDisable */ - -#define GL2PS_POLYGON_OFFSET_FILL 1 -#define GL2PS_POLYGON_BOUNDARY 2 -#define GL2PS_LINE_STIPPLE 3 -#define GL2PS_BLEND 4 - -/* Text alignment (o=raster position; default mode is BL): - +---+ +---+ +---+ +---+ +---+ +---+ +-o-+ o---+ +---o - | o | o | | o | | | | | | | | | | | | - +---+ +---+ +---+ +-o-+ o---+ +---o +---+ +---+ +---+ - C CL CR B BL BR T TL TR */ - -#define GL2PS_TEXT_C 1 -#define GL2PS_TEXT_CL 2 -#define GL2PS_TEXT_CR 3 -#define GL2PS_TEXT_B 4 -#define GL2PS_TEXT_BL 5 -#define GL2PS_TEXT_BR 6 -#define GL2PS_TEXT_T 7 -#define GL2PS_TEXT_TL 8 -#define GL2PS_TEXT_TR 9 - -typedef GLfloat GL2PSrgba[4]; - -#if defined(__cplusplus) -extern "C" { -#endif - -GL2PSDLL_API GLint gl2psBeginPage(const char *title, const char *producer, - GLint viewport[4], GLint format, GLint sort, - GLint options, GLint colormode, - GLint colorsize, GL2PSrgba *colormap, - GLint nr, GLint ng, GLint nb, GLint buffersize, - FILE *stream, const char *filename); -GL2PSDLL_API GLint gl2psEndPage(void); -GL2PSDLL_API GLint gl2psSetOptions(GLint options); -GL2PSDLL_API GLint gl2psGetOptions(GLint *options); -GL2PSDLL_API GLint gl2psBeginViewport(GLint viewport[4]); -GL2PSDLL_API GLint gl2psEndViewport(void); -GL2PSDLL_API GLint gl2psText(const char *str, const char *fontname, - GLshort fontsize); -GL2PSDLL_API GLint gl2psTextOpt(const char *str, const char *fontname, - GLshort fontsize, GLint align, GLfloat angle); -GL2PSDLL_API GLint gl2psSpecial(GLint format, const char *str); -GL2PSDLL_API GLint gl2psDrawPixels(GLsizei width, GLsizei height, - GLint xorig, GLint yorig, - GLenum format, GLenum type, const void *pixels); -GL2PSDLL_API GLint gl2psEnable(GLint mode); -GL2PSDLL_API GLint gl2psDisable(GLint mode); -GL2PSDLL_API GLint gl2psPointSize(GLfloat value); -GL2PSDLL_API GLint gl2psLineWidth(GLfloat value); -GL2PSDLL_API GLint gl2psBlendFunc(GLenum sfactor, GLenum dfactor); - -/* undocumented */ -GL2PSDLL_API GLint gl2psDrawImageMap(GLsizei width, GLsizei height, - const GLfloat position[3], - const unsigned char *imagemap); -GL2PSDLL_API const char *gl2psGetFileExtension(GLint format); -GL2PSDLL_API const char *gl2psGetFormatDescription(GLint format); - -#if defined(__cplusplus) -} -#endif - -#endif /* __GL2PS_H__ */ diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/gripes.cc --- a/libinterp/interp-core/gripes.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,238 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "oct-obj.h" -#include "utils.h" - -void -gripe_not_supported (const char *fcn) -{ - error ("%s: not supported on this system", fcn); -} - -void -gripe_not_implemented (const char *fcn) -{ - error ("%s: not implemented", fcn); -} - -void -gripe_string_invalid (void) -{ - error ("std::string constant used in invalid context"); -} - -void -gripe_range_invalid (void) -{ - error ("range constant used in invalid context"); -} - -void -gripe_nonconformant (void) -{ - error ("nonconformant matrices"); -} - -void -gripe_nonconformant (octave_idx_type r1, octave_idx_type c1, octave_idx_type r2, octave_idx_type c2) -{ - error ("nonconformant matrices (op1 is %dx%d, op2 is %dx%d)", - r1, c1, r2, c2); -} - -void -gripe_empty_arg (const char *name, bool is_error) -{ - if (is_error) - error ("%s: empty matrix is invalid as an argument", name); - else - warning ("%s: argument is empty matrix", name); -} - -void -gripe_square_matrix_required (const char *name) -{ - error ("%s: argument must be a square matrix", name); -} - -void -gripe_user_supplied_eval (const char *name) -{ - error ("%s: evaluation of user-supplied function failed", name); -} - -void -gripe_user_returned_invalid (const char *name) -{ - error ("%s: user-supplied function returned invalid value", name); -} - -void -gripe_invalid_conversion (const std::string& from, const std::string& to) -{ - error ("invalid conversion from %s to %s", from.c_str (), to.c_str ()); -} - -void -gripe_invalid_value_specified (const char *name) -{ - warning ("invalid value specified for '%s'", name); -} - -void -gripe_2_or_3_dim_plot (void) -{ - error ("plot: can only plot in 2 or 3 dimensions"); -} - -void -gripe_unrecognized_float_fmt (void) -{ - error ("unrecognized floating point format requested"); -} - -void -gripe_unrecognized_data_fmt (const char *warn_for) -{ - error ("%s: unrecognized data format requested", warn_for); -} - -void -gripe_data_conversion (const char *from, const char *to) -{ - error ("unable to convert from %s to %s format", from, to); -} - -void -gripe_wrong_type_arg (const char *name, const char *s, bool is_error) -{ - if (is_error) - error ("%s: wrong type argument '%s'", name, s); - else - warning ("%s: wrong type argument '%s'", name, s); -} - -void -gripe_wrong_type_arg (const char *name, const std::string& s, bool is_error) -{ - gripe_wrong_type_arg (name, s.c_str (), is_error); -} - -void -gripe_wrong_type_arg (const char *name, const octave_value& tc, - bool is_error) -{ - std::string type = tc.type_name (); - - gripe_wrong_type_arg (name, type, is_error); -} - -void -gripe_wrong_type_arg (const std::string& name, const octave_value& tc, - bool is_error) -{ - gripe_wrong_type_arg (name.c_str (), tc, is_error); -} - -void -gripe_wrong_type_arg_for_unary_op (const octave_value& op) -{ - std::string type = op.type_name (); - error ("invalid operand '%s' for unary operator", type.c_str ()); -} - -void -gripe_wrong_type_arg_for_binary_op (const octave_value& op) -{ - std::string type = op.type_name (); - error ("invalid operand '%s' for binary operator", type.c_str ()); -} - -void -gripe_implicit_conversion (const char *id, const char *from, const char *to) -{ - warning_with_id (id, "implicit conversion from %s to %s", from, to); -} - -void -gripe_implicit_conversion (const std::string& id, - const std::string& from, const std::string& to) -{ - warning_with_id (id.c_str (), - "implicit conversion from %s to %s", - from.c_str (), to.c_str ()); -} - -void -gripe_divide_by_zero (void) -{ - warning_with_id ("Octave:divide-by-zero", "division by zero"); -} - -void -gripe_logical_conversion (void) -{ - warning_with_id ("Octave:logical-conversion", - "value not equal to 1 or 0 converted to logical 1"); -} - -void -gripe_library_execution_error (void) -{ - octave_exception_state = octave_no_exception; - - if (! error_state) - error ("caught execution error in library function"); -} - -void -gripe_invalid_inquiry_subscript (void) -{ - error ("invalid dimension inquiry of a non-existent value"); -} - -void -gripe_indexed_cs_list (void) -{ - error ("a cs-list cannot be further indexed"); -} - -void -gripe_nonbraced_cs_list_assignment (void) -{ - error ("invalid assignment to cs-list outside multiple assignment"); -} - -void -gripe_warn_complex_cmp (void) -{ - warning_with_id ("Octave:matlab-incompatible", - "potential Matlab compatibility problem: comparing complex numbers"); -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/gripes.h --- a/libinterp/interp-core/gripes.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,130 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_gripes_h) -#define octave_gripes_h 1 - -#include - -#include "lo-array-gripes.h" - -class octave_value; - -extern OCTINTERP_API void -gripe_not_supported (const char *); - -extern OCTINTERP_API void -gripe_not_implemented (const char *); - -extern OCTINTERP_API void -gripe_string_invalid (void); - -extern OCTINTERP_API void -gripe_range_invalid (void); - -extern OCTINTERP_API void -gripe_nonconformant (void); - -extern OCTINTERP_API void -gripe_nonconformant (octave_idx_type r1, octave_idx_type c1, octave_idx_type r2, octave_idx_type c2); - -extern OCTINTERP_API void -gripe_empty_arg (const char *name, bool is_error); - -extern OCTINTERP_API void -gripe_square_matrix_required (const char *name); - -extern OCTINTERP_API void -gripe_user_supplied_eval (const char *name); - -extern OCTINTERP_API void -gripe_user_returned_invalid (const char *name); - -extern OCTINTERP_API void -gripe_invalid_conversion (const std::string& from, const std::string& to); - -extern OCTINTERP_API void -gripe_invalid_value_specified (const char *name); - -extern OCTINTERP_API void -gripe_2_or_3_dim_plot (void); - -extern OCTINTERP_API void -gripe_unrecognized_float_fmt (void); - -extern OCTINTERP_API void -gripe_unrecognized_data_fmt (const char *warn_for); - -extern OCTINTERP_API void -gripe_data_conversion (const char *from, const char *to); - -extern OCTINTERP_API void -gripe_wrong_type_arg (const char *name, const char *s, - bool is_error = true); - -extern OCTINTERP_API void -gripe_wrong_type_arg (const char *name, const std::string& s, - bool is_error = true); - -extern OCTINTERP_API void -gripe_wrong_type_arg (const char *name, const octave_value& tc, - bool is_error = true); - -extern OCTINTERP_API void -gripe_wrong_type_arg (const std::string& name, const octave_value& tc, - bool is_error = true); - -extern OCTINTERP_API void -gripe_wrong_type_arg_for_unary_op (const octave_value& op); - -extern OCTINTERP_API void -gripe_wrong_type_arg_for_binary_op (const octave_value& op); - -extern OCTINTERP_API void -gripe_implicit_conversion (const char *id, const char *from, const char *to); - -extern OCTINTERP_API void -gripe_implicit_conversion (const std::string& id, const std::string& from, - const std::string& to); - -extern OCTINTERP_API void -gripe_divide_by_zero (void); - -extern OCTINTERP_API void -gripe_logical_conversion (void); - -extern OCTINTERP_API void -gripe_library_execution_error (void); - -extern OCTINTERP_API void -gripe_invalid_inquiry_subscript (void); - -extern OCTINTERP_API void -gripe_indexed_cs_list (void); - -extern OCTINTERP_API void -gripe_nonbraced_cs_list_assignment (void); - -extern OCTINTERP_API void -gripe_warn_complex_cmp (void); - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/jit-ir.cc --- a/libinterp/interp-core/jit-ir.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,840 +0,0 @@ -/* - -Copyright (C) 2012 Max Brister - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Author: Max Brister - -// defines required by llvm -#define __STDC_LIMIT_MACROS -#define __STDC_CONSTANT_MACROS - -#ifdef HAVE_CONFIG_H -#include -#endif - -#ifdef HAVE_LLVM - -#include "jit-ir.h" - -#include -#include - -#include "error.h" - -// -------------------- jit_factory -------------------- -jit_factory::~jit_factory (void) -{ - for (value_list::iterator iter = all_values.begin (); - iter != all_values.end (); ++iter) - delete *iter; -} - -void -jit_factory::track_value (jit_value *value) -{ - if (value->type ()) - mconstants.push_back (value); - all_values.push_back (value); -} - -// -------------------- jit_block_list -------------------- -void -jit_block_list::insert_after (iterator iter, jit_block *ablock) -{ - ++iter; - insert_before (iter, ablock); -} - -void -jit_block_list::insert_after (jit_block *loc, jit_block *ablock) -{ - insert_after (loc->location (), ablock); -} - -void -jit_block_list::insert_before (iterator iter, jit_block *ablock) -{ - iter = mlist.insert (iter, ablock); - ablock->stash_location (iter); -} - -void -jit_block_list::insert_before (jit_block *loc, jit_block *ablock) -{ - insert_before (loc->location (), ablock); -} - -void -jit_block_list::label (void) -{ - if (mlist.size ()) - { - jit_block *block = mlist.back (); - block->label (); - } -} - -std::ostream& -jit_block_list::print (std::ostream& os, const std::string& header) const -{ - os << "-------------------- " << header << " --------------------\n"; - return os << *this; -} - -std::ostream& -jit_block_list::print_dom (std::ostream& os) const -{ - os << "-------------------- dom info --------------------\n"; - for (const_iterator iter = begin (); iter != end (); ++iter) - { - assert (*iter); - (*iter)->print_dom (os); - } - os << std::endl; - - return os; -} - -void -jit_block_list::push_back (jit_block *b) -{ - mlist.push_back (b); - iterator iter = mlist.end (); - b->stash_location (--iter); -} - -std::ostream& -operator<<(std::ostream& os, const jit_block_list& blocks) -{ - for (jit_block_list::const_iterator iter = blocks.begin (); - iter != blocks.end (); ++iter) - { - assert (*iter); - (*iter)->print (os, 0); - } - return os << std::endl; -} - -// -------------------- jit_use -------------------- -jit_block * -jit_use::user_parent (void) const -{ - return muser->parent (); -} - -// -------------------- jit_value -------------------- -jit_value::~jit_value (void) -{} - -jit_block * -jit_value::first_use_block (void) -{ - jit_use *use = first_use (); - while (use) - { - if (! isa (use->user ())) - return use->user_parent (); - - use = use->next (); - } - - return 0; -} - -void -jit_value::replace_with (jit_value *value) -{ - while (first_use ()) - { - jit_instruction *user = first_use ()->user (); - size_t idx = first_use ()->index (); - user->stash_argument (idx, value); - } -} - -#define JIT_METH(clname) \ - void \ - jit_ ## clname::accept (jit_ir_walker& walker) \ - { \ - walker.visit (*this); \ - } - -JIT_VISIT_IR_NOTEMPLATE -#undef JIT_METH - -std::ostream& -operator<< (std::ostream& os, const jit_value& value) -{ - return value.short_print (os); -} - -std::ostream& -jit_print (std::ostream& os, jit_value *avalue) -{ - if (avalue) - return avalue->print (os); - return os << "NULL"; -} - -// -------------------- jit_instruction -------------------- -void -jit_instruction::remove (void) -{ - if (mparent) - mparent->remove (mlocation); - resize_arguments (0); -} - -llvm::BasicBlock * -jit_instruction::parent_llvm (void) const -{ - return mparent->to_llvm (); -} - -std::ostream& -jit_instruction::short_print (std::ostream& os) const -{ - if (type ()) - jit_print (os, type ()) << ": "; - return os << "#" << mid; -} - -void -jit_instruction::do_construct_ssa (size_t start, size_t end) -{ - for (size_t i = start; i < end; ++i) - { - jit_value *arg = argument (i); - jit_variable *var = dynamic_cast (arg); - if (var && var->has_top ()) - stash_argument (i, var->top ()); - } -} - -// -------------------- jit_block -------------------- -void -jit_block::replace_with (jit_value *value) -{ - assert (isa (value)); - jit_block *block = static_cast (value); - - jit_value::replace_with (block); - - while (ILIST_T::first_use ()) - { - jit_phi_incomming *incomming = ILIST_T::first_use (); - incomming->stash_value (block); - } -} - -void -jit_block::replace_in_phi (jit_block *ablock, jit_block *with) -{ - jit_phi_incomming *node = ILIST_T::first_use (); - while (node) - { - jit_phi_incomming *prev = node; - node = node->next (); - - if (prev->user_parent () == ablock) - prev->stash_value (with); - } -} - -jit_block * -jit_block::maybe_merge () -{ - if (successor_count () == 1 && successor (0) != this - && (successor (0)->use_count () == 1 || instructions.size () == 1)) - { - jit_block *to_merge = successor (0); - merge (*to_merge); - return to_merge; - } - - return 0; -} - -void -jit_block::merge (jit_block& block) -{ - // the merge block will contain a new terminator - jit_terminator *old_term = terminator (); - if (old_term) - old_term->remove (); - - bool was_empty = end () == begin (); - iterator merge_begin = end (); - if (! was_empty) - --merge_begin; - - instructions.splice (end (), block.instructions); - if (was_empty) - merge_begin = begin (); - else - ++merge_begin; - - // now merge_begin points to the start of the new instructions, we must - // update their parent information - for (iterator iter = merge_begin; iter != end (); ++iter) - { - jit_instruction *instr = *iter; - instr->stash_parent (this, iter); - } - - block.replace_with (this); -} - -jit_instruction * -jit_block::prepend (jit_instruction *instr) -{ - instructions.push_front (instr); - instr->stash_parent (this, instructions.begin ()); - return instr; -} - -jit_instruction * -jit_block::prepend_after_phi (jit_instruction *instr) -{ - // FIXME: Make this O(1) - for (iterator iter = begin (); iter != end (); ++iter) - { - jit_instruction *temp = *iter; - if (! isa (temp)) - { - insert_before (iter, instr); - return instr; - } - } - - return append (instr); -} - -void -jit_block::internal_append (jit_instruction *instr) -{ - instructions.push_back (instr); - instr->stash_parent (this, --instructions.end ()); -} - -jit_instruction * -jit_block::insert_before (iterator loc, jit_instruction *instr) -{ - iterator iloc = instructions.insert (loc, instr); - instr->stash_parent (this, iloc); - return instr; -} - -jit_instruction * -jit_block::insert_after (iterator loc, jit_instruction *instr) -{ - ++loc; - iterator iloc = instructions.insert (loc, instr); - instr->stash_parent (this, iloc); - return instr; -} - -jit_terminator * -jit_block::terminator (void) const -{ - assert (this); - if (instructions.empty ()) - return 0; - - jit_instruction *last = instructions.back (); - return dynamic_cast (last); -} - -bool -jit_block::branch_alive (jit_block *asucc) const -{ - return terminator ()->alive (asucc); -} - -jit_block * -jit_block::successor (size_t i) const -{ - jit_terminator *term = terminator (); - return term->successor (i); -} - -size_t -jit_block::successor_count (void) const -{ - jit_terminator *term = terminator (); - return term ? term->successor_count () : 0; -} - -llvm::BasicBlock * -jit_block::to_llvm (void) const -{ - return llvm::cast (llvm_value); -} - -std::ostream& -jit_block::print_dom (std::ostream& os) const -{ - short_print (os); - os << ":\n"; - os << " mid: " << mid << std::endl; - os << " predecessors: "; - for (jit_use *use = first_use (); use; use = use->next ()) - os << *use->user_parent () << " "; - os << std::endl; - - os << " successors: "; - for (size_t i = 0; i < successor_count (); ++i) - os << *successor (i) << " "; - os << std::endl; - - os << " idom: "; - if (idom) - os << *idom; - else - os << "NULL"; - os << std::endl; - os << " df: "; - for (df_iterator iter = df_begin (); iter != df_end (); ++iter) - os << **iter << " "; - os << std::endl; - - os << " dom_succ: "; - for (size_t i = 0; i < dom_succ.size (); ++i) - os << *dom_succ[i] << " "; - - return os << std::endl; -} - -void -jit_block::compute_df (size_t avisit_count) -{ - if (visited (avisit_count)) - return; - - if (use_count () >= 2) - { - for (jit_use *use = first_use (); use; use = use->next ()) - { - jit_block *runner = use->user_parent (); - while (runner != idom) - { - runner->mdf.insert (this); - runner = runner->idom; - } - } - } - - for (size_t i = 0; i < successor_count (); ++i) - successor (i)->compute_df (avisit_count); -} - -bool -jit_block::update_idom (size_t avisit_count) -{ - if (visited (avisit_count) || ! use_count ()) - return false; - - bool changed = false; - for (jit_use *use = first_use (); use; use = use->next ()) - { - jit_block *pred = use->user_parent (); - changed = pred->update_idom (avisit_count) || changed; - } - - jit_use *use = first_use (); - jit_block *new_idom = use->user_parent (); - use = use->next (); - - for (; use; use = use->next ()) - { - jit_block *pred = use->user_parent (); - jit_block *pidom = pred->idom; - if (pidom) - new_idom = idom_intersect (pidom, new_idom); - } - - if (idom != new_idom) - { - idom = new_idom; - return true; - } - - return changed; -} - -void -jit_block::label (size_t avisit_count, size_t& number) -{ - if (visited (avisit_count)) - return; - - for (jit_use *use = first_use (); use; use = use->next ()) - { - jit_block *pred = use->user_parent (); - pred->label (avisit_count, number); - } - - mid = number++; -} - -void -jit_block::pop_all (void) -{ - for (iterator iter = begin (); iter != end (); ++iter) - { - jit_instruction *instr = *iter; - instr->pop_variable (); - } -} - -std::ostream& -jit_block::print (std::ostream& os, size_t indent) const -{ - print_indent (os, indent); - short_print (os) << ": %pred = "; - for (jit_use *use = first_use (); use; use = use->next ()) - { - jit_block *pred = use->user_parent (); - os << *pred; - if (use->next ()) - os << ", "; - } - os << std::endl; - - for (const_iterator iter = begin (); iter != end (); ++iter) - { - jit_instruction *instr = *iter; - instr->print (os, indent + 1) << std::endl; - } - return os; -} - -jit_block * -jit_block::maybe_split (jit_factory& factory, jit_block_list& blocks, - jit_block *asuccessor) -{ - if (successor_count () > 1) - { - jit_terminator *term = terminator (); - size_t idx = term->successor_index (asuccessor); - jit_block *split = factory.create ("phi_split", mvisit_count); - - // place after this to ensure define before use in the blocks list - blocks.insert_after (this, split); - - term->stash_argument (idx, split); - jit_branch *br = split->append (factory.create (asuccessor)); - replace_in_phi (asuccessor, split); - - if (alive ()) - { - split->mark_alive (); - br->infer (); - } - - return split; - } - - return this; -} - -void -jit_block::create_dom_tree (size_t avisit_count) -{ - if (visited (avisit_count)) - return; - - if (idom != this) - idom->dom_succ.push_back (this); - - for (size_t i = 0; i < successor_count (); ++i) - successor (i)->create_dom_tree (avisit_count); -} - -jit_block * -jit_block::idom_intersect (jit_block *i, jit_block *j) -{ - while (i && j && i != j) - { - while (i && i->id () > j->id ()) - i = i->idom; - - while (i && j && j->id () > i->id ()) - j = j->idom; - } - - return i ? i : j; -} - -// -------------------- jit_phi_incomming -------------------- - -jit_block * -jit_phi_incomming::user_parent (void) const -{ return muser->parent (); } - -// -------------------- jit_phi -------------------- -bool -jit_phi::prune (void) -{ - jit_block *p = parent (); - size_t new_idx = 0; - jit_value *unique = argument (1); - - for (size_t i = 0; i < argument_count (); ++i) - { - jit_block *inc = incomming (i); - if (inc->branch_alive (p)) - { - if (unique != argument (i)) - unique = 0; - - if (new_idx != i) - { - stash_argument (new_idx, argument (i)); - mincomming[new_idx].stash_value (inc); - } - - ++new_idx; - } - } - - if (new_idx != argument_count ()) - { - resize_arguments (new_idx); - mincomming.resize (new_idx); - } - - assert (argument_count () > 0); - if (unique) - { - replace_with (unique); - return true; - } - - return false; -} - -bool -jit_phi::infer (void) -{ - jit_block *p = parent (); - if (! p->alive ()) - return false; - - jit_type *infered = 0; - for (size_t i = 0; i < argument_count (); ++i) - { - jit_block *inc = incomming (i); - if (inc->branch_alive (p)) - infered = jit_typeinfo::join (infered, argument_type (i)); - } - - if (infered != type ()) - { - stash_type (infered); - return true; - } - - return false; -} - -llvm::PHINode * -jit_phi::to_llvm (void) const -{ - return llvm::cast (jit_value::to_llvm ()); -} - -// -------------------- jit_terminator -------------------- -size_t -jit_terminator::successor_index (const jit_block *asuccessor) const -{ - size_t scount = successor_count (); - for (size_t i = 0; i < scount; ++i) - if (successor (i) == asuccessor) - return i; - - panic_impossible (); -} - -bool -jit_terminator::infer (void) -{ - if (! parent ()->alive ()) - return false; - - bool changed = false; - for (size_t i = 0; i < malive.size (); ++i) - if (! malive[i] && check_alive (i)) - { - changed = true; - malive[i] = true; - successor (i)->mark_alive (); - } - - return changed; -} - -llvm::TerminatorInst * -jit_terminator::to_llvm (void) const -{ - return llvm::cast (jit_value::to_llvm ()); -} - -// -------------------- jit_call -------------------- -bool -jit_call::needs_release (void) const -{ - if (type () && jit_typeinfo::get_release (type ()).valid ()) - { - for (jit_use *use = first_use (); use; use = use->next ()) - { - jit_assign *assign = dynamic_cast (use->user ()); - if (assign && assign->artificial ()) - return false; - } - - return true; - } - return false; -} - -bool -jit_call::infer (void) -{ - // FIXME: explain algorithm - for (size_t i = 0; i < argument_count (); ++i) - { - already_infered[i] = argument_type (i); - if (! already_infered[i]) - return false; - } - - jit_type *infered = moperation.result (already_infered); - if (! infered && use_count ()) - { - std::stringstream ss; - ss << "Missing overload in type inference for "; - print (ss, 0); - throw jit_fail_exception (ss.str ()); - } - - if (infered != type ()) - { - stash_type (infered); - return true; - } - - return false; -} - -// -------------------- jit_error_check -------------------- -std::string -jit_error_check::variable_to_string (variable v) -{ - switch (v) - { - case var_error_state: - return "error_state"; - case var_interrupt: - return "interrupt"; - default: - panic_impossible (); - } -} - -std::ostream& -jit_error_check::print (std::ostream& os, size_t indent) const -{ - print_indent (os, indent) << "error_check " << variable_to_string (mvariable) - << ", "; - - if (has_check_for ()) - os << " " << *check_for () << ", "; - print_successor (os << " ", 1) << ", "; - return print_successor (os << " ", 0); -} - -// -------------------- jit_magic_end -------------------- -jit_magic_end::context::context (jit_factory& factory, jit_value *avalue, - size_t aindex, size_t acount) - : value (avalue), index (factory.create (aindex)), - count (factory.create (acount)) -{} - -jit_magic_end::jit_magic_end (const std::vector& full_context) - : contexts (full_context) -{ - resize_arguments (contexts.size ()); - - size_t i; - std::vector::const_iterator iter; - for (iter = contexts.begin (), i = 0; iter != contexts.end (); ++iter, ++i) - stash_argument (i, iter->value); -} - -jit_magic_end::context -jit_magic_end::resolve_context (void) const -{ - size_t idx; - for (idx = 0; idx < contexts.size (); ++idx) - { - jit_type *ctx_type = contexts[idx].value->type (); - if (! ctx_type || ctx_type->skip_paren ()) - break; - } - - if (idx >= contexts.size ()) - idx = 0; - - context ret = contexts[idx]; - ret.value = argument (idx); - return ret; -} - -bool -jit_magic_end::infer (void) -{ - jit_type *new_type = overload ().result (); - if (new_type != type ()) - { - stash_type (new_type); - return true; - } - - return false; -} - -std::ostream& -jit_magic_end::print (std::ostream& os, size_t indent) const -{ - context ctx = resolve_context (); - short_print (print_indent (os, indent)) << " (" << *ctx.value << ", "; - return os << *ctx.index << ", " << *ctx.count << ")"; -} - -const jit_function& -jit_magic_end::overload () const -{ - const context& ctx = resolve_context (); - return jit_typeinfo::end (ctx.value, ctx.index, ctx.count); -} - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/jit-ir.h --- a/libinterp/interp-core/jit-ir.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1436 +0,0 @@ -/* - -Copyright (C) 2012 Max Brister - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Author: Max Brister - -#if !defined (octave_jit_ir_h) -#define octave_jit_ir_h 1 - -#ifdef HAVE_LLVM - -#include -#include -#include - -#include "jit-typeinfo.h" - -// The low level octave jit ir -// this ir is close to llvm, but contains information for doing type inference. -// We convert the octave parse tree to this IR directly. - -#define JIT_VISIT_IR_NOTEMPLATE \ - JIT_METH(block); \ - JIT_METH(branch); \ - JIT_METH(cond_branch); \ - JIT_METH(call); \ - JIT_METH(extract_argument); \ - JIT_METH(store_argument); \ - JIT_METH(return); \ - JIT_METH(phi); \ - JIT_METH(variable); \ - JIT_METH(error_check); \ - JIT_METH(assign) \ - JIT_METH(argument) \ - JIT_METH(magic_end) - -#define JIT_VISIT_IR_CONST \ - JIT_METH(const_bool); \ - JIT_METH(const_scalar); \ - JIT_METH(const_complex); \ - JIT_METH(const_index); \ - JIT_METH(const_string); \ - JIT_METH(const_range) - -#define JIT_VISIT_IR_CLASSES \ - JIT_VISIT_IR_NOTEMPLATE \ - JIT_VISIT_IR_CONST - -// forward declare all ir classes -#define JIT_METH(cname) \ - class jit_ ## cname; - -JIT_VISIT_IR_NOTEMPLATE - -#undef JIT_METH - -// ABCs which aren't included in JIT_VISIT_IR_ALL -class jit_instruction; -class jit_terminator; - -template -class jit_const; - -typedef jit_const jit_const_bool; -typedef jit_const jit_const_scalar; -typedef jit_const jit_const_complex; -typedef jit_const jit_const_index; - -typedef jit_const jit_const_string; -typedef jit_const -jit_const_range; - -class jit_ir_walker; -class jit_use; - -// Creates and tracks memory for jit_value and subclasses. -// Memory managment is simple, all values that are created live as long as the -// factory. -class -jit_factory -{ - typedef std::list value_list; -public: - ~jit_factory (void); - - const value_list& constants (void) const { return mconstants; } - - template - T *create (void) - { - T *ret = new T (); - track_value (ret); - return ret; - } - -#define DECL_ARG(n) const ARG ## n& arg ## n -#define JIT_CREATE(N) \ - template \ - T *create (OCT_MAKE_LIST (DECL_ARG, N)) \ - { \ - T *ret = new T (OCT_MAKE_ARG_LIST (arg, N)); \ - track_value (ret); \ - return ret; \ - } - - JIT_CREATE (1) - JIT_CREATE (2) - JIT_CREATE (3) - JIT_CREATE (4) - -#undef JIT_CREATE -#undef DECL_ARG -private: - void track_value (jit_value *v); - - value_list all_values; - - value_list mconstants; -}; - -// A list of basic blocks (jit_block) which form some body of code. -// -// We do not directly inherit from std::list because we need to update the -// blocks stashed location in push_back and insert. -class -jit_block_list -{ -public: - typedef std::list::iterator iterator; - typedef std::list::const_iterator const_iterator; - - jit_block *back (void) const { return mlist.back (); } - - iterator begin (void) { return mlist.begin (); } - - const_iterator begin (void) const { return mlist.begin (); } - - iterator end (void) { return mlist.end (); } - - const_iterator end (void) const { return mlist.end (); } - - iterator erase (iterator iter) { return mlist.erase (iter); } - - jit_block *front (void) const { return mlist.front (); } - - void insert_after (iterator iter, jit_block *ablock); - - void insert_after (jit_block *loc, jit_block *ablock); - - void insert_before (iterator iter, jit_block *ablock); - - void insert_before (jit_block *loc, jit_block *ablock); - - void label (void); - - std::ostream& print (std::ostream& os, const std::string& header) const; - - std::ostream& print_dom (std::ostream& os) const; - - void push_back (jit_block *b); -private: - std::list mlist; -}; - -std::ostream& operator<<(std::ostream& os, const jit_block_list& blocks); - -class -jit_value : public jit_internal_list -{ -public: - jit_value (void) : llvm_value (0), ty (0), mlast_use (0), - min_worklist (false) {} - - virtual ~jit_value (void); - - bool in_worklist (void) const - { - return min_worklist; - } - - void stash_in_worklist (bool ain_worklist) - { - min_worklist = ain_worklist; - } - - // The block of the first use which is not a jit_error_check - // So this is not necessarily first_use ()->parent (). - jit_block *first_use_block (void); - - // replace all uses with - virtual void replace_with (jit_value *value); - - jit_type *type (void) const { return ty; } - - llvm::Type *type_llvm (void) const - { - return ty ? ty->to_llvm () : 0; - } - - const std::string& type_name (void) const - { - return ty->name (); - } - - void stash_type (jit_type *new_ty) { ty = new_ty; } - - std::string print_string (void) - { - std::stringstream ss; - print (ss); - return ss.str (); - } - - jit_instruction *last_use (void) const { return mlast_use; } - - void stash_last_use (jit_instruction *alast_use) - { - mlast_use = alast_use; - } - - virtual bool needs_release (void) const { return false; } - - virtual std::ostream& print (std::ostream& os, size_t indent = 0) const = 0; - - virtual std::ostream& short_print (std::ostream& os) const - { return print (os); } - - virtual void accept (jit_ir_walker& walker) = 0; - - bool has_llvm (void) const - { - return llvm_value; - } - - llvm::Value *to_llvm (void) const - { - assert (llvm_value); - return llvm_value; - } - - void stash_llvm (llvm::Value *compiled) - { - llvm_value = compiled; - } - -protected: - std::ostream& print_indent (std::ostream& os, size_t indent = 0) const - { - for (size_t i = 0; i < indent * 8; ++i) - os << " "; - return os; - } - - llvm::Value *llvm_value; -private: - jit_type *ty; - jit_instruction *mlast_use; - bool min_worklist; -}; - -std::ostream& operator<< (std::ostream& os, const jit_value& value); -std::ostream& jit_print (std::ostream& os, jit_value *avalue); - -class -jit_use : public jit_internal_node -{ -public: - // some compilers don't allow us to use jit_internal_node without template - // paremeters - typedef jit_internal_node PARENT_T; - - jit_use (void) : muser (0), mindex (0) {} - - // we should really have a move operator, but not until c++11 :( - jit_use (const jit_use& use) : muser (0), mindex (0) - { - *this = use; - } - - jit_use& operator= (const jit_use& use) - { - stash_value (use.value (), use.user (), use.index ()); - return *this; - } - - size_t index (void) const { return mindex; } - - jit_instruction *user (void) const { return muser; } - - jit_block *user_parent (void) const; - - std::list user_parent_location (void) const; - - void stash_value (jit_value *avalue, jit_instruction *auser = 0, - size_t aindex = -1) - { - PARENT_T::stash_value (avalue); - mindex = aindex; - muser = auser; - } -private: - jit_instruction *muser; - size_t mindex; -}; - -class -jit_instruction : public jit_value -{ -public: - // FIXME: this code could be so much pretier with varadic templates... - jit_instruction (void) : mid (next_id ()), mparent (0) - {} - - jit_instruction (size_t nargs) : mid (next_id ()), mparent (0) - { - already_infered.reserve (nargs); - marguments.reserve (nargs); - } - -#define STASH_ARG(i) stash_argument (i, arg ## i); -#define JIT_INSTRUCTION_CTOR(N) \ - jit_instruction (OCT_MAKE_DECL_LIST (jit_value *, arg, N)) \ - : already_infered (N), marguments (N), mid (next_id ()), mparent (0) \ - { \ - OCT_ITERATE_MACRO (STASH_ARG, N); \ - } - - JIT_INSTRUCTION_CTOR(1) - JIT_INSTRUCTION_CTOR(2) - JIT_INSTRUCTION_CTOR(3) - JIT_INSTRUCTION_CTOR(4) - -#undef STASH_ARG -#undef JIT_INSTRUCTION_CTOR - - jit_instruction (const std::vector& aarguments) - : already_infered (aarguments.size ()), marguments (aarguments.size ()), - mid (next_id ()), mparent (0) - { - for (size_t i = 0; i < aarguments.size (); ++i) - stash_argument (i, aarguments[i]); - } - - static void reset_ids (void) - { - next_id (true); - } - - jit_value *argument (size_t i) const - { - return marguments[i].value (); - } - - llvm::Value *argument_llvm (size_t i) const - { - assert (argument (i)); - return argument (i)->to_llvm (); - } - - jit_type *argument_type (size_t i) const - { - return argument (i)->type (); - } - - llvm::Type *argument_type_llvm (size_t i) const - { - assert (argument (i)); - return argument_type (i)->to_llvm (); - } - - std::ostream& print_argument (std::ostream& os, size_t i) const - { - if (argument (i)) - return argument (i)->short_print (os); - else - return os << "NULL"; - } - - void stash_argument (size_t i, jit_value *arg) - { - marguments[i].stash_value (arg, this, i); - } - - void push_argument (jit_value *arg) - { - marguments.push_back (jit_use ()); - stash_argument (marguments.size () - 1, arg); - already_infered.push_back (0); - } - - size_t argument_count (void) const - { - return marguments.size (); - } - - void resize_arguments (size_t acount, jit_value *adefault = 0) - { - size_t old = marguments.size (); - marguments.resize (acount); - already_infered.resize (acount); - - if (adefault) - for (size_t i = old; i < acount; ++i) - stash_argument (i, adefault); - } - - const std::vector& arguments (void) const { return marguments; } - - // argument types which have been infered already - const std::vector& argument_types (void) const - { return already_infered; } - - virtual void push_variable (void) {} - - virtual void pop_variable (void) {} - - virtual void construct_ssa (void) - { - do_construct_ssa (0, argument_count ()); - } - - virtual bool infer (void) { return false; } - - void remove (void); - - virtual std::ostream& short_print (std::ostream& os) const; - - jit_block *parent (void) const { return mparent; } - - std::list::iterator location (void) const - { - return mlocation; - } - - llvm::BasicBlock *parent_llvm (void) const; - - void stash_parent (jit_block *aparent, - std::list::iterator alocation) - { - mparent = aparent; - mlocation = alocation; - } - - size_t id (void) const { return mid; } -protected: - - // Do SSA replacement on arguments in [start, end) - void do_construct_ssa (size_t start, size_t end); - - std::vector already_infered; -private: - static size_t next_id (bool reset = false) - { - static size_t ret = 0; - if (reset) - return ret = 0; - - return ret++; - } - - std::vector marguments; - - size_t mid; - jit_block *mparent; - std::list::iterator mlocation; -}; - -// defnie accept methods for subclasses -#define JIT_VALUE_ACCEPT \ - virtual void accept (jit_ir_walker& walker); - -// for use as a dummy argument during conversion to LLVM -class -jit_argument : public jit_value -{ -public: - jit_argument (jit_type *atype, llvm::Value *avalue) - { - stash_type (atype); - stash_llvm (avalue); - } - - virtual std::ostream& print (std::ostream& os, size_t indent = 0) const - { - print_indent (os, indent); - return jit_print (os, type ()) << ": DUMMY"; - } - - JIT_VALUE_ACCEPT; -}; - -template -class -jit_const : public jit_value -{ -public: - typedef PASS_T pass_t; - - jit_const (PASS_T avalue) : mvalue (avalue) - { - stash_type (EXTRACT_T ()); - } - - PASS_T value (void) const { return mvalue; } - - virtual std::ostream& print (std::ostream& os, size_t indent = 0) const - { - print_indent (os, indent); - jit_print (os, type ()) << ": "; - if (QUOTE) - os << "\""; - os << mvalue; - if (QUOTE) - os << "\""; - return os; - } - - JIT_VALUE_ACCEPT; -private: - T mvalue; -}; - -class jit_phi_incomming; - -class -jit_block : public jit_value, public jit_internal_list -{ - typedef jit_internal_list ILIST_T; -public: - typedef std::list instruction_list; - typedef instruction_list::iterator iterator; - typedef instruction_list::const_iterator const_iterator; - - typedef std::set df_set; - typedef df_set::const_iterator df_iterator; - - static const size_t NO_ID = static_cast (-1); - - jit_block (const std::string& aname, size_t avisit_count = 0) - : mvisit_count (avisit_count), mid (NO_ID), idom (0), mname (aname), - malive (false) - {} - - virtual void replace_with (jit_value *value); - - void replace_in_phi (jit_block *ablock, jit_block *with); - - // we have a new internal list, but we want to stay compatable with jit_value - jit_use *first_use (void) const { return jit_value::first_use (); } - - size_t use_count (void) const { return jit_value::use_count (); } - - // if a block is alive, then it might be visited during execution - bool alive (void) const { return malive; } - - void mark_alive (void) { malive = true; } - - // If we can merge with a successor, do so and return the now empty block - jit_block *maybe_merge (); - - // merge another block into this block, leaving the merge block empty - void merge (jit_block& merge); - - const std::string& name (void) const { return mname; } - - jit_instruction *prepend (jit_instruction *instr); - - jit_instruction *prepend_after_phi (jit_instruction *instr); - - template - T *append (T *instr) - { - internal_append (instr); - return instr; - } - - jit_instruction *insert_before (iterator loc, jit_instruction *instr); - - jit_instruction *insert_before (jit_instruction *loc, jit_instruction *instr) - { - return insert_before (loc->location (), instr); - } - - jit_instruction *insert_after (iterator loc, jit_instruction *instr); - - jit_instruction *insert_after (jit_instruction *loc, jit_instruction *instr) - { - return insert_after (loc->location (), instr); - } - - iterator remove (iterator iter) - { - jit_instruction *instr = *iter; - iter = instructions.erase (iter); - instr->stash_parent (0, instructions.end ()); - return iter; - } - - jit_terminator *terminator (void) const; - - // is the jump from pred alive? - bool branch_alive (jit_block *asucc) const; - - jit_block *successor (size_t i) const; - - size_t successor_count (void) const; - - iterator begin (void) { return instructions.begin (); } - - const_iterator begin (void) const { return instructions.begin (); } - - iterator end (void) { return instructions.end (); } - - const_iterator end (void) const { return instructions.end (); } - - iterator phi_begin (void); - - iterator phi_end (void); - - iterator nonphi_begin (void); - - // must label before id is valid - size_t id (void) const { return mid; } - - // dominance frontier - const df_set& df (void) const { return mdf; } - - df_iterator df_begin (void) const { return mdf.begin (); } - - df_iterator df_end (void) const { return mdf.end (); } - - // label with a RPO walk - void label (void) - { - size_t number = 0; - label (mvisit_count, number); - } - - void label (size_t avisit_count, size_t& number); - - // See for idom computation algorithm - // Cooper, Keith D.; Harvey, Timothy J; and Kennedy, Ken (2001). - // "A Simple, Fast Dominance Algorithm" - void compute_idom (jit_block& entry_block) - { - bool changed; - entry_block.idom = &entry_block; - do - changed = update_idom (mvisit_count); - while (changed); - } - - // compute dominance frontier - void compute_df (void) - { - compute_df (mvisit_count); - } - - void create_dom_tree (void) - { - create_dom_tree (mvisit_count); - } - - jit_block *dom_successor (size_t idx) const - { - return dom_succ[idx]; - } - - size_t dom_successor_count (void) const - { - return dom_succ.size (); - } - - // call pop_varaible on all instructions - void pop_all (void); - - virtual std::ostream& print (std::ostream& os, size_t indent = 0) const; - - jit_block *maybe_split (jit_factory& factory, jit_block_list& blocks, - jit_block *asuccessor); - - jit_block *maybe_split (jit_factory& factory, jit_block_list& blocks, - jit_block& asuccessor) - { - return maybe_split (factory, blocks, &asuccessor); - } - - // print dominator infomration - std::ostream& print_dom (std::ostream& os) const; - - virtual std::ostream& short_print (std::ostream& os) const - { - os << mname; - if (mid != NO_ID) - os << mid; - else - os << "!"; - return os; - } - - llvm::BasicBlock *to_llvm (void) const; - - std::list::iterator location (void) const - { return mlocation; } - - void stash_location (std::list::iterator alocation) - { mlocation = alocation; } - - // used to prevent visiting the same node twice in the graph - size_t visit_count (void) const { return mvisit_count; } - - // check if this node has been visited yet at the given visit count. If we - // have not been visited yet, mark us as visited. - bool visited (size_t avisit_count) - { - if (mvisit_count <= avisit_count) - { - mvisit_count = avisit_count + 1; - return false; - } - - return true; - } - - jit_instruction *front (void) { return instructions.front (); } - - jit_instruction *back (void) { return instructions.back (); } - - JIT_VALUE_ACCEPT; -private: - void internal_append (jit_instruction *instr); - - void compute_df (size_t avisit_count); - - bool update_idom (size_t avisit_count); - - void create_dom_tree (size_t avisit_count); - - static jit_block *idom_intersect (jit_block *i, jit_block *j); - - size_t mvisit_count; - size_t mid; - jit_block *idom; - df_set mdf; - std::vector dom_succ; - std::string mname; - instruction_list instructions; - bool malive; - std::list::iterator mlocation; -}; - -// keeps track of phi functions that use a block on incomming edges -class -jit_phi_incomming : public jit_internal_node -{ -public: - jit_phi_incomming (void) : muser (0) {} - - jit_phi_incomming (jit_phi *auser) : muser (auser) {} - - jit_phi_incomming (const jit_phi_incomming& use) - { - *this = use; - } - - jit_phi_incomming& operator= (const jit_phi_incomming& use) - { - stash_value (use.value ()); - muser = use.muser; - return *this; - } - - jit_phi *user (void) const { return muser; } - - jit_block *user_parent (void) const; -private: - jit_phi *muser; -}; - -// A non-ssa variable -class -jit_variable : public jit_value -{ -public: - jit_variable (const std::string& aname) : mname (aname), mlast_use (0) {} - - const std::string &name (void) const { return mname; } - - // manipulate the value_stack, for use during SSA construction. The top of the - // value stack represents the current value for this variable - bool has_top (void) const - { - return ! value_stack.empty (); - } - - jit_value *top (void) const - { - return value_stack.top (); - } - - void push (jit_instruction *v) - { - value_stack.push (v); - mlast_use = v; - } - - void pop (void) - { - value_stack.pop (); - } - - jit_instruction *last_use (void) const - { - return mlast_use; - } - - void stash_last_use (jit_instruction *instr) - { - mlast_use = instr; - } - - // blocks in which we are used - void use_blocks (jit_block::df_set& result) - { - jit_use *use = first_use (); - while (use) - { - result.insert (use->user_parent ()); - use = use->next (); - } - } - - virtual std::ostream& print (std::ostream& os, size_t indent = 0) const - { - return print_indent (os, indent) << mname; - } - - JIT_VALUE_ACCEPT; -private: - std::string mname; - std::stack value_stack; - jit_instruction *mlast_use; -}; - -class -jit_assign_base : public jit_instruction -{ -public: - jit_assign_base (jit_variable *adest) : jit_instruction (), mdest (adest) {} - - jit_assign_base (jit_variable *adest, size_t npred) : jit_instruction (npred), - mdest (adest) {} - - jit_assign_base (jit_variable *adest, jit_value *arg0, jit_value *arg1) - : jit_instruction (arg0, arg1), mdest (adest) {} - - jit_variable *dest (void) const { return mdest; } - - virtual void push_variable (void) - { - mdest->push (this); - } - - virtual void pop_variable (void) - { - mdest->pop (); - } - - virtual std::ostream& short_print (std::ostream& os) const - { - if (type ()) - jit_print (os, type ()) << ": "; - - dest ()->short_print (os); - return os << "#" << id (); - } -private: - jit_variable *mdest; -}; - -class -jit_assign : public jit_assign_base -{ -public: - jit_assign (jit_variable *adest, jit_value *asrc) - : jit_assign_base (adest, adest, asrc), martificial (false) {} - - jit_value *overwrite (void) const - { - return argument (0); - } - - jit_value *src (void) const - { - return argument (1); - } - - // variables don't get modified in an SSA, but COW requires we modify - // variables. An artificial assign is for when a variable gets modified. We - // need an assign in the SSA, but the reference counts shouldn't be updated. - bool artificial (void) const { return martificial; } - - void mark_artificial (void) { martificial = true; } - - virtual bool infer (void) - { - jit_type *stype = src ()->type (); - if (stype != type()) - { - stash_type (stype); - return true; - } - - return false; - } - - virtual std::ostream& print (std::ostream& os, size_t indent = 0) const - { - print_indent (os, indent) << *this << " = " << *src (); - - if (artificial ()) - os << " [artificial]"; - - return os; - } - - JIT_VALUE_ACCEPT; -private: - bool martificial; -}; - -class -jit_phi : public jit_assign_base -{ -public: - jit_phi (jit_variable *adest, size_t npred) - : jit_assign_base (adest, npred) - { - mincomming.reserve (npred); - } - - // removes arguments form dead incomming jumps - bool prune (void); - - void add_incomming (jit_block *from, jit_value *value) - { - push_argument (value); - mincomming.push_back (jit_phi_incomming (this)); - mincomming[mincomming.size () - 1].stash_value (from); - } - - jit_block *incomming (size_t i) const - { - return mincomming[i].value (); - } - - llvm::BasicBlock *incomming_llvm (size_t i) const - { - return incomming (i)->to_llvm (); - } - - virtual void construct_ssa (void) {} - - virtual bool infer (void); - - virtual std::ostream& print (std::ostream& os, size_t indent = 0) const - { - std::stringstream ss; - print_indent (ss, indent); - short_print (ss) << " phi "; - std::string ss_str = ss.str (); - std::string indent_str (ss_str.size (), ' '); - os << ss_str; - - for (size_t i = 0; i < argument_count (); ++i) - { - if (i > 0) - os << indent_str; - os << "| "; - - os << *incomming (i) << " -> "; - os << *argument (i); - - if (i + 1 < argument_count ()) - os << std::endl; - } - - return os; - } - - llvm::PHINode *to_llvm (void) const; - - JIT_VALUE_ACCEPT; -private: - std::vector mincomming; -}; - -class -jit_terminator : public jit_instruction -{ -public: -#define JIT_TERMINATOR_CONST(N) \ - jit_terminator (size_t asuccessor_count, \ - OCT_MAKE_DECL_LIST (jit_value *, arg, N)) \ - : jit_instruction (OCT_MAKE_ARG_LIST (arg, N)), \ - malive (asuccessor_count, false) {} - - JIT_TERMINATOR_CONST (1) - JIT_TERMINATOR_CONST (2) - JIT_TERMINATOR_CONST (3) - -#undef JIT_TERMINATOR_CONST - - jit_block *successor (size_t idx = 0) const - { - return static_cast (argument (idx)); - } - - llvm::BasicBlock *successor_llvm (size_t idx = 0) const - { - return successor (idx)->to_llvm (); - } - - size_t successor_index (const jit_block *asuccessor) const; - - std::ostream& print_successor (std::ostream& os, size_t idx = 0) const - { - if (alive (idx)) - os << "[live] "; - else - os << "[dead] "; - - return successor (idx)->short_print (os); - } - - // Check if the jump to successor is live - bool alive (const jit_block *asuccessor) const - { - return alive (successor_index (asuccessor)); - } - - bool alive (size_t idx) const { return malive[idx]; } - - bool alive (int idx) const { return malive[idx]; } - - size_t successor_count (void) const { return malive.size (); } - - virtual bool infer (void); - - llvm::TerminatorInst *to_llvm (void) const; -protected: - virtual bool check_alive (size_t) const { return true; } -private: - std::vector malive; -}; - -class -jit_branch : public jit_terminator -{ -public: - jit_branch (jit_block *succ) : jit_terminator (1, succ) {} - - virtual size_t successor_count (void) const { return 1; } - - virtual std::ostream& print (std::ostream& os, size_t indent = 0) const - { - print_indent (os, indent) << "branch: "; - return print_successor (os); - } - - JIT_VALUE_ACCEPT; -}; - -class -jit_cond_branch : public jit_terminator -{ -public: - jit_cond_branch (jit_value *c, jit_block *ctrue, jit_block *cfalse) - : jit_terminator (2, ctrue, cfalse, c) {} - - jit_value *cond (void) const { return argument (2); } - - std::ostream& print_cond (std::ostream& os) const - { - return cond ()->short_print (os); - } - - llvm::Value *cond_llvm (void) const - { - return cond ()->to_llvm (); - } - - virtual size_t successor_count (void) const { return 2; } - - virtual std::ostream& print (std::ostream& os, size_t indent = 0) const - { - print_indent (os, indent) << "cond_branch: "; - print_cond (os) << ", "; - print_successor (os, 0) << ", "; - return print_successor (os, 1); - } - - JIT_VALUE_ACCEPT; -}; - -class -jit_call : public jit_instruction -{ -public: - jit_call (const jit_operation& (*aoperation) (void)) - : moperation (aoperation ()) - { - const jit_function& ol = overload (); - if (ol.valid ()) - stash_type (ol.result ()); - } - - jit_call (const jit_operation& aoperation) : moperation (aoperation) - { - const jit_function& ol = overload (); - if (ol.valid ()) - stash_type (ol.result ()); - } - -#define JIT_CALL_CONST(N) \ - jit_call (const jit_operation& aoperation, \ - OCT_MAKE_DECL_LIST (jit_value *, arg, N)) \ - : jit_instruction (OCT_MAKE_ARG_LIST (arg, N)), moperation (aoperation) {} \ - \ - jit_call (const jit_operation& (*aoperation) (void), \ - OCT_MAKE_DECL_LIST (jit_value *, arg, N)) \ - : jit_instruction (OCT_MAKE_ARG_LIST (arg, N)), moperation (aoperation ()) \ - {} - - JIT_CALL_CONST (1) - JIT_CALL_CONST (2) - JIT_CALL_CONST (3) - JIT_CALL_CONST (4) - -#undef JIT_CALL_CONST - - jit_call (const jit_operation& aoperation, - const std::vector& args) - : jit_instruction (args), moperation (aoperation) - {} - - const jit_operation& operation (void) const { return moperation; } - - bool can_error (void) const - { - return overload ().can_error (); - } - - const jit_function& overload (void) const - { - return moperation.overload (argument_types ()); - } - - virtual bool needs_release (void) const; - - virtual std::ostream& print (std::ostream& os, size_t indent = 0) const - { - print_indent (os, indent); - - if (use_count ()) - short_print (os) << " = "; - os << "call " << moperation.name () << " ("; - - for (size_t i = 0; i < argument_count (); ++i) - { - print_argument (os, i); - if (i + 1 < argument_count ()) - os << ", "; - } - return os << ")"; - } - - virtual bool infer (void); - - JIT_VALUE_ACCEPT; -private: - const jit_operation& moperation; -}; - -// FIXME: This is just ugly... -// checks error_state, if error_state is false then goto the normal branch, -// otherwise goto the error branch -class -jit_error_check : public jit_terminator -{ -public: - // Which variable is the error check for? - enum variable - { - var_error_state, - var_interrupt - }; - - static std::string variable_to_string (variable v); - - jit_error_check (variable var, jit_call *acheck_for, jit_block *normal, - jit_block *error) - : jit_terminator (2, error, normal, acheck_for), mvariable (var) {} - - jit_error_check (variable var, jit_block *normal, jit_block *error) - : jit_terminator (2, error, normal), mvariable (var) {} - - variable check_variable (void) const { return mvariable; } - - bool has_check_for (void) const - { - return argument_count () == 3; - } - - jit_call *check_for (void) const - { - assert (has_check_for ()); - return static_cast (argument (2)); - } - - virtual std::ostream& print (std::ostream& os, size_t indent = 0) const; - - JIT_VALUE_ACCEPT; -protected: - virtual bool check_alive (size_t idx) const - { - if (! has_check_for ()) - return true; - return idx == 1 ? true : check_for ()->can_error (); - } -private: - variable mvariable; -}; - -// for now only handles the 1D case -class -jit_magic_end : public jit_instruction -{ -public: - class - context - { - public: - context (void) : value (0), index (0), count (0) - {} - - context (jit_factory& factory, jit_value *avalue, size_t aindex, - size_t acount); - - jit_value *value; - jit_const_index *index; - jit_const_index *count; - }; - - jit_magic_end (const std::vector& full_context); - - virtual bool infer (void); - - const jit_function& overload () const; - - virtual std::ostream& print (std::ostream& os, size_t indent = 0) const; - - context resolve_context (void) const; - - virtual std::ostream& short_print (std::ostream& os) const - { - return os << "magic_end" << "#" << id (); - } - - JIT_VALUE_ACCEPT; -private: - std::vector contexts; -}; - -class -jit_extract_argument : public jit_assign_base -{ -public: - jit_extract_argument (jit_type *atype, jit_variable *adest) - : jit_assign_base (adest) - { - stash_type (atype); - } - - const std::string& name (void) const - { - return dest ()->name (); - } - - const jit_function& overload (void) const - { - return jit_typeinfo::cast (type (), jit_typeinfo::get_any ()); - } - - virtual std::ostream& print (std::ostream& os, size_t indent = 0) const - { - print_indent (os, indent); - - return short_print (os) << " = extract " << name (); - } - - JIT_VALUE_ACCEPT; -}; - -class -jit_store_argument : public jit_instruction -{ -public: - jit_store_argument (jit_variable *var) - : jit_instruction (var), dest (var) - {} - - const std::string& name (void) const - { - return dest->name (); - } - - const jit_function& overload (void) const - { - return jit_typeinfo::cast (jit_typeinfo::get_any (), result_type ()); - } - - jit_value *result (void) const - { - return argument (0); - } - - jit_type *result_type (void) const - { - return result ()->type (); - } - - llvm::Value *result_llvm (void) const - { - return result ()->to_llvm (); - } - - virtual std::ostream& print (std::ostream& os, size_t indent = 0) const - { - jit_value *res = result (); - print_indent (os, indent) << "store "; - dest->short_print (os); - - if (! isa (res)) - { - os << " = "; - res->short_print (os); - } - - return os; - } - - JIT_VALUE_ACCEPT; -private: - jit_variable *dest; -}; - -class -jit_return : public jit_instruction -{ -public: - jit_return (void) {} - - jit_return (jit_value *retval) : jit_instruction (retval) {} - - jit_value *result (void) const - { - return argument_count () ? argument (0) : 0; - } - - jit_type *result_type (void) const - { - jit_value *res = result (); - return res ? res->type () : 0; - } - - virtual std::ostream& print (std::ostream& os, size_t indent = 0) const - { - print_indent (os, indent) << "return"; - - if (result ()) - os << " " << *result (); - - return os; - } - - JIT_VALUE_ACCEPT; -}; - -class -jit_ir_walker -{ -public: - virtual ~jit_ir_walker () {} - -#define JIT_METH(clname) \ - virtual void visit (jit_ ## clname&) = 0; - - JIT_VISIT_IR_CLASSES; - -#undef JIT_METH -}; - -template -void -jit_const::accept (jit_ir_walker& walker) -{ - walker.visit (*this); -} - -#undef JIT_VALUE_ACCEPT - -#endif -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/jit-typeinfo.cc --- a/libinterp/interp-core/jit-typeinfo.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2239 +0,0 @@ -/* - -Copyright (C) 2012 Max Brister - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Author: Max Brister - -// defines required by llvm -#define __STDC_LIMIT_MACROS -#define __STDC_CONSTANT_MACROS - -#ifdef HAVE_CONFIG_H -#include -#endif - -#ifdef HAVE_LLVM - -#include "jit-typeinfo.h" - -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "jit-ir.h" -#include "ov.h" -#include "ov-builtin.h" -#include "ov-complex.h" -#include "ov-scalar.h" -#include "pager.h" - -static llvm::LLVMContext& context = llvm::getGlobalContext (); - -jit_typeinfo *jit_typeinfo::instance = 0; - -std::ostream& jit_print (std::ostream& os, jit_type *atype) -{ - if (! atype) - return os << "null"; - return os << atype->name (); -} - -// function that jit code calls -extern "C" void -octave_jit_print_any (const char *name, octave_base_value *obv) -{ - obv->print_with_name (octave_stdout, name, true); -} - -extern "C" void -octave_jit_print_scalar (const char *name, double value) -{ - // FIXME: We should avoid allocating a new octave_scalar each time - octave_value ov (value); - ov.print_with_name (octave_stdout, name); -} - -extern "C" octave_base_value* -octave_jit_binary_any_any (octave_value::binary_op op, octave_base_value *lhs, - octave_base_value *rhs) -{ - octave_value olhs (lhs, true); - octave_value orhs (rhs, true); - octave_value result = do_binary_op (op, olhs, orhs); - octave_base_value *rep = result.internal_rep (); - rep->grab (); - return rep; -} - -extern "C" octave_idx_type -octave_jit_compute_nelem (double base, double limit, double inc) -{ - Range rng = Range (base, limit, inc); - return rng.nelem (); -} - -extern "C" void -octave_jit_release_any (octave_base_value *obv) -{ - obv->release (); -} - -extern "C" void -octave_jit_release_matrix (jit_matrix *m) -{ - delete m->array; -} - -extern "C" octave_base_value * -octave_jit_grab_any (octave_base_value *obv) -{ - obv->grab (); - return obv; -} - -extern "C" jit_matrix -octave_jit_grab_matrix (jit_matrix *m) -{ - return *m->array; -} - -extern "C" octave_base_value * -octave_jit_cast_any_matrix (jit_matrix *m) -{ - octave_value ret (*m->array); - octave_base_value *rep = ret.internal_rep (); - rep->grab (); - delete m->array; - - return rep; -} - -extern "C" jit_matrix -octave_jit_cast_matrix_any (octave_base_value *obv) -{ - NDArray m = obv->array_value (); - obv->release (); - return m; -} - -extern "C" octave_base_value * -octave_jit_cast_any_range (jit_range *rng) -{ - Range temp (*rng); - octave_value ret (temp); - octave_base_value *rep = ret.internal_rep (); - rep->grab (); - - return rep; -} -extern "C" jit_range -octave_jit_cast_range_any (octave_base_value *obv) -{ - - jit_range r (obv->range_value ()); - obv->release (); - return r; -} - -extern "C" double -octave_jit_cast_scalar_any (octave_base_value *obv) -{ - double ret = obv->double_value (); - obv->release (); - return ret; -} - -extern "C" octave_base_value * -octave_jit_cast_any_scalar (double value) -{ - return new octave_scalar (value); -} - -extern "C" Complex -octave_jit_cast_complex_any (octave_base_value *obv) -{ - Complex ret = obv->complex_value (); - obv->release (); - return ret; -} - -extern "C" octave_base_value * -octave_jit_cast_any_complex (Complex c) -{ - if (c.imag () == 0) - return new octave_scalar (c.real ()); - else - return new octave_complex (c); -} - -extern "C" void -octave_jit_gripe_nan_to_logical_conversion (void) -{ - try - { - gripe_nan_to_logical_conversion (); - } - catch (const octave_execution_exception&) - { - gripe_library_execution_error (); - } -} - -extern "C" void -octave_jit_ginvalid_index (void) -{ - try - { - gripe_invalid_index (); - } - catch (const octave_execution_exception&) - { - gripe_library_execution_error (); - } -} - -extern "C" void -octave_jit_gindex_range (int nd, int dim, octave_idx_type iext, - octave_idx_type ext) -{ - try - { - gripe_index_out_of_range (nd, dim, iext, ext); - } - catch (const octave_execution_exception&) - { - gripe_library_execution_error (); - } -} - -extern "C" jit_matrix -octave_jit_paren_subsasgn_impl (jit_matrix *mat, octave_idx_type index, - double value) -{ - NDArray *array = mat->array; - if (array->nelem () < index) - array->resize1 (index); - - double *data = array->fortran_vec (); - data[index - 1] = value; - - mat->update (); - return *mat; -} - -static void -make_indices (double *indices, octave_idx_type idx_count, - Array& result) -{ - result.resize (dim_vector (1, idx_count)); - for (octave_idx_type i = 0; i < idx_count; ++i) - result(i) = idx_vector (indices[i]); -} - -extern "C" double -octave_jit_paren_scalar (jit_matrix *mat, double *indicies, - octave_idx_type idx_count) -{ - // FIXME: Replace this with a more optimal version - try - { - Array idx; - make_indices (indicies, idx_count, idx); - - Array ret = mat->array->index (idx); - return ret.xelem (0); - } - catch (const octave_execution_exception&) - { - gripe_library_execution_error (); - return 0; - } -} - -extern "C" jit_matrix -octave_jit_paren_scalar_subsasgn (jit_matrix *mat, double *indices, - octave_idx_type idx_count, double value) -{ - // FIXME: Replace this with a more optimal version - jit_matrix ret; - try - { - Array idx; - make_indices (indices, idx_count, idx); - - Matrix temp (1, 1); - temp.xelem(0) = value; - mat->array->assign (idx, temp); - ret.update (mat->array); - } - catch (const octave_execution_exception&) - { - gripe_library_execution_error (); - } - - return ret; -} - -extern "C" jit_matrix -octave_jit_paren_subsasgn_matrix_range (jit_matrix *mat, jit_range *index, - double value) -{ - NDArray *array = mat->array; - bool done = false; - - // optimize for the simple case (no resizing and no errors) - if (*array->jit_ref_count () == 1 - && index->all_elements_are_ints ()) - { - // this code is similar to idx_vector::fill, but we avoid allocating an - // idx_vector and its associated rep - octave_idx_type start = static_cast (index->base) - 1; - octave_idx_type step = static_cast (index->inc); - octave_idx_type nelem = index->nelem; - octave_idx_type final = start + nelem * step; - if (step < 0) - { - step = -step; - std::swap (final, start); - } - - if (start >= 0 && final < mat->slice_len) - { - done = true; - - double *data = array->jit_slice_data (); - if (step == 1) - std::fill (data + start, data + start + nelem, value); - else - { - for (octave_idx_type i = start; i < final; i += step) - data[i] = value; - } - } - } - - if (! done) - { - idx_vector idx (*index); - NDArray avalue (dim_vector (1, 1)); - avalue.xelem (0) = value; - array->assign (idx, avalue); - } - - jit_matrix ret; - ret.update (array); - return ret; -} - -extern "C" double -octave_jit_end_matrix (jit_matrix *mat, octave_idx_type idx, - octave_idx_type count) -{ - octave_idx_type ndim = mat->dimensions[-1]; - if (ndim == count) - return mat->dimensions[idx]; - else if (ndim > count) - { - if (idx == count - 1) - { - double ret = mat->dimensions[idx]; - for (octave_idx_type i = idx + 1; i < ndim; ++i) - ret *= mat->dimensions[idx]; - return ret; - } - - return mat->dimensions[idx]; - } - else // ndim < count - return idx < ndim ? mat->dimensions[idx] : 1; -} - -extern "C" octave_base_value * -octave_jit_create_undef (void) -{ - octave_value undef; - octave_base_value *ret = undef.internal_rep (); - ret->grab (); - - return ret; -} - -extern "C" Complex -octave_jit_complex_mul (Complex lhs, Complex rhs) -{ - if (lhs.imag () == 0 && rhs.imag() == 0) - return Complex (lhs.real () * rhs.real (), 0); - - return lhs * rhs; -} - -extern "C" Complex -octave_jit_complex_div (Complex lhs, Complex rhs) -{ - // see src/OPERATORS/op-cs-cs.cc - if (rhs == 0.0) - gripe_divide_by_zero (); - - return lhs / rhs; -} - -// FIXME: CP form src/xpow.cc -static inline int -xisint (double x) -{ - return (D_NINT (x) == x - && ((x >= 0 && x < std::numeric_limits::max ()) - || (x <= 0 && x > std::numeric_limits::min ()))); -} - -extern "C" Complex -octave_jit_pow_scalar_scalar (double lhs, double rhs) -{ - // FIXME: almost CP from src/xpow.cc - if (lhs < 0.0 && ! xisint (rhs)) - return std::pow (Complex (lhs), rhs); - return std::pow (lhs, rhs); -} - -extern "C" Complex -octave_jit_pow_complex_complex (Complex lhs, Complex rhs) -{ - if (lhs.imag () == 0 && rhs.imag () == 0) - return octave_jit_pow_scalar_scalar (lhs.real (), rhs.real ()); - return std::pow (lhs, rhs); -} - -extern "C" Complex -octave_jit_pow_complex_scalar (Complex lhs, double rhs) -{ - if (lhs.imag () == 0) - return octave_jit_pow_scalar_scalar (lhs.real (), rhs); - return std::pow (lhs, rhs); -} - -extern "C" Complex -octave_jit_pow_scalar_complex (double lhs, Complex rhs) -{ - if (rhs.imag () == 0) - return octave_jit_pow_scalar_scalar (lhs, rhs.real ()); - return std::pow (lhs, rhs); -} - -extern "C" void -octave_jit_print_matrix (jit_matrix *m) -{ - std::cout << *m << std::endl; -} - -static void -gripe_bad_result (void) -{ - error ("incorrect type information given to the JIT compiler"); -} - -// FIXME: Add support for multiple outputs -extern "C" octave_base_value * -octave_jit_call (octave_builtin::fcn fn, size_t nargin, - octave_base_value **argin, jit_type *result_type) -{ - octave_value_list ovl (nargin); - for (size_t i = 0; i < nargin; ++i) - ovl.xelem (i) = octave_value (argin[i]); - - ovl = fn (ovl, 1); - - // FIXME: Check result_type somehow - if (result_type) - { - if (ovl.length () < 1) - { - gripe_bad_result (); - return 0; - } - - octave_value result = ovl.xelem(0); - octave_base_value *ret = result.internal_rep (); - ret->grab (); - return ret; - } - - if (! (ovl.length () == 0 - || (ovl.length () == 1 && ovl.xelem (0).is_undefined ()))) - gripe_bad_result (); - - return 0; -} - -// -------------------- jit_range -------------------- -bool -jit_range::all_elements_are_ints () const -{ - Range r (*this); - return r.all_elements_are_ints (); -} - -std::ostream& -operator<< (std::ostream& os, const jit_range& rng) -{ - return os << "Range[" << rng.base << ", " << rng.limit << ", " << rng.inc - << ", " << rng.nelem << "]"; -} - -// -------------------- jit_matrix -------------------- - -std::ostream& -operator<< (std::ostream& os, const jit_matrix& mat) -{ - return os << "Matrix[" << mat.ref_count << ", " << mat.slice_data << ", " - << mat.slice_len << ", " << mat.dimensions << ", " - << mat.array << "]"; -} - -// -------------------- jit_type -------------------- -jit_type::jit_type (const std::string& aname, jit_type *aparent, - llvm::Type *allvm_type, bool askip_paren, int aid) : - mname (aname), mparent (aparent), llvm_type (allvm_type), mid (aid), - mdepth (aparent ? aparent->mdepth + 1 : 0), mskip_paren (askip_paren) -{ - std::memset (msret, 0, sizeof (msret)); - std::memset (mpointer_arg, 0, sizeof (mpointer_arg)); - std::memset (mpack, 0, sizeof (mpack)); - std::memset (munpack, 0, sizeof (munpack)); - - for (size_t i = 0; i < jit_convention::length; ++i) - mpacked_type[i] = llvm_type; -} - -llvm::Type * -jit_type::to_llvm_arg (void) const -{ - return llvm_type ? llvm_type->getPointerTo () : 0; -} - -// -------------------- jit_function -------------------- -jit_function::jit_function () : module (0), llvm_function (0), mresult (0), - call_conv (jit_convention::length), - mcan_error (false) -{} - -jit_function::jit_function (llvm::Module *amodule, - jit_convention::type acall_conv, - const llvm::Twine& aname, jit_type *aresult, - const std::vector& aargs) - : module (amodule), mresult (aresult), args (aargs), call_conv (acall_conv), - mcan_error (false) -{ - llvm::SmallVector llvm_args; - - llvm::Type *rtype = llvm::Type::getVoidTy (context); - if (mresult) - { - rtype = mresult->packed_type (call_conv); - if (sret ()) - { - llvm_args.push_back (rtype->getPointerTo ()); - rtype = llvm::Type::getVoidTy (context); - } - } - - for (std::vector::const_iterator iter = args.begin (); - iter != args.end (); ++iter) - { - jit_type *ty = *iter; - assert (ty); - llvm::Type *argty = ty->packed_type (call_conv); - if (ty->pointer_arg (call_conv)) - argty = argty->getPointerTo (); - - llvm_args.push_back (argty); - } - - // we mark all functinos as external linkage because this prevents llvm - // from getting rid of always inline functions - llvm::FunctionType *ft = llvm::FunctionType::get (rtype, llvm_args, false); - llvm_function = llvm::Function::Create (ft, llvm::Function::ExternalLinkage, - aname, module); - - if (sret ()) - llvm_function->addAttribute (1, llvm::Attribute::StructRet); - - if (call_conv == jit_convention::internal) - llvm_function->addFnAttr (llvm::Attribute::AlwaysInline); -} - -jit_function::jit_function (const jit_function& fn, jit_type *aresult, - const std::vector& aargs) - : module (fn.module), llvm_function (fn.llvm_function), mresult (aresult), - args (aargs), call_conv (fn.call_conv), mcan_error (fn.mcan_error) -{ -} - -jit_function::jit_function (const jit_function& fn) - : module (fn.module), llvm_function (fn.llvm_function), mresult (fn.mresult), - args (fn.args), call_conv (fn.call_conv), mcan_error (fn.mcan_error) -{} - -void -jit_function::erase (void) -{ - if (! llvm_function) - return; - - llvm_function->eraseFromParent (); - llvm_function = 0; -} - -std::string -jit_function::name (void) const -{ - return llvm_function->getName (); -} - -llvm::BasicBlock * -jit_function::new_block (const std::string& aname, - llvm::BasicBlock *insert_before) -{ - return llvm::BasicBlock::Create (context, aname, llvm_function, - insert_before); -} - -llvm::Value * -jit_function::call (llvm::IRBuilderD& builder, - const std::vector& in_args) const -{ - if (! valid ()) - throw jit_fail_exception ("Call not implemented"); - - assert (in_args.size () == args.size ()); - std::vector llvm_args (args.size ()); - for (size_t i = 0; i < in_args.size (); ++i) - llvm_args[i] = in_args[i]->to_llvm (); - - return call (builder, llvm_args); -} - -llvm::Value * -jit_function::call (llvm::IRBuilderD& builder, - const std::vector& in_args) const -{ - if (! valid ()) - throw jit_fail_exception ("Call not implemented"); - - assert (in_args.size () == args.size ()); - llvm::SmallVector llvm_args; - llvm_args.reserve (in_args.size () + sret ()); - - llvm::BasicBlock *insert_block = builder.GetInsertBlock (); - llvm::Function *parent = insert_block->getParent (); - assert (parent); - - // we insert allocas inside the prelude block to prevent stack overflows - llvm::BasicBlock& prelude = parent->getEntryBlock (); - llvm::IRBuilder<> pre_builder (&prelude, prelude.begin ()); - - llvm::AllocaInst *sret_mem = 0; - if (sret ()) - { - sret_mem = pre_builder.CreateAlloca (mresult->packed_type (call_conv)); - llvm_args.push_back (sret_mem); - } - - for (size_t i = 0; i < in_args.size (); ++i) - { - llvm::Value *arg = in_args[i]; - jit_type::convert_fn convert = args[i]->pack (call_conv); - if (convert) - arg = convert (builder, arg); - - if (args[i]->pointer_arg (call_conv)) - { - llvm::Type *ty = args[i]->packed_type (call_conv); - llvm::Value *alloca = pre_builder.CreateAlloca (ty); - builder.CreateStore (arg, alloca); - arg = alloca; - } - - llvm_args.push_back (arg); - } - - llvm::CallInst *callinst = builder.CreateCall (llvm_function, llvm_args); - llvm::Value *ret = callinst; - - if (sret ()) - { - callinst->addAttribute (1, llvm::Attribute::StructRet); - ret = builder.CreateLoad (sret_mem); - } - - if (mresult) - { - jit_type::convert_fn unpack = mresult->unpack (call_conv); - if (unpack) - ret = unpack (builder, ret); - } - - return ret; -} - -llvm::Value * -jit_function::argument (llvm::IRBuilderD& builder, size_t idx) const -{ - assert (idx < args.size ()); - - // FIXME: We should be treating arguments like a list, not a vector. Shouldn't - // matter much for now, as the number of arguments shouldn't be much bigger - // than 4 - llvm::Function::arg_iterator iter = llvm_function->arg_begin (); - if (sret ()) - ++iter; - - for (size_t i = 0; i < idx; ++i, ++iter); - - if (args[idx]->pointer_arg (call_conv)) - return builder.CreateLoad (iter); - - return iter; -} - -void -jit_function::do_return (llvm::IRBuilderD& builder, llvm::Value *rval, - bool verify) -{ - assert (! rval == ! mresult); - - if (rval) - { - jit_type::convert_fn convert = mresult->pack (call_conv); - if (convert) - rval = convert (builder, rval); - - if (sret ()) - { - builder.CreateStore (rval, llvm_function->arg_begin ()); - builder.CreateRetVoid (); - } - else - builder.CreateRet (rval); - } - else - builder.CreateRetVoid (); - - if (verify) - llvm::verifyFunction (*llvm_function); -} - -void -jit_function::do_add_mapping (llvm::ExecutionEngine *engine, void *fn) -{ - assert (valid ()); - engine->addGlobalMapping (llvm_function, fn); -} - -std::ostream& -operator<< (std::ostream& os, const jit_function& fn) -{ - llvm::Function *lfn = fn.to_llvm (); - os << "jit_function: cc=" << fn.call_conv; - llvm::raw_os_ostream llvm_out (os); - lfn->print (llvm_out); - llvm_out.flush (); - return os; -} - -// -------------------- jit_operation -------------------- -jit_operation::~jit_operation (void) -{ - for (generated_map::iterator iter = generated.begin (); - iter != generated.end (); ++iter) - { - delete iter->first; - delete iter->second; - } -} - -void -jit_operation::add_overload (const jit_function& func, - const std::vector& args) -{ - if (args.size () >= overloads.size ()) - overloads.resize (args.size () + 1); - - Array& over = overloads[args.size ()]; - dim_vector dv (over.dims ()); - Array idx = to_idx (args); - bool must_resize = false; - - if (dv.length () != idx.numel ()) - { - dv.resize (idx.numel ()); - must_resize = true; - } - - for (octave_idx_type i = 0; i < dv.length (); ++i) - if (dv(i) <= idx(i)) - { - must_resize = true; - dv(i) = idx(i) + 1; - } - - if (must_resize) - over.resize (dv); - - over(idx) = func; -} - -const jit_function& -jit_operation::overload (const std::vector& types) const -{ - static jit_function null_overload; - for (size_t i =0; i < types.size (); ++i) - if (! types[i]) - return null_overload; - - if (types.size () >= overloads.size ()) - return do_generate (types); - - const Array& over = overloads[types.size ()]; - dim_vector dv (over.dims ()); - Array idx = to_idx (types); - for (octave_idx_type i = 0; i < dv.length (); ++i) - if (idx(i) >= dv(i)) - return do_generate (types); - - const jit_function& ret = over(idx); - if (! ret.valid ()) - return do_generate (types); - - return ret; -} - -Array -jit_operation::to_idx (const std::vector& types) const -{ - octave_idx_type numel = types.size (); - numel = std::max (2, numel); - - Array idx (dim_vector (1, numel)); - for (octave_idx_type i = 0; i < static_cast (types.size ()); - ++i) - idx(i) = types[i]->type_id (); - - if (types.size () == 0) - idx(0) = idx(1) = 0; - if (types.size () == 1) - { - idx(1) = idx(0); - idx(0) = 0; - } - - return idx; -} - -const jit_function& -jit_operation::do_generate (const signature_vec& types) const -{ - static jit_function null_overload; - generated_map::const_iterator find = generated.find (&types); - if (find != generated.end ()) - { - if (find->second) - return *find->second; - else - return null_overload; - } - - jit_function *ret = generate (types); - generated[new signature_vec (types)] = ret; - return ret ? *ret : null_overload; -} - -jit_function * -jit_operation::generate (const signature_vec&) const -{ - return 0; -} - -bool -jit_operation::signature_cmp -::operator() (const signature_vec *lhs, const signature_vec *rhs) -{ - const signature_vec& l = *lhs; - const signature_vec& r = *rhs; - - if (l.size () < r.size ()) - return true; - else if (l.size () > r.size ()) - return false; - - for (size_t i = 0; i < l.size (); ++i) - { - if (l[i]->type_id () < r[i]->type_id ()) - return true; - else if (l[i]->type_id () > r[i]->type_id ()) - return false; - } - - return false; -} - -// -------------------- jit_index_operation -------------------- -jit_function * -jit_index_operation::generate (const signature_vec& types) const -{ - if (types.size () > 2 && types[0] == jit_typeinfo::get_matrix ()) - { - // indexing a matrix with scalars - jit_type *scalar = jit_typeinfo::get_scalar (); - for (size_t i = 1; i < types.size (); ++i) - if (types[i] != scalar) - return 0; - - return generate_matrix (types); - } - - return 0; -} - -llvm::Value * -jit_index_operation::create_arg_array (llvm::IRBuilderD& builder, - const jit_function &fn, size_t start_idx, - size_t end_idx) const -{ - size_t n = end_idx - start_idx; - llvm::Type *scalar_t = jit_typeinfo::get_scalar_llvm (); - llvm::ArrayType *array_t = llvm::ArrayType::get (scalar_t, n); - llvm::Value *array = llvm::UndefValue::get (array_t); - for (size_t i = start_idx; i < end_idx; ++i) - { - llvm::Value *idx = fn.argument (builder, i); - array = builder.CreateInsertValue (array, idx, i - start_idx); - } - - llvm::Value *array_mem = builder.CreateAlloca (array_t); - builder.CreateStore (array, array_mem); - return builder.CreateBitCast (array_mem, scalar_t->getPointerTo ()); -} - -// -------------------- jit_paren_subsref -------------------- -jit_function * -jit_paren_subsref::generate_matrix (const signature_vec& types) const -{ - std::stringstream ss; - ss << "jit_paren_subsref_matrix_scalar" << (types.size () - 1); - - jit_type *scalar = jit_typeinfo::get_scalar (); - jit_function *fn = new jit_function (module, jit_convention::internal, - ss.str (), scalar, types); - fn->mark_can_error (); - llvm::BasicBlock *body = fn->new_block (); - llvm::IRBuilder<> builder (body); - - llvm::Value *array = create_arg_array (builder, *fn, 1, types.size ()); - jit_type *index = jit_typeinfo::get_index (); - llvm::Value *nelem = llvm::ConstantInt::get (index->to_llvm (), - types.size () - 1); - llvm::Value *mat = fn->argument (builder, 0); - llvm::Value *ret = paren_scalar.call (builder, mat, array, nelem); - fn->do_return (builder, ret); - return fn; -} - -void -jit_paren_subsref::do_initialize (void) -{ - std::vector types (3); - types[0] = jit_typeinfo::get_matrix (); - types[1] = jit_typeinfo::get_scalar_ptr (); - types[2] = jit_typeinfo::get_index (); - - jit_type *scalar = jit_typeinfo::get_scalar (); - paren_scalar = jit_function (module, jit_convention::external, - "octave_jit_paren_scalar", scalar, types); - paren_scalar.add_mapping (engine, &octave_jit_paren_scalar); - paren_scalar.mark_can_error (); -} - -// -------------------- jit_paren_subsasgn -------------------- -jit_function * -jit_paren_subsasgn::generate_matrix (const signature_vec& types) const -{ - std::stringstream ss; - ss << "jit_paren_subsasgn_matrix_scalar" << (types.size () - 2); - - jit_type *matrix = jit_typeinfo::get_matrix (); - jit_function *fn = new jit_function (module, jit_convention::internal, - ss.str (), matrix, types); - fn->mark_can_error (); - llvm::BasicBlock *body = fn->new_block (); - llvm::IRBuilder<> builder (body); - - llvm::Value *array = create_arg_array (builder, *fn, 1, types.size () - 1); - jit_type *index = jit_typeinfo::get_index (); - llvm::Value *nelem = llvm::ConstantInt::get (index->to_llvm (), - types.size () - 2); - - llvm::Value *mat = fn->argument (builder, 0); - llvm::Value *value = fn->argument (builder, types.size () - 1); - llvm::Value *ret = paren_scalar.call (builder, mat, array, nelem, value); - fn->do_return (builder, ret); - return fn; -} - -void -jit_paren_subsasgn::do_initialize (void) -{ - if (paren_scalar.valid ()) - return; - - jit_type *matrix = jit_typeinfo::get_matrix (); - std::vector types (4); - types[0] = matrix; - types[1] = jit_typeinfo::get_scalar_ptr (); - types[2] = jit_typeinfo::get_index (); - types[3] = jit_typeinfo::get_scalar (); - - paren_scalar = jit_function (module, jit_convention::external, - "octave_jit_paren_scalar", matrix, types); - paren_scalar.add_mapping (engine, &octave_jit_paren_scalar_subsasgn); - paren_scalar.mark_can_error (); -} - -// -------------------- jit_typeinfo -------------------- -void -jit_typeinfo::initialize (llvm::Module *m, llvm::ExecutionEngine *e) -{ - new jit_typeinfo (m, e); -} - -// wrap function names to simplify jit_typeinfo::create_external -#define JIT_FN(fn) engine, &fn, #fn - -jit_typeinfo::jit_typeinfo (llvm::Module *m, llvm::ExecutionEngine *e) - : module (m), engine (e), next_id (0), - builder (*new llvm::IRBuilderD (context)) -{ - instance = this; - - // FIXME: We should be registering types like in octave_value_typeinfo - llvm::Type *any_t = llvm::StructType::create (context, "octave_base_value"); - any_t = any_t->getPointerTo (); - - llvm::Type *scalar_t = llvm::Type::getDoubleTy (context); - llvm::Type *bool_t = llvm::Type::getInt1Ty (context); - llvm::Type *string_t = llvm::Type::getInt8Ty (context); - string_t = string_t->getPointerTo (); - llvm::Type *index_t = llvm::Type::getIntNTy (context, - sizeof(octave_idx_type) * 8); - - llvm::StructType *range_t = llvm::StructType::create (context, "range"); - std::vector range_contents (4, scalar_t); - range_contents[3] = index_t; - range_t->setBody (range_contents); - - llvm::Type *refcount_t = llvm::Type::getIntNTy (context, sizeof(int) * 8); - - llvm::StructType *matrix_t = llvm::StructType::create (context, "matrix"); - llvm::Type *matrix_contents[5]; - matrix_contents[0] = refcount_t->getPointerTo (); - matrix_contents[1] = scalar_t->getPointerTo (); - matrix_contents[2] = index_t; - matrix_contents[3] = index_t->getPointerTo (); - matrix_contents[4] = string_t; - matrix_t->setBody (llvm::makeArrayRef (matrix_contents, 5)); - - llvm::Type *complex_t = llvm::ArrayType::get (scalar_t, 2); - - // complex_ret is what is passed to C functions in order to get calling - // convention right - llvm::Type *cmplx_inner_cont[] = {scalar_t, scalar_t}; - llvm::StructType *cmplx_inner = llvm::StructType::create (cmplx_inner_cont); - - complex_ret = llvm::StructType::create (context, "complex_ret"); - { - llvm::Type *contents[] = {cmplx_inner}; - complex_ret->setBody (contents); - } - - // create types - any = new_type ("any", 0, any_t); - matrix = new_type ("matrix", any, matrix_t); - complex = new_type ("complex", any, complex_t); - scalar = new_type ("scalar", complex, scalar_t); - scalar_ptr = new_type ("scalar_ptr", 0, scalar_t->getPointerTo ()); - any_ptr = new_type ("any_ptr", 0, any_t->getPointerTo ()); - range = new_type ("range", any, range_t); - string = new_type ("string", any, string_t); - boolean = new_type ("bool", any, bool_t); - index = new_type ("index", any, index_t); - - create_int (8); - create_int (16); - create_int (32); - create_int (64); - - casts.resize (next_id + 1); - identities.resize (next_id + 1); - - // specify calling conventions - // FIXME: We should detect architecture and do something sane based on that - // here we assume x86 or x86_64 - matrix->mark_sret (jit_convention::external); - matrix->mark_pointer_arg (jit_convention::external); - - range->mark_sret (jit_convention::external); - range->mark_pointer_arg (jit_convention::external); - - complex->set_pack (jit_convention::external, &jit_typeinfo::pack_complex); - complex->set_unpack (jit_convention::external, &jit_typeinfo::unpack_complex); - complex->set_packed_type (jit_convention::external, complex_ret); - - if (sizeof (void *) == 4) - complex->mark_sret (jit_convention::external); - - paren_subsref_fn.initialize (module, engine); - paren_subsasgn_fn.initialize (module, engine); - - // bind global variables - lerror_state = new llvm::GlobalVariable (*module, bool_t, false, - llvm::GlobalValue::ExternalLinkage, - 0, "error_state"); - engine->addGlobalMapping (lerror_state, - reinterpret_cast (&error_state)); - - // sig_atomic_type is going to be some sort of integer - sig_atomic_type = llvm::Type::getIntNTy (context, sizeof(sig_atomic_t) * 8); - loctave_interrupt_state - = new llvm::GlobalVariable (*module, sig_atomic_type, false, - llvm::GlobalValue::ExternalLinkage, 0, - "octave_interrupt_state"); - engine->addGlobalMapping (loctave_interrupt_state, - reinterpret_cast (&octave_interrupt_state)); - - // generic call function - { - jit_type *int_t = intN (sizeof (octave_builtin::fcn) * 8); - any_call = create_external (JIT_FN (octave_jit_call), any, int_t, int_t, - any_ptr, int_t); - } - - // any with anything is an any op - jit_function fn; - jit_type *binary_op_type = intN (sizeof (octave_value::binary_op) * 8); - llvm::Type *llvm_bo_type = binary_op_type->to_llvm (); - jit_function any_binary = create_external (JIT_FN (octave_jit_binary_any_any), - any, binary_op_type, any, any); - any_binary.mark_can_error (); - binary_ops.resize (octave_value::num_binary_ops); - for (size_t i = 0; i < octave_value::num_binary_ops; ++i) - { - octave_value::binary_op op = static_cast (i); - std::string op_name = octave_value::binary_op_as_string (op); - binary_ops[i].stash_name ("binary" + op_name); - } - - unary_ops.resize (octave_value::num_unary_ops); - for (size_t i = 0; i < octave_value::num_unary_ops; ++i) - { - octave_value::unary_op op = static_cast (i); - std::string op_name = octave_value::unary_op_as_string (op); - unary_ops[i].stash_name ("unary" + op_name); - } - - for (int op = 0; op < octave_value::num_binary_ops; ++op) - { - llvm::Twine fn_name ("octave_jit_binary_any_any_"); - fn_name = fn_name + llvm::Twine (op); - - fn = create_internal (fn_name, any, any, any); - fn.mark_can_error (); - llvm::BasicBlock *block = fn.new_block (); - builder.SetInsertPoint (block); - llvm::APInt op_int(sizeof (octave_value::binary_op) * 8, op, - std::numeric_limits::is_signed); - llvm::Value *op_as_llvm = llvm::ConstantInt::get (llvm_bo_type, op_int); - llvm::Value *ret = any_binary.call (builder, op_as_llvm, - fn.argument (builder, 0), - fn.argument (builder, 1)); - fn.do_return (builder, ret); - binary_ops[op].add_overload (fn); - } - - // grab matrix - fn = create_external (JIT_FN (octave_jit_grab_matrix), matrix, matrix); - grab_fn.add_overload (fn); - - grab_fn.add_overload (create_identity (scalar)); - grab_fn.add_overload (create_identity (scalar_ptr)); - grab_fn.add_overload (create_identity (any_ptr)); - grab_fn.add_overload (create_identity (boolean)); - grab_fn.add_overload (create_identity (complex)); - grab_fn.add_overload (create_identity (index)); - - // release any - fn = create_external (JIT_FN (octave_jit_release_any), 0, any); - release_fn.add_overload (fn); - release_fn.stash_name ("release"); - - // release matrix - fn = create_external (JIT_FN (octave_jit_release_matrix), 0, matrix); - release_fn.add_overload (fn); - - // destroy - destroy_fn = release_fn; - destroy_fn.stash_name ("destroy"); - destroy_fn.add_overload (create_identity(scalar)); - destroy_fn.add_overload (create_identity(boolean)); - destroy_fn.add_overload (create_identity(index)); - destroy_fn.add_overload (create_identity(complex)); - - // now for binary scalar operations - add_binary_op (scalar, octave_value::op_add, llvm::Instruction::FAdd); - add_binary_op (scalar, octave_value::op_sub, llvm::Instruction::FSub); - add_binary_op (scalar, octave_value::op_mul, llvm::Instruction::FMul); - add_binary_op (scalar, octave_value::op_el_mul, llvm::Instruction::FMul); - - add_binary_fcmp (scalar, octave_value::op_lt, llvm::CmpInst::FCMP_ULT); - add_binary_fcmp (scalar, octave_value::op_le, llvm::CmpInst::FCMP_ULE); - add_binary_fcmp (scalar, octave_value::op_eq, llvm::CmpInst::FCMP_UEQ); - add_binary_fcmp (scalar, octave_value::op_ge, llvm::CmpInst::FCMP_UGE); - add_binary_fcmp (scalar, octave_value::op_gt, llvm::CmpInst::FCMP_UGT); - add_binary_fcmp (scalar, octave_value::op_ne, llvm::CmpInst::FCMP_UNE); - - jit_function gripe_div0 = create_external (JIT_FN (gripe_divide_by_zero), 0); - gripe_div0.mark_can_error (); - - // divide is annoying because it might error - fn = create_internal ("octave_jit_div_scalar_scalar", scalar, scalar, scalar); - fn.mark_can_error (); - - llvm::BasicBlock *body = fn.new_block (); - builder.SetInsertPoint (body); - { - llvm::BasicBlock *warn_block = fn.new_block ("warn"); - llvm::BasicBlock *normal_block = fn.new_block ("normal"); - - llvm::Value *zero = llvm::ConstantFP::get (scalar_t, 0); - llvm::Value *check = builder.CreateFCmpUEQ (zero, fn.argument (builder, 1)); - builder.CreateCondBr (check, warn_block, normal_block); - - builder.SetInsertPoint (warn_block); - gripe_div0.call (builder); - builder.CreateBr (normal_block); - - builder.SetInsertPoint (normal_block); - llvm::Value *ret = builder.CreateFDiv (fn.argument (builder, 0), - fn.argument (builder, 1)); - fn.do_return (builder, ret); - } - binary_ops[octave_value::op_div].add_overload (fn); - binary_ops[octave_value::op_el_div].add_overload (fn); - - // ldiv is the same as div with the operators reversed - fn = mirror_binary (fn); - binary_ops[octave_value::op_ldiv].add_overload (fn); - binary_ops[octave_value::op_el_ldiv].add_overload (fn); - - // In general, the result of scalar ^ scalar is a complex number. We might be - // able to improve on this if we keep track of the range of values varaibles - // can take on. - fn = create_external (JIT_FN (octave_jit_pow_scalar_scalar), complex, scalar, - scalar); - binary_ops[octave_value::op_pow].add_overload (fn); - binary_ops[octave_value::op_el_pow].add_overload (fn); - - // now for unary scalar operations - // FIXME: Impelment not - fn = create_internal ("octave_jit_++", scalar, scalar); - body = fn.new_block (); - builder.SetInsertPoint (body); - { - llvm::Value *one = llvm::ConstantFP::get (scalar_t, 1); - llvm::Value *val = fn.argument (builder, 0); - val = builder.CreateFAdd (val, one); - fn.do_return (builder, val); - } - unary_ops[octave_value::op_incr].add_overload (fn); - - fn = create_internal ("octave_jit_--", scalar, scalar); - body = fn.new_block (); - builder.SetInsertPoint (body); - { - llvm::Value *one = llvm::ConstantFP::get (scalar_t, 1); - llvm::Value *val = fn.argument (builder, 0); - val = builder.CreateFSub (val, one); - fn.do_return (builder, val); - } - unary_ops[octave_value::op_decr].add_overload (fn); - - fn = create_internal ("octave_jit_uminus", scalar, scalar); - body = fn.new_block (); - builder.SetInsertPoint (body); - { - llvm::Value *mone = llvm::ConstantFP::get (scalar_t, -1); - llvm::Value *val = fn.argument (builder, 0); - val = builder.CreateFMul (val, mone); - fn.do_return (builder, val); - } - - fn = create_identity (scalar); - unary_ops[octave_value::op_uplus].add_overload (fn); - unary_ops[octave_value::op_transpose].add_overload (fn); - unary_ops[octave_value::op_hermitian].add_overload (fn); - - // now for binary complex operations - fn = create_internal ("octave_jit_+_complex_complex", complex, complex, - complex); - body = fn.new_block (); - builder.SetInsertPoint (body); - { - llvm::Value *lhs = fn.argument (builder, 0); - llvm::Value *rhs = fn.argument (builder, 1); - llvm::Value *real = builder.CreateFAdd (complex_real (lhs), - complex_real (rhs)); - llvm::Value *imag = builder.CreateFAdd (complex_imag (lhs), - complex_imag (rhs)); - fn.do_return (builder, complex_new (real, imag)); - } - binary_ops[octave_value::op_add].add_overload (fn); - - fn = create_internal ("octave_jit_-_complex_complex", complex, complex, - complex); - body = fn.new_block (); - builder.SetInsertPoint (body); - { - llvm::Value *lhs = fn.argument (builder, 0); - llvm::Value *rhs = fn.argument (builder, 1); - llvm::Value *real = builder.CreateFSub (complex_real (lhs), - complex_real (rhs)); - llvm::Value *imag = builder.CreateFSub (complex_imag (lhs), - complex_imag (rhs)); - fn.do_return (builder, complex_new (real, imag)); - } - binary_ops[octave_value::op_sub].add_overload (fn); - - fn = create_external (JIT_FN (octave_jit_complex_mul), - complex, complex, complex); - binary_ops[octave_value::op_mul].add_overload (fn); - binary_ops[octave_value::op_el_mul].add_overload (fn); - - jit_function complex_div = create_external (JIT_FN (octave_jit_complex_div), - complex, complex, complex); - complex_div.mark_can_error (); - binary_ops[octave_value::op_div].add_overload (fn); - binary_ops[octave_value::op_ldiv].add_overload (fn); - - fn = create_external (JIT_FN (octave_jit_pow_complex_complex), complex, - complex, complex); - binary_ops[octave_value::op_pow].add_overload (fn); - binary_ops[octave_value::op_el_pow].add_overload (fn); - - fn = create_internal ("octave_jit_*_scalar_complex", complex, scalar, - complex); - jit_function mul_scalar_complex = fn; - body = fn.new_block (); - builder.SetInsertPoint (body); - { - llvm::BasicBlock *complex_mul = fn.new_block ("complex_mul"); - llvm::BasicBlock *scalar_mul = fn.new_block ("scalar_mul"); - - llvm::Value *fzero = llvm::ConstantFP::get (scalar_t, 0); - llvm::Value *lhs = fn.argument (builder, 0); - llvm::Value *rhs = fn.argument (builder, 1); - - llvm::Value *cmp = builder.CreateFCmpUEQ (complex_imag (rhs), fzero); - builder.CreateCondBr (cmp, scalar_mul, complex_mul); - - builder.SetInsertPoint (scalar_mul); - llvm::Value *temp = complex_real (rhs); - temp = builder.CreateFMul (lhs, temp); - fn.do_return (builder, complex_new (temp, fzero), false); - - - builder.SetInsertPoint (complex_mul); - temp = complex_new (builder.CreateFMul (lhs, complex_real (rhs)), - builder.CreateFMul (lhs, complex_imag (rhs))); - fn.do_return (builder, temp); - } - binary_ops[octave_value::op_mul].add_overload (fn); - binary_ops[octave_value::op_el_mul].add_overload (fn); - - - fn = mirror_binary (mul_scalar_complex); - binary_ops[octave_value::op_mul].add_overload (fn); - binary_ops[octave_value::op_el_mul].add_overload (fn); - - fn = create_internal ("octave_jit_+_scalar_complex", complex, scalar, - complex); - body = fn.new_block (); - builder.SetInsertPoint (body); - { - llvm::Value *lhs = fn.argument (builder, 0); - llvm::Value *rhs = fn.argument (builder, 1); - llvm::Value *real = builder.CreateFAdd (lhs, complex_real (rhs)); - fn.do_return (builder, complex_real (rhs, real)); - } - binary_ops[octave_value::op_add].add_overload (fn); - - fn = mirror_binary (fn); - binary_ops[octave_value::op_add].add_overload (fn); - - fn = create_internal ("octave_jit_-_complex_scalar", complex, complex, - scalar); - body = fn.new_block (); - builder.SetInsertPoint (body); - { - llvm::Value *lhs = fn.argument (builder, 0); - llvm::Value *rhs = fn.argument (builder, 1); - llvm::Value *real = builder.CreateFSub (complex_real (lhs), rhs); - fn.do_return (builder, complex_real (lhs, real)); - } - binary_ops[octave_value::op_sub].add_overload (fn); - - fn = create_internal ("octave_jit_-_scalar_complex", complex, scalar, - complex); - body = fn.new_block (); - builder.SetInsertPoint (body); - { - llvm::Value *lhs = fn.argument (builder, 0); - llvm::Value *rhs = fn.argument (builder, 1); - llvm::Value *real = builder.CreateFSub (lhs, complex_real (rhs)); - fn.do_return (builder, complex_real (rhs, real)); - } - binary_ops[octave_value::op_sub].add_overload (fn); - - fn = create_external (JIT_FN (octave_jit_pow_scalar_complex), complex, scalar, - complex); - binary_ops[octave_value::op_pow].add_overload (fn); - binary_ops[octave_value::op_el_pow].add_overload (fn); - - fn = create_external (JIT_FN (octave_jit_pow_complex_scalar), complex, - complex, scalar); - binary_ops[octave_value::op_pow].add_overload (fn); - binary_ops[octave_value::op_el_pow].add_overload (fn); - - // now for binary index operators - add_binary_op (index, octave_value::op_add, llvm::Instruction::Add); - - // and binary bool operators - add_binary_op (boolean, octave_value::op_el_or, llvm::Instruction::Or); - add_binary_op (boolean, octave_value::op_el_and, llvm::Instruction::And); - - // now for printing functions - print_fn.stash_name ("print"); - add_print (any, reinterpret_cast (&octave_jit_print_any)); - add_print (scalar, reinterpret_cast (&octave_jit_print_scalar)); - - // initialize for loop - for_init_fn.stash_name ("for_init"); - - fn = create_internal ("octave_jit_for_range_init", index, range); - body = fn.new_block (); - builder.SetInsertPoint (body); - { - llvm::Value *zero = llvm::ConstantInt::get (index_t, 0); - fn.do_return (builder, zero); - } - for_init_fn.add_overload (fn); - - // bounds check for for loop - for_check_fn.stash_name ("for_check"); - - fn = create_internal ("octave_jit_for_range_check", boolean, range, index); - body = fn.new_block (); - builder.SetInsertPoint (body); - { - llvm::Value *nelem - = builder.CreateExtractValue (fn.argument (builder, 0), 3); - llvm::Value *idx = fn.argument (builder, 1); - llvm::Value *ret = builder.CreateICmpULT (idx, nelem); - fn.do_return (builder, ret); - } - for_check_fn.add_overload (fn); - - // index variabe for for loop - for_index_fn.stash_name ("for_index"); - - fn = create_internal ("octave_jit_for_range_idx", scalar, range, index); - body = fn.new_block (); - builder.SetInsertPoint (body); - { - llvm::Value *idx = fn.argument (builder, 1); - llvm::Value *didx = builder.CreateSIToFP (idx, scalar_t); - llvm::Value *rng = fn.argument (builder, 0); - llvm::Value *base = builder.CreateExtractValue (rng, 0); - llvm::Value *inc = builder.CreateExtractValue (rng, 2); - - llvm::Value *ret = builder.CreateFMul (didx, inc); - ret = builder.CreateFAdd (base, ret); - fn.do_return (builder, ret); - } - for_index_fn.add_overload (fn); - - // logically true - logically_true_fn.stash_name ("logically_true"); - - jit_function gripe_nantl - = create_external (JIT_FN (octave_jit_gripe_nan_to_logical_conversion), 0); - gripe_nantl.mark_can_error (); - - fn = create_internal ("octave_jit_logically_true_scalar", boolean, scalar); - fn.mark_can_error (); - - body = fn.new_block (); - builder.SetInsertPoint (body); - { - llvm::BasicBlock *error_block = fn.new_block ("error"); - llvm::BasicBlock *normal_block = fn.new_block ("normal"); - - llvm::Value *check = builder.CreateFCmpUNE (fn.argument (builder, 0), - fn.argument (builder, 0)); - builder.CreateCondBr (check, error_block, normal_block); - - builder.SetInsertPoint (error_block); - gripe_nantl.call (builder); - builder.CreateBr (normal_block); - builder.SetInsertPoint (normal_block); - - llvm::Value *zero = llvm::ConstantFP::get (scalar_t, 0); - llvm::Value *ret = builder.CreateFCmpONE (fn.argument (builder, 0), zero); - fn.do_return (builder, ret); - } - logically_true_fn.add_overload (fn); - - // logically_true boolean - fn = create_identity (boolean); - logically_true_fn.add_overload (fn); - - // make_range - // FIXME: May be benificial to implement all in LLVM - make_range_fn.stash_name ("make_range"); - jit_function compute_nelem - = create_external (JIT_FN (octave_jit_compute_nelem), - index, scalar, scalar, scalar); - - - fn = create_internal ("octave_jit_make_range", range, scalar, scalar, scalar); - body = fn.new_block (); - builder.SetInsertPoint (body); - { - llvm::Value *base = fn.argument (builder, 0); - llvm::Value *limit = fn.argument (builder, 1); - llvm::Value *inc = fn.argument (builder, 2); - llvm::Value *nelem = compute_nelem.call (builder, base, limit, inc); - - llvm::Value *dzero = llvm::ConstantFP::get (scalar_t, 0); - llvm::Value *izero = llvm::ConstantInt::get (index_t, 0); - llvm::Value *rng = llvm::ConstantStruct::get (range_t, dzero, dzero, dzero, - izero, NULL); - rng = builder.CreateInsertValue (rng, base, 0); - rng = builder.CreateInsertValue (rng, limit, 1); - rng = builder.CreateInsertValue (rng, inc, 2); - rng = builder.CreateInsertValue (rng, nelem, 3); - fn.do_return (builder, rng); - } - make_range_fn.add_overload (fn); - - // paren_subsref - jit_type *jit_int = intN (sizeof (int) * 8); - llvm::Type *int_t = jit_int->to_llvm (); - jit_function ginvalid_index - = create_external (JIT_FN (octave_jit_ginvalid_index), 0); - jit_function gindex_range = create_external (JIT_FN (octave_jit_gindex_range), - 0, jit_int, jit_int, index, - index); - - fn = create_internal ("()subsref", scalar, matrix, scalar); - fn.mark_can_error (); - - body = fn.new_block (); - builder.SetInsertPoint (body); - { - llvm::Value *one = llvm::ConstantInt::get (index_t, 1); - llvm::Value *ione; - if (index_t == int_t) - ione = one; - else - ione = llvm::ConstantInt::get (int_t, 1); - - llvm::Value *undef = llvm::UndefValue::get (scalar_t); - llvm::Value *mat = fn.argument (builder, 0); - llvm::Value *idx = fn.argument (builder, 1); - - // convert index to scalar to integer, and check index >= 1 - llvm::Value *int_idx = builder.CreateFPToSI (idx, index_t); - llvm::Value *check_idx = builder.CreateSIToFP (int_idx, scalar_t); - llvm::Value *cond0 = builder.CreateFCmpUNE (idx, check_idx); - llvm::Value *cond1 = builder.CreateICmpSLT (int_idx, one); - llvm::Value *cond = builder.CreateOr (cond0, cond1); - - llvm::BasicBlock *done = fn.new_block ("done"); - llvm::BasicBlock *conv_error = fn.new_block ("conv_error", done); - llvm::BasicBlock *normal = fn.new_block ("normal", done); - builder.CreateCondBr (cond, conv_error, normal); - - builder.SetInsertPoint (conv_error); - ginvalid_index.call (builder); - builder.CreateBr (done); - - builder.SetInsertPoint (normal); - llvm::Value *len = builder.CreateExtractValue (mat, - llvm::ArrayRef (2)); - cond = builder.CreateICmpSGT (int_idx, len); - - - llvm::BasicBlock *bounds_error = fn.new_block ("bounds_error", done); - llvm::BasicBlock *success = fn.new_block ("success", done); - builder.CreateCondBr (cond, bounds_error, success); - - builder.SetInsertPoint (bounds_error); - gindex_range.call (builder, ione, ione, int_idx, len); - builder.CreateBr (done); - - builder.SetInsertPoint (success); - llvm::Value *data = builder.CreateExtractValue (mat, - llvm::ArrayRef (1)); - llvm::Value *gep = builder.CreateInBoundsGEP (data, int_idx); - llvm::Value *ret = builder.CreateLoad (gep); - builder.CreateBr (done); - - builder.SetInsertPoint (done); - - llvm::PHINode *merge = llvm::PHINode::Create (scalar_t, 3); - builder.Insert (merge); - merge->addIncoming (undef, conv_error); - merge->addIncoming (undef, bounds_error); - merge->addIncoming (ret, success); - fn.do_return (builder, merge); - } - paren_subsref_fn.add_overload (fn); - - // paren subsasgn - paren_subsasgn_fn.stash_name ("()subsasgn"); - - jit_function resize_paren_subsasgn - = create_external (JIT_FN (octave_jit_paren_subsasgn_impl), matrix, matrix, - index, scalar); - - fn = create_internal ("octave_jit_paren_subsasgn", matrix, matrix, scalar, - scalar); - fn.mark_can_error (); - body = fn.new_block (); - builder.SetInsertPoint (body); - { - llvm::Value *one = llvm::ConstantInt::get (index_t, 1); - - llvm::Value *mat = fn.argument (builder, 0); - llvm::Value *idx = fn.argument (builder, 1); - llvm::Value *value = fn.argument (builder, 2); - - llvm::Value *int_idx = builder.CreateFPToSI (idx, index_t); - llvm::Value *check_idx = builder.CreateSIToFP (int_idx, scalar_t); - llvm::Value *cond0 = builder.CreateFCmpUNE (idx, check_idx); - llvm::Value *cond1 = builder.CreateICmpSLT (int_idx, one); - llvm::Value *cond = builder.CreateOr (cond0, cond1); - - llvm::BasicBlock *done = fn.new_block ("done"); - - llvm::BasicBlock *conv_error = fn.new_block ("conv_error", done); - llvm::BasicBlock *normal = fn.new_block ("normal", done); - builder.CreateCondBr (cond, conv_error, normal); - builder.SetInsertPoint (conv_error); - ginvalid_index.call (builder); - builder.CreateBr (done); - - builder.SetInsertPoint (normal); - llvm::Value *len = builder.CreateExtractValue (mat, 2); - cond0 = builder.CreateICmpSGT (int_idx, len); - - llvm::Value *rcount = builder.CreateExtractValue (mat, 0); - rcount = builder.CreateLoad (rcount); - cond1 = builder.CreateICmpSGT (rcount, one); - cond = builder.CreateOr (cond0, cond1); - - llvm::BasicBlock *bounds_error = fn.new_block ("bounds_error", done); - llvm::BasicBlock *success = fn.new_block ("success", done); - builder.CreateCondBr (cond, bounds_error, success); - - // resize on out of bounds access - builder.SetInsertPoint (bounds_error); - llvm::Value *resize_result = resize_paren_subsasgn.call (builder, mat, - int_idx, value); - builder.CreateBr (done); - - builder.SetInsertPoint (success); - llvm::Value *data = builder.CreateExtractValue (mat, - llvm::ArrayRef (1)); - llvm::Value *gep = builder.CreateInBoundsGEP (data, int_idx); - builder.CreateStore (value, gep); - builder.CreateBr (done); - - builder.SetInsertPoint (done); - - llvm::PHINode *merge = llvm::PHINode::Create (matrix_t, 3); - builder.Insert (merge); - merge->addIncoming (mat, conv_error); - merge->addIncoming (resize_result, bounds_error); - merge->addIncoming (mat, success); - fn.do_return (builder, merge); - } - paren_subsasgn_fn.add_overload (fn); - - fn = create_external (JIT_FN (octave_jit_paren_subsasgn_matrix_range), matrix, - matrix, range, scalar); - fn.mark_can_error (); - paren_subsasgn_fn.add_overload (fn); - - end1_fn.stash_name ("end1"); - fn = create_internal ("octave_jit_end1_matrix", scalar, matrix, index, index); - body = fn.new_block (); - builder.SetInsertPoint (body); - { - llvm::Value *mat = fn.argument (builder, 0); - llvm::Value *ret = builder.CreateExtractValue (mat, 2); - fn.do_return (builder, builder.CreateSIToFP (ret, scalar_t)); - } - end1_fn.add_overload (fn); - - end_fn.stash_name ("end"); - fn = create_external (JIT_FN (octave_jit_end_matrix),scalar, matrix, index, - index); - end_fn.add_overload (fn); - - // -------------------- create_undef -------------------- - create_undef_fn.stash_name ("create_undef"); - fn = create_external (JIT_FN (octave_jit_create_undef), any); - create_undef_fn.add_overload (fn); - - casts[any->type_id ()].stash_name ("(any)"); - casts[scalar->type_id ()].stash_name ("(scalar)"); - casts[complex->type_id ()].stash_name ("(complex)"); - casts[matrix->type_id ()].stash_name ("(matrix)"); - casts[range->type_id ()].stash_name ("(range)"); - - // cast any <- matrix - fn = create_external (JIT_FN (octave_jit_cast_any_matrix), any, matrix); - casts[any->type_id ()].add_overload (fn); - - // cast matrix <- any - fn = create_external (JIT_FN (octave_jit_cast_matrix_any), matrix, any); - casts[matrix->type_id ()].add_overload (fn); - - // cast any <- range - fn = create_external (JIT_FN (octave_jit_cast_any_range), any, range); - casts[any->type_id ()].add_overload (fn); - - // cast range <- any - fn = create_external (JIT_FN (octave_jit_cast_range_any), range, any); - casts[range->type_id ()].add_overload (fn); - - // cast any <- scalar - fn = create_external (JIT_FN (octave_jit_cast_any_scalar), any, scalar); - casts[any->type_id ()].add_overload (fn); - - // cast scalar <- any - fn = create_external (JIT_FN (octave_jit_cast_scalar_any), scalar, any); - casts[scalar->type_id ()].add_overload (fn); - - // cast any <- complex - fn = create_external (JIT_FN (octave_jit_cast_any_complex), any, complex); - casts[any->type_id ()].add_overload (fn); - - // cast complex <- any - fn = create_external (JIT_FN (octave_jit_cast_complex_any), complex, any); - casts[complex->type_id ()].add_overload (fn); - - // cast complex <- scalar - fn = create_internal ("octave_jit_cast_complex_scalar", complex, scalar); - body = fn.new_block (); - builder.SetInsertPoint (body); - { - llvm::Value *zero = llvm::ConstantFP::get (scalar_t, 0); - fn.do_return (builder, complex_new (fn.argument (builder, 0), zero)); - } - casts[complex->type_id ()].add_overload (fn); - - // cast scalar <- complex - fn = create_internal ("octave_jit_cast_scalar_complex", scalar, complex); - body = fn.new_block (); - builder.SetInsertPoint (body); - fn.do_return (builder, complex_real (fn.argument (builder, 0))); - casts[scalar->type_id ()].add_overload (fn); - - // cast any <- any - fn = create_identity (any); - casts[any->type_id ()].add_overload (fn); - - // cast scalar <- scalar - fn = create_identity (scalar); - casts[scalar->type_id ()].add_overload (fn); - - // cast complex <- complex - fn = create_identity (complex); - casts[complex->type_id ()].add_overload (fn); - - // -------------------- builtin functions -------------------- - add_builtin ("#unknown_function"); - unknown_function = builtins["#unknown_function"]; - - add_builtin ("sin"); - register_intrinsic ("sin", llvm::Intrinsic::sin, scalar, scalar); - register_generic ("sin", matrix, matrix); - - add_builtin ("cos"); - register_intrinsic ("cos", llvm::Intrinsic::cos, scalar, scalar); - register_generic ("cos", matrix, matrix); - - add_builtin ("exp"); - register_intrinsic ("exp", llvm::Intrinsic::cos, scalar, scalar); - register_generic ("exp", matrix, matrix); - - add_builtin ("balance"); - register_generic ("balance", matrix, matrix); - - add_builtin ("cond"); - register_generic ("cond", scalar, matrix); - - add_builtin ("det"); - register_generic ("det", scalar, matrix); - - add_builtin ("norm"); - register_generic ("norm", scalar, matrix); - - add_builtin ("rand"); - register_generic ("rand", matrix, scalar); - register_generic ("rand", matrix, std::vector (2, scalar)); - - add_builtin ("magic"); - register_generic ("magic", matrix, scalar); - register_generic ("magic", matrix, std::vector (2, scalar)); - - add_builtin ("eye"); - register_generic ("eye", matrix, scalar); - register_generic ("eye", matrix, std::vector (2, scalar)); - - add_builtin ("mod"); - register_generic ("mod", scalar, std::vector (2, scalar)); - - casts.resize (next_id + 1); - jit_function any_id = create_identity (any); - jit_function grab_any = create_external (JIT_FN (octave_jit_grab_any), - any, any); - jit_function release_any = get_release (any); - std::vector args; - args.resize (1); - - for (std::map::iterator iter = builtins.begin (); - iter != builtins.end (); ++iter) - { - jit_type *btype = iter->second; - args[0] = btype; - - grab_fn.add_overload (jit_function (grab_any, btype, args)); - release_fn.add_overload (jit_function (release_any, 0, args)); - casts[any->type_id ()].add_overload (jit_function (any_id, any, args)); - - args[0] = any; - casts[btype->type_id ()].add_overload (jit_function (any_id, btype, - args)); - } -} - -const jit_function& -jit_typeinfo::do_end (jit_value *value, jit_value *idx, jit_value *count) -{ - jit_const_index *ccount = dynamic_cast (count); - if (ccount && ccount->value () == 1) - return end1_fn.overload (value->type (), idx->type (), count->type ()); - - return end_fn.overload (value->type (), idx->type (), count->type ()); -} - -jit_type* -jit_typeinfo::new_type (const std::string& name, jit_type *parent, - llvm::Type *llvm_type, bool skip_paren) -{ - jit_type *ret = new jit_type (name, parent, llvm_type, skip_paren, next_id++); - id_to_type.push_back (ret); - return ret; -} - -void -jit_typeinfo::add_print (jit_type *ty, void *fptr) -{ - std::stringstream name; - name << "octave_jit_print_" << ty->name (); - jit_function fn = create_external (engine, fptr, name.str (), 0, intN (8), ty); - print_fn.add_overload (fn); -} - -// FIXME: cp between add_binary_op, add_binary_icmp, and add_binary_fcmp -void -jit_typeinfo::add_binary_op (jit_type *ty, int op, int llvm_op) -{ - std::stringstream fname; - octave_value::binary_op ov_op = static_cast(op); - fname << "octave_jit_" << octave_value::binary_op_as_string (ov_op) - << "_" << ty->name (); - - jit_function fn = create_internal (fname.str (), ty, ty, ty); - llvm::BasicBlock *block = fn.new_block (); - builder.SetInsertPoint (block); - llvm::Instruction::BinaryOps temp - = static_cast(llvm_op); - - llvm::Value *ret = builder.CreateBinOp (temp, fn.argument (builder, 0), - fn.argument (builder, 1)); - fn.do_return (builder, ret); - binary_ops[op].add_overload (fn); -} - -void -jit_typeinfo::add_binary_icmp (jit_type *ty, int op, int llvm_op) -{ - std::stringstream fname; - octave_value::binary_op ov_op = static_cast(op); - fname << "octave_jit" << octave_value::binary_op_as_string (ov_op) - << "_" << ty->name (); - - jit_function fn = create_internal (fname.str (), boolean, ty, ty); - llvm::BasicBlock *block = fn.new_block (); - builder.SetInsertPoint (block); - llvm::CmpInst::Predicate temp - = static_cast(llvm_op); - llvm::Value *ret = builder.CreateICmp (temp, fn.argument (builder, 0), - fn.argument (builder, 1)); - fn.do_return (builder, ret); - binary_ops[op].add_overload (fn); -} - -void -jit_typeinfo::add_binary_fcmp (jit_type *ty, int op, int llvm_op) -{ - std::stringstream fname; - octave_value::binary_op ov_op = static_cast(op); - fname << "octave_jit" << octave_value::binary_op_as_string (ov_op) - << "_" << ty->name (); - - jit_function fn = create_internal (fname.str (), boolean, ty, ty); - llvm::BasicBlock *block = fn.new_block (); - builder.SetInsertPoint (block); - llvm::CmpInst::Predicate temp - = static_cast(llvm_op); - llvm::Value *ret = builder.CreateFCmp (temp, fn.argument (builder, 0), - fn.argument (builder, 1)); - fn.do_return (builder, ret); - binary_ops[op].add_overload (fn); -} - -jit_function -jit_typeinfo::create_function (jit_convention::type cc, const llvm::Twine& name, - jit_type *ret, - const std::vector& args) -{ - jit_function result (module, cc, name, ret, args); - return result; -} - -jit_function -jit_typeinfo::create_identity (jit_type *type) -{ - size_t id = type->type_id (); - if (id >= identities.size ()) - identities.resize (id + 1); - - if (! identities[id].valid ()) - { - std::stringstream name; - name << "id_" << type->name (); - - jit_function fn = create_internal (name.str (), type, type); - llvm::BasicBlock *body = fn.new_block (); - builder.SetInsertPoint (body); - fn.do_return (builder, fn.argument (builder, 0)); - return identities[id] = fn; - } - - return identities[id]; -} - -llvm::Value * -jit_typeinfo::do_insert_error_check (llvm::IRBuilderD& abuilder) -{ - return abuilder.CreateLoad (lerror_state); -} - -llvm::Value * -jit_typeinfo::do_insert_interrupt_check (llvm::IRBuilderD& abuilder) -{ - llvm::LoadInst *val = abuilder.CreateLoad (loctave_interrupt_state); - val->setVolatile (true); - return abuilder.CreateICmpSGT (val, abuilder.getInt32 (0)); -} - -void -jit_typeinfo::add_builtin (const std::string& name) -{ - jit_type *btype = new_type (name, any, any->to_llvm (), true); - builtins[name] = btype; - - octave_builtin *ov_builtin = find_builtin (name); - if (ov_builtin) - ov_builtin->stash_jit (*btype); -} - -void -jit_typeinfo::register_intrinsic (const std::string& name, size_t iid, - jit_type *result, - const std::vector& args) -{ - jit_type *builtin_type = builtins[name]; - size_t nargs = args.size (); - llvm::SmallVector llvm_args (nargs); - for (size_t i = 0; i < nargs; ++i) - llvm_args[i] = args[i]->to_llvm (); - - llvm::Intrinsic::ID id = static_cast (iid); - llvm::Function *ifun = llvm::Intrinsic::getDeclaration (module, id, - llvm_args); - std::stringstream fn_name; - fn_name << "octave_jit_" << name; - - std::vector args1 (nargs + 1); - args1[0] = builtin_type; - std::copy (args.begin (), args.end (), args1.begin () + 1); - - // The first argument will be the Octave function, but we already know that - // the function call is the equivalent of the intrinsic, so we ignore it and - // call the intrinsic with the remaining arguments. - jit_function fn = create_internal (fn_name.str (), result, args1); - llvm::BasicBlock *body = fn.new_block (); - builder.SetInsertPoint (body); - - llvm::SmallVector fargs (nargs); - for (size_t i = 0; i < nargs; ++i) - fargs[i] = fn.argument (builder, i + 1); - - llvm::Value *ret = builder.CreateCall (ifun, fargs); - fn.do_return (builder, ret); - paren_subsref_fn.add_overload (fn); -} - -octave_builtin * -jit_typeinfo::find_builtin (const std::string& name) -{ - // FIXME: Finalize what we want to store in octave_builtin, then add functions - // to access these values in octave_value - octave_value ov_builtin = symbol_table::find (name); - return dynamic_cast (ov_builtin.internal_rep ()); -} - -void -jit_typeinfo::register_generic (const std::string& name, jit_type *result, - const std::vector& args) -{ - octave_builtin *builtin = find_builtin (name); - if (! builtin) - return; - - std::vector fn_args (args.size () + 1); - fn_args[0] = builtins[name]; - std::copy (args.begin (), args.end (), fn_args.begin () + 1); - jit_function fn = create_internal (name, result, fn_args); - fn.mark_can_error (); - llvm::BasicBlock *block = fn.new_block (); - builder.SetInsertPoint (block); - llvm::Type *any_t = any->to_llvm (); - llvm::ArrayType *array_t = llvm::ArrayType::get (any_t, args.size ()); - llvm::Value *array = llvm::UndefValue::get (array_t); - for (size_t i = 0; i < args.size (); ++i) - { - llvm::Value *arg = fn.argument (builder, i + 1); - jit_function agrab = get_grab (args[i]); - if (agrab.valid ()) - arg = agrab.call (builder, arg); - jit_function acast = cast (any, args[i]); - array = builder.CreateInsertValue (array, acast.call (builder, arg), i); - } - - llvm::Value *array_mem = builder.CreateAlloca (array_t); - builder.CreateStore (array, array_mem); - array = builder.CreateBitCast (array_mem, any_t->getPointerTo ()); - - jit_type *jintTy = intN (sizeof (octave_builtin::fcn) * 8); - llvm::Type *intTy = jintTy->to_llvm (); - size_t fcn_int = reinterpret_cast (builtin->function ()); - llvm::Value *fcn = llvm::ConstantInt::get (intTy, fcn_int); - llvm::Value *nargin = llvm::ConstantInt::get (intTy, args.size ()); - size_t result_int = reinterpret_cast (result); - llvm::Value *res_llvm = llvm::ConstantInt::get (intTy, result_int); - llvm::Value *ret = any_call.call (builder, fcn, nargin, array, res_llvm); - - jit_function cast_result = cast (result, any); - fn.do_return (builder, cast_result.call (builder, ret)); - paren_subsref_fn.add_overload (fn); -} - -jit_function -jit_typeinfo::mirror_binary (const jit_function& fn) -{ - jit_function ret = create_internal (fn.name () + "_reverse", - fn.result (), fn.argument_type (1), - fn.argument_type (0)); - if (fn.can_error ()) - ret.mark_can_error (); - - llvm::BasicBlock *body = ret.new_block (); - builder.SetInsertPoint (body); - llvm::Value *result = fn.call (builder, ret.argument (builder, 1), - ret.argument (builder, 0)); - if (ret.result ()) - ret.do_return (builder, result); - else - ret.do_return (builder); - - return ret; -} - -llvm::Value * -jit_typeinfo::pack_complex (llvm::IRBuilderD& bld, llvm::Value *cplx) -{ - llvm::Type *complex_ret = instance->complex_ret; - llvm::Value *real = bld.CreateExtractValue (cplx, 0); - llvm::Value *imag = bld.CreateExtractValue (cplx, 1); - llvm::Value *ret = llvm::UndefValue::get (complex_ret); - - unsigned int re_idx[] = {0, 0}; - unsigned int im_idx[] = {0, 1}; - ret = bld.CreateInsertValue (ret, real, re_idx); - return bld.CreateInsertValue (ret, imag, im_idx); -} - -llvm::Value * -jit_typeinfo::unpack_complex (llvm::IRBuilderD& bld, llvm::Value *result) -{ - unsigned int re_idx[] = {0, 0}; - unsigned int im_idx[] = {0, 1}; - - llvm::Type *complex_t = get_complex ()->to_llvm (); - llvm::Value *real = bld.CreateExtractValue (result, re_idx); - llvm::Value *imag = bld.CreateExtractValue (result, im_idx); - llvm::Value *ret = llvm::UndefValue::get (complex_t); - - ret = bld.CreateInsertValue (ret, real, 0); - return bld.CreateInsertValue (ret, imag, 1); -} - -llvm::Value * -jit_typeinfo::complex_real (llvm::Value *cx) -{ - return builder.CreateExtractValue (cx, 0); -} - -llvm::Value * -jit_typeinfo::complex_real (llvm::Value *cx, llvm::Value *real) -{ - return builder.CreateInsertValue (cx, real, 0); -} - -llvm::Value * -jit_typeinfo::complex_imag (llvm::Value *cx) -{ - return builder.CreateExtractValue (cx, 1); -} - -llvm::Value * -jit_typeinfo::complex_imag (llvm::Value *cx, llvm::Value *imag) -{ - return builder.CreateInsertValue (cx, imag, 1); -} - -llvm::Value * -jit_typeinfo::complex_new (llvm::Value *real, llvm::Value *imag) -{ - llvm::Value *ret = llvm::UndefValue::get (complex->to_llvm ()); - ret = complex_real (ret, real); - return complex_imag (ret, imag); -} - -void -jit_typeinfo::create_int (size_t nbits) -{ - std::stringstream tname; - tname << "int" << nbits; - ints[nbits] = new_type (tname.str (), any, llvm::Type::getIntNTy (context, - nbits)); -} - -jit_type * -jit_typeinfo::intN (size_t nbits) const -{ - std::map::const_iterator iter = ints.find (nbits); - if (iter != ints.end ()) - return iter->second; - - throw jit_fail_exception ("No such integer type"); -} - -jit_type * -jit_typeinfo::do_type_of (const octave_value &ov) const -{ - if (ov.is_function ()) - { - // FIXME: This is ugly, we need to finalize how we want to to this, then - // have octave_value fully support the needed functionality - octave_builtin *builtin - = dynamic_cast (ov.internal_rep ()); - return builtin && builtin->to_jit () ? builtin->to_jit () - : unknown_function; - } - - if (ov.is_range ()) - return get_range (); - - if (ov.is_double_type () && ! ov.is_complex_type ()) - { - if (ov.is_real_scalar ()) - return get_scalar (); - - if (ov.is_matrix_type ()) - return get_matrix (); - } - - if (ov.is_complex_scalar ()) - { - Complex cv = ov.complex_value (); - - // We don't really represent complex values, instead we represent - // complex_or_scalar. If the imag value is zero, we assume a scalar. - if (cv.imag () != 0) - return get_complex (); - } - - return get_any (); -} - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/jit-typeinfo.h --- a/libinterp/interp-core/jit-typeinfo.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,852 +0,0 @@ -/* - -Copyright (C) 2012 Max Brister - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Author: Max Brister - -#if !defined (octave_jit_typeinfo_h) -#define octave_jit_typeinfo_h 1 - -#ifdef HAVE_LLVM - -#include -#include - -#include "Range.h" -#include "jit-util.h" - -// Defines the type system used by jit and a singleton class, jit_typeinfo, to -// manage the types. -// -// FIXME: -// Operations are defined and implemented in jit_typeinfo. Eventually they -// should be moved elsewhere. (just like with octave_typeinfo) - -// jit_range is compatable with the llvm range structure -struct -jit_range -{ - jit_range (const Range& from) : base (from.base ()), limit (from.limit ()), - inc (from.inc ()), nelem (from.nelem ()) - {} - - operator Range () const - { - return Range (base, limit, inc); - } - - bool all_elements_are_ints () const; - - double base; - double limit; - double inc; - octave_idx_type nelem; -}; - -std::ostream& operator<< (std::ostream& os, const jit_range& rng); - -// jit_array is compatable with the llvm array/matrix structures -template -struct -jit_array -{ - jit_array () : array (0) {} - - jit_array (T& from) : array (new T (from)) - { - update (); - } - - void update (void) - { - ref_count = array->jit_ref_count (); - slice_data = array->jit_slice_data () - 1; - slice_len = array->capacity (); - dimensions = array->jit_dimensions (); - } - - void update (T *aarray) - { - array = aarray; - update (); - } - - operator T () const - { - return *array; - } - - int *ref_count; - - U *slice_data; - octave_idx_type slice_len; - octave_idx_type *dimensions; - - T *array; -}; - -typedef jit_array jit_matrix; - -std::ostream& operator<< (std::ostream& os, const jit_matrix& mat); - -// calling convention -namespace -jit_convention -{ - enum - type - { - // internal to jit - internal, - - // an external C call - external, - - length - }; -} - -// Used to keep track of estimated (infered) types during JIT. This is a -// hierarchical type system which includes both concrete and abstract types. -// -// The types form a lattice. Currently we only allow for one parent type, but -// eventually we may allow for multiple predecessors. -class -jit_type -{ -public: - typedef llvm::Value *(*convert_fn) (llvm::IRBuilderD&, llvm::Value *); - - jit_type (const std::string& aname, jit_type *aparent, llvm::Type *allvm_type, - bool askip_paren, int aid); - - // a user readable type name - const std::string& name (void) const { return mname; } - - // a unique id for the type - int type_id (void) const { return mid; } - - // An abstract base type, may be null - jit_type *parent (void) const { return mparent; } - - // convert to an llvm type - llvm::Type *to_llvm (void) const { return llvm_type; } - - // how this type gets passed as a function argument - llvm::Type *to_llvm_arg (void) const; - - size_t depth (void) const { return mdepth; } - - bool skip_paren (void) const { return mskip_paren; } - - // -------------------- Calling Convention information -------------------- - - // A function declared like: mytype foo (int arg0, int arg1); - // Will be converted to: void foo (mytype *retval, int arg0, int arg1) - // if mytype is sret. The caller is responsible for allocating space for - // retval. (on the stack) - bool sret (jit_convention::type cc) const { return msret[cc]; } - - void mark_sret (jit_convention::type cc) - { msret[cc] = true; } - - // A function like: void foo (mytype arg0) - // Will be converted to: void foo (mytype *arg0) - // Basically just pass by reference. - bool pointer_arg (jit_convention::type cc) const { return mpointer_arg[cc]; } - - void mark_pointer_arg (jit_convention::type cc) - { mpointer_arg[cc] = true; } - - // Convert into an equivalent form before calling. For example, complex is - // represented as two values llvm vector, but we need to pass it as a two - // valued llvm structure to C functions. - convert_fn pack (jit_convention::type cc) { return mpack[cc]; } - - void set_pack (jit_convention::type cc, convert_fn fn) { mpack[cc] = fn; } - - // The inverse operation of pack. - convert_fn unpack (jit_convention::type cc) { return munpack[cc]; } - - void set_unpack (jit_convention::type cc, convert_fn fn) - { munpack[cc] = fn; } - - // The resulting type after pack is called. - llvm::Type *packed_type (jit_convention::type cc) - { return mpacked_type[cc]; } - - void set_packed_type (jit_convention::type cc, llvm::Type *ty) - { mpacked_type[cc] = ty; } -private: - std::string mname; - jit_type *mparent; - llvm::Type *llvm_type; - int mid; - size_t mdepth; - bool mskip_paren; - - bool msret[jit_convention::length]; - bool mpointer_arg[jit_convention::length]; - - convert_fn mpack[jit_convention::length]; - convert_fn munpack[jit_convention::length]; - - llvm::Type *mpacked_type[jit_convention::length]; -}; - -// seperate print function to allow easy printing if type is null -std::ostream& jit_print (std::ostream& os, jit_type *atype); - -class jit_value; - -// An abstraction for calling llvm functions with jit_values. Deals with calling -// convention details. -class -jit_function -{ - friend std::ostream& operator<< (std::ostream& os, const jit_function& fn); -public: - // create a function in an invalid state - jit_function (); - - jit_function (llvm::Module *amodule, jit_convention::type acall_conv, - const llvm::Twine& aname, jit_type *aresult, - const std::vector& aargs); - - // Use an existing function, but change the argument types. The new argument - // types must behave the same for the current calling convention. - jit_function (const jit_function& fn, jit_type *aresult, - const std::vector& aargs); - - jit_function (const jit_function& fn); - - // erase the interal LLVM function (if it exists). Will become invalid. - void erase (void); - - template - void add_mapping (llvm::ExecutionEngine *engine, T fn) - { - do_add_mapping (engine, reinterpret_cast (fn)); - } - - bool valid (void) const { return llvm_function; } - - std::string name (void) const; - - llvm::BasicBlock *new_block (const std::string& aname = "body", - llvm::BasicBlock *insert_before = 0); - - llvm::Value *call (llvm::IRBuilderD& builder, - const std::vector& in_args) const; - - llvm::Value *call (llvm::IRBuilderD& builder, - const std::vector& in_args - = std::vector ()) const; - -#define JIT_PARAM_ARGS llvm::IRBuilderD& builder, -#define JIT_PARAMS builder, -#define JIT_CALL(N) JIT_EXPAND (llvm::Value *, call, llvm::Value *, const, N) - - JIT_CALL (1) - JIT_CALL (2) - JIT_CALL (3) - JIT_CALL (4) - JIT_CALL (5) - -#undef JIT_CALL - -#define JIT_CALL(N) JIT_EXPAND (llvm::Value *, call, jit_value *, const, N) - - JIT_CALL (1); - JIT_CALL (2); - JIT_CALL (3); - -#undef JIT_CALL -#undef JIT_PARAMS -#undef JIT_PARAM_ARGS - - llvm::Value *argument (llvm::IRBuilderD& builder, size_t idx) const; - - void do_return (llvm::IRBuilderD& builder, llvm::Value *rval = 0, - bool verify = true); - - llvm::Function *to_llvm (void) const { return llvm_function; } - - // If true, then the return value is passed as a pointer in the first argument - bool sret (void) const { return mresult && mresult->sret (call_conv); } - - bool can_error (void) const { return mcan_error; } - - void mark_can_error (void) { mcan_error = true; } - - jit_type *result (void) const { return mresult; } - - jit_type *argument_type (size_t idx) const - { - assert (idx < args.size ()); - return args[idx]; - } - - const std::vector& arguments (void) const { return args; } -private: - void do_add_mapping (llvm::ExecutionEngine *engine, void *fn); - - llvm::Module *module; - llvm::Function *llvm_function; - jit_type *mresult; - std::vector args; - jit_convention::type call_conv; - bool mcan_error; -}; - -std::ostream& operator<< (std::ostream& os, const jit_function& fn); - - -// Keeps track of information about how to implement operations (+, -, *, ect) -// and their resulting types. -class -jit_operation -{ -public: - // type signature vector - typedef std::vector signature_vec; - - virtual ~jit_operation (void); - - void add_overload (const jit_function& func) - { - add_overload (func, func.arguments ()); - } - - void add_overload (const jit_function& func, - const signature_vec& args); - - const jit_function& overload (const signature_vec& types) const; - - jit_type *result (const signature_vec& types) const - { - const jit_function& temp = overload (types); - return temp.result (); - } - -#define JIT_PARAMS -#define JIT_PARAM_ARGS -#define JIT_OVERLOAD(N) \ - JIT_EXPAND (const jit_function&, overload, jit_type *, const, N) \ - JIT_EXPAND (jit_type *, result, jit_type *, const, N) - - JIT_OVERLOAD (1); - JIT_OVERLOAD (2); - JIT_OVERLOAD (3); - -#undef JIT_PARAMS -#undef JIT_PARAM_ARGS - - const std::string& name (void) const { return mname; } - - void stash_name (const std::string& aname) { mname = aname; } -protected: - virtual jit_function *generate (const signature_vec& types) const; -private: - Array to_idx (const signature_vec& types) const; - - const jit_function& do_generate (const signature_vec& types) const; - - struct signature_cmp - { - bool operator() (const signature_vec *lhs, const signature_vec *rhs); - }; - - typedef std::map - generated_map; - - mutable generated_map generated; - - std::vector > overloads; - - std::string mname; -}; - -class -jit_index_operation : public jit_operation -{ -public: - jit_index_operation (void) : module (0), engine (0) {} - - void initialize (llvm::Module *amodule, llvm::ExecutionEngine *aengine) - { - module = amodule; - engine = aengine; - do_initialize (); - } -protected: - virtual jit_function *generate (const signature_vec& types) const; - - virtual jit_function *generate_matrix (const signature_vec& types) const = 0; - - virtual void do_initialize (void) = 0; - - // helper functions - // [start_idx, end_idx). - llvm::Value *create_arg_array (llvm::IRBuilderD& builder, - const jit_function &fn, size_t start_idx, - size_t end_idx) const; - - llvm::Module *module; - llvm::ExecutionEngine *engine; -}; - -class -jit_paren_subsref : public jit_index_operation -{ -protected: - virtual jit_function *generate_matrix (const signature_vec& types) const; - - virtual void do_initialize (void); -private: - jit_function paren_scalar; -}; - -class -jit_paren_subsasgn : public jit_index_operation -{ -protected: - jit_function *generate_matrix (const signature_vec& types) const; - - virtual void do_initialize (void); -private: - jit_function paren_scalar; -}; - -// A singleton class which handles the construction of jit_types and -// jit_operations. -class -jit_typeinfo -{ -public: - static void initialize (llvm::Module *m, llvm::ExecutionEngine *e); - - static jit_type *join (jit_type *lhs, jit_type *rhs) - { - return instance->do_join (lhs, rhs); - } - - static jit_type *get_any (void) { return instance->any; } - - static jit_type *get_matrix (void) { return instance->matrix; } - - static jit_type *get_scalar (void) { return instance->scalar; } - - static llvm::Type *get_scalar_llvm (void) - { return instance->scalar->to_llvm (); } - - static jit_type *get_scalar_ptr (void) { return instance->scalar_ptr; } - - static jit_type *get_any_ptr (void) { return instance->any_ptr; } - - static jit_type *get_range (void) { return instance->range; } - - static jit_type *get_string (void) { return instance->string; } - - static jit_type *get_bool (void) { return instance->boolean; } - - static jit_type *get_index (void) { return instance->index; } - - static llvm::Type *get_index_llvm (void) - { return instance->index->to_llvm (); } - - static jit_type *get_complex (void) { return instance->complex; } - - // Get the jit_type of an octave_value - static jit_type *type_of (const octave_value& ov) - { - return instance->do_type_of (ov); - } - - static const jit_operation& binary_op (int op) - { - return instance->do_binary_op (op); - } - - static const jit_operation& unary_op (int op) - { - return instance->do_unary_op (op); - } - - static const jit_operation& grab (void) { return instance->grab_fn; } - - static const jit_function& get_grab (jit_type *type) - { - return instance->grab_fn.overload (type); - } - - static const jit_operation& release (void) - { - return instance->release_fn; - } - - static const jit_function& get_release (jit_type *type) - { - return instance->release_fn.overload (type); - } - - static const jit_operation& destroy (void) - { - return instance->destroy_fn; - } - - static const jit_operation& print_value (void) - { - return instance->print_fn; - } - - static const jit_operation& for_init (void) - { - return instance->for_init_fn; - } - - static const jit_operation& for_check (void) - { - return instance->for_check_fn; - } - - static const jit_operation& for_index (void) - { - return instance->for_index_fn; - } - - static const jit_operation& make_range (void) - { - return instance->make_range_fn; - } - - static const jit_operation& paren_subsref (void) - { - return instance->paren_subsref_fn; - } - - static const jit_operation& paren_subsasgn (void) - { - return instance->paren_subsasgn_fn; - } - - static const jit_operation& logically_true (void) - { - return instance->logically_true_fn; - } - - static const jit_operation& cast (jit_type *result) - { - return instance->do_cast (result); - } - - static const jit_function& cast (jit_type *to, jit_type *from) - { - return instance->do_cast (to, from); - } - - static llvm::Value *insert_error_check (llvm::IRBuilderD& bld) - { - return instance->do_insert_error_check (bld); - } - - static llvm::Value *insert_interrupt_check (llvm::IRBuilderD& bld) - { - return instance->do_insert_interrupt_check (bld); - } - - static const jit_operation& end (void) - { - return instance->end_fn; - } - - static const jit_function& end (jit_value *value, jit_value *index, - jit_value *count) - { - return instance->do_end (value, index, count); - } - - static const jit_operation& create_undef (void) - { - return instance->create_undef_fn; - } - - static llvm::Value *create_complex (llvm::Value *real, llvm::Value *imag) - { - return instance->complex_new (real, imag); - } -private: - jit_typeinfo (llvm::Module *m, llvm::ExecutionEngine *e); - - // FIXME: Do these methods really need to be in jit_typeinfo? - jit_type *do_join (jit_type *lhs, jit_type *rhs) - { - // empty case - if (! lhs) - return rhs; - - if (! rhs) - return lhs; - - // check for a shared parent - while (lhs != rhs) - { - if (lhs->depth () > rhs->depth ()) - lhs = lhs->parent (); - else if (lhs->depth () < rhs->depth ()) - rhs = rhs->parent (); - else - { - // we MUST have depth > 0 as any is the base type of everything - do - { - lhs = lhs->parent (); - rhs = rhs->parent (); - } - while (lhs != rhs); - } - } - - return lhs; - } - - jit_type *do_difference (jit_type *lhs, jit_type *) - { - // FIXME: Maybe we can do something smarter? - return lhs; - } - - jit_type *do_type_of (const octave_value &ov) const; - - const jit_operation& do_binary_op (int op) const - { - assert (static_cast(op) < binary_ops.size ()); - return binary_ops[op]; - } - - const jit_operation& do_unary_op (int op) const - { - assert (static_cast (op) < unary_ops.size ()); - return unary_ops[op]; - } - - const jit_operation& do_cast (jit_type *to) - { - static jit_operation null_function; - if (! to) - return null_function; - - size_t id = to->type_id (); - if (id >= casts.size ()) - return null_function; - return casts[id]; - } - - const jit_function& do_cast (jit_type *to, jit_type *from) - { - return do_cast (to).overload (from); - } - - const jit_function& do_end (jit_value *value, jit_value *index, - jit_value *count); - - jit_type *new_type (const std::string& name, jit_type *parent, - llvm::Type *llvm_type, bool skip_paren = false); - - - void add_print (jit_type *ty, void *fptr); - - void add_binary_op (jit_type *ty, int op, int llvm_op); - - void add_binary_icmp (jit_type *ty, int op, int llvm_op); - - void add_binary_fcmp (jit_type *ty, int op, int llvm_op); - - // create a function with an external calling convention - // forces the function pointer to be specified - template - jit_function create_external (llvm::ExecutionEngine *ee, T fn, - const llvm::Twine& name, jit_type *ret, - const std::vector& args - = std::vector ()) - { - jit_function retval = create_function (jit_convention::external, name, ret, - args); - retval.add_mapping (ee, fn); - return retval; - } - -#define JIT_PARAM_ARGS llvm::ExecutionEngine *ee, T fn, \ - const llvm::Twine& name, jit_type *ret, -#define JIT_PARAMS ee, fn, name, ret, -#define CREATE_FUNCTION(N) JIT_EXPAND(template jit_function, \ - create_external, \ - jit_type *, /* empty */, N) - - CREATE_FUNCTION(1); - CREATE_FUNCTION(2); - CREATE_FUNCTION(3); - CREATE_FUNCTION(4); - -#undef JIT_PARAM_ARGS -#undef JIT_PARAMS -#undef CREATE_FUNCTION - - // use create_external or create_internal directly - jit_function create_function (jit_convention::type cc, - const llvm::Twine& name, jit_type *ret, - const std::vector& args - = std::vector ()); - - // create an internal calling convention (a function defined in llvm) - jit_function create_internal (const llvm::Twine& name, jit_type *ret, - const std::vector& args - = std::vector ()) - { - return create_function (jit_convention::internal, name, ret, args); - } - -#define JIT_PARAM_ARGS const llvm::Twine& name, jit_type *ret, -#define JIT_PARAMS name, ret, -#define CREATE_FUNCTION(N) JIT_EXPAND(jit_function, create_internal, \ - jit_type *, /* empty */, N) - - CREATE_FUNCTION(1); - CREATE_FUNCTION(2); - CREATE_FUNCTION(3); - CREATE_FUNCTION(4); - -#undef JIT_PARAM_ARGS -#undef JIT_PARAMS -#undef CREATE_FUNCTION - - jit_function create_identity (jit_type *type); - - llvm::Value *do_insert_error_check (llvm::IRBuilderD& bld); - - llvm::Value *do_insert_interrupt_check (llvm::IRBuilderD& bld); - - void add_builtin (const std::string& name); - - void register_intrinsic (const std::string& name, size_t id, - jit_type *result, jit_type *arg0) - { - std::vector args (1, arg0); - register_intrinsic (name, id, result, args); - } - - void register_intrinsic (const std::string& name, size_t id, jit_type *result, - const std::vector& args); - - void register_generic (const std::string& name, jit_type *result, - jit_type *arg0) - { - std::vector args (1, arg0); - register_generic (name, result, args); - } - - void register_generic (const std::string& name, jit_type *result, - const std::vector& args); - - octave_builtin *find_builtin (const std::string& name); - - jit_function mirror_binary (const jit_function& fn); - - llvm::Function *wrap_complex (llvm::Function *wrap); - - static llvm::Value *pack_complex (llvm::IRBuilderD& bld, - llvm::Value *cplx); - - static llvm::Value *unpack_complex (llvm::IRBuilderD& bld, - llvm::Value *result); - - llvm::Value *complex_real (llvm::Value *cx); - - llvm::Value *complex_real (llvm::Value *cx, llvm::Value *real); - - llvm::Value *complex_imag (llvm::Value *cx); - - llvm::Value *complex_imag (llvm::Value *cx, llvm::Value *imag); - - llvm::Value *complex_new (llvm::Value *real, llvm::Value *imag); - - void create_int (size_t nbits); - - jit_type *intN (size_t nbits) const; - - static jit_typeinfo *instance; - - llvm::Module *module; - llvm::ExecutionEngine *engine; - int next_id; - - llvm::GlobalVariable *lerror_state; - llvm::GlobalVariable *loctave_interrupt_state; - - llvm::Type *sig_atomic_type; - - std::vector id_to_type; - jit_type *any; - jit_type *matrix; - jit_type *scalar; - jit_type *scalar_ptr; // a fake type for interfacing with C++ - jit_type *any_ptr; // a fake type for interfacing with C++ - jit_type *range; - jit_type *string; - jit_type *boolean; - jit_type *index; - jit_type *complex; - jit_type *unknown_function; - std::map ints; - std::map builtins; - - llvm::StructType *complex_ret; - - std::vector binary_ops; - std::vector unary_ops; - jit_operation grab_fn; - jit_operation release_fn; - jit_operation destroy_fn; - jit_operation print_fn; - jit_operation for_init_fn; - jit_operation for_check_fn; - jit_operation for_index_fn; - jit_operation logically_true_fn; - jit_operation make_range_fn; - jit_paren_subsref paren_subsref_fn; - jit_paren_subsasgn paren_subsasgn_fn; - jit_operation end1_fn; - jit_operation end_fn; - jit_operation create_undef_fn; - - jit_function any_call; - - // type id -> cast function TO that type - std::vector casts; - - // type id -> identity function - std::vector identities; - - llvm::IRBuilderD& builder; -}; - -#endif -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/jit-util.cc --- a/libinterp/interp-core/jit-util.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,46 +0,0 @@ -/* - -Copyright (C) 2012 Max Brister - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Author: Max Brister - -// defines required by llvm -#define __STDC_LIMIT_MACROS -#define __STDC_CONSTANT_MACROS - -#ifdef HAVE_CONFIG_H -#include -#endif - -#ifdef HAVE_LLVM - -#include -#include - -std::ostream& -operator<< (std::ostream& os, const llvm::Value& v) -{ - llvm::raw_os_ostream llvm_out (os); - v.print (llvm_out); - return os; -} - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/jit-util.h --- a/libinterp/interp-core/jit-util.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,205 +0,0 @@ -/* - -Copyright (C) 2012 Max Brister - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Author: Max Brister - -// Some utility classes and functions used throughout jit - -#if !defined (octave_jit_util_h) -#define octave_jit_util_h 1 - -#ifdef HAVE_LLVM - -#include - -// we don't want to include llvm headers here, as they require -// __STDC_LIMIT_MACROS and __STDC_CONSTANT_MACROS be defined in the entire -// compilation unit -namespace llvm -{ - class Value; - class Module; - class FunctionPassManager; - class PassManager; - class ExecutionEngine; - class Function; - class BasicBlock; - class LLVMContext; - class Type; - class StructType; - class Twine; - class GlobalVariable; - class TerminatorInst; - class PHINode; - - class ConstantFolder; - - template - class IRBuilderDefaultInserter; - - template - class IRBuilder; - -typedef IRBuilder > -IRBuilderD; -} - -class octave_base_value; -class octave_builtin; -class octave_value; -class tree; -class tree_expression; - -// thrown when we should give up on JIT and interpret -class jit_fail_exception : public std::runtime_error -{ -public: - jit_fail_exception (void) : std::runtime_error ("unknown"), mknown (false) {} - jit_fail_exception (const std::string& reason) : std::runtime_error (reason), - mknown (true) - {} - - bool known (void) const { return mknown; } -private: - bool mknown; -}; - -// llvm doesn't provide this, and it's really useful for debugging -std::ostream& operator<< (std::ostream& os, const llvm::Value& v); - -template -class jit_internal_node; - -// jit_internal_list and jit_internal_node implement generic embedded doubly -// linked lists. List items extend from jit_internal_list, and can be placed -// in nodes of type jit_internal_node. We use CRTP twice. -template -class -jit_internal_list -{ - friend class jit_internal_node; -public: - jit_internal_list (void) : use_head (0), use_tail (0), muse_count (0) {} - - virtual ~jit_internal_list (void) - { - while (use_head) - use_head->stash_value (0); - } - - NODE_T *first_use (void) const { return use_head; } - - size_t use_count (void) const { return muse_count; } -private: - NODE_T *use_head; - NODE_T *use_tail; - size_t muse_count; -}; - -// a node for internal linked lists -template -class -jit_internal_node -{ -public: - typedef jit_internal_list jit_ilist; - - jit_internal_node (void) : mvalue (0), mnext (0), mprev (0) {} - - ~jit_internal_node (void) { remove (); } - - LIST_T *value (void) const { return mvalue; } - - void stash_value (LIST_T *avalue) - { - remove (); - - mvalue = avalue; - - if (mvalue) - { - jit_ilist *ilist = mvalue; - NODE_T *sthis = static_cast (this); - if (ilist->use_head) - { - ilist->use_tail->mnext = sthis; - mprev = ilist->use_tail; - } - else - ilist->use_head = sthis; - - ilist->use_tail = sthis; - ++ilist->muse_count; - } - } - - NODE_T *next (void) const { return mnext; } - - NODE_T *prev (void) const { return mprev; } -private: - void remove () - { - if (mvalue) - { - jit_ilist *ilist = mvalue; - if (mprev) - mprev->mnext = mnext; - else - // we are the use_head - ilist->use_head = mnext; - - if (mnext) - mnext->mprev = mprev; - else - // we are the use tail - ilist->use_tail = mprev; - - mnext = mprev = 0; - --ilist->muse_count; - mvalue = 0; - } - } - - LIST_T *mvalue; - NODE_T *mnext; - NODE_T *mprev; -}; - -// Use like: isa (value) -// basically just a short cut type typing dyanmic_cast. -template -bool isa (U *value) -{ - return dynamic_cast (value); -} - -#define JIT_ASSIGN_ARG(i) the_args[i] = arg ## i; -#define JIT_EXPAND(ret, fname, type, isconst, N) \ - ret fname (JIT_PARAM_ARGS OCT_MAKE_DECL_LIST (type, arg, N)) isconst \ - { \ - std::vector the_args (N); \ - OCT_ITERATE_MACRO (JIT_ASSIGN_ARG, N); \ - return fname (JIT_PARAMS the_args); \ - } - -#endif -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/ls-ascii-helper.cc --- a/libinterp/interp-core/ls-ascii-helper.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,175 +0,0 @@ -/* - -Copyright (C) 2009-2012 Benjamin Lindner - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "ls-ascii-helper.h" - -#include -#include - -// Helper functions when reading from ascii files. - -// These function take care of CR/LF issues when files are opened in -// text-mode for reading. - -// Skip characters from stream IS until a newline is reached. -// Depending on KEEP_NEWLINE, either eat newline from stream or -// keep it unread. - -void -skip_until_newline (std::istream& is, bool keep_newline) -{ - if (! is) - return; - - while (is) - { - char c = is.peek (); - - if (c == '\n' || c == '\r') - { - // Reached newline. - if (! keep_newline) - { - // Eat the CR or LF character. - char d; - is.get (d); - - // Make sure that for binary-mode opened ascii files - // containing CRLF line endings we skip the LF after CR. - if (c == '\r' && is.peek () == '\n') - { - // Yes, LF following CR, eat it. - is.get (d); - } - } - - // Newline was found, and read from stream if - // keep_newline == true, so exit loop. - break; - } - else - { - // No newline charater peeked, so read it and proceed to next - // character. - char d; - is.get (d); - } - } -} - - -// If stream IS currently points to a newline (a leftover from a -// previous read) then eat newline(s) until a non-newline character is -// found. - -void -skip_preceeding_newline (std::istream& is) -{ - if (! is) - return; - - // Check whether IS currently points to newline character. - char c = is.peek (); - - if (c == '\n' || c == '\r') - { - // Yes, at newline. - do - { - // Eat the CR or LF character. - char d; - is.get (d); - - // Make sure that for binary-mode opened ascii files - // containing CRLF line endings we skip the LF after CR. - if (c == '\r' && is.peek () == '\n') - { - // Yes, LF following CR, eat it. - is.get (d); - } - - // Peek into next character. - c = is.peek (); - - // Loop while still a newline ahead. - } - while (c == '\n' || c == '\r'); - } -} - -// Read charaters from stream IS until a newline is reached. -// Depending on KEEP_NEWLINE, either eat newline from stream or keep -// it unread. Characters read are stored and returned as -// std::string. - -std::string -read_until_newline (std::istream& is, bool keep_newline) -{ - if (! is) - return std::string (); - - std::ostringstream buf; - - while (is) - { - char c = is.peek (); - - if (c == '\n' || c == '\r') - { - // Reached newline. - if (! keep_newline) - { - // Eat the CR or LF character. - char d; - is.get (d); - - // Make sure that for binary-mode opened ascii files - // containing CRLF line endings we skip the LF after - // CR. - - if (c == '\r' && is.peek () == '\n') - { - // Yes, LF following CR, eat it. - is.get (d); - } - } - - // Newline was found, and read from stream if - // keep_newline == true, so exit loop. - break; - } - else - { - // No newline charater peeked, so read it, store it, and - // proceed to next. - char d; - is.get (d); - buf << d; - } - } - - return buf.str (); -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/ls-ascii-helper.h --- a/libinterp/interp-core/ls-ascii-helper.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -/* - -Copyright (C) 2009-2012 Benjamin Lindner - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_ls_ascii_helper_h) -#define octave_ls_ascii_helper_h 1 - -#include -#include - -extern OCTINTERP_API void -skip_until_newline (std::istream& is, bool keep_newline = false); - -extern OCTINTERP_API void -skip_preceeding_newline (std::istream& is); - -extern OCTINTERP_API std::string -read_until_newline (std::istream& is, bool keep_newline = false); - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/ls-hdf5.cc --- a/libinterp/interp-core/ls-hdf5.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,921 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Author: Steven G. Johnson - -#ifdef HAVE_CONFIG_H -#include -#endif - -#if defined (HAVE_HDF5) - -#include -#include -#include - -#include -#include -#include -#include -#include - -#include "byte-swap.h" -#include "data-conv.h" -#include "file-ops.h" -#include "glob-match.h" -#include "lo-mappers.h" -#include "mach-info.h" -#include "oct-env.h" -#include "oct-time.h" -#include "quit.h" -#include "str-vec.h" -#include "oct-locbuf.h" - -#include "Cell.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "load-save.h" -#include "oct-obj.h" -#include "oct-map.h" -#include "ov-cell.h" -#include "pager.h" -#include "pt-exp.h" -#include "sysdep.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" -#include "version.h" -#include "dMatrix.h" -#include "ov-lazy-idx.h" - -#include "ls-utils.h" -#include "ls-hdf5.h" - -static std::string -make_valid_identifier (const std::string& nm) -{ - std::string retval; - - size_t nm_len = nm.length (); - - if (nm_len > 0) - { - if (! isalpha (nm[0])) - retval += '_'; - - for (size_t i = 0; i < nm_len; i++) - { - char c = nm[i]; - retval += (isalnum (c) || c == '_') ? c : '_'; - } - } - - return retval; -} - -// Define this to 1 if/when HDF5 supports automatic conversion between -// integer and floating-point binary data: -#define HAVE_HDF5_INT2FLOAT_CONVERSIONS 0 - -// Given two compound types t1 and t2, determine whether they -// are compatible for reading/writing. This function only -// works for non-nested types composed of simple elements (ints, floats...), -// which is all we need it for - -bool -hdf5_types_compatible (hid_t t1, hid_t t2) -{ - int n; - if ((n = H5Tget_nmembers (t1)) != H5Tget_nmembers (t2)) - return false; - - for (int i = 0; i < n; ++i) - { - hid_t mt1 = H5Tget_member_type (t1, i); - hid_t mt2 = H5Tget_member_type (t2, i); - - if (H5Tget_class (mt1) != H5Tget_class (mt2)) - return false; - - H5Tclose (mt2); - H5Tclose (mt1); - } - - return true; -} - -// Return true if loc_id has the attribute named attr_name, and false -// otherwise. - -bool -hdf5_check_attr (hid_t loc_id, const char *attr_name) -{ - bool retval = false; - - // we have to pull some shenanigans here to make sure - // HDF5 doesn't print out all sorts of error messages if we - // call H5Aopen for a non-existing attribute - - H5E_auto_t err_func; - void *err_func_data; - - // turn off error reporting temporarily, but save the error - // reporting function: - -#if HAVE_HDF5_18 - H5Eget_auto (H5E_DEFAULT, &err_func, &err_func_data); - H5Eset_auto (H5E_DEFAULT, 0, 0); -#else - H5Eget_auto (&err_func, &err_func_data); - H5Eset_auto (0, 0); -#endif - - hid_t attr_id = H5Aopen_name (loc_id, attr_name); - - if (attr_id >= 0) - { - // successful - retval = true; - H5Aclose (attr_id); - } - - // restore error reporting: -#if HAVE_HDF5_18 - H5Eset_auto (H5E_DEFAULT, err_func, err_func_data); -#else - H5Eset_auto (err_func, err_func_data); -#endif - return retval; -} - -bool -hdf5_get_scalar_attr (hid_t loc_id, hid_t type_id, - const char *attr_name, void *buf) -{ - bool retval = false; - - // we have to pull some shenanigans here to make sure - // HDF5 doesn't print out all sorts of error messages if we - // call H5Aopen for a non-existing attribute - - H5E_auto_t err_func; - void *err_func_data; - - // turn off error reporting temporarily, but save the error - // reporting function: - -#if HAVE_HDF5_18 - H5Eget_auto (H5E_DEFAULT, &err_func, &err_func_data); - H5Eset_auto (H5E_DEFAULT, 0, 0); -#else - H5Eget_auto (&err_func, &err_func_data); - H5Eset_auto (0, 0); -#endif - - hid_t attr_id = H5Aopen_name (loc_id, attr_name); - - if (attr_id >= 0) - { - hid_t space_id = H5Aget_space (attr_id); - - hsize_t rank = H5Sget_simple_extent_ndims (space_id); - - if (rank == 0) - retval = H5Aread (attr_id, type_id, buf) >= 0; - H5Aclose (attr_id); - } - - // restore error reporting: -#if HAVE_HDF5_18 - H5Eset_auto (H5E_DEFAULT, err_func, err_func_data); -#else - H5Eset_auto (err_func, err_func_data); -#endif - return retval; -} - - - - -// The following subroutines creates an HDF5 representations of the way -// we will store Octave complex types (pairs of floating-point numbers). -// NUM_TYPE is the HDF5 numeric type to use for storage (e.g. -// H5T_NATIVE_DOUBLE to save as 'double'). Note that any necessary -// conversions are handled automatically by HDF5. - -hid_t -hdf5_make_complex_type (hid_t num_type) -{ - hid_t type_id = H5Tcreate (H5T_COMPOUND, sizeof (double) * 2); - - H5Tinsert (type_id, "real", 0 * sizeof (double), num_type); - H5Tinsert (type_id, "imag", 1 * sizeof (double), num_type); - - return type_id; -} - -// This function is designed to be passed to H5Giterate, which calls it -// on each data item in an HDF5 file. For the item whose name is NAME in -// the group GROUP_ID, this function sets dv->tc to an Octave representation -// of that item. (dv must be a pointer to hdf5_callback_data.) (It also -// sets the other fields of dv). -// -// It returns 1 on success (in which case H5Giterate stops and returns), -// -1 on error, and 0 to tell H5Giterate to continue on to the next item -// (e.g. if NAME was a data type we don't recognize). - -herr_t -hdf5_read_next_data (hid_t group_id, const char *name, void *dv) -{ - hdf5_callback_data *d = static_cast (dv); - hid_t type_id = -1, type_class_id = -1, data_id = -1, subgroup_id = -1, - space_id = -1; - - H5G_stat_t info; - herr_t retval = 0; - bool ident_valid = valid_identifier (name); - - std::string vname = name; - - // Allow identifiers as all digits so we can load lists saved by - // earlier versions of Octave. - - if (! ident_valid ) - { - // fix the identifier, replacing invalid chars with underscores - vname = make_valid_identifier (vname); - - // check again (in case vname was null, empty, or some such thing): - ident_valid = valid_identifier (vname); - } - - H5Gget_objinfo (group_id, name, 1, &info); - - if (info.type == H5G_GROUP && ident_valid) - { -#if HAVE_HDF5_18 - subgroup_id = H5Gopen (group_id, name, H5P_DEFAULT); -#else - subgroup_id = H5Gopen (group_id, name); -#endif - - if (subgroup_id < 0) - { - retval = subgroup_id; - goto done; - } - - if (hdf5_check_attr (subgroup_id, "OCTAVE_NEW_FORMAT")) - { -#if HAVE_HDF5_18 - data_id = H5Dopen (subgroup_id, "type", H5P_DEFAULT); -#else - data_id = H5Dopen (subgroup_id, "type"); -#endif - - if (data_id < 0) - { - retval = data_id; - goto done; - } - - type_id = H5Dget_type (data_id); - - type_class_id = H5Tget_class (type_id); - - if (type_class_id != H5T_STRING) - goto done; - - space_id = H5Dget_space (data_id); - hsize_t rank = H5Sget_simple_extent_ndims (space_id); - - if (rank != 0) - goto done; - - int slen = H5Tget_size (type_id); - if (slen < 0) - goto done; - - OCTAVE_LOCAL_BUFFER (char, typ, slen); - - // create datatype for (null-terminated) string to read into: - hid_t st_id = H5Tcopy (H5T_C_S1); - H5Tset_size (st_id, slen); - - if (H5Dread (data_id, st_id, H5S_ALL, H5S_ALL, H5P_DEFAULT, - typ) < 0) - goto done; - - H5Tclose (st_id); - H5Dclose (data_id); - - d->tc = octave_value_typeinfo::lookup_type (typ); - - retval = (d->tc.load_hdf5 (subgroup_id, "value") ? 1 : -1); - - // check for OCTAVE_GLOBAL attribute: - d->global = hdf5_check_attr (subgroup_id, "OCTAVE_GLOBAL"); - - H5Gclose (subgroup_id); - } - else - { - // an HDF5 group is treated as an octave structure by - // default (since that preserves name information), and an - // octave list otherwise. - - if (hdf5_check_attr (subgroup_id, "OCTAVE_LIST")) - d->tc = octave_value_typeinfo::lookup_type ("list"); - else - d->tc = octave_value_typeinfo::lookup_type ("struct"); - - // check for OCTAVE_GLOBAL attribute: - d->global = hdf5_check_attr (subgroup_id, "OCTAVE_GLOBAL"); - - H5Gclose (subgroup_id); - - retval = (d->tc.load_hdf5 (group_id, name) ? 1 : -1); - } - - } - else if (info.type == H5G_DATASET && ident_valid) - { - // For backwards compatiability. -#if HAVE_HDF5_18 - data_id = H5Dopen (group_id, name, H5P_DEFAULT); -#else - data_id = H5Dopen (group_id, name); -#endif - - if (data_id < 0) - { - retval = data_id; - goto done; - } - - type_id = H5Dget_type (data_id); - - type_class_id = H5Tget_class (type_id); - - if (type_class_id == H5T_FLOAT) - { - space_id = H5Dget_space (data_id); - - hsize_t rank = H5Sget_simple_extent_ndims (space_id); - - if (rank == 0) - d->tc = octave_value_typeinfo::lookup_type ("scalar"); - else - d->tc = octave_value_typeinfo::lookup_type ("matrix"); - - H5Sclose (space_id); - } - else if (type_class_id == H5T_INTEGER) - { - // What integer type do we really have.. - std::string int_typ; -#ifdef HAVE_H5T_GET_NATIVE_TYPE - // FIXME test this code and activated with an autoconf - // test!! It is also incorrect for 64-bit indexing!! - - switch (H5Tget_native_type (type_id, H5T_DIR_ASCEND)) - { - case H5T_NATIVE_CHAR: - int_typ = "int8 "; - break; - - case H5T_NATIVE_SHORT: - int_typ = "int16 "; - break; - - case H5T_NATIVE_INT: - case H5T_NATIVE_LONG: - int_typ = "int32 "; - break; - - case H5T_NATIVE_LLONG: - int_typ = "int64 "; - break; - - case H5T_NATIVE_UCHAR: - int_typ = "uint8 "; - break; - - case H5T_NATIVE_USHORT: - int_typ = "uint16 "; - break; - - case H5T_NATIVE_UINT: - case H5T_NATIVE_ULONG: - int_typ = "uint32 "; - break; - - case H5T_NATIVE_ULLONG: - int_typ = "uint64 "; - break; - } -#else - hid_t int_sign = H5Tget_sign (type_id); - - if (int_sign == H5T_SGN_ERROR) - warning ("load: can't read '%s' (unknown datatype)", name); - else - { - if (int_sign == H5T_SGN_NONE) - int_typ.append ("u"); - int_typ.append ("int"); - - int slen = H5Tget_size (type_id); - if (slen < 0) - warning ("load: can't read '%s' (unknown datatype)", name); - else - { - switch (slen) - { - case 1: - int_typ.append ("8 "); - break; - - case 2: - int_typ.append ("16 "); - break; - - case 4: - int_typ.append ("32 "); - break; - - case 8: - int_typ.append ("64 "); - break; - - default: - warning ("load: can't read '%s' (unknown datatype)", - name); - int_typ = ""; - break; - } - } - } -#endif - if (int_typ == "") - warning ("load: can't read '%s' (unknown datatype)", name); - else - { - // Matrix or scalar? - space_id = H5Dget_space (data_id); - - hsize_t rank = H5Sget_simple_extent_ndims (space_id); - - if (rank == 0) - int_typ.append ("scalar"); - else - int_typ.append ("matrix"); - - d->tc = octave_value_typeinfo::lookup_type (int_typ); - H5Sclose (space_id); - } - } - else if (type_class_id == H5T_STRING) - d->tc = octave_value_typeinfo::lookup_type ("string"); - else if (type_class_id == H5T_COMPOUND) - { - hid_t complex_type = hdf5_make_complex_type (H5T_NATIVE_DOUBLE); - - if (hdf5_types_compatible (type_id, complex_type)) - { - // read complex matrix or scalar variable - space_id = H5Dget_space (data_id); - hsize_t rank = H5Sget_simple_extent_ndims (space_id); - - if (rank == 0) - d->tc = octave_value_typeinfo::lookup_type ("complex scalar"); - else - d->tc = octave_value_typeinfo::lookup_type ("complex matrix"); - - H5Sclose (space_id); - } - else - // Assume that if its not complex its a range. If its not - // it'll be rejected later in the range code - d->tc = octave_value_typeinfo::lookup_type ("range"); - - H5Tclose (complex_type); - } - else - { - warning ("load: can't read '%s' (unknown datatype)", name); - retval = 0; // unknown datatype; skip - } - - // check for OCTAVE_GLOBAL attribute: - d->global = hdf5_check_attr (data_id, "OCTAVE_GLOBAL"); - - H5Tclose (type_id); - H5Dclose (data_id); - - retval = (d->tc.load_hdf5 (group_id, name) ? 1 : -1); - } - - if (!ident_valid) - { - // should we attempt to handle invalid identifiers by converting - // bad characters to '_', say? - warning ("load: skipping invalid identifier '%s' in hdf5 file", - name); - } - - done: - if (retval < 0) - error ("load: error while reading hdf5 item %s", name); - - if (retval > 0) - { - // get documentation string, if any: - int comment_length = H5Gget_comment (group_id, name, 0, 0); - - if (comment_length > 1) - { - OCTAVE_LOCAL_BUFFER (char, tdoc, comment_length); - H5Gget_comment (group_id, name, comment_length, tdoc); - d->doc = tdoc; - } - else if (vname != name) - { - // the name was changed; store the original name - // as the documentation string: - d->doc = name; - } - - // copy name (actually, vname): - d->name = vname; - } - - return retval; -} - -// Read the next Octave variable from the stream IS, which must really be -// an hdf5_ifstream. Return the variable value in tc, its doc string -// in doc, and whether it is global in global. The return value is -// the name of the variable, or NULL if none were found or there was -// and error. -std::string -read_hdf5_data (std::istream& is, const std::string& /* filename */, - bool& global, octave_value& tc, std::string& doc) -{ - std::string retval; - - doc.resize (0); - - hdf5_ifstream& hs = dynamic_cast (is); - hdf5_callback_data d; - - herr_t H5Giterate_retval = -1; - - hsize_t num_obj = 0; -#if HAVE_HDF5_18 - hid_t group_id = H5Gopen (hs.file_id, "/", H5P_DEFAULT); -#else - hid_t group_id = H5Gopen (hs.file_id, "/"); -#endif - H5Gget_num_objs (group_id, &num_obj); - H5Gclose (group_id); - if (hs.current_item < static_cast (num_obj)) - H5Giterate_retval = H5Giterate (hs.file_id, "/", &hs.current_item, - hdf5_read_next_data, &d); - - if (H5Giterate_retval > 0) - { - global = d.global; - tc = d.tc; - doc = d.doc; - } - else - { - // an error occurred (H5Giterate_retval < 0) or there are no - // more datasets print an error message if retval < 0? - // hdf5_read_next_data already printed one, probably. - } - - if (! d.name.empty ()) - retval = d.name; - - return retval; -} - -// Add an attribute named attr_name to loc_id (a simple scalar -// attribute with value 1). Return value is >= 0 on success. -herr_t -hdf5_add_attr (hid_t loc_id, const char *attr_name) -{ - herr_t retval = 0; - - hid_t as_id = H5Screate (H5S_SCALAR); - - if (as_id >= 0) - { -#if HAVE_HDF5_18 - hid_t a_id = H5Acreate (loc_id, attr_name, H5T_NATIVE_UCHAR, - as_id, H5P_DEFAULT, H5P_DEFAULT); -#else - hid_t a_id = H5Acreate (loc_id, attr_name, - H5T_NATIVE_UCHAR, as_id, H5P_DEFAULT); -#endif - if (a_id >= 0) - { - unsigned char attr_val = 1; - - retval = H5Awrite (a_id, H5T_NATIVE_UCHAR, &attr_val); - - H5Aclose (a_id); - } - else - retval = a_id; - - H5Sclose (as_id); - } - else - retval = as_id; - - return retval; -} - -herr_t -hdf5_add_scalar_attr (hid_t loc_id, hid_t type_id, - const char *attr_name, void *buf) -{ - herr_t retval = 0; - - hid_t as_id = H5Screate (H5S_SCALAR); - - if (as_id >= 0) - { -#if HAVE_HDF5_18 - hid_t a_id = H5Acreate (loc_id, attr_name, type_id, - as_id, H5P_DEFAULT, H5P_DEFAULT); -#else - hid_t a_id = H5Acreate (loc_id, attr_name, - type_id, as_id, H5P_DEFAULT); -#endif - if (a_id >= 0) - { - retval = H5Awrite (a_id, type_id, buf); - - H5Aclose (a_id); - } - else - retval = a_id; - - H5Sclose (as_id); - } - else - retval = as_id; - - return retval; -} - -// Save an empty matrix, if needed. Returns -// > 0 Saved empty matrix -// = 0 Not an empty matrix; did nothing -// < 0 Error condition -int -save_hdf5_empty (hid_t loc_id, const char *name, const dim_vector d) -{ - hsize_t sz = d.length (); - OCTAVE_LOCAL_BUFFER (octave_idx_type, dims, sz); - bool empty = false; - hid_t space_hid = -1, data_hid = -1; - int retval; - for (hsize_t i = 0; i < sz; i++) - { - dims[i] = d(i); - if (dims[i] < 1) - empty = true; - } - - if (!empty) - return 0; - - space_hid = H5Screate_simple (1, &sz, 0); - if (space_hid < 0) return space_hid; -#if HAVE_HDF5_18 - data_hid = H5Dcreate (loc_id, name, H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (loc_id, name, H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - return data_hid; - } - - retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, - H5P_DEFAULT, dims) >= 0; - - H5Dclose (data_hid); - H5Sclose (space_hid); - - if (retval >= 0) - retval = hdf5_add_attr (loc_id, "OCTAVE_EMPTY_MATRIX"); - - return (retval == 0 ? 1 : retval); -} - -// Load an empty matrix, if needed. Returns -// > 0 loaded empty matrix, dimensions returned -// = 0 Not an empty matrix; did nothing -// < 0 Error condition -int -load_hdf5_empty (hid_t loc_id, const char *name, dim_vector &d) -{ - if (! hdf5_check_attr (loc_id, "OCTAVE_EMPTY_MATRIX")) - return 0; - - hsize_t hdims, maxdims; -#if HAVE_HDF5_18 - hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); -#else - hid_t data_hid = H5Dopen (loc_id, name); -#endif - hid_t space_id = H5Dget_space (data_hid); - H5Sget_simple_extent_dims (space_id, &hdims, &maxdims); - int retval; - - OCTAVE_LOCAL_BUFFER (octave_idx_type, dims, hdims); - - retval = H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, - H5P_DEFAULT, dims); - if (retval >= 0) - { - d.resize (hdims); - for (hsize_t i = 0; i < hdims; i++) - d(i) = dims[i]; - } - - H5Sclose (space_id); - H5Dclose (data_hid); - - return (retval == 0 ? hdims : retval); -} - -// save_type_to_hdf5 is not currently used, since hdf5 doesn't yet support -// automatic float<->integer conversions: - -#if HAVE_HDF5_INT2FLOAT_CONVERSIONS - -// return the HDF5 type id corresponding to the Octave save_type - -hid_t -save_type_to_hdf5 (save_type st) -{ - switch (st) - { - case LS_U_CHAR: - return H5T_NATIVE_UCHAR; - - case LS_U_SHORT: - return H5T_NATIVE_USHORT; - - case LS_U_INT: - return H5T_NATIVE_UINT; - - case LS_CHAR: - return H5T_NATIVE_CHAR; - - case LS_SHORT: - return H5T_NATIVE_SHORT; - - case LS_INT: - return H5T_NATIVE_INT; - - case LS_FLOAT: - return H5T_NATIVE_FLOAT; - - case LS_DOUBLE: - default: - return H5T_NATIVE_DOUBLE; - } -} -#endif /* HAVE_HDF5_INT2FLOAT_CONVERSIONS */ - -// Add the data from TC to the HDF5 location loc_id, which could -// be either a file or a group within a file. Return true if -// successful. This function calls itself recursively for lists -// (stored as HDF5 groups). - -bool -add_hdf5_data (hid_t loc_id, const octave_value& tc, - const std::string& name, const std::string& doc, - bool mark_as_global, bool save_as_floats) -{ - hsize_t dims[3]; - hid_t type_id = -1, space_id = -1, data_id = -1, data_type_id = -1; - bool retval = false; - octave_value val = tc; - // FIXME: diagonal & permutation matrices currently don't know how to save - // themselves, so we convert them first to normal matrices using A = A(:,:). - // This is a temporary hack. - if (val.is_diag_matrix () || val.is_perm_matrix () - || val.type_id () == octave_lazy_index::static_type_id ()) - val = val.full_value (); - - std::string t = val.type_name (); -#if HAVE_HDF5_18 - data_id = H5Gcreate (loc_id, name.c_str (), H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_id = H5Gcreate (loc_id, name.c_str (), 0); -#endif - if (data_id < 0) - goto error_cleanup; - - // attach the type of the variable - type_id = H5Tcopy (H5T_C_S1); H5Tset_size (type_id, t.length () + 1); - if (type_id < 0) - goto error_cleanup; - - dims[0] = 0; - space_id = H5Screate_simple (0 , dims, 0); - if (space_id < 0) - goto error_cleanup; -#if HAVE_HDF5_18 - data_type_id = H5Dcreate (data_id, "type", type_id, space_id, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_type_id = H5Dcreate (data_id, "type", type_id, space_id, H5P_DEFAULT); -#endif - if (data_type_id < 0 || H5Dwrite (data_type_id, type_id, H5S_ALL, H5S_ALL, - H5P_DEFAULT, t.c_str ()) < 0) - goto error_cleanup; - - // Now call the real function to save the variable - retval = val.save_hdf5 (data_id, "value", save_as_floats); - - // attach doc string as comment: - if (retval && doc.length () > 0 - && H5Gset_comment (loc_id, name.c_str (), doc.c_str ()) < 0) - retval = false; - - // if it's global, add an attribute "OCTAVE_GLOBAL" with value 1 - if (retval && mark_as_global) - retval = hdf5_add_attr (data_id, "OCTAVE_GLOBAL") >= 0; - - // We are saving in the new variable format, so mark it - if (retval) - retval = hdf5_add_attr (data_id, "OCTAVE_NEW_FORMAT") >= 0; - - error_cleanup: - - if (data_type_id >= 0) - H5Dclose (data_type_id); - - if (type_id >= 0) - H5Tclose (type_id); - - if (space_id >= 0) - H5Sclose (space_id); - - if (data_id >= 0) - H5Gclose (data_id); - - if (! retval) - error ("save: error while writing '%s' to hdf5 file", name.c_str ()); - - return retval; -} - -// Write data from TC in HDF5 (binary) format to the stream OS, -// which must be an hdf5_ofstream, returning true on success. - -bool -save_hdf5_data (std::ostream& os, const octave_value& tc, - const std::string& name, const std::string& doc, - bool mark_as_global, bool save_as_floats) -{ - hdf5_ofstream& hs = dynamic_cast (os); - - return add_hdf5_data (hs.file_id, tc, name, doc, - mark_as_global, save_as_floats); -} - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/ls-hdf5.h --- a/libinterp/interp-core/ls-hdf5.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,213 +0,0 @@ -/* - -Copyright (C) 2003-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_ls_hdf5_h) -#define octave_ls_hdf5_h 1 - -#if defined (HAVE_HDF5) - -#include "oct-hdf5.h" - -// first, we need to define our own dummy stream subclass, since -// HDF5 needs to do its own file i/o - -// hdf5_fstreambase is used for both input and output streams, modeled -// on the fstreambase class in - -class hdf5_fstreambase : virtual public std::ios -{ -public: - - // HDF5 uses an "id" to refer to an open file - hid_t file_id; - - // keep track of current item index in the file - int current_item; - - hdf5_fstreambase () : file_id (-1), current_item () { } - - ~hdf5_fstreambase () { close (); } - - hdf5_fstreambase (const char *name, int mode, int /* prot */ = 0) - : file_id (-1), current_item (-1) - { - if (mode & std::ios::in) - file_id = H5Fopen (name, H5F_ACC_RDONLY, H5P_DEFAULT); - else if (mode & std::ios::out) - { - if (mode & std::ios::app && H5Fis_hdf5 (name) > 0) - file_id = H5Fopen (name, H5F_ACC_RDWR, H5P_DEFAULT); - else - file_id = H5Fcreate (name, H5F_ACC_TRUNC, H5P_DEFAULT, - H5P_DEFAULT); - } - if (file_id < 0) - std::ios::setstate (std::ios::badbit); - - current_item = 0; - } - - void close () - { - if (file_id >= 0) - { - if (H5Fclose (file_id) < 0) - std::ios::setstate (std::ios::badbit); - file_id = -1; - } - } - - void open (const char *name, int mode, int) - { - clear (); - - if (mode & std::ios::in) - file_id = H5Fopen (name, H5F_ACC_RDONLY, H5P_DEFAULT); - else if (mode & std::ios::out) - { - if (mode & std::ios::app && H5Fis_hdf5 (name) > 0) - file_id = H5Fopen (name, H5F_ACC_RDWR, H5P_DEFAULT); - else - file_id = H5Fcreate (name, H5F_ACC_TRUNC, H5P_DEFAULT, - H5P_DEFAULT); - } - if (file_id < 0) - std::ios::setstate (std::ios::badbit); - - current_item = 0; - } -}; - -// input and output streams, subclassing istream and ostream -// so that we can pass them for stream parameters in the functions below. - -class hdf5_ifstream : public hdf5_fstreambase, public std::istream -{ -public: - - hdf5_ifstream () : hdf5_fstreambase (), std::istream (0) { } - - hdf5_ifstream (const char *name, int mode = std::ios::in|std::ios::binary, - int prot = 0) - : hdf5_fstreambase (name, mode, prot), std::istream (0) { } - - void open (const char *name, int mode = std::ios::in|std::ios::binary, - int prot = 0) - { hdf5_fstreambase::open (name, mode, prot); } -}; - -class hdf5_ofstream : public hdf5_fstreambase, public std::ostream -{ -public: - - hdf5_ofstream () : hdf5_fstreambase (), std::ostream (0) { } - - hdf5_ofstream (const char *name, int mode = std::ios::out|std::ios::binary, - int prot = 0) - : hdf5_fstreambase (name, mode, prot), std::ostream (0) { } - - void open (const char *name, int mode = std::ios::out|std::ios::binary, - int prot = 0) - { hdf5_fstreambase::open (name, mode, prot); } -}; - -// Callback data structure for passing data to hdf5_read_next_data, below. - -struct -hdf5_callback_data -{ - hdf5_callback_data (void) - : name (), global (false), tc (), doc () { } - - // the following fields are set by hdf5_read_data on successful return: - - // the name of the variable - std::string name; - - // whether it is global - bool global; - - // the value of the variable, in Octave form - octave_value tc; - - // a documentation string (NULL if none) - std::string doc; -}; - -#if HAVE_HDF5_INT2FLOAT_CONVERSIONS -extern OCTINTERP_API hid_t -save_type_to_hdf5 (save_type st) -#endif - -extern OCTINTERP_API hid_t -hdf5_make_complex_type (hid_t num_type); - -extern OCTINTERP_API bool -hdf5_types_compatible (hid_t t1, hid_t t2); - -extern OCTINTERP_API herr_t -hdf5_read_next_data (hid_t group_id, const char *name, void *dv); - -extern OCTINTERP_API bool -add_hdf5_data (hid_t loc_id, const octave_value& tc, - const std::string& name, const std::string& doc, - bool mark_as_global, bool save_as_floats); - -extern OCTINTERP_API int -save_hdf5_empty (hid_t loc_id, const char *name, const dim_vector d); - -extern OCTINTERP_API int -load_hdf5_empty (hid_t loc_id, const char *name, dim_vector &d); - -extern OCTINTERP_API std::string -read_hdf5_data (std::istream& is, const std::string& filename, bool& global, - octave_value& tc, std::string& doc); - -extern OCTINTERP_API bool -save_hdf5_data (std::ostream& os, const octave_value& tc, - const std::string& name, const std::string& doc, - bool mark_as_global, bool save_as_floats); - -extern OCTINTERP_API bool -hdf5_check_attr (hid_t loc_id, const char *attr_name); - -extern OCTINTERP_API bool -hdf5_get_scalar_attr (hid_t loc_id, hid_t type_id, const char *attr_name, - void *buf); - -extern OCTINTERP_API herr_t -hdf5_add_attr (hid_t loc_id, const char *attr_name); - - -extern OCTINTERP_API herr_t -hdf5_add_scalar_attr (hid_t loc_id, hid_t type_id, - const char *attr_name, void *buf); - -#ifdef USE_64_BIT_IDX_T -#define H5T_NATIVE_IDX H5T_NATIVE_LONG -#else -#define H5T_NATIVE_IDX H5T_NATIVE_INT -#endif - -#endif - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/ls-mat-ascii.cc --- a/libinterp/interp-core/ls-mat-ascii.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,430 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include -#include -#include -#include -#include - -#include "byte-swap.h" -#include "data-conv.h" -#include "file-ops.h" -#include "glob-match.h" -#include "lo-mappers.h" -#include "mach-info.h" -#include "oct-env.h" -#include "oct-time.h" -#include "quit.h" -#include "str-vec.h" - -#include "Cell.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "lex.h" -#include "load-save.h" -#include "ls-ascii-helper.h" -#include "ls-mat-ascii.h" -#include "oct-obj.h" -#include "oct-map.h" -#include "ov-cell.h" -#include "pager.h" -#include "pt-exp.h" -#include "sysdep.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" -#include "version.h" -#include "dMatrix.h" - -static std::string -get_mat_data_input_line (std::istream& is) -{ - std::string retval; - - bool have_data = false; - - do - { - retval = ""; - - char c; - while (is.get (c)) - { - if (c == '\n' || c == '\r') - { - is.putback (c); - skip_preceeding_newline (is); - break; - } - - if (c == '%' || c == '#') - { - skip_until_newline (is, false); - break; - } - - if (! is.eof ()) - { - if (! have_data && c != ' ' && c != '\t') - have_data = true; - - retval += c; - } - } - } - while (! (have_data || is.eof ())); - - return retval; -} - -static void -get_lines_and_columns (std::istream& is, - octave_idx_type& nr, octave_idx_type& nc, - const std::string& filename = std::string (), - bool quiet = false, bool check_numeric = false) -{ - std::streampos pos = is.tellg (); - - int file_line_number = 0; - - nr = 0; - nc = 0; - - while (is && ! error_state) - { - octave_quit (); - - std::string buf = get_mat_data_input_line (is); - - file_line_number++; - - size_t beg = buf.find_first_not_of (", \t"); - - // If we see a CR as the last character in the buffer, we had a - // CRLF pair as the line separator. Any other CR in the text - // will not be considered as whitespace. - - if (beg != std::string::npos && buf[beg] == '\r' && beg == buf.length () - 1) - { - // We had a blank line ending with a CRLF. Handle it the - // same as an empty line. - beg = std::string::npos; - } - - octave_idx_type tmp_nc = 0; - - while (beg != std::string::npos) - { - tmp_nc++; - - size_t end = buf.find_first_of (", \t", beg); - - if (end != std::string::npos) - { - if (check_numeric) - { - std::istringstream tmp_stream (buf.substr (beg, end-beg)); - - octave_read_double (tmp_stream); - - if (tmp_stream.fail ()) - { - if (! quiet) - error ("load: %s: non-numeric data found near line %d", - filename.c_str (), file_line_number); - - nr = 0; - nc = 0; - - goto done; - } - } - - beg = buf.find_first_not_of (", \t", end); - - if (beg == std::string::npos || (buf[beg] == '\r' && - beg == buf.length () - 1)) - { - // We had a line with trailing spaces and - // ending with a CRLF, so this should look like EOL, - // not a new colum. - break; - } - } - else - break; - } - - if (tmp_nc > 0) - { - if (nc == 0) - { - nc = tmp_nc; - nr++; - } - else if (nc == tmp_nc) - nr++; - else - { - if (! quiet) - error ("load: %s: inconsistent number of columns near line %d", - filename.c_str (), file_line_number); - - nr = 0; - nc = 0; - - goto done; - } - } - } - - if (! quiet && (nr == 0 || nc == 0)) - error ("load: file '%s' seems to be empty!", filename.c_str ()); - - done: - - is.clear (); - is.seekg (pos); -} - -// Extract a matrix from a file of numbers only. -// -// Comments are not allowed. The file should only have numeric values. -// -// Reads the file twice. Once to find the number of rows and columns, -// and once to extract the matrix. -// -// FILENAME is used for error messages. -// -// This format provides no way to tag the data as global. - -std::string -read_mat_ascii_data (std::istream& is, const std::string& filename, - octave_value& tc) -{ - std::string retval; - - std::string varname; - - size_t pos = filename.rfind ('/'); - - if (pos != std::string::npos) - varname = filename.substr (pos+1); - else - varname = filename; - - pos = varname.rfind ('.'); - - if (pos != std::string::npos) - varname = varname.substr (0, pos); - - size_t len = varname.length (); - for (size_t i = 0; i < len; i++) - { - char c = varname[i]; - if (! (isalnum (c) || c == '_')) - varname[i] = '_'; - } - - if (is_keyword (varname) || ! isalpha (varname[0])) - varname.insert (0, "X"); - - if (valid_identifier (varname)) - { - octave_idx_type nr = 0; - octave_idx_type nc = 0; - - int total_count = 0; - - get_lines_and_columns (is, nr, nc, filename); - - octave_quit (); - - if (! error_state && nr > 0 && nc > 0) - { - Matrix tmp (nr, nc); - - if (nr < 1 || nc < 1) - is.clear (std::ios::badbit); - else - { - double d; - for (octave_idx_type i = 0; i < nr; i++) - { - std::string buf = get_mat_data_input_line (is); - - std::istringstream tmp_stream (buf); - - for (octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - - d = octave_read_value (tmp_stream); - - if (tmp_stream || tmp_stream.eof ()) - { - tmp.elem (i, j) = d; - total_count++; - - // Skip whitespace and commas. - char c; - while (1) - { - tmp_stream >> c; - - if (! tmp_stream) - break; - - if (! (c == ' ' || c == '\t' || c == ',')) - { - tmp_stream.putback (c); - break; - } - } - - if (tmp_stream.eof ()) - break; - } - else - { - error ("load: failed to read matrix from file '%s'", - filename.c_str ()); - - return retval; - } - - } - } - } - - if (is || is.eof ()) - { - // FIXME -- not sure this is best, but it works. - - if (is.eof ()) - is.clear (); - - octave_idx_type expected = nr * nc; - - if (expected == total_count) - { - tc = tmp; - retval = varname; - } - else - error ("load: expected %d elements, found %d", - expected, total_count); - } - else - error ("load: failed to read matrix from file '%s'", - filename.c_str ()); - } - else - error ("load: unable to extract matrix size from file '%s'", - filename.c_str ()); - } - else - error ("load: unable to convert filename '%s' to valid identifier", - filename.c_str ()); - - return retval; -} - -bool -save_mat_ascii_data (std::ostream& os, const octave_value& val, - int precision, bool tabs) -{ - bool success = true; - - if (val.is_complex_type ()) - warning ("save: omitting imaginary part for ASCII file"); - - Matrix m = val.matrix_value (true); - - if (error_state) - { - success = false; - - error_state = 0; - } - else - { - long old_precision = os.precision (); - - os.precision (precision); - - std::ios::fmtflags oflags - = os.flags (static_cast (std::ios::scientific)); - - if (tabs) - { - for (octave_idx_type i = 0; i < m.rows (); i++) - { - for (octave_idx_type j = 0; j < m.cols (); j++) - { - // Omit leading tabs. - if (j != 0) os << '\t'; - octave_write_double (os, m (i, j)); - } - os << "\n"; - } - } - else - os << m; - - os.flags (oflags); - - os.precision (old_precision); - } - - return (os && success); -} - -bool -looks_like_mat_ascii_file (const std::string& filename) -{ - bool retval = false; - - std::ifstream is (filename.c_str ()); - - if (is) - { - octave_idx_type nr = 0; - octave_idx_type nc = 0; - - get_lines_and_columns (is, nr, nc, filename, true, true); - - retval = (nr != 0 && nc != 0); - } - - return retval; -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/ls-mat-ascii.h --- a/libinterp/interp-core/ls-mat-ascii.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,36 +0,0 @@ -/* - -Copyright (C) 2003-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_ls_mat_ascii_h) -#define octave_ls_mat_ascii_h 1 - -extern std::string -read_mat_ascii_data (std::istream& is, const std::string& filename, - octave_value& tc); - -extern bool -save_mat_ascii_data (std::ostream& os, const octave_value& val_arg, - int precision, bool tabs = false); - -extern bool looks_like_mat_ascii_file (const std::string& filename); - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/ls-mat4.cc --- a/libinterp/interp-core/ls-mat4.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,609 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include -#include -#include -#include -#include - -#include "byte-swap.h" -#include "data-conv.h" -#include "file-ops.h" -#include "glob-match.h" -#include "lo-mappers.h" -#include "mach-info.h" -#include "oct-env.h" -#include "oct-time.h" -#include "quit.h" -#include "str-vec.h" -#include "oct-locbuf.h" - -#include "Cell.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "load-save.h" -#include "oct-obj.h" -#include "oct-map.h" -#include "ov-cell.h" -#include "pager.h" -#include "pt-exp.h" -#include "sysdep.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" -#include "version.h" -#include "dMatrix.h" -#include "dSparse.h" - -#include "ls-mat4.h" - -// Read LEN elements of data from IS in the format specified by -// PRECISION, placing the result in DATA. If SWAP is TRUE, swap -// the bytes of each element before copying to DATA. FLT_FMT -// specifies the format of the data if we are reading floating point -// numbers. - -static void -read_mat_binary_data (std::istream& is, double *data, int precision, - int len, bool swap, - oct_mach_info::float_format flt_fmt) -{ - switch (precision) - { - case 0: - read_doubles (is, data, LS_DOUBLE, len, swap, flt_fmt); - break; - - case 1: - read_doubles (is, data, LS_FLOAT, len, swap, flt_fmt); - break; - - case 2: - read_doubles (is, data, LS_INT, len, swap, flt_fmt); - break; - - case 3: - read_doubles (is, data, LS_SHORT, len, swap, flt_fmt); - break; - - case 4: - read_doubles (is, data, LS_U_SHORT, len, swap, flt_fmt); - break; - - case 5: - read_doubles (is, data, LS_U_CHAR, len, swap, flt_fmt); - break; - - default: - break; - } -} - -int -read_mat_file_header (std::istream& is, bool& swap, int32_t& mopt, - int32_t& nr, int32_t& nc, - int32_t& imag, int32_t& len, - int quiet) -{ - swap = false; - - // We expect to fail here, at the beginning of a record, so not - // being able to read another mopt value should not result in an - // error. - - is.read (reinterpret_cast (&mopt), 4); - if (! is) - return 1; - - if (! is.read (reinterpret_cast (&nr), 4)) - goto data_read_error; - - if (! is.read (reinterpret_cast (&nc), 4)) - goto data_read_error; - - if (! is.read (reinterpret_cast (&imag), 4)) - goto data_read_error; - - if (! is.read (reinterpret_cast (&len), 4)) - goto data_read_error; - -// If mopt is nonzero and the byte order is swapped, mopt will be -// bigger than we expect, so we swap bytes. -// -// If mopt is zero, it means the file was written on a little endian -// machine, and we only need to swap if we are running on a big endian -// machine. -// -// Gag me. - - if (oct_mach_info::words_big_endian () && mopt == 0) - swap = true; - - // mopt is signed, therefore byte swap may result in negative value. - - if (mopt > 9999 || mopt < 0) - swap = true; - - if (swap) - { - swap_bytes<4> (&mopt); - swap_bytes<4> (&nr); - swap_bytes<4> (&nc); - swap_bytes<4> (&imag); - swap_bytes<4> (&len); - } - - if (mopt > 9999 || mopt < 0 || imag > 1 || imag < 0) - { - if (! quiet) - error ("load: can't read binary file"); - return -1; - } - - return 0; - - data_read_error: - return -1; -} - -// We don't just use a cast here, because we need to be able to detect -// possible errors. - -oct_mach_info::float_format -mopt_digit_to_float_format (int mach) -{ - oct_mach_info::float_format flt_fmt = oct_mach_info::flt_fmt_unknown; - - switch (mach) - { - case 0: - flt_fmt = oct_mach_info::flt_fmt_ieee_little_endian; - break; - - case 1: - flt_fmt = oct_mach_info::flt_fmt_ieee_big_endian; - break; - - case 2: - flt_fmt = oct_mach_info::flt_fmt_vax_d; - break; - - case 3: - flt_fmt = oct_mach_info::flt_fmt_vax_g; - break; - - case 4: - flt_fmt = oct_mach_info::flt_fmt_cray; - break; - - default: - flt_fmt = oct_mach_info::flt_fmt_unknown; - break; - } - - return flt_fmt; -} - -int -float_format_to_mopt_digit (oct_mach_info::float_format flt_fmt) -{ - int retval = -1; - - switch (flt_fmt) - { - case oct_mach_info::flt_fmt_ieee_little_endian: - retval = 0; - break; - - case oct_mach_info::flt_fmt_ieee_big_endian: - retval = 1; - break; - - case oct_mach_info::flt_fmt_vax_d: - retval = 2; - break; - - case oct_mach_info::flt_fmt_vax_g: - retval = 3; - break; - - case oct_mach_info::flt_fmt_cray: - retval = 4; - break; - - default: - break; - } - - return retval; -} - -// Extract one value (scalar, matrix, string, etc.) from stream IS and -// place it in TC, returning the name of the variable. -// -// The data is expected to be in Matlab version 4 .mat format, though -// not all the features of that format are supported. -// -// FILENAME is used for error messages. -// -// This format provides no way to tag the data as global. - -std::string -read_mat_binary_data (std::istream& is, const std::string& filename, - octave_value& tc) -{ - std::string retval; - - // These are initialized here instead of closer to where they are - // first used to avoid errors from gcc about goto crossing - // initialization of variable. - - Matrix re; - oct_mach_info::float_format flt_fmt = oct_mach_info::flt_fmt_unknown; - bool swap = false; - int type = 0; - int prec = 0; - int order = 0; - int mach = 0; - int dlen = 0; - - int32_t mopt, nr, nc, imag, len; - - int err = read_mat_file_header (is, swap, mopt, nr, nc, imag, len); - if (err) - { - if (err < 0) - goto data_read_error; - else - return retval; - } - - type = mopt % 10; // Full, sparse, etc. - mopt /= 10; // Eliminate first digit. - prec = mopt % 10; // double, float, int, etc. - mopt /= 10; // Eliminate second digit. - order = mopt % 10; // Row or column major ordering. - mopt /= 10; // Eliminate third digit. - mach = mopt % 10; // IEEE, VAX, etc. - - flt_fmt = mopt_digit_to_float_format (mach); - - if (flt_fmt == oct_mach_info::flt_fmt_unknown) - { - error ("load: unrecognized binary format!"); - return retval; - } - - if (imag && type == 1) - { - error ("load: encountered complex matrix with string flag set!"); - return retval; - } - - // LEN includes the terminating character, and the file is also - // supposed to include it, but apparently not all files do. Either - // way, I think this should work. - - { - OCTAVE_LOCAL_BUFFER (char, name, len+1); - name[len] = '\0'; - if (! is.read (name, len)) - goto data_read_error; - retval = name; - - dlen = nr * nc; - if (dlen < 0) - goto data_read_error; - - if (order) - { - octave_idx_type tmp = nr; - nr = nc; - nc = tmp; - } - - if (type == 2) - { - if (nc == 4) - { - octave_idx_type nr_new, nc_new; - Array data (dim_vector (1, nr - 1)); - Array c (dim_vector (1, nr - 1)); - Array r (dim_vector (1, nr - 1)); - OCTAVE_LOCAL_BUFFER (double, dtmp, nr); - OCTAVE_LOCAL_BUFFER (double, ctmp, nr); - - read_mat_binary_data (is, dtmp, prec, nr, swap, flt_fmt); - for (octave_idx_type i = 0; i < nr - 1; i++) - r.xelem (i) = dtmp[i] - 1; - nr_new = dtmp[nr - 1]; - read_mat_binary_data (is, dtmp, prec, nr, swap, flt_fmt); - for (octave_idx_type i = 0; i < nr - 1; i++) - c.xelem (i) = dtmp[i] - 1; - nc_new = dtmp[nr - 1]; - read_mat_binary_data (is, dtmp, prec, nr - 1, swap, flt_fmt); - read_mat_binary_data (is, ctmp, prec, 1, swap, flt_fmt); - read_mat_binary_data (is, ctmp, prec, nr - 1, swap, flt_fmt); - - for (octave_idx_type i = 0; i < nr - 1; i++) - data.xelem (i) = Complex (dtmp[i], ctmp[i]); - read_mat_binary_data (is, ctmp, prec, 1, swap, flt_fmt); - - SparseComplexMatrix smc = SparseComplexMatrix (data, r, c, - nr_new, nc_new); - - tc = order ? smc.transpose () : smc; - } - else - { - octave_idx_type nr_new, nc_new; - Array data (dim_vector (1, nr - 1)); - Array c (dim_vector (1, nr - 1)); - Array r (dim_vector (1, nr - 1)); - OCTAVE_LOCAL_BUFFER (double, dtmp, nr); - - read_mat_binary_data (is, dtmp, prec, nr, swap, flt_fmt); - for (octave_idx_type i = 0; i < nr - 1; i++) - r.xelem (i) = dtmp[i] - 1; - nr_new = dtmp[nr - 1]; - read_mat_binary_data (is, dtmp, prec, nr, swap, flt_fmt); - for (octave_idx_type i = 0; i < nr - 1; i++) - c.xelem (i) = dtmp[i] - 1; - nc_new = dtmp[nr - 1]; - read_mat_binary_data (is, data.fortran_vec (), prec, nr - 1, swap, flt_fmt); - read_mat_binary_data (is, dtmp, prec, 1, swap, flt_fmt); - - SparseMatrix sm = SparseMatrix (data, r, c, nr_new, nc_new); - - tc = order ? sm.transpose () : sm; - } - } - else - { - re.resize (nr, nc); - - read_mat_binary_data (is, re.fortran_vec (), prec, dlen, swap, flt_fmt); - - if (! is || error_state) - { - error ("load: reading matrix data for '%s'", name); - goto data_read_error; - } - - if (imag) - { - Matrix im (nr, nc); - - read_mat_binary_data (is, im.fortran_vec (), prec, dlen, swap, - flt_fmt); - - if (! is || error_state) - { - error ("load: reading imaginary matrix data for '%s'", name); - goto data_read_error; - } - - ComplexMatrix ctmp (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - ctmp (i, j) = Complex (re (i, j), im (i, j)); - - tc = order ? ctmp.transpose () : ctmp; - } - else - tc = order ? re.transpose () : re; - - if (type == 1) - tc = tc.convert_to_str (false, true, '\''); - } - - return retval; - } - - data_read_error: - error ("load: trouble reading binary file '%s'", filename.c_str ()); - return retval; -} - -// Save the data from TC along with the corresponding NAME on stream OS -// in the MatLab version 4 binary format. - -bool -save_mat_binary_data (std::ostream& os, const octave_value& tc, - const std::string& name) -{ - int32_t mopt = 0; - - mopt += tc.is_sparse_type () ? 2 : tc.is_string () ? 1 : 0; - - oct_mach_info::float_format flt_fmt = - oct_mach_info::native_float_format ();; - - mopt += 1000 * float_format_to_mopt_digit (flt_fmt); - - os.write (reinterpret_cast (&mopt), 4); - - octave_idx_type len; - int32_t nr = tc.rows (); - - int32_t nc = tc.columns (); - - if (tc.is_sparse_type ()) - { - len = tc.nnz (); - uint32_t nnz = len + 1; - os.write (reinterpret_cast (&nnz), 4); - - uint32_t iscmplx = tc.is_complex_type () ? 4 : 3; - os.write (reinterpret_cast (&iscmplx), 4); - - uint32_t tmp = 0; - os.write (reinterpret_cast (&tmp), 4); - } - else - { - os.write (reinterpret_cast (&nr), 4); - os.write (reinterpret_cast (&nc), 4); - - int32_t imag = tc.is_complex_type () ? 1 : 0; - os.write (reinterpret_cast (&imag), 4); - - len = nr * nc; - } - - - // LEN includes the terminating character, and the file is also - // supposed to include it. - - int32_t name_len = name.length () + 1; - - os.write (reinterpret_cast (&name_len), 4); - os << name << '\0'; - - if (tc.is_string ()) - { - unwind_protect frame; - - charMatrix chm = tc.char_matrix_value (); - - octave_idx_type nrow = chm.rows (); - octave_idx_type ncol = chm.cols (); - - OCTAVE_LOCAL_BUFFER (double, buf, ncol*nrow); - - for (octave_idx_type i = 0; i < nrow; i++) - { - std::string tstr = chm.row_as_string (i); - const char *s = tstr.data (); - - for (octave_idx_type j = 0; j < ncol; j++) - buf[j*nrow+i] = static_cast (*s++ & 0x00FF); - } - os.write (reinterpret_cast (buf), nrow*ncol*sizeof (double)); - } - else if (tc.is_range ()) - { - Range r = tc.range_value (); - double base = r.base (); - double inc = r.inc (); - octave_idx_type nel = r.nelem (); - for (octave_idx_type i = 0; i < nel; i++) - { - double x = base + i * inc; - os.write (reinterpret_cast (&x), 8); - } - } - else if (tc.is_real_scalar ()) - { - double tmp = tc.double_value (); - os.write (reinterpret_cast (&tmp), 8); - } - else if (tc.is_sparse_type ()) - { - double ds; - OCTAVE_LOCAL_BUFFER (double, dtmp, len); - if (tc.is_complex_matrix ()) - { - SparseComplexMatrix m = tc.sparse_complex_matrix_value (); - - for (octave_idx_type i = 0; i < len; i++) - dtmp[i] = m.ridx (i) + 1; - os.write (reinterpret_cast (dtmp), 8 * len); - ds = nr; - os.write (reinterpret_cast (&ds), 8); - - octave_idx_type ii = 0; - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = m.cidx (j); i < m.cidx (j+1); i++) - dtmp[ii++] = j + 1; - os.write (reinterpret_cast (dtmp), 8 * len); - ds = nc; - os.write (reinterpret_cast (&ds), 8); - - for (octave_idx_type i = 0; i < len; i++) - dtmp[i] = std::real (m.data (i)); - os.write (reinterpret_cast (dtmp), 8 * len); - ds = 0.; - os.write (reinterpret_cast (&ds), 8); - - for (octave_idx_type i = 0; i < len; i++) - dtmp[i] = std::imag (m.data (i)); - os.write (reinterpret_cast (dtmp), 8 * len); - os.write (reinterpret_cast (&ds), 8); - } - else - { - SparseMatrix m = tc.sparse_matrix_value (); - - for (octave_idx_type i = 0; i < len; i++) - dtmp[i] = m.ridx (i) + 1; - os.write (reinterpret_cast (dtmp), 8 * len); - ds = nr; - os.write (reinterpret_cast (&ds), 8); - - octave_idx_type ii = 0; - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = m.cidx (j); i < m.cidx (j+1); i++) - dtmp[ii++] = j + 1; - os.write (reinterpret_cast (dtmp), 8 * len); - ds = nc; - os.write (reinterpret_cast (&ds), 8); - - os.write (reinterpret_cast (m.data ()), 8 * len); - ds = 0.; - os.write (reinterpret_cast (&ds), 8); - } - } - else if (tc.is_real_matrix ()) - { - Matrix m = tc.matrix_value (); - os.write (reinterpret_cast (m.data ()), 8 * len); - } - else if (tc.is_complex_scalar ()) - { - Complex tmp = tc.complex_value (); - os.write (reinterpret_cast (&tmp), 16); - } - else if (tc.is_complex_matrix ()) - { - ComplexMatrix m_cmplx = tc.complex_matrix_value (); - Matrix m = ::real (m_cmplx); - os.write (reinterpret_cast (m.data ()), 8 * len); - m = ::imag (m_cmplx); - os.write (reinterpret_cast (m.data ()), 8 * len); - } - else - gripe_wrong_type_arg ("save", tc, false); - - return os; -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/ls-mat4.h --- a/libinterp/interp-core/ls-mat4.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,45 +0,0 @@ -/* - -Copyright (C) 2003-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_ls_mat4_h) -#define octave_ls_mat4_h 1 - -extern oct_mach_info::float_format -mopt_digit_to_float_format (int mach); - -extern int -float_format_to_mopt_digit (oct_mach_info::float_format flt_fmt); - -extern int -read_mat_file_header (std::istream& is, bool& swap, int32_t& mopt, - int32_t& nr, int32_t& nc, int32_t& imag, - int32_t& len, int quiet = 0); - -extern std::string -read_mat_binary_data (std::istream& is, const std::string& filename, - octave_value& tc); - -extern bool -save_mat_binary_data (std::ostream& os, const octave_value& tc, - const std::string& name) ; - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/ls-mat5.cc --- a/libinterp/interp-core/ls-mat5.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2745 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Author: James R. Van Zandt - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include -#include -#include -#include -#include -#include - -#include "byte-swap.h" -#include "data-conv.h" -#include "file-ops.h" -#include "glob-match.h" -#include "lo-mappers.h" -#include "mach-info.h" -#include "oct-env.h" -#include "oct-time.h" -#include "quit.h" -#include "str-vec.h" -#include "file-stat.h" -#include "oct-locbuf.h" - -#include "Cell.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "load-save.h" -#include "load-path.h" -#include "oct-obj.h" -#include "oct-map.h" -#include "ov-cell.h" -#include "ov-class.h" -#include "ov-fcn-inline.h" -#include "pager.h" -#include "pt-exp.h" -#include "sysdep.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" -#include "version.h" -#include "dMatrix.h" - -#include "ls-utils.h" -#include "ls-mat5.h" - -#include "parse.h" -#include "defaults.h" - -#ifdef HAVE_ZLIB -#include -#endif - -#define READ_PAD(is_small_data_element, l) ((is_small_data_element) ? 4 : (((l)+7)/8)*8) -#define PAD(l) (((l) > 0 && (l) <= 4) ? 4 : (((l)+7)/8)*8) -#define INT8(l) ((l) == miINT8 || (l) == miUINT8 || (l) == miUTF8) - - -// The subsystem data block -static octave_value subsys_ov; - -// FIXME -- the following enum values should be the same as the -// mxClassID values in mexproto.h, but it seems they have also changed -// over time. What is the correct way to handle this and maintain -// backward compatibility with old MAT files? For now, use -// "MAT_FILE_" instead of "mx" as the prefix for these names to avoid -// conflict with the mxClassID enum in mexproto.h. - -enum arrayclasstype - { - MAT_FILE_CELL_CLASS=1, // cell array - MAT_FILE_STRUCT_CLASS, // structure - MAT_FILE_OBJECT_CLASS, // object - MAT_FILE_CHAR_CLASS, // character array - MAT_FILE_SPARSE_CLASS, // sparse array - MAT_FILE_DOUBLE_CLASS, // double precision array - MAT_FILE_SINGLE_CLASS, // single precision floating point - MAT_FILE_INT8_CLASS, // 8 bit signed integer - MAT_FILE_UINT8_CLASS, // 8 bit unsigned integer - MAT_FILE_INT16_CLASS, // 16 bit signed integer - MAT_FILE_UINT16_CLASS, // 16 bit unsigned integer - MAT_FILE_INT32_CLASS, // 32 bit signed integer - MAT_FILE_UINT32_CLASS, // 32 bit unsigned integer - MAT_FILE_INT64_CLASS, // 64 bit signed integer - MAT_FILE_UINT64_CLASS, // 64 bit unsigned integer - MAT_FILE_FUNCTION_CLASS, // Function handle - MAT_FILE_WORKSPACE_CLASS // Workspace (undocumented) - }; - -// Read COUNT elements of data from IS in the format specified by TYPE, -// placing the result in DATA. If SWAP is TRUE, swap the bytes of -// each element before copying to DATA. FLT_FMT specifies the format -// of the data if we are reading floating point numbers. - -static void -read_mat5_binary_data (std::istream& is, double *data, - octave_idx_type count, bool swap, mat5_data_type type, - oct_mach_info::float_format flt_fmt) -{ - - switch (type) - { - case miINT8: - read_doubles (is, data, LS_CHAR, count, swap, flt_fmt); - break; - - case miUTF8: - case miUINT8: - read_doubles (is, data, LS_U_CHAR, count, swap, flt_fmt); - break; - - case miINT16: - read_doubles (is, data, LS_SHORT, count, swap, flt_fmt); - break; - - case miUTF16: - case miUINT16: - read_doubles (is, data, LS_U_SHORT, count, swap, flt_fmt); - break; - - case miINT32: - read_doubles (is, data, LS_INT, count, swap, flt_fmt); - break; - - case miUTF32: - case miUINT32: - read_doubles (is, data, LS_U_INT, count, swap, flt_fmt); - break; - - case miSINGLE: - read_doubles (is, data, LS_FLOAT, count, swap, flt_fmt); - break; - - case miRESERVE1: - break; - - case miDOUBLE: - read_doubles (is, data, LS_DOUBLE, count, swap, flt_fmt); - break; - - case miRESERVE2: - case miRESERVE3: - break; - - // FIXME -- how are the 64-bit cases supposed to work here? - case miINT64: - read_doubles (is, data, LS_LONG, count, swap, flt_fmt); - break; - - case miUINT64: - read_doubles (is, data, LS_U_LONG, count, swap, flt_fmt); - break; - - case miMATRIX: - default: - break; - } -} - -static void -read_mat5_binary_data (std::istream& is, float *data, - octave_idx_type count, bool swap, mat5_data_type type, - oct_mach_info::float_format flt_fmt) -{ - - switch (type) - { - case miINT8: - read_floats (is, data, LS_CHAR, count, swap, flt_fmt); - break; - - case miUTF8: - case miUINT8: - read_floats (is, data, LS_U_CHAR, count, swap, flt_fmt); - break; - - case miINT16: - read_floats (is, data, LS_SHORT, count, swap, flt_fmt); - break; - - case miUTF16: - case miUINT16: - read_floats (is, data, LS_U_SHORT, count, swap, flt_fmt); - break; - - case miINT32: - read_floats (is, data, LS_INT, count, swap, flt_fmt); - break; - - case miUTF32: - case miUINT32: - read_floats (is, data, LS_U_INT, count, swap, flt_fmt); - break; - - case miSINGLE: - read_floats (is, data, LS_FLOAT, count, swap, flt_fmt); - break; - - case miRESERVE1: - break; - - case miDOUBLE: - read_floats (is, data, LS_DOUBLE, count, swap, flt_fmt); - break; - - case miRESERVE2: - case miRESERVE3: - break; - - // FIXME -- how are the 64-bit cases supposed to work here? - case miINT64: - read_floats (is, data, LS_LONG, count, swap, flt_fmt); - break; - - case miUINT64: - read_floats (is, data, LS_U_LONG, count, swap, flt_fmt); - break; - - case miMATRIX: - default: - break; - } -} - -template -void -read_mat5_integer_data (std::istream& is, T *m, octave_idx_type count, - bool swap, mat5_data_type type) -{ - -#define READ_INTEGER_DATA(TYPE, swap, data, size, len, stream) \ - do \ - { \ - if (len > 0) \ - { \ - OCTAVE_LOCAL_BUFFER (TYPE, ptr, len); \ - stream.read (reinterpret_cast (ptr), size * len); \ - if (swap) \ - swap_bytes< size > (ptr, len); \ - for (octave_idx_type i = 0; i < len; i++) \ - data[i] = ptr[i]; \ - } \ - } \ - while (0) - - switch (type) - { - case miINT8: - READ_INTEGER_DATA (int8_t, swap, m, 1, count, is); - break; - - case miUINT8: - READ_INTEGER_DATA (uint8_t, swap, m, 1, count, is); - break; - - case miINT16: - READ_INTEGER_DATA (int16_t, swap, m, 2, count, is); - break; - - case miUINT16: - READ_INTEGER_DATA (uint16_t, swap, m, 2, count, is); - break; - - case miINT32: - READ_INTEGER_DATA (int32_t, swap, m, 4, count, is); - break; - - case miUINT32: - READ_INTEGER_DATA (uint32_t, swap, m, 4, count, is); - break; - - case miSINGLE: - case miRESERVE1: - case miDOUBLE: - case miRESERVE2: - case miRESERVE3: - break; - - case miINT64: - READ_INTEGER_DATA (int64_t, swap, m, 8, count, is); - break; - - case miUINT64: - READ_INTEGER_DATA (uint64_t, swap, m, 8, count, is); - break; - - case miMATRIX: - default: - break; - } - -#undef READ_INTEGER_DATA - -} - -template void -read_mat5_integer_data (std::istream& is, octave_int8 *m, - octave_idx_type count, bool swap, - mat5_data_type type); - -template void -read_mat5_integer_data (std::istream& is, octave_int16 *m, - octave_idx_type count, bool swap, - mat5_data_type type); - -template void -read_mat5_integer_data (std::istream& is, octave_int32 *m, - octave_idx_type count, bool swap, - mat5_data_type type); - -template void -read_mat5_integer_data (std::istream& is, octave_int64 *m, - octave_idx_type count, bool swap, - mat5_data_type type); - -template void -read_mat5_integer_data (std::istream& is, octave_uint8 *m, - octave_idx_type count, bool swap, - mat5_data_type type); - -template void -read_mat5_integer_data (std::istream& is, octave_uint16 *m, - octave_idx_type count, bool swap, - mat5_data_type type); - -template void -read_mat5_integer_data (std::istream& is, octave_uint32 *m, - octave_idx_type count, bool swap, - mat5_data_type type); - -template void -read_mat5_integer_data (std::istream& is, octave_uint64 *m, - octave_idx_type count, bool swap, - mat5_data_type type); - -template void -read_mat5_integer_data (std::istream& is, int *m, - octave_idx_type count, bool swap, - mat5_data_type type); - -#define OCTAVE_MAT5_INTEGER_READ(TYP) \ - { \ - TYP re (dims); \ - \ - std::streampos tmp_pos; \ - \ - if (read_mat5_tag (is, swap, type, len, is_small_data_element)) \ - { \ - error ("load: reading matrix data for '%s'", retval.c_str ()); \ - goto data_read_error; \ - } \ - \ - octave_idx_type n = re.numel (); \ - tmp_pos = is.tellg (); \ - read_mat5_integer_data (is, re.fortran_vec (), n, swap, \ - static_cast (type)); \ - \ - if (! is || error_state) \ - { \ - error ("load: reading matrix data for '%s'", retval.c_str ()); \ - goto data_read_error; \ - } \ - \ - is.seekg (tmp_pos + static_cast\ - (READ_PAD (is_small_data_element, len))); \ - \ - if (imag) \ - { \ - /* We don't handle imag integer types, convert to an array */ \ - NDArray im (dims); \ - \ - if (read_mat5_tag (is, swap, type, len, is_small_data_element)) \ - { \ - error ("load: reading matrix data for '%s'", \ - retval.c_str ()); \ - goto data_read_error; \ - } \ - \ - n = im.numel (); \ - read_mat5_binary_data (is, im.fortran_vec (), n, swap, \ - static_cast (type), flt_fmt); \ - \ - if (! is || error_state) \ - { \ - error ("load: reading imaginary matrix data for '%s'", \ - retval.c_str ()); \ - goto data_read_error; \ - } \ - \ - ComplexNDArray ctmp (dims); \ - \ - for (octave_idx_type i = 0; i < n; i++) \ - ctmp(i) = Complex (re(i).double_value (), im(i)); \ - \ - tc = ctmp; \ - } \ - else \ - tc = re; \ - } - -// Read one element tag from stream IS, -// place the type code in TYPE, the byte count in BYTES and true (false) to -// IS_SMALL_DATA_ELEMENT if the tag is 4 (8) bytes long. -// return nonzero on error -static int -read_mat5_tag (std::istream& is, bool swap, int32_t& type, int32_t& bytes, - bool& is_small_data_element) -{ - unsigned int upper; - int32_t temp; - - if (! is.read (reinterpret_cast (&temp), 4 )) - goto data_read_error; - - if (swap) - swap_bytes<4> (&temp); - - upper = (temp >> 16) & 0xffff; - type = temp & 0xffff; - - if (upper) - { - // "compressed" format - bytes = upper; - is_small_data_element = true; - } - else - { - if (! is.read (reinterpret_cast (&temp), 4 )) - goto data_read_error; - if (swap) - swap_bytes<4> (&temp); - bytes = temp; - is_small_data_element = false; - } - - return 0; - - data_read_error: - return 1; -} - -static void -read_int (std::istream& is, bool swap, int32_t& val) -{ - is.read (reinterpret_cast (&val), 4); - - if (swap) - swap_bytes<4> (&val); -} - -// Extract one data element (scalar, matrix, string, etc.) from stream -// IS and place it in TC, returning the name of the variable. -// -// The data is expected to be in Matlab's "Version 5" .mat format, -// though not all the features of that format are supported. -// -// FILENAME is used for error messages. - -std::string -read_mat5_binary_element (std::istream& is, const std::string& filename, - bool swap, bool& global, octave_value& tc) -{ - std::string retval; - - global = false; - - // NOTE: these are initialized here instead of closer to where they - // are first used to avoid errors from gcc about goto crossing - // initialization of variable. - - bool imag; - bool isclass = false; - bool logicalvar; - dim_vector dims; - enum arrayclasstype arrayclass; - int16_t number = *(reinterpret_cast("\x00\x01")); - octave_idx_type nzmax; - std::string classname; - - // MAT files always use IEEE floating point - oct_mach_info::float_format flt_fmt = oct_mach_info::flt_fmt_unknown; - if ((number == 1) ^ swap) - flt_fmt = oct_mach_info::flt_fmt_ieee_big_endian; - else - flt_fmt = oct_mach_info::flt_fmt_ieee_little_endian; - - // element type, length and small data element flag - int32_t type = 0; - int32_t element_length; - bool is_small_data_element; - if (read_mat5_tag (is, swap, type, element_length, is_small_data_element)) - return retval; // EOF - - if (type == miCOMPRESSED) - { -#ifdef HAVE_ZLIB - // If C++ allowed us direct access to the file descriptor of an - // ifstream in a uniform way, the code below could be vastly - // simplified, and additional copies of the data in memory - // wouldn't be needed. - - OCTAVE_LOCAL_BUFFER (char, inbuf, element_length); - is.read (inbuf, element_length); - - // We uncompress the first 8 bytes of the header to get the buffer length - // This will fail with an error Z_MEM_ERROR - uLongf destLen = 8; - OCTAVE_LOCAL_BUFFER (unsigned int, tmp, 2); - if (uncompress (reinterpret_cast (tmp), &destLen, - reinterpret_cast (inbuf), element_length) - != Z_MEM_ERROR) - { - // Why should I have to initialize outbuf as I'll just overwrite!! - if (swap) - swap_bytes<4> (tmp, 2); - - destLen = tmp[1] + 8; - std::string outbuf (destLen, ' '); - - // FIXME -- find a way to avoid casting away const here! - - int err = uncompress (reinterpret_cast (const_cast (outbuf.c_str ())), - &destLen, reinterpret_cast (inbuf), - element_length); - - if (err != Z_OK) - { - std::string msg; - switch (err) - { - case Z_STREAM_END: - msg = "stream end"; - break; - - case Z_NEED_DICT: - msg = "need dict"; - break; - - case Z_ERRNO: - msg = "errno case"; - break; - - case Z_STREAM_ERROR: - msg = "stream error"; - break; - - case Z_DATA_ERROR: - msg = "data error"; - break; - - case Z_MEM_ERROR: - msg = "mem error"; - break; - - case Z_BUF_ERROR: - msg = "buf error"; - break; - - case Z_VERSION_ERROR: - msg = "version error"; - break; - } - - error ("load: error uncompressing data element (%s from zlib)", - msg.c_str ()); - } - else - { - std::istringstream gz_is (outbuf); - retval = read_mat5_binary_element (gz_is, filename, - swap, global, tc); - } - } - else - error ("load: error probing size of compressed data element"); - - return retval; -#else // HAVE_ZLIB - error ("load: zlib unavailable, cannot read compressed data element"); -#endif - } - - std::streampos pos; - - if (type != miMATRIX) - { - pos = is.tellg (); - error ("load: invalid element type = %d", type); - goto early_read_error; - } - - if (element_length == 0) - { - tc = Matrix (); - return retval; - } - - pos = is.tellg (); - - // array flags subelement - int32_t len; - if (read_mat5_tag (is, swap, type, len, is_small_data_element) || - type != miUINT32 || len != 8 || is_small_data_element) - { - error ("load: invalid array flags subelement"); - goto early_read_error; - } - - int32_t flags; - read_int (is, swap, flags); - - imag = (flags & 0x0800) != 0; // has an imaginary part? - - global = (flags & 0x0400) != 0; // global variable? - - logicalvar = (flags & 0x0200) != 0; // boolean ? - - arrayclass = static_cast (flags & 0xff); - - int32_t tmp_nzmax; - read_int (is, swap, tmp_nzmax); // max number of non-zero in sparse - nzmax = tmp_nzmax; - - // dimensions array subelement - if (arrayclass != MAT_FILE_WORKSPACE_CLASS) - { - int32_t dim_len; - - if (read_mat5_tag (is, swap, type, dim_len, is_small_data_element) || - type != miINT32) - { - error ("load: invalid dimensions array subelement"); - goto early_read_error; - } - - int ndims = dim_len / 4; - dims.resize (ndims); - for (int i = 0; i < ndims; i++) - { - int32_t n; - read_int (is, swap, n); - dims(i) = n; - } - - std::streampos tmp_pos = is.tellg (); - is.seekg (tmp_pos + static_cast - (READ_PAD (is_small_data_element, dim_len) - dim_len)); - } - else - { - // Why did mathworks decide to not have dims for a workspace!!! - dims.resize (2); - dims(0) = 1; - dims(1) = 1; - } - - if (read_mat5_tag (is, swap, type, len, is_small_data_element) || !INT8(type)) - { - error ("load: invalid array name subelement"); - goto early_read_error; - } - - { - OCTAVE_LOCAL_BUFFER (char, name, len+1); - - // Structure field subelements have zero-length array name subelements. - - std::streampos tmp_pos = is.tellg (); - - if (len) - { - if (! is.read (name, len )) - goto data_read_error; - - is.seekg (tmp_pos + static_cast - (READ_PAD (is_small_data_element, len))); - } - - name[len] = '\0'; - retval = name; - } - - switch (arrayclass) - { - case MAT_FILE_CELL_CLASS: - { - Cell cell_array (dims); - - octave_idx_type n = cell_array.numel (); - - for (octave_idx_type i = 0; i < n; i++) - { - octave_value tc2; - - std::string nm - = read_mat5_binary_element (is, filename, swap, global, tc2); - - if (! is || error_state) - { - error ("load: reading cell data for '%s'", nm.c_str ()); - goto data_read_error; - } - - cell_array(i) = tc2; - } - - tc = cell_array; - } - break; - - case MAT_FILE_SPARSE_CLASS: - { - octave_idx_type nr = dims(0); - octave_idx_type nc = dims(1); - SparseMatrix sm; - SparseComplexMatrix scm; - octave_idx_type *ridx; - octave_idx_type *cidx; - double *data; - - // Setup return value - if (imag) - { - scm = SparseComplexMatrix (nr, nc, nzmax); - ridx = scm.ridx (); - cidx = scm.cidx (); - data = 0; - } - else - { - sm = SparseMatrix (nr, nc, nzmax); - ridx = sm.ridx (); - cidx = sm.cidx (); - data = sm.data (); - } - - // row indices - std::streampos tmp_pos; - - if (read_mat5_tag (is, swap, type, len, is_small_data_element)) - { - error ("load: reading sparse row data for '%s'", retval.c_str ()); - goto data_read_error; - } - - tmp_pos = is.tellg (); - - read_mat5_integer_data (is, ridx, nzmax, swap, - static_cast (type)); - - if (! is || error_state) - { - error ("load: reading sparse row data for '%s'", retval.c_str ()); - goto data_read_error; - } - - is.seekg (tmp_pos + static_cast - (READ_PAD (is_small_data_element, len))); - - // col indices - if (read_mat5_tag (is, swap, type, len, is_small_data_element)) - { - error ("load: reading sparse column data for '%s'", retval.c_str ()); - goto data_read_error; - } - - tmp_pos = is.tellg (); - - read_mat5_integer_data (is, cidx, nc + 1, swap, - static_cast (type)); - - if (! is || error_state) - { - error ("load: reading sparse column data for '%s'", retval.c_str ()); - goto data_read_error; - } - - is.seekg (tmp_pos + static_cast - (READ_PAD (is_small_data_element, len))); - - // real data subelement - if (read_mat5_tag (is, swap, type, len, is_small_data_element)) - { - error ("load: reading sparse matrix data for '%s'", retval.c_str ()); - goto data_read_error; - } - - octave_idx_type nnz = cidx[nc]; - NDArray re; - if (imag) - { - re = NDArray (dim_vector (nnz, 1)); - data = re.fortran_vec (); - } - - tmp_pos = is.tellg (); - read_mat5_binary_data (is, data, nnz, swap, - static_cast (type), flt_fmt); - - if (! is || error_state) - { - error ("load: reading sparse matrix data for '%s'", retval.c_str ()); - goto data_read_error; - } - - is.seekg (tmp_pos + static_cast - (READ_PAD (is_small_data_element, len))); - - // imaginary data subelement - if (imag) - { - NDArray im (dim_vector (static_cast (nnz), 1)); - - if (read_mat5_tag (is, swap, type, len, is_small_data_element)) - { - error ("load: reading sparse matrix data for '%s'", retval.c_str ()); - goto data_read_error; - } - - read_mat5_binary_data (is, im.fortran_vec (), nnz, swap, - static_cast (type), flt_fmt); - - if (! is || error_state) - { - error ("load: reading imaginary sparse matrix data for '%s'", - retval.c_str ()); - goto data_read_error; - } - - for (octave_idx_type i = 0; i < nnz; i++) - scm.xdata (i) = Complex (re (i), im (i)); - - tc = scm; - } - else - tc = sm; - } - break; - - case MAT_FILE_FUNCTION_CLASS: - { - octave_value tc2; - std::string nm - = read_mat5_binary_element (is, filename, swap, global, tc2); - - if (! is || error_state) - goto data_read_error; - - // Octave can handle both "/" and "\" as a directory seperator - // and so can ignore the separator field of m0. I think the - // sentinel field is also save to ignore. - octave_scalar_map m0 = tc2.scalar_map_value (); - octave_scalar_map m1 = m0.contents ("function_handle").scalar_map_value (); - std::string ftype = m1.contents ("type").string_value (); - std::string fname = m1.contents ("function").string_value (); - std::string fpath = m1.contents ("file").string_value (); - - if (ftype == "simple" || ftype == "scopedfunction") - { - if (fpath.length () == 0) - // We have a builtin function - tc = make_fcn_handle (fname); - else - { - std::string mroot = - m0.contents ("matlabroot").string_value (); - - if ((fpath.length () >= mroot.length ()) && - fpath.substr (0, mroot.length ()) == mroot && - OCTAVE_EXEC_PREFIX != mroot) - { - // If fpath starts with matlabroot, and matlabroot - // doesn't equal octave_config_info ("exec_prefix") - // then the function points to a version of Octave - // or Matlab other than the running version. In that - // case we replace with the same function in the - // running version of Octave? - - // First check if just replacing matlabroot is enough - std::string str = OCTAVE_EXEC_PREFIX + - fpath.substr (mroot.length ()); - file_stat fs (str); - - if (fs.exists ()) - { - size_t xpos - = str.find_last_of (file_ops::dir_sep_chars ()); - - std::string dir_name = str.substr (0, xpos); - - octave_function *fcn - = load_fcn_from_file (str, dir_name, "", fname); - - if (fcn) - { - octave_value tmp (fcn); - - tc = octave_value (new octave_fcn_handle (tmp, fname)); - } - } - else - { - // Next just search for it anywhere in the system path - string_vector names(3); - names(0) = fname + ".oct"; - names(1) = fname + ".mex"; - names(2) = fname + ".m"; - - dir_path p (load_path::system_path ()); - - str = octave_env::make_absolute (p.find_first_of (names)); - - size_t xpos - = str.find_last_of (file_ops::dir_sep_chars ()); - - std::string dir_name = str.substr (0, xpos); - - octave_function *fcn - = load_fcn_from_file (str, dir_name, "", fname); - - if (fcn) - { - octave_value tmp (fcn); - - tc = octave_value (new octave_fcn_handle (tmp, fname)); - } - else - { - warning ("load: can't find the file %s", - fpath.c_str ()); - goto skip_ahead; - } - } - } - else - { - size_t xpos - = fpath.find_last_of (file_ops::dir_sep_chars ()); - - std::string dir_name = fpath.substr (0, xpos); - - octave_function *fcn - = load_fcn_from_file (fpath, dir_name, "", fname); - - if (fcn) - { - octave_value tmp (fcn); - - tc = octave_value (new octave_fcn_handle (tmp, fname)); - } - else - { - warning ("load: can't find the file %s", - fpath.c_str ()); - goto skip_ahead; - } - } - } - } - else if (ftype == "nested") - { - warning ("load: can't load nested function"); - goto skip_ahead; - } - else if (ftype == "anonymous") - { - octave_scalar_map m2 = m1.contents ("workspace").scalar_map_value (); - uint32NDArray MCOS = m2.contents ("MCOS").uint32_array_value (); - octave_idx_type off = static_cast(MCOS(4).double_value ()); - m2 = subsys_ov.scalar_map_value (); - m2 = m2.contents ("MCOS").scalar_map_value (); - tc2 = m2.contents ("MCOS").cell_value ()(1 + off).cell_value ()(1); - m2 = tc2.scalar_map_value (); - - unwind_protect_safe frame; - - // Set up temporary scope to use for evaluating the text - // that defines the anonymous function. - - symbol_table::scope_id local_scope = symbol_table::alloc_scope (); - frame.add_fcn (symbol_table::erase_scope, local_scope); - - symbol_table::set_scope (local_scope); - - octave_call_stack::push (local_scope, 0); - frame.add_fcn (octave_call_stack::pop); - - if (m2.nfields () > 0) - { - octave_value tmp; - - for (octave_map::iterator p0 = m2.begin () ; - p0 != m2.end (); p0++) - { - std::string key = m2.key (p0); - octave_value val = m2.contents (p0); - - symbol_table::assign (key, val, local_scope, 0); - } - } - - int parse_status; - octave_value anon_fcn_handle = - eval_string (fname.substr (4), true, parse_status); - - if (parse_status == 0) - { - octave_fcn_handle *fh = - anon_fcn_handle.fcn_handle_value (); - - if (fh) - tc = new octave_fcn_handle (fh->fcn_val (), "@"); - else - { - error ("load: failed to load anonymous function handle"); - goto skip_ahead; - } - } - else - { - error ("load: failed to load anonymous function handle"); - goto skip_ahead; - } - - frame.run (); - } - else - { - error ("load: invalid function handle type"); - goto skip_ahead; - } - } - break; - - case MAT_FILE_WORKSPACE_CLASS: - { - octave_map m (dim_vector (1, 1)); - int n_fields = 2; - string_vector field (n_fields); - - for (int i = 0; i < n_fields; i++) - { - int32_t fn_type; - int32_t fn_len; - if (read_mat5_tag (is, swap, fn_type, fn_len, is_small_data_element) - || !INT8(fn_type)) - { - error ("load: invalid field name subelement"); - goto data_read_error; - } - - OCTAVE_LOCAL_BUFFER (char, elname, fn_len + 1); - - std::streampos tmp_pos = is.tellg (); - - if (fn_len) - { - if (! is.read (elname, fn_len)) - goto data_read_error; - - is.seekg (tmp_pos + static_cast - (READ_PAD (is_small_data_element, fn_len))); - } - - elname[fn_len] = '\0'; - - field(i) = elname; - } - - std::vector elt (n_fields); - - for (octave_idx_type i = 0; i < n_fields; i++) - elt[i] = Cell (dims); - - octave_idx_type n = dims.numel (); - - // fields subelements - for (octave_idx_type j = 0; j < n; j++) - { - for (octave_idx_type i = 0; i < n_fields; i++) - { - if (field(i) == "MCOS") - { - octave_value fieldtc; - read_mat5_binary_element (is, filename, swap, global, - fieldtc); - if (! is || error_state) - goto data_read_error; - - elt[i](j) = fieldtc; - } - else - elt[i](j) = octave_value (); - } - } - - for (octave_idx_type i = 0; i < n_fields; i++) - m.assign (field (i), elt[i]); - tc = m; - } - break; - - case MAT_FILE_OBJECT_CLASS: - { - isclass = true; - - if (read_mat5_tag (is, swap, type, len, is_small_data_element) || - !INT8(type)) - { - error ("load: invalid class name"); - goto skip_ahead; - } - - { - OCTAVE_LOCAL_BUFFER (char, name, len+1); - - std::streampos tmp_pos = is.tellg (); - - if (len) - { - if (! is.read (name, len )) - goto data_read_error; - - is.seekg (tmp_pos + static_cast - (READ_PAD (is_small_data_element, len))); - } - - name[len] = '\0'; - classname = name; - } - } - // Fall-through - case MAT_FILE_STRUCT_CLASS: - { - octave_map m (dims); - int32_t fn_type; - int32_t fn_len; - int32_t field_name_length; - - // field name length subelement -- actually the maximum length - // of a field name. The Matlab docs promise this will always - // be 32. We read and use the actual value, on the theory - // that eventually someone will recognize that's a waste of space. - if (read_mat5_tag (is, swap, fn_type, fn_len, is_small_data_element) - || fn_type != miINT32) - { - error ("load: invalid field name length subelement"); - goto data_read_error; - } - - if (! is.read (reinterpret_cast (&field_name_length), fn_len )) - goto data_read_error; - - if (swap) - swap_bytes<4> (&field_name_length); - - // field name subelement. The length of this subelement tells - // us how many fields there are. - if (read_mat5_tag (is, swap, fn_type, fn_len, is_small_data_element) - || !INT8(fn_type)) - { - error ("load: invalid field name subelement"); - goto data_read_error; - } - - octave_idx_type n_fields = fn_len/field_name_length; - - if (n_fields > 0) - { - fn_len = READ_PAD (is_small_data_element, fn_len); - - OCTAVE_LOCAL_BUFFER (char, elname, fn_len); - - if (! is.read (elname, fn_len)) - goto data_read_error; - - std::vector elt (n_fields); - - for (octave_idx_type i = 0; i < n_fields; i++) - elt[i] = Cell (dims); - - octave_idx_type n = dims.numel (); - - // fields subelements - for (octave_idx_type j = 0; j < n; j++) - { - for (octave_idx_type i = 0; i < n_fields; i++) - { - octave_value fieldtc; - read_mat5_binary_element (is, filename, swap, global, - fieldtc); - elt[i](j) = fieldtc; - } - } - - for (octave_idx_type i = 0; i < n_fields; i++) - { - const char *key = elname + i*field_name_length; - - m.assign (key, elt[i]); - } - } - - if (isclass) - { - if (classname == "inline") - { - // inline is not an object in Octave but rather an - // overload of a function handle. Special case. - tc = - new octave_fcn_inline (m.contents ("expr")(0).string_value (), - m.contents ("args")(0).string_value ()); - } - else - { - octave_class* cls - = new octave_class (m, classname, - std::list ()); - - if (cls->reconstruct_exemplar ()) - { - - if (! cls->reconstruct_parents ()) - warning ("load: unable to reconstruct object inheritance"); - - tc = cls; - if (load_path::find_method (classname, "loadobj") != - std::string ()) - { - octave_value_list tmp = feval ("loadobj", tc, 1); - - if (! error_state) - tc = tmp(0); - else - goto data_read_error; - } - } - else - { - tc = m; - warning ("load: element has been converted to a structure"); - } - } - } - else - tc = m; - } - break; - - case MAT_FILE_INT8_CLASS: - OCTAVE_MAT5_INTEGER_READ (int8NDArray); - break; - - case MAT_FILE_UINT8_CLASS: - { - OCTAVE_MAT5_INTEGER_READ (uint8NDArray); - - // Logical variables can either be MAT_FILE_UINT8_CLASS or - // MAT_FILE_DOUBLE_CLASS, so check if we have a logical - // variable and convert it. - - if (logicalvar) - { - uint8NDArray in = tc.uint8_array_value (); - octave_idx_type nel = in.numel (); - boolNDArray out (dims); - - for (octave_idx_type i = 0; i < nel; i++) - out(i) = in(i).bool_value (); - - tc = out; - } - } - break; - - case MAT_FILE_INT16_CLASS: - OCTAVE_MAT5_INTEGER_READ (int16NDArray); - break; - - case MAT_FILE_UINT16_CLASS: - OCTAVE_MAT5_INTEGER_READ (uint16NDArray); - break; - - case MAT_FILE_INT32_CLASS: - OCTAVE_MAT5_INTEGER_READ (int32NDArray); - break; - - case MAT_FILE_UINT32_CLASS: - OCTAVE_MAT5_INTEGER_READ (uint32NDArray); - break; - - case MAT_FILE_INT64_CLASS: - OCTAVE_MAT5_INTEGER_READ (int64NDArray); - break; - - case MAT_FILE_UINT64_CLASS: - OCTAVE_MAT5_INTEGER_READ (uint64NDArray); - break; - - - case MAT_FILE_SINGLE_CLASS: - { - FloatNDArray re (dims); - - // real data subelement - - std::streampos tmp_pos; - - if (read_mat5_tag (is, swap, type, len, is_small_data_element)) - { - error ("load: reading matrix data for '%s'", retval.c_str ()); - goto data_read_error; - } - - octave_idx_type n = re.numel (); - tmp_pos = is.tellg (); - read_mat5_binary_data (is, re.fortran_vec (), n, swap, - static_cast (type), flt_fmt); - - if (! is || error_state) - { - error ("load: reading matrix data for '%s'", retval.c_str ()); - goto data_read_error; - } - - is.seekg (tmp_pos + static_cast - (READ_PAD (is_small_data_element, len))); - - if (imag) - { - // imaginary data subelement - - FloatNDArray im (dims); - - if (read_mat5_tag (is, swap, type, len, is_small_data_element)) - { - error ("load: reading matrix data for '%s'", retval.c_str ()); - goto data_read_error; - } - - n = im.numel (); - read_mat5_binary_data (is, im.fortran_vec (), n, swap, - static_cast (type), flt_fmt); - - if (! is || error_state) - { - error ("load: reading imaginary matrix data for '%s'", - retval.c_str ()); - goto data_read_error; - } - - FloatComplexNDArray ctmp (dims); - - for (octave_idx_type i = 0; i < n; i++) - ctmp(i) = FloatComplex (re(i), im(i)); - - tc = ctmp; - } - else - tc = re; - } - break; - - case MAT_FILE_CHAR_CLASS: - // handle as a numerical array to start with - - case MAT_FILE_DOUBLE_CLASS: - default: - { - NDArray re (dims); - - // real data subelement - - std::streampos tmp_pos; - - if (read_mat5_tag (is, swap, type, len, is_small_data_element)) - { - error ("load: reading matrix data for '%s'", retval.c_str ()); - goto data_read_error; - } - - octave_idx_type n = re.numel (); - tmp_pos = is.tellg (); - read_mat5_binary_data (is, re.fortran_vec (), n, swap, - static_cast (type), flt_fmt); - - if (! is || error_state) - { - error ("load: reading matrix data for '%s'", retval.c_str ()); - goto data_read_error; - } - - is.seekg (tmp_pos + static_cast - (READ_PAD (is_small_data_element, len))); - - if (logicalvar) - { - // Logical variables can either be MAT_FILE_UINT8_CLASS or - // MAT_FILE_DOUBLE_CLASS, so check if we have a logical - // variable and convert it. - - boolNDArray out (dims); - - for (octave_idx_type i = 0; i < n; i++) - out (i) = static_cast (re (i)); - - tc = out; - } - else if (imag) - { - // imaginary data subelement - - NDArray im (dims); - - if (read_mat5_tag (is, swap, type, len, is_small_data_element)) - { - error ("load: reading matrix data for '%s'", retval.c_str ()); - goto data_read_error; - } - - n = im.numel (); - read_mat5_binary_data (is, im.fortran_vec (), n, swap, - static_cast (type), flt_fmt); - - if (! is || error_state) - { - error ("load: reading imaginary matrix data for '%s'", - retval.c_str ()); - goto data_read_error; - } - - ComplexNDArray ctmp (dims); - - for (octave_idx_type i = 0; i < n; i++) - ctmp(i) = Complex (re(i), im(i)); - - tc = ctmp; - } - else - { - if (arrayclass == MAT_FILE_CHAR_CLASS) - { - if (type == miUTF16 || type == miUTF32) - { - bool found_big_char = false; - for (octave_idx_type i = 0; i < n; i++) - { - if (re(i) > 127) { - re(i) = '?'; - found_big_char = true; - } - } - - if (found_big_char) - warning ("load: can not read non-ASCII portions of UTF characters; replacing unreadable characters with '?'"); - } - else if (type == miUTF8) - { - // Search for multi-byte encoded UTF8 characters and - // replace with 0x3F for '?'... Give the user a warning - - bool utf8_multi_byte = false; - for (octave_idx_type i = 0; i < n; i++) - { - unsigned char a = static_cast (re(i)); - if (a > 0x7f) - utf8_multi_byte = true; - } - - if (utf8_multi_byte) - { - warning ("load: can not read multi-byte encoded UTF8 characters; replacing unreadable characters with '?'"); - for (octave_idx_type i = 0; i < n; i++) - { - unsigned char a = static_cast (re(i)); - if (a > 0x7f) - re(i) = '?'; - } - } - } - tc = re; - tc = tc.convert_to_str (false, true, '\''); - } - else - tc = re; - } - } - } - - is.seekg (pos + static_cast (element_length)); - - if (is.eof ()) - is.clear (); - - return retval; - - data_read_error: - early_read_error: - error ("load: trouble reading binary file '%s'", filename.c_str ()); - return std::string (); - - skip_ahead: - warning ("skipping over '%s'", retval.c_str ()); - is.seekg (pos + static_cast (element_length)); - return read_mat5_binary_element (is, filename, swap, global, tc); -} - -int -read_mat5_binary_file_header (std::istream& is, bool& swap, bool quiet, - const std::string& filename) -{ - int16_t version=0, magic=0; - uint64_t subsys_offset; - - is.seekg (116, std::ios::beg); - is.read (reinterpret_cast (&subsys_offset), 8); - - is.seekg (124, std::ios::beg); - is.read (reinterpret_cast (&version), 2); - is.read (reinterpret_cast (&magic), 2); - - if (magic == 0x4d49) - swap = 0; - else if (magic == 0x494d) - swap = 1; - else - { - if (! quiet) - error ("load: can't read binary file"); - return -1; - } - - if (! swap) // version number is inverse swapped! - version = ((version >> 8) & 0xff) + ((version & 0xff) << 8); - - if (version != 1 && !quiet) - warning ("load: found version %d binary MAT file, " - "but only prepared for version 1", version); - - if (swap) - swap_bytes<8> (&subsys_offset, 1); - - if (subsys_offset != 0x2020202020202020ULL && subsys_offset != 0ULL) - { - // Read the subsystem data block - is.seekg (subsys_offset, std::ios::beg); - - octave_value tc; - bool global; - read_mat5_binary_element (is, filename, swap, global, tc); - - if (!is || error_state) - return -1; - - if (tc.is_uint8_type ()) - { - const uint8NDArray itmp = tc.uint8_array_value (); - octave_idx_type ilen = itmp.numel (); - - // Why should I have to initialize outbuf as just overwrite - std::string outbuf (ilen - 7, ' '); - - // FIXME -- find a way to avoid casting away const here - char *ctmp = const_cast (outbuf.c_str ()); - for (octave_idx_type j = 8; j < ilen; j++) - ctmp[j-8] = itmp(j).char_value (); - - std::istringstream fh_ws (outbuf); - - read_mat5_binary_element (fh_ws, filename, swap, global, subsys_ov); - - if (error_state) - return -1; - } - else - return -1; - - // Reposition to just after the header - is.seekg (128, std::ios::beg); - } - - return 0; -} - -static int -write_mat5_tag (std::ostream& is, int type, octave_idx_type bytes) -{ - int32_t temp; - - if (bytes > 0 && bytes <= 4) - temp = (bytes << 16) + type; - else - { - temp = type; - if (! is.write (reinterpret_cast (&temp), 4)) - goto data_write_error; - temp = bytes; - } - - if (! is.write (reinterpret_cast (&temp), 4)) - goto data_write_error; - - return 0; - - data_write_error: - return 1; -} - -// Have to use copy here to avoid writing over data accessed via -// Matrix::data(). - -#define MAT5_DO_WRITE(TYPE, data, count, stream) \ - do \ - { \ - OCTAVE_LOCAL_BUFFER (TYPE, ptr, count); \ - for (octave_idx_type i = 0; i < count; i++) \ - ptr[i] = static_cast (data[i]); \ - stream.write (reinterpret_cast (ptr), count * sizeof (TYPE)); \ - } \ - while (0) - -// write out the numeric values in M to OS, -// preceded by the appropriate tag. -static void -write_mat5_array (std::ostream& os, const NDArray& m, bool save_as_floats) -{ - save_type st = LS_DOUBLE; - const double *data = m.data (); - - if (save_as_floats) - { - if (m.too_large_for_float ()) - { - warning ("save: some values too large to save as floats --"); - warning ("save: saving as doubles instead"); - } - else - st = LS_FLOAT; - } - - double max_val, min_val; - if (m.all_integers (max_val, min_val)) - st = get_save_type (max_val, min_val); - - mat5_data_type mst; - int size; - switch (st) - { - default: - case LS_DOUBLE: mst = miDOUBLE; size = 8; break; - case LS_FLOAT: mst = miSINGLE; size = 4; break; - case LS_U_CHAR: mst = miUINT8; size = 1; break; - case LS_U_SHORT: mst = miUINT16; size = 2; break; - case LS_U_INT: mst = miUINT32; size = 4; break; - case LS_CHAR: mst = miINT8; size = 1; break; - case LS_SHORT: mst = miINT16; size = 2; break; - case LS_INT: mst = miINT32; size = 4; break; - } - - octave_idx_type nel = m.numel (); - octave_idx_type len = nel*size; - - write_mat5_tag (os, mst, len); - - { - switch (st) - { - case LS_U_CHAR: - MAT5_DO_WRITE (uint8_t, data, nel, os); - break; - - case LS_U_SHORT: - MAT5_DO_WRITE (uint16_t, data, nel, os); - break; - - case LS_U_INT: - MAT5_DO_WRITE (uint32_t, data, nel, os); - break; - - case LS_U_LONG: - MAT5_DO_WRITE (uint64_t, data, nel, os); - break; - - case LS_CHAR: - MAT5_DO_WRITE (int8_t, data, nel, os); - break; - - case LS_SHORT: - MAT5_DO_WRITE (int16_t, data, nel, os); - break; - - case LS_INT: - MAT5_DO_WRITE (int32_t, data, nel, os); - break; - - case LS_LONG: - MAT5_DO_WRITE (int64_t, data, nel, os); - break; - - case LS_FLOAT: - MAT5_DO_WRITE (float, data, nel, os); - break; - - case LS_DOUBLE: // No conversion necessary. - os.write (reinterpret_cast (data), len); - break; - - default: - (*current_liboctave_error_handler) - ("unrecognized data format requested"); - break; - } - } - if (PAD (len) > len) - { - static char buf[9]="\x00\x00\x00\x00\x00\x00\x00\x00"; - os.write (buf, PAD (len) - len); - } -} - -static void -write_mat5_array (std::ostream& os, const FloatNDArray& m, bool) -{ - save_type st = LS_FLOAT; - const float *data = m.data (); - - float max_val, min_val; - if (m.all_integers (max_val, min_val)) - st = get_save_type (max_val, min_val); - - mat5_data_type mst; - int size; - switch (st) - { - default: - case LS_DOUBLE: mst = miDOUBLE; size = 8; break; - case LS_FLOAT: mst = miSINGLE; size = 4; break; - case LS_U_CHAR: mst = miUINT8; size = 1; break; - case LS_U_SHORT: mst = miUINT16; size = 2; break; - case LS_U_INT: mst = miUINT32; size = 4; break; - case LS_CHAR: mst = miINT8; size = 1; break; - case LS_SHORT: mst = miINT16; size = 2; break; - case LS_INT: mst = miINT32; size = 4; break; - } - - octave_idx_type nel = m.numel (); - octave_idx_type len = nel*size; - - write_mat5_tag (os, mst, len); - - { - switch (st) - { - case LS_U_CHAR: - MAT5_DO_WRITE (uint8_t, data, nel, os); - break; - - case LS_U_SHORT: - MAT5_DO_WRITE (uint16_t, data, nel, os); - break; - - case LS_U_INT: - MAT5_DO_WRITE (uint32_t, data, nel, os); - break; - - case LS_U_LONG: - MAT5_DO_WRITE (uint64_t, data, nel, os); - break; - - case LS_CHAR: - MAT5_DO_WRITE (int8_t, data, nel, os); - break; - - case LS_SHORT: - MAT5_DO_WRITE (int16_t, data, nel, os); - break; - - case LS_INT: - MAT5_DO_WRITE (int32_t, data, nel, os); - break; - - case LS_LONG: - MAT5_DO_WRITE (int64_t, data, nel, os); - break; - - case LS_FLOAT: // No conversion necessary. - os.write (reinterpret_cast (data), len); - break; - - case LS_DOUBLE: - MAT5_DO_WRITE (double, data, nel, os); - break; - - default: - (*current_liboctave_error_handler) - ("unrecognized data format requested"); - break; - } - } - if (PAD (len) > len) - { - static char buf[9]="\x00\x00\x00\x00\x00\x00\x00\x00"; - os.write (buf, PAD (len) - len); - } -} - -template -void -write_mat5_integer_data (std::ostream& os, const T *m, int size, - octave_idx_type nel) -{ - mat5_data_type mst; - unsigned len; - - switch (size) - { - case 1: - mst = miUINT8; - break; - case 2: - mst = miUINT16; - break; - case 4: - mst = miUINT32; - break; - case 8: - mst = miUINT64; - break; - case -1: - mst = miINT8; - size = - size; - break; - case -2: - mst = miINT16; - size = - size; - break; - case -4: - mst = miINT32; - size = - size; - break; - case -8: - default: - mst = miINT64; - size = - size; - break; - } - - len = nel*size; - write_mat5_tag (os, mst, len); - - os.write (reinterpret_cast (m), len); - - if (PAD (len) > len) - { - static char buf[9]="\x00\x00\x00\x00\x00\x00\x00\x00"; - os.write (buf, PAD (len) - len); - } -} - -template void -write_mat5_integer_data (std::ostream& os, const octave_int8 *m, - int size, octave_idx_type nel); - -template void -write_mat5_integer_data (std::ostream& os, const octave_int16 *m, - int size, octave_idx_type nel); - -template void -write_mat5_integer_data (std::ostream& os, const octave_int32 *m, - int size, octave_idx_type nel); - -template void -write_mat5_integer_data (std::ostream& os, const octave_int64 *m, - int size, octave_idx_type nel); - -template void -write_mat5_integer_data (std::ostream& os, const octave_uint8 *m, - int size, octave_idx_type nel); - -template void -write_mat5_integer_data (std::ostream& os, const octave_uint16 *m, - int size, octave_idx_type nel); - -template void -write_mat5_integer_data (std::ostream& os, const octave_uint32 *m, - int size, octave_idx_type nel); - -template void -write_mat5_integer_data (std::ostream& os, const octave_uint64 *m, - int size, octave_idx_type nel); - -template void -write_mat5_integer_data (std::ostream& os, const int *m, - int size, octave_idx_type nel); - -// Write out cell element values in the cell array to OS, preceded by -// the appropriate tag. - -static bool -write_mat5_cell_array (std::ostream& os, const Cell& cell, - bool mark_as_global, bool save_as_floats) -{ - octave_idx_type nel = cell.numel (); - - for (octave_idx_type i = 0; i < nel; i++) - { - octave_value ov = cell(i); - - if (! save_mat5_binary_element (os, ov, "", mark_as_global, - false, save_as_floats)) - return false; - } - - return true; -} - -int -save_mat5_array_length (const double* val, octave_idx_type nel, - bool save_as_floats) -{ - if (nel > 0) - { - int size = 8; - - if (save_as_floats) - { - bool too_large_for_float = false; - for (octave_idx_type i = 0; i < nel; i++) - { - double tmp = val[i]; - - if (! (xisnan (tmp) || xisinf (tmp)) - && fabs (tmp) > std::numeric_limits::max ()) - { - too_large_for_float = true; - break; - } - } - - if (!too_large_for_float) - size = 4; - } - - // The code below is disabled since get_save_type currently doesn't - // deal with integer types. This will need to be activated if get_save_type - // is changed. - - // double max_val = val[0]; - // double min_val = val[0]; - // bool all_integers = true; - // - // for (int i = 0; i < nel; i++) - // { - // double val = val[i]; - // - // if (val > max_val) - // max_val = val; - // - // if (val < min_val) - // min_val = val; - // - // if (D_NINT (val) != val) - // { - // all_integers = false; - // break; - // } - // } - // - // if (all_integers) - // { - // if (max_val < 256 && min_val > -1) - // size = 1; - // else if (max_val < 65536 && min_val > -1) - // size = 2; - // else if (max_val < 4294967295UL && min_val > -1) - // size = 4; - // else if (max_val < 128 && min_val >= -128) - // size = 1; - // else if (max_val < 32768 && min_val >= -32768) - // size = 2; - // else if (max_val <= 2147483647L && min_val >= -2147483647L) - // size = 4; - // } - - return 8 + nel * size; - } - else - return 8; -} - -int -save_mat5_array_length (const float* /* val */, octave_idx_type nel, bool) -{ - if (nel > 0) - { - int size = 4; - - - // The code below is disabled since get_save_type currently doesn't - // deal with integer types. This will need to be activated if get_save_type - // is changed. - - // float max_val = val[0]; - // float min_val = val[0]; - // bool all_integers = true; - // - // for (int i = 0; i < nel; i++) - // { - // float val = val[i]; - // - // if (val > max_val) - // max_val = val; - // - // if (val < min_val) - // min_val = val; - // - // if (D_NINT (val) != val) - // { - // all_integers = false; - // break; - // } - // } - // - // if (all_integers) - // { - // if (max_val < 256 && min_val > -1) - // size = 1; - // else if (max_val < 65536 && min_val > -1) - // size = 2; - // else if (max_val < 4294967295UL && min_val > -1) - // size = 4; - // else if (max_val < 128 && min_val >= -128) - // size = 1; - // else if (max_val < 32768 && min_val >= -32768) - // size = 2; - // else if (max_val <= 2147483647L && min_val >= -2147483647L) - // size = 4; - // } - - // Round nel up to nearest even number of elements. Take into account - // Short tags for 4 byte elements. - return PAD ((nel > 0 && nel * size <= 4 ? 4 : 8) + nel * size); - } - else - return 8; -} - -int -save_mat5_array_length (const Complex* val, octave_idx_type nel, - bool save_as_floats) -{ - int ret; - - OCTAVE_LOCAL_BUFFER (double, tmp, nel); - - for (octave_idx_type i = 1; i < nel; i++) - tmp[i] = std::real (val[i]); - - ret = save_mat5_array_length (tmp, nel, save_as_floats); - - for (octave_idx_type i = 1; i < nel; i++) - tmp[i] = std::imag (val[i]); - - ret += save_mat5_array_length (tmp, nel, save_as_floats); - - return ret; -} - -int -save_mat5_array_length (const FloatComplex* val, octave_idx_type nel, - bool save_as_floats) -{ - int ret; - - OCTAVE_LOCAL_BUFFER (float, tmp, nel); - - for (octave_idx_type i = 1; i < nel; i++) - tmp[i] = std::real (val[i]); - - ret = save_mat5_array_length (tmp, nel, save_as_floats); - - for (octave_idx_type i = 1; i < nel; i++) - tmp[i] = std::imag (val[i]); - - ret += save_mat5_array_length (tmp, nel, save_as_floats); - - return ret; -} - -int -save_mat5_element_length (const octave_value& tc, const std::string& name, - bool save_as_floats, bool mat7_format) -{ - size_t max_namelen = 63; - size_t len = name.length (); - std::string cname = tc.class_name (); - int ret = 32; - - if (len > 4) - ret += PAD (len > max_namelen ? max_namelen : len); - - ret += PAD (4 * tc.ndims ()); - - if (tc.is_string ()) - { - charNDArray chm = tc.char_array_value (); - ret += 8; - if (chm.numel () > 2) - ret += PAD (2 * chm.numel ()); - } - else if (tc.is_sparse_type ()) - { - if (tc.is_complex_type ()) - { - const SparseComplexMatrix m = tc.sparse_complex_matrix_value (); - octave_idx_type nc = m.cols (); - octave_idx_type nnz = m.nnz (); - - ret += 16 + save_mat5_array_length (m.data (), nnz, save_as_floats); - if (nnz > 1) - ret += PAD (nnz * sizeof (int32_t)); - if (nc > 0) - ret += PAD ((nc + 1) * sizeof (int32_t)); - } - else - { - const SparseMatrix m = tc.sparse_matrix_value (); - octave_idx_type nc = m.cols (); - octave_idx_type nnz = m.nnz (); - - ret += 16 + save_mat5_array_length (m.data (), nnz, save_as_floats); - if (nnz > 1) - ret += PAD (nnz * sizeof (int32_t)); - if (nc > 0) - ret += PAD ((nc + 1) * sizeof (int32_t)); - } - } - -#define INT_LEN(nel, size) \ - { \ - ret += 8; \ - octave_idx_type sz = nel * size; \ - if (sz > 4) \ - ret += PAD (sz); \ - } - - else if (cname == "int8") - INT_LEN (tc.int8_array_value ().numel (), 1) - else if (cname == "int16") - INT_LEN (tc.int16_array_value ().numel (), 2) - else if (cname == "int32") - INT_LEN (tc.int32_array_value ().numel (), 4) - else if (cname == "int64") - INT_LEN (tc.int64_array_value ().numel (), 8) - else if (cname == "uint8") - INT_LEN (tc.uint8_array_value ().numel (), 1) - else if (cname == "uint16") - INT_LEN (tc.uint16_array_value ().numel (), 2) - else if (cname == "uint32") - INT_LEN (tc.uint32_array_value ().numel (), 4) - else if (cname == "uint64") - INT_LEN (tc.uint64_array_value ().numel (), 8) - else if (tc.is_bool_type ()) - INT_LEN (tc.bool_array_value ().numel (), 1) - else if (tc.is_real_scalar () || tc.is_real_matrix () || tc.is_range ()) - { - if (tc.is_single_type ()) - { - const FloatNDArray m = tc.float_array_value (); - ret += save_mat5_array_length (m.fortran_vec (), m.numel (), - save_as_floats); - } - else - { - const NDArray m = tc.array_value (); - ret += save_mat5_array_length (m.fortran_vec (), m.numel (), - save_as_floats); - } - } - else if (tc.is_cell ()) - { - Cell cell = tc.cell_value (); - octave_idx_type nel = cell.numel (); - - for (int i = 0; i < nel; i++) - ret += 8 + - save_mat5_element_length (cell (i), "", save_as_floats, mat7_format); - } - else if (tc.is_complex_scalar () || tc.is_complex_matrix ()) - { - if (tc.is_single_type ()) - { - const FloatComplexNDArray m = tc.float_complex_array_value (); - ret += save_mat5_array_length (m.fortran_vec (), m.numel (), - save_as_floats); - } - else - { - const ComplexNDArray m = tc.complex_array_value (); - ret += save_mat5_array_length (m.fortran_vec (), m.numel (), - save_as_floats); - } - } - else if (tc.is_map () || tc.is_inline_function () || tc.is_object ()) - { - int fieldcnt = 0; - const octave_map m = tc.map_value (); - octave_idx_type nel = m.numel (); - - if (tc.is_inline_function ()) - // length of "inline" is 6 - ret += 8 + PAD (6 > max_namelen ? max_namelen : 6); - else if (tc.is_object ()) - { - size_t classlen = tc.class_name (). length (); - - ret += 8 + PAD (classlen > max_namelen ? max_namelen : classlen); - } - - for (octave_map::const_iterator i = m.begin (); i != m.end (); i++) - fieldcnt++; - - ret += 16 + fieldcnt * (max_namelen + 1); - - - for (octave_idx_type j = 0; j < nel; j++) - { - - for (octave_map::const_iterator i = m.begin (); i != m.end (); i++) - { - const Cell elts = m.contents (i); - - ret += 8 + save_mat5_element_length (elts(j), "", - save_as_floats, mat7_format); - } - } - } - else - ret = -1; - - return ret; -} - -static void -write_mat5_sparse_index_vector (std::ostream& os, - const octave_idx_type *idx, - octave_idx_type nel) -{ - int tmp = sizeof (int32_t); - - OCTAVE_LOCAL_BUFFER (int32_t, tmp_idx, nel); - - for (octave_idx_type i = 0; i < nel; i++) - tmp_idx[i] = idx[i]; - - write_mat5_integer_data (os, tmp_idx, -tmp, nel); -} - -static void -gripe_dim_too_large (const std::string& name) -{ - warning ("save: skipping %s: dimension too large for MAT format", - name.c_str ()); -} - -// save the data from TC along with the corresponding NAME on stream -// OS in the MatLab version 5 binary format. Return true on success. - -bool -save_mat5_binary_element (std::ostream& os, - const octave_value& tc, const std::string& name, - bool mark_as_global, bool mat7_format, - bool save_as_floats, bool compressing) -{ - int32_t flags = 0; - int32_t nnz_32 = 0; - std::string cname = tc.class_name (); - size_t max_namelen = 63; - - dim_vector dv = tc.dims (); - int nd = tc.ndims (); - int dim_len = 4*nd; - - static octave_idx_type max_dim_val = std::numeric_limits::max (); - - for (int i = 0; i < nd; i++) - { - if (dv(i) > max_dim_val) - { - gripe_dim_too_large (name); - goto skip_to_next; - } - } - - if (tc.is_sparse_type ()) - { - octave_idx_type nnz; - octave_idx_type nc; - - if (tc.is_complex_type ()) - { - SparseComplexMatrix scm = tc.sparse_complex_matrix_value (); - nnz = scm.nzmax (); - nc = scm.cols (); - } - else - { - SparseMatrix sm = tc.sparse_matrix_value (); - nnz = sm.nzmax (); - nc = sm.cols (); - } - - if (nnz > max_dim_val || nc + 1 > max_dim_val) - { - gripe_dim_too_large (name); - goto skip_to_next; - } - - nnz_32 = nnz; - } - else if (dv.numel () > max_dim_val) - { - gripe_dim_too_large (name); - goto skip_to_next; - } - -#ifdef HAVE_ZLIB - if (mat7_format && !compressing) - { - bool ret = false; - - std::ostringstream buf; - - // The code seeks backwards in the stream to fix the header. Can't - // do this with zlib, so use a stringstream. - ret = save_mat5_binary_element (buf, tc, name, mark_as_global, true, - save_as_floats, true); - - if (ret) - { - // destLen must be at least 0.1% larger than source buffer - // + 12 bytes. Reality is it must be larger again than that. - std::string buf_str = buf.str (); - uLongf srcLen = buf_str.length (); - uLongf destLen = srcLen * 101 / 100 + 12; - OCTAVE_LOCAL_BUFFER (char, out_buf, destLen); - - if (compress (reinterpret_cast (out_buf), &destLen, - reinterpret_cast (buf_str.c_str ()), srcLen) == Z_OK) - { - write_mat5_tag (os, miCOMPRESSED, - static_cast (destLen)); - - os.write (out_buf, destLen); - } - else - { - error ("save: error compressing data element"); - ret = false; - } - } - - return ret; - } -#endif - - write_mat5_tag (os, miMATRIX, save_mat5_element_length - (tc, name, save_as_floats, mat7_format)); - - // array flags subelement - write_mat5_tag (os, miUINT32, 8); - - if (tc.is_bool_type ()) - flags |= 0x0200; - - if (mark_as_global) - flags |= 0x0400; - - if (tc.is_complex_scalar () || tc.is_complex_matrix ()) - flags |= 0x0800; - - if (tc.is_string ()) - flags |= MAT_FILE_CHAR_CLASS; - else if (cname == "int8") - flags |= MAT_FILE_INT8_CLASS; - else if (cname == "int16") - flags |= MAT_FILE_INT16_CLASS; - else if (cname == "int32") - flags |= MAT_FILE_INT32_CLASS; - else if (cname == "int64") - flags |= MAT_FILE_INT64_CLASS; - else if (cname == "uint8" || tc.is_bool_type ()) - flags |= MAT_FILE_UINT8_CLASS; - else if (cname == "uint16") - flags |= MAT_FILE_UINT16_CLASS; - else if (cname == "uint32") - flags |= MAT_FILE_UINT32_CLASS; - else if (cname == "uint64") - flags |= MAT_FILE_UINT64_CLASS; - else if (tc.is_sparse_type ()) - flags |= MAT_FILE_SPARSE_CLASS; - else if (tc.is_real_scalar () || tc.is_real_matrix () || tc.is_range () - || tc.is_complex_scalar () || tc.is_complex_matrix ()) - { - if (tc.is_single_type ()) - flags |= MAT_FILE_SINGLE_CLASS; - else - flags |= MAT_FILE_DOUBLE_CLASS; - } - else if (tc.is_map ()) - flags |= MAT_FILE_STRUCT_CLASS; - else if (tc.is_cell ()) - flags |= MAT_FILE_CELL_CLASS; - else if (tc.is_inline_function () || tc.is_object ()) - flags |= MAT_FILE_OBJECT_CLASS; - else - { - gripe_wrong_type_arg ("save", tc, false); - goto error_cleanup; - } - - os.write (reinterpret_cast (&flags), 4); - // Matlab seems to have trouble reading files that have nzmax == 0 at - // this point in the file. - if (nnz_32 == 0) - nnz_32 = 1; - os.write (reinterpret_cast (&nnz_32), 4); - - write_mat5_tag (os, miINT32, dim_len); - - for (int i = 0; i < nd; i++) - { - int32_t n = dv(i); - os.write (reinterpret_cast (&n), 4); - } - - if (PAD (dim_len) > dim_len) - { - static char buf[9]="\x00\x00\x00\x00\x00\x00\x00\x00"; - os.write (buf, PAD (dim_len) - dim_len); - } - - // array name subelement - { - size_t namelen = name.length (); - - if (namelen > max_namelen) - namelen = max_namelen; // Truncate names if necessary - - int paddedlength = PAD (namelen); - - write_mat5_tag (os, miINT8, namelen); - OCTAVE_LOCAL_BUFFER (char, paddedname, paddedlength); - memset (paddedname, 0, paddedlength); - strncpy (paddedname, name.c_str (), namelen); - os.write (paddedname, paddedlength); - } - - // data element - if (tc.is_string ()) - { - charNDArray chm = tc.char_array_value (); - octave_idx_type nel = chm.numel (); - octave_idx_type len = nel*2; - octave_idx_type paddedlength = PAD (len); - - OCTAVE_LOCAL_BUFFER (int16_t, buf, nel+3); - write_mat5_tag (os, miUINT16, len); - - const char *s = chm.data (); - - for (octave_idx_type i = 0; i < nel; i++) - buf[i] = *s++ & 0x00FF; - - os.write (reinterpret_cast (buf), len); - - if (paddedlength > len) - { - static char padbuf[9]="\x00\x00\x00\x00\x00\x00\x00\x00"; - os.write (padbuf, paddedlength - len); - } - } - else if (tc.is_sparse_type ()) - { - if (tc.is_complex_type ()) - { - const SparseComplexMatrix m = tc.sparse_complex_matrix_value (); - octave_idx_type nnz = m.nnz (); - octave_idx_type nc = m.cols (); - - write_mat5_sparse_index_vector (os, m.ridx (), nnz); - write_mat5_sparse_index_vector (os, m.cidx (), nc + 1); - - NDArray buf (dim_vector (nnz, 1)); - - for (octave_idx_type i = 0; i < nnz; i++) - buf (i) = std::real (m.data (i)); - - write_mat5_array (os, buf, save_as_floats); - - for (octave_idx_type i = 0; i < nnz; i++) - buf (i) = std::imag (m.data (i)); - - write_mat5_array (os, buf, save_as_floats); - } - else - { - const SparseMatrix m = tc.sparse_matrix_value (); - octave_idx_type nnz = m.nnz (); - octave_idx_type nc = m.cols (); - - write_mat5_sparse_index_vector (os, m.ridx (), nnz); - write_mat5_sparse_index_vector (os, m.cidx (), nc + 1); - - // FIXME - // Is there a way to easily do without this buffer - NDArray buf (dim_vector (nnz, 1)); - - for (int i = 0; i < nnz; i++) - buf (i) = m.data (i); - - write_mat5_array (os, buf, save_as_floats); - } - } - else if (cname == "int8") - { - int8NDArray m = tc.int8_array_value (); - - write_mat5_integer_data (os, m.fortran_vec (), -1, m.numel ()); - } - else if (cname == "int16") - { - int16NDArray m = tc.int16_array_value (); - - write_mat5_integer_data (os, m.fortran_vec (), -2, m.numel ()); - } - else if (cname == "int32") - { - int32NDArray m = tc.int32_array_value (); - - write_mat5_integer_data (os, m.fortran_vec (), -4, m.numel ()); - } - else if (cname == "int64") - { - int64NDArray m = tc.int64_array_value (); - - write_mat5_integer_data (os, m.fortran_vec (), -8, m.numel ()); - } - else if (cname == "uint8") - { - uint8NDArray m = tc.uint8_array_value (); - - write_mat5_integer_data (os, m.fortran_vec (), 1, m.numel ()); - } - else if (cname == "uint16") - { - uint16NDArray m = tc.uint16_array_value (); - - write_mat5_integer_data (os, m.fortran_vec (), 2, m.numel ()); - } - else if (cname == "uint32") - { - uint32NDArray m = tc.uint32_array_value (); - - write_mat5_integer_data (os, m.fortran_vec (), 4, m.numel ()); - } - else if (cname == "uint64") - { - uint64NDArray m = tc.uint64_array_value (); - - write_mat5_integer_data (os, m.fortran_vec (), 8, m.numel ()); - } - else if (tc.is_bool_type ()) - { - uint8NDArray m (tc.bool_array_value ()); - - write_mat5_integer_data (os, m.fortran_vec (), 1, m.numel ()); - } - else if (tc.is_real_scalar () || tc.is_real_matrix () || tc.is_range ()) - { - if (tc.is_single_type ()) - { - FloatNDArray m = tc.float_array_value (); - - write_mat5_array (os, m, save_as_floats); - } - else - { - NDArray m = tc.array_value (); - - write_mat5_array (os, m, save_as_floats); - } - } - else if (tc.is_cell ()) - { - Cell cell = tc.cell_value (); - - if (! write_mat5_cell_array (os, cell, mark_as_global, save_as_floats)) - goto error_cleanup; - } - else if (tc.is_complex_scalar () || tc.is_complex_matrix ()) - { - if (tc.is_single_type ()) - { - FloatComplexNDArray m_cmplx = tc.float_complex_array_value (); - - write_mat5_array (os, ::real (m_cmplx), save_as_floats); - write_mat5_array (os, ::imag (m_cmplx), save_as_floats); - } - else - { - ComplexNDArray m_cmplx = tc.complex_array_value (); - - write_mat5_array (os, ::real (m_cmplx), save_as_floats); - write_mat5_array (os, ::imag (m_cmplx), save_as_floats); - } - } - else if (tc.is_map () || tc.is_inline_function () || tc.is_object ()) - { - if (tc.is_inline_function () || tc.is_object ()) - { - std::string classname = tc.is_object () ? tc.class_name () : "inline"; - size_t namelen = classname.length (); - - if (namelen > max_namelen) - namelen = max_namelen; // Truncate names if necessary - - int paddedlength = PAD (namelen); - - write_mat5_tag (os, miINT8, namelen); - OCTAVE_LOCAL_BUFFER (char, paddedname, paddedlength); - memset (paddedname, 0, paddedlength); - strncpy (paddedname, classname.c_str (), namelen); - os.write (paddedname, paddedlength); - } - - octave_map m; - - if (tc.is_object () && - load_path::find_method (tc.class_name (), "saveobj") != std::string ()) - { - octave_value_list tmp = feval ("saveobj", tc, 1); - if (! error_state) - m = tmp(0).map_value (); - else - goto error_cleanup; - } - else - m = tc.map_value (); - - // an Octave structure */ - // recursively write each element of the structure - { - char buf[64]; - int32_t maxfieldnamelength = max_namelen + 1; - - octave_idx_type nf = m.nfields (); - - write_mat5_tag (os, miINT32, 4); - os.write (reinterpret_cast (&maxfieldnamelength), 4); - write_mat5_tag (os, miINT8, nf*maxfieldnamelength); - - // Iterating over the list of keys will preserve the order of - // the fields. - string_vector keys = m.keys (); - - for (octave_idx_type i = 0; i < nf; i++) - { - std::string key = keys(i); - - // write the name of each element - memset (buf, 0, max_namelen + 1); - // only 31 or 63 char names permitted - strncpy (buf, key.c_str (), max_namelen); - os.write (buf, max_namelen + 1); - } - - octave_idx_type len = m.numel (); - - // Create temporary copy of structure contents to avoid - // multiple calls of the contents method. - std::vector elts (nf); - for (octave_idx_type i = 0; i < nf; i++) - elts[i] = m.contents (keys(i)).data (); - - for (octave_idx_type j = 0; j < len; j++) - { - // write the data of each element - - // Iterating over the list of keys will preserve the order - // of the fields. - for (octave_idx_type i = 0; i < nf; i++) - { - bool retval2 = save_mat5_binary_element (os, elts[i][j], "", - mark_as_global, - false, - save_as_floats); - if (! retval2) - goto error_cleanup; - } - } - } - } - else - gripe_wrong_type_arg ("save", tc, false); - - skip_to_next: - return true; - - error_cleanup: - error ("save: error while writing '%s' to MAT file", name.c_str ()); - - return false; -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/ls-mat5.h --- a/libinterp/interp-core/ls-mat5.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,61 +0,0 @@ -/* - -Copyright (C) 2003-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_ls_mat5_h) -#define octave_ls_mat5_h 1 - -enum mat5_data_type - { - miINT8 = 1, // 8 bit signed - miUINT8, // 8 bit unsigned - miINT16, // 16 bit signed - miUINT16, // 16 bit unsigned - miINT32, // 32 bit signed - miUINT32, // 32 bit unsigned - miSINGLE, // IEEE 754 single precision float - miRESERVE1, - miDOUBLE, // IEEE 754 double precision float - miRESERVE2, - miRESERVE3, - miINT64, // 64 bit signed - miUINT64, // 64 bit unsigned - miMATRIX, // MATLAB array - miCOMPRESSED, // Compressed data - miUTF8, // Unicode UTF-8 Encoded Character Data - miUTF16, // Unicode UTF-16 Encoded Character Data - miUTF32 // Unicode UTF-32 Encoded Character Data - }; - -extern int -read_mat5_binary_file_header (std::istream& is, bool& swap, - bool quiet = false, - const std::string& filename = std::string ()); -extern std::string -read_mat5_binary_element (std::istream& is, const std::string& filename, - bool swap, bool& global, octave_value& tc); -extern bool -save_mat5_binary_element (std::ostream& os, - const octave_value& tc, const std::string& name, - bool mark_as_global, bool mat7_format, - bool save_as_floats, bool compressing = false); - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/ls-oct-binary.cc --- a/libinterp/interp-core/ls-oct-binary.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,307 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include -#include -#include -#include -#include - -#include "byte-swap.h" -#include "data-conv.h" -#include "file-ops.h" -#include "glob-match.h" -#include "lo-mappers.h" -#include "mach-info.h" -#include "oct-env.h" -#include "oct-time.h" -#include "quit.h" -#include "str-vec.h" -#include "oct-locbuf.h" - -#include "Cell.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "load-save.h" -#include "oct-obj.h" -#include "oct-map.h" -#include "ov-cell.h" -#include "pager.h" -#include "pt-exp.h" -#include "sysdep.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" -#include "version.h" -#include "dMatrix.h" - -#include "ls-utils.h" -#include "ls-oct-binary.h" - -// Extract one value (scalar, matrix, string, etc.) from stream IS and -// place it in TC, returning the name of the variable. If the value -// is tagged as global in the file, return TRUE in GLOBAL. If SWAP -// is TRUE, swap bytes after reading. -// -// The data is expected to be in the following format: -// -// Header (one per file): -// ===================== -// -// object type bytes -// ------ ---- ----- -// magic number string 10 -// -// float format integer 1 -// -// -// Data (one set for each item): -// ============================ -// -// object type bytes -// ------ ---- ----- -// name_length integer 4 -// -// name string name_length -// -// doc_length integer 4 -// -// doc string doc_length -// -// global flag integer 1 -// -// data type char 1 -// -// In general "data type" is 255, and in that case the next arguments -// in the data set are -// -// object type bytes -// ------ ---- ----- -// type_length integer 4 -// -// type string type_length -// -// The string "type" is then used with octave_value_typeinfo::lookup_type -// to create an octave_value of the correct type. The specific load/save -// function is then called. -// -// For backward compatiablity "data type" can also be a value between 1 -// and 7, where this defines a hardcoded octave_value of the type -// -// data type octave_value -// --------- ------------ -// 1 scalar -// 2 matrix -// 3 complex scalar -// 4 complex matrix -// 5 string (old style storage) -// 6 range -// 7 string -// -// Except for "data type" equal 5 that requires special treatment, these -// old style "data type" value also cause the specific load/save functions -// to be called. FILENAME is used for error messages. - -std::string -read_binary_data (std::istream& is, bool swap, - oct_mach_info::float_format fmt, - const std::string& filename, bool& global, - octave_value& tc, std::string& doc) -{ - std::string retval; - - unsigned char tmp = 0; - - int32_t name_len = 0; - int32_t doc_len = 0; - - doc.resize (0); - - // We expect to fail here, at the beginning of a record, so not - // being able to read another name should not result in an error. - - is.read (reinterpret_cast (&name_len), 4); - if (! is) - return retval; - if (swap) - swap_bytes<4> (&name_len); - - { - OCTAVE_LOCAL_BUFFER (char, name, name_len+1); - name[name_len] = '\0'; - if (! is.read (reinterpret_cast (name), name_len)) - goto data_read_error; - retval = name; - } - - is.read (reinterpret_cast (&doc_len), 4); - if (! is) - goto data_read_error; - if (swap) - swap_bytes<4> (&doc_len); - - { - OCTAVE_LOCAL_BUFFER (char, tdoc, doc_len+1); - tdoc[doc_len] = '\0'; - if (! is.read (reinterpret_cast (tdoc), doc_len)) - goto data_read_error; - doc = tdoc; - } - - if (! is.read (reinterpret_cast (&tmp), 1)) - goto data_read_error; - global = tmp ? 1 : 0; - - tmp = 0; - if (! is.read (reinterpret_cast (&tmp), 1)) - goto data_read_error; - - // All cases except 255 kept for backwards compatibility - switch (tmp) - { - case 1: - tc = octave_value_typeinfo::lookup_type ("scalar"); - break; - - case 2: - tc = octave_value_typeinfo::lookup_type ("matrix"); - break; - - case 3: - tc = octave_value_typeinfo::lookup_type ("complex scalar"); - break; - - case 4: - tc = octave_value_typeinfo::lookup_type ("complex matrix"); - break; - - case 5: - { - // FIXMEX - // This is cruft, since its for a save type that is old. Maybe - // this is taking backward compatability too far!! - int32_t len; - if (! is.read (reinterpret_cast (&len), 4)) - goto data_read_error; - if (swap) - swap_bytes<4> (&len); - OCTAVE_LOCAL_BUFFER (char, s, len+1); - if (! is.read (reinterpret_cast (s), len)) - goto data_read_error; - s[len] = '\0'; - tc = s; - - // Early return, since don't want rest of this function - return retval; - } - break; - - case 6: - tc = octave_value_typeinfo::lookup_type ("range"); - break; - - case 7: - tc = octave_value_typeinfo::lookup_type ("string"); - break; - - case 255: - { - // Read the saved variable type - int32_t len; - if (! is.read (reinterpret_cast (&len), 4)) - goto data_read_error; - if (swap) - swap_bytes<4> (&len); - OCTAVE_LOCAL_BUFFER (char, s, len+1); - if (! is.read (s, len)) - goto data_read_error; - s[len] = '\0'; - std::string typ = s; - tc = octave_value_typeinfo::lookup_type (typ); - } - break; - default: - goto data_read_error; - break; - } - - if (!tc.load_binary (is, swap, fmt)) - { - data_read_error: - error ("load: trouble reading binary file '%s'", filename.c_str ()); - } - - return retval; -} - -// Save the data from TC along with the corresponding NAME, help -// string DOC, and global flag MARK_AS_GLOBAL on stream OS in the -// binary format described above for read_binary_data. - -bool -save_binary_data (std::ostream& os, const octave_value& tc, - const std::string& name, const std::string& doc, - bool mark_as_global, bool save_as_floats) -{ - int32_t name_len = name.length (); - - os.write (reinterpret_cast (&name_len), 4); - os << name; - - int32_t doc_len = doc.length (); - - os.write (reinterpret_cast (&doc_len), 4); - os << doc; - - unsigned char tmp; - - tmp = mark_as_global; - os.write (reinterpret_cast (&tmp), 1); - - // 255 flags the new binary format - tmp = 255; - os.write (reinterpret_cast (&tmp), 1); - - // Write the string corresponding to the octave_value type - std::string typ = tc.type_name (); - int32_t len = typ.length (); - os.write (reinterpret_cast (&len), 4); - const char *btmp = typ.data (); - os.write (btmp, len); - - // The octave_value of tc is const. Make a copy... - octave_value val = tc; - - // Call specific save function - bool success = val.save_binary (os, save_as_floats); - - return (os && success); -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/ls-oct-binary.h --- a/libinterp/interp-core/ls-oct-binary.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,37 +0,0 @@ -/* - -Copyright (C) 2003-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_ls_oct_binary_h) -#define octave_ls_oct_binary_h 1 - -extern OCTINTERP_API bool -save_binary_data (std::ostream& os, const octave_value& tc, - const std::string& name, const std::string& doc, - bool mark_as_global, bool save_as_floats); - -extern OCTINTERP_API std::string -read_binary_data (std::istream& is, bool swap, - oct_mach_info::float_format fmt, - const std::string& filename, bool& global, - octave_value& tc, std::string& doc); - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/ls-utils.cc --- a/libinterp/interp-core/ls-utils.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,88 +0,0 @@ -/* - -Copyright (C) 2003-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "data-conv.h" - -#include "ls-utils.h" - -// MAX_VAL and MIN_VAL are assumed to have integral values even though -// they are stored in doubles. - -save_type -get_save_type (double /* max_val */, double /* min_val */) -{ - save_type st = LS_DOUBLE; - - // Matlab doesn't seem to load the UINT32 type correctly, so let's - // avoid it (and the other unsigned types, even though they may not - // have the same problem. And apparently, there are problems with - // other smaller types as well. If we avoid them all, then maybe we - // will avoid problems. Unfortunately, we won't be able to save - // space... - - // if (max_val < 256 && min_val > -1) - // st = LS_U_CHAR; - // else if (max_val < 65536 && min_val > -1) - // st = LS_U_SHORT; - // else if (max_val < 4294967295UL && min_val > -1) - // st = LS_U_INT; - // else if (max_val < 128 && min_val >= -128) - // st = LS_CHAR; - // else if (max_val < 32768 && min_val >= -32768) - // st = LS_SHORT; - // else if (max_val <= 2147483647L && min_val >= -2147483647L) - // st = LS_INT; - - return st; -} - -save_type -get_save_type (float /* max_val */, float /* min_val */) -{ - save_type st = LS_FLOAT; - - // Matlab doesn't seem to load the UINT32 type correctly, so let's - // avoid it (and the other unsigned types, even though they may not - // have the same problem. And apparently, there are problems with - // other smaller types as well. If we avoid them all, then maybe we - // will avoid problems. Unfortunately, we won't be able to save - // space... - - // if (max_val < 256 && min_val > -1) - // st = LS_U_CHAR; - // else if (max_val < 65536 && min_val > -1) - // st = LS_U_SHORT; - // else if (max_val < 4294967295UL && min_val > -1) - // st = LS_U_INT; - // else if (max_val < 128 && min_val >= -128) - // st = LS_CHAR; - // else if (max_val < 32768 && min_val >= -32768) - // st = LS_SHORT; - // else if (max_val <= 2147483647L && min_val >= -2147483647L) - // st = LS_INT; - - return st; -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/ls-utils.h --- a/libinterp/interp-core/ls-utils.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,32 +0,0 @@ -/* - -Copyright (C) 2003-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_ls_utils_h) -#define octave_ls_utils 1 - -extern save_type -get_save_type (double max_val, double min_val); - -extern save_type -get_save_type (float max_val, float min_val); - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/matherr.c --- a/libinterp/interp-core/matherr.c Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,53 +0,0 @@ -/* - -Copyright (C) 1997-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#if defined (EXCEPTION_IN_MATH) - -#include "lo-math.h" - -int -matherr (struct exception *x) -{ - /* Possibly print our own message someday. Should probably be - user-switchable. */ - - switch (x->type) - { - case DOMAIN: - case SING: - case OVERFLOW: - case UNDERFLOW: - case TLOSS: - case PLOSS: - default: - break; - } - - /* But don't print the system message. */ - - return 1; -} -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/mex.cc --- a/libinterp/interp-core/mex.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,3385 +0,0 @@ -/* - -Copyright (C) 2006-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#include - -#include -#include -#include -#include -#include -#include - -#include - -#include "f77-fcn.h" -#include "lo-ieee.h" -#include "oct-locbuf.h" - -#include "Cell.h" -// mxArray must be declared as a class before including mexproto.h. -#include "mxarray.h" -#include "mexproto.h" -#include "oct-map.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-mex-fcn.h" -#include "ov-usr-fcn.h" -#include "pager.h" -#include "parse.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" -#include "graphics.h" - -// #define DEBUG 1 - -static void -xfree (void *ptr) -{ - ::free (ptr); -} - -static mwSize -max_str_len (mwSize m, const char **str) -{ - int max_len = 0; - - for (mwSize i = 0; i < m; i++) - { - mwSize tmp = strlen (str[i]); - - if (tmp > max_len) - max_len = tmp; - } - - return max_len; -} - -static int -valid_key (const char *key) -{ - int retval = 0; - - int nel = strlen (key); - - if (nel > 0) - { - if (isalpha (key[0])) - { - for (int i = 1; i < nel; i++) - { - if (! (isalnum (key[i]) || key[i] == '_')) - goto done; - } - - retval = 1; - } - } - - done: - - return retval; -} - -// ------------------------------------------------------------------ - -void -mxArray_base::error (const char *msg) const -{ - // FIXME - ::error ("%s", msg); -} - -static mwIndex -calc_single_subscript_internal (mwSize ndims, const mwSize *dims, - mwSize nsubs, const mwIndex *subs) -{ - mwIndex retval = 0; - - switch (nsubs) - { - case 0: - break; - - case 1: - retval = subs[0]; - break; - - default: - { - // Both nsubs and ndims should be at least 2 here. - - mwSize n = nsubs <= ndims ? nsubs : ndims; - - retval = subs[--n]; - - while (--n >= 0) - retval = dims[n] * retval + subs[n]; - } - break; - } - - return retval; -} - -// The object that handles values pass to MEX files from Octave. Some -// methods in this class may set mutate_flag to TRUE to tell the -// mxArray class to convert to the Matlab-style representation and -// then invoke the method on that object instead (for example, getting -// a pointer to real or imaginary data from a complex object requires -// a mutation but getting a pointer to real data from a real object -// does not). Changing the representation causes a copy so we try to -// avoid it unless it is really necessary. Once the conversion -// happens, we delete this representation, so the conversion can only -// happen once per call to a MEX file. - -static inline void *maybe_mark_foreign (void *ptr); - -class mxArray_octave_value : public mxArray_base -{ -public: - - mxArray_octave_value (const octave_value& ov) - : mxArray_base (), val (ov), mutate_flag (false), - id (mxUNKNOWN_CLASS), class_name (0), ndims (-1), dims (0) { } - - mxArray_base *dup (void) const { return new mxArray_octave_value (*this); } - - mxArray *as_mxArray (void) const - { - return val.as_mxArray (); - } - - ~mxArray_octave_value (void) - { - mxFree (class_name); - mxFree (dims); - } - - bool is_octave_value (void) const { return true; } - - int is_cell (void) const { return val.is_cell (); } - - int is_char (void) const { return val.is_string (); } - - int is_complex (void) const { return val.is_complex_type (); } - - int is_double (void) const { return val.is_double_type (); } - - int is_function_handle (void) const { return val.is_function_handle (); } - - int is_int16 (void) const { return val.is_int16_type (); } - - int is_int32 (void) const { return val.is_int32_type (); } - - int is_int64 (void) const { return val.is_int64_type (); } - - int is_int8 (void) const { return val.is_int8_type (); } - - int is_logical (void) const { return val.is_bool_type (); } - - int is_numeric (void) const { return val.is_numeric_type (); } - - int is_single (void) const { return val.is_single_type (); } - - int is_sparse (void) const { return val.is_sparse_type (); } - - int is_struct (void) const { return val.is_map (); } - - int is_uint16 (void) const { return val.is_uint16_type (); } - - int is_uint32 (void) const { return val.is_uint32_type (); } - - int is_uint64 (void) const { return val.is_uint64_type (); } - - int is_uint8 (void) const { return val.is_uint8_type (); } - - int is_range (void) const { return val.is_range (); } - - int is_real_type (void) const { return val.is_real_type (); } - - int is_logical_scalar_true (void) const - { - return (is_logical_scalar () && val.is_true ()); - } - - mwSize get_m (void) const { return val.rows (); } - - mwSize get_n (void) const - { - mwSize n = 1; - - // Force dims and ndims to be cached. - get_dimensions (); - - for (mwIndex i = ndims - 1; i > 0; i--) - n *= dims[i]; - - return n; - } - - mwSize *get_dimensions (void) const - { - if (! dims) - { - ndims = val.ndims (); - - dims = static_cast (mxArray::malloc (ndims * sizeof (mwSize))); - - dim_vector dv = val.dims (); - - for (mwIndex i = 0; i < ndims; i++) - dims[i] = dv(i); - } - - return dims; - } - - mwSize get_number_of_dimensions (void) const - { - // Force dims and ndims to be cached. - get_dimensions (); - - return ndims; - } - - void set_m (mwSize /*m*/) { request_mutation (); } - - void set_n (mwSize /*n*/) { request_mutation (); } - - void set_dimensions (mwSize */*dims_arg*/, mwSize /*ndims_arg*/) - { - request_mutation (); - } - - mwSize get_number_of_elements (void) const { return val.numel (); } - - int is_empty (void) const { return val.is_empty (); } - - mxClassID get_class_id (void) const - { - id = mxUNKNOWN_CLASS; - - std::string cn = val.class_name (); - - if (cn == "cell") - id = mxCELL_CLASS; - else if (cn == "struct") - id = mxSTRUCT_CLASS; - else if (cn == "logical") - id = mxLOGICAL_CLASS; - else if (cn == "char") - id = mxCHAR_CLASS; - else if (cn == "double") - id = mxDOUBLE_CLASS; - else if (cn == "single") - id = mxSINGLE_CLASS; - else if (cn == "int8") - id = mxINT8_CLASS; - else if (cn == "uint8") - id = mxUINT8_CLASS; - else if (cn == "int16") - id = mxINT16_CLASS; - else if (cn == "uint16") - id = mxUINT16_CLASS; - else if (cn == "int32") - id = mxINT32_CLASS; - else if (cn == "uint32") - id = mxUINT32_CLASS; - else if (cn == "int64") - id = mxINT64_CLASS; - else if (cn == "uint64") - id = mxUINT64_CLASS; - else if (cn == "function_handle") - id = mxFUNCTION_CLASS; - - return id; - } - - const char *get_class_name (void) const - { - if (! class_name) - { - std::string s = val.class_name (); - class_name = mxArray::strsave (s.c_str ()); - } - - return class_name; - } - - // Not allowed. - void set_class_name (const char */*name_arg*/) { request_mutation (); } - - mxArray *get_cell (mwIndex /*idx*/) const - { - request_mutation (); - return 0; - } - - // Not allowed. - void set_cell (mwIndex /*idx*/, mxArray */*val*/) { request_mutation (); } - - double get_scalar (void) const { return val.scalar_value (true); } - - void *get_data (void) const - { - void *retval = val.mex_get_data (); - - if (retval) - maybe_mark_foreign (retval); - else - request_mutation (); - - return retval; - } - - void *get_imag_data (void) const - { - void *retval = 0; - - if (is_numeric () && is_real_type ()) - retval = 0; - else - request_mutation (); - - return retval; - } - - // Not allowed. - void set_data (void */*pr*/) { request_mutation (); } - - // Not allowed. - void set_imag_data (void */*pi*/) { request_mutation (); } - - mwIndex *get_ir (void) const - { - return static_cast (maybe_mark_foreign (val.mex_get_ir ())); - } - - mwIndex *get_jc (void) const - { - return static_cast (maybe_mark_foreign (val.mex_get_jc ())); - } - - mwSize get_nzmax (void) const { return val.nzmax (); } - - // Not allowed. - void set_ir (mwIndex */*ir*/) { request_mutation (); } - - // Not allowed. - void set_jc (mwIndex */*jc*/) { request_mutation (); } - - // Not allowed. - void set_nzmax (mwSize /*nzmax*/) { request_mutation (); } - - // Not allowed. - int add_field (const char */*key*/) - { - request_mutation (); - return 0; - } - - // Not allowed. - void remove_field (int /*key_num*/) { request_mutation (); } - - mxArray *get_field_by_number (mwIndex /*index*/, int /*key_num*/) const - { - request_mutation (); - return 0; - } - - // Not allowed. - void set_field_by_number (mwIndex /*index*/, int /*key_num*/, mxArray */*val*/) - { - request_mutation (); - } - - int get_number_of_fields (void) const { return val.nfields (); } - - const char *get_field_name_by_number (int /*key_num*/) const - { - request_mutation (); - return 0; - } - - int get_field_number (const char */*key*/) const - { - request_mutation (); - return 0; - } - - int get_string (char *buf, mwSize buflen) const - { - int retval = 1; - - mwSize nel = get_number_of_elements (); - - if (val.is_string () && nel < buflen) - { - charNDArray tmp = val.char_array_value (); - - const char *p = tmp.data (); - - for (mwIndex i = 0; i < nel; i++) - buf[i] = p[i]; - - buf[nel] = 0; - - retval = 0; - } - - return retval; - } - - char *array_to_string (void) const - { - // FIXME -- this is suposed to handle multi-byte character - // strings. - - char *buf = 0; - - if (val.is_string ()) - { - mwSize nel = get_number_of_elements (); - - buf = static_cast (mxArray::malloc (nel + 1)); - - if (buf) - { - charNDArray tmp = val.char_array_value (); - - const char *p = tmp.data (); - - for (mwIndex i = 0; i < nel; i++) - buf[i] = p[i]; - - buf[nel] = '\0'; - } - } - - return buf; - } - - mwIndex calc_single_subscript (mwSize nsubs, mwIndex *subs) const - { - // Force ndims, dims to be cached. - get_dimensions (); - - return calc_single_subscript_internal (ndims, dims, nsubs, subs); - } - - size_t get_element_size (void) const - { - // Force id to be cached. - get_class_id (); - - switch (id) - { - case mxCELL_CLASS: return sizeof (mxArray *); - case mxSTRUCT_CLASS: return sizeof (mxArray *); - case mxLOGICAL_CLASS: return sizeof (mxLogical); - case mxCHAR_CLASS: return sizeof (mxChar); - case mxDOUBLE_CLASS: return sizeof (double); - case mxSINGLE_CLASS: return sizeof (float); - case mxINT8_CLASS: return 1; - case mxUINT8_CLASS: return 1; - case mxINT16_CLASS: return 2; - case mxUINT16_CLASS: return 2; - case mxINT32_CLASS: return 4; - case mxUINT32_CLASS: return 4; - case mxINT64_CLASS: return 8; - case mxUINT64_CLASS: return 8; - case mxFUNCTION_CLASS: return 0; - default: return 0; - } - } - - bool mutation_needed (void) const { return mutate_flag; } - - void request_mutation (void) const - { - if (mutate_flag) - panic_impossible (); - - mutate_flag = true; - } - - mxArray *mutate (void) const { return val.as_mxArray (); } - - octave_value as_octave_value (void) const { return val; } - -protected: - - mxArray_octave_value (const mxArray_octave_value& arg) - : mxArray_base (arg), val (arg.val), mutate_flag (arg.mutate_flag), - id (arg.id), class_name (mxArray::strsave (arg.class_name)), - ndims (arg.ndims), - dims (ndims > 0 ? static_cast (mxArray::malloc (ndims * sizeof (mwSize))) : 0) - { - if (dims) - { - for (mwIndex i = 0; i < ndims; i++) - dims[i] = arg.dims[i]; - } - } - -private: - - octave_value val; - - mutable bool mutate_flag; - - // Caching these does not cost much or lead to much duplicated - // code. For other things, we just request mutation to a - // Matlab-style mxArray object. - - mutable mxClassID id; - mutable char *class_name; - mutable mwSize ndims; - mutable mwSize *dims; - - // No assignment! FIXME -- should this be implemented? Note that we - // do have a copy constructor. - - mxArray_octave_value& operator = (const mxArray_octave_value&); -}; - -// The base class for the Matlab-style representation, used to handle -// things that are common to all Matlab-style objects. - -class mxArray_matlab : public mxArray_base -{ -protected: - - mxArray_matlab (mxClassID id_arg = mxUNKNOWN_CLASS) - : mxArray_base (), class_name (0), id (id_arg), ndims (0), dims (0) { } - - mxArray_matlab (mxClassID id_arg, mwSize ndims_arg, const mwSize *dims_arg) - : mxArray_base (), class_name (0), id (id_arg), - ndims (ndims_arg < 2 ? 2 : ndims_arg), - dims (static_cast (mxArray::malloc (ndims * sizeof (mwSize)))) - { - if (ndims_arg < 2) - { - dims[0] = 1; - dims[1] = 1; - } - - for (mwIndex i = 0; i < ndims_arg; i++) - dims[i] = dims_arg[i]; - - for (mwIndex i = ndims - 1; i > 1; i--) - { - if (dims[i] == 1) - ndims--; - else - break; - } - } - - mxArray_matlab (mxClassID id_arg, const dim_vector& dv) - : mxArray_base (), class_name (0), id (id_arg), - ndims (dv.length ()), - dims (static_cast (mxArray::malloc (ndims * sizeof (mwSize)))) - { - for (mwIndex i = 0; i < ndims; i++) - dims[i] = dv(i); - - for (mwIndex i = ndims - 1; i > 1; i--) - { - if (dims[i] == 1) - ndims--; - else - break; - } - } - - mxArray_matlab (mxClassID id_arg, mwSize m, mwSize n) - : mxArray_base (), class_name (0), id (id_arg), ndims (2), - dims (static_cast (mxArray::malloc (ndims * sizeof (mwSize)))) - { - dims[0] = m; - dims[1] = n; - } - -public: - - ~mxArray_matlab (void) - { - mxFree (class_name); - mxFree (dims); - } - - int is_cell (void) const { return id == mxCELL_CLASS; } - - int is_char (void) const { return id == mxCHAR_CLASS; } - - int is_complex (void) const { return 0; } - - int is_double (void) const { return id == mxDOUBLE_CLASS; } - - int is_function_handle (void) const { return id == mxFUNCTION_CLASS; } - - int is_int16 (void) const { return id == mxINT16_CLASS; } - - int is_int32 (void) const { return id == mxINT32_CLASS; } - - int is_int64 (void) const { return id == mxINT64_CLASS; } - - int is_int8 (void) const { return id == mxINT8_CLASS; } - - int is_logical (void) const { return id == mxLOGICAL_CLASS; } - - int is_numeric (void) const - { - return (id == mxDOUBLE_CLASS || id == mxSINGLE_CLASS - || id == mxINT8_CLASS || id == mxUINT8_CLASS - || id == mxINT16_CLASS || id == mxUINT16_CLASS - || id == mxINT32_CLASS || id == mxUINT32_CLASS - || id == mxINT64_CLASS || id == mxUINT64_CLASS); - } - - int is_single (void) const { return id == mxSINGLE_CLASS; } - - int is_sparse (void) const { return 0; } - - int is_struct (void) const { return id == mxSTRUCT_CLASS; } - - int is_uint16 (void) const { return id == mxUINT16_CLASS; } - - int is_uint32 (void) const { return id == mxUINT32_CLASS; } - - int is_uint64 (void) const { return id == mxUINT64_CLASS; } - - int is_uint8 (void) const { return id == mxUINT8_CLASS; } - - int is_logical_scalar_true (void) const - { - return (is_logical_scalar () - && static_cast (get_data ())[0] != 0); - } - - mwSize get_m (void) const { return dims[0]; } - - mwSize get_n (void) const - { - mwSize n = 1; - - for (mwSize i = ndims - 1 ; i > 0 ; i--) - n *= dims[i]; - - return n; - } - - mwSize *get_dimensions (void) const { return dims; } - - mwSize get_number_of_dimensions (void) const { return ndims; } - - void set_m (mwSize m) { dims[0] = m; } - - void set_n (mwSize n) { dims[1] = n; } - - void set_dimensions (mwSize *dims_arg, mwSize ndims_arg) - { - dims = dims_arg; - ndims = ndims_arg; - } - - mwSize get_number_of_elements (void) const - { - mwSize retval = dims[0]; - - for (mwIndex i = 1; i < ndims; i++) - retval *= dims[i]; - - return retval; - } - - int is_empty (void) const { return get_number_of_elements () == 0; } - - mxClassID get_class_id (void) const { return id; } - - const char *get_class_name (void) const - { - switch (id) - { - case mxCELL_CLASS: return "cell"; - case mxSTRUCT_CLASS: return "struct"; - case mxLOGICAL_CLASS: return "logical"; - case mxCHAR_CLASS: return "char"; - case mxDOUBLE_CLASS: return "double"; - case mxSINGLE_CLASS: return "single"; - case mxINT8_CLASS: return "int8"; - case mxUINT8_CLASS: return "uint8"; - case mxINT16_CLASS: return "int16"; - case mxUINT16_CLASS: return "uint16"; - case mxINT32_CLASS: return "int32"; - case mxUINT32_CLASS: return "uint32"; - case mxINT64_CLASS: return "int64"; - case mxUINT64_CLASS: return "uint64"; - case mxFUNCTION_CLASS: return "function_handle"; - default: return "unknown"; - } - } - - void set_class_name (const char *name_arg) - { - mxFree (class_name); - class_name = static_cast (mxArray::malloc (strlen (name_arg) + 1)); - strcpy (class_name, name_arg); - } - - mxArray *get_cell (mwIndex /*idx*/) const - { - invalid_type_error (); - return 0; - } - - void set_cell (mwIndex /*idx*/, mxArray */*val*/) - { - invalid_type_error (); - } - - double get_scalar (void) const - { - invalid_type_error (); - return 0; - } - - void *get_data (void) const - { - invalid_type_error (); - return 0; - } - - void *get_imag_data (void) const - { - invalid_type_error (); - return 0; - } - - void set_data (void */*pr*/) - { - invalid_type_error (); - } - - void set_imag_data (void */*pi*/) - { - invalid_type_error (); - } - - mwIndex *get_ir (void) const - { - invalid_type_error (); - return 0; - } - - mwIndex *get_jc (void) const - { - invalid_type_error (); - return 0; - } - - mwSize get_nzmax (void) const - { - invalid_type_error (); - return 0; - } - - void set_ir (mwIndex */*ir*/) - { - invalid_type_error (); - } - - void set_jc (mwIndex */*jc*/) - { - invalid_type_error (); - } - - void set_nzmax (mwSize /*nzmax*/) - { - invalid_type_error (); - } - - int add_field (const char */*key*/) - { - invalid_type_error (); - return -1; - } - - void remove_field (int /*key_num*/) - { - invalid_type_error (); - } - - mxArray *get_field_by_number (mwIndex /*index*/, int /*key_num*/) const - { - invalid_type_error (); - return 0; - } - - void set_field_by_number (mwIndex /*index*/, int /*key_num*/, mxArray */*val*/) - { - invalid_type_error (); - } - - int get_number_of_fields (void) const - { - invalid_type_error (); - return 0; - } - - const char *get_field_name_by_number (int /*key_num*/) const - { - invalid_type_error (); - return 0; - } - - int get_field_number (const char */*key*/) const - { - return -1; - } - - int get_string (char */*buf*/, mwSize /*buflen*/) const - { - invalid_type_error (); - return 0; - } - - char *array_to_string (void) const - { - invalid_type_error (); - return 0; - } - - mwIndex calc_single_subscript (mwSize nsubs, mwIndex *subs) const - { - return calc_single_subscript_internal (ndims, dims, nsubs, subs); - } - - size_t get_element_size (void) const - { - switch (id) - { - case mxCELL_CLASS: return sizeof (mxArray *); - case mxSTRUCT_CLASS: return sizeof (mxArray *); - case mxLOGICAL_CLASS: return sizeof (mxLogical); - case mxCHAR_CLASS: return sizeof (mxChar); - case mxDOUBLE_CLASS: return sizeof (double); - case mxSINGLE_CLASS: return sizeof (float); - case mxINT8_CLASS: return 1; - case mxUINT8_CLASS: return 1; - case mxINT16_CLASS: return 2; - case mxUINT16_CLASS: return 2; - case mxINT32_CLASS: return 4; - case mxUINT32_CLASS: return 4; - case mxINT64_CLASS: return 8; - case mxUINT64_CLASS: return 8; - case mxFUNCTION_CLASS: return 0; - default: return 0; - } - } - -protected: - - mxArray_matlab (const mxArray_matlab& val) - : mxArray_base (val), class_name (mxArray::strsave (val.class_name)), - id (val.id), ndims (val.ndims), - dims (static_cast (mxArray::malloc (ndims * sizeof (mwSize)))) - { - for (mwIndex i = 0; i < ndims; i++) - dims[i] = val.dims[i]; - } - - dim_vector - dims_to_dim_vector (void) const - { - mwSize nd = get_number_of_dimensions (); - - mwSize *d = get_dimensions (); - - dim_vector dv; - dv.resize (nd); - - for (mwIndex i = 0; i < nd; i++) - dv(i) = d[i]; - - return dv; - } - -private: - - char *class_name; - - mxClassID id; - - mwSize ndims; - mwSize *dims; - - void invalid_type_error (void) const - { - error ("invalid type for operation"); - } - - // No assignment! FIXME -- should this be implemented? Note that we - // do have a copy constructor. - - mxArray_matlab& operator = (const mxArray_matlab&); -}; - -// Matlab-style numeric, character, and logical data. - -class mxArray_number : public mxArray_matlab -{ -public: - - mxArray_number (mxClassID id_arg, mwSize ndims_arg, const mwSize *dims_arg, - mxComplexity flag = mxREAL) - : mxArray_matlab (id_arg, ndims_arg, dims_arg), - pr (mxArray::calloc (get_number_of_elements (), get_element_size ())), - pi (flag == mxCOMPLEX ? mxArray::calloc (get_number_of_elements (), get_element_size ()) : 0) { } - - mxArray_number (mxClassID id_arg, const dim_vector& dv, - mxComplexity flag = mxREAL) - : mxArray_matlab (id_arg, dv), - pr (mxArray::calloc (get_number_of_elements (), get_element_size ())), - pi (flag == mxCOMPLEX ? mxArray::calloc (get_number_of_elements (), get_element_size ()) : 0) { } - - mxArray_number (mxClassID id_arg, mwSize m, mwSize n, mxComplexity flag = mxREAL) - : mxArray_matlab (id_arg, m, n), - pr (mxArray::calloc (get_number_of_elements (), get_element_size ())), - pi (flag == mxCOMPLEX ? mxArray::calloc (get_number_of_elements (), get_element_size ()) : 0) { } - - mxArray_number (mxClassID id_arg, double val) - : mxArray_matlab (id_arg, 1, 1), - pr (mxArray::calloc (get_number_of_elements (), get_element_size ())), - pi (0) - { - double *dpr = static_cast (pr); - dpr[0] = val; - } - - mxArray_number (mxClassID id_arg, mxLogical val) - : mxArray_matlab (id_arg, 1, 1), - pr (mxArray::calloc (get_number_of_elements (), get_element_size ())), - pi (0) - { - mxLogical *lpr = static_cast (pr); - lpr[0] = val; - } - - mxArray_number (const char *str) - : mxArray_matlab (mxCHAR_CLASS, - str ? (strlen (str) ? 1 : 0) : 0, - str ? strlen (str) : 0), - pr (mxArray::calloc (get_number_of_elements (), get_element_size ())), - pi (0) - { - mxChar *cpr = static_cast (pr); - mwSize nel = get_number_of_elements (); - for (mwIndex i = 0; i < nel; i++) - cpr[i] = str[i]; - } - - // FIXME?? - mxArray_number (mwSize m, const char **str) - : mxArray_matlab (mxCHAR_CLASS, m, max_str_len (m, str)), - pr (mxArray::calloc (get_number_of_elements (), get_element_size ())), - pi (0) - { - mxChar *cpr = static_cast (pr); - - mwSize *dv = get_dimensions (); - - mwSize nc = dv[1]; - - for (mwIndex j = 0; j < m; j++) - { - const char *ptr = str[j]; - - size_t tmp_len = strlen (ptr); - - for (size_t i = 0; i < tmp_len; i++) - cpr[m*i+j] = static_cast (ptr[i]); - - for (size_t i = tmp_len; i < static_cast(nc); i++) - cpr[m*i+j] = static_cast (' '); - } - } - - mxArray_base *dup (void) const { return new mxArray_number (*this); } - - ~mxArray_number (void) - { - mxFree (pr); - mxFree (pi); - } - - int is_complex (void) const { return pi != 0; } - - double get_scalar (void) const - { - double retval = 0; - - switch (get_class_id ()) - { - case mxLOGICAL_CLASS: - retval = *(static_cast (pr)); - break; - - case mxCHAR_CLASS: - retval = *(static_cast (pr)); - break; - - case mxSINGLE_CLASS: - retval = *(static_cast (pr)); - break; - - case mxDOUBLE_CLASS: - retval = *(static_cast (pr)); - break; - - case mxINT8_CLASS: - retval = *(static_cast (pr)); - break; - - case mxUINT8_CLASS: - retval = *(static_cast (pr)); - break; - - case mxINT16_CLASS: - retval = *(static_cast (pr)); - break; - - case mxUINT16_CLASS: - retval = *(static_cast (pr)); - break; - - case mxINT32_CLASS: - retval = *(static_cast (pr)); - break; - - case mxUINT32_CLASS: - retval = *(static_cast (pr)); - break; - - case mxINT64_CLASS: - retval = *(static_cast (pr)); - break; - - case mxUINT64_CLASS: - retval = *(static_cast (pr)); - break; - - default: - panic_impossible (); - } - - return retval; - } - - void *get_data (void) const { return pr; } - - void *get_imag_data (void) const { return pi; } - - void set_data (void *pr_arg) { pr = pr_arg; } - - void set_imag_data (void *pi_arg) { pi = pi_arg; } - - int get_string (char *buf, mwSize buflen) const - { - int retval = 0; - - mwSize nel = get_number_of_elements (); - - if (! (nel < buflen)) - { - retval = 1; - if (buflen > 0) - nel = buflen-1; - } - - if (nel < buflen) - { - mxChar *ptr = static_cast (pr); - - for (mwIndex i = 0; i < nel; i++) - buf[i] = static_cast (ptr[i]); - - buf[nel] = 0; - } - - return retval; - } - - char *array_to_string (void) const - { - // FIXME -- this is suposed to handle multi-byte character - // strings. - - mwSize nel = get_number_of_elements (); - - char *buf = static_cast (mxArray::malloc (nel + 1)); - - if (buf) - { - mxChar *ptr = static_cast (pr); - - for (mwIndex i = 0; i < nel; i++) - buf[i] = static_cast (ptr[i]); - - buf[nel] = '\0'; - } - - return buf; - } - - octave_value as_octave_value (void) const - { - octave_value retval; - - dim_vector dv = dims_to_dim_vector (); - - switch (get_class_id ()) - { - case mxLOGICAL_CLASS: - retval = int_to_ov (dv); - break; - - case mxCHAR_CLASS: - { - mwSize nel = get_number_of_elements (); - - mxChar *ppr = static_cast (pr); - - charNDArray val (dv); - - char *ptr = val.fortran_vec (); - - for (mwIndex i = 0; i < nel; i++) - ptr[i] = static_cast (ppr[i]); - - retval = val; - } - break; - - case mxSINGLE_CLASS: - { - mwSize nel = get_number_of_elements (); - - float *ppr = static_cast (pr); - - if (pi) - { - FloatComplexNDArray val (dv); - - FloatComplex *ptr = val.fortran_vec (); - - float *ppi = static_cast (pi); - - for (mwIndex i = 0; i < nel; i++) - ptr[i] = FloatComplex (ppr[i], ppi[i]); - - retval = val; - } - else - { - FloatNDArray val (dv); - - float *ptr = val.fortran_vec (); - - for (mwIndex i = 0; i < nel; i++) - ptr[i] = ppr[i]; - - retval = val; - } - } - break; - - case mxDOUBLE_CLASS: - { - mwSize nel = get_number_of_elements (); - - double *ppr = static_cast (pr); - - if (pi) - { - ComplexNDArray val (dv); - - Complex *ptr = val.fortran_vec (); - - double *ppi = static_cast (pi); - - for (mwIndex i = 0; i < nel; i++) - ptr[i] = Complex (ppr[i], ppi[i]); - - retval = val; - } - else - { - NDArray val (dv); - - double *ptr = val.fortran_vec (); - - for (mwIndex i = 0; i < nel; i++) - ptr[i] = ppr[i]; - - retval = val; - } - } - break; - - case mxINT8_CLASS: - retval = int_to_ov (dv); - break; - - case mxUINT8_CLASS: - retval = int_to_ov (dv); - break; - - case mxINT16_CLASS: - retval = int_to_ov (dv); - break; - - case mxUINT16_CLASS: - retval = int_to_ov (dv); - break; - - case mxINT32_CLASS: - retval = int_to_ov (dv); - break; - - case mxUINT32_CLASS: - retval = int_to_ov (dv); - break; - - case mxINT64_CLASS: - retval = int_to_ov (dv); - break; - - case mxUINT64_CLASS: - retval = int_to_ov (dv); - break; - - default: - panic_impossible (); - } - - return retval; - } - -protected: - - template - octave_value - int_to_ov (const dim_vector& dv) const - { - octave_value retval; - - mwSize nel = get_number_of_elements (); - - ELT_T *ppr = static_cast (pr); - - if (pi) - error ("complex integer types are not supported"); - else - { - ARRAY_T val (dv); - - ARRAY_ELT_T *ptr = val.fortran_vec (); - - for (mwIndex i = 0; i < nel; i++) - ptr[i] = ppr[i]; - - retval = val; - } - - return retval; - } - - mxArray_number (const mxArray_number& val) - : mxArray_matlab (val), - pr (mxArray::malloc (get_number_of_elements () * get_element_size ())), - pi (val.pi ? mxArray::malloc (get_number_of_elements () * get_element_size ()) : 0) - { - size_t nbytes = get_number_of_elements () * get_element_size (); - - if (pr) - memcpy (pr, val.pr, nbytes); - - if (pi) - memcpy (pi, val.pi, nbytes); - } - -private: - - void *pr; - void *pi; - - // No assignment! FIXME -- should this be implemented? Note that we - // do have a copy constructor. - - mxArray_number& operator = (const mxArray_number&); -}; - -// Matlab-style sparse arrays. - -class mxArray_sparse : public mxArray_matlab -{ -public: - - mxArray_sparse (mxClassID id_arg, mwSize m, mwSize n, mwSize nzmax_arg, - mxComplexity flag = mxREAL) - : mxArray_matlab (id_arg, m, n), nzmax (nzmax_arg), - pr (mxArray::calloc (nzmax, get_element_size ())), - pi (flag == mxCOMPLEX ? mxArray::calloc (nzmax, get_element_size ()) : 0), - ir (static_cast (mxArray::calloc (nzmax, sizeof (mwIndex)))), - jc (static_cast (mxArray::calloc (n + 1, sizeof (mwIndex)))) - { } - - mxArray_base *dup (void) const { return new mxArray_sparse (*this); } - - ~mxArray_sparse (void) - { - mxFree (pr); - mxFree (pi); - mxFree (ir); - mxFree (jc); - } - - int is_complex (void) const { return pi != 0; } - - int is_sparse (void) const { return 1; } - - void *get_data (void) const { return pr; } - - void *get_imag_data (void) const { return pi; } - - void set_data (void *pr_arg) { pr = pr_arg; } - - void set_imag_data (void *pi_arg) { pi = pi_arg; } - - mwIndex *get_ir (void) const { return ir; } - - mwIndex *get_jc (void) const { return jc; } - - mwSize get_nzmax (void) const { return nzmax; } - - void set_ir (mwIndex *ir_arg) { ir = ir_arg; } - - void set_jc (mwIndex *jc_arg) { jc = jc_arg; } - - void set_nzmax (mwSize nzmax_arg) { nzmax = nzmax_arg; } - - octave_value as_octave_value (void) const - { - octave_value retval; - - dim_vector dv = dims_to_dim_vector (); - - switch (get_class_id ()) - { - case mxLOGICAL_CLASS: - { - bool *ppr = static_cast (pr); - - SparseBoolMatrix val (get_m (), get_n (), - static_cast (nzmax)); - - for (mwIndex i = 0; i < nzmax; i++) - { - val.xdata (i) = ppr[i]; - val.xridx (i) = ir[i]; - } - - for (mwIndex i = 0; i < get_n () + 1; i++) - val.xcidx (i) = jc[i]; - - retval = val; - } - break; - - case mxSINGLE_CLASS: - error ("single precision sparse data type not supported"); - break; - - case mxDOUBLE_CLASS: - { - if (pi) - { - double *ppr = static_cast (pr); - double *ppi = static_cast (pi); - - SparseComplexMatrix val (get_m (), get_n (), - static_cast (nzmax)); - - for (mwIndex i = 0; i < nzmax; i++) - { - val.xdata (i) = Complex (ppr[i], ppi[i]); - val.xridx (i) = ir[i]; - } - - for (mwIndex i = 0; i < get_n () + 1; i++) - val.xcidx (i) = jc[i]; - - retval = val; - } - else - { - double *ppr = static_cast (pr); - - SparseMatrix val (get_m (), get_n (), - static_cast (nzmax)); - - for (mwIndex i = 0; i < nzmax; i++) - { - val.xdata (i) = ppr[i]; - val.xridx (i) = ir[i]; - } - - for (mwIndex i = 0; i < get_n () + 1; i++) - val.xcidx (i) = jc[i]; - - retval = val; - } - } - break; - - default: - panic_impossible (); - } - - return retval; - } - -private: - - mwSize nzmax; - - void *pr; - void *pi; - mwIndex *ir; - mwIndex *jc; - - mxArray_sparse (const mxArray_sparse& val) - : mxArray_matlab (val), nzmax (val.nzmax), - pr (mxArray::malloc (nzmax * get_element_size ())), - pi (val.pi ? mxArray::malloc (nzmax * get_element_size ()) : 0), - ir (static_cast (mxArray::malloc (nzmax * sizeof (mwIndex)))), - jc (static_cast (mxArray::malloc (nzmax * sizeof (mwIndex)))) - { - size_t nbytes = nzmax * get_element_size (); - - if (pr) - memcpy (pr, val.pr, nbytes); - - if (pi) - memcpy (pi, val.pi, nbytes); - - if (ir) - memcpy (ir, val.ir, nzmax * sizeof (mwIndex)); - - if (jc) - memcpy (jc, val.jc, (val.get_n () + 1) * sizeof (mwIndex)); - } - - // No assignment! FIXME -- should this be implemented? Note that we - // do have a copy constructor. - - mxArray_sparse& operator = (const mxArray_sparse&); -}; - -// Matlab-style struct arrays. - -class mxArray_struct : public mxArray_matlab -{ -public: - - mxArray_struct (mwSize ndims_arg, const mwSize *dims_arg, int num_keys_arg, - const char **keys) - : mxArray_matlab (mxSTRUCT_CLASS, ndims_arg, dims_arg), nfields (num_keys_arg), - fields (static_cast (mxArray::calloc (nfields, sizeof (char *)))), - data (static_cast (mxArray::calloc (nfields * get_number_of_elements (), sizeof (mxArray *)))) - { - init (keys); - } - - mxArray_struct (const dim_vector& dv, int num_keys_arg, const char **keys) - : mxArray_matlab (mxSTRUCT_CLASS, dv), nfields (num_keys_arg), - fields (static_cast (mxArray::calloc (nfields, sizeof (char *)))), - data (static_cast (mxArray::calloc (nfields * get_number_of_elements (), sizeof (mxArray *)))) - { - init (keys); - } - - mxArray_struct (mwSize m, mwSize n, int num_keys_arg, const char **keys) - : mxArray_matlab (mxSTRUCT_CLASS, m, n), nfields (num_keys_arg), - fields (static_cast (mxArray::calloc (nfields, sizeof (char *)))), - data (static_cast (mxArray::calloc (nfields * get_number_of_elements (), sizeof (mxArray *)))) - { - init (keys); - } - - void init (const char **keys) - { - for (int i = 0; i < nfields; i++) - fields[i] = mxArray::strsave (keys[i]); - } - - mxArray_base *dup (void) const { return new mxArray_struct (*this); } - - ~mxArray_struct (void) - { - for (int i = 0; i < nfields; i++) - mxFree (fields[i]); - - mxFree (fields); - - mwSize ntot = nfields * get_number_of_elements (); - - for (mwIndex i = 0; i < ntot; i++) - delete data[i]; - - mxFree (data); - } - - int add_field (const char *key) - { - int retval = -1; - - if (valid_key (key)) - { - nfields++; - - fields = static_cast (mxRealloc (fields, nfields * sizeof (char *))); - - if (fields) - { - fields[nfields-1] = mxArray::strsave (key); - - mwSize nel = get_number_of_elements (); - - mwSize ntot = nfields * nel; - - mxArray **new_data = static_cast (mxArray::malloc (ntot * sizeof (mxArray *))); - - if (new_data) - { - mwIndex j = 0; - mwIndex k = 0; - mwIndex n = 0; - - for (mwIndex i = 0; i < ntot; i++) - { - if (++n == nfields) - { - new_data[j++] = 0; - n = 0; - } - else - new_data[j++] = data[k++]; - } - - mxFree (data); - - data = new_data; - - retval = nfields - 1; - } - } - } - - return retval; - } - - void remove_field (int key_num) - { - if (key_num >= 0 && key_num < nfields) - { - mwSize nel = get_number_of_elements (); - - mwSize ntot = nfields * nel; - - int new_nfields = nfields - 1; - - char **new_fields = static_cast (mxArray::malloc (new_nfields * sizeof (char *))); - - mxArray **new_data = static_cast (mxArray::malloc (new_nfields * nel * sizeof (mxArray *))); - - for (int i = 0; i < key_num; i++) - new_fields[i] = fields[i]; - - for (int i = key_num + 1; i < nfields; i++) - new_fields[i-1] = fields[i]; - - if (new_nfields > 0) - { - mwIndex j = 0; - mwIndex k = 0; - mwIndex n = 0; - - for (mwIndex i = 0; i < ntot; i++) - { - if (n == key_num) - k++; - else - new_data[j++] = data[k++]; - - if (++n == nfields) - n = 0; - } - } - - nfields = new_nfields; - - mxFree (fields); - mxFree (data); - - fields = new_fields; - data = new_data; - } - } - - mxArray *get_field_by_number (mwIndex index, int key_num) const - { - return key_num >= 0 && key_num < nfields - ? data[nfields * index + key_num] : 0; - } - - void set_field_by_number (mwIndex index, int key_num, mxArray *val); - - int get_number_of_fields (void) const { return nfields; } - - const char *get_field_name_by_number (int key_num) const - { - return key_num >= 0 && key_num < nfields ? fields[key_num] : 0; - } - - int get_field_number (const char *key) const - { - int retval = -1; - - for (int i = 0; i < nfields; i++) - { - if (! strcmp (key, fields[i])) - { - retval = i; - break; - } - } - - return retval; - } - - void *get_data (void) const { return data; } - - void set_data (void *data_arg) { data = static_cast (data_arg); } - - octave_value as_octave_value (void) const - { - dim_vector dv = dims_to_dim_vector (); - - string_vector keys (fields, nfields); - - octave_map m; - - mwSize ntot = nfields * get_number_of_elements (); - - for (int i = 0; i < nfields; i++) - { - Cell c (dv); - - octave_value *p = c.fortran_vec (); - - mwIndex k = 0; - for (mwIndex j = i; j < ntot; j += nfields) - p[k++] = mxArray::as_octave_value (data[j]); - - m.assign (keys[i], c); - } - - return m; - } - -private: - - int nfields; - - char **fields; - - mxArray **data; - - mxArray_struct (const mxArray_struct& val) - : mxArray_matlab (val), nfields (val.nfields), - fields (static_cast (mxArray::malloc (nfields * sizeof (char *)))), - data (static_cast (mxArray::malloc (nfields * get_number_of_elements () * sizeof (mxArray *)))) - { - for (int i = 0; i < nfields; i++) - fields[i] = mxArray::strsave (val.fields[i]); - - mwSize nel = get_number_of_elements (); - - for (mwIndex i = 0; i < nel * nfields; i++) - { - mxArray *ptr = val.data[i]; - data[i] = ptr ? ptr->dup () : 0; - } - } - - // No assignment! FIXME -- should this be implemented? Note that we - // do have a copy constructor. - - mxArray_struct& operator = (const mxArray_struct& val); -}; - -// Matlab-style cell arrays. - -class mxArray_cell : public mxArray_matlab -{ -public: - - mxArray_cell (mwSize ndims_arg, const mwSize *dims_arg) - : mxArray_matlab (mxCELL_CLASS, ndims_arg, dims_arg), - data (static_cast (mxArray::calloc (get_number_of_elements (), sizeof (mxArray *)))) { } - - mxArray_cell (const dim_vector& dv) - : mxArray_matlab (mxCELL_CLASS, dv), - data (static_cast (mxArray::calloc (get_number_of_elements (), sizeof (mxArray *)))) { } - - mxArray_cell (mwSize m, mwSize n) - : mxArray_matlab (mxCELL_CLASS, m, n), - data (static_cast (mxArray::calloc (get_number_of_elements (), sizeof (mxArray *)))) { } - - mxArray_base *dup (void) const { return new mxArray_cell (*this); } - - ~mxArray_cell (void) - { - mwSize nel = get_number_of_elements (); - - for (mwIndex i = 0; i < nel; i++) - delete data[i]; - - mxFree (data); - } - - mxArray *get_cell (mwIndex idx) const - { - return idx >= 0 && idx < get_number_of_elements () ? data[idx] : 0; - } - - void set_cell (mwIndex idx, mxArray *val); - - void *get_data (void) const { return data; } - - void set_data (void *data_arg) { data = static_cast (data_arg); } - - octave_value as_octave_value (void) const - { - dim_vector dv = dims_to_dim_vector (); - - Cell c (dv); - - mwSize nel = get_number_of_elements (); - - octave_value *p = c.fortran_vec (); - - for (mwIndex i = 0; i < nel; i++) - p[i] = mxArray::as_octave_value (data[i]); - - return c; - } - -private: - - mxArray **data; - - mxArray_cell (const mxArray_cell& val) - : mxArray_matlab (val), - data (static_cast (mxArray::malloc (get_number_of_elements () * sizeof (mxArray *)))) - { - mwSize nel = get_number_of_elements (); - - for (mwIndex i = 0; i < nel; i++) - { - mxArray *ptr = val.data[i]; - data[i] = ptr ? ptr->dup () : 0; - } - } - - // No assignment! FIXME -- should this be implemented? Note that we - // do have a copy constructor. - - mxArray_cell& operator = (const mxArray_cell&); -}; - -// ------------------------------------------------------------------ - -mxArray::mxArray (const octave_value& ov) - : rep (new mxArray_octave_value (ov)), name (0) { } - -mxArray::mxArray (mxClassID id, mwSize ndims, const mwSize *dims, mxComplexity flag) - : rep (new mxArray_number (id, ndims, dims, flag)), name (0) { } - -mxArray::mxArray (mxClassID id, const dim_vector& dv, mxComplexity flag) - : rep (new mxArray_number (id, dv, flag)), name (0) { } - -mxArray::mxArray (mxClassID id, mwSize m, mwSize n, mxComplexity flag) - : rep (new mxArray_number (id, m, n, flag)), name (0) { } - -mxArray::mxArray (mxClassID id, double val) - : rep (new mxArray_number (id, val)), name (0) { } - -mxArray::mxArray (mxClassID id, mxLogical val) - : rep (new mxArray_number (id, val)), name (0) { } - -mxArray::mxArray (const char *str) - : rep (new mxArray_number (str)), name (0) { } - -mxArray::mxArray (mwSize m, const char **str) - : rep (new mxArray_number (m, str)), name (0) { } - -mxArray::mxArray (mxClassID id, mwSize m, mwSize n, mwSize nzmax, mxComplexity flag) - : rep (new mxArray_sparse (id, m, n, nzmax, flag)), name (0) { } - -mxArray::mxArray (mwSize ndims, const mwSize *dims, int num_keys, const char **keys) - : rep (new mxArray_struct (ndims, dims, num_keys, keys)), name (0) { } - -mxArray::mxArray (const dim_vector& dv, int num_keys, const char **keys) - : rep (new mxArray_struct (dv, num_keys, keys)), name (0) { } - -mxArray::mxArray (mwSize m, mwSize n, int num_keys, const char **keys) - : rep (new mxArray_struct (m, n, num_keys, keys)), name (0) { } - -mxArray::mxArray (mwSize ndims, const mwSize *dims) - : rep (new mxArray_cell (ndims, dims)), name (0) { } - -mxArray::mxArray (const dim_vector& dv) - : rep (new mxArray_cell (dv)), name (0) { } - -mxArray::mxArray (mwSize m, mwSize n) - : rep (new mxArray_cell (m, n)), name (0) { } - -mxArray::~mxArray (void) -{ - mxFree (name); - - delete rep; -} - -void -mxArray::set_name (const char *name_arg) -{ - mxFree (name); - name = mxArray::strsave (name_arg); -} - -octave_value -mxArray::as_octave_value (const mxArray *ptr) -{ - return ptr ? ptr->as_octave_value () : octave_value (Matrix ()); -} - -octave_value -mxArray::as_octave_value (void) const -{ - return rep->as_octave_value (); -} - -void -mxArray::maybe_mutate (void) const -{ - if (rep->is_octave_value ()) - { - // The mutate function returns a pointer to a complete new - // mxArray object (or 0, if no mutation happened). We just want - // to replace the existing rep with the rep from the new object. - - mxArray *new_val = rep->mutate (); - - if (new_val) - { - delete rep; - rep = new_val->rep; - new_val->rep = 0; - delete new_val; - } - } -} - -// ------------------------------------------------------------------ - -// A class to manage calls to MEX functions. Mostly deals with memory -// management. - -class mex -{ -public: - - mex (octave_mex_function *f) - : curr_mex_fcn (f), memlist (), arraylist (), fname (0) { } - - ~mex (void) - { - if (! memlist.empty ()) - error ("mex: %s: cleanup failed", function_name ()); - - mxFree (fname); - } - - const char *function_name (void) const - { - if (! fname) - { - octave_function *fcn = octave_call_stack::current (); - - if (fcn) - { - std::string nm = fcn->name (); - fname = mxArray::strsave (nm.c_str ()); - } - else - fname = mxArray::strsave ("unknown"); - } - - return fname; - } - - // Free all unmarked pointers obtained from malloc and calloc. - static void cleanup (void *ptr) - { - mex *context = static_cast (ptr); - - // We can't use mex::free here because it modifies memlist. - for (std::set::iterator p = context->memlist.begin (); - p != context->memlist.end (); p++) - xfree (*p); - - context->memlist.clear (); - - // We can't use mex::free_value here because it modifies arraylist. - for (std::set::iterator p = context->arraylist.begin (); - p != context->arraylist.end (); p++) - delete *p; - - context->arraylist.clear (); - } - - // Allocate memory. - void *malloc_unmarked (size_t n) - { - void *ptr = gnulib::malloc (n); - - if (! ptr) - { - // FIXME -- could use "octave_new_handler();" instead - - error ("%s: failed to allocate %d bytes of memory", - function_name (), n); - - abort (); - } - - global_mark (ptr); - - return ptr; - } - - // Allocate memory to be freed on exit. - void *malloc (size_t n) - { - void *ptr = malloc_unmarked (n); - - mark (ptr); - - return ptr; - } - - // Allocate memory and initialize to 0. - void *calloc_unmarked (size_t n, size_t t) - { - void *ptr = malloc_unmarked (n*t); - - memset (ptr, 0, n*t); - - return ptr; - } - - // Allocate memory to be freed on exit and initialize to 0. - void *calloc (size_t n, size_t t) - { - void *ptr = calloc_unmarked (n, t); - - mark (ptr); - - return ptr; - } - - // Reallocate a pointer obtained from malloc or calloc. If the - // pointer is NULL, allocate using malloc. We don't need an - // "unmarked" version of this. - void *realloc (void *ptr, size_t n) - { - void *v; - - if (ptr) - { - v = gnulib::realloc (ptr, n); - - std::set::iterator p = memlist.find (ptr); - - if (v && p != memlist.end ()) - { - memlist.erase (p); - memlist.insert (v); - } - - p = global_memlist.find (ptr); - - if (v && p != global_memlist.end ()) - { - global_memlist.erase (p); - global_memlist.insert (v); - } - } - else - v = malloc (n); - - return v; - } - - // Free a pointer obtained from malloc or calloc. - void free (void *ptr) - { - if (ptr) - { - unmark (ptr); - - std::set::iterator p = global_memlist.find (ptr); - - if (p != global_memlist.end ()) - { - global_memlist.erase (p); - - xfree (ptr); - } - else - { - p = foreign_memlist.find (ptr); - - if (p != foreign_memlist.end ()) - foreign_memlist.erase (p); -#ifdef DEBUG - else - warning ("mxFree: skipping memory not allocated by mxMalloc, mxCalloc, or mxRealloc"); -#endif - } - } - } - - // Mark a pointer to be freed on exit. - void mark (void *ptr) - { -#ifdef DEBUG - if (memlist.find (ptr) != memlist.end ()) - warning ("%s: double registration ignored", function_name ()); -#endif - - memlist.insert (ptr); - } - - // Unmark a pointer to be freed on exit, either because it was - // made persistent, or because it was already freed. - void unmark (void *ptr) - { - std::set::iterator p = memlist.find (ptr); - - if (p != memlist.end ()) - memlist.erase (p); -#ifdef DEBUG - else - warning ("%s: value not marked", function_name ()); -#endif - } - - mxArray *mark_array (mxArray *ptr) - { - arraylist.insert (ptr); - return ptr; - } - - void unmark_array (mxArray *ptr) - { - std::set::iterator p = arraylist.find (ptr); - - if (p != arraylist.end ()) - arraylist.erase (p); - } - - // Mark a pointer as one we allocated. - void mark_foreign (void *ptr) - { -#ifdef DEBUG - if (foreign_memlist.find (ptr) != foreign_memlist.end ()) - warning ("%s: double registration ignored", function_name ()); -#endif - - foreign_memlist.insert (ptr); - } - - // Unmark a pointer as one we allocated. - void unmark_foreign (void *ptr) - { - std::set::iterator p = foreign_memlist.find (ptr); - - if (p != foreign_memlist.end ()) - foreign_memlist.erase (p); -#ifdef DEBUG - else - warning ("%s: value not marked", function_name ()); -#endif - - } - - // Make a new array value and initialize from an octave value; it will be - // freed on exit unless marked as persistent. - mxArray *make_value (const octave_value& ov) - { - return mark_array (new mxArray (ov)); - } - - // Free an array and its contents. - bool free_value (mxArray *ptr) - { - bool inlist = false; - - std::set::iterator p = arraylist.find (ptr); - - if (p != arraylist.end ()) - { - inlist = true; - arraylist.erase (p); - delete ptr; - } -#ifdef DEBUG - else - warning ("mex::free_value: skipping memory not allocated by mex::make_value"); -#endif - - return inlist; - } - - octave_mex_function *current_mex_function (void) const - { - return curr_mex_fcn; - } - - // 1 if error should be returned to MEX file, 0 if abort. - int trap_feval_error; - - // longjmp return point if mexErrMsgTxt or error. - jmp_buf jump; - - // Trigger a long jump back to the mex calling function. - void abort (void) { longjmp (jump, 1); } - -private: - - // Pointer to the mex function that corresponds to this mex context. - octave_mex_function *curr_mex_fcn; - - // List of memory resources that need to be freed upon exit. - std::set memlist; - - // List of mxArray objects that need to be freed upon exit. - std::set arraylist; - - // List of memory resources we know about, but that were allocated - // elsewhere. - std::set foreign_memlist; - - // The name of the currently executing function. - mutable char *fname; - - // List of memory resources we allocated. - static std::set global_memlist; - - // Mark a pointer as one we allocated. - void global_mark (void *ptr) - { -#ifdef DEBUG - if (global_memlist.find (ptr) != global_memlist.end ()) - warning ("%s: double registration ignored", function_name ()); -#endif - - global_memlist.insert (ptr); - } - - // Unmark a pointer as one we allocated. - void global_unmark (void *ptr) - { - std::set::iterator p = global_memlist.find (ptr); - - if (p != global_memlist.end ()) - global_memlist.erase (p); -#ifdef DEBUG - else - warning ("%s: value not marked", function_name ()); -#endif - - } - - // No copying! - - mex (const mex&); - - mex& operator = (const mex&); -}; - -// List of memory resources we allocated. -std::set mex::global_memlist; - -// Current context. -mex *mex_context = 0; - -void * -mxArray::malloc (size_t n) -{ - return mex_context ? mex_context->malloc_unmarked (n) : gnulib::malloc (n); -} - -void * -mxArray::calloc (size_t n, size_t t) -{ - return mex_context ? mex_context->calloc_unmarked (n, t) : ::calloc (n, t); -} - -static inline void * -maybe_mark_foreign (void *ptr) -{ - if (mex_context) - mex_context->mark_foreign (ptr); - - return ptr; -} - -static inline mxArray * -maybe_unmark_array (mxArray *ptr) -{ - if (mex_context) - mex_context->unmark_array (ptr); - - return ptr; -} - -static inline void * -maybe_unmark (void *ptr) -{ - if (mex_context) - mex_context->unmark (ptr); - - return ptr; -} - -void -mxArray_struct::set_field_by_number (mwIndex index, int key_num, mxArray *val) -{ - if (key_num >= 0 && key_num < nfields) - data[nfields * index + key_num] = maybe_unmark_array (val); -} - -void -mxArray_cell::set_cell (mwIndex idx, mxArray *val) -{ - if (idx >= 0 && idx < get_number_of_elements ()) - data[idx] = maybe_unmark_array (val); -} - -// ------------------------------------------------------------------ - -// C interface to mxArray objects: - -// Floating point predicates. - -int -mxIsFinite (const double v) -{ - return lo_ieee_finite (v) != 0; -} - -int -mxIsInf (const double v) -{ - return lo_ieee_isinf (v) != 0; -} - -int -mxIsNaN (const double v) -{ - return lo_ieee_isnan (v) != 0; -} - -double -mxGetEps (void) -{ - return std::numeric_limits::epsilon (); -} - -double -mxGetInf (void) -{ - return lo_ieee_inf_value (); -} - -double -mxGetNaN (void) -{ - return lo_ieee_nan_value (); -} - -// Memory management. -void * -mxCalloc (size_t n, size_t size) -{ - return mex_context ? mex_context->calloc (n, size) : ::calloc (n, size); -} - -void * -mxMalloc (size_t n) -{ - return mex_context ? mex_context->malloc (n) : gnulib::malloc (n); -} - -void * -mxRealloc (void *ptr, size_t size) -{ - return mex_context ? mex_context->realloc (ptr, size) : gnulib::realloc (ptr, size); -} - -void -mxFree (void *ptr) -{ - if (mex_context) - mex_context->free (ptr); - else - xfree (ptr); -} - -static inline mxArray * -maybe_mark_array (mxArray *ptr) -{ - return mex_context ? mex_context->mark_array (ptr) : ptr; -} - -// Constructors. -mxArray * -mxCreateCellArray (mwSize ndims, const mwSize *dims) -{ - return maybe_mark_array (new mxArray (ndims, dims)); -} - -mxArray * -mxCreateCellMatrix (mwSize m, mwSize n) -{ - return maybe_mark_array (new mxArray (m, n)); -} - -mxArray * -mxCreateCharArray (mwSize ndims, const mwSize *dims) -{ - return maybe_mark_array (new mxArray (mxCHAR_CLASS, ndims, dims)); -} - -mxArray * -mxCreateCharMatrixFromStrings (mwSize m, const char **str) -{ - return maybe_mark_array (new mxArray (m, str)); -} - -mxArray * -mxCreateDoubleMatrix (mwSize m, mwSize n, mxComplexity flag) -{ - return maybe_mark_array (new mxArray (mxDOUBLE_CLASS, m, n, flag)); -} - -mxArray * -mxCreateDoubleScalar (double val) -{ - return maybe_mark_array (new mxArray (mxDOUBLE_CLASS, val)); -} - -mxArray * -mxCreateLogicalArray (mwSize ndims, const mwSize *dims) -{ - return maybe_mark_array (new mxArray (mxLOGICAL_CLASS, ndims, dims)); -} - -mxArray * -mxCreateLogicalMatrix (mwSize m, mwSize n) -{ - return maybe_mark_array (new mxArray (mxLOGICAL_CLASS, m, n)); -} - -mxArray * -mxCreateLogicalScalar (mxLogical val) -{ - return maybe_mark_array (new mxArray (mxLOGICAL_CLASS, val)); -} - -mxArray * -mxCreateNumericArray (mwSize ndims, const mwSize *dims, mxClassID class_id, - mxComplexity flag) -{ - return maybe_mark_array (new mxArray (class_id, ndims, dims, flag)); -} - -mxArray * -mxCreateNumericMatrix (mwSize m, mwSize n, mxClassID class_id, mxComplexity flag) -{ - return maybe_mark_array (new mxArray (class_id, m, n, flag)); -} - -mxArray * -mxCreateSparse (mwSize m, mwSize n, mwSize nzmax, mxComplexity flag) -{ - return maybe_mark_array (new mxArray (mxDOUBLE_CLASS, m, n, nzmax, flag)); -} - -mxArray * -mxCreateSparseLogicalMatrix (mwSize m, mwSize n, mwSize nzmax) -{ - return maybe_mark_array (new mxArray (mxLOGICAL_CLASS, m, n, nzmax)); -} - -mxArray * -mxCreateString (const char *str) -{ - return maybe_mark_array (new mxArray (str)); -} - -mxArray * -mxCreateStructArray (mwSize ndims, const mwSize *dims, int num_keys, const char **keys) -{ - return maybe_mark_array (new mxArray (ndims, dims, num_keys, keys)); -} - -mxArray * -mxCreateStructMatrix (mwSize m, mwSize n, int num_keys, const char **keys) -{ - return maybe_mark_array (new mxArray (m, n, num_keys, keys)); -} - -// Copy constructor. -mxArray * -mxDuplicateArray (const mxArray *ptr) -{ - return maybe_mark_array (ptr->dup ()); -} - -// Destructor. -void -mxDestroyArray (mxArray *ptr) -{ - if (! (mex_context && mex_context->free_value (ptr))) - delete ptr; -} - -// Type Predicates. -int -mxIsCell (const mxArray *ptr) -{ - return ptr->is_cell (); -} - -int -mxIsChar (const mxArray *ptr) -{ - return ptr->is_char (); -} - -int -mxIsClass (const mxArray *ptr, const char *name) -{ - return ptr->is_class (name); -} - -int -mxIsComplex (const mxArray *ptr) -{ - return ptr->is_complex (); -} - -int -mxIsDouble (const mxArray *ptr) -{ - return ptr->is_double (); -} - -int -mxIsFunctionHandle (const mxArray *ptr) -{ - return ptr->is_function_handle (); -} - -int -mxIsInt16 (const mxArray *ptr) -{ - return ptr->is_int16 (); -} - -int -mxIsInt32 (const mxArray *ptr) -{ - return ptr->is_int32 (); -} - -int -mxIsInt64 (const mxArray *ptr) -{ - return ptr->is_int64 (); -} - -int -mxIsInt8 (const mxArray *ptr) -{ - return ptr->is_int8 (); -} - -int -mxIsLogical (const mxArray *ptr) -{ - return ptr->is_logical (); -} - -int -mxIsNumeric (const mxArray *ptr) -{ - return ptr->is_numeric (); -} - -int -mxIsSingle (const mxArray *ptr) -{ - return ptr->is_single (); -} - -int -mxIsSparse (const mxArray *ptr) -{ - return ptr->is_sparse (); -} - -int -mxIsStruct (const mxArray *ptr) -{ - return ptr->is_struct (); -} - -int -mxIsUint16 (const mxArray *ptr) -{ - return ptr->is_uint16 (); -} - -int -mxIsUint32 (const mxArray *ptr) -{ - return ptr->is_uint32 (); -} - -int -mxIsUint64 (const mxArray *ptr) -{ - return ptr->is_uint64 (); -} - -int -mxIsUint8 (const mxArray *ptr) -{ - return ptr->is_uint8 (); -} - -// Odd type+size predicate. -int -mxIsLogicalScalar (const mxArray *ptr) -{ - return ptr->is_logical_scalar (); -} - -// Odd type+size+value predicate. -int -mxIsLogicalScalarTrue (const mxArray *ptr) -{ - return ptr->is_logical_scalar_true (); -} - -// Size predicate. -int -mxIsEmpty (const mxArray *ptr) -{ - return ptr->is_empty (); -} - -// Just plain odd thing to ask of a value. -int -mxIsFromGlobalWS (const mxArray */*ptr*/) -{ - // FIXME - abort (); - return 0; -} - -// Dimension extractors. -size_t -mxGetM (const mxArray *ptr) -{ - return ptr->get_m (); -} - -size_t -mxGetN (const mxArray *ptr) -{ - return ptr->get_n (); -} - -mwSize * -mxGetDimensions (const mxArray *ptr) -{ - return ptr->get_dimensions (); -} - -mwSize -mxGetNumberOfDimensions (const mxArray *ptr) -{ - return ptr->get_number_of_dimensions (); -} - -size_t -mxGetNumberOfElements (const mxArray *ptr) -{ - return ptr->get_number_of_elements (); -} - -// Dimension setters. -void -mxSetM (mxArray *ptr, mwSize m) -{ - ptr->set_m (m); -} - -void -mxSetN (mxArray *ptr, mwSize n) -{ - ptr->set_n (n); -} - -void -mxSetDimensions (mxArray *ptr, const mwSize *dims, mwSize ndims) -{ - ptr->set_dimensions (static_cast ( - maybe_unmark (const_cast (dims))), - ndims); -} - -// Data extractors. -double * -mxGetPr (const mxArray *ptr) -{ - return static_cast (ptr->get_data ()); -} - -double * -mxGetPi (const mxArray *ptr) -{ - return static_cast (ptr->get_imag_data ()); -} - -double -mxGetScalar (const mxArray *ptr) -{ - return ptr->get_scalar (); -} - -mxChar * -mxGetChars (const mxArray *ptr) -{ - return static_cast (ptr->get_data ()); -} - -mxLogical * -mxGetLogicals (const mxArray *ptr) -{ - return static_cast (ptr->get_data ()); -} - -void * -mxGetData (const mxArray *ptr) -{ - return ptr->get_data (); -} - -void * -mxGetImagData (const mxArray *ptr) -{ - return ptr->get_imag_data (); -} - -// Data setters. -void -mxSetPr (mxArray *ptr, double *pr) -{ - ptr->set_data (maybe_unmark (pr)); -} - -void -mxSetPi (mxArray *ptr, double *pi) -{ - ptr->set_imag_data (maybe_unmark (pi)); -} - -void -mxSetData (mxArray *ptr, void *pr) -{ - ptr->set_data (maybe_unmark (pr)); -} - -void -mxSetImagData (mxArray *ptr, void *pi) -{ - ptr->set_imag_data (maybe_unmark (pi)); -} - -// Classes. -mxClassID -mxGetClassID (const mxArray *ptr) -{ - return ptr->get_class_id (); -} - -const char * -mxGetClassName (const mxArray *ptr) -{ - return ptr->get_class_name (); -} - -void -mxSetClassName (mxArray *ptr, const char *name) -{ - ptr->set_class_name (name); -} - -// Cell support. -mxArray * -mxGetCell (const mxArray *ptr, mwIndex idx) -{ - return ptr->get_cell (idx); -} - -void -mxSetCell (mxArray *ptr, mwIndex idx, mxArray *val) -{ - ptr->set_cell (idx, val); -} - -// Sparse support. -mwIndex * -mxGetIr (const mxArray *ptr) -{ - return ptr->get_ir (); -} - -mwIndex * -mxGetJc (const mxArray *ptr) -{ - return ptr->get_jc (); -} - -mwSize -mxGetNzmax (const mxArray *ptr) -{ - return ptr->get_nzmax (); -} - -void -mxSetIr (mxArray *ptr, mwIndex *ir) -{ - ptr->set_ir (static_cast (maybe_unmark (ir))); -} - -void -mxSetJc (mxArray *ptr, mwIndex *jc) -{ - ptr->set_jc (static_cast (maybe_unmark (jc))); -} - -void -mxSetNzmax (mxArray *ptr, mwSize nzmax) -{ - ptr->set_nzmax (nzmax); -} - -// Structure support. -int -mxAddField (mxArray *ptr, const char *key) -{ - return ptr->add_field (key); -} - -void -mxRemoveField (mxArray *ptr, int key_num) -{ - ptr->remove_field (key_num); -} - -mxArray * -mxGetField (const mxArray *ptr, mwIndex index, const char *key) -{ - int key_num = mxGetFieldNumber (ptr, key); - return mxGetFieldByNumber (ptr, index, key_num); -} - -mxArray * -mxGetFieldByNumber (const mxArray *ptr, mwIndex index, int key_num) -{ - return ptr->get_field_by_number (index, key_num); -} - -void -mxSetField (mxArray *ptr, mwIndex index, const char *key, mxArray *val) -{ - int key_num = mxGetFieldNumber (ptr, key); - mxSetFieldByNumber (ptr, index, key_num, val); -} - -void -mxSetFieldByNumber (mxArray *ptr, mwIndex index, int key_num, mxArray *val) -{ - ptr->set_field_by_number (index, key_num, val); -} - -int -mxGetNumberOfFields (const mxArray *ptr) -{ - return ptr->get_number_of_fields (); -} - -const char * -mxGetFieldNameByNumber (const mxArray *ptr, int key_num) -{ - return ptr->get_field_name_by_number (key_num); -} - -int -mxGetFieldNumber (const mxArray *ptr, const char *key) -{ - return ptr->get_field_number (key); -} - -int -mxGetString (const mxArray *ptr, char *buf, mwSize buflen) -{ - return ptr->get_string (buf, buflen); -} - -char * -mxArrayToString (const mxArray *ptr) -{ - return ptr->array_to_string (); -} - -mwIndex -mxCalcSingleSubscript (const mxArray *ptr, mwSize nsubs, mwIndex *subs) -{ - return ptr->calc_single_subscript (nsubs, subs); -} - -size_t -mxGetElementSize (const mxArray *ptr) -{ - return ptr->get_element_size (); -} - -// ------------------------------------------------------------------ - -typedef void (*cmex_fptr) (int nlhs, mxArray **plhs, int nrhs, mxArray **prhs); -typedef F77_RET_T (*fmex_fptr) (int& nlhs, mxArray **plhs, int& nrhs, mxArray **prhs); - -octave_value_list -call_mex (bool have_fmex, void *f, const octave_value_list& args, - int nargout_arg, octave_mex_function *curr_mex_fcn) -{ - // Use at least 1 for nargout since even for zero specified args, - // still want to be able to return an ans. - - volatile int nargout = nargout_arg; - - int nargin = args.length (); - OCTAVE_LOCAL_BUFFER (mxArray *, argin, nargin); - for (int i = 0; i < nargin; i++) - argin[i] = 0; - - int nout = nargout == 0 ? 1 : nargout; - OCTAVE_LOCAL_BUFFER (mxArray *, argout, nout); - for (int i = 0; i < nout; i++) - argout[i] = 0; - - unwind_protect_safe frame; - - // Save old mex pointer. - frame.protect_var (mex_context); - - mex context (curr_mex_fcn); - - frame.add_fcn (mex::cleanup, static_cast (&context)); - - for (int i = 0; i < nargin; i++) - argin[i] = context.make_value (args(i)); - - if (setjmp (context.jump) == 0) - { - mex_context = &context; - - if (have_fmex) - { - fmex_fptr fcn = FCN_PTR_CAST (fmex_fptr, f); - - int tmp_nargout = nargout; - int tmp_nargin = nargin; - - fcn (tmp_nargout, argout, tmp_nargin, argin); - } - else - { - cmex_fptr fcn = FCN_PTR_CAST (cmex_fptr, f); - - fcn (nargout, argout, nargin, argin); - } - } - - // Convert returned array entries back into octave values. - - octave_value_list retval; - - if (! error_state) - { - if (nargout == 0 && argout[0]) - { - // We have something for ans. - nargout = 1; - } - - retval.resize (nargout); - - for (int i = 0; i < nargout; i++) - retval(i) = mxArray::as_octave_value (argout[i]); - } - - // Clean up mex resources. - frame.run (); - - return retval; -} - -// C interface to mex functions: - -const char * -mexFunctionName (void) -{ - return mex_context ? mex_context->function_name () : "unknown"; -} - -int -mexCallMATLAB (int nargout, mxArray *argout[], int nargin, - mxArray *argin[], const char *fname) -{ - octave_value_list args; - - // FIXME -- do we need unwind protect to clean up args? Off hand, I - // would say that this problem is endemic to Octave and we will - // continue to have memory leaks after Ctrl-C until proper exception - // handling is implemented. longjmp() only clears the stack, so any - // class which allocates data on the heap is going to leak. - - args.resize (nargin); - - for (int i = 0; i < nargin; i++) - args(i) = mxArray::as_octave_value (argin[i]); - - octave_value_list retval = feval (fname, args, nargout); - - if (error_state && mex_context->trap_feval_error == 0) - { - // FIXME -- is this the correct way to clean up? abort() is - // going to trigger a long jump, so the normal class destructors - // will not be called. Hopefully this will reduce things to a - // tiny leak. Maybe create a new octave memory tracer type - // which prints a friendly message every time it is - // created/copied/deleted to check this. - - args.resize (0); - retval.resize (0); - mex_context->abort (); - } - - int num_to_copy = retval.length (); - - if (nargout < retval.length ()) - num_to_copy = nargout; - - for (int i = 0; i < num_to_copy; i++) - { - // FIXME -- it would be nice to avoid copying the value here, - // but there is no way to steal memory from a matrix, never mind - // that matrix memory is allocated by new[] and mxArray memory - // is allocated by malloc(). - argout[i] = mex_context->make_value (retval (i)); - } - - while (num_to_copy < nargout) - argout[num_to_copy++] = 0; - - if (error_state) - { - error_state = 0; - return 1; - } - else - return 0; -} - -void -mexSetTrapFlag (int flag) -{ - if (mex_context) - mex_context->trap_feval_error = flag; -} - -int -mexEvalString (const char *s) -{ - int retval = 0; - - int parse_status; - - octave_value_list ret; - - ret = eval_string (s, false, parse_status, 0); - - if (parse_status || error_state) - { - error_state = 0; - - retval = 1; - } - - return retval; -} - -void -mexErrMsgTxt (const char *s) -{ - if (s && strlen (s) > 0) - error ("%s: %s", mexFunctionName (), s); - else - { - // For compatibility with Matlab, print an empty message. - // Octave's error routine requires a non-null input so use a SPACE. - error (" "); - } - - mex_context->abort (); -} - -void -mexErrMsgIdAndTxt (const char *id, const char *fmt, ...) -{ - if (fmt && strlen (fmt) > 0) - { - const char *fname = mexFunctionName (); - size_t len = strlen (fname) + 2 + strlen (fmt) + 1; - OCTAVE_LOCAL_BUFFER (char, tmpfmt, len); - sprintf (tmpfmt, "%s: %s", fname, fmt); - va_list args; - va_start (args, fmt); - verror_with_id (id, tmpfmt, args); - va_end (args); - } - else - { - // For compatibility with Matlab, print an empty message. - // Octave's error routine requires a non-null input so use a SPACE. - error (" "); - } - - mex_context->abort (); -} - -void -mexWarnMsgTxt (const char *s) -{ - warning ("%s", s); -} - -void -mexWarnMsgIdAndTxt (const char *id, const char *fmt, ...) -{ - // FIXME -- is this right? What does Matlab do if fmt is NULL or - // an empty string? - - if (fmt && strlen (fmt) > 0) - { - const char *fname = mexFunctionName (); - size_t len = strlen (fname) + 2 + strlen (fmt) + 1; - OCTAVE_LOCAL_BUFFER (char, tmpfmt, len); - sprintf (tmpfmt, "%s: %s", fname, fmt); - va_list args; - va_start (args, fmt); - vwarning_with_id (id, tmpfmt, args); - va_end (args); - } -} - -int -mexPrintf (const char *fmt, ...) -{ - int retval; - va_list args; - va_start (args, fmt); - retval = octave_vformat (octave_stdout, fmt, args); - va_end (args); - return retval; -} - -mxArray * -mexGetVariable (const char *space, const char *name) -{ - mxArray *retval = 0; - - octave_value val; - - if (! strcmp (space, "global")) - val = get_global_value (name); - else - { - // FIXME -- should this be in variables.cc? - - unwind_protect frame; - - bool caller = ! strcmp (space, "caller"); - bool base = ! strcmp (space, "base"); - - if (caller || base) - { - // MEX files don't create a separate frame in the call stack, - // so we are already in the "caller" frame. - - if (base) - { - octave_call_stack::goto_base_frame (); - - if (error_state) - return retval; - - frame.add_fcn (octave_call_stack::pop); - } - - val = symbol_table::varval (name); - } - else - mexErrMsgTxt ("mexGetVariable: symbol table does not exist"); - } - - if (val.is_defined ()) - { - retval = mex_context->make_value (val); - - retval->set_name (name); - } - - return retval; -} - -const mxArray * -mexGetVariablePtr (const char *space, const char *name) -{ - return mexGetVariable (space, name); -} - -int -mexPutVariable (const char *space, const char *name, const mxArray *ptr) -{ - if (! ptr) - return 1; - - if (! name) - return 1; - - if (name[0] == '\0') - name = ptr->get_name (); - - if (! name || name[0] == '\0') - return 1; - - if (! strcmp (space, "global")) - set_global_value (name, mxArray::as_octave_value (ptr)); - else - { - // FIXME -- should this be in variables.cc? - - unwind_protect frame; - - bool caller = ! strcmp (space, "caller"); - bool base = ! strcmp (space, "base"); - - if (caller || base) - { - // MEX files don't create a separate frame in the call stack, - // so we are already in the "caller" frame. - - if (base) - { - octave_call_stack::goto_base_frame (); - - if (error_state) - return 1; - - frame.add_fcn (octave_call_stack::pop); - } - - symbol_table::assign (name, mxArray::as_octave_value (ptr)); - } - else - mexErrMsgTxt ("mexPutVariable: symbol table does not exist"); - } - - return 0; -} - -void -mexMakeArrayPersistent (mxArray *ptr) -{ - maybe_unmark_array (ptr); -} - -void -mexMakeMemoryPersistent (void *ptr) -{ - maybe_unmark (ptr); -} - -int -mexAtExit (void (*f) (void)) -{ - if (mex_context) - { - octave_mex_function *curr_mex_fcn = mex_context->current_mex_function (); - - assert (curr_mex_fcn); - - curr_mex_fcn->atexit (f); - } - - return 0; -} - -const mxArray * -mexGet (double handle, const char *property) -{ - mxArray *m = 0; - octave_value ret = get_property_from_handle (handle, property, "mexGet"); - - if (!error_state && ret.is_defined ()) - m = ret.as_mxArray (); - return m; -} - -int -mexIsGlobal (const mxArray *ptr) -{ - return mxIsFromGlobalWS (ptr); -} - -int -mexIsLocked (void) -{ - int retval = 0; - - if (mex_context) - { - const char *fname = mexFunctionName (); - - retval = mislocked (fname); - } - - return retval; -} - -std::map mex_lock_count; - -void -mexLock (void) -{ - if (mex_context) - { - const char *fname = mexFunctionName (); - - if (mex_lock_count.find (fname) == mex_lock_count.end ()) - mex_lock_count[fname] = 1; - else - mex_lock_count[fname]++; - - mlock (); - } -} - -int -mexSet (double handle, const char *property, mxArray *val) -{ - bool ret = - set_property_in_handle (handle, property, mxArray::as_octave_value (val), - "mexSet"); - return (ret ? 0 : 1); -} - -void -mexUnlock (void) -{ - if (mex_context) - { - const char *fname = mexFunctionName (); - - std::map::iterator p = mex_lock_count.find (fname); - - if (p != mex_lock_count.end ()) - { - int count = --mex_lock_count[fname]; - - if (count == 0) - { - munlock (fname); - - mex_lock_count.erase (p); - } - } - } -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/mex.h --- a/libinterp/interp-core/mex.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,175 +0,0 @@ -/* - -Copyright (C) 2001-2012 Paul Kienzle - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -/* - -This code was originally distributed as part of Octave Forge under -the following terms: - -Author: Paul Kienzle -I grant this code to the public domain. -2001-03-22 - -THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND -ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS -OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) -HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF -SUCH DAMAGE. - -*/ - -/* mex.h is for use in C-programs only; do NOT include it in mex.cc */ - -#if ! defined (MEX_H) -#define MEX_H - -#define HAVE_OCTAVE - -typedef void mxArray; - -#if ! defined (__cplusplus) -typedef int bool; -#endif - -/* -V4 stuff */ -#if defined (V4) -#define Matrix mxArray -#define REAL mxREAL -#endif - -#define mxMAXNAME 64 - -#include "mexproto.h" - -#if defined (__cplusplus) -extern "C" { -#endif - -#if defined (V4) -void mexFunction (int nlhs, mxArray* plhs[], int nrhs, mxArray *prhs[]); -#else -void mexFunction (int nlhs, mxArray* plhs[], int nrhs, const mxArray *prhs[]); -#endif - -/* V4 floating point routines renamed in V5. */ -#define mexIsNaN mxIsNaN -#define mexIsFinite mxIsFinite -#define mexIsInf mxIsInf -#define mexGetEps mxGetEps -#define mexGetInf mxGetInf -#define mexGetNaN mxGetNan - -#define mexGetGlobal(nm) mexGetArray (nm, "global") -#define mexGetMatrix(nm) mexGetArray (nm, "caller") -#define mexGetMatrixPtr(nm) mexGetArrayPtr (nm, "caller") - -#define mexGetArray(nm, space) mexGetVariable (space, nm) -#define mexGetArrayPtr(nm, space) mexGetVariablePtr (space, nm) - -#define mexPutMatrix(ptr) mexPutVariable ("caller", "", ptr) -#define mexPutArray(ptr, space) mexPutVariable (space, "", ptr) - -#define mxCreateFull mxCreateDoubleMatrix - -#define mxCreateScalarDouble mxCreateDoubleScalar - -#define mxFreeMatrix mxDestroyArray - -#define mxIsString mxIsChar - -/* Apparently these are also defined. */ - -#ifndef UINT64_T -#define UINT64_T uint64_t -#endif - -#ifndef uint64_T -#define uint64_T uint64_t -#endif - -#ifndef INT64_T -#define INT64_T int64_t -#endif - -#ifndef int64_T -#define int64_T int64_t -#endif - -#ifndef UINT32_T -#define UINT32_T uint32_t -#endif - -#ifndef uint32_T -#define uint32_T uint32_t -#endif - -#ifndef INT32_T -#define INT32_T int32_t -#endif - -#ifndef int32_T -#define int32_T int32_t -#endif - -#ifndef UINT16_T -#define UINT16_T uint16_t -#endif - -#ifndef uint16_T -#define uint16_T uint16_t -#endif - -#ifndef INT16_T -#define INT16_T int16_t -#endif - -#ifndef int16_T -#define int16_T int16_t -#endif - -#ifndef UINT8_T -#define UINT8_T uint8_t -#endif - -#ifndef uint8_T -#define uint8_T uint8_t -#endif - -#ifndef INT8_T -#define INT8_T int8_t -#endif - -#ifndef int8_T -#define int8_T int8_t -#endif - -#if defined (__cplusplus) -} -#endif - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/mexproto.h --- a/libinterp/interp-core/mexproto.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,280 +0,0 @@ -/* - -Copyright (C) 2006-2012 Paul Kienzle - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -/* - -This code was originally distributed as part of Octave Forge under -the following terms: - -Author: Paul Kienzle -I grant this code to the public domain. -2001-03-22 - -THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND -ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS -OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) -HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF -SUCH DAMAGE. - -*/ - -/* mex.h is for use in C-programs only; do NOT include it in mex.cc */ - -#if ! defined (MEXPROTO_H) -#define MEXPROTO_H - -#if defined (__cplusplus) -#include -extern "C" { -#else -#include -#endif - -/* The definition of OCTINTERP_API is normally provided by Octave's - config.h file. This is provided for the case of mex.h included by - user programs that don't use Octave's config.h. */ -#if ! defined (OCTINTERP_API) -#if defined (_MSC_VER) -#define OCTINTERP_API __declspec(dllimport) -#else -/* All other compilers, at least for now. */ -#define OCTINTERP_API -#endif -#endif - -#define MXARRAY_TYPEDEFS_ONLY -#include "mxarray.h" -#undef MXARRAY_TYPEDEFS_ONLY - -/* Interface to the interpreter. */ -extern OCTINTERP_API const char *mexFunctionName (void); - -extern OCTINTERP_API int mexCallMATLAB (int nargout, mxArray *argout[], int nargin, mxArray *argin[], const char *fname); - -extern OCTINTERP_API void mexSetTrapFlag (int flag); -extern OCTINTERP_API int mexEvalString (const char *s); -extern OCTINTERP_API void mexErrMsgTxt (const char *s); -extern OCTINTERP_API void mexErrMsgIdAndTxt (const char *id, const char *s, ...); -extern OCTINTERP_API void mexWarnMsgTxt (const char *s); -extern OCTINTERP_API void mexWarnMsgIdAndTxt (const char *id, const char *s, ...); -extern OCTINTERP_API int mexPrintf (const char *fmt, ...); - -extern OCTINTERP_API mxArray *mexGetVariable (const char *space, const char *name); -extern OCTINTERP_API const mxArray *mexGetVariablePtr (const char *space, const char *name); - -extern OCTINTERP_API int mexPutVariable (const char *space, const char *name, - const mxArray *ptr); - -extern OCTINTERP_API void mexMakeArrayPersistent (mxArray *ptr); -extern OCTINTERP_API void mexMakeMemoryPersistent (void *ptr); - -extern OCTINTERP_API int mexAtExit (void (*f) (void)); -extern OCTINTERP_API const mxArray *mexGet (double handle, const char *property); -extern OCTINTERP_API int mexIsGlobal (const mxArray *ptr); -extern OCTINTERP_API int mexIsLocked (void); -extern OCTINTERP_API void mexLock (void); -extern OCTINTERP_API int mexSet (double handle, const char *property, mxArray *val); -extern OCTINTERP_API void mexUnlock (void); - -/* Floating point predicates. */ -extern OCTINTERP_API int mxIsFinite (double v); -extern OCTINTERP_API int mxIsInf (double v); -extern OCTINTERP_API int mxIsNaN (double v); - -/* Floating point values. */ -extern OCTINTERP_API double mxGetEps (void); -extern OCTINTERP_API double mxGetInf (void); -extern OCTINTERP_API double mxGetNaN (void); - -/* Memory management. */ -extern OCTINTERP_API void *mxCalloc (size_t n, size_t size); -extern OCTINTERP_API void *mxMalloc (size_t n); -extern OCTINTERP_API void *mxRealloc (void *ptr, size_t size); -extern OCTINTERP_API void mxFree (void *ptr); - -/* Constructors. */ -extern OCTINTERP_API mxArray *mxCreateCellArray (mwSize ndims, const mwSize *dims); -extern OCTINTERP_API mxArray *mxCreateCellMatrix (mwSize m, mwSize n); -extern OCTINTERP_API mxArray *mxCreateCharArray (mwSize ndims, const mwSize *dims); -extern OCTINTERP_API mxArray *mxCreateCharMatrixFromStrings (mwSize m, const char **str); -extern OCTINTERP_API mxArray *mxCreateDoubleMatrix (mwSize nr, mwSize nc, mxComplexity flag); -extern OCTINTERP_API mxArray *mxCreateDoubleScalar (double val); -extern OCTINTERP_API mxArray *mxCreateLogicalArray (mwSize ndims, const mwSize *dims); -extern OCTINTERP_API mxArray *mxCreateLogicalMatrix (mwSize m, mwSize n); -extern OCTINTERP_API mxArray *mxCreateLogicalScalar (mxLogical val); -extern OCTINTERP_API mxArray *mxCreateNumericArray (mwSize ndims, const mwSize *dims, mxClassID class_id, mxComplexity flag); -extern OCTINTERP_API mxArray *mxCreateNumericMatrix (mwSize m, mwSize n, mxClassID class_id, mxComplexity flag); -extern OCTINTERP_API mxArray *mxCreateSparse (mwSize m, mwSize n, mwSize nzmax, mxComplexity flag); -extern OCTINTERP_API mxArray *mxCreateSparseLogicalMatrix (mwSize m, mwSize n, mwSize nzmax); -extern OCTINTERP_API mxArray *mxCreateString (const char *str); -extern OCTINTERP_API mxArray *mxCreateStructArray (mwSize ndims, const mwSize *dims, int num_keys, const char **keys); -extern OCTINTERP_API mxArray *mxCreateStructMatrix (mwSize rows, mwSize cols, int num_keys, const char **keys); - -/* Copy constructor. */ -extern OCTINTERP_API mxArray *mxDuplicateArray (const mxArray *v); - -/* Destructor. */ -extern OCTINTERP_API void mxDestroyArray (mxArray *v); - -/* Type Predicates. */ -extern OCTINTERP_API int mxIsCell (const mxArray *ptr); -extern OCTINTERP_API int mxIsChar (const mxArray *ptr); -extern OCTINTERP_API int mxIsClass (const mxArray *ptr, const char *name); -extern OCTINTERP_API int mxIsComplex (const mxArray *ptr); -extern OCTINTERP_API int mxIsDouble (const mxArray *ptr); -extern OCTINTERP_API int mxIsFunctionHandle (const mxArray *ptr); -extern OCTINTERP_API int mxIsInt16 (const mxArray *ptr); -extern OCTINTERP_API int mxIsInt32 (const mxArray *ptr); -extern OCTINTERP_API int mxIsInt64 (const mxArray *ptr); -extern OCTINTERP_API int mxIsInt8 (const mxArray *ptr); -extern OCTINTERP_API int mxIsLogical (const mxArray *ptr); -extern OCTINTERP_API int mxIsNumeric (const mxArray *ptr); -extern OCTINTERP_API int mxIsSingle (const mxArray *ptr); -extern OCTINTERP_API int mxIsSparse (const mxArray *ptr); -extern OCTINTERP_API int mxIsStruct (const mxArray *ptr); -extern OCTINTERP_API int mxIsUint16 (const mxArray *ptr); -extern OCTINTERP_API int mxIsUint32 (const mxArray *ptr); -extern OCTINTERP_API int mxIsUint64 (const mxArray *ptr); -extern OCTINTERP_API int mxIsUint8 (const mxArray *ptr); - -/* Odd type+size predicate. */ -extern OCTINTERP_API int mxIsLogicalScalar (const mxArray *ptr); - -/* Odd type+size+value predicate. */ -extern OCTINTERP_API int mxIsLogicalScalarTrue (const mxArray *ptr); - -/* Size predicate. */ -extern OCTINTERP_API int mxIsEmpty (const mxArray *ptr); - -/* Just plain odd thing to ask of a value. */ -extern OCTINTERP_API int mxIsFromGlobalWS (const mxArray *ptr); - -/* Dimension extractors. */ -extern OCTINTERP_API size_t mxGetM (const mxArray *ptr); -extern OCTINTERP_API size_t mxGetN (const mxArray *ptr); -extern OCTINTERP_API mwSize *mxGetDimensions (const mxArray *ptr); -extern OCTINTERP_API mwSize mxGetNumberOfDimensions (const mxArray *ptr); -extern OCTINTERP_API size_t mxGetNumberOfElements (const mxArray *ptr); - -/* Dimension setters. */ -extern OCTINTERP_API void mxSetM (mxArray *ptr, mwSize M); -extern OCTINTERP_API void mxSetN (mxArray *ptr, mwSize N); -extern OCTINTERP_API void mxSetDimensions (mxArray *ptr, const mwSize *dims, mwSize ndims); - -/* Data extractors. */ -extern OCTINTERP_API double *mxGetPi (const mxArray *ptr); -extern OCTINTERP_API double *mxGetPr (const mxArray *ptr); -extern OCTINTERP_API double mxGetScalar (const mxArray *ptr); -extern OCTINTERP_API mxChar *mxGetChars (const mxArray *ptr); -extern OCTINTERP_API mxLogical *mxGetLogicals (const mxArray *ptr); -extern OCTINTERP_API void *mxGetData (const mxArray *ptr); -extern OCTINTERP_API void *mxGetImagData (const mxArray *ptr); - -/* Data setters. */ -extern OCTINTERP_API void mxSetPr (mxArray *ptr, double *pr); -extern OCTINTERP_API void mxSetPi (mxArray *ptr, double *pi); -extern OCTINTERP_API void mxSetData (mxArray *ptr, void *data); -extern OCTINTERP_API void mxSetImagData (mxArray *ptr, void *pi); - -/* Classes. */ -extern OCTINTERP_API mxClassID mxGetClassID (const mxArray *ptr); -extern OCTINTERP_API const char *mxGetClassName (const mxArray *ptr); - -extern OCTINTERP_API void mxSetClassName (mxArray *ptr, const char *name); - -/* Cell support. */ -extern OCTINTERP_API mxArray *mxGetCell (const mxArray *ptr, mwIndex idx); - -extern OCTINTERP_API void mxSetCell (mxArray *ptr, mwIndex idx, mxArray *val); - -/* Sparse support. */ -extern OCTINTERP_API mwIndex *mxGetIr (const mxArray *ptr); -extern OCTINTERP_API mwIndex *mxGetJc (const mxArray *ptr); -extern OCTINTERP_API mwSize mxGetNzmax (const mxArray *ptr); - -extern OCTINTERP_API void mxSetIr (mxArray *ptr, mwIndex *ir); -extern OCTINTERP_API void mxSetJc (mxArray *ptr, mwIndex *jc); -extern OCTINTERP_API void mxSetNzmax (mxArray *ptr, mwSize nzmax); - -/* Structure support. */ -extern OCTINTERP_API int mxAddField (mxArray *ptr, const char *key); - -extern OCTINTERP_API void mxRemoveField (mxArray *ptr, int key_num); - -extern OCTINTERP_API mxArray *mxGetField (const mxArray *ptr, mwIndex index, const char *key); -extern OCTINTERP_API mxArray *mxGetFieldByNumber (const mxArray *ptr, mwIndex index, int key_num); - -extern OCTINTERP_API void mxSetField (mxArray *ptr, mwIndex index, const char *key, mxArray *val); -extern OCTINTERP_API void mxSetFieldByNumber (mxArray *ptr, mwIndex index, int key_num, mxArray *val); - -extern OCTINTERP_API int mxGetNumberOfFields (const mxArray *ptr); - -extern OCTINTERP_API const char *mxGetFieldNameByNumber (const mxArray *ptr, int key_num); -extern OCTINTERP_API int mxGetFieldNumber (const mxArray *ptr, const char *key); - -extern OCTINTERP_API int mxGetString (const mxArray *ptr, char *buf, mwSize buflen); -extern OCTINTERP_API char *mxArrayToString (const mxArray *ptr); - -/* Miscellaneous. */ -#ifdef NDEBUG -#define mxAssert(expr, msg) \ - do \ - { \ - if (! expr) \ - { \ - mexPrintf ("Assertion failed: %s, at line %d of file \"%s\".\n%s\n", \ - #expr, __LINE__, __FILE__, msg); \ - } \ - } \ - while (0) - -#define mxAssertS(expr, msg) \ - do \ - { \ - if (! expr) \ - { \ - mexPrintf ("Assertion failed at line %d of file \"%s\".\n%s\n", \ - __LINE__, __FILE__, msg); \ - abort (); \ - } \ - } \ - while (0) -#else -#define mxAssert(expr, msg) -#define mxAssertS(expr, msg) -#endif - -extern OCTINTERP_API mwIndex mxCalcSingleSubscript (const mxArray *ptr, mwSize nsubs, mwIndex *subs); - -extern OCTINTERP_API size_t mxGetElementSize (const mxArray *ptr); - -#if defined (__cplusplus) -} -#endif - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/module.mk --- a/libinterp/interp-core/module.mk Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,140 +0,0 @@ -EXTRA_DIST += \ - interp-core/module.mk \ - interp-core/gl2ps.c \ - interp-core/mxarray.in.h \ - interp-core/oct-errno.in.cc - -JIT_INC = \ - interp-core/jit-util.h \ - interp-core/jit-typeinfo.h \ - interp-core/jit-ir.h \ - interp-core/pt-jit.h - -INTERP_CORE_INC = \ - interp-core/Cell.h \ - interp-core/action-container.h \ - interp-core/c-file-ptr-stream.h \ - interp-core/comment-list.h \ - interp-core/cutils.h \ - interp-core/defun-dld.h \ - interp-core/defun-int.h \ - interp-core/display.h \ - interp-core/dynamic-ld.h \ - interp-core/event-queue.h \ - interp-core/gl-render.h \ - interp-core/gl2ps-renderer.h \ - interp-core/gl2ps.h \ - interp-core/gripes.h \ - interp-core/ls-ascii-helper.h \ - interp-core/ls-hdf5.h \ - interp-core/ls-mat-ascii.h \ - interp-core/ls-mat4.h \ - interp-core/ls-mat5.h \ - interp-core/ls-oct-binary.h \ - interp-core/ls-utils.h \ - interp-core/mex.h \ - interp-core/mexproto.h \ - interp-core/mxarray.in.h \ - interp-core/oct-errno.h \ - interp-core/oct-fstrm.h \ - interp-core/oct-hdf5.h \ - interp-core/oct-iostrm.h \ - interp-core/oct-lvalue.h \ - interp-core/oct-map.h \ - interp-core/oct-obj.h \ - interp-core/oct-prcstrm.h \ - interp-core/oct-procbuf.h \ - interp-core/oct-stdstrm.h \ - interp-core/oct-stream.h \ - interp-core/oct-strstrm.h \ - interp-core/oct.h \ - interp-core/procstream.h \ - interp-core/siglist.h \ - interp-core/sparse-xdiv.h \ - interp-core/sparse-xpow.h \ - interp-core/txt-eng-ft.h \ - interp-core/txt-eng.h \ - interp-core/unwind-prot.h \ - interp-core/xdiv.h \ - interp-core/xnorm.h \ - interp-core/xpow.h \ - interp-core/zfstream.h \ - $(JIT_INC) - -JIT_SRC = \ - interp-core/jit-util.cc \ - interp-core/jit-typeinfo.cc \ - interp-core/jit-ir.cc \ - interp-core/pt-jit.cc - -C_INTERP_CORE_SRC = \ - interp-core/cutils.c \ - interp-core/matherr.c \ - interp-core/siglist.c \ - interp-core/xgl2ps.c - -INTERP_CORE_SRC = \ - interp-core/Cell.cc \ - interp-core/c-file-ptr-stream.cc \ - interp-core/comment-list.cc \ - interp-core/display.cc \ - interp-core/dynamic-ld.cc \ - interp-core/gl-render.cc \ - interp-core/gl2ps-renderer.cc \ - interp-core/gripes.cc \ - interp-core/ls-ascii-helper.cc \ - interp-core/ls-hdf5.cc \ - interp-core/ls-mat-ascii.cc \ - interp-core/ls-mat4.cc \ - interp-core/ls-mat5.cc \ - interp-core/ls-oct-binary.cc \ - interp-core/ls-utils.cc \ - interp-core/mex.cc \ - interp-core/oct-fstrm.cc \ - interp-core/oct-iostrm.cc \ - interp-core/oct-lvalue.cc \ - interp-core/oct-map.cc \ - interp-core/oct-obj.cc \ - interp-core/oct-prcstrm.cc \ - interp-core/oct-procbuf.cc \ - interp-core/oct-stream.cc \ - interp-core/oct-strstrm.cc \ - interp-core/procstream.cc \ - interp-core/sparse-xdiv.cc \ - interp-core/sparse-xpow.cc \ - interp-core/txt-eng-ft.cc \ - interp-core/unwind-prot.cc \ - interp-core/xdiv.cc \ - interp-core/xnorm.cc \ - interp-core/xpow.cc \ - interp-core/zfstream.cc \ - $(JIT_SRC) \ - $(C_INTERP_CORE_SRC) - -## FIXME: Automake does not support per-object rules. -## These rules could be emulated by creating a new convenience -## library and using per-library rules. Or we can just live -## without the rule since there haven't been any problems. (09/18/2012) -#display.df display.lo: CPPFLAGS += $(X11_FLAGS) - -## Special rules for sources which must be built before rest of compilation. -interp-core/oct-errno.cc: interp-core/oct-errno.in.cc Makefile - if test -n "$(PERL)"; then \ - $(srcdir)/mk-errno-list --perl "$(PERL)" < $< > $@-t; \ - elif test -n "$(PYTHON)"; then \ - $(srcdir)/mk-errno-list --python "$(PYTHON)" < $< > $@-t; \ - else \ - $(SED) '/@SYSDEP_ERRNO_LIST@/D' $< > $@-t; \ - fi - mv $@-t $@ - -interp-core/mxarray.h: interp-core/mxarray.in.h Makefile - $(SED) < $< \ - -e "s|%NO_EDIT_WARNING%|DO NOT EDIT! Generated automatically from $( $@-t - mv $@-t $@ - -noinst_LTLIBRARIES += interp-core/libinterp-core.la - -interp_core_libinterp_core_la_SOURCES = $(INTERP_CORE_SRC) -interp_core_libinterp_core_la_CPPFLAGS = $(liboctinterp_la_CPPFLAGS) diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/mxarray.in.h --- a/libinterp/interp-core/mxarray.in.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,517 +0,0 @@ -// %NO_EDIT_WARNING% -/* - -Copyright (C) 2001-2012 Paul Kienzle - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -/* - -Part of this code was originally distributed as part of Octave Forge under -the following terms: - -Author: Paul Kienzle -I grant this code to the public domain. -2001-03-22 - -THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND -ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS -OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) -HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF -SUCH DAMAGE. - -*/ - -#if ! defined (MXARRAY_H) -#define MXARRAY_H - -typedef enum - { - mxREAL = 0, - mxCOMPLEX = 1 - } - mxComplexity; - -typedef enum - { - mxUNKNOWN_CLASS = 0, - mxCELL_CLASS, - mxSTRUCT_CLASS, - mxLOGICAL_CLASS, - mxCHAR_CLASS, - mxUNUSED_CLASS, - mxDOUBLE_CLASS, - mxSINGLE_CLASS, - mxINT8_CLASS, - mxUINT8_CLASS, - mxINT16_CLASS, - mxUINT16_CLASS, - mxINT32_CLASS, - mxUINT32_CLASS, - mxINT64_CLASS, - mxUINT64_CLASS, - mxFUNCTION_CLASS - } - mxClassID; - -typedef unsigned char mxLogical; - -/* typedef Uint16 mxChar; */ -typedef char mxChar; - -/* - * FIXME? Mathworks says these should be size_t on 64-bit system and when - * mex is used with the -largearraydims flag, but why do that? Its better - * to conform to the same indexing as the rest of Octave - */ -typedef %OCTAVE_IDX_TYPE% mwSize; -typedef %OCTAVE_IDX_TYPE% mwIndex; -typedef %OCTAVE_IDX_TYPE% mwSignedIndex; - -#if ! defined (MXARRAY_TYPEDEFS_ONLY) - -#include - -class octave_value; - -#define DO_MUTABLE_METHOD(RET_T, METHOD_CALL) \ - RET_T retval = rep->METHOD_CALL; \ - \ - if (rep->mutation_needed ()) \ - { \ - maybe_mutate (); \ - retval = rep->METHOD_CALL; \ - } \ - \ - return retval - -#define DO_VOID_MUTABLE_METHOD(METHOD_CALL) \ - rep->METHOD_CALL; \ - \ - if (rep->mutation_needed ()) \ - { \ - maybe_mutate (); \ - rep->METHOD_CALL; \ - } - -// A class to provide the default implemenation of some of the virtual -// functions declared in the mxArray class. - -class mxArray; - -class mxArray_base -{ -protected: - - mxArray_base (void) { } - -public: - - virtual mxArray_base *dup (void) const = 0; - - virtual mxArray *as_mxArray (void) const { return 0; } - - virtual ~mxArray_base (void) { } - - virtual bool is_octave_value (void) const { return false; } - - virtual int is_cell (void) const = 0; - - virtual int is_char (void) const = 0; - - virtual int is_class (const char *name_arg) const - { - int retval = 0; - - const char *cname = get_class_name (); - - if (cname && name_arg) - retval = ! strcmp (cname, name_arg); - - return retval; - } - - virtual int is_complex (void) const = 0; - - virtual int is_double (void) const = 0; - - virtual int is_function_handle (void) const = 0; - - virtual int is_int16 (void) const = 0; - - virtual int is_int32 (void) const = 0; - - virtual int is_int64 (void) const = 0; - - virtual int is_int8 (void) const = 0; - - virtual int is_logical (void) const = 0; - - virtual int is_numeric (void) const = 0; - - virtual int is_single (void) const = 0; - - virtual int is_sparse (void) const = 0; - - virtual int is_struct (void) const = 0; - - virtual int is_uint16 (void) const = 0; - - virtual int is_uint32 (void) const = 0; - - virtual int is_uint64 (void) const = 0; - - virtual int is_uint8 (void) const = 0; - - virtual int is_logical_scalar (void) const - { - return is_logical () && get_number_of_elements () == 1; - } - - virtual int is_logical_scalar_true (void) const = 0; - - virtual mwSize get_m (void) const = 0; - - virtual mwSize get_n (void) const = 0; - - virtual mwSize *get_dimensions (void) const = 0; - - virtual mwSize get_number_of_dimensions (void) const = 0; - - virtual void set_m (mwSize m) = 0; - - virtual void set_n (mwSize n) = 0; - - virtual void set_dimensions (mwSize *dims_arg, mwSize ndims_arg) = 0; - - virtual mwSize get_number_of_elements (void) const = 0; - - virtual int is_empty (void) const = 0; - - virtual mxClassID get_class_id (void) const = 0; - - virtual const char *get_class_name (void) const = 0; - - virtual void set_class_name (const char *name_arg) = 0; - - virtual mxArray *get_cell (mwIndex /*idx*/) const - { - invalid_type_error (); - return 0; - } - - virtual void set_cell (mwIndex idx, mxArray *val) = 0; - - virtual double get_scalar (void) const = 0; - - virtual void *get_data (void) const = 0; - - virtual void *get_imag_data (void) const = 0; - - virtual void set_data (void *pr) = 0; - - virtual void set_imag_data (void *pi) = 0; - - virtual mwIndex *get_ir (void) const = 0; - - virtual mwIndex *get_jc (void) const = 0; - - virtual mwSize get_nzmax (void) const = 0; - - virtual void set_ir (mwIndex *ir) = 0; - - virtual void set_jc (mwIndex *jc) = 0; - - virtual void set_nzmax (mwSize nzmax) = 0; - - virtual int add_field (const char *key) = 0; - - virtual void remove_field (int key_num) = 0; - - virtual mxArray *get_field_by_number (mwIndex index, int key_num) const = 0; - - virtual void set_field_by_number (mwIndex index, int key_num, mxArray *val) = 0; - - virtual int get_number_of_fields (void) const = 0; - - virtual const char *get_field_name_by_number (int key_num) const = 0; - - virtual int get_field_number (const char *key) const = 0; - - virtual int get_string (char *buf, mwSize buflen) const = 0; - - virtual char *array_to_string (void) const = 0; - - virtual mwIndex calc_single_subscript (mwSize nsubs, mwIndex *subs) const = 0; - - virtual size_t get_element_size (void) const = 0; - - virtual bool mutation_needed (void) const { return false; } - - virtual mxArray *mutate (void) const { return 0; } - - virtual octave_value as_octave_value (void) const = 0; - -protected: - - mxArray_base (const mxArray_base&) { } - - void invalid_type_error (void) const - { - error ("invalid type for operation"); - } - - void error (const char *msg) const; -}; - -// The main interface class. The representation can be based on an -// octave_value object or a separate object that tries to reproduce -// the semantics of mxArray objects in Matlab more directly. - -class mxArray -{ -public: - - mxArray (const octave_value& ov); - - mxArray (mxClassID id, mwSize ndims, const mwSize *dims, - mxComplexity flag = mxREAL); - - mxArray (mxClassID id, const dim_vector& dv, mxComplexity flag = mxREAL); - - mxArray (mxClassID id, mwSize m, mwSize n, mxComplexity flag = mxREAL); - - mxArray (mxClassID id, double val); - - mxArray (mxClassID id, mxLogical val); - - mxArray (const char *str); - - mxArray (mwSize m, const char **str); - - mxArray (mxClassID id, mwSize m, mwSize n, mwSize nzmax, - mxComplexity flag = mxREAL); - - mxArray (mwSize ndims, const mwSize *dims, int num_keys, const char **keys); - - mxArray (const dim_vector& dv, int num_keys, const char **keys); - - mxArray (mwSize m, mwSize n, int num_keys, const char **keys); - - mxArray (mwSize ndims, const mwSize *dims); - - mxArray (const dim_vector& dv); - - mxArray (mwSize m, mwSize n); - - mxArray *dup (void) const - { - mxArray *retval = rep->as_mxArray (); - - if (retval) - retval->set_name (name); - else - { - mxArray_base *new_rep = rep->dup (); - - retval = new mxArray (new_rep, name); - } - - return retval; - } - - ~mxArray (void); - - bool is_octave_value (void) const { return rep->is_octave_value (); } - - int is_cell (void) const { return rep->is_cell (); } - - int is_char (void) const { return rep->is_char (); } - - int is_class (const char *name_arg) const { return rep->is_class (name_arg); } - - int is_complex (void) const { return rep->is_complex (); } - - int is_double (void) const { return rep->is_double (); } - - int is_function_handle (void) const { return rep->is_function_handle (); } - - int is_int16 (void) const { return rep->is_int16 (); } - - int is_int32 (void) const { return rep->is_int32 (); } - - int is_int64 (void) const { return rep->is_int64 (); } - - int is_int8 (void) const { return rep->is_int8 (); } - - int is_logical (void) const { return rep->is_logical (); } - - int is_numeric (void) const { return rep->is_numeric (); } - - int is_single (void) const { return rep->is_single (); } - - int is_sparse (void) const { return rep->is_sparse (); } - - int is_struct (void) const { return rep->is_struct (); } - - int is_uint16 (void) const { return rep->is_uint16 (); } - - int is_uint32 (void) const { return rep->is_uint32 (); } - - int is_uint64 (void) const { return rep->is_uint64 (); } - - int is_uint8 (void) const { return rep->is_uint8 (); } - - int is_logical_scalar (void) const { return rep->is_logical_scalar (); } - - int is_logical_scalar_true (void) const { return rep->is_logical_scalar_true (); } - - mwSize get_m (void) const { return rep->get_m (); } - - mwSize get_n (void) const { return rep->get_n (); } - - mwSize *get_dimensions (void) const { return rep->get_dimensions (); } - - mwSize get_number_of_dimensions (void) const { return rep->get_number_of_dimensions (); } - - void set_m (mwSize m) { DO_VOID_MUTABLE_METHOD (set_m (m)); } - - void set_n (mwSize n) { DO_VOID_MUTABLE_METHOD (set_n (n)); } - - void set_dimensions (mwSize *dims_arg, mwSize ndims_arg) { DO_VOID_MUTABLE_METHOD (set_dimensions (dims_arg, ndims_arg)); } - - mwSize get_number_of_elements (void) const { return rep->get_number_of_elements (); } - - int is_empty (void) const { return get_number_of_elements () == 0; } - - const char *get_name (void) const { return name; } - - void set_name (const char *name_arg); - - mxClassID get_class_id (void) const { return rep->get_class_id (); } - - const char *get_class_name (void) const { return rep->get_class_name (); } - - void set_class_name (const char *name_arg) { DO_VOID_MUTABLE_METHOD (set_class_name (name_arg)); } - - mxArray *get_cell (mwIndex idx) const { DO_MUTABLE_METHOD (mxArray *, get_cell (idx)); } - - void set_cell (mwIndex idx, mxArray *val) { DO_VOID_MUTABLE_METHOD (set_cell (idx, val)); } - - double get_scalar (void) const { return rep->get_scalar (); } - - void *get_data (void) const { DO_MUTABLE_METHOD (void *, get_data ()); } - - void *get_imag_data (void) const { DO_MUTABLE_METHOD (void *, get_imag_data ()); } - - void set_data (void *pr) { DO_VOID_MUTABLE_METHOD (set_data (pr)); } - - void set_imag_data (void *pi) { DO_VOID_MUTABLE_METHOD (set_imag_data (pi)); } - - mwIndex *get_ir (void) const { DO_MUTABLE_METHOD (mwIndex *, get_ir ()); } - - mwIndex *get_jc (void) const { DO_MUTABLE_METHOD (mwIndex *, get_jc ()); } - - mwSize get_nzmax (void) const { return rep->get_nzmax (); } - - void set_ir (mwIndex *ir) { DO_VOID_MUTABLE_METHOD (set_ir (ir)); } - - void set_jc (mwIndex *jc) { DO_VOID_MUTABLE_METHOD (set_jc (jc)); } - - void set_nzmax (mwSize nzmax) { DO_VOID_MUTABLE_METHOD (set_nzmax (nzmax)); } - - int add_field (const char *key) { DO_MUTABLE_METHOD (int, add_field (key)); } - - void remove_field (int key_num) { DO_VOID_MUTABLE_METHOD (remove_field (key_num)); } - - mxArray *get_field_by_number (mwIndex index, int key_num) const { DO_MUTABLE_METHOD (mxArray *, get_field_by_number (index, key_num)); } - - void set_field_by_number (mwIndex index, int key_num, mxArray *val) { DO_VOID_MUTABLE_METHOD (set_field_by_number (index, key_num, val)); } - - int get_number_of_fields (void) const { return rep->get_number_of_fields (); } - - const char *get_field_name_by_number (int key_num) const { DO_MUTABLE_METHOD (const char*, get_field_name_by_number (key_num)); } - - int get_field_number (const char *key) const { DO_MUTABLE_METHOD (int, get_field_number (key)); } - - int get_string (char *buf, mwSize buflen) const { return rep->get_string (buf, buflen); } - - char *array_to_string (void) const { return rep->array_to_string (); } - - mwIndex calc_single_subscript (mwSize nsubs, mwIndex *subs) const { return rep->calc_single_subscript (nsubs, subs); } - - size_t get_element_size (void) const { return rep->get_element_size (); } - - bool mutation_needed (void) const { return rep->mutation_needed (); } - - mxArray *mutate (void) const { return rep->mutate (); } - - static void *malloc (size_t n); - - static void *calloc (size_t n, size_t t); - - static char *strsave (const char *str) - { - char *retval = 0; - - if (str) - { - mwSize sz = sizeof (mxChar) * (strlen (str) + 1); - retval = static_cast (mxArray::malloc (sz)); - strcpy (retval, str); - } - - return retval; - } - - static octave_value as_octave_value (const mxArray *ptr); - -protected: - - octave_value as_octave_value (void) const; - -private: - - mutable mxArray_base *rep; - - char *name; - - mxArray (mxArray_base *r, const char *n) - : rep (r), name (mxArray::strsave (n)) { } - - void maybe_mutate (void) const; - - // No copying! - - mxArray (const mxArray&); - - mxArray& operator = (const mxArray&); -}; - -#undef DO_MUTABLE_METHOD -#undef DO_VOID_MUTABLE_METHOD - -#endif -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/oct-errno.h --- a/libinterp/interp-core/oct-errno.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,72 +0,0 @@ -// oct-errno.h.in -/* - -Copyright (C) 2005-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_errno_h) -#define octave_errno_h 1 - -#include -#include -#include - -#include "oct-map.h" - -class -octave_errno -{ -protected: - - octave_errno (void); - -public: - - ~octave_errno (void) { } - - static bool instance_ok (void); - - static void cleanup_instance (void) { delete instance; instance = 0; } - - static int lookup (const std::string& name); - - static octave_scalar_map list (void); - - static int get (void) { return errno; } - - static int set (int val) - { - int retval = errno; - errno = val; - return retval; - } - -private: - - std::map errno_tbl; - - static octave_errno *instance; - - int do_lookup (const std::string& name); - - octave_scalar_map do_list (void); -}; - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/oct-errno.in.cc --- a/libinterp/interp-core/oct-errno.in.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,345 +0,0 @@ -// DO NOT EDIT! Generated automatically from oct-errno.in.cc by configure -/* - -Copyright (C) 2005-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "singleton-cleanup.h" - -#include "oct-errno.h" -#include "oct-map.h" -#include "error.h" - -octave_errno *octave_errno::instance = 0; - -octave_errno::octave_errno (void) -{ - struct errno_struct - { - const char *name; - int value; - }; - - static errno_struct errno_codes[] = - { - // POSIX. - -#if defined (E2BIG) - { "E2BIG", E2BIG, }, -#endif -#if defined (EACCES) - { "EACCES", EACCES, }, -#endif -#if defined (EADDRINUSE) - { "EADDRINUSE", EADDRINUSE, }, -#endif -#if defined (EADDRNOTAVAIL) - { "EADDRNOTAVAIL", EADDRNOTAVAIL, }, -#endif -#if defined (EAFNOSUPPORT) - { "EAFNOSUPPORT", EAFNOSUPPORT, }, -#endif -#if defined (EAGAIN) - { "EAGAIN", EAGAIN, }, -#endif -#if defined (EALREADY) - { "EALREADY", EALREADY, }, -#endif -#if defined (EBADF) - { "EBADF", EBADF, }, -#endif -#if defined (EBUSY) - { "EBUSY", EBUSY, }, -#endif -#if defined (ECHILD) - { "ECHILD", ECHILD, }, -#endif -#if defined (ECONNABORTED) - { "ECONNABORTED", ECONNABORTED, }, -#endif -#if defined (ECONNREFUSED) - { "ECONNREFUSED", ECONNREFUSED, }, -#endif -#if defined (ECONNRESET) - { "ECONNRESET", ECONNRESET, }, -#endif -#if defined (EDEADLK) - { "EDEADLK", EDEADLK, }, -#endif -#if defined (EDESTADDRREQ) - { "EDESTADDRREQ", EDESTADDRREQ, }, -#endif -#if defined (EDOM) - { "EDOM", EDOM, }, -#endif -#if defined (EDQUOT) - { "EDQUOT", EDQUOT, }, -#endif -#if defined (EEXIST) - { "EEXIST", EEXIST, }, -#endif -#if defined (EFAULT) - { "EFAULT", EFAULT, }, -#endif -#if defined (EFBIG) - { "EFBIG", EFBIG, }, -#endif -#if defined (EHOSTDOWN) - { "EHOSTDOWN", EHOSTDOWN, }, -#endif -#if defined (EHOSTUNREACH) - { "EHOSTUNREACH", EHOSTUNREACH, }, -#endif -#if defined (EINPROGRESS) - { "EINPROGRESS", EINPROGRESS, }, -#endif -#if defined (EINTR) - { "EINTR", EINTR, }, -#endif -#if defined (EINVAL) - { "EINVAL", EINVAL, }, -#endif -#if defined (EIO) - { "EIO", EIO, }, -#endif -#if defined (EISCONN) - { "EISCONN", EISCONN, }, -#endif -#if defined (EISDIR) - { "EISDIR", EISDIR, }, -#endif -#if defined (ELOOP) - { "ELOOP", ELOOP, }, -#endif -#if defined (EMFILE) - { "EMFILE", EMFILE, }, -#endif -#if defined (EMLINK) - { "EMLINK", EMLINK, }, -#endif -#if defined (EMSGSIZE) - { "EMSGSIZE", EMSGSIZE, }, -#endif -#if defined (ENAMETOOLONG) - { "ENAMETOOLONG", ENAMETOOLONG, }, -#endif -#if defined (ENETDOWN) - { "ENETDOWN", ENETDOWN, }, -#endif -#if defined (ENETRESET) - { "ENETRESET", ENETRESET, }, -#endif -#if defined (ENETUNREACH) - { "ENETUNREACH", ENETUNREACH, }, -#endif -#if defined (ENFILE) - { "ENFILE", ENFILE, }, -#endif -#if defined (ENOBUFS) - { "ENOBUFS", ENOBUFS, }, -#endif -#if defined (ENODEV) - { "ENODEV", ENODEV, }, -#endif -#if defined (ENOENT) - { "ENOENT", ENOENT, }, -#endif -#if defined (ENOEXEC) - { "ENOEXEC", ENOEXEC, }, -#endif -#if defined (ENOLCK) - { "ENOLCK", ENOLCK, }, -#endif -#if defined (ENOMEM) - { "ENOMEM", ENOMEM, }, -#endif -#if defined (ENOPROTOOPT) - { "ENOPROTOOPT", ENOPROTOOPT, }, -#endif -#if defined (ENOSPC) - { "ENOSPC", ENOSPC, }, -#endif -#if defined (ENOSYS) - { "ENOSYS", ENOSYS, }, -#endif -#if defined (ENOTBLK) - { "ENOTBLK", ENOTBLK, }, -#endif -#if defined (ENOTCONN) - { "ENOTCONN", ENOTCONN, }, -#endif -#if defined (ENOTDIR) - { "ENOTDIR", ENOTDIR, }, -#endif -#if defined (ENOTEMPTY) - { "ENOTEMPTY", ENOTEMPTY, }, -#endif -#if defined (ENOTSOCK) - { "ENOTSOCK", ENOTSOCK, }, -#endif -#if defined (ENOTTY) - { "ENOTTY", ENOTTY, }, -#endif -#if defined (ENXIO) - { "ENXIO", ENXIO, }, -#endif -#if defined (EOPNOTSUPP) - { "EOPNOTSUPP", EOPNOTSUPP, }, -#endif -#if defined (EPERM) - { "EPERM", EPERM, }, -#endif -#if defined (EPFNOSUPPORT) - { "EPFNOSUPPORT", EPFNOSUPPORT, }, -#endif -#if defined (EPIPE) - { "EPIPE", EPIPE, }, -#endif -#if defined (EPROTONOSUPPORT) - { "EPROTONOSUPPORT", EPROTONOSUPPORT, }, -#endif -#if defined (EPROTOTYPE) - { "EPROTOTYPE", EPROTOTYPE, }, -#endif -#if defined (ERANGE) - { "ERANGE", ERANGE, }, -#endif -#if defined (EREMOTE) - { "EREMOTE", EREMOTE, }, -#endif -#if defined (ERESTART) - { "ERESTART", ERESTART, }, -#endif -#if defined (EROFS) - { "EROFS", EROFS, }, -#endif -#if defined (ESHUTDOWN) - { "ESHUTDOWN", ESHUTDOWN, }, -#endif -#if defined (ESOCKTNOSUPPORT) - { "ESOCKTNOSUPPORT", ESOCKTNOSUPPORT, }, -#endif -#if defined (ESPIPE) - { "ESPIPE", ESPIPE, }, -#endif -#if defined (ESRCH) - { "ESRCH", ESRCH, }, -#endif -#if defined (ESTALE) - { "ESTALE", ESTALE, }, -#endif -#if defined (ETIMEDOUT) - { "ETIMEDOUT", ETIMEDOUT, }, -#endif -#if defined (ETOOMANYREFS) - { "ETOOMANYREFS", ETOOMANYREFS, }, -#endif -#if defined (ETXTBSY) - { "ETXTBSY", ETXTBSY, }, -#endif -#if defined (EUSERS) - { "EUSERS", EUSERS, }, -#endif -#if defined (EWOULDBLOCK) - { "EWOULDBLOCK", EWOULDBLOCK, }, -#endif -#if defined (EXDEV) - { "EXDEV", EXDEV, }, -#endif - - // Others (duplicates are OK). - -@SYSDEP_ERRNO_LIST@ - - { 0, 0, }, - }; - - // Stuff them all in a map for fast access. - - errno_struct *ptr = errno_codes; - - while (ptr->name) - { - errno_tbl[ptr->name] = ptr->value; - ptr++; - } -} - -bool -octave_errno::instance_ok (void) -{ - bool retval = true; - - if (! instance) - { - instance = new octave_errno (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); - } - - if (! instance) - { - ::error ("unable to create errno object!"); - - retval = false; - } - - return retval; -} - -int -octave_errno::lookup (const std::string& name) -{ - return (instance_ok ()) ? instance->do_lookup (name) : -1; -} - -octave_scalar_map -octave_errno::list (void) -{ - return (instance_ok ()) ? instance->do_list () : octave_scalar_map (); -} - -int -octave_errno::do_lookup (const std::string& name) -{ - return (errno_tbl.find (name) != errno_tbl.end ()) ? errno_tbl[name] : -1; -} - -octave_scalar_map -octave_errno::do_list (void) -{ - octave_scalar_map retval; - - for (std::map::const_iterator p = errno_tbl.begin (); - p != errno_tbl.end (); - p++) - { - retval.assign (p->first, p->second); - } - - return retval; -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/oct-fstrm.cc --- a/libinterp/interp-core/oct-fstrm.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,114 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include "error.h" -#include "oct-fstrm.h" - -octave_stream -octave_fstream::create (const std::string& nm_arg, std::ios::openmode arg_md, - oct_mach_info::float_format ff) -{ - return octave_stream (new octave_fstream (nm_arg, arg_md, ff)); -} - -octave_fstream::octave_fstream (const std::string& nm_arg, - std::ios::openmode arg_md, - oct_mach_info::float_format ff) - : octave_base_stream (arg_md, ff), nm (nm_arg) -{ - -#if CXX_ISO_COMPLIANT_LIBRARY - - fs.open (nm.c_str (), arg_md); - -#else - // Override default protection of 0664 so that umask will appear to - // do the right thing. - - fs.open (nm.c_str (), arg_md, 0666); - -#endif - - if (! fs) - error (gnulib::strerror (errno)); -} - -// Position a stream at OFFSET relative to ORIGIN. - -int -octave_fstream::seek (off_t, int) -{ - error ("fseek: invalid_operation"); - return -1; -} - -// Return current stream position. - -off_t -octave_fstream::tell (void) -{ - error ("ftell: invalid_operation"); - return -1; -} - -// Return non-zero if EOF has been reached on this stream. - -bool -octave_fstream::eof (void) const -{ - return fs.eof (); -} - -void -octave_fstream::do_close (void) -{ - fs.close (); -} - -std::istream * -octave_fstream::input_stream (void) -{ - std::istream *retval = 0; - - if (mode () & std::ios::in) - retval = &fs; - - return retval; -} - -std::ostream * -octave_fstream::output_stream (void) -{ - std::ostream *retval = 0; - - if (mode () & std::ios::out) - retval = &fs; - - return retval; -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/oct-fstrm.h --- a/libinterp/interp-core/oct-fstrm.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,86 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_octave_fstream_h) -#define octave_octave_fstream_h 1 - -#include -#include - -#include "oct-stream.h" - -class -octave_fstream : public octave_base_stream -{ -public: - - octave_fstream (const std::string& nm_arg, - std::ios::openmode arg_md = std::ios::in|std::ios::out, - oct_mach_info::float_format flt_fmt - = oct_mach_info::native_float_format ()); - - static octave_stream - create (const std::string& nm_arg, - std::ios::openmode arg_md = std::ios::in|std::ios::out, - oct_mach_info::float_format flt_fmt - = oct_mach_info::native_float_format ()); - - // Position a stream at OFFSET relative to ORIGIN. - - int seek (off_t offset, int origin); - - // Return current stream position. - - off_t tell (void); - - // Return non-zero if EOF has been reached on this stream. - - bool eof (void) const; - - void do_close (void); - - // The name of the file. - - std::string name (void) const { return nm; } - - std::istream *input_stream (void); - - std::ostream *output_stream (void); - -protected: - - ~octave_fstream (void) { } - -private: - - std::string nm; - - std::fstream fs; - - // No copying! - - octave_fstream (const octave_fstream&); - - octave_fstream& operator = (const octave_fstream&); -}; - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/oct-hdf5.h --- a/libinterp/interp-core/oct-hdf5.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,30 +0,0 @@ -/* - -Copyright (C) 2009-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave__hdf5_h) -#define octave_hdf5_h 1 - -#if defined (HAVE_HDF5) -#include -#endif - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/oct-iostrm.cc --- a/libinterp/interp-core/oct-iostrm.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,89 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "error.h" -#include "oct-iostrm.h" - -// Position a stream at OFFSET relative to ORIGIN. - -int -octave_base_iostream::seek (off_t, int) -{ - invalid_operation (); - return -1; -} - -// Return current stream position. - -off_t -octave_base_iostream::tell (void) -{ - invalid_operation (); - return -1; -} - -// Return non-zero if EOF has been reached on this stream. - -bool -octave_base_iostream::eof (void) const -{ - invalid_operation (); - return false; -} - -void -octave_base_iostream::invalid_operation (void) const -{ - ::error ("%s: invalid operation", stream_type ()); -} - -// Return non-zero if EOF has been reached on this stream. - -bool -octave_istream::eof (void) const -{ - return is && is->eof (); -} - -octave_stream -octave_istream::create (std::istream *arg, const std::string& n) -{ - return octave_stream (new octave_istream (arg, n)); -} - -// Return non-zero if EOF has been reached on this stream. - -bool -octave_ostream::eof (void) const -{ - return os && os->eof (); -} - -octave_stream -octave_ostream::create (std::ostream *arg, const std::string& n) -{ - return octave_stream (new octave_ostream (arg, n)); -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/oct-iostrm.h --- a/libinterp/interp-core/oct-iostrm.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,154 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_octave_iostream_h) -#define octave_octave_iostream_h 1 - -#include - -#include "oct-stream.h" - -class -octave_base_iostream : public octave_base_stream -{ -public: - - octave_base_iostream (const std::string& n = std::string (), - std::ios::openmode m = std::ios::in|std::ios::out, - oct_mach_info::float_format ff - = oct_mach_info::native_float_format ()) - : octave_base_stream (m, ff), nm (n) { } - - // Position a stream at OFFSET relative to ORIGIN. - - int seek (off_t offset, int origin); - - // Return current stream position. - - off_t tell (void); - - // Return non-zero if EOF has been reached on this stream. - - bool eof (void) const; - - // The name of the file. - - std::string name (void) const { return nm; } - -protected: - - ~octave_base_iostream (void) { } - - void invalid_operation (void) const; - -private: - - std::string nm; - - virtual const char *stream_type (void) const = 0; - - // No copying! - - octave_base_iostream (const octave_base_iostream&); - - octave_base_iostream& operator = (const octave_base_iostream&); -}; - -class -octave_istream : public octave_base_iostream -{ -public: - - octave_istream (std::istream *arg = 0, const std::string& n = std::string ()) - : octave_base_iostream (n, std::ios::in, - oct_mach_info::native_float_format ()), - is (arg) - { } - - static octave_stream - create (std::istream *arg = 0, const std::string& n = std::string ()); - - // Return non-zero if EOF has been reached on this stream. - - bool eof (void) const; - - std::istream *input_stream (void) { return is; } - - std::ostream *output_stream (void) { return 0; } - -protected: - - ~octave_istream (void) { } - -private: - - std::istream *is; - - const char *stream_type (void) const { return "octave_istream"; } - - // No copying! - - octave_istream (const octave_istream&); - - octave_istream& operator = (const octave_istream&); -}; - -class -octave_ostream : public octave_base_iostream -{ -public: - - octave_ostream (std::ostream *arg, const std::string& n = std::string ()) - : octave_base_iostream (n, std::ios::out, - oct_mach_info::native_float_format ()), - os (arg) - { } - - static octave_stream - create (std::ostream *arg, const std::string& n = std::string ()); - - // Return non-zero if EOF has been reached on this stream. - - bool eof (void) const; - - std::istream *input_stream (void) { return 0; } - - std::ostream *output_stream (void) { return os; } - -protected: - - ~octave_ostream (void) { } - -private: - - std::ostream *os; - - const char *stream_type (void) const { return "octave_ostream"; } - - // No copying! - - octave_ostream (const octave_ostream&); - - octave_ostream& operator = (const octave_ostream&); -}; - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/oct-lvalue.cc --- a/libinterp/interp-core/oct-lvalue.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,94 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "error.h" -#include "oct-obj.h" -#include "oct-lvalue.h" -#include "ov.h" - -void -octave_lvalue::assign (octave_value::assign_op op, const octave_value& rhs) -{ - if (! is_black_hole ()) - { - if (idx.empty ()) - sym->assign (op, rhs); - else - sym->assign (op, type, idx, rhs); - } -} - -void -octave_lvalue::set_index (const std::string& t, - const std::list& i) -{ - if (idx.empty ()) - { - type = t; - idx = i; - } - else - error ("invalid index expression in assignment"); -} - -void -octave_lvalue::do_unary_op (octave_value::unary_op op) -{ - if (! is_black_hole ()) - { - if (idx.empty ()) - sym->do_non_const_unary_op (op); - else - sym->do_non_const_unary_op (op, type, idx); - } -} - -octave_value -octave_lvalue::value (void) const -{ - octave_value retval; - - if (! is_black_hole ()) - { - octave_value val = sym->varval (); - - if (idx.empty ()) - retval = val; - else - { - if (val.is_constant ()) - retval = val.subsref (type, idx); - else - { - octave_value_list t = val.subsref (type, idx, 1); - if (t.length () > 0) - retval = t(0); - } - } - } - - return retval; -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/oct-lvalue.h --- a/libinterp/interp-core/oct-lvalue.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,108 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_lvalue_h) -#define octave_lvalue_h 1 - -class octave_value; -class octave_value_list; - -#include - -#include "oct-obj.h" -#include "pt-idx.h" -#include "symtab.h" - -class -octave_lvalue -{ -public: - - octave_lvalue (const symbol_table::symbol_reference& s - = symbol_table::symbol_reference ()) - : sym (s), type (), idx (), nel (1) - { } - - octave_lvalue (const octave_lvalue& vr) - : sym (vr.sym), type (vr.type), idx (vr.idx), nel (vr.nel) - { } - - octave_lvalue& operator = (const octave_lvalue& vr) - { - if (this != &vr) - { - sym = vr.sym; - type = vr.type; - idx = vr.idx; - nel = vr.nel; - } - - return *this; - } - - ~octave_lvalue (void) { } - - bool is_black_hole (void) const { return sym.is_black_hole (); } - - bool is_defined (void) const - { - return ! is_black_hole () && sym->is_defined (); - } - - bool is_undefined (void) const - { - return is_black_hole () || sym->is_undefined (); - } - - bool is_map (void) const - { - return value().is_map (); - } - - void define (const octave_value& v) { sym->assign (v); } - - void assign (octave_value::assign_op, const octave_value&); - - void numel (octave_idx_type n) { nel = n; } - - octave_idx_type numel (void) const { return nel; } - - void set_index (const std::string& t, const std::list& i); - - void clear_index (void) { type = std::string (); idx.clear (); } - - void do_unary_op (octave_value::unary_op op); - - octave_value value (void) const; - -private: - - symbol_table::symbol_reference sym; - - std::string type; - - std::list idx; - - octave_idx_type nel; -}; - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/oct-map.cc --- a/libinterp/interp-core/oct-map.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1779 +0,0 @@ -/* - -Copyright (C) 1995-2012 John W. Eaton -Copyright (C) 2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "error.h" -#include "str-vec.h" - -#include "oct-map.h" -#include "utils.h" - -octave_fields::octave_fields (const string_vector& fields) - : rep (new fields_rep) -{ - octave_idx_type n = fields.numel (); - for (octave_idx_type i = 0; i < n; i++) - (*rep)[fields(i)] = i; -} - -octave_fields::octave_fields (const char * const *fields) - : rep (new fields_rep) -{ - octave_idx_type n = 0; - while (*fields) - (*rep)[std::string (*fields++)] = n++; -} - -bool -octave_fields::isfield (const std::string& field) const -{ - return rep->find (field) != rep->end (); -} - -octave_idx_type -octave_fields::getfield (const std::string& field) const -{ - fields_rep::iterator p = rep->find (field); - return (p != rep->end ()) ? p->second : -1; -} - -octave_idx_type -octave_fields::getfield (const std::string& field) -{ - fields_rep::iterator p = rep->find (field); - if (p != rep->end ()) - return p->second; - else - { - make_unique (); - octave_idx_type n = rep->size (); - return (*rep)[field] = n; - } -} - -octave_idx_type -octave_fields::rmfield (const std::string& field) -{ - fields_rep::iterator p = rep->find (field); - if (p == rep->end ()) - return -1; - else - { - octave_idx_type n = p->second; - make_unique (); - rep->erase (field); - for (fields_rep::iterator q = rep->begin (); q != rep->end (); q++) - { - if (q->second >= n) - q->second--; - } - - return n; - } -} - -void -octave_fields::orderfields (Array& perm) -{ - octave_idx_type n = rep->size (); - perm.clear (n, 1); - - make_unique (); - octave_idx_type i = 0; - for (fields_rep::iterator q = rep->begin (); q != rep->end (); q++) - { - octave_idx_type j = q->second; - q->second = i; - perm(i++) = j; - } -} - -bool -octave_fields::equal_up_to_order (const octave_fields& other, - octave_idx_type* perm) const -{ - bool retval = true; - - iterator p = begin (), q = other.begin (); - for (; p != end () && q != other.end (); p++, q++) - { - if (p->first == q->first) - perm[p->second] = q->second; - else - { - retval = false; - break; - } - } - - retval = (p == end () && q == other.end ()); - - return retval; -} - -bool -octave_fields::equal_up_to_order (const octave_fields& other, - Array& perm) const -{ - octave_idx_type n = nfields (); - if (perm.length () != n) - perm.clear (1, n); - - return equal_up_to_order (other, perm.fortran_vec ()); -} - -string_vector -octave_fields::fieldnames (void) const -{ - octave_idx_type n = nfields (); - string_vector retval(n); - - for (iterator p = begin (); p != end (); p++) - retval.xelem (p->second) = p->first; - - return retval; -} - -octave_value -octave_scalar_map::getfield (const std::string& k) const -{ - octave_idx_type idx = xkeys.getfield (k); - return (idx >= 0) ? xvals[idx] : octave_value (); -} - -void -octave_scalar_map::setfield (const std::string& k, const octave_value& val) -{ - octave_idx_type idx = xkeys.getfield (k); - if (idx < static_cast (xvals.size ())) - xvals[idx] = val; - else - xvals.push_back (val); -} - -void -octave_scalar_map::rmfield (const std::string& k) -{ - octave_idx_type idx = xkeys.rmfield (k); - if (idx >= 0) - xvals.erase (xvals.begin () + idx); -} - -octave_scalar_map -octave_scalar_map::orderfields (void) const -{ - Array perm; - return orderfields (perm); -} - -octave_scalar_map -octave_scalar_map::orderfields (Array& perm) const -{ - octave_scalar_map retval (xkeys); - retval.xkeys.orderfields (perm); - - octave_idx_type nf = nfields (); - for (octave_idx_type i = 0; i < nf; i++) - retval.xvals[i] = xvals[perm.xelem (i)]; - - return retval; -} - -octave_scalar_map -octave_scalar_map::orderfields (const octave_scalar_map& other, - Array& perm) const -{ - if (xkeys.is_same (other.xkeys)) - return *this; - else - { - octave_scalar_map retval (other.xkeys); - if (other.xkeys.equal_up_to_order (xkeys, perm)) - { - octave_idx_type nf = nfields (); - for (octave_idx_type i = 0; i < nf; i++) - retval.xvals[i] = xvals[perm.xelem (i)]; - } - else - error ("orderfields: structs must have same fields up to order"); - - return retval; - } -} - -octave_value -octave_scalar_map::contents (const std::string& k) const -{ - return getfield (k); -} - -octave_value& -octave_scalar_map::contents (const std::string& k) -{ - octave_idx_type idx = xkeys.getfield (k); - if (idx >= static_cast (xvals.size ())) - xvals.resize (idx+1); - return xvals[idx]; -} - -octave_map::octave_map (const octave_scalar_map& m) - : xkeys (m.xkeys), xvals (), dimensions (1, 1) -{ - octave_idx_type nf = m.nfields (); - xvals.reserve (nf); - for (octave_idx_type i = 0; i < nf; i++) - { - xvals.push_back (Cell (dimensions)); - xvals[i].xelem (0) = m.xvals[i]; - } -} - -octave_map::octave_map (const Octave_map& m) - : xkeys (m.keys ()), xvals (m.nfields ()), dimensions (m.dims ()) -{ - for (iterator p = begin (); p != end (); p++) - contents(p) = m.contents (key (p)); - - optimize_dimensions (); -} - -Cell -octave_map::getfield (const std::string& k) const -{ - octave_idx_type idx = xkeys.getfield (k); - return (idx >= 0) ? xvals[idx] : Cell (); -} - -void -octave_map::setfield (const std::string& k, const Cell& val) -{ - if (nfields () == 0) - dimensions = val.dims (); - - if (val.dims () == dimensions) - { - octave_idx_type idx = xkeys.getfield (k); - if (idx < static_cast (xvals.size ())) - xvals[idx] = val; - else - xvals.push_back (val); - } - else - error ("octave_map::setfield: internal error"); -} - -void -octave_map::rmfield (const std::string& k) -{ - octave_idx_type idx = xkeys.rmfield (k); - if (idx >= 0) - xvals.erase (xvals.begin () + idx); -} - -octave_map -octave_map::orderfields (void) const -{ - Array perm; - return orderfields (perm); -} - -octave_map -octave_map::orderfields (Array& perm) const -{ - octave_map retval (xkeys); - retval.xkeys.orderfields (perm); - - octave_idx_type nf = nfields (); - for (octave_idx_type i = 0; i < nf; i++) - retval.xvals[i] = xvals[perm.xelem (i)]; - - return retval; -} - -octave_map -octave_map::orderfields (const octave_map& other, - Array& perm) const -{ - if (xkeys.is_same (other.xkeys)) - return *this; - else - { - octave_map retval (other.xkeys); - if (other.xkeys.equal_up_to_order (xkeys, perm)) - { - octave_idx_type nf = nfields (); - for (octave_idx_type i = 0; i < nf; i++) - retval.xvals[i] = xvals[perm.xelem (i)]; - } - else - error ("orderfields: structs must have same fields up to order"); - - return retval; - } -} - -Cell -octave_map::contents (const std::string& k) const -{ - return getfield (k); -} - -Cell& -octave_map::contents (const std::string& k) -{ - octave_idx_type idx = xkeys.getfield (k); - if (idx >= static_cast (xvals.size ())) - xvals.push_back (Cell (dimensions)); // auto-set correct dims. - return xvals[idx]; -} - -void -octave_map::extract_scalar (octave_scalar_map& dest, - octave_idx_type idx) const -{ - octave_idx_type nf = nfields (); - for (octave_idx_type i = 0; i < nf; i++) - dest.xvals[i] = xvals[i](idx); -} - -octave_scalar_map -octave_map::checkelem (octave_idx_type n) const -{ - octave_scalar_map retval (xkeys); - - // Optimize this so that there is just one check. - extract_scalar (retval, compute_index (n, dimensions)); - - return retval; -} - -octave_scalar_map -octave_map::checkelem (octave_idx_type i, octave_idx_type j) const -{ - octave_scalar_map retval (xkeys); - - // Optimize this so that there is just one check. - extract_scalar (retval, compute_index (i, j, dimensions)); - - return retval; -} - -octave_scalar_map -octave_map::checkelem (const Array& ra_idx) const -{ - octave_scalar_map retval (xkeys); - - // Optimize this so that there is just one check. - extract_scalar (retval, compute_index (ra_idx, dimensions)); - - return retval; -} - -octave_scalar_map -octave_map::fast_elem_extract (octave_idx_type n) const -{ - octave_scalar_map retval (xkeys); - - extract_scalar (retval, n); - - return retval; -} - -bool -octave_map::fast_elem_insert (octave_idx_type n, - const octave_scalar_map& rhs) -{ - bool retval = false; - - octave_idx_type nf = nfields (); - if (rhs.xkeys.is_same (xkeys)) - { - for (octave_idx_type i = 0; i < nf; i++) - xvals[i](n) = rhs.xvals[i]; - - retval = true; - } - else - { - OCTAVE_LOCAL_BUFFER (octave_idx_type, perm, nf); - if (xkeys.equal_up_to_order (rhs.xkeys, perm)) - { - for (octave_idx_type i = 0; i < nf; i++) - xvals[i](n) = rhs.xvals[perm[i]]; - - retval = true; - } - } - - return retval; -} - -octave_map -octave_map::squeeze (void) const -{ - octave_map retval (*this); - octave_idx_type nf = nfields (); - - retval.dimensions = dimensions.squeeze (); - - for (octave_idx_type i = 0; i < nf; i++) - retval.xvals[i] = xvals[i].squeeze (); - - retval.optimize_dimensions (); - - return retval; -} - -/* -## test preservation of xkeys by squeeze -%!test -%! x(1,1,1,1).d = 10; x(3,5,1,7).a = "b"; x(2,4,1,7).f = 27; -%! assert (fieldnames (squeeze (x)), {"d"; "a"; "f"}); -*/ - -octave_map -octave_map::permute (const Array& vec, bool inv) const -{ - octave_map retval (xkeys); - octave_idx_type nf = nfields (); - - for (octave_idx_type i = 0; i < nf; i++) - retval.xvals[i] = xvals[i].permute (vec, inv); - - // FIXME: - // There is no dim_vector::permute for technical reasons. - // We pick the dim vector from results if possible, otherwise use a dummy - // array to get it. Need (?) a better solution to this problem. - if (nf > 0) - retval.dimensions = retval.xvals[0].dims (); - else - { - Array dummy (dimensions); - dummy = dummy.permute (vec, inv); - retval.dimensions = dummy.dims (); - } - - retval.optimize_dimensions (); - - return retval; -} - -/* -## test preservation of key order by permute -%!test -%! x(1,1,1,1).d = 10; x(3,5,1,7).a = "b"; x(2,4,1,7).f = 27; -%! assert (fieldnames (permute (x, [3, 4, 1, 2])), {"d"; "a"; "f"}); -*/ - -octave_map -octave_map::transpose (void) const -{ - assert (ndims () == 2); - - octave_map retval (xkeys); - - retval.dimensions = dim_vector (dimensions (1), dimensions (0)); - - octave_idx_type nf = nfields (); - for (octave_idx_type i = 0; i < nf; i++) - retval.xvals[i] = xvals[i].transpose (); - - retval.optimize_dimensions (); - - return retval; -} - -/* -## test preservation of key order by transpose -%!test -%! x(1,1).d = 10; x(3,5).a = "b"; x(2,4).f = 27; -%! assert (fieldnames (transpose (x)), {"d"; "a"; "f"}); -%! assert (fieldnames (x'), {"d"; "a"; "f"}); -%! assert (fieldnames (x.'), {"d"; "a"; "f"}); -*/ - -octave_map -octave_map::reshape (const dim_vector& dv) const -{ - octave_map retval (xkeys); - retval.dimensions = dv; - - octave_idx_type nf = nfields (); - if (nf > 0) - { - retval.xvals.reserve (nf); - for (octave_idx_type i = 0; i < nf; i++) - retval.xvals[i] = xvals[i].reshape (dv); - } - else - { - // FIXME: Do it with a dummy array, to reuse error message. - // Need (?) a better solution. - Array dummy (dimensions); - dummy.reshape (dv); - } - - retval.optimize_dimensions (); - - return retval; -} - -/* -## test preservation of key order by reshape -%!test -%! x(1,1).d = 10; x(4,6).a = "b"; x(2,4).f = 27; -%! assert (fieldnames (reshape (x, 3, 8)), {"d"; "a"; "f"}); -*/ - -void -octave_map::resize (const dim_vector& dv, bool fill) -{ - octave_idx_type nf = nfields (); - if (nf > 0) - { - for (octave_idx_type i = 0; i < nf; i++) - { - if (fill) - xvals[i].resize (dv, Matrix ()); - else - xvals[i].resize (dv); - } - } - else - { - // FIXME: Do it with a dummy array, to reuse error message. - // Need (?) a better solution. - Array dummy (dimensions); - dummy.resize (dv); - } - - dimensions = dv; - optimize_dimensions (); -} - -void -octave_map::do_cat (int dim, octave_idx_type n, const octave_scalar_map *map_list, - octave_map& retval) -{ - octave_idx_type nf = retval.nfields (); - retval.xvals.reserve (nf); - - dim_vector& rd = retval.dimensions; - rd.resize (dim+1, 1); - rd(0) = rd(1) = 1; - rd(dim) = n; - - for (octave_idx_type j = 0; j < nf; j++) - { - retval.xvals.push_back (Cell (rd)); - assert (retval.xvals[j].numel () == n); - for (octave_idx_type i = 0; i < n; i++) - retval.xvals[j].xelem (i) = map_list[i].xvals[j]; - } -} - -void -octave_map::do_cat (int dim, octave_idx_type n, const octave_map *map_list, - octave_map& retval) -{ - octave_idx_type nf = retval.nfields (); - retval.xvals.reserve (nf); - - OCTAVE_LOCAL_BUFFER (Array, field_list, n); - - for (octave_idx_type j = 0; j < nf; j++) - { - for (octave_idx_type i = 0; i < n; i++) - field_list[i] = map_list[i].xvals[j]; - - retval.xvals.push_back (Array::cat (dim, n, field_list)); - if (j == 0) - retval.dimensions = retval.xvals[j].dims (); - } -} - -// This is just a wrapper. -void permute_to_correct_order1 (const octave_scalar_map& ref, const octave_scalar_map& src, - octave_scalar_map& dest, Array& perm) -{ - dest = src.orderfields (ref, perm); -} - -// In non-scalar case, we also promote empty structs without fields. -void permute_to_correct_order1 (const octave_map& ref, const octave_map& src, - octave_map& dest, Array& perm) -{ - if (src.nfields () == 0 && src.is_empty ()) - dest = octave_map (src.dims (), ref.keys ()); - else - dest = src.orderfields (ref, perm); -} - -template -static void -permute_to_correct_order (octave_idx_type n, octave_idx_type nf, - octave_idx_type idx, const map *map_list, - map *new_map_list) -{ - new_map_list[idx] = map_list[idx]; - - Array perm (dim_vector (1, nf)); - - for (octave_idx_type i = 0; i < n; i++) - { - if (i == idx) - continue; - - permute_to_correct_order1 (map_list[idx], map_list[i], new_map_list[i], perm); - - if (error_state) - { - // Use liboctave exception to be consistent. - (*current_liboctave_error_handler) - ("cat: field names mismatch in concatenating structs"); - break; - } - } -} - - -octave_map -octave_map::cat (int dim, octave_idx_type n, const octave_scalar_map *map_list) -{ - octave_map retval; - - // Allow dim = -1, -2 for compatibility, though it makes no difference here. - if (dim == -1 || dim == -2) - dim = -dim - 1; - else if (dim < 0) - (*current_liboctave_error_handler) - ("cat: invalid dimension"); - - if (n == 1) - retval = map_list[0]; - else if (n > 1) - { - octave_idx_type idx, nf = 0; - for (idx = 0; idx < n; idx++) - { - nf = map_list[idx].nfields (); - if (nf > 0) - { - retval.xkeys = map_list[idx].xkeys; - break; - } - } - - if (nf > 0) - { - // Try the fast case. - bool all_same = true; - for (octave_idx_type i = 0; i < n; i++) - { - all_same = map_list[idx].xkeys.is_same (map_list[i].xkeys); - if (! all_same) - break; - } - - if (all_same) - do_cat (dim, n, map_list, retval); - else - { - // permute all structures to common order. - OCTAVE_LOCAL_BUFFER (octave_scalar_map, new_map_list, n); - - permute_to_correct_order (n, nf, idx, map_list, new_map_list); - - do_cat (dim, n, new_map_list, retval); - } - - } - else - { - dim_vector& rd = retval.dimensions; - rd.resize (dim+1, 1); - rd(0) = rd(1) = 1; - rd(dim) = n; - } - - retval.optimize_dimensions (); - } - - return retval; -} - -octave_map -octave_map::cat (int dim, octave_idx_type n, const octave_map *map_list) -{ - octave_map retval; - - // Allow dim = -1, -2 for compatibility, though it makes no difference here. - if (dim == -1 || dim == -2) - dim = -dim - 1; - else if (dim < 0) - (*current_liboctave_error_handler) - ("cat: invalid dimension"); - - if (n == 1) - retval = map_list[0]; - else if (n > 1) - { - octave_idx_type idx, nf = 0; - - for (idx = 0; idx < n; idx++) - { - nf = map_list[idx].nfields (); - if (nf > 0) - { - retval.xkeys = map_list[idx].xkeys; - break; - } - } - - // Try the fast case. - bool all_same = true; - - if (nf > 0) - { - for (octave_idx_type i = 0; i < n; i++) - { - all_same = map_list[idx].xkeys.is_same (map_list[i].xkeys); - - if (! all_same) - break; - } - } - - if (all_same && nf > 0) - do_cat (dim, n, map_list, retval); - else - { - if (nf > 0) - { - // permute all structures to correct order. - OCTAVE_LOCAL_BUFFER (octave_map, new_map_list, n); - - permute_to_correct_order (n, nf, idx, map_list, new_map_list); - - do_cat (dim, n, new_map_list, retval); - } - else - { - dim_vector dv = map_list[0].dimensions; - - for (octave_idx_type i = 1; i < n; i++) - { - if (! dv.concat (map_list[i].dimensions, dim)) - { - error ("dimension mismatch in struct concatenation"); - return retval; - } - } - - retval.dimensions = dv; - } - } - - retval.optimize_dimensions (); - } - - return retval; -} - -/* -## test preservation of key order by concatenation -%!test -%! x(1, 1).d = 10; x(4, 6).a = "b"; x(2, 4).f = 27; -%! y(1, 6).f = 11; y(1, 6).a = "c"; y(1, 6).d = 33; -%! assert (fieldnames ([x; y]), {"d"; "a"; "f"}); - -%!test -%! s = struct (); -%! sr = [s,s]; -%! sc = [s;s]; -%! sm = [s,s;s,s]; -%! assert (nfields (sr), 0); -%! assert (nfields (sc), 0); -%! assert (nfields (sm), 0); -%! assert (size (sr), [1, 2]); -%! assert (size (sc), [2, 1]); -%! assert (size (sm), [2, 2]); -*/ - -octave_map -octave_map::index (const idx_vector& i, bool resize_ok) const -{ - octave_map retval (xkeys); - octave_idx_type nf = nfields (); - - for (octave_idx_type k = 0; k < nf; k++) - retval.xvals[k] = xvals[k].index (i, resize_ok); - - if (nf > 0) - retval.dimensions = retval.xvals[0].dims (); - else - { - // Use dummy array. FIXME: Need(?) a better solution. - Array dummy (dimensions); - dummy = dummy.index (i, resize_ok); - retval.dimensions = dummy.dims (); - } - - retval.optimize_dimensions (); - - return retval; -} - -octave_map -octave_map::index (const idx_vector& i, const idx_vector& j, - bool resize_ok) const -{ - octave_map retval (xkeys); - octave_idx_type nf = nfields (); - - for (octave_idx_type k = 0; k < nf; k++) - retval.xvals[k] = xvals[k].index (i, j, resize_ok); - - if (nf > 0) - retval.dimensions = retval.xvals[0].dims (); - else - { - // Use dummy array. FIXME: Need(?) a better solution. - Array dummy (dimensions); - dummy = dummy.index (i, j, resize_ok); - retval.dimensions = dummy.dims (); - } - - retval.optimize_dimensions (); - - return retval; -} - -octave_map -octave_map::index (const Array& ia, bool resize_ok) const -{ - octave_map retval (xkeys); - octave_idx_type nf = nfields (); - - for (octave_idx_type k = 0; k < nf; k++) - retval.xvals[k] = xvals[k].index (ia, resize_ok); - - if (nf > 0) - retval.dimensions = retval.xvals[0].dims (); - else - { - // Use dummy array. FIXME: Need(?) a better solution. - Array dummy (dimensions); - dummy = dummy.index (ia, resize_ok); - retval.dimensions = dummy.dims (); - } - - retval.optimize_dimensions (); - - return retval; -} - -octave_map -octave_map::index (const octave_value_list& idx, bool resize_ok) const -{ - octave_idx_type n_idx = idx.length (); - octave_map retval; - - switch (n_idx) - { - case 1: - { - idx_vector i = idx(0).index_vector (); - - if (! error_state) - retval = index (i, resize_ok); - } - break; - - case 2: - { - idx_vector i = idx(0).index_vector (); - - if (! error_state) - { - idx_vector j = idx(1).index_vector (); - - retval = index (i, j, resize_ok); - } - } - break; - - default: - { - Array ia (dim_vector (n_idx, 1)); - - for (octave_idx_type i = 0; i < n_idx; i++) - { - ia(i) = idx(i).index_vector (); - - if (error_state) - break; - } - - if (! error_state) - retval = index (ia, resize_ok); - } - break; - } - - return retval; -} - -// Perhaps one day these will be optimized. Right now, they just call index. -octave_map -octave_map::column (octave_idx_type k) const -{ - return index (idx_vector::colon, k); -} - -octave_map -octave_map::page (octave_idx_type k) const -{ - static Array ia (dim_vector (3, 1), idx_vector::colon); - - ia(2) = k; - return index (ia); -} - -void -octave_map::assign (const idx_vector& i, const octave_map& rhs) -{ - if (rhs.xkeys.is_same (xkeys)) - { - octave_idx_type nf = nfields (); - - for (octave_idx_type k = 0; k < nf; k++) - xvals[k].assign (i, rhs.xvals[k], Matrix ()); - - if (nf > 0) - dimensions = xvals[0].dims (); - else - { - // Use dummy array. FIXME: Need(?) a better solution. - Array dummy (dimensions), rhs_dummy (rhs.dimensions); - dummy.assign (i, rhs_dummy);; - dimensions = dummy.dims (); - } - - optimize_dimensions (); - } - else if (nfields () == 0) - { - octave_map tmp (dimensions, rhs.xkeys); - tmp.assign (i, rhs); - *this = tmp; - } - else - { - Array perm; - octave_map rhs1 = rhs.orderfields (*this, perm); - if (! error_state) - { - assert (rhs1.xkeys.is_same (xkeys)); - assign (i, rhs1); - } - else - error ("incompatible fields in struct assignment"); - } -} - -void -octave_map::assign (const idx_vector& i, const idx_vector& j, - const octave_map& rhs) -{ - if (rhs.xkeys.is_same (xkeys)) - { - octave_idx_type nf = nfields (); - - for (octave_idx_type k = 0; k < nf; k++) - xvals[k].assign (i, j, rhs.xvals[k], Matrix ()); - - if (nf > 0) - dimensions = xvals[0].dims (); - else - { - // Use dummy array. FIXME: Need(?) a better solution. - Array dummy (dimensions), rhs_dummy (rhs.dimensions); - dummy.assign (i, j, rhs_dummy);; - dimensions = dummy.dims (); - } - - optimize_dimensions (); - } - else if (nfields () == 0) - { - octave_map tmp (dimensions, rhs.xkeys); - tmp.assign (i, j, rhs); - *this = tmp; - } - else - { - Array perm; - octave_map rhs1 = rhs.orderfields (*this, perm); - if (! error_state) - { - assert (rhs1.xkeys.is_same (xkeys)); - assign (i, j, rhs1); - } - else - error ("incompatible fields in struct assignment"); - } -} - -void -octave_map::assign (const Array& ia, - const octave_map& rhs) -{ - if (rhs.xkeys.is_same (xkeys)) - { - octave_idx_type nf = nfields (); - - for (octave_idx_type k = 0; k < nf; k++) - xvals[k].assign (ia, rhs.xvals[k], Matrix ()); - - if (nf > 0) - dimensions = xvals[0].dims (); - else - { - // Use dummy array. FIXME: Need(?) a better solution. - Array dummy (dimensions), rhs_dummy (rhs.dimensions); - dummy.assign (ia, rhs_dummy);; - dimensions = dummy.dims (); - } - - optimize_dimensions (); - } - else if (nfields () == 0) - { - octave_map tmp (dimensions, rhs.xkeys); - tmp.assign (ia, rhs); - *this = tmp; - } - else - { - Array perm; - octave_map rhs1 = rhs.orderfields (*this, perm); - if (! error_state) - { - assert (rhs1.xkeys.is_same (xkeys)); - assign (ia, rhs1); - } - else - error ("incompatible fields in struct assignment"); - } -} - -void -octave_map::assign (const octave_value_list& idx, const octave_map& rhs) -{ - octave_idx_type n_idx = idx.length (); - - switch (n_idx) - { - case 1: - { - idx_vector i = idx(0).index_vector (); - - if (! error_state) - assign (i, rhs); - } - break; - - case 2: - { - idx_vector i = idx(0).index_vector (); - - if (! error_state) - { - idx_vector j = idx(1).index_vector (); - - assign (i, j, rhs); - } - } - break; - - default: - { - Array ia (dim_vector (n_idx, 1)); - - for (octave_idx_type i = 0; i < n_idx; i++) - { - ia(i) = idx(i).index_vector (); - - if (error_state) - break; - } - - if (! error_state) - assign (ia, rhs); - } - break; - } -} - -void -octave_map::assign (const octave_value_list& idx, const std::string& k, - const Cell& rhs) -{ - Cell tmp; - iterator p = seek (k); - Cell& ref = p != end () ? contents (p) : tmp; - - if (&ref == &tmp) - ref = Cell (dimensions); - - ref.assign (idx, rhs); - - if (! error_state && ref.dims () != dimensions) - { - dimensions = ref.dims (); - - octave_idx_type nf = nfields (); - for (octave_idx_type i = 0; i < nf; i++) - { - if (&xvals[i] != &ref) - xvals[i].resize (dimensions, Matrix ()); - } - - optimize_dimensions (); - } - - if (! error_state && &ref == &tmp) - setfield (k, tmp); -} - -/* -%!test -%! rhs.b = 1; -%! a(3) = rhs; -%! assert ({a.b}, {[], [], 1}) -*/ - -void -octave_map::delete_elements (const idx_vector& i) -{ - octave_idx_type nf = nfields (); - for (octave_idx_type k = 0; k < nf; k++) - xvals[k].delete_elements (i); - - if (nf > 0) - dimensions = xvals[0].dims (); - else - { - // Use dummy array. FIXME: Need(?) a better solution. - Array dummy (dimensions); - dummy.delete_elements (i); - dimensions = dummy.dims (); - } - - optimize_dimensions (); -} - -void -octave_map::delete_elements (int dim, const idx_vector& i) -{ - octave_idx_type nf = nfields (); - for (octave_idx_type k = 0; k < nf; k++) - xvals[k].delete_elements (dim, i); - - if (nf > 0) - dimensions = xvals[0].dims (); - else - { - // Use dummy array. FIXME: Need(?) a better solution. - Array dummy (dimensions); - dummy.delete_elements (dim, i); - dimensions = dummy.dims (); - } - - optimize_dimensions (); -} - -void -octave_map::delete_elements (const Array& ia) -{ - octave_idx_type nf = nfields (); - for (octave_idx_type k = 0; k < nf; k++) - xvals[k].delete_elements (ia); - - if (nf > 0) - dimensions = xvals[0].dims (); - else - { - // Use dummy array. FIXME: Need(?) a better solution. - Array dummy (dimensions); - dummy.delete_elements (ia); - dimensions = dummy.dims (); - } - - optimize_dimensions (); -} - -void -octave_map::delete_elements (const octave_value_list& idx) -{ - octave_idx_type n_idx = idx.length (); - - Array ia (dim_vector (n_idx, 1)); - - for (octave_idx_type i = 0; i < n_idx; i++) - { - ia(i) = idx(i).index_vector (); - - if (error_state) - break; - } - - if (! error_state) - delete_elements (ia); -} - -/* -## test preservation of key order by indexing -%!test -%! x(1, 1).d = 10; x(4, 6).a = "b"; x(2, 4).f = 27; -%! assert (fieldnames (x([1, 2], [2:5])), {"d"; "a"; "f"}); -*/ - -octave_map -octave_map::concat (const octave_map& rb, const Array& ra_idx) -{ - if (nfields () == rb.nfields ()) - { - for (const_iterator pa = begin (); pa != end (); pa++) - { - const_iterator pb = rb.seek (key(pa)); - - if (pb == rb.end ()) - { - error ("field name mismatch in structure concatenation"); - break; - } - - contents(pa).insert (rb.contents (pb), ra_idx); - } - } - else - { - dim_vector dv = dims (); - - if (dv.all_zero ()) - *this = rb; - else if (! rb.dims ().all_zero ()) - error ("invalid structure concatenation"); - } - - return *this; -} - -void -octave_map::optimize_dimensions (void) -{ - octave_idx_type nf = nfields (); - - for (octave_idx_type i = 0; i < nf; i++) - { - if (! xvals[i].optimize_dimensions (dimensions)) - { - error ("internal error: dimension mismatch across fields in struct"); - break; - } - } - -} - -Octave_map::Octave_map (const dim_vector& dv, const Cell& key_vals) - : map (), key_list (), dimensions (dv) -{ - Cell c (dv); - - if (key_vals.is_cellstr ()) - { - for (octave_idx_type i = 0; i < key_vals.numel (); i++) - { - std::string k = key_vals(i).string_value (); - map[k] = c; - key_list.push_back (k); - } - } - else - error ("Octave_map: expecting keys to be cellstr"); -} - -Octave_map::Octave_map (const octave_map& m) - : map (), key_list (), dimensions (m.dims ()) -{ - for (octave_map::const_iterator p = m.begin (); p != m.end (); p++) - map[m.key (p)] = m.contents (p); - const string_vector mkeys = m.fieldnames (); - for (octave_idx_type i = 0; i < mkeys.numel (); i++) - key_list.push_back (mkeys(i)); -} - -Octave_map -Octave_map::squeeze (void) const -{ - Octave_map retval (dims ().squeeze ()); - - for (const_iterator pa = begin (); pa != end (); pa++) - { - Cell tmp = contents (pa).squeeze (); - - if (error_state) - break; - - retval.assign (key (pa), tmp); - } - - // Preserve order of keys. - retval.key_list = key_list; - - return retval; -} - -Octave_map -Octave_map::permute (const Array& vec, bool inv) const -{ - Octave_map retval (dims ()); - - for (const_iterator pa = begin (); pa != end (); pa++) - { - Cell tmp = contents (pa).permute (vec, inv); - - if (error_state) - break; - - retval.assign (key (pa), tmp); - } - - // Preserve order of keys. - retval.key_list = key_list; - - return retval; -} - -Cell& -Octave_map::contents (const std::string& k) -{ - maybe_add_to_key_list (k); - - return map[k]; -} - -Cell -Octave_map::contents (const std::string& k) const -{ - const_iterator p = seek (k); - - return p != end () ? p->second : Cell (); -} - -int -Octave_map::intfield (const std::string& k, int def_val) const -{ - int retval = def_val; - - Cell c = contents (k); - - if (! c.is_empty ()) - retval = c(0).int_value (); - - return retval; -} - -std::string -Octave_map::stringfield (const std::string& k, - const std::string& def_val) const -{ - std::string retval = def_val; - - Cell c = contents (k); - - if (! c.is_empty ()) - retval = c(0).string_value (); - - return retval; -} - -string_vector -Octave_map::keys (void) const -{ - assert (static_cast(nfields ()) == key_list.size ()); - - return string_vector (key_list); -} - -Octave_map -Octave_map::transpose (void) const -{ - assert (ndims () == 2); - - dim_vector dv = dims (); - - octave_idx_type nr = dv(0); - octave_idx_type nc = dv(1); - - dim_vector new_dims (nc, nr); - - Octave_map retval (new_dims); - - for (const_iterator p = begin (); p != end (); p++) - retval.assign (key(p), Cell (contents(p).transpose ())); - - // Preserve order of keys. - retval.key_list = key_list; - - return retval; -} - -Octave_map -Octave_map::reshape (const dim_vector& new_dims) const -{ - Octave_map retval; - - if (new_dims != dims ()) - { - for (const_iterator p = begin (); p != end (); p++) - retval.assign (key(p), contents(p).reshape (new_dims)); - - retval.dimensions = new_dims; - - // Preserve order of keys. - retval.key_list = key_list; - } - else - retval = *this; - - return retval; -} - -void -Octave_map::resize (const dim_vector& dv, bool fill) -{ - if (dv != dims ()) - { - if (nfields () == 0) - dimensions = dv; - else - { - for (const_iterator p = begin (); p != end (); p++) - { - Cell tmp = contents(p); - - if (fill) - tmp.resize (dv, Matrix ()); - else - tmp.resize (dv); - - dimensions = dv; - - assign (key(p), tmp); - } - } - } -} - -Octave_map -Octave_map::concat (const Octave_map& rb, const Array& ra_idx) -{ - Octave_map retval; - - if (nfields () == rb.nfields ()) - { - for (const_iterator pa = begin (); pa != end (); pa++) - { - const_iterator pb = rb.seek (key(pa)); - - if (pb == rb.end ()) - { - error ("field name mismatch in structure concatenation"); - break; - } - - retval.assign (key(pa), - contents(pa).insert (rb.contents(pb), ra_idx)); - } - - // Preserve order of keys. - retval.key_list = key_list; - } - else - { - dim_vector dv = dims (); - - if (dv.all_zero ()) - retval = rb; - else - { - dv = rb.dims (); - - if (dv.all_zero ()) - retval = *this; - else - error ("invalid structure concatenation"); - } - } - - return retval; -} - -static bool -keys_ok (const Octave_map& a, const Octave_map& b, string_vector& keys) -{ - bool retval = false; - - keys = string_vector (); - - if (a.nfields () == 0) - { - keys = b.keys (); - retval = true; - } - else - { - string_vector a_keys = a.keys ().sort (); - string_vector b_keys = b.keys ().sort (); - - octave_idx_type a_len = a_keys.length (); - octave_idx_type b_len = b_keys.length (); - - if (a_len == b_len) - { - for (octave_idx_type i = 0; i < a_len; i++) - { - if (a_keys[i] != b_keys[i]) - goto done; - } - - keys = a_keys; - retval = true; - } - } - - done: - return retval; -} - -Octave_map& -Octave_map::maybe_delete_elements (const octave_value_list& idx) -{ - string_vector t_keys = keys (); - octave_idx_type len = t_keys.length (); - - if (len > 0) - { - for (octave_idx_type i = 0; i < len; i++) - { - std::string k = t_keys[i]; - - contents(k).delete_elements (idx); - - if (error_state) - break; - } - - if (!error_state) - dimensions = contents(t_keys[0]).dims (); - } - - return *this; -} - -Octave_map& -Octave_map::assign (const octave_value_list& idx, const Octave_map& rhs) -{ - string_vector t_keys; - - if (keys_ok (*this, rhs, t_keys)) - { - octave_idx_type len = t_keys.length (); - - if (len == 0) - { - Cell tmp_lhs (dims ()); - Cell tmp_rhs (rhs.dims ()); - - tmp_lhs.assign (idx, tmp_rhs, Matrix ()); - - if (! error_state) - resize (tmp_lhs.dims ()); - else - error ("size mismatch in structure assignment"); - } - else - { - for (octave_idx_type i = 0; i < len; i++) - { - std::string k = t_keys[i]; - - Cell t_rhs = rhs.contents (k); - - assign (idx, k, t_rhs); - - if (error_state) - break; - } - } - } - else - error ("field name mismatch in structure assignment"); - - return *this; -} - -Octave_map& -Octave_map::assign (const octave_value_list& idx, const std::string& k, - const Cell& rhs) -{ - Cell tmp; - - if (contains (k)) - tmp = map[k]; - else - tmp = Cell (dimensions); - - tmp.assign (idx, rhs); - - if (! error_state) - { - dim_vector tmp_dims = tmp.dims (); - - if (tmp_dims != dimensions) - { - for (iterator p = begin (); p != end (); p++) - contents(p).resize (tmp_dims, Matrix ()); - - dimensions = tmp_dims; - } - - maybe_add_to_key_list (k); - - map[k] = tmp; - } - - return *this; -} - -Octave_map& -Octave_map::assign (const std::string& k, const octave_value& rhs) -{ - if (nfields () == 0) - { - maybe_add_to_key_list (k); - - map[k] = Cell (rhs); - - dimensions = dim_vector (1, 1); - } - else - { - dim_vector dv = dims (); - - if (dv.all_ones ()) - { - maybe_add_to_key_list (k); - - map[k] = Cell (rhs); - } - else - error ("invalid structure assignment"); - } - - return *this; -} - -Octave_map& -Octave_map::assign (const std::string& k, const Cell& rhs) -{ - if (nfields () == 0) - { - maybe_add_to_key_list (k); - - map[k] = rhs; - - dimensions = rhs.dims (); - } - else - { - if (dims () == rhs.dims ()) - { - maybe_add_to_key_list (k); - - map[k] = rhs; - } - else - error ("invalid structure assignment"); - } - - return *this; -} - -Octave_map -Octave_map::index (const octave_value_list& idx, bool resize_ok) const -{ - Octave_map retval; - - octave_idx_type n_idx = idx.length (); - - if (n_idx > 0) - { - Array ra_idx (dim_vector (n_idx, 1)); - - for (octave_idx_type i = 0; i < n_idx; i++) - { - ra_idx(i) = idx(i).index_vector (); - if (error_state) - break; - } - - if (! error_state) - { - for (const_iterator p = begin (); p != end (); p++) - { - Cell tmp = contents (p); - - tmp = tmp.Array::index (ra_idx, resize_ok); - - if (error_state) - break; - - retval.assign (key(p), tmp); - } - - // Preserve order of keys. - retval.key_list = key_list; - } - } - else - retval = *this; - - return retval; -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/oct-map.h --- a/libinterp/interp-core/oct-map.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,659 +0,0 @@ -/* - -Copyright (C) 1994-2012 John W. Eaton -Copyright (C) 2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_oct_map_h) -#define octave_oct_map_h 1 - -#include -#include - -#include "Cell.h" -#include "oct-obj.h" - -class string_vector; - -// A class holding a map field->index. Supports reference-counting. -class OCTINTERP_API -octave_fields -{ - class fields_rep : public std::map - { - public: - fields_rep (void) : std::map (), count (1) { } - fields_rep (const fields_rep& other) - : std::map (other), count (1) { } - - octave_refcount count; - - private: - fields_rep& operator = (const fields_rep&); // no assignment! - }; - - fields_rep *rep; - - static fields_rep *nil_rep (void) - { - static fields_rep nr; - return &nr; - } - -public: - - octave_fields (void) : rep (nil_rep ()) { rep->count++; } - octave_fields (const string_vector&); - octave_fields (const char * const *); - - ~octave_fields (void) - { - if (--rep->count == 0) - delete rep; - } - - void make_unique (void) - { - if (rep->count > 1) - { - fields_rep *r = new fields_rep (*rep); - - if (--rep->count == 0) - delete rep; - - rep = r; - } - } - - octave_fields (const octave_fields& o) : rep (o.rep) { rep->count++; } - - octave_fields& - operator = (const octave_fields& o) - { - o.rep->count++; - if (--rep->count == 0) - delete rep; - rep = o.rep; - - return *this; - } - - // constant iteration support. non-const iteration intentionally unsupported. - - typedef std::map::const_iterator const_iterator; - typedef const_iterator iterator; - - const_iterator begin (void) const { return rep->begin (); } - const_iterator end (void) const { return rep->end (); } - - std::string key (const_iterator p) const { return p->first; } - octave_idx_type index (const_iterator p) const { return p->second; } - - const_iterator seek (const std::string& k) const - { return rep->find (k); } - - // high-level methods. - - // number of fields. - octave_idx_type nfields (void) const { return rep->size (); } - - // check whether a field exists. - bool isfield (const std::string& name) const; - - // get index of field. return -1 if not exist - octave_idx_type getfield (const std::string& name) const; - // get index of field. add if not exist - octave_idx_type getfield (const std::string& name); - // remove field and return the index. -1 if didn't exist. - octave_idx_type rmfield (const std::string& name); - - // order the fields of this map. creates a permutation - // used to order the fields. - void orderfields (Array& perm); - - // compares two instances for equality up to order of fields. - // returns a permutation needed to bring the fields of *other* - // into the order of *this*. - bool equal_up_to_order (const octave_fields& other, - octave_idx_type* perm) const; - - bool equal_up_to_order (const octave_fields& other, - Array& perm) const; - - bool is_same (const octave_fields& other) const - { return rep == other.rep; } - - // Returns the fields as a vector of strings. - string_vector fieldnames (void) const; - - void clear (void) - { - *this = octave_fields (); - } -}; - - -class OCTINTERP_API -octave_scalar_map -{ -public: - - octave_scalar_map (const octave_fields& k) - : xkeys (k), xvals (k.nfields ()) { } - - octave_scalar_map (void) : xkeys (), xvals () { } - - octave_scalar_map (const string_vector& k) - : xkeys (k), xvals (k.length ()) { } - - octave_scalar_map (const octave_scalar_map& m) - : xkeys (m.xkeys), xvals(m.xvals) { } - - octave_scalar_map& operator = (const octave_scalar_map& m) - { - xkeys = m.xkeys; - xvals = m.xvals; - - return *this; - } - - // iteration support. note that both const and non-const iterators are the - // same. The const/non-const distinction is made by the key & contents method. - typedef octave_fields::const_iterator const_iterator; - typedef const_iterator iterator; - - const_iterator begin (void) const { return xkeys.begin (); } - const_iterator end (void) const { return xkeys.end (); } - - const_iterator seek (const std::string& k) const { return xkeys.seek (k); } - - std::string key (const_iterator p) const - { return xkeys.key (p); } - octave_idx_type index (const_iterator p) const - { return xkeys.index (p); } - - const octave_value& contents (const_iterator p) const - { return xvals[xkeys.index (p)]; } - - octave_value& contents (iterator p) - { return xvals[xkeys.index (p)]; } - - const octave_value& contents (octave_idx_type i) const - { return xvals[i]; } - - octave_value& contents (octave_idx_type i) - { return xvals[i]; } - - // number of fields. - octave_idx_type nfields (void) const { return xkeys.nfields (); } - - // check whether a field exists. - bool isfield (const std::string& name) const - { return xkeys.isfield (name); } - - bool contains (const std::string& name) const - { return isfield (name); } - - string_vector fieldnames (void) const - { return xkeys.fieldnames (); } - - string_vector keys (void) const - { return fieldnames (); } - - // get contents of a given field. empty value if not exist. - octave_value getfield (const std::string& key) const; - - // set contents of a given field. add if not exist. - void setfield (const std::string& key, const octave_value& val); - void assign (const std::string& k, const octave_value& val) - { setfield (k, val); } - - // remove a given field. do nothing if not exist. - void rmfield (const std::string& key); - void del (const std::string& k) { rmfield (k); } - - // return a copy with fields ordered, optionally along with permutation. - octave_scalar_map orderfields (void) const; - octave_scalar_map orderfields (Array& perm) const; - octave_scalar_map orderfields (const octave_scalar_map& other, - Array& perm) const; - - // aka getfield/setfield, but the latter returns a reference. - octave_value contents (const std::string& k) const; - octave_value& contents (const std::string& k); - - void clear (void) - { - xkeys.clear (); - xvals.clear (); - } - - friend class octave_map; - -private: - - octave_fields xkeys; - std::vector xvals; - -}; - -template<> -inline octave_scalar_map octave_value_extract (const octave_value& v) - { return v.scalar_map_value (); } - -class OCTINTERP_API -octave_map -{ -public: - - octave_map (const octave_fields& k) - : xkeys (k), xvals (k.nfields ()), dimensions () { } - - octave_map (const dim_vector& dv, const octave_fields& k) - : xkeys (k), xvals (k.nfields (), Cell (dv)), dimensions (dv) { } - - typedef octave_scalar_map element_type; - - octave_map (void) : xkeys (), xvals (), dimensions () { } - - octave_map (const dim_vector& dv) : xkeys (), xvals (), dimensions (dv) { } - - octave_map (const string_vector& k) - : xkeys (k), xvals (k.length (), Cell (1, 1)), dimensions (1, 1) { } - - octave_map (const dim_vector& dv, const string_vector& k) - : xkeys (k), xvals (k.length (), Cell (dv)), dimensions (dv) { } - - octave_map (const octave_map& m) - : xkeys (m.xkeys), xvals (m.xvals), dimensions (m.dimensions) { } - - octave_map (const octave_scalar_map& m); - - octave_map (const Octave_map& m); - - octave_map& operator = (const octave_map& m) - { - xkeys = m.xkeys; - xvals = m.xvals; - dimensions = m.dimensions; - - return *this; - } - - // iteration support. note that both const and non-const iterators are the - // same. The const/non-const distinction is made by the key & contents method. - typedef octave_fields::const_iterator const_iterator; - typedef const_iterator iterator; - - const_iterator begin (void) const { return xkeys.begin (); } - const_iterator end (void) const { return xkeys.end (); } - - const_iterator seek (const std::string& k) const { return xkeys.seek (k); } - - std::string key (const_iterator p) const - { return xkeys.key (p); } - octave_idx_type index (const_iterator p) const - { return xkeys.index (p); } - - const Cell& contents (const_iterator p) const - { return xvals[xkeys.index (p)]; } - - Cell& contents (iterator p) - { return xvals[xkeys.index (p)]; } - - const Cell& contents (octave_idx_type i) const - { return xvals[i]; } - - Cell& contents (octave_idx_type i) - { return xvals[i]; } - - // number of fields. - octave_idx_type nfields (void) const { return xkeys.nfields (); } - - // check whether a field exists. - bool isfield (const std::string& name) const - { return xkeys.isfield (name); } - - bool contains (const std::string& name) const - { return isfield (name); } - - string_vector fieldnames (void) const - { return xkeys.fieldnames (); } - - string_vector keys (void) const - { return fieldnames (); } - - // get contents of a given field. empty value if not exist. - Cell getfield (const std::string& key) const; - - // set contents of a given field. add if not exist. checks for - // correct dimensions. - void setfield (const std::string& key, const Cell& val); - void assign (const std::string& k, const Cell& val) - { setfield (k, val); } - - // remove a given field. do nothing if not exist. - void rmfield (const std::string& key); - void del (const std::string& k) { rmfield (k); } - - // return a copy with fields ordered, optionally along with permutation. - octave_map orderfields (void) const; - octave_map orderfields (Array& perm) const; - octave_map orderfields (const octave_map& other, - Array& perm) const; - - // aka getfield/setfield, but the latter returns a reference. - Cell contents (const std::string& k) const; - Cell& contents (const std::string& k); - - void clear (void) - { - xkeys.clear (); - xvals.clear (); - } - - // The Array-like methods. - octave_idx_type numel (void) const { return dimensions.numel (); } - octave_idx_type length (void) const { return numel (); } - bool is_empty (void) const { return dimensions.any_zero (); } - - octave_idx_type rows (void) const { return dimensions(0); } - octave_idx_type cols (void) const { return dimensions(1); } - octave_idx_type columns (void) const { return dimensions(1); } - - // Extract a scalar substructure. - octave_scalar_map checkelem (octave_idx_type n) const; - octave_scalar_map checkelem (octave_idx_type i, octave_idx_type j) const; - - octave_scalar_map - checkelem (const Array& ra_idx) const; - - octave_scalar_map operator () (octave_idx_type n) const - { return checkelem (n); } - octave_scalar_map operator () (octave_idx_type i, octave_idx_type j) const - { return checkelem (i, j); } - - octave_scalar_map - operator () (const Array& ra_idx) const - { return checkelem (ra_idx); } - - octave_map squeeze (void) const; - - octave_map permute (const Array& vec, bool inv = false) const; - - dim_vector dims (void) const { return dimensions; } - - int ndims (void) const { return dimensions.length (); } - - octave_map transpose (void) const; - - octave_map reshape (const dim_vector& dv) const; - - void resize (const dim_vector& dv, bool fill = false); - - static octave_map - cat (int dim, octave_idx_type n, const octave_scalar_map *map_list); - - static octave_map - cat (int dim, octave_idx_type n, const octave_map *map_list); - - octave_map index (const idx_vector& i, bool resize_ok = false) const; - - octave_map index (const idx_vector& i, const idx_vector& j, - bool resize_ok = false) const; - - octave_map index (const Array& ia, - bool resize_ok = false) const; - - octave_map index (const octave_value_list&, bool resize_ok = false) const; - - octave_map column (octave_idx_type k) const; - octave_map page (octave_idx_type k) const; - - void assign (const idx_vector& i, const octave_map& rhs); - - void assign (const idx_vector& i, const idx_vector& j, const octave_map& rhs); - - void assign (const Array& ia, const octave_map& rhs); - - void assign (const octave_value_list&, const octave_map& rhs); - - void assign (const octave_value_list& idx, const std::string& k, - const Cell& rhs); - - void delete_elements (const idx_vector& i); - - void delete_elements (int dim, const idx_vector& i); - - void delete_elements (const Array& ia); - - void delete_elements (const octave_value_list&); - - octave_map concat (const octave_map& rb, const Array& ra_idx); - - // like checkelem, but no check. - octave_scalar_map fast_elem_extract (octave_idx_type n) const; - - // element assignment, no bounds check - bool fast_elem_insert (octave_idx_type n, const octave_scalar_map& rhs); - -private: - - octave_fields xkeys; - std::vector xvals; - dim_vector dimensions; - - void optimize_dimensions (void); - void extract_scalar (octave_scalar_map& dest, - octave_idx_type index) const; - static void do_cat (int dim, octave_idx_type n, - const octave_scalar_map *map_list, octave_map& retval); - static void do_cat (int dim, octave_idx_type n, - const octave_map *map_list, octave_map& retval); -}; - -template<> -inline octave_map octave_value_extract (const octave_value& v) - { return v.map_value (); } - -// The original Octave_map object which is now deprecated. -// Octave_map and octave_map are convertible to each other. - -class -OCTINTERP_API -Octave_map -{ - public: - - typedef std::map::iterator iterator; - typedef std::map::const_iterator const_iterator; - - typedef std::list::iterator key_list_iterator; - typedef std::list::const_iterator const_key_list_iterator; - - // Warning! You should always use at least two dimensions. - - Octave_map (const dim_vector& dv = dim_vector (0, 0), - const Cell& key_vals = Cell ()); - - Octave_map (const std::string& k, const octave_value& value) - : map (), key_list (), dimensions (1, 1) - { - map[k] = value; - key_list.push_back (k); - } - - Octave_map (const string_vector& sv, - const dim_vector& dv = dim_vector (0, 0)) - : map (), key_list (), dimensions (dv) - { - for (octave_idx_type i = 0; i < sv.length (); i++) - { - std::string k = sv[i]; - map[k] = Cell (dv); - key_list.push_back (k); - } - } - - Octave_map (const std::string& k, const Cell& vals) - : map (), key_list (), dimensions (vals.dims ()) - { - map[k] = vals; - key_list.push_back (k); - } - - Octave_map (const std::string& k, const octave_value_list& val_list) - : map (), key_list (), dimensions (1, val_list.length ()) - { - map[k] = val_list; - key_list.push_back (k); - } - - Octave_map (const Octave_map& m) - : map (m.map), key_list (m.key_list), dimensions (m.dimensions) { } - - Octave_map (const octave_map& m); - - Octave_map& operator = (const Octave_map& m) - { - if (this != &m) - { - map = m.map; - key_list = m.key_list; - dimensions = m.dimensions; - } - - return *this; - } - - ~Octave_map (void) { } - - Octave_map squeeze (void) const; - - Octave_map permute (const Array& vec, bool inv = false) const; - - // This is the number of keys. - octave_idx_type nfields (void) const { return map.size (); } - - void del (const std::string& k) - { - iterator p = map.find (k); - - if (p != map.end ()) - { - map.erase (p); - - key_list_iterator q - = std::find (key_list.begin (), key_list.end (), k); - - assert (q != key_list.end ()); - - key_list.erase (q); - } - } - - iterator begin (void) { return iterator (map.begin ()); } - const_iterator begin (void) const { return const_iterator (map.begin ()); } - - iterator end (void) { return iterator (map.end ()); } - const_iterator end (void) const { return const_iterator (map.end ()); } - - std::string key (const_iterator p) const { return p->first; } - - Cell& contents (const std::string& k); - Cell contents (const std::string& k) const; - - Cell& contents (iterator p) - { return p->second; } - - Cell contents (const_iterator p) const - { return p->second; } - - int intfield (const std::string& k, int def_val = 0) const; - - std::string stringfield (const std::string& k, - const std::string& def_val = std::string ()) const; - - iterator seek (const std::string& k) { return map.find (k); } - const_iterator seek (const std::string& k) const { return map.find (k); } - - bool contains (const std::string& k) const - { return (seek (k) != map.end ()); } - - void clear (void) - { - map.clear (); - key_list.clear (); - } - - string_vector keys (void) const; - - octave_idx_type rows (void) const { return dimensions(0); } - - octave_idx_type columns (void) const { return dimensions(1); } - - dim_vector dims (void) const { return dimensions; } - - int ndims (void) const { return dimensions.length (); } - - Octave_map transpose (void) const; - - Octave_map reshape (const dim_vector& new_dims) const; - - void resize (const dim_vector& dv, bool fill = false); - - octave_idx_type numel (void) const { return dimensions.numel (); } - - Octave_map concat (const Octave_map& rb, const Array& ra_idx); - - Octave_map& maybe_delete_elements (const octave_value_list& idx); - - Octave_map& assign (const octave_value_list& idx, const Octave_map& rhs); - - Octave_map& assign (const octave_value_list& idx, const std::string& k, - const Cell& rhs); - - Octave_map& assign (const std::string& k, const octave_value& rhs); - - Octave_map& assign (const std::string& k, const Cell& rhs); - - Octave_map index (const octave_value_list& idx, - bool resize_ok = false) const; - -private: - - // The map of names to values. - std::map map; - - // An extra list of keys, so we can keep track of the order the keys - // are added for compatibility with you know what. - std::list key_list; - - // The current size. - mutable dim_vector dimensions; - - void maybe_add_to_key_list (const std::string& k) - { - if (! contains (k)) - key_list.push_back (k); - } -} GCC_ATTR_DEPRECATED; - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/oct-obj.cc --- a/libinterp/interp-core/oct-obj.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,284 +0,0 @@ -/* - -Copyright (C) 1994-2012 John W. Eaton -Copyright (C) 2009 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "error.h" -#include "oct-obj.h" -#include "Cell.h" - -// We are likely to have a lot of octave_value_list objects to allocate, -// so make the grow_size large. -DEFINE_OCTAVE_ALLOCATOR2(octave_value_list, 1024); - -octave_value_list::octave_value_list (const std::list& lst) -{ - octave_idx_type n = 0, nel = 0; - - // Determine number. - for (std::list::const_iterator p = lst.begin (); - p != lst.end (); p++) - { - n++; - nel += p->length (); - } - - // Optimize single-element case - if (n == 1) - data = lst.front ().data; - else if (nel > 0) - { - data.resize (dim_vector (1, nel)); - octave_idx_type k = 0; - for (std::list::const_iterator p = lst.begin (); - p != lst.end (); p++) - { - data.assign (idx_vector (k, k + p->length ()), p->data); - k += p->length (); - } - assert (k == nel); - } - -} - -octave_value_list& -octave_value_list::prepend (const octave_value& val) -{ - octave_idx_type n = length (); - - resize (n + 1); - - while (n > 0) - { - elem (n) = elem (n - 1); - n--; - } - - elem (0) = val; - - return *this; -} - -octave_value_list& -octave_value_list::append (const octave_value& val) -{ - octave_idx_type n = length (); - - resize (n + 1); - - elem (n) = val; - - return *this; -} - -octave_value_list& -octave_value_list::append (const octave_value_list& lst) -{ - octave_idx_type len = length (); - octave_idx_type lst_len = lst.length (); - - resize (len + lst_len); - - for (octave_idx_type i = 0; i < lst_len; i++) - elem (len + i) = lst (i); - - return *this; -} - -octave_value_list& -octave_value_list::reverse (void) -{ - octave_idx_type n = length (); - - for (octave_idx_type i = 0; i < n / 2; i++) - { - octave_value tmp = elem (i); - elem (i) = elem (n - i - 1); - elem (n - i - 1) = tmp; - } - - return *this; -} - -octave_value_list -octave_value_list::splice (octave_idx_type offset, octave_idx_type rep_length, - const octave_value_list& lst) const -{ - octave_value_list retval; - - octave_idx_type len = length (); - - if (offset < 0 || offset >= len) - { - if (! (rep_length == 0 && offset == len)) - { - error ("octave_value_list::splice: invalid OFFSET"); - return retval; - } - } - - if (rep_length < 0 || rep_length + offset > len) - { - error ("octave_value_list::splice: invalid LENGTH"); - return retval; - } - - octave_idx_type lst_len = lst.length (); - - octave_idx_type new_len = len - rep_length + lst_len; - - retval.resize (new_len); - - octave_idx_type k = 0; - - for (octave_idx_type i = 0; i < offset; i++) - retval(k++) = elem (i); - - for (octave_idx_type i = 0; i < lst_len; i++) - retval(k++) = lst (i); - - for (octave_idx_type i = offset + rep_length; i < len; i++) - retval(k++) = elem (i); - - return retval; -} - -bool -octave_value_list::all_strings_p (void) const -{ - octave_idx_type n = length (); - - for (octave_idx_type i = 0; i < n; i++) - if (! elem(i).is_string ()) - return false; - - return true; -} - -bool -octave_value_list::all_scalars (void) const -{ - octave_idx_type n = length (); - - for (octave_idx_type i = 0; i < n; i++) - { - dim_vector dv = elem(i).dims (); - if (! dv.all_ones ()) - return false; - } - - return true; -} - -bool -octave_value_list::any_cell (void) const -{ - octave_idx_type n = length (); - - for (octave_idx_type i = 0; i < n; i++) - if (elem (i).is_cell ()) - return true; - - return false; -} - -bool -octave_value_list::has_magic_colon (void) const -{ - octave_idx_type n = length (); - - for (octave_idx_type i = 0; i < n; i++) - if (elem(i).is_magic_colon ()) - return true; - - return false; -} - -string_vector -octave_value_list::make_argv (const std::string& fcn_name) const -{ - string_vector argv; - - if (all_strings_p ()) - { - octave_idx_type len = length (); - - octave_idx_type total_nr = 0; - - for (octave_idx_type i = 0; i < len; i++) - { - // An empty std::string ("") has zero columns and zero rows (a - // change that was made for Matlab contemptibility. - - octave_idx_type n = elem(i).rows (); - - total_nr += n ? n : 1; - } - - octave_idx_type k = 0; - if (! fcn_name.empty ()) - { - argv.resize (total_nr+1); - argv[0] = fcn_name; - k = 1; - } - else - argv.resize (total_nr); - - for (octave_idx_type i = 0; i < len; i++) - { - octave_idx_type nr = elem(i).rows (); - - if (nr < 2) - argv[k++] = elem(i).string_value (); - else - { - string_vector tmp = elem(i).all_strings (); - - for (octave_idx_type j = 0; j < nr; j++) - argv[k++] = tmp[j]; - } - } - } - else - error ("%s: expecting all arguments to be strings", fcn_name.c_str ()); - - return argv; -} - -void -octave_value_list::make_storable_values (void) -{ - octave_idx_type len = length (); - const Array& cdata = data; - - for (octave_idx_type i = 0; i < len; i++) - { - // This is optimized so that we don't force a copy unless necessary. - octave_value tmp = cdata(i).storable_value (); - if (! tmp.is_copy_of (cdata (i))) - data(i) = tmp; - } -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/oct-obj.h --- a/libinterp/interp-core/oct-obj.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,317 +0,0 @@ -/* - -Copyright (C) 1994-2012 John W. Eaton -Copyright (C) 2009 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_oct_obj_h) -#define octave_oct_obj_h 1 - -#include -#include - -#include "oct-alloc.h" -#include "str-vec.h" -#include "Array.h" - -#include "ov.h" -#include "Cell.h" - -class -OCTINTERP_API -octave_value_list -{ -public: - - octave_value_list (void) - : data (), names () { } - - explicit octave_value_list (octave_idx_type n) - : data (dim_vector (1, n)), names () { } - - octave_value_list (octave_idx_type n, const octave_value& val) - : data (dim_vector (1, n), val), names () { } - - octave_value_list (const octave_value& tc) - : data (dim_vector (1, 1), tc), names () { } - - octave_value_list (const Array& d) - : data (d.as_row ()), names () { } - - octave_value_list (const Cell& tc) - : data (tc.as_row ()), names () { } - - octave_value_list (const octave_value_list& obj) - : data (obj.data), names (obj.names) { } - - // Concatenation constructor. - octave_value_list (const std::list&); - - ~octave_value_list (void) { } - - octave_value_list& operator = (const octave_value_list& obj) - { - if (this != &obj) - { - data = obj.data; - names = obj.names; - } - - return *this; - } - - Array array_value (void) const { return data; } - - Cell cell_value (void) const { return array_value (); } - - // Assignment will resize on range errors. - - octave_value& operator () (octave_idx_type n) { return elem (n); } - - const octave_value& operator () (octave_idx_type n) const { return elem (n); } - - octave_idx_type length (void) const { return data.length (); } - - bool empty (void) const { return length () == 0; } - - void resize (octave_idx_type n, const octave_value& rfv = octave_value ()) - { - data.resize (dim_vector (1, n), rfv); - } - - octave_value_list& prepend (const octave_value& val); - - octave_value_list& append (const octave_value& val); - - octave_value_list& append (const octave_value_list& lst); - - octave_value_list& reverse (void); - - octave_value_list - slice (octave_idx_type offset, octave_idx_type len, bool tags = false) const - { - octave_value_list retval (data.linear_slice (offset, offset + len)); - if (tags && len > 0 && names.length () > 0) - retval.names = names.linear_slice (offset, std::min (len, names.length ())); - - return retval; - } - - octave_value_list - splice (octave_idx_type offset, octave_idx_type len, - const octave_value_list& lst = octave_value_list ()) const; - - bool all_strings_p (void) const; - - bool all_scalars (void) const; - - bool any_cell (void) const; - - bool has_magic_colon (void) const; - - string_vector make_argv (const std::string& = std::string ()) const; - - void stash_name_tags (const string_vector& nm) { names = nm; } - - string_vector name_tags (void) const { return names; } - - void make_storable_values (void); - - octave_value& xelem (octave_idx_type i) - { - return data.xelem (i); - } - - void clear (void) - { - data.clear (); - } - -private: - - Array data; - - // This list of strings can be used to tag each element of data with - // a name. By default, it is empty. - string_vector names; - - octave_value& elem (octave_idx_type n) - { - if (n >= length ()) - resize (n + 1); - - return data(n); - } - - const octave_value& elem (octave_idx_type n) const - { return data(n); } - - DECLARE_OCTAVE_ALLOCATOR -}; - -// Make it easy to build argument lists for built-in functions or for -// returning values. - -inline octave_value_list -ovl (const octave_value& a0) -{ - octave_value_list retval; - retval(0) = a0; - return retval; -} - -inline octave_value_list -ovl (const octave_value& a0, const octave_value& a1) -{ - octave_value_list retval; - retval(1) = a1; - retval(0) = a0; - return retval; -} - -inline octave_value_list -ovl (const octave_value& a0, const octave_value& a1, - const octave_value& a2) -{ - octave_value_list retval; - retval(2) = a2; - retval(1) = a1; - retval(0) = a0; - return retval; -} - -inline octave_value_list -ovl (const octave_value& a0, const octave_value& a1, - const octave_value& a2, const octave_value& a3) -{ - octave_value_list retval; - retval(3) = a3; - retval(2) = a2; - retval(1) = a1; - retval(0) = a0; - return retval; -} - -inline octave_value_list -ovl (const octave_value& a0, const octave_value& a1, - const octave_value& a2, const octave_value& a3, - const octave_value& a4) -{ - octave_value_list retval; - retval(4) = a4; - retval(3) = a3; - retval(2) = a2; - retval(1) = a1; - retval(0) = a0; - return retval; -} - -inline octave_value_list -ovl (const octave_value& a0, const octave_value& a1, - const octave_value& a2, const octave_value& a3, - const octave_value& a4, const octave_value& a5) -{ - octave_value_list retval; - retval(5) = a5; - retval(4) = a4; - retval(3) = a3; - retval(2) = a2; - retval(1) = a1; - retval(0) = a0; - return retval; -} - -inline octave_value_list -ovl (const octave_value& a0, const octave_value& a1, - const octave_value& a2, const octave_value& a3, - const octave_value& a4, const octave_value& a5, - const octave_value& a6) -{ - octave_value_list retval; - retval(6) = a6; - retval(5) = a5; - retval(4) = a4; - retval(3) = a3; - retval(2) = a2; - retval(1) = a1; - retval(0) = a0; - return retval; -} - -inline octave_value_list -ovl (const octave_value& a0, const octave_value& a1, - const octave_value& a2, const octave_value& a3, - const octave_value& a4, const octave_value& a5, - const octave_value& a6, const octave_value& a7) -{ - octave_value_list retval; - retval(7) = a7; - retval(6) = a6; - retval(5) = a5; - retval(4) = a4; - retval(3) = a3; - retval(2) = a2; - retval(1) = a1; - retval(0) = a0; - return retval; -} - -inline octave_value_list -ovl (const octave_value& a0, const octave_value& a1, - const octave_value& a2, const octave_value& a3, - const octave_value& a4, const octave_value& a5, - const octave_value& a6, const octave_value& a7, - const octave_value& a8) -{ - octave_value_list retval; - retval(8) = a8; - retval(7) = a7; - retval(6) = a6; - retval(5) = a5; - retval(4) = a4; - retval(3) = a3; - retval(2) = a2; - retval(1) = a1; - retval(0) = a0; - return retval; -} - -inline octave_value_list -ovl (const octave_value& a0, const octave_value& a1, - const octave_value& a2, const octave_value& a3, - const octave_value& a4, const octave_value& a5, - const octave_value& a6, const octave_value& a7, - const octave_value& a8, const octave_value& a9) -{ - octave_value_list retval; - retval(9) = a9; - retval(8) = a8; - retval(7) = a7; - retval(6) = a6; - retval(5) = a5; - retval(4) = a4; - retval(3) = a3; - retval(2) = a2; - retval(1) = a1; - retval(0) = a0; - return retval; -} - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/oct-prcstrm.cc --- a/libinterp/interp-core/oct-prcstrm.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,70 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "oct-prcstrm.h" -#include "sysdep.h" - -octave_stream -octave_iprocstream::create (const std::string& n, std::ios::openmode arg_md, - oct_mach_info::float_format ff) -{ - return octave_stream (new octave_iprocstream (n, arg_md, ff)); -} - -octave_iprocstream::octave_iprocstream (const std::string& n, - std::ios::openmode arg_md, - oct_mach_info::float_format ff) - : octave_stdiostream (n, octave_popen (n.c_str (), "r"), - arg_md, ff, octave_pclose) -{ -} - -octave_iprocstream::~octave_iprocstream (void) -{ - do_close (); -} - -octave_stream -octave_oprocstream::create (const std::string& n, std::ios::openmode arg_md, - oct_mach_info::float_format ff) -{ - return octave_stream (new octave_oprocstream (n, arg_md, ff)); -} - -octave_oprocstream::octave_oprocstream (const std::string& n, - std::ios::openmode arg_md, - oct_mach_info::float_format ff) - : octave_stdiostream (n, octave_popen (n.c_str (), "w"), - arg_md, ff, octave_pclose) -{ -} - -octave_oprocstream::~octave_oprocstream (void) -{ - do_close (); -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/oct-prcstrm.h --- a/libinterp/interp-core/oct-prcstrm.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,87 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_octave_procstream_h) -#define octave_octave_procstream_h 1 - -#include "oct-stdstrm.h" - -// FIXME -- why don't these classes use iprocstream and -// oprocstream, which in turn use the octave_procbuf class? - -class -octave_iprocstream : public octave_stdiostream -{ -public: - - octave_iprocstream (const std::string& n, - std::ios::openmode arg_md = std::ios::in, - oct_mach_info::float_format flt_fmt - = oct_mach_info::native_float_format ()); - - static octave_stream - create (const std::string& n, std::ios::openmode arg_md = std::ios::in, - oct_mach_info::float_format flt_fmt - = oct_mach_info::native_float_format ()); - -protected: - - ~octave_iprocstream (void); - -private: - - // No copying! - - octave_iprocstream (const octave_iprocstream&); - - octave_iprocstream& operator = (const octave_iprocstream&); -}; - -class -octave_oprocstream : public octave_stdiostream -{ -public: - - octave_oprocstream (const std::string& n, - std::ios::openmode arg_md = std::ios::out, - oct_mach_info::float_format flt_fmt - = oct_mach_info::native_float_format ()); - - static octave_stream - create (const std::string& n, std::ios::openmode arg_md = std::ios::out, - oct_mach_info::float_format flt_fmt - = oct_mach_info::native_float_format ()); - -protected: - - ~octave_oprocstream (void); - -private: - - // No copying! - - octave_oprocstream (const octave_oprocstream&); - - octave_oprocstream& operator = (const octave_oprocstream&); -}; - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/oct-procbuf.cc --- a/libinterp/interp-core/oct-procbuf.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,222 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include - -#include -#include - -#include "lo-mappers.h" -#include "lo-utils.h" -#include "oct-procbuf.h" -#include "oct-syscalls.h" -#include "sysdep.h" -#include "variables.h" - -#include "defun.h" -#include "gripes.h" -#include "utils.h" - -#ifndef SHELL_PATH -#define SHELL_PATH "/bin/sh" -#endif - -// This class is based on the procbuf class from libg++, written by -// Per Bothner, Copyright (C) 1993 Free Software Foundation. - -static octave_procbuf *octave_procbuf_list = 0; - -#ifndef BUFSIZ -#define BUFSIZ 1024 -#endif - -octave_procbuf * -octave_procbuf::open (const char *command, int mode) -{ -#if defined (__CYGWIN__) || defined (__MINGW32__) || defined (_MSC_VER) - - if (is_open ()) - return 0; - - f = octave_popen (command, (mode & std::ios::in) ? "r" : "w"); - - if (! f) - return 0; - - // Oops... popen doesn't return the associated pid, so fake it for now - - proc_pid = 1; - - open_p = true; - - if (mode & std::ios::out) - ::setvbuf (f, 0, _IOLBF, BUFSIZ); - - return this; - -#elif defined (HAVE_SYS_WAIT_H) - - int pipe_fds[2]; - - volatile int child_std_end = (mode & std::ios::in) ? 1 : 0; - - volatile int parent_end, child_end; - - if (is_open ()) - return 0; - - if (pipe (pipe_fds) < 0) - return 0; - - if (mode & std::ios::in) - { - parent_end = pipe_fds[0]; - child_end = pipe_fds[1]; - } - else - { - parent_end = pipe_fds[1]; - child_end = pipe_fds[0]; - } - - proc_pid = ::fork (); - - if (proc_pid == 0) - { - gnulib::close (parent_end); - - if (child_end != child_std_end) - { - gnulib::dup2 (child_end, child_std_end); - gnulib::close (child_end); - } - - while (octave_procbuf_list) - { - FILE *fp = octave_procbuf_list->f; - - if (fp) - { - gnulib::fclose (fp); - fp = 0; - } - - octave_procbuf_list = octave_procbuf_list->next; - } - - execl (SHELL_PATH, "sh", "-c", command, static_cast (0)); - - exit (127); - } - - gnulib::close (child_end); - - if (proc_pid < 0) - { - gnulib::close (parent_end); - return 0; - } - - f = ::fdopen (parent_end, (mode & std::ios::in) ? "r" : "w"); - - if (mode & std::ios::out) - ::setvbuf (f, 0, _IOLBF, BUFSIZ); - - open_p = true; - - next = octave_procbuf_list; - octave_procbuf_list = this; - - return this; - -#else - - return 0; - -#endif -} - -octave_procbuf * -octave_procbuf::close (void) -{ -#if defined (__CYGWIN__) || defined (__MINGW32__) || defined (_MSC_VER) - - if (f) - { - wstatus = octave_pclose (f); - f = 0; - } - - open_p = false; - - return this; - -#elif defined (HAVE_SYS_WAIT_H) - - if (f) - { - pid_t wait_pid; - - int status = -1; - - for (octave_procbuf **ptr = &octave_procbuf_list; - *ptr != 0; - ptr = &(*ptr)->next) - { - if (*ptr == this) - { - *ptr = (*ptr)->next; - status = 0; - break; - } - } - - if (status == 0 && gnulib::fclose (f) == 0) - { - using namespace std; - - do - { - wait_pid = octave_syscalls::waitpid (proc_pid, &wstatus, 0); - } - while (wait_pid == -1 && errno == EINTR); - } - - f = 0; - } - - open_p = false; - - return this; - -#else - - return 0; - -#endif -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/oct-procbuf.h --- a/libinterp/interp-core/oct-procbuf.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,79 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// This class is based on the procbuf class from libg++, written by -// Per Bothner, Copyright (C) 1993 Free Software Foundation. - -#if !defined (octave_octave_procbuf_h) -#define octave_octave_procbuf_h 1 - -#include - -#include "c-file-ptr-stream.h" - -class -octave_procbuf : public c_file_ptr_buf -{ -public: - - octave_procbuf (void) - : c_file_ptr_buf (0), wstatus (-1), open_p (false), proc_pid (-1), - next (0) { } - - octave_procbuf (const char *command, int mode) - : c_file_ptr_buf (0), wstatus (-1), open_p (false), proc_pid (-1), - next (0) { open (command, mode); } - - ~octave_procbuf (void) { close (); } - - octave_procbuf *open (const char *command, int mode); - - octave_procbuf *close (void); - - int wait_status (void) const { return wstatus; } - - bool is_open (void) const { return open_p; } - - pid_t pid (void) const { return proc_pid; } - -protected: - - int wstatus; - - bool open_p; - - pid_t proc_pid; - - octave_procbuf *next; - -private: - - // No copying! - - octave_procbuf (const octave_procbuf&); - - octave_procbuf& operator = (const octave_procbuf&); -}; - -extern void symbols_of_oct_procbuf (void); - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/oct-stdstrm.h --- a/libinterp/interp-core/oct-stdstrm.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,175 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_octave_stdiostream_h) -#define octave_octave_stdiostream_h 1 - -#include "oct-stream.h" -#include "c-file-ptr-stream.h" - -template -class -octave_tstdiostream : public octave_base_stream -{ -public: - - octave_tstdiostream (const std::string& n, FILE_T f = 0, int fid = 0, - std::ios::openmode m = std::ios::in|std::ios::out, - oct_mach_info::float_format ff - = oct_mach_info::native_float_format (), - typename BUF_T::close_fcn cf = BUF_T::file_close) - : octave_base_stream (m, ff), nm (n), md (m), - s (f ? new STREAM_T (f, cf) : 0), fnum (fid) - { } - - // Position a stream at OFFSET relative to ORIGIN. - - int seek (off_t offset, int origin) - { return s ? s->seek (offset, origin) : -1; } - - // Return current stream position. - - off_t tell (void) { return s ? s->tell () : -1; } - - // Return non-zero if EOF has been reached on this stream. - - bool eof (void) const { return s ? s->eof () : true; } - - // The name of the file. - - std::string name (void) const { return nm; } - - std::istream *input_stream (void) { return (md & std::ios::in) ? s : 0; } - - std::ostream *output_stream (void) { return (md & std::ios::out) ? s : 0; } - - // FIXME -- should not have to cast away const here. - BUF_T *rdbuf (void) const - { return s ? (const_cast (s))->rdbuf () : 0; } - - int file_number (void) const { return fnum; } - - bool bad (void) const { return s ? s->bad () : true; } - - void clear (void) { if (s) s->clear (); } - - void do_close (void) { if (s) s->stream_close (); } - -protected: - - std::string nm; - - std::ios::openmode md; - - STREAM_T *s; - - // The file number associated with this file. - int fnum; - - ~octave_tstdiostream (void) { delete s; } - -private: - - // No copying! - - octave_tstdiostream (const octave_tstdiostream&); - - octave_tstdiostream& operator = (const octave_tstdiostream&); -}; - -class -octave_stdiostream - : public octave_tstdiostream -{ -public: - - octave_stdiostream (const std::string& n, FILE *f = 0, - std::ios::openmode m = std::ios::in|std::ios::out, - oct_mach_info::float_format ff - = oct_mach_info::native_float_format (), - c_file_ptr_buf::close_fcn cf = c_file_ptr_buf::file_close) - : octave_tstdiostream (n, f, f ? fileno (f) : -1, m, ff, cf) { } - - static octave_stream - create (const std::string& n, FILE *f = 0, - std::ios::openmode m = std::ios::in|std::ios::out, - oct_mach_info::float_format ff - = oct_mach_info::native_float_format (), - c_file_ptr_buf::close_fcn cf = c_file_ptr_buf::file_close) - { - return octave_stream (new octave_stdiostream (n, f, m, ff, cf)); - } - -protected: - - ~octave_stdiostream (void) { } - -private: - - // No copying! - - octave_stdiostream (const octave_stdiostream&); - - octave_stdiostream& operator = (const octave_stdiostream&); -}; - -#ifdef HAVE_ZLIB - -class -octave_zstdiostream - : public octave_tstdiostream -{ -public: - - octave_zstdiostream (const std::string& n, gzFile f = 0, int fid = 0, - std::ios::openmode m = std::ios::in|std::ios::out, - oct_mach_info::float_format ff - = oct_mach_info::native_float_format (), - c_zfile_ptr_buf::close_fcn cf = c_zfile_ptr_buf::file_close) - : octave_tstdiostream (n, f, fid, m, ff, cf) { } - - static octave_stream - create (const std::string& n, gzFile f = 0, int fid = 0, - std::ios::openmode m = std::ios::in|std::ios::out, - oct_mach_info::float_format ff - = oct_mach_info::native_float_format (), - c_zfile_ptr_buf::close_fcn cf = c_zfile_ptr_buf::file_close) - { - return octave_stream (new octave_zstdiostream (n, f, fid, m, ff, cf)); - } - -protected: - - ~octave_zstdiostream (void) { } - -private: - - // No copying! - - octave_zstdiostream (const octave_zstdiostream&); - - octave_zstdiostream& operator = (const octave_zstdiostream&); -}; - -#endif - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/oct-stream.cc --- a/libinterp/interp-core/oct-stream.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,4311 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include -#include -#include -#include -#include - -#include - -#include "byte-swap.h" -#include "lo-ieee.h" -#include "lo-mappers.h" -#include "lo-utils.h" -#include "quit.h" -#include "singleton-cleanup.h" -#include "str-vec.h" - -#include "error.h" -#include "gripes.h" -#include "input.h" -#include "oct-stdstrm.h" -#include "oct-stream.h" -#include "oct-obj.h" -#include "utils.h" - -// Possible values for conv_err: -// -// 1 : not a real scalar -// 2 : value is NaN -// 3 : value is not an integer - -static int -convert_to_valid_int (const octave_value& tc, int& conv_err) -{ - int retval = 0; - - conv_err = 0; - - double dval = tc.double_value (); - - if (! error_state) - { - if (! lo_ieee_isnan (dval)) - { - int ival = NINT (dval); - - if (ival == dval) - retval = ival; - else - conv_err = 3; - } - else - conv_err = 2; - } - else - conv_err = 1; - - return retval; -} - -static int -get_size (double d, const std::string& who) -{ - int retval = -1; - - if (! lo_ieee_isnan (d)) - { - if (! xisinf (d)) - { - if (d >= 0.0) - retval = NINT (d); - else - ::error ("%s: negative value invalid as size specification", - who.c_str ()); - } - else - retval = -1; - } - else - ::error ("%s: NaN is invalid as size specification", who.c_str ()); - - return retval; -} - -static void -get_size (const Array& size, octave_idx_type& nr, octave_idx_type& nc, bool& one_elt_size_spec, - const std::string& who) -{ - nr = -1; - nc = -1; - - one_elt_size_spec = false; - - double dnr = -1.0; - double dnc = -1.0; - - octave_idx_type sz_len = size.length (); - - if (sz_len == 1) - { - one_elt_size_spec = true; - - dnr = size (0); - - dnc = (dnr == 0.0) ? 0.0 : 1.0; - } - else if (sz_len == 2) - { - dnr = size (0); - - if (! xisinf (dnr)) - dnc = size (1); - else - ::error ("%s: invalid size specification", who.c_str ()); - } - else - ::error ("%s: invalid size specification", who.c_str ()); - - if (! error_state) - { - nr = get_size (dnr, who); - - if (! error_state && dnc >= 0.0) - nc = get_size (dnc, who); - } -} - -scanf_format_list::scanf_format_list (const std::string& s) - : nconv (0), curr_idx (0), list (dim_vector (16, 1)), buf (0) -{ - octave_idx_type num_elts = 0; - - size_t n = s.length (); - - size_t i = 0; - - int width = 0; - bool discard = false; - char modifier = '\0'; - char type = '\0'; - - bool have_more = true; - - while (i < n) - { - have_more = true; - - if (! buf) - buf = new std::ostringstream (); - - if (s[i] == '%') - { - // Process percent-escape conversion type. - - process_conversion (s, i, n, width, discard, type, modifier, - num_elts); - - have_more = (buf != 0); - } - else if (isspace (s[i])) - { - type = scanf_format_elt::whitespace_conversion; - - width = 0; - discard = false; - modifier = '\0'; - *buf << " "; - - while (++i < n && isspace (s[i])) - /* skip whitespace */; - - add_elt_to_list (width, discard, type, modifier, num_elts); - - have_more = false; - } - else - { - type = scanf_format_elt::literal_conversion; - - width = 0; - discard = false; - modifier = '\0'; - - while (i < n && ! isspace (s[i]) && s[i] != '%') - *buf << s[i++]; - - add_elt_to_list (width, discard, type, modifier, num_elts); - - have_more = false; - } - - if (nconv < 0) - { - have_more = false; - break; - } - } - - if (have_more) - add_elt_to_list (width, discard, type, modifier, num_elts); - - list.resize (dim_vector (num_elts, 1)); - - delete buf; -} - -scanf_format_list::~scanf_format_list (void) -{ - octave_idx_type n = list.length (); - - for (octave_idx_type i = 0; i < n; i++) - { - scanf_format_elt *elt = list(i); - delete elt; - } -} - -void -scanf_format_list::add_elt_to_list (int width, bool discard, char type, - char modifier, octave_idx_type& num_elts, - const std::string& char_class) -{ - if (buf) - { - std::string text = buf->str (); - - if (! text.empty ()) - { - scanf_format_elt *elt - = new scanf_format_elt (text.c_str (), width, discard, type, - modifier, char_class); - - if (num_elts == list.length ()) - list.resize (dim_vector (2 * num_elts, 1)); - - list(num_elts++) = elt; - } - - delete buf; - buf = 0; - } -} - -static std::string -expand_char_class (const std::string& s) -{ - std::string retval; - - size_t len = s.length (); - - size_t i = 0; - - while (i < len) - { - unsigned char c = s[i++]; - - if (c == '-' && i > 1 && i < len - && static_cast (s[i-2]) <= static_cast (s[i])) - { - // Add all characters from the range except the first (we - // already added it below). - - for (c = s[i-2]+1; c < s[i]; c++) - retval += c; - } - else - { - // Add the character to the class. Only add '-' if it is - // the last character in the class. - - if (c != '-' || i == len) - retval += c; - } - } - - return retval; -} - -void -scanf_format_list::process_conversion (const std::string& s, size_t& i, - size_t n, int& width, bool& discard, - char& type, char& modifier, - octave_idx_type& num_elts) -{ - width = 0; - discard = false; - modifier = '\0'; - type = '\0'; - - *buf << s[i++]; - - bool have_width = false; - - while (i < n) - { - switch (s[i]) - { - case '*': - if (discard) - nconv = -1; - else - { - discard = true; - *buf << s[i++]; - } - break; - - case '0': case '1': case '2': case '3': case '4': - case '5': case '6': case '7': case '8': case '9': - if (have_width) - nconv = -1; - else - { - char c = s[i++]; - width = width * 10 + c - '0'; - have_width = true; - *buf << c; - while (i < n && isdigit (s[i])) - { - c = s[i++]; - width = width * 10 + c - '0'; - *buf << c; - } - } - break; - - case 'h': case 'l': case 'L': - if (modifier != '\0') - nconv = -1; - else - modifier = s[i++]; - break; - - case 'd': case 'i': case 'o': case 'u': case 'x': - if (modifier == 'L') - { - nconv = -1; - break; - } - goto fini; - - case 'e': case 'f': case 'g': - if (modifier == 'h') - { - nconv = -1; - break; - } - - // No float or long double conversions, thanks. - *buf << 'l'; - - goto fini; - - case 'c': case 's': case 'p': case '%': case '[': - if (modifier != '\0') - { - nconv = -1; - break; - } - goto fini; - - fini: - { - if (finish_conversion (s, i, n, width, discard, type, - modifier, num_elts) == 0) - return; - } - break; - - default: - nconv = -1; - break; - } - - if (nconv < 0) - break; - } - - nconv = -1; -} - -int -scanf_format_list::finish_conversion (const std::string& s, size_t& i, - size_t n, int& width, bool discard, - char& type, char modifier, - octave_idx_type& num_elts) -{ - int retval = 0; - - std::string char_class; - - size_t beg_idx = std::string::npos; - size_t end_idx = std::string::npos; - - if (s[i] == '%') - { - type = '%'; - *buf << s[i++]; - } - else - { - type = s[i]; - - if (s[i] == '[') - { - *buf << s[i++]; - - if (i < n) - { - beg_idx = i; - - if (s[i] == '^') - { - type = '^'; - *buf << s[i++]; - - if (i < n) - { - beg_idx = i; - - if (s[i] == ']') - *buf << s[i++]; - } - } - else if (s[i] == ']') - *buf << s[i++]; - } - - while (i < n && s[i] != ']') - *buf << s[i++]; - - if (i < n && s[i] == ']') - { - end_idx = i-1; - *buf << s[i++]; - } - - if (s[i-1] != ']') - retval = nconv = -1; - } - else - *buf << s[i++]; - - nconv++; - } - - if (nconv >= 0) - { - if (beg_idx != std::string::npos && end_idx != std::string::npos) - char_class = expand_char_class (s.substr (beg_idx, - end_idx - beg_idx + 1)); - - add_elt_to_list (width, discard, type, modifier, num_elts, char_class); - } - - return retval; -} - -void -scanf_format_list::printme (void) const -{ - octave_idx_type n = list.length (); - - for (octave_idx_type i = 0; i < n; i++) - { - scanf_format_elt *elt = list(i); - - std::cerr - << "width: " << elt->width << "\n" - << "discard: " << elt->discard << "\n" - << "type: "; - - if (elt->type == scanf_format_elt::literal_conversion) - std::cerr << "literal text\n"; - else if (elt->type == scanf_format_elt::whitespace_conversion) - std::cerr << "whitespace\n"; - else - std::cerr << elt->type << "\n"; - - std::cerr - << "modifier: " << elt->modifier << "\n" - << "char_class: '" << undo_string_escapes (elt->char_class) << "'\n" - << "text: '" << undo_string_escapes (elt->text) << "'\n\n"; - } -} - -bool -scanf_format_list::all_character_conversions (void) -{ - octave_idx_type n = list.length (); - - if (n > 0) - { - for (octave_idx_type i = 0; i < n; i++) - { - scanf_format_elt *elt = list(i); - - switch (elt->type) - { - case 'c': case 's': case '%': case '[': case '^': - case scanf_format_elt::literal_conversion: - case scanf_format_elt::whitespace_conversion: - break; - - default: - return false; - break; - } - } - - return true; - } - else - return false; -} - -bool -scanf_format_list::all_numeric_conversions (void) -{ - octave_idx_type n = list.length (); - - if (n > 0) - { - for (octave_idx_type i = 0; i < n; i++) - { - scanf_format_elt *elt = list(i); - - switch (elt->type) - { - case 'd': case 'i': case 'o': case 'u': case 'x': - case 'e': case 'f': case 'g': - break; - - default: - return false; - break; - } - } - - return true; - } - else - return false; -} - -// Ugh again. - -printf_format_list::printf_format_list (const std::string& s) - : nconv (0), curr_idx (0), list (dim_vector (16, 1)), buf (0) -{ - octave_idx_type num_elts = 0; - - size_t n = s.length (); - - size_t i = 0; - - int args = 0; - std::string flags; - int fw = 0; - int prec = 0; - char modifier = '\0'; - char type = '\0'; - - bool have_more = true; - bool empty_buf = true; - - if (n == 0) - { - printf_format_elt *elt - = new printf_format_elt ("", args, fw, prec, flags, type, modifier); - - list(num_elts++) = elt; - - list.resize (dim_vector (num_elts, 1)); - } - else - { - while (i < n) - { - have_more = true; - - if (! buf) - { - buf = new std::ostringstream (); - empty_buf = true; - } - - switch (s[i]) - { - case '%': - { - if (empty_buf) - { - process_conversion (s, i, n, args, flags, fw, prec, - type, modifier, num_elts); - - have_more = (buf != 0); - } - else - add_elt_to_list (args, flags, fw, prec, type, modifier, - num_elts); - } - break; - - default: - { - args = 0; - flags = ""; - fw = 0; - prec = 0; - modifier = '\0'; - type = '\0'; - *buf << s[i++]; - empty_buf = false; - } - break; - } - - if (nconv < 0) - { - have_more = false; - break; - } - } - - if (have_more) - add_elt_to_list (args, flags, fw, prec, type, modifier, num_elts); - - list.resize (dim_vector (num_elts, 1)); - - delete buf; - } -} - -printf_format_list::~printf_format_list (void) -{ - octave_idx_type n = list.length (); - - for (octave_idx_type i = 0; i < n; i++) - { - printf_format_elt *elt = list(i); - delete elt; - } -} - -void -printf_format_list::add_elt_to_list (int args, const std::string& flags, - int fw, int prec, char type, - char modifier, octave_idx_type& num_elts) -{ - if (buf) - { - std::string text = buf->str (); - - if (! text.empty ()) - { - printf_format_elt *elt - = new printf_format_elt (text.c_str (), args, fw, prec, flags, - type, modifier); - - if (num_elts == list.length ()) - list.resize (dim_vector (2 * num_elts, 1)); - - list(num_elts++) = elt; - } - - delete buf; - buf = 0; - } -} - -void -printf_format_list::process_conversion - (const std::string& s, size_t& i, size_t n, int& args, std::string& flags, - int& fw, int& prec, char& modifier, char& type, octave_idx_type& num_elts) -{ - args = 0; - flags = ""; - fw = 0; - prec = 0; - modifier = '\0'; - type = '\0'; - - *buf << s[i++]; - - bool nxt = false; - - while (i < n) - { - switch (s[i]) - { - case '-': case '+': case ' ': case '0': case '#': - flags += s[i]; - *buf << s[i++]; - break; - - default: - nxt = true; - break; - } - - if (nxt) - break; - } - - if (i < n) - { - if (s[i] == '*') - { - fw = -1; - args++; - *buf << s[i++]; - } - else - { - if (isdigit (s[i])) - { - int nn = 0; - std::string tmp = s.substr (i); - sscanf (tmp.c_str (), "%d%n", &fw, &nn); - } - - while (i < n && isdigit (s[i])) - *buf << s[i++]; - } - } - - if (i < n && s[i] == '.') - { - *buf << s[i++]; - - if (i < n) - { - if (s[i] == '*') - { - prec = -1; - args++; - *buf << s[i++]; - } - else - { - if (isdigit (s[i])) - { - int nn = 0; - std::string tmp = s.substr (i); - sscanf (tmp.c_str (), "%d%n", &prec, &nn); - } - - while (i < n && isdigit (s[i])) - *buf << s[i++]; - } - } - } - - if (i < n) - { - switch (s[i]) - { - case 'h': case 'l': case 'L': - modifier = s[i]; - *buf << s[i++]; - break; - - default: - break; - } - } - - if (i < n) - finish_conversion (s, i, args, flags, fw, prec, modifier, type, num_elts); - else - nconv = -1; -} - -void -printf_format_list::finish_conversion - (const std::string& s, size_t& i, int args, const std::string& flags, - int fw, int prec, char modifier, char& type, octave_idx_type& num_elts) - -{ - switch (s[i]) - { - case 'd': case 'i': case 'o': case 'x': case 'X': - case 'u': case 'c': - if (modifier == 'L') - { - nconv = -1; - break; - } - goto fini; - - case 'f': case 'e': case 'E': case 'g': case 'G': - if (modifier == 'h' || modifier == 'l') - { - nconv = -1; - break; - } - goto fini; - - case 's': case 'p': case '%': - if (modifier != '\0') - { - nconv = -1; - break; - } - goto fini; - - fini: - - type = s[i]; - - *buf << s[i++]; - - if (type != '%' || args != 0) - nconv++; - - if (type != '%') - args++; - - add_elt_to_list (args, flags, fw, prec, type, modifier, num_elts); - - break; - - default: - nconv = -1; - break; - } -} - -void -printf_format_list::printme (void) const -{ - int n = list.length (); - - for (int i = 0; i < n; i++) - { - printf_format_elt *elt = list(i); - - std::cerr - << "args: " << elt->args << "\n" - << "flags: '" << elt->flags << "'\n" - << "width: " << elt->fw << "\n" - << "prec: " << elt->prec << "\n" - << "type: '" << elt->type << "'\n" - << "modifier: '" << elt->modifier << "'\n" - << "text: '" << undo_string_escapes (elt->text) << "'\n\n"; - } -} - -void -octave_base_stream::error (const std::string& msg) -{ - fail = true; - errmsg = msg; -} - -void -octave_base_stream::error (const std::string& who, const std::string& msg) -{ - fail = true; - errmsg = who + ": " + msg; -} - -void -octave_base_stream::clear (void) -{ - fail = false; - errmsg = ""; -} - -void -octave_base_stream::clearerr (void) -{ - std::istream *is = input_stream (); - std::ostream *os = output_stream (); - - if (is) - is->clear (); - - if (os) - os->clear (); -} - -// Functions that are defined for all input streams (input streams -// are those that define is). - -std::string -octave_base_stream::do_gets (octave_idx_type max_len, bool& err, - bool strip_newline, const std::string& who) -{ - std::string retval; - - if ((interactive || forced_interactive) && file_number () == 0) - { - ::error ("%s: unable to read from stdin while running interactively", - who.c_str ()); - - return retval; - } - - err = false; - - std::istream *isp = input_stream (); - - if (isp) - { - std::istream& is = *isp; - - std::ostringstream buf; - - int c = 0; - int char_count = 0; - - if (max_len != 0) - { - while (is && (c = is.get ()) != EOF) - { - char_count++; - - // Handle CRLF, CR, or LF as line ending. - - if (c == '\r') - { - if (! strip_newline) - buf << static_cast (c); - - c = is.get (); - - if (c != EOF) - { - if (c == '\n') - { - char_count++; - - if (! strip_newline) - buf << static_cast (c); - } - else - is.putback (c); - } - - break; - } - else if (c == '\n') - { - if (! strip_newline) - buf << static_cast (c); - - break; - } - else - buf << static_cast (c); - - if (max_len > 0 && char_count == max_len) - break; - } - } - - if (! is.eof () && char_count > 0) - { - // GAGME. Matlab seems to check for EOF even if the last - // character in a file is a newline character. This is NOT - // what the corresponding C-library functions do. - int disgusting_compatibility_hack = is.get (); - if (! is.eof ()) - is.putback (disgusting_compatibility_hack); - } - - if (is.good () || (is.eof () && char_count > 0)) - retval = buf.str (); - else - { - err = true; - - if (is.eof () && char_count == 0) - error (who, "at end of file"); - else - error (who, "read error"); - } - } - else - { - err = true; - invalid_operation (who, "reading"); - } - - return retval; -} - -std::string -octave_base_stream::getl (octave_idx_type max_len, bool& err, const std::string& who) -{ - return do_gets (max_len, err, true, who); -} - -std::string -octave_base_stream::gets (octave_idx_type max_len, bool& err, const std::string& who) -{ - return do_gets (max_len, err, false, who); -} - -off_t -octave_base_stream::skipl (off_t num, bool& err, const std::string& who) -{ - off_t cnt = -1; - - if ((interactive || forced_interactive) && file_number () == 0) - { - ::error ("%s: unable to read from stdin while running interactively", - who.c_str ()); - - return count; - } - - err = false; - - std::istream *isp = input_stream (); - - if (isp) - { - std::istream& is = *isp; - - int c = 0, lastc = -1; - cnt = 0; - - while (is && (c = is.get ()) != EOF) - { - // Handle CRLF, CR, or LF as line ending. - - if (c == '\r' || (c == '\n' && lastc != '\r')) - { - if (++cnt == num) - break; - } - - lastc = c; - } - - // Maybe eat the following \n if \r was just met. - if (c == '\r' && is.peek () == '\n') - is.get (); - - if (is.bad ()) - { - err = true; - error (who, "read error"); - } - - if (err) - cnt = -1; - } - else - { - err = true; - invalid_operation (who, "reading"); - } - - return cnt; -} - -#define OCTAVE_SCAN(is, fmt, arg) octave_scan (is, fmt, arg) - -template -std::istream& -octave_scan_1 (std::istream& is, const scanf_format_elt& fmt, T* valptr) -{ - T& ref = *valptr; - - switch (fmt.type) - { - case 'o': - is >> std::oct >> ref >> std::dec; - break; - - case 'x': - is >> std::hex >> ref >> std::dec; - break; - - case 'i': - { - int c1 = EOF; - - while (is && (c1 = is.get ()) != EOF && isspace (c1)) - /* skip whitespace */; - - if (c1 != EOF) - { - if (c1 == '0') - { - int c2 = is.peek (); - - if (c2 == 'x' || c2 == 'X') - { - is.ignore (); - if (std::isxdigit (is.peek ())) - is >> std::hex >> ref >> std::dec; - else - ref = 0; - } - else - { - if (c2 == '0' || c2 == '1' || c2 == '2' - || c2 == '3' || c2 == '4' || c2 == '5' - || c2 == '6' || c2 == '7') - is >> std::oct >> ref >> std::dec; - else - ref = 0; - } - } - else - { - is.putback (c1); - - is >> ref; - } - } - } - break; - - default: - is >> ref; - break; - } - - return is; -} - -template -std::istream& -octave_scan (std::istream& is, const scanf_format_elt& fmt, T* valptr) -{ - if (fmt.width) - { - // Limit input to fmt.width characters by reading into a - // temporary stringstream buffer. - - std::string tmp; - - is.width (fmt.width); - is >> tmp; - - std::istringstream ss (tmp); - - octave_scan_1 (ss, fmt, valptr); - } - else - octave_scan_1 (is, fmt, valptr); - - return is; -} - -// Note that this specialization is only used for reading characters, not -// character strings. See BEGIN_S_CONVERSION for details. - -template<> -std::istream& -octave_scan<> (std::istream& is, const scanf_format_elt& /* fmt */, - char* valptr) -{ - return is >> valptr; -} - -template std::istream& -octave_scan (std::istream&, const scanf_format_elt&, int*); - -template std::istream& -octave_scan (std::istream&, const scanf_format_elt&, long int*); - -template std::istream& -octave_scan (std::istream&, const scanf_format_elt&, short int*); - -template std::istream& -octave_scan (std::istream&, const scanf_format_elt&, unsigned int*); - -template std::istream& -octave_scan (std::istream&, const scanf_format_elt&, unsigned long int*); - -template std::istream& -octave_scan (std::istream&, const scanf_format_elt&, unsigned short int*); - -#if 0 -template std::istream& -octave_scan (std::istream&, const scanf_format_elt&, float*); -#endif - -template<> -std::istream& -octave_scan<> (std::istream& is, const scanf_format_elt& fmt, double* valptr) -{ - double& ref = *valptr; - - switch (fmt.type) - { - case 'e': - case 'f': - case 'g': - { - int c1 = EOF; - - while (is && (c1 = is.get ()) != EOF && isspace (c1)) - /* skip whitespace */; - - if (c1 != EOF) - { - is.putback (c1); - - ref = octave_read_value (is); - } - } - break; - - default: - panic_impossible (); - break; - } - - return is; -} - -template -void -do_scanf_conv (std::istream& is, const scanf_format_elt& fmt, - T valptr, Matrix& mval, double *data, octave_idx_type& idx, - octave_idx_type& conversion_count, octave_idx_type nr, octave_idx_type max_size, - bool discard) -{ - OCTAVE_SCAN (is, fmt, valptr); - - if (is) - { - if (idx == max_size && ! discard) - { - max_size *= 2; - - if (nr > 0) - mval.resize (nr, max_size / nr, 0.0); - else - mval.resize (max_size, 1, 0.0); - - data = mval.fortran_vec (); - } - - if (! discard) - { - conversion_count++; - data[idx++] = *(valptr); - } - } -} - -template void -do_scanf_conv (std::istream&, const scanf_format_elt&, int*, - Matrix&, double*, octave_idx_type&, octave_idx_type&, octave_idx_type, octave_idx_type, bool); - -template void -do_scanf_conv (std::istream&, const scanf_format_elt&, long int*, - Matrix&, double*, octave_idx_type&, octave_idx_type&, octave_idx_type, octave_idx_type, bool); - -template void -do_scanf_conv (std::istream&, const scanf_format_elt&, short int*, - Matrix&, double*, octave_idx_type&, octave_idx_type&, octave_idx_type, octave_idx_type, bool); - -template void -do_scanf_conv (std::istream&, const scanf_format_elt&, unsigned int*, - Matrix&, double*, octave_idx_type&, octave_idx_type&, octave_idx_type, octave_idx_type, bool); - -template void -do_scanf_conv (std::istream&, const scanf_format_elt&, unsigned long int*, - Matrix&, double*, octave_idx_type&, octave_idx_type&, octave_idx_type, octave_idx_type, bool); - -template void -do_scanf_conv (std::istream&, const scanf_format_elt&, unsigned short int*, - Matrix&, double*, octave_idx_type&, octave_idx_type&, octave_idx_type, octave_idx_type, bool); - -#if 0 -template void -do_scanf_conv (std::istream&, const scanf_format_elt&, float*, - Matrix&, double*, octave_idx_type&, octave_idx_type&, octave_idx_type, octave_idx_type, bool); -#endif - -template void -do_scanf_conv (std::istream&, const scanf_format_elt&, double*, - Matrix&, double*, octave_idx_type&, octave_idx_type&, octave_idx_type, octave_idx_type, bool); - -#define DO_WHITESPACE_CONVERSION() \ - do \ - { \ - int c = EOF; \ - \ - while (is && (c = is.get ()) != EOF && isspace (c)) \ - /* skip whitespace */; \ - \ - if (c != EOF) \ - is.putback (c); \ - } \ - while (0) - -#define DO_LITERAL_CONVERSION() \ - do \ - { \ - int c = EOF; \ - \ - int n = strlen (fmt); \ - int i = 0; \ - \ - while (i < n && is && (c = is.get ()) != EOF) \ - { \ - if (c == static_cast (fmt[i])) \ - { \ - i++; \ - continue; \ - } \ - else \ - { \ - is.putback (c); \ - break; \ - } \ - } \ - \ - if (i != n) \ - is.setstate (std::ios::failbit); \ - } \ - while (0) - -#define DO_PCT_CONVERSION() \ - do \ - { \ - int c = is.get (); \ - \ - if (c != EOF) \ - { \ - if (c != '%') \ - { \ - is.putback (c); \ - is.setstate (std::ios::failbit); \ - } \ - } \ - else \ - is.setstate (std::ios::failbit); \ - } \ - while (0) - -#define BEGIN_C_CONVERSION() \ - is.unsetf (std::ios::skipws); \ - \ - int width = elt->width ? elt->width : 1; \ - \ - std::string tmp (width, '\0'); \ - \ - int c = EOF; \ - int n = 0; \ - \ - while (is && n < width && (c = is.get ()) != EOF) \ - tmp[n++] = static_cast (c); \ - \ - if (n > 0 && c == EOF) \ - is.clear (); \ - \ - tmp.resize (n) - -// For a '%s' format, skip initial whitespace and then read until the -// next whitespace character or until WIDTH characters have been read. -#define BEGIN_S_CONVERSION() \ - int width = elt->width; \ - \ - std::string tmp; \ - \ - do \ - { \ - if (width) \ - { \ - tmp = std::string (width, '\0'); \ - \ - int c = EOF; \ - \ - int n = 0; \ - \ - while (is && (c = is.get ()) != EOF) \ - { \ - if (! isspace (c)) \ - { \ - tmp[n++] = static_cast (c); \ - break; \ - } \ - } \ - \ - while (is && n < width && (c = is.get ()) != EOF) \ - { \ - if (isspace (c)) \ - { \ - is.putback (c); \ - break; \ - } \ - else \ - tmp[n++] = static_cast (c); \ - } \ - \ - if (n > 0 && c == EOF) \ - is.clear (); \ - \ - tmp.resize (n); \ - } \ - else \ - { \ - is >> std::ws >> tmp; \ - } \ - } \ - while (0) - -// This format must match a nonempty sequence of characters. -#define BEGIN_CHAR_CLASS_CONVERSION() \ - int width = elt->width; \ - \ - std::string tmp; \ - \ - do \ - { \ - if (! width) \ - width = std::numeric_limits::max (); \ - \ - std::ostringstream buf; \ - \ - std::string char_class = elt->char_class; \ - \ - int c = EOF; \ - \ - if (elt->type == '[') \ - { \ - int chars_read = 0; \ - while (is && chars_read++ < width && (c = is.get ()) != EOF \ - && char_class.find (c) != std::string::npos) \ - buf << static_cast (c); \ - } \ - else \ - { \ - int chars_read = 0; \ - while (is && chars_read++ < width && (c = is.get ()) != EOF \ - && char_class.find (c) == std::string::npos) \ - buf << static_cast (c); \ - } \ - \ - if (width == std::numeric_limits::max () && c != EOF) \ - is.putback (c); \ - \ - tmp = buf.str (); \ - \ - if (tmp.empty ()) \ - is.setstate (std::ios::failbit); \ - else if (c == EOF) \ - is.clear (); \ - \ - } \ - while (0) - -#define FINISH_CHARACTER_CONVERSION() \ - do \ - { \ - width = tmp.length (); \ - \ - if (is) \ - { \ - int i = 0; \ - \ - if (! discard) \ - { \ - conversion_count++; \ - \ - while (i < width) \ - { \ - if (data_index == max_size) \ - { \ - max_size *= 2; \ - \ - if (all_char_conv) \ - { \ - if (one_elt_size_spec) \ - mval.resize (1, max_size, 0.0); \ - else if (nr > 0) \ - mval.resize (nr, max_size / nr, 0.0); \ - else \ - panic_impossible (); \ - } \ - else if (nr > 0) \ - mval.resize (nr, max_size / nr, 0.0); \ - else \ - mval.resize (max_size, 1, 0.0); \ - \ - data = mval.fortran_vec (); \ - } \ - \ - data[data_index++] = tmp[i++]; \ - } \ - } \ - } \ - } \ - while (0) - -octave_value -octave_base_stream::do_scanf (scanf_format_list& fmt_list, - octave_idx_type nr, octave_idx_type nc, bool one_elt_size_spec, - octave_idx_type& conversion_count, const std::string& who) -{ - octave_value retval = Matrix (); - - if ((interactive || forced_interactive) && file_number () == 0) - { - ::error ("%s: unable to read from stdin while running interactively", - who.c_str ()); - - return retval; - } - - conversion_count = 0; - - octave_idx_type nconv = fmt_list.num_conversions (); - - octave_idx_type data_index = 0; - - if (nr == 0 || nc == 0) - { - if (one_elt_size_spec) - nc = 0; - - return Matrix (nr, nc, 0.0); - } - - std::istream *isp = input_stream (); - - bool all_char_conv = fmt_list.all_character_conversions (); - - Matrix mval; - double *data = 0; - octave_idx_type max_size = 0; - octave_idx_type max_conv = 0; - - octave_idx_type final_nr = 0; - octave_idx_type final_nc = 0; - - if (all_char_conv) - { - // Any of these could be resized later (if we have %s - // conversions, we may read more than one element for each - // conversion). - - if (one_elt_size_spec) - { - max_size = 512; - mval.resize (1, max_size, 0.0); - - if (nr > 0) - max_conv = nr; - } - else if (nr > 0) - { - if (nc > 0) - { - mval.resize (nr, nc, 0.0); - max_size = max_conv = nr * nc; - } - else - { - mval.resize (nr, 32, 0.0); - max_size = nr * 32; - } - } - else - panic_impossible (); - } - else if (nr > 0) - { - if (nc > 0) - { - // Will not resize later. - mval.resize (nr, nc, 0.0); - max_size = nr * nc; - max_conv = max_size; - } - else - { - // Maybe resize later. - mval.resize (nr, 32, 0.0); - max_size = nr * 32; - } - } - else - { - // Maybe resize later. - mval.resize (32, 1, 0.0); - max_size = 32; - } - - data = mval.fortran_vec (); - - if (isp) - { - std::istream& is = *isp; - - const scanf_format_elt *elt = fmt_list.first (); - - std::ios::fmtflags flags = is.flags (); - - octave_idx_type trips = 0; - - octave_idx_type num_fmt_elts = fmt_list.length (); - - for (;;) - { - octave_quit (); - - if (elt) - { - if (! (elt->type == scanf_format_elt::whitespace_conversion - || elt->type == scanf_format_elt::literal_conversion - || elt->type == '%') - && max_conv > 0 && conversion_count == max_conv) - { - if (all_char_conv && one_elt_size_spec) - { - final_nr = 1; - final_nc = data_index; - } - else - { - final_nr = nr; - final_nc = (data_index - 1) / nr + 1; - } - - break; - } - else if (data_index == max_size) - { - max_size *= 2; - - if (all_char_conv) - { - if (one_elt_size_spec) - mval.resize (1, max_size, 0.0); - else if (nr > 0) - mval.resize (nr, max_size / nr, 0.0); - else - panic_impossible (); - } - else if (nr > 0) - mval.resize (nr, max_size / nr, 0.0); - else - mval.resize (max_size, 1, 0.0); - - data = mval.fortran_vec (); - } - - const char *fmt = elt->text; - - bool discard = elt->discard; - - switch (elt->type) - { - case scanf_format_elt::whitespace_conversion: - DO_WHITESPACE_CONVERSION (); - break; - - case scanf_format_elt::literal_conversion: - DO_LITERAL_CONVERSION (); - break; - - case '%': - DO_PCT_CONVERSION (); - break; - - case 'd': case 'i': - { - switch (elt->modifier) - { - case 'h': - { - short int tmp; - do_scanf_conv (is, *elt, &tmp, mval, data, - data_index, conversion_count, - nr, max_size, discard); - } - break; - - case 'l': - { - long int tmp; - do_scanf_conv (is, *elt, &tmp, mval, data, - data_index, conversion_count, - nr, max_size, discard); - } - break; - - default: - { - int tmp; - do_scanf_conv (is, *elt, &tmp, mval, data, - data_index, conversion_count, - nr, max_size, discard); - } - break; - } - } - break; - - case 'o': case 'u': case 'x': - { - switch (elt->modifier) - { - case 'h': - { - unsigned short int tmp; - do_scanf_conv (is, *elt, &tmp, mval, data, - data_index, conversion_count, - nr, max_size, discard); - } - break; - - case 'l': - { - unsigned long int tmp; - do_scanf_conv (is, *elt, &tmp, mval, data, - data_index, conversion_count, - nr, max_size, discard); - } - break; - - default: - { - unsigned int tmp; - do_scanf_conv (is, *elt, &tmp, mval, data, - data_index, conversion_count, - nr, max_size, discard); - } - break; - } - } - break; - - case 'e': case 'f': case 'g': - { - double tmp; - - do_scanf_conv (is, *elt, &tmp, mval, data, - data_index, conversion_count, - nr, max_size, discard); - } - break; - - case 'c': - { - BEGIN_C_CONVERSION (); - - FINISH_CHARACTER_CONVERSION (); - - is.setf (flags); - } - break; - - case 's': - { - BEGIN_S_CONVERSION (); - - FINISH_CHARACTER_CONVERSION (); - } - break; - - case '[': case '^': - { - BEGIN_CHAR_CLASS_CONVERSION (); - - FINISH_CHARACTER_CONVERSION (); - } - break; - - case 'p': - error ("%s: unsupported format specifier", who.c_str ()); - break; - - default: - error ("%s: internal format error", who.c_str ()); - break; - } - - if (! ok ()) - { - break; - } - else if (! is) - { - if (all_char_conv) - { - if (one_elt_size_spec) - { - final_nr = 1; - final_nc = data_index; - } - else if (data_index > nr) - { - final_nr = nr; - final_nc = (data_index - 1) / nr + 1; - } - else - { - final_nr = data_index; - final_nc = 1; - } - } - else if (nr > 0) - { - if (data_index > nr) - { - final_nr = nr; - final_nc = (data_index - 1) / nr + 1; - } - else - { - final_nr = data_index; - final_nc = 1; - } - } - else - { - final_nr = data_index; - final_nc = 1; - } - - // If it looks like we have a matching failure, then - // reset the failbit in the stream state. - - if (is.rdstate () & std::ios::failbit) - is.clear (is.rdstate () & (~std::ios::failbit)); - - // FIXME -- is this the right thing to do? - - if (interactive && name () == "stdin") - { - is.clear (); - - // Skip to end of line. - - bool err; - do_gets (-1, err, false, who); - } - - break; - } - } - else - { - error ("%s: internal format error", who.c_str ()); - break; - } - - if (nconv == 0 && ++trips == num_fmt_elts) - { - if (all_char_conv && one_elt_size_spec) - { - final_nr = 1; - final_nc = data_index; - } - else - { - final_nr = nr; - final_nc = (data_index - 1) / nr + 1; - } - - break; - } - else - elt = fmt_list.next (nconv > 0); - } - } - - if (ok ()) - { - mval.resize (final_nr, final_nc, 0.0); - - retval = mval; - - if (all_char_conv) - retval = retval.convert_to_str (false, true); - } - - return retval; -} - -octave_value -octave_base_stream::scanf (const std::string& fmt, const Array& size, - octave_idx_type& conversion_count, const std::string& who) -{ - octave_value retval = Matrix (); - - conversion_count = 0; - - std::istream *isp = input_stream (); - - if (isp) - { - scanf_format_list fmt_list (fmt); - - if (fmt_list.num_conversions () == -1) - ::error ("%s: invalid format specified", who.c_str ()); - else - { - octave_idx_type nr = -1; - octave_idx_type nc = -1; - - bool one_elt_size_spec; - - get_size (size, nr, nc, one_elt_size_spec, who); - - if (! error_state) - retval = do_scanf (fmt_list, nr, nc, one_elt_size_spec, - conversion_count, who); - } - } - else - invalid_operation (who, "reading"); - - return retval; -} - -bool -octave_base_stream::do_oscanf (const scanf_format_elt *elt, - octave_value& retval, const std::string& who) -{ - bool quit = false; - - std::istream *isp = input_stream (); - - if (isp) - { - std::istream& is = *isp; - - std::ios::fmtflags flags = is.flags (); - - if (elt) - { - const char *fmt = elt->text; - - bool discard = elt->discard; - - switch (elt->type) - { - case scanf_format_elt::whitespace_conversion: - DO_WHITESPACE_CONVERSION (); - break; - - case scanf_format_elt::literal_conversion: - DO_LITERAL_CONVERSION (); - break; - - case '%': - { - DO_PCT_CONVERSION (); - - if (! is) - quit = true; - - } - break; - - case 'd': case 'i': - { - int tmp; - - if (OCTAVE_SCAN (is, *elt, &tmp)) - { - if (! discard) - retval = tmp; - } - else - quit = true; - } - break; - - case 'o': case 'u': case 'x': - { - long int tmp; - - if (OCTAVE_SCAN (is, *elt, &tmp)) - { - if (! discard) - retval = tmp; - } - else - quit = true; - } - break; - - case 'e': case 'f': case 'g': - { - double tmp; - - if (OCTAVE_SCAN (is, *elt, &tmp)) - { - if (! discard) - retval = tmp; - } - else - quit = true; - } - break; - - case 'c': - { - BEGIN_C_CONVERSION (); - - if (! discard) - retval = tmp; - - if (! is) - quit = true; - - is.setf (flags); - } - break; - - case 's': - { - BEGIN_S_CONVERSION (); - - if (! discard) - retval = tmp; - - if (! is) - quit = true; - } - break; - - case '[': case '^': - { - BEGIN_CHAR_CLASS_CONVERSION (); - - if (! discard) - retval = tmp; - - if (! is) - quit = true; - } - break; - - case 'p': - error ("%s: unsupported format specifier", who.c_str ()); - break; - - default: - error ("%s: internal format error", who.c_str ()); - break; - } - } - - if (ok () && is.fail ()) - { - error ("%s: read error", who.c_str ()); - - // FIXME -- is this the right thing to do? - - if (interactive && name () == "stdin") - { - // Skip to end of line. - - bool err; - do_gets (-1, err, false, who); - } - } - } - - return quit; -} - -octave_value_list -octave_base_stream::oscanf (const std::string& fmt, const std::string& who) -{ - octave_value_list retval; - - std::istream *isp = input_stream (); - - if (isp) - { - std::istream& is = *isp; - - scanf_format_list fmt_list (fmt); - - octave_idx_type nconv = fmt_list.num_conversions (); - - if (nconv == -1) - ::error ("%s: invalid format specified", who.c_str ()); - else - { - is.clear (); - - octave_idx_type len = fmt_list.length (); - - retval.resize (nconv+2, Matrix ()); - - const scanf_format_elt *elt = fmt_list.first (); - - int num_values = 0; - - bool quit = false; - - for (octave_idx_type i = 0; i < len; i++) - { - octave_value tmp; - - quit = do_oscanf (elt, tmp, who); - - if (quit) - break; - else - { - if (tmp.is_defined ()) - retval(num_values++) = tmp; - - if (! ok ()) - break; - - elt = fmt_list.next (nconv > 0); - } - } - - retval(nconv) = num_values; - - int err_num; - retval(nconv+1) = error (false, err_num); - - if (! quit) - { - // Pick up any trailing stuff. - if (ok () && len > nconv) - { - octave_value tmp; - - elt = fmt_list.next (); - - do_oscanf (elt, tmp, who); - } - } - } - } - else - invalid_operation (who, "reading"); - - return retval; -} - -// Functions that are defined for all output streams (output streams -// are those that define os). - -int -octave_base_stream::flush (void) -{ - int retval = -1; - - std::ostream *os = output_stream (); - - if (os) - { - os->flush (); - - if (os->good ()) - retval = 0; - } - else - invalid_operation ("fflush", "writing"); - - return retval; -} - -class -printf_value_cache -{ -public: - - enum state { ok, conversion_error }; - - printf_value_cache (const octave_value_list& args, const std::string& who) - : values (args), val_idx (0), elt_idx (0), - n_vals (values.length ()), n_elts (0), data (0), - curr_state (ok) - { - for (octave_idx_type i = 0; i < values.length (); i++) - { - octave_value val = values(i); - - if (val.is_map () || val.is_cell () || val.is_object ()) - { - gripe_wrong_type_arg (who, val); - break; - } - } - } - - ~printf_value_cache (void) { } - - // Get the current value as a double and advance the internal pointer. - double double_value (void); - - // Get the current value as an int and advance the internal pointer. - int int_value (void); - - // Get the current value as a string and advance the internal pointer. - std::string string_value (void); - - operator bool () const { return (curr_state == ok); } - - bool exhausted (void) { return (val_idx >= n_vals); } - -private: - - const octave_value_list values; - int val_idx; - int elt_idx; - int n_vals; - int n_elts; - const double *data; - NDArray curr_val; - state curr_state; - - // Must create value cache with values! - - printf_value_cache (void); - - // No copying! - - printf_value_cache (const printf_value_cache&); - - printf_value_cache& operator = (const printf_value_cache&); -}; - -double -printf_value_cache::double_value (void) -{ - double retval = 0.0; - - if (exhausted ()) - curr_state = conversion_error; - - while (! exhausted ()) - { - if (! data) - { - octave_value tmp_val = values (val_idx); - - // Force string conversion here for compatibility. - - curr_val = tmp_val.array_value (true); - - if (! error_state) - { - elt_idx = 0; - n_elts = curr_val.length (); - data = curr_val.data (); - } - else - { - curr_state = conversion_error; - break; - } - } - - if (elt_idx < n_elts) - { - retval = data[elt_idx++]; - - if (elt_idx >= n_elts) - { - elt_idx = 0; - val_idx++; - data = 0; - } - - break; - } - else - { - val_idx++; - data = 0; - - if (n_elts == 0 && exhausted ()) - curr_state = conversion_error; - - continue; - } - } - - return retval; -} - -int -printf_value_cache::int_value (void) -{ - int retval = 0; - - double dval = double_value (); - - if (! error_state) - { - if (D_NINT (dval) == dval) - retval = NINT (dval); - else - curr_state = conversion_error; - } - - return retval; -} - -std::string -printf_value_cache::string_value (void) -{ - std::string retval; - - if (exhausted ()) - curr_state = conversion_error; - else - { - octave_value tval = values (val_idx++); - - if (tval.rows () == 1) - retval = tval.string_value (); - else - { - // In the name of Matlab compatibility. - - charMatrix chm = tval.char_matrix_value (); - - octave_idx_type nr = chm.rows (); - octave_idx_type nc = chm.columns (); - - int k = 0; - - retval.resize (nr * nc, '\0'); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - retval[k++] = chm(i,j); - } - - if (error_state) - curr_state = conversion_error; - } - - return retval; -} - -// Ugh again and again. - -template -int -do_printf_conv (std::ostream& os, const char *fmt, int nsa, int sa_1, - int sa_2, T arg, const std::string& who) -{ - int retval = 0; - - switch (nsa) - { - case 2: - retval = octave_format (os, fmt, sa_1, sa_2, arg); - break; - - case 1: - retval = octave_format (os, fmt, sa_1, arg); - break; - - case 0: - retval = octave_format (os, fmt, arg); - break; - - default: - ::error ("%s: internal error handling format", who.c_str ()); - break; - } - - return retval; -} - -template int -do_printf_conv (std::ostream&, const char*, int, int, int, int, - const std::string&); - -template int -do_printf_conv (std::ostream&, const char*, int, int, int, long, - const std::string&); - -template int -do_printf_conv (std::ostream&, const char*, int, int, int, unsigned int, - const std::string&); - -template int -do_printf_conv (std::ostream&, const char*, int, int, int, unsigned long, - const std::string&); - -template int -do_printf_conv (std::ostream&, const char*, int, int, int, double, - const std::string&); - -template int -do_printf_conv (std::ostream&, const char*, int, int, int, const char*, - const std::string&); - -#define DO_DOUBLE_CONV(TQUAL) \ - do \ - { \ - if (val > std::numeric_limits::max () \ - || val < std::numeric_limits::min ()) \ - { \ - std::string tfmt = fmt; \ - \ - tfmt.replace (tfmt.rfind (elt->type), 1, ".f"); \ - \ - if (elt->modifier == 'l') \ - tfmt.replace (tfmt.rfind (elt->modifier), 1, ""); \ - \ - retval += do_printf_conv (os, tfmt.c_str (), nsa, sa_1, sa_2, \ - val, who); \ - } \ - else \ - retval += do_printf_conv (os, fmt, nsa, sa_1, sa_2, \ - static_cast (val), who); \ - } \ - while (0) - -int -octave_base_stream::do_printf (printf_format_list& fmt_list, - const octave_value_list& args, - const std::string& who) -{ - int retval = 0; - - octave_idx_type nconv = fmt_list.num_conversions (); - - std::ostream *osp = output_stream (); - - if (osp) - { - std::ostream& os = *osp; - - const printf_format_elt *elt = fmt_list.first (); - - printf_value_cache val_cache (args, who); - - if (error_state) - return retval; - - for (;;) - { - octave_quit (); - - if (elt) - { - // NSA is the number of 'star' args to convert. - - int nsa = (elt->fw < 0) + (elt->prec < 0); - - int sa_1 = 0; - int sa_2 = 0; - - if (nsa > 0) - { - sa_1 = val_cache.int_value (); - - if (! val_cache) - break; - else - { - if (nsa > 1) - { - sa_2 = val_cache.int_value (); - - if (! val_cache) - break; - } - } - } - - const char *fmt = elt->text; - - if (elt->type == '%') - { - os << "%"; - retval++; - } - else if (elt->args == 0 && elt->text) - { - os << elt->text; - retval += strlen (elt->text); - } - else if (elt->type == 's') - { - std::string val = val_cache.string_value (); - - if (val_cache) - retval += do_printf_conv (os, fmt, nsa, sa_1, - sa_2, val.c_str (), who); - else - break; - } - else - { - double val = val_cache.double_value (); - - if (val_cache) - { - if (lo_ieee_isnan (val) || xisinf (val)) - { - std::string tfmt = fmt; - std::string::size_type i1, i2; - - tfmt.replace ((i1 = tfmt.rfind (elt->type)), - 1, 1, 's'); - - if ((i2 = tfmt.rfind ('.')) != std::string::npos && i2 < i1) - { - tfmt.erase (i2, i1-i2); - if (elt->prec < 0) - nsa--; - } - - const char *tval = xisinf (val) - ? (val < 0 ? "-Inf" : "Inf") - : (lo_ieee_is_NA (val) ? "NA" : "NaN"); - - retval += do_printf_conv (os, tfmt.c_str (), - nsa, sa_1, sa_2, - tval, who); - } - else - { - char type = elt->type; - - switch (type) - { - case 'd': case 'i': case 'c': - DO_DOUBLE_CONV (OCTAVE_EMPTY_CPP_ARG); - break; - - case 'o': case 'x': case 'X': case 'u': - DO_DOUBLE_CONV (unsigned); - break; - - case 'f': case 'e': case 'E': - case 'g': case 'G': - retval - += do_printf_conv (os, fmt, nsa, sa_1, sa_2, - val, who); - break; - - default: - error ("%s: invalid format specifier", - who.c_str ()); - return -1; - break; - } - } - } - else - break; - } - - if (! os) - { - error ("%s: write error", who.c_str ()); - break; - } - } - else - { - ::error ("%s: internal error handling format", who.c_str ()); - retval = -1; - break; - } - - elt = fmt_list.next (nconv > 0 && ! val_cache.exhausted ()); - - if (! elt || (val_cache.exhausted () && elt->args > 0)) - break; - } - } - else - invalid_operation (who, "writing"); - - return retval; -} - -int -octave_base_stream::printf (const std::string& fmt, - const octave_value_list& args, - const std::string& who) -{ - int retval = 0; - - printf_format_list fmt_list (fmt); - - if (fmt_list.num_conversions () == -1) - ::error ("%s: invalid format specified", who.c_str ()); - else - retval = do_printf (fmt_list, args, who); - - return retval; -} - -int -octave_base_stream::puts (const std::string& s, const std::string& who) -{ - int retval = -1; - - std::ostream *osp = output_stream (); - - if (osp) - { - std::ostream& os = *osp; - - os << s; - - if (os) - { - // FIXME -- why does this seem to be necessary? - // Without it, output from a loop like - // - // for i = 1:100, fputs (stdout, "foo\n"); endfor - // - // doesn't seem to go to the pager immediately. - - os.flush (); - - if (os) - retval = 0; - else - error ("%s: write error", who.c_str ()); - } - else - error ("%s: write error", who.c_str ()); - } - else - invalid_operation (who, "writing"); - - return retval; -} - -// Return current error message for this stream. - -std::string -octave_base_stream::error (bool clear_err, int& err_num) -{ - err_num = fail ? -1 : 0; - - std::string tmp = errmsg; - - if (clear_err) - clear (); - - return tmp; -} - -void -octave_base_stream::invalid_operation (const std::string& who, const char *rw) -{ - // Note that this is not ::error () ! - - error (who, std::string ("stream not open for ") + rw); -} - -octave_stream::octave_stream (octave_base_stream *bs) - : rep (bs) -{ - if (rep) - rep->count = 1; -} - -octave_stream::~octave_stream (void) -{ - if (rep && --rep->count == 0) - delete rep; -} - -octave_stream::octave_stream (const octave_stream& s) - : rep (s.rep) -{ - if (rep) - rep->count++; -} - -octave_stream& -octave_stream::operator = (const octave_stream& s) -{ - if (rep != s.rep) - { - if (rep && --rep->count == 0) - delete rep; - - rep = s.rep; - - if (rep) - rep->count++; - } - - return *this; -} - -int -octave_stream::flush (void) -{ - int retval = -1; - - if (stream_ok ()) - retval = rep->flush (); - - return retval; -} - -std::string -octave_stream::getl (octave_idx_type max_len, bool& err, const std::string& who) -{ - std::string retval; - - if (stream_ok ()) - retval = rep->getl (max_len, err, who); - - return retval; -} - -std::string -octave_stream::getl (const octave_value& tc_max_len, bool& err, - const std::string& who) -{ - std::string retval; - - err = false; - - int conv_err = 0; - - int max_len = -1; - - if (tc_max_len.is_defined ()) - { - max_len = convert_to_valid_int (tc_max_len, conv_err); - - if (conv_err || max_len < 0) - { - err = true; - ::error ("%s: invalid maximum length specified", who.c_str ()); - } - } - - if (! error_state) - retval = getl (max_len, err, who); - - return retval; -} - -std::string -octave_stream::gets (octave_idx_type max_len, bool& err, const std::string& who) -{ - std::string retval; - - if (stream_ok ()) - retval = rep->gets (max_len, err, who); - - return retval; -} - -std::string -octave_stream::gets (const octave_value& tc_max_len, bool& err, - const std::string& who) -{ - std::string retval; - - err = false; - - int conv_err = 0; - - int max_len = -1; - - if (tc_max_len.is_defined ()) - { - max_len = convert_to_valid_int (tc_max_len, conv_err); - - if (conv_err || max_len < 0) - { - err = true; - ::error ("%s: invalid maximum length specified", who.c_str ()); - } - } - - if (! error_state) - retval = gets (max_len, err, who); - - return retval; -} - -off_t -octave_stream::skipl (off_t count, bool& err, const std::string& who) -{ - off_t retval = -1; - - if (stream_ok ()) - retval = rep->skipl (count, err, who); - - return retval; -} - -off_t -octave_stream::skipl (const octave_value& tc_count, bool& err, const std::string& who) -{ - off_t retval = -1; - - err = false; - - int conv_err = 0; - - int count = 1; - - if (tc_count.is_defined ()) - { - if (tc_count.is_scalar_type () && xisinf (tc_count.scalar_value ())) - count = -1; - else - { - count = convert_to_valid_int (tc_count, conv_err); - - if (conv_err || count < 0) - { - err = true; - ::error ("%s: invalid number of lines specified", who.c_str ()); - } - } - } - - if (! error_state) - retval = skipl (count, err, who); - - return retval; -} - -int -octave_stream::seek (off_t offset, int origin) -{ - int status = -1; - - if (stream_ok ()) - { - clearerr (); - - // Find current position so we can return to it if needed. - - off_t orig_pos = rep->tell (); - - // Move to end of file. If successful, find the offset of the end. - - status = rep->seek (0, SEEK_END); - - if (status == 0) - { - off_t eof_pos = rep->tell (); - - if (origin == SEEK_CUR) - { - // Move back to original position, otherwise we will be - // seeking from the end of file which is probably not the - // original location. - - rep->seek (orig_pos, SEEK_SET); - } - - // Attempt to move to desired position; may be outside bounds - // of existing file. - - status = rep->seek (offset, origin); - - if (status == 0) - { - // Where are we after moving to desired position? - - off_t desired_pos = rep->tell (); - - // I don't think save_pos can be less than zero, but we'll - // check anyway... - - if (desired_pos > eof_pos || desired_pos < 0) - { - // Seek outside bounds of file. Failure should leave - // position unchanged. - - rep->seek (orig_pos, SEEK_SET); - - status = -1; - } - } - else - { - // Seeking to the desired position failed. Move back to - // original position and return failure status. - - rep->seek (orig_pos, SEEK_SET); - - status = -1; - } - } - } - - return status; -} - -int -octave_stream::seek (const octave_value& tc_offset, - const octave_value& tc_origin) -{ - int retval = -1; - - // FIXME -- should we have octave_value methods that handle off_t - // explicitly? - octave_int64 val = tc_offset.int64_scalar_value (); - off_t xoffset = val.value (); - - if (! error_state) - { - int conv_err = 0; - - int origin = SEEK_SET; - - if (tc_origin.is_string ()) - { - std::string xorigin = tc_origin.string_value (); - - if (xorigin == "bof") - origin = SEEK_SET; - else if (xorigin == "cof") - origin = SEEK_CUR; - else if (xorigin == "eof") - origin = SEEK_END; - else - conv_err = -1; - } - else - { - int xorigin = convert_to_valid_int (tc_origin, conv_err); - - if (! conv_err) - { - if (xorigin == -1) - origin = SEEK_SET; - else if (xorigin == 0) - origin = SEEK_CUR; - else if (xorigin == 1) - origin = SEEK_END; - else - conv_err = -1; - } - } - - if (! conv_err) - { - retval = seek (xoffset, origin); - - if (retval != 0) - error ("fseek: failed to seek to requested position"); - } - else - error ("fseek: invalid value for origin"); - } - else - error ("fseek: invalid value for offset"); - - return retval; -} - -off_t -octave_stream::tell (void) -{ - off_t retval = -1; - - if (stream_ok ()) - retval = rep->tell (); - - return retval; -} - -int -octave_stream::rewind (void) -{ - return seek (0, SEEK_SET); -} - -bool -octave_stream::is_open (void) const -{ - bool retval = false; - - if (stream_ok ()) - retval = rep->is_open (); - - return retval; -} - -void -octave_stream::close (void) -{ - if (stream_ok ()) - rep->close (); -} - -template -octave_value -do_read (octave_stream& strm, octave_idx_type nr, octave_idx_type nc, octave_idx_type block_size, - octave_idx_type skip, bool do_float_fmt_conv, bool do_NA_conv, - oct_mach_info::float_format from_flt_fmt, octave_idx_type& count) -{ - octave_value retval; - - RET_T nda; - - count = 0; - - typedef typename RET_T::element_type ELMT; - ELMT elt_zero = ELMT (); - - ELMT *dat = 0; - - octave_idx_type max_size = 0; - - octave_idx_type final_nr = 0; - octave_idx_type final_nc = 1; - - if (nr > 0) - { - if (nc > 0) - { - nda.resize (dim_vector (nr, nc), elt_zero); - dat = nda.fortran_vec (); - max_size = nr * nc; - } - else - { - nda.resize (dim_vector (nr, 32), elt_zero); - dat = nda.fortran_vec (); - max_size = nr * 32; - } - } - else - { - nda.resize (dim_vector (32, 1), elt_zero); - dat = nda.fortran_vec (); - max_size = 32; - } - - // FIXME -- byte order for Cray? - - bool swap = false; - - if (oct_mach_info::words_big_endian ()) - swap = (from_flt_fmt == oct_mach_info::flt_fmt_ieee_little_endian - || from_flt_fmt == oct_mach_info::flt_fmt_vax_g - || from_flt_fmt == oct_mach_info::flt_fmt_vax_g); - else - swap = (from_flt_fmt == oct_mach_info::flt_fmt_ieee_big_endian); - - union - { - char buf[sizeof (typename strip_template_param::type)]; - typename strip_template_param::type val; - } u; - - std::istream *isp = strm.input_stream (); - - if (isp) - { - std::istream& is = *isp; - - octave_idx_type elts_read = 0; - - for (;;) - { - // FIXME -- maybe there should be a special case for - // skip == 0. - - if (is) - { - if (nr > 0 && nc > 0 && count == max_size) - { - final_nr = nr; - final_nc = nc; - - break; - } - - is.read (u.buf, sizeof (typename strip_template_param::type)); - - // We only swap bytes for integer types. For float - // types, the format conversion will also handle byte - // swapping. - - if (swap) - swap_bytes::type)> (u.buf); - else if (do_float_fmt_conv) - do_float_format_conversion - (u.buf, - sizeof (typename strip_template_param::type), - 1, from_flt_fmt, oct_mach_info::float_format ()); - - typename RET_T::element_type tmp - = static_cast (u.val); - - if (is) - { - if (count == max_size) - { - max_size *= 2; - - if (nr > 0) - nda.resize (dim_vector (nr, max_size / nr), - elt_zero); - else - nda.resize (dim_vector (max_size, 1), elt_zero); - - dat = nda.fortran_vec (); - } - - if (do_NA_conv && __lo_ieee_is_old_NA (tmp)) - tmp = __lo_ieee_replace_old_NA (tmp); - - dat[count++] = tmp; - - elts_read++; - } - - int seek_status = 0; - - if (skip != 0 && elts_read == block_size) - { - seek_status = strm.seek (skip, SEEK_CUR); - elts_read = 0; - } - - if (is.eof () || seek_status < 0) - { - if (nr > 0) - { - if (count > nr) - { - final_nr = nr; - final_nc = (count - 1) / nr + 1; - } - else - { - final_nr = count; - final_nc = 1; - } - } - else - { - final_nr = count; - final_nc = 1; - } - - break; - } - } - else if (is.eof ()) - break; - } - } - - nda.resize (dim_vector (final_nr, final_nc), elt_zero); - - retval = nda; - - return retval; -} - -#define DO_READ_VAL_TEMPLATE(RET_T, READ_T) \ - template octave_value \ - do_read (octave_stream&, octave_idx_type, octave_idx_type, octave_idx_type, octave_idx_type, bool, bool, \ - oct_mach_info::float_format, octave_idx_type&) - -// FIXME -- should we only have float if it is a different -// size from double? - -#define INSTANTIATE_DO_READ(VAL_T) \ - DO_READ_VAL_TEMPLATE (VAL_T, octave_int8); \ - DO_READ_VAL_TEMPLATE (VAL_T, octave_uint8); \ - DO_READ_VAL_TEMPLATE (VAL_T, octave_int16); \ - DO_READ_VAL_TEMPLATE (VAL_T, octave_uint16); \ - DO_READ_VAL_TEMPLATE (VAL_T, octave_int32); \ - DO_READ_VAL_TEMPLATE (VAL_T, octave_uint32); \ - DO_READ_VAL_TEMPLATE (VAL_T, octave_int64); \ - DO_READ_VAL_TEMPLATE (VAL_T, octave_uint64); \ - DO_READ_VAL_TEMPLATE (VAL_T, float); \ - DO_READ_VAL_TEMPLATE (VAL_T, double); \ - DO_READ_VAL_TEMPLATE (VAL_T, char); \ - DO_READ_VAL_TEMPLATE (VAL_T, signed char); \ - DO_READ_VAL_TEMPLATE (VAL_T, unsigned char) - -INSTANTIATE_DO_READ (int8NDArray); -INSTANTIATE_DO_READ (uint8NDArray); -INSTANTIATE_DO_READ (int16NDArray); -INSTANTIATE_DO_READ (uint16NDArray); -INSTANTIATE_DO_READ (int32NDArray); -INSTANTIATE_DO_READ (uint32NDArray); -INSTANTIATE_DO_READ (int64NDArray); -INSTANTIATE_DO_READ (uint64NDArray); -INSTANTIATE_DO_READ (FloatNDArray); -INSTANTIATE_DO_READ (NDArray); -INSTANTIATE_DO_READ (charNDArray); -INSTANTIATE_DO_READ (boolNDArray); - -typedef octave_value (*read_fptr) (octave_stream&, octave_idx_type, octave_idx_type, octave_idx_type, octave_idx_type, bool, bool, - oct_mach_info::float_format ffmt, octave_idx_type&); - -#define FILL_TABLE_ROW(R, VAL_T) \ - read_fptr_table[R][oct_data_conv::dt_int8] = do_read; \ - read_fptr_table[R][oct_data_conv::dt_uint8] = do_read; \ - read_fptr_table[R][oct_data_conv::dt_int16] = do_read; \ - read_fptr_table[R][oct_data_conv::dt_uint16] = do_read; \ - read_fptr_table[R][oct_data_conv::dt_int32] = do_read; \ - read_fptr_table[R][oct_data_conv::dt_uint32] = do_read; \ - read_fptr_table[R][oct_data_conv::dt_int64] = do_read; \ - read_fptr_table[R][oct_data_conv::dt_uint64] = do_read; \ - read_fptr_table[R][oct_data_conv::dt_single] = do_read; \ - read_fptr_table[R][oct_data_conv::dt_double] = do_read; \ - read_fptr_table[R][oct_data_conv::dt_char] = do_read; \ - read_fptr_table[R][oct_data_conv::dt_schar] = do_read; \ - read_fptr_table[R][oct_data_conv::dt_uchar] = do_read; \ - read_fptr_table[R][oct_data_conv::dt_logical] = do_read - -octave_value -octave_stream::read (const Array& size, octave_idx_type block_size, - oct_data_conv::data_type input_type, - oct_data_conv::data_type output_type, - octave_idx_type skip, oct_mach_info::float_format ffmt, - octave_idx_type& char_count) -{ - static bool initialized = false; - - // Table function pointers for return types x read types. - - static read_fptr read_fptr_table[oct_data_conv::dt_unknown][14]; - - if (! initialized) - { - for (int i = 0; i < oct_data_conv::dt_unknown; i++) - for (int j = 0; j < 14; j++) - read_fptr_table[i][j] = 0; - - FILL_TABLE_ROW (oct_data_conv::dt_int8, int8NDArray); - FILL_TABLE_ROW (oct_data_conv::dt_uint8, uint8NDArray); - FILL_TABLE_ROW (oct_data_conv::dt_int16, int16NDArray); - FILL_TABLE_ROW (oct_data_conv::dt_uint16, uint16NDArray); - FILL_TABLE_ROW (oct_data_conv::dt_int32, int32NDArray); - FILL_TABLE_ROW (oct_data_conv::dt_uint32, uint32NDArray); - FILL_TABLE_ROW (oct_data_conv::dt_int64, int64NDArray); - FILL_TABLE_ROW (oct_data_conv::dt_uint64, uint64NDArray); - FILL_TABLE_ROW (oct_data_conv::dt_single, FloatNDArray); - FILL_TABLE_ROW (oct_data_conv::dt_double, NDArray); - FILL_TABLE_ROW (oct_data_conv::dt_char, charNDArray); - FILL_TABLE_ROW (oct_data_conv::dt_schar, charNDArray); - FILL_TABLE_ROW (oct_data_conv::dt_uchar, charNDArray); - FILL_TABLE_ROW (oct_data_conv::dt_logical, boolNDArray); - - initialized = true; - } - - octave_value retval; - - if (stream_ok ()) - { - // FIXME -- we may eventually want to make this extensible. - - // FIXME -- we need a better way to ensure that this - // numbering stays consistent with the order of the elements in the - // data_type enum in the oct_data_conv class. - - char_count = 0; - - octave_idx_type nr = -1; - octave_idx_type nc = -1; - - bool ignore; - - get_size (size, nr, nc, ignore, "fread"); - - if (! error_state) - { - if (nr == 0 || nc == 0) - retval = Matrix (nr, nc); - else - { - if (ffmt == oct_mach_info::flt_fmt_unknown) - ffmt = float_format (); - - read_fptr fcn = read_fptr_table[output_type][input_type]; - - bool do_float_fmt_conv = ((input_type == oct_data_conv::dt_double - || input_type == oct_data_conv::dt_single) - && ffmt != float_format ()); - - bool do_NA_conv = (output_type == oct_data_conv::dt_double); - - if (fcn) - { - retval = (*fcn) (*this, nr, nc, block_size, skip, - do_float_fmt_conv, do_NA_conv, - ffmt, char_count); - - // FIXME -- kluge! - - if (! error_state - && (output_type == oct_data_conv::dt_char - || output_type == oct_data_conv::dt_schar - || output_type == oct_data_conv::dt_uchar)) - retval = retval.char_matrix_value (); - } - else - error ("fread: unable to read and convert requested types"); - } - } - else - invalid_operation ("fread", "reading"); - } - - return retval; -} - -octave_idx_type -octave_stream::write (const octave_value& data, octave_idx_type block_size, - oct_data_conv::data_type output_type, octave_idx_type skip, - oct_mach_info::float_format flt_fmt) -{ - octave_idx_type retval = -1; - - if (stream_ok ()) - { - if (! error_state) - { - if (flt_fmt == oct_mach_info::flt_fmt_unknown) - flt_fmt = float_format (); - - octave_idx_type status = data.write (*this, block_size, output_type, - skip, flt_fmt); - - if (status < 0) - error ("fwrite: write error"); - else - retval = status; - } - else - invalid_operation ("fwrite", "writing"); - } - - return retval; -} - -template -void -write_int (std::ostream& os, bool swap, const T& val) -{ - typename T::val_type tmp = val.value (); - - if (swap) - swap_bytes (&tmp); - - os.write (reinterpret_cast (&tmp), - sizeof (typename T::val_type)); -} - -template void write_int (std::ostream&, bool, const octave_int8&); -template void write_int (std::ostream&, bool, const octave_uint8&); -template void write_int (std::ostream&, bool, const octave_int16&); -template void write_int (std::ostream&, bool, const octave_uint16&); -template void write_int (std::ostream&, bool, const octave_int32&); -template void write_int (std::ostream&, bool, const octave_uint32&); -template void write_int (std::ostream&, bool, const octave_int64&); -template void write_int (std::ostream&, bool, const octave_uint64&); - -template -static inline bool -do_write (std::ostream& os, const T& val, oct_data_conv::data_type output_type, - oct_mach_info::float_format flt_fmt, bool swap, - bool do_float_conversion) -{ - bool retval = true; - - // For compatibility, Octave converts to the output type, then - // writes. This means that truncation happens on the conversion. - // For example, the following program prints 0: - // - // x = int8 (-1) - // f = fopen ("foo.dat", "w"); - // fwrite (f, x, "unsigned char"); - // fclose (f); - // f = fopen ("foo.dat", "r"); - // y = fread (f, 1, "unsigned char"); - // printf ("%d\n", y); - - switch (output_type) - { - case oct_data_conv::dt_char: - case oct_data_conv::dt_schar: - case oct_data_conv::dt_int8: - write_int (os, swap, octave_int8 (val)); - break; - - case oct_data_conv::dt_uchar: - case oct_data_conv::dt_uint8: - write_int (os, swap, octave_uint8 (val)); - break; - - case oct_data_conv::dt_int16: - write_int (os, swap, octave_int16 (val)); - break; - - case oct_data_conv::dt_uint16: - write_int (os, swap, octave_uint16 (val)); - break; - - case oct_data_conv::dt_int32: - write_int (os, swap, octave_int32 (val)); - break; - - case oct_data_conv::dt_uint32: - write_int (os, swap, octave_uint32 (val)); - break; - - case oct_data_conv::dt_int64: - write_int (os, swap, octave_int64 (val)); - break; - - case oct_data_conv::dt_uint64: - write_int (os, swap, octave_uint64 (val)); - break; - - case oct_data_conv::dt_single: - { - float f = static_cast (val); - - if (do_float_conversion) - do_float_format_conversion (&f, 1, flt_fmt); - - os.write (reinterpret_cast (&f), sizeof (float)); - } - break; - - case oct_data_conv::dt_double: - { - double d = static_cast (val); - if (do_float_conversion) - do_double_format_conversion (&d, 1, flt_fmt); - - os.write (reinterpret_cast (&d), sizeof (double)); - } - break; - - default: - retval = false; - (*current_liboctave_error_handler) - ("write: invalid type specification"); - break; - } - - return retval; -} - -template bool -do_write (std::ostream&, const octave_int8&, oct_data_conv::data_type, - oct_mach_info::float_format, bool, bool); - -template bool -do_write (std::ostream&, const octave_uint8&, oct_data_conv::data_type, - oct_mach_info::float_format, bool, bool); - -template bool -do_write (std::ostream&, const octave_int16&, oct_data_conv::data_type, - oct_mach_info::float_format, bool, bool); - -template bool -do_write (std::ostream&, const octave_uint16&, oct_data_conv::data_type, - oct_mach_info::float_format, bool, bool); - -template bool -do_write (std::ostream&, const octave_int32&, oct_data_conv::data_type, - oct_mach_info::float_format, bool, bool); - -template bool -do_write (std::ostream&, const octave_uint32&, oct_data_conv::data_type, - oct_mach_info::float_format, bool, bool); - -template bool -do_write (std::ostream&, const octave_int64&, oct_data_conv::data_type, - oct_mach_info::float_format, bool, bool); - -template bool -do_write (std::ostream&, const octave_uint64&, oct_data_conv::data_type, - oct_mach_info::float_format, bool, bool); - -template -octave_idx_type -octave_stream::write (const Array& data, octave_idx_type block_size, - oct_data_conv::data_type output_type, - octave_idx_type skip, oct_mach_info::float_format flt_fmt) -{ - octave_idx_type retval = -1; - - bool status = true; - - octave_idx_type count = 0; - - const T *d = data.data (); - - octave_idx_type n = data.length (); - - oct_mach_info::float_format native_flt_fmt - = oct_mach_info::float_format (); - - bool do_float_conversion = (flt_fmt != native_flt_fmt); - - // FIXME -- byte order for Cray? - - bool swap = false; - - if (oct_mach_info::words_big_endian ()) - swap = (flt_fmt == oct_mach_info::flt_fmt_ieee_little_endian - || flt_fmt == oct_mach_info::flt_fmt_vax_g - || flt_fmt == oct_mach_info::flt_fmt_vax_g); - else - swap = (flt_fmt == oct_mach_info::flt_fmt_ieee_big_endian); - - for (octave_idx_type i = 0; i < n; i++) - { - std::ostream *osp = output_stream (); - - if (osp) - { - std::ostream& os = *osp; - - if (skip != 0 && (i % block_size) == 0) - { - // Seek to skip when inside bounds of existing file. - // Otherwise, write NUL to skip. - - off_t orig_pos = tell (); - - seek (0, SEEK_END); - - off_t eof_pos = tell (); - - // Is it possible for this to fail to return us to the - // original position? - seek (orig_pos, SEEK_SET); - - off_t remaining = eof_pos - orig_pos; - - if (remaining < skip) - { - seek (0, SEEK_END); - - // FIXME -- probably should try to write larger - // blocks... - - unsigned char zero = 0; - for (octave_idx_type j = 0; j < skip - remaining; j++) - os.write (reinterpret_cast (&zero), 1); - } - else - seek (skip, SEEK_CUR); - } - - if (os) - { - status = do_write (os, d[i], output_type, flt_fmt, swap, - do_float_conversion); - - if (os && status) - count++; - else - break; - } - else - { - status = false; - break; - } - } - else - { - status = false; - break; - } - } - - if (status) - retval = count; - - return retval; -} - -template octave_idx_type -octave_stream::write (const Array&, octave_idx_type, - oct_data_conv::data_type, - octave_idx_type, oct_mach_info::float_format); - -template octave_idx_type -octave_stream::write (const Array&, octave_idx_type, - oct_data_conv::data_type, - octave_idx_type, oct_mach_info::float_format); - -template octave_idx_type -octave_stream::write (const Array&, octave_idx_type, - oct_data_conv::data_type, - octave_idx_type, oct_mach_info::float_format); - -template octave_idx_type -octave_stream::write (const Array&, octave_idx_type, - oct_data_conv::data_type, - octave_idx_type, oct_mach_info::float_format); - -template octave_idx_type -octave_stream::write (const Array&, octave_idx_type, - oct_data_conv::data_type, - octave_idx_type, oct_mach_info::float_format); - -template octave_idx_type -octave_stream::write (const Array&, octave_idx_type, - oct_data_conv::data_type, - octave_idx_type, oct_mach_info::float_format); - -template octave_idx_type -octave_stream::write (const Array&, octave_idx_type, - oct_data_conv::data_type, - octave_idx_type, oct_mach_info::float_format); - -template octave_idx_type -octave_stream::write (const Array&, octave_idx_type, - oct_data_conv::data_type, - octave_idx_type, oct_mach_info::float_format); - -template octave_idx_type -octave_stream::write (const Array&, octave_idx_type, - oct_data_conv::data_type, - octave_idx_type, oct_mach_info::float_format); - -template octave_idx_type -octave_stream::write (const Array&, octave_idx_type, - oct_data_conv::data_type, - octave_idx_type, oct_mach_info::float_format); - -template octave_idx_type -octave_stream::write (const Array&, octave_idx_type, - oct_data_conv::data_type, - octave_idx_type, oct_mach_info::float_format); - -template octave_idx_type -octave_stream::write (const Array&, octave_idx_type, - oct_data_conv::data_type, - octave_idx_type, oct_mach_info::float_format); - -octave_value -octave_stream::scanf (const std::string& fmt, const Array& size, - octave_idx_type& count, const std::string& who) -{ - octave_value retval; - - if (stream_ok ()) - retval = rep->scanf (fmt, size, count, who); - - return retval; -} - -octave_value -octave_stream::scanf (const octave_value& fmt, const Array& size, - octave_idx_type& count, const std::string& who) -{ - octave_value retval = Matrix (); - - if (fmt.is_string ()) - { - std::string sfmt = fmt.string_value (); - - if (fmt.is_sq_string ()) - sfmt = do_string_escapes (sfmt); - - retval = scanf (sfmt, size, count, who); - } - else - { - // Note that this is not ::error () ! - - error (who + ": format must be a string"); - } - - return retval; -} - -octave_value_list -octave_stream::oscanf (const std::string& fmt, const std::string& who) -{ - octave_value_list retval; - - if (stream_ok ()) - retval = rep->oscanf (fmt, who); - - return retval; -} - -octave_value_list -octave_stream::oscanf (const octave_value& fmt, const std::string& who) -{ - octave_value_list retval; - - if (fmt.is_string ()) - { - std::string sfmt = fmt.string_value (); - - if (fmt.is_sq_string ()) - sfmt = do_string_escapes (sfmt); - - retval = oscanf (sfmt, who); - } - else - { - // Note that this is not ::error () ! - - error (who + ": format must be a string"); - } - - return retval; -} - -int -octave_stream::printf (const std::string& fmt, const octave_value_list& args, - const std::string& who) -{ - int retval = -1; - - if (stream_ok ()) - retval = rep->printf (fmt, args, who); - - return retval; -} - -int -octave_stream::printf (const octave_value& fmt, const octave_value_list& args, - const std::string& who) -{ - int retval = 0; - - if (fmt.is_string ()) - { - std::string sfmt = fmt.string_value (); - - if (fmt.is_sq_string ()) - sfmt = do_string_escapes (sfmt); - - retval = printf (sfmt, args, who); - } - else - { - // Note that this is not ::error () ! - - error (who + ": format must be a string"); - } - - return retval; -} - -int -octave_stream::puts (const std::string& s, const std::string& who) -{ - int retval = -1; - - if (stream_ok ()) - retval = rep->puts (s, who); - - return retval; -} - -// FIXME -- maybe this should work for string arrays too. - -int -octave_stream::puts (const octave_value& tc_s, const std::string& who) -{ - int retval = -1; - - if (tc_s.is_string ()) - { - std::string s = tc_s.string_value (); - retval = puts (s, who); - } - else - { - // Note that this is not ::error () ! - - error (who + ": argument must be a string"); - } - - return retval; -} - -bool -octave_stream::eof (void) const -{ - int retval = -1; - - if (stream_ok ()) - retval = rep->eof (); - - return retval; -} - -std::string -octave_stream::error (bool clear, int& err_num) -{ - std::string retval = "invalid stream object"; - - if (stream_ok (false)) - retval = rep->error (clear, err_num); - - return retval; -} - -std::string -octave_stream::name (void) const -{ - std::string retval; - - if (stream_ok ()) - retval = rep->name (); - - return retval; -} - -int -octave_stream::mode (void) const -{ - int retval = 0; - - if (stream_ok ()) - retval = rep->mode (); - - return retval; -} - -oct_mach_info::float_format -octave_stream::float_format (void) const -{ - oct_mach_info::float_format retval = oct_mach_info::flt_fmt_unknown; - - if (stream_ok ()) - retval = rep->float_format (); - - return retval; -} - -std::string -octave_stream::mode_as_string (int mode) -{ - std::string retval = "???"; - std::ios::openmode in_mode = static_cast (mode); - - if (in_mode == std::ios::in) - retval = "r"; - else if (in_mode == std::ios::out - || in_mode == (std::ios::out | std::ios::trunc)) - retval = "w"; - else if (in_mode == (std::ios::out | std::ios::app)) - retval = "a"; - else if (in_mode == (std::ios::in | std::ios::out)) - retval = "r+"; - else if (in_mode == (std::ios::in | std::ios::out | std::ios::trunc)) - retval = "w+"; - else if (in_mode == (std::ios::in | std::ios::out | std::ios::ate)) - retval = "a+"; - else if (in_mode == (std::ios::in | std::ios::binary)) - retval = "rb"; - else if (in_mode == (std::ios::out | std::ios::binary) - || in_mode == (std::ios::out | std::ios::trunc | std::ios::binary)) - retval = "wb"; - else if (in_mode == (std::ios::out | std::ios::app | std::ios::binary)) - retval = "ab"; - else if (in_mode == (std::ios::in | std::ios::out | std::ios::binary)) - retval = "r+b"; - else if (in_mode == (std::ios::in | std::ios::out | std::ios::trunc - | std::ios::binary)) - retval = "w+b"; - else if (in_mode == (std::ios::in | std::ios::out | std::ios::ate - | std::ios::binary)) - retval = "a+b"; - - return retval; -} - -octave_stream_list *octave_stream_list::instance = 0; - -bool -octave_stream_list::instance_ok (void) -{ - bool retval = true; - - if (! instance) - { - instance = new octave_stream_list (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); - } - - if (! instance) - { - ::error ("unable to create stream list object!"); - - retval = false; - } - - return retval; -} - -int -octave_stream_list::insert (octave_stream& os) -{ - return (instance_ok ()) ? instance->do_insert (os) : -1; -} - -octave_stream -octave_stream_list::lookup (int fid, const std::string& who) -{ - return (instance_ok ()) ? instance->do_lookup (fid, who) : octave_stream (); -} - -octave_stream -octave_stream_list::lookup (const octave_value& fid, const std::string& who) -{ - return (instance_ok ()) ? instance->do_lookup (fid, who) : octave_stream (); -} - -int -octave_stream_list::remove (int fid, const std::string& who) -{ - return (instance_ok ()) ? instance->do_remove (fid, who) : -1; -} - -int -octave_stream_list::remove (const octave_value& fid, const std::string& who) -{ - return (instance_ok ()) ? instance->do_remove (fid, who) : -1; -} - -void -octave_stream_list::clear (bool flush) -{ - if (instance) - instance->do_clear (flush); -} - -string_vector -octave_stream_list::get_info (int fid) -{ - return (instance_ok ()) ? instance->do_get_info (fid) : string_vector (); -} - -string_vector -octave_stream_list::get_info (const octave_value& fid) -{ - return (instance_ok ()) ? instance->do_get_info (fid) : string_vector (); -} - -std::string -octave_stream_list::list_open_files (void) -{ - return (instance_ok ()) ? instance->do_list_open_files () : std::string (); -} - -octave_value -octave_stream_list::open_file_numbers (void) -{ - return (instance_ok ()) - ? instance->do_open_file_numbers () : octave_value (); -} - -int -octave_stream_list::get_file_number (const octave_value& fid) -{ - return (instance_ok ()) ? instance->do_get_file_number (fid) : -1; -} - -int -octave_stream_list::do_insert (octave_stream& os) -{ - // Insert item with key corresponding to file-descriptor. - - int stream_number; - - if ((stream_number = os.file_number ()) == -1) - return stream_number; - - // Should we test for "(list.find (stream_number) != list.end ()) && - // list[stream_number].is_open ()" and respond with "error - // ("internal error: ...")"? It should not happen except for some - // bug or if the user has opened a stream with an interpreted - // command, but closed it directly with a system call in an - // oct-file; then the kernel knows the fd is free, but Octave does - // not know. If it happens, it should not do harm here to simply - // overwrite this entry, although the wrong entry might have done - // harm before. - - if (list.size () < list.max_size ()) - list[stream_number] = os; - else - { - stream_number = -1; - error ("could not create file id"); - } - - return stream_number; - -} - -static void -gripe_invalid_file_id (int fid, const std::string& who) -{ - if (who.empty ()) - ::error ("invalid stream number = %d", fid); - else - ::error ("%s: invalid stream number = %d", who.c_str (), fid); -} - -octave_stream -octave_stream_list::do_lookup (int fid, const std::string& who) const -{ - octave_stream retval; - - if (fid >= 0) - { - if (lookup_cache != list.end () && lookup_cache->first == fid) - retval = lookup_cache->second; - else - { - ostrl_map::const_iterator iter = list.find (fid); - - if (iter != list.end ()) - { - retval = iter->second; - lookup_cache = iter; - } - else - gripe_invalid_file_id (fid, who); - } - } - else - gripe_invalid_file_id (fid, who); - - return retval; -} - -octave_stream -octave_stream_list::do_lookup (const octave_value& fid, - const std::string& who) const -{ - octave_stream retval; - - int i = get_file_number (fid); - - if (! error_state) - retval = do_lookup (i, who); - - return retval; -} - -int -octave_stream_list::do_remove (int fid, const std::string& who) -{ - int retval = -1; - - // Can't remove stdin (std::cin), stdout (std::cout), or stderr - // (std::cerr). - - if (fid > 2) - { - ostrl_map::iterator iter = list.find (fid); - - if (iter != list.end ()) - { - octave_stream os = iter->second; - list.erase (iter); - lookup_cache = list.end (); - - // FIXME: is this check redundant? - if (os.is_valid ()) - { - os.close (); - retval = 0; - } - else - gripe_invalid_file_id (fid, who); - } - else - gripe_invalid_file_id (fid, who); - } - else - gripe_invalid_file_id (fid, who); - - return retval; -} - -int -octave_stream_list::do_remove (const octave_value& fid, const std::string& who) -{ - int retval = -1; - - if (fid.is_string () && fid.string_value () == "all") - { - do_clear (false); - - retval = 0; - } - else - { - int i = get_file_number (fid); - - if (! error_state) - retval = do_remove (i, who); - } - - return retval; -} - -void -octave_stream_list::do_clear (bool flush) -{ - if (flush) - { - // Do flush stdout and stderr. - - list[0].flush (); - list[1].flush (); - } - - octave_stream saved_os[3]; - // But don't delete them or stdin. - for (ostrl_map::iterator iter = list.begin (); iter != list.end (); iter++) - { - int fid = iter->first; - octave_stream os = iter->second; - if (fid < 3) - saved_os[fid] = os; - else if (os.is_valid ()) - os.close (); - } - list.clear (); - for (int fid = 0; fid < 3; fid++) list[fid] = saved_os[fid]; - lookup_cache = list.end (); -} - -string_vector -octave_stream_list::do_get_info (int fid) const -{ - string_vector retval; - - octave_stream os = do_lookup (fid); - - if (os.is_valid ()) - { - retval.resize (3); - - retval(2) = oct_mach_info::float_format_as_string (os.float_format ()); - retval(1) = octave_stream::mode_as_string (os.mode ()); - retval(0) = os.name (); - } - else - ::error ("invalid file id = %d", fid); - - return retval; -} - -string_vector -octave_stream_list::do_get_info (const octave_value& fid) const -{ - string_vector retval; - - int conv_err = 0; - - int int_fid = convert_to_valid_int (fid, conv_err); - - if (! conv_err) - retval = do_get_info (int_fid); - else - ::error ("file id must be a file object or integer value"); - - return retval; -} - -std::string -octave_stream_list::do_list_open_files (void) const -{ - std::string retval; - - std::ostringstream buf; - - buf << "\n" - << " number mode arch name\n" - << " ------ ---- ---- ----\n"; - - for (ostrl_map::const_iterator p = list.begin (); p != list.end (); p++) - { - octave_stream os = p->second; - - buf << " " - << std::setiosflags (std::ios::right) - << std::setw (4) << p->first << " " - << std::setiosflags (std::ios::left) - << std::setw (3) - << octave_stream::mode_as_string (os.mode ()) - << " " - << std::setw (9) - << oct_mach_info::float_format_as_string (os.float_format ()) - << " " - << os.name () << "\n"; - } - - buf << "\n"; - - retval = buf.str (); - - return retval; -} - -octave_value -octave_stream_list::do_open_file_numbers (void) const -{ - Matrix retval (1, list.size (), 0.0); - - int num_open = 0; - - for (ostrl_map::const_iterator p = list.begin (); p != list.end (); p++) - { - // Skip stdin, stdout, and stderr. - - if (p->first > 2 && p->second) - retval(0,num_open++) = p->first; - } - - retval.resize ((num_open > 0), num_open); - - return retval; -} - -int -octave_stream_list::do_get_file_number (const octave_value& fid) const -{ - int retval = -1; - - if (fid.is_string ()) - { - std::string nm = fid.string_value (); - - for (ostrl_map::const_iterator p = list.begin (); p != list.end (); p++) - { - // stdin (std::cin), stdout (std::cout), and stderr (std::cerr) - // are unnamed. - - if (p->first > 2) - { - octave_stream os = p->second; - - if (os && os.name () == nm) - { - retval = p->first; - break; - } - } - } - } - else - { - int conv_err = 0; - - int int_fid = convert_to_valid_int (fid, conv_err); - - if (conv_err) - ::error ("file id must be a file object, std::string, or integer value"); - else - retval = int_fid; - } - - return retval; -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/oct-stream.h --- a/libinterp/interp-core/oct-stream.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,716 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_octave_stream_h) -#define octave_octave_stream_h 1 - -class Matrix; -class string_vector; -class octave_value; -class octave_value_list; - -#include -#include -#include -#include - -#include "Array.h" -#include "data-conv.h" -#include "lo-utils.h" -#include "mach-info.h" -#include "oct-refcount.h" - -class -OCTINTERP_API -scanf_format_elt -{ -public: - - enum special_conversion - { - whitespace_conversion = 1, - literal_conversion = 2 - }; - - scanf_format_elt (const char *txt = 0, int w = 0, bool d = false, - char typ = '\0', char mod = '\0', - const std::string& ch_class = std::string ()) - : text (strsave (txt)), width (w), discard (d), type (typ), - modifier (mod), char_class (ch_class) { } - - scanf_format_elt (const scanf_format_elt& e) - : text (strsave (e.text)), width (e.width), discard (e.discard), - type (e.type), modifier (e.modifier), char_class (e.char_class) { } - - scanf_format_elt& operator = (const scanf_format_elt& e) - { - if (this != &e) - { - text = strsave (e.text); - width = e.width; - discard = e.discard; - type = e.type; - modifier = e.modifier; - char_class = e.char_class; - } - - return *this; - } - - ~scanf_format_elt (void) { delete [] text; } - - // The C-style format string. - const char *text; - - // The maximum field width. - int width; - - // TRUE if we are not storing the result of this conversion. - bool discard; - - // Type of conversion -- 'd', 'i', 'o', 'u', 'x', 'e', 'f', 'g', - // 'c', 's', 'p', '%', or '['. - char type; - - // A length modifier -- 'h', 'l', or 'L'. - char modifier; - - // The class of characters in a '[' format. - std::string char_class; -}; - -class -OCTINTERP_API -scanf_format_list -{ -public: - - scanf_format_list (const std::string& fmt = std::string ()); - - ~scanf_format_list (void); - - octave_idx_type num_conversions (void) { return nconv; } - - // The length can be different than the number of conversions. - // For example, "x %d y %d z" has 2 conversions but the length of - // the list is 3 because of the characters that appear after the - // last conversion. - - octave_idx_type length (void) { return list.length (); } - - const scanf_format_elt *first (void) - { - curr_idx = 0; - return current (); - } - - const scanf_format_elt *current (void) const - { return list.length () > 0 ? list.elem (curr_idx) : 0; } - - const scanf_format_elt *next (bool cycle = true) - { - curr_idx++; - - if (curr_idx >= list.length ()) - { - if (cycle) - curr_idx = 0; - else - return 0; - } - return current (); - } - - void printme (void) const; - - bool ok (void) const { return (nconv >= 0); } - - operator bool () const { return ok (); } - - bool all_character_conversions (void); - - bool all_numeric_conversions (void); - -private: - - // Number of conversions specified by this format string, or -1 if - // invalid conversions have been found. - octave_idx_type nconv; - - // Index to current element; - octave_idx_type curr_idx; - - // FIXME -- maybe LIST should be a std::list object? - // List of format elements. - Array list; - - // Temporary buffer. - std::ostringstream *buf; - - void add_elt_to_list (int width, bool discard, char type, char modifier, - octave_idx_type& num_elts, - const std::string& char_class = std::string ()); - - void process_conversion (const std::string& s, size_t& i, size_t n, - int& width, bool& discard, char& type, - char& modifier, octave_idx_type& num_elts); - - int finish_conversion (const std::string& s, size_t& i, size_t n, - int& width, bool discard, char& type, - char modifier, octave_idx_type& num_elts); - // No copying! - - scanf_format_list (const scanf_format_list&); - - scanf_format_list& operator = (const scanf_format_list&); -}; - -class -printf_format_elt -{ -public: - - printf_format_elt (const char *txt = 0, int n = 0, int w = 0, - int p = 0, const std::string& f = std::string (), - char typ = '\0', char mod = '\0') - : text (strsave (txt)), args (n), fw (w), prec (p), flags (f), - type (typ), modifier (mod) { } - - printf_format_elt (const printf_format_elt& e) - : text (strsave (e.text)), args (e.args), fw (e.fw), prec (e.prec), - flags (e.flags), type (e.type), modifier (e.modifier) { } - - printf_format_elt& operator = (const printf_format_elt& e) - { - if (this != &e) - { - text = strsave (e.text); - args = e.args; - fw = e.fw; - prec = e.prec; - flags = e.flags; - type = e.type; - modifier = e.modifier; - } - - return *this; - } - - ~printf_format_elt (void) { delete [] text; } - - // The C-style format string. - const char *text; - - // How many args do we expect to consume? - int args; - - // Field width. - int fw; - - // Precision. - int prec; - - // Flags -- '-', '+', ' ', '0', or '#'. - std::string flags; - - // Type of conversion -- 'd', 'i', 'o', 'x', 'X', 'u', 'c', 's', - // 'f', 'e', 'E', 'g', 'G', 'p', or '%' - char type; - - // A length modifier -- 'h', 'l', or 'L'. - char modifier; -}; - -class -OCTINTERP_API -printf_format_list -{ -public: - - printf_format_list (const std::string& fmt = std::string ()); - - ~printf_format_list (void); - - octave_idx_type num_conversions (void) { return nconv; } - - const printf_format_elt *first (void) - { - curr_idx = 0; - return current (); - } - - const printf_format_elt *current (void) const - { return list.length () > 0 ? list.elem (curr_idx) : 0; } - - const printf_format_elt *next (bool cycle = true) - { - curr_idx++; - - if (curr_idx >= list.length ()) - { - if (cycle) - curr_idx = 0; - else - return 0; - } - - return current (); - } - - bool last_elt_p (void) { return (curr_idx + 1 == list.length ()); } - - void printme (void) const; - - bool ok (void) const { return (nconv >= 0); } - - operator bool () const { return ok (); } - -private: - - // Number of conversions specified by this format string, or -1 if - // invalid conversions have been found. - octave_idx_type nconv; - - // Index to current element; - octave_idx_type curr_idx; - - // FIXME -- maybe LIST should be a std::list object? - // List of format elements. - Array list; - - // Temporary buffer. - std::ostringstream *buf; - - void add_elt_to_list (int args, const std::string& flags, int fw, - int prec, char type, char modifier, - octave_idx_type& num_elts); - - void process_conversion (const std::string& s, size_t& i, size_t n, - int& args, std::string& flags, int& fw, - int& prec, char& modifier, char& type, - octave_idx_type& num_elts); - - void finish_conversion (const std::string& s, size_t& i, int args, - const std::string& flags, int fw, int prec, - char modifier, char& type, - octave_idx_type& num_elts); - - // No copying! - - printf_format_list (const printf_format_list&); - - printf_format_list& operator = (const printf_format_list&); -}; - -// Provide an interface for Octave streams. - -class -OCTINTERP_API -octave_base_stream -{ -friend class octave_stream; - -public: - - octave_base_stream (std::ios::openmode arg_md = std::ios::in|std::ios::out, - oct_mach_info::float_format ff - = oct_mach_info::native_float_format ()) - : count (0), md (arg_md), flt_fmt (ff), fail (false), open_state (true), - errmsg () - { } - - virtual ~octave_base_stream (void) { } - - // The remaining functions are not specific to input or output only, - // and must be provided by the derived classes. - - // Position a stream at OFFSET relative to ORIGIN. - - virtual int seek (off_t offset, int origin) = 0; - - // Return current stream position. - - virtual off_t tell (void) = 0; - - // Return TRUE if EOF has been reached on this stream. - - virtual bool eof (void) const = 0; - - // The name of the file. - - virtual std::string name (void) const = 0; - - // If the derived class provides this function and it returns a - // pointer to a valid istream, scanf(), read(), getl(), and gets() - // will automatically work for this stream. - - virtual std::istream *input_stream (void) { return 0; } - - // If the derived class provides this function and it returns a - // pointer to a valid ostream, flush(), write(), and printf() will - // automatically work for this stream. - - virtual std::ostream *output_stream (void) { return 0; } - - // Return TRUE if this stream is open. - - bool is_open (void) const { return open_state; } - - virtual void do_close (void) { } - - void close (void) - { - if (is_open ()) - { - open_state = false; - do_close (); - } - } - - virtual int file_number (void) const - { - // Kluge alert! - - if (name () == "stdin") - return 0; - else if (name () == "stdout") - return 1; - else if (name () == "stderr") - return 2; - else - return -1; - } - - bool ok (void) const { return ! fail; } - - // Return current error message for this stream. - - std::string error (bool clear, int& err_num); - -protected: - - int mode (void) const { return md; } - - oct_mach_info::float_format float_format (void) const { return flt_fmt; } - - // Set current error state and set fail to TRUE. - - void error (const std::string& msg); - void error (const std::string& who, const std::string& msg); - - // Clear any error message and set fail to FALSE. - - void clear (void); - - // Clear stream state. - - void clearerr (void); - -private: - - // A reference count. - octave_refcount count; - - // The permission bits for the file. Should be some combination of - // std::ios::open_mode bits. - int md; - - // Data format. - oct_mach_info::float_format flt_fmt; - - // TRUE if an error has occurred. - bool fail; - - // TRUE if this stream is open. - bool open_state; - - // Should contain error message if fail is TRUE. - std::string errmsg; - - // Functions that are defined for all input streams (input streams - // are those that define is). - - std::string do_gets (octave_idx_type max_len, bool& err, bool strip_newline, - const std::string& who /* = "gets" */); - - std::string getl (octave_idx_type max_len, bool& err, const std::string& who /* = "getl" */); - std::string gets (octave_idx_type max_len, bool& err, const std::string& who /* = "gets" */); - off_t skipl (off_t count, bool& err, const std::string& who /* = "skipl" */); - - octave_value do_scanf (scanf_format_list& fmt_list, octave_idx_type nr, octave_idx_type nc, - bool one_elt_size_spec, octave_idx_type& count, - const std::string& who /* = "scanf" */); - - octave_value scanf (const std::string& fmt, const Array& size, - octave_idx_type& count, const std::string& who /* = "scanf" */); - - bool do_oscanf (const scanf_format_elt *elt, octave_value&, - const std::string& who /* = "scanf" */); - - octave_value_list oscanf (const std::string& fmt, - const std::string& who /* = "scanf" */); - - // Functions that are defined for all output streams (output streams - // are those that define os). - - int flush (void); - - int do_printf (printf_format_list& fmt_list, const octave_value_list& args, - const std::string& who /* = "printf" */); - - int printf (const std::string& fmt, const octave_value_list& args, - const std::string& who /* = "printf" */); - - int puts (const std::string& s, const std::string& who /* = "puts" */); - - // We can always do this in terms of seek(), so the derived class - // only has to provide that. - - void invalid_operation (const std::string& who, const char *rw); - - // No copying! - - octave_base_stream (const octave_base_stream&); - - octave_base_stream& operator = (const octave_base_stream&); -}; - -class -OCTINTERP_API -octave_stream -{ -public: - - octave_stream (octave_base_stream *bs = 0); - - ~octave_stream (void); - - octave_stream (const octave_stream&); - - octave_stream& operator = (const octave_stream&); - - int flush (void); - - std::string getl (octave_idx_type max_len, bool& err, const std::string& who /* = "getl" */); - std::string getl (const octave_value& max_len, bool& err, - const std::string& who /* = "getl" */); - - std::string gets (octave_idx_type max_len, bool& err, const std::string& who /* = "gets" */); - std::string gets (const octave_value& max_len, bool& err, - const std::string& who /* = "gets" */); - - off_t skipl (off_t count, bool& err, const std::string& who /* = "skipl" */); - off_t skipl (const octave_value& count, bool& err, const std::string& who /* = "skipl" */); - - int seek (off_t offset, int origin); - int seek (const octave_value& offset, const octave_value& origin); - - off_t tell (void); - - int rewind (void); - - bool is_open (void) const; - - void close (void); - - octave_value read (const Array& size, octave_idx_type block_size, - oct_data_conv::data_type input_type, - oct_data_conv::data_type output_type, - octave_idx_type skip, oct_mach_info::float_format flt_fmt, - octave_idx_type& count); - - octave_idx_type write (const octave_value& data, octave_idx_type block_size, - oct_data_conv::data_type output_type, - octave_idx_type skip, oct_mach_info::float_format flt_fmt); - - template - octave_idx_type write (const Array&, octave_idx_type block_size, - oct_data_conv::data_type output_type, - octave_idx_type skip, oct_mach_info::float_format flt_fmt); - - octave_value scanf (const std::string& fmt, const Array& size, - octave_idx_type& count, const std::string& who /* = "scanf" */); - - octave_value scanf (const octave_value& fmt, const Array& size, - octave_idx_type& count, const std::string& who /* = "scanf" */); - - octave_value_list oscanf (const std::string& fmt, - const std::string& who /* = "scanf" */); - - octave_value_list oscanf (const octave_value& fmt, - const std::string& who /* = "scanf" */); - - int printf (const std::string& fmt, const octave_value_list& args, - const std::string& who /* = "printf" */); - - int printf (const octave_value& fmt, const octave_value_list& args, - const std::string& who /* = "printf" */); - - int puts (const std::string& s, const std::string& who /* = "puts" */); - int puts (const octave_value& s, const std::string& who /* = "puts" */); - - bool eof (void) const; - - std::string error (bool clear, int& err_num); - - std::string error (bool clear = false) - { - int err_num; - return error (clear, err_num); - } - - // Set the error message and state. - - void error (const std::string& msg) - { - if (rep) - rep->error (msg); - } - - void error (const char *msg) { error (std::string (msg)); } - - int file_number (void) { return rep ? rep->file_number () : -1; } - - bool is_valid (void) const { return (rep != 0); } - - bool ok (void) const { return rep && rep->ok (); } - - operator bool () const { return ok (); } - - std::string name (void) const; - - int mode (void) const; - - oct_mach_info::float_format float_format (void) const; - - static std::string mode_as_string (int mode); - - std::istream *input_stream (void) - { - return rep ? rep->input_stream () : 0; - } - - std::ostream *output_stream (void) - { - return rep ? rep->output_stream () : 0; - } - - void clearerr (void) { if (rep) rep->clearerr (); } - -private: - - // The actual representation of this stream. - octave_base_stream *rep; - - bool stream_ok (bool clear = true) const - { - bool retval = true; - - if (rep) - { - if (clear) - rep->clear (); - } - else - retval = false; - - return retval; - } - - void invalid_operation (const std::string& who, const char *rw) - { - if (rep) - rep->invalid_operation (who, rw); - } -}; - -class -OCTINTERP_API -octave_stream_list -{ -protected: - - octave_stream_list (void) : list (), lookup_cache (list.end ()) { } - -public: - - ~octave_stream_list (void) { } - - static bool instance_ok (void); - - static int insert (octave_stream& os); - - static octave_stream - lookup (int fid, const std::string& who = std::string ()); - - static octave_stream - lookup (const octave_value& fid, const std::string& who = std::string ()); - - static int remove (int fid, const std::string& who = std::string ()); - static int remove (const octave_value& fid, - const std::string& who = std::string ()); - - static void clear (bool flush = true); - - static string_vector get_info (int fid); - static string_vector get_info (const octave_value& fid); - - static std::string list_open_files (void); - - static octave_value open_file_numbers (void); - - static int get_file_number (const octave_value& fid); - -private: - - typedef std::map ostrl_map; - - ostrl_map list; - - mutable ostrl_map::const_iterator lookup_cache; - - static octave_stream_list *instance; - - static void cleanup_instance (void) { delete instance; instance = 0; } - - int do_insert (octave_stream& os); - - octave_stream do_lookup (int fid, const std::string& who = std::string ()) const; - octave_stream do_lookup (const octave_value& fid, - const std::string& who = std::string ()) const; - - int do_remove (int fid, const std::string& who = std::string ()); - int do_remove (const octave_value& fid, const std::string& who = std::string ()); - - void do_clear (bool flush = true); - - string_vector do_get_info (int fid) const; - string_vector do_get_info (const octave_value& fid) const; - - std::string do_list_open_files (void) const; - - octave_value do_open_file_numbers (void) const; - - int do_get_file_number (const octave_value& fid) const; -}; - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/oct-strstrm.cc --- a/libinterp/interp-core/oct-strstrm.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,66 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "oct-strstrm.h" - -// Position a stream at OFFSET relative to ORIGIN. - -int -octave_base_strstream::seek (off_t, int) -{ - error ("fseek: invalid operation"); - return -1; -} - -// Return current stream position. - -off_t -octave_base_strstream::tell (void) -{ - error ("ftell: invalid operation"); - return -1; -} - -octave_stream -octave_istrstream::create (const char *data, std::ios::openmode arg_md, - oct_mach_info::float_format flt_fmt) -{ - return octave_stream (new octave_istrstream (data, arg_md, flt_fmt)); -} - -octave_stream -octave_istrstream::create (const std::string& data, std::ios::openmode arg_md, - oct_mach_info::float_format flt_fmt) -{ - return octave_stream (new octave_istrstream (data, arg_md, flt_fmt)); -} - -octave_stream -octave_ostrstream::create (std::ios::openmode arg_md, - oct_mach_info::float_format flt_fmt) -{ - return octave_stream (new octave_ostrstream (arg_md, flt_fmt)); -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/oct-strstrm.h --- a/libinterp/interp-core/oct-strstrm.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,176 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_octave_strstream_h) -#define octave_octave_strstream_h 1 - -#include -#include - -#include "oct-stream.h" - -class -octave_base_strstream : public octave_base_stream -{ -public: - - octave_base_strstream (std::ios::openmode m = std::ios::out, - oct_mach_info::float_format ff - = oct_mach_info::native_float_format ()) - : octave_base_stream (m, ff) { } - - // Position a stream at OFFSET relative to ORIGIN. - - int seek (off_t, int); - - // Return current stream position. - - virtual off_t tell (void); - - // The name of the file. - - std::string name (void) const { return std::string (); } - - virtual std::streambuf *rdbuf (void) = 0; - - virtual bool bad (void) const = 0; - - virtual void clear (void) = 0; - -protected: - - ~octave_base_strstream (void) { } - -private: - - // No copying! - - octave_base_strstream (const octave_base_strstream&); - - octave_base_strstream& operator = (const octave_base_strstream&); -}; - -class -octave_istrstream : public octave_base_strstream -{ -public: - - octave_istrstream (const char *data, - std::ios::openmode arg_md = std::ios::out, - oct_mach_info::float_format ff - = oct_mach_info::native_float_format ()) - : octave_base_strstream (arg_md, ff), is (data) { } - - octave_istrstream (const std::string& data, - std::ios::openmode arg_md = std::ios::out, - oct_mach_info::float_format ff - = oct_mach_info::native_float_format ()) - : octave_base_strstream (arg_md, ff), is (data.c_str ()) { } - - static octave_stream - create (const char *data, std::ios::openmode arg_md = std::ios::out, - oct_mach_info::float_format ff - = oct_mach_info::native_float_format ()); - - static octave_stream - create (const std::string& data, std::ios::openmode arg_md = std::ios::out, - oct_mach_info::float_format ff - = oct_mach_info::native_float_format ()); - - // Return non-zero if EOF has been reached on this stream. - - bool eof (void) const { return is.eof (); } - - std::istream *input_stream (void) { return &is; } - - std::ostream *output_stream (void) { return 0; } - - off_t tell (void) { return is.tellg (); } - - std::streambuf *rdbuf (void) { return is ? is.rdbuf () : 0; } - - bool bad (void) const { return is.bad (); } - - void clear (void) { is.clear (); } - -protected: - - ~octave_istrstream (void) { } - -private: - - std::istringstream is; - - // No copying! - - octave_istrstream (const octave_istrstream&); - - octave_istrstream& operator = (const octave_istrstream&); -}; - -class -octave_ostrstream : public octave_base_strstream -{ -public: - - octave_ostrstream (std::ios::openmode arg_md = std::ios::out, - oct_mach_info::float_format ff - = oct_mach_info::native_float_format ()) - : octave_base_strstream (arg_md, ff), os () { } - - static octave_stream - create (std::ios::openmode arg_md = std::ios::out, - oct_mach_info::float_format ff - = oct_mach_info::native_float_format ()); - - // Return non-zero if EOF has been reached on this stream. - - bool eof (void) const { return os.eof (); } - - std::istream *input_stream (void) { return 0; } - - std::ostream *output_stream (void) { return &os; } - - std::string str (void) { return os.str (); } - - std::streambuf *rdbuf (void) { return os ? os.rdbuf () : 0; } - - bool bad (void) const { return os.bad (); } - - void clear (void) { os.clear (); } - -protected: - - ~octave_ostrstream (void) { } - -private: - - std::ostringstream os; - - // No copying! - - octave_ostrstream (const octave_ostrstream&); - - octave_ostrstream& operator = (const octave_ostrstream&); -}; - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/oct.h --- a/libinterp/interp-core/oct.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,45 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_oct_h) -#define octave_oct_h 1 - -// Things that are often included to create .oct files. - -// config.h needs to be first because it includes #defines that can */ -// affect other header files. - -#include - -#include "Matrix.h" - -#include "oct-locbuf.h" -#include "defun-dld.h" -#include "error.h" -#include "gripes.h" -#include "help.h" -#include "oct-obj.h" -#include "pager.h" -#include "utils.h" -#include "variables.h" - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/procstream.cc --- a/libinterp/interp-core/procstream.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,70 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "procstream.h" - -procstreambase::procstreambase (const std::string& command, int mode) -{ - pb_init (); - - if (! pb.open (command.c_str (), mode)) - std::ios::setstate (std::ios::badbit); -} - -procstreambase::procstreambase (const char *command, int mode) -{ - pb_init (); - - if (! pb.open (command, mode)) - std::ios::setstate (std::ios::badbit); -} - -void -procstreambase::open (const char *command, int mode) -{ - clear (); - - if (! pb.open (command, mode)) - std::ios::setstate (std::ios::badbit); -} - -int -procstreambase::close (void) -{ - int status = 0; - - if (is_open ()) - { - if (! pb.close ()) - std::ios::setstate (std::ios::failbit); - - status = pb.wait_status (); - } - - return status; -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/procstream.h --- a/libinterp/interp-core/procstream.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,161 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_procstream_h) -#define octave_procstream_h 1 - -#include -#include - -#include - -#include "oct-procbuf.h" - -class -OCTINTERP_API -procstreambase : virtual public std::ios -{ -public: - - procstreambase (void) : pb () { pb_init (); } - - procstreambase (const std::string& name, int mode); - - procstreambase (const char *name, int mode); - - ~procstreambase (void) { close (); } - - void open (const std::string& name, int mode) - { open (name.c_str (), mode); } - - void open (const char *name, int mode); - - int is_open (void) const { return pb.is_open (); } - - int close (void); - - pid_t pid (void) const { return pb.pid (); } - - int file_number (void) const { return pb.file_number (); } - -private: - - octave_procbuf pb; - - void pb_init (void) { init (&pb); } - - procstreambase (const procstreambase&); - - procstreambase& operator = (const procstreambase&); -}; - -class -OCTINTERP_API -iprocstream : public std::istream, public procstreambase -// iprocstream : public procstreambase, public std::istream -{ -public: - - iprocstream (void) : std::istream (0), procstreambase () { } - - iprocstream (const std::string& name, int mode = std::ios::in) - : std::istream (0), procstreambase (name, mode) { } - - iprocstream (const char *name, int mode = std::ios::in) - : std::istream (0), procstreambase (name, mode) { } - - ~iprocstream (void) { } - - void open (const std::string& name, int mode = std::ios::in) - { procstreambase::open (name, mode); } - - void open (const char *name, int mode = std::ios::in) - { procstreambase::open (name, mode); } - -private: - - iprocstream (const iprocstream&); - - iprocstream& operator = (const iprocstream&); -}; - -class -OCTINTERP_API -oprocstream : public std::ostream, public procstreambase -// oprocstream : public procstreambase, public std::ostream -{ -public: - - oprocstream (void) : std::ostream (0), procstreambase () { } - - oprocstream (const std::string& name, int mode = std::ios::out) - : std::ostream (0), procstreambase (name, mode) { } - - oprocstream (const char *name, int mode = std::ios::out) - : std::ostream (0), procstreambase (name, mode) { } - - ~oprocstream (void) { } - - void open (const std::string& name, int mode = std::ios::out) - { procstreambase::open (name, mode); } - - void open (const char *name, int mode = std::ios::out) - { procstreambase::open (name, mode); } - -private: - - oprocstream (const oprocstream&); - - oprocstream& operator = (const oprocstream&); -}; - -class -OCTINTERP_API -procstream : public std::iostream, public procstreambase -// procstream : public procstreambase, public std::iostream -{ -public: - - procstream (void) : std::iostream (0), procstreambase () { } - - procstream (const std::string& name, int mode) - : std::iostream (0), procstreambase (name, mode) { } - - procstream (const char *name, int mode) - : std::iostream (0), procstreambase (name, mode) { } - - ~procstream (void) { } - - void open (const std::string& name, int mode) - { procstreambase::open (name, mode); } - - void open (const char *name, int mode) - { procstreambase::open (name, mode); } - -private: - - procstream (const procstream&); - - procstream& operator = (const procstream&); -}; - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/pt-jit.cc --- a/libinterp/interp-core/pt-jit.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2693 +0,0 @@ -/* - -Copyright (C) 2012 Max Brister - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Author: Max Brister - -#define __STDC_LIMIT_MACROS -#define __STDC_CONSTANT_MACROS - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "debug.h" -#include "defun.h" -#include "ov.h" -#include "pt-all.h" -#include "pt-jit.h" -#include "sighandlers.h" -#include "symtab.h" -#include "variables.h" - -#ifdef HAVE_LLVM - -static bool Vdebug_jit = false; - -static bool Vjit_enable = true; - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -static llvm::IRBuilder<> builder (llvm::getGlobalContext ()); - -static llvm::LLVMContext& context = llvm::getGlobalContext (); - -// -------------------- jit_break_exception -------------------- - -// jit_break is thrown whenever a branch we are converting has only breaks or -// continues. This is because all code that follows a break or continue is dead. -class jit_break_exception : public std::exception {}; - -// -------------------- jit_convert -------------------- -jit_convert::jit_convert (tree &tee, jit_type *for_bounds) - : converting_function (false) -{ - initialize (symbol_table::current_scope ()); - - if (for_bounds) - create_variable (next_for_bounds (false), for_bounds); - - try - { - visit (tee); - } - catch (const jit_break_exception&) - {} - - // breaks must have been handled by the top level loop - assert (breaks.empty ()); - assert (continues.empty ()); - - block->append (factory.create (final_block)); - blocks.push_back (final_block); - - for (variable_map::iterator iter = vmap.begin (); iter != vmap.end (); ++iter) - { - jit_variable *var = iter->second; - const std::string& name = var->name (); - if (name.size () && name[0] != '#') - final_block->append (factory.create (var)); - } - - final_block->append (factory.create ()); -} - -jit_convert::jit_convert (octave_user_function& fcn, - const std::vector& args) - : converting_function (true) -{ - initialize (fcn.scope ()); - - tree_parameter_list *plist = fcn.parameter_list (); - tree_parameter_list *rlist = fcn.return_list (); - if (plist && plist->takes_varargs ()) - throw jit_fail_exception ("varags not supported"); - - if (rlist && (rlist->size () > 1 || rlist->takes_varargs ())) - throw jit_fail_exception ("multiple returns not supported"); - - if (plist) - { - tree_parameter_list::iterator piter = plist->begin (); - for (size_t i = 0; i < args.size (); ++i, ++piter) - { - if (piter == plist->end ()) - throw jit_fail_exception ("Too many parameter to function"); - - tree_decl_elt *elt = *piter; - std::string name = elt->name (); - create_variable (name, args[i]); - } - } - - jit_value *return_value = 0; - bool all_breaking = false; - if (fcn.is_special_expr ()) - { - tree_expression *expr = fcn.special_expr (); - if (expr) - { - jit_variable *retvar = get_variable ("#return"); - jit_value *retval; - try - { - retval = visit (expr); - } - catch (const jit_break_exception&) - {} - - if (breaks.size () || continues.size ()) - throw jit_fail_exception ("break/continue not supported in " - "anonymous functions"); - - block->append (factory.create (retvar, retval)); - return_value = retvar; - } - } - else - { - try - { - visit_statement_list (*fcn.body ()); - } - catch (const jit_break_exception&) - { - all_breaking = true; - } - - // the user may use break or continue to exit the function - finish_breaks (final_block, continues); - finish_breaks (final_block, breaks); - } - - if (! all_breaking) - block->append (factory.create (final_block)); - - blocks.push_back (final_block); - block = final_block; - - if (! return_value && rlist && rlist->size () == 1) - { - tree_decl_elt *elt = rlist->front (); - return_value = get_variable (elt->name ()); - } - - // FIXME: We should use live range analysis to delete variables where needed. - // For now we just delete everything at the end of the function. - for (variable_map::iterator iter = vmap.begin (); iter != vmap.end (); ++iter) - { - if (iter->second != return_value) - { - jit_call *call; - call = factory.create (&jit_typeinfo::destroy, - iter->second); - final_block->append (call); - } - } - - if (return_value) - final_block->append (factory.create (return_value)); - else - final_block->append (factory.create ()); -} - -void -jit_convert::visit_anon_fcn_handle (tree_anon_fcn_handle&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::visit_argument_list (tree_argument_list&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::visit_binary_expression (tree_binary_expression& be) -{ - if (be.op_type () >= octave_value::num_binary_ops) - { - tree_boolean_expression *boole; - boole = dynamic_cast (&be); - assert (boole); - bool is_and = boole->op_type () == tree_boolean_expression::bool_and; - - std::string short_name = next_shortcircut_result (); - jit_variable *short_result = factory.create (short_name); - vmap[short_name] = short_result; - - jit_block *done = factory.create (block->name ()); - tree_expression *lhs = be.lhs (); - jit_value *lhsv = visit (lhs); - lhsv = create_checked (&jit_typeinfo::logically_true, lhsv); - - jit_block *short_early = factory.create ("short_early"); - blocks.push_back (short_early); - - jit_block *short_cont = factory.create ("short_cont"); - - if (is_and) - block->append (factory.create (lhsv, short_cont, short_early)); - else - block->append (factory.create (lhsv, short_early, short_cont)); - - block = short_early; - - jit_value *early_result = factory.create (! is_and); - block->append (factory.create (short_result, early_result)); - block->append (factory.create (done)); - - blocks.push_back (short_cont); - block = short_cont; - - tree_expression *rhs = be.rhs (); - jit_value *rhsv = visit (rhs); - rhsv = create_checked (&jit_typeinfo::logically_true, rhsv); - block->append (factory.create (short_result, rhsv)); - block->append (factory.create (done)); - - blocks.push_back (done); - block = done; - result = short_result; - } - else - { - tree_expression *lhs = be.lhs (); - jit_value *lhsv = visit (lhs); - - tree_expression *rhs = be.rhs (); - jit_value *rhsv = visit (rhs); - - const jit_operation& fn = jit_typeinfo::binary_op (be.op_type ()); - result = create_checked (fn, lhsv, rhsv); - } -} - -void -jit_convert::visit_break_command (tree_break_command&) -{ - breaks.push_back (block); - throw jit_break_exception (); -} - -void -jit_convert::visit_colon_expression (tree_colon_expression& expr) -{ - // in the futher we need to add support for classes and deal with rvalues - jit_value *base = visit (expr.base ()); - jit_value *limit = visit (expr.limit ()); - jit_value *increment; - tree_expression *tinc = expr.increment (); - - if (tinc) - increment = visit (tinc); - else - increment = factory.create (1); - - result = block->append (factory.create (jit_typeinfo::make_range, base, - limit, increment)); -} - -void -jit_convert::visit_continue_command (tree_continue_command&) -{ - continues.push_back (block); - throw jit_break_exception (); -} - -void -jit_convert::visit_global_command (tree_global_command&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::visit_persistent_command (tree_persistent_command&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::visit_decl_elt (tree_decl_elt&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::visit_decl_init_list (tree_decl_init_list&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::visit_simple_for_command (tree_simple_for_command& cmd) -{ - // Note we do an initial check to see if the loop will run atleast once. - // This allows us to get better type inference bounds on variables defined - // and used only inside the for loop (e.g. the index variable) - - // If we are a nested for loop we need to store the previous breaks - unwind_protect prot; - prot.protect_var (breaks); - prot.protect_var (continues); - breaks.clear (); - continues.clear (); - - // we need a variable for our iterator, because it is used in multiple blocks - std::string iter_name = next_iterator (); - jit_variable *iterator = factory.create (iter_name); - factory.create (iter_name); - vmap[iter_name] = iterator; - - jit_block *body = factory.create ("for_body"); - jit_block *tail = factory.create ("for_tail"); - - // do control expression, iter init, and condition check in prev_block (block) - // if we are the top level for loop, the bounds is an input argument. - jit_value *control = find_variable (next_for_bounds ()); - if (! control) - control = visit (cmd.control_expr ()); - jit_call *init_iter = factory.create (jit_typeinfo::for_init, - control); - block->append (init_iter); - block->append (factory.create (iterator, init_iter)); - - jit_call *check = factory.create (jit_typeinfo::for_check, control, - iterator); - block->append (check); - block->append (factory.create (check, body, tail)); - - blocks.push_back (body); - block = body; - - // compute the syntactical iterator - jit_call *idx_rhs = factory.create (jit_typeinfo::for_index, - control, iterator); - block->append (idx_rhs); - do_assign (cmd.left_hand_side (), idx_rhs); - - // do loop - tree_statement_list *pt_body = cmd.body (); - bool all_breaking = false; - try - { - pt_body->accept (*this); - } - catch (const jit_break_exception&) - { - if (continues.empty ()) - { - // WTF are you doing user? Every branch was a break, why did you have - // a loop??? Users are silly people... - finish_breaks (tail, breaks); - blocks.push_back (tail); - block = tail; - return; - } - - all_breaking = true; - } - - // check our condition, continues jump to this block - jit_block *check_block = factory.create ("for_check"); - blocks.push_back (check_block); - - jit_block *interrupt_check = factory.create ("for_interrupt"); - blocks.push_back (interrupt_check); - - if (! all_breaking) - block->append (factory.create (check_block)); - finish_breaks (check_block, continues); - - block = check_block; - const jit_operation& add_fn = jit_typeinfo::binary_op (octave_value::op_add); - jit_value *one = factory.create (1); - jit_call *iter_inc = factory.create (add_fn, iterator, one); - block->append (iter_inc); - block->append (factory.create (iterator, iter_inc)); - check = block->append (factory.create (jit_typeinfo::for_check, - control, iterator)); - block->append (factory.create (check, interrupt_check, - tail)); - - block = interrupt_check; - jit_error_check *ec - = factory.create (jit_error_check::var_interrupt, - body, final_block); - block->append (ec); - - // breaks will go to our tail - blocks.push_back (tail); - finish_breaks (tail, breaks); - block = tail; -} - -void -jit_convert::visit_complex_for_command (tree_complex_for_command&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::visit_octave_user_script (octave_user_script&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::visit_octave_user_function (octave_user_function&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::visit_octave_user_function_header (octave_user_function&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::visit_octave_user_function_trailer (octave_user_function&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::visit_function_def (tree_function_def&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::visit_identifier (tree_identifier& ti) -{ - if (ti.has_magic_end ()) - { - if (!end_context.size ()) - throw jit_fail_exception ("Illegal end"); - result = block->append (factory.create (end_context)); - } - else - { - jit_variable *var = get_variable (ti.name ()); - jit_instruction *instr; - instr = factory.create (&jit_typeinfo::grab, var); - result = block->append (instr); - } -} - -void -jit_convert::visit_if_clause (tree_if_clause&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::visit_if_command (tree_if_command& cmd) -{ - tree_if_command_list *lst = cmd.cmd_list (); - assert (lst); // jwe: Can this be null? - lst->accept (*this); -} - -void -jit_convert::visit_if_command_list (tree_if_command_list& lst) -{ - tree_if_clause *last = lst.back (); - size_t last_else = static_cast (last->is_else_clause ()); - - // entry_blocks represents the block you need to enter in order to execute - // the condition check for the ith clause. For the else, it is simple the - // else body. If there is no else body, then it is padded with the tail - std::vector entry_blocks (lst.size () + 1 - last_else); - std::vector branch_blocks (lst.size (), 0); // final blocks - entry_blocks[0] = block; - - // we need to construct blocks first, because they have jumps to eachother - tree_if_command_list::iterator iter = lst.begin (); - ++iter; - for (size_t i = 1; iter != lst.end (); ++iter, ++i) - { - tree_if_clause *tic = *iter; - if (tic->is_else_clause ()) - entry_blocks[i] = factory.create ("else"); - else - entry_blocks[i] = factory.create ("ifelse_cond"); - } - - jit_block *tail = factory.create ("if_tail"); - if (! last_else) - entry_blocks[entry_blocks.size () - 1] = tail; - - - // each branch in the if statement will have different breaks/continues - block_list current_breaks = breaks; - block_list current_continues = continues; - breaks.clear (); - continues.clear (); - - size_t num_incomming = 0; // number of incomming blocks to our tail - iter = lst.begin (); - for (size_t i = 0; iter != lst.end (); ++iter, ++i) - { - tree_if_clause *tic = *iter; - block = entry_blocks[i]; - assert (block); - - if (i) // the first block is prev_block, so it has already been added - blocks.push_back (entry_blocks[i]); - - if (! tic->is_else_clause ()) - { - tree_expression *expr = tic->condition (); - jit_value *cond = visit (expr); - jit_call *check = create_checked (&jit_typeinfo::logically_true, - cond); - jit_block *body = factory.create (i == 0 ? "if_body" - : "ifelse_body"); - blocks.push_back (body); - - jit_instruction *br = factory.create (check, body, - entry_blocks[i + 1]); - block->append (br); - block = body; - } - - tree_statement_list *stmt_lst = tic->commands (); - assert (stmt_lst); // jwe: Can this be null? - - try - { - stmt_lst->accept (*this); - ++num_incomming; - block->append (factory.create (tail)); - } - catch(const jit_break_exception&) - {} - - current_breaks.splice (current_breaks.end (), breaks); - current_continues.splice (current_continues.end (), continues); - } - - breaks.splice (breaks.end (), current_breaks); - continues.splice (continues.end (), current_continues); - - if (num_incomming || ! last_else) - { - blocks.push_back (tail); - block = tail; - } - else - // every branch broke, so we don't have a tail - throw jit_break_exception (); -} - -void -jit_convert::visit_index_expression (tree_index_expression& exp) -{ - result = resolve (exp); -} - -void -jit_convert::visit_matrix (tree_matrix&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::visit_cell (tree_cell&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::visit_multi_assignment (tree_multi_assignment&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::visit_no_op_command (tree_no_op_command&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::visit_constant (tree_constant& tc) -{ - octave_value v = tc.rvalue1 (); - jit_type *ty = jit_typeinfo::type_of (v); - - if (ty == jit_typeinfo::get_scalar ()) - { - double dv = v.double_value (); - result = factory.create (dv); - } - else if (ty == jit_typeinfo::get_range ()) - { - Range rv = v.range_value (); - result = factory.create (rv); - } - else if (ty == jit_typeinfo::get_complex ()) - { - Complex cv = v.complex_value (); - result = factory.create (cv); - } - else - throw jit_fail_exception ("Unknown constant"); -} - -void -jit_convert::visit_fcn_handle (tree_fcn_handle&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::visit_parameter_list (tree_parameter_list&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::visit_postfix_expression (tree_postfix_expression& tpe) -{ - octave_value::unary_op etype = tpe.op_type (); - tree_expression *operand = tpe.operand (); - jit_value *operandv = visit (operand); - - const jit_operation& fn = jit_typeinfo::unary_op (etype); - result = create_checked (fn, operandv); - - if (etype == octave_value::op_incr || etype == octave_value::op_decr) - { - jit_value *ret = create_checked (&jit_typeinfo::grab, operandv); - do_assign (operand, result); - result = ret; - } -} - -void -jit_convert::visit_prefix_expression (tree_prefix_expression& tpe) -{ - octave_value::unary_op etype = tpe.op_type (); - tree_expression *operand = tpe.operand (); - const jit_operation& fn = jit_typeinfo::unary_op (etype); - result = create_checked (fn, visit (operand)); - - if (etype == octave_value::op_incr || etype == octave_value::op_decr) - do_assign (operand, result); -} - -void -jit_convert::visit_return_command (tree_return_command&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::visit_return_list (tree_return_list&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::visit_simple_assignment (tree_simple_assignment& tsa) -{ - tree_expression *rhs = tsa.right_hand_side (); - jit_value *rhsv = visit (rhs); - octave_value::assign_op op = tsa.op_type (); - - if (op != octave_value::op_asn_eq) - { - // do the equivlent binary operation, then assign. This is always correct, - // but isn't always optimal. - tree_expression *lhs = tsa.left_hand_side (); - jit_value *lhsv = visit (lhs); - octave_value::binary_op bop = octave_value::assign_op_to_binary_op (op); - const jit_operation& fn = jit_typeinfo::binary_op (bop); - rhsv = create_checked (fn, lhsv, rhsv); - } - - result = do_assign (tsa.left_hand_side (), rhsv); -} - -void -jit_convert::visit_statement (tree_statement& stmt) -{ - tree_command *cmd = stmt.command (); - tree_expression *expr = stmt.expression (); - - if (cmd) - visit (cmd); - else - { - // stolen from tree_evaluator::visit_statement - bool do_bind_ans = false; - - if (expr->is_identifier ()) - { - tree_identifier *id = dynamic_cast (expr); - - do_bind_ans = (! id->is_variable ()); - } - else - do_bind_ans = (! expr->is_assignment_expression ()); - - jit_value *expr_result = visit (expr); - - if (do_bind_ans) - do_assign ("ans", expr_result, expr->print_result ()); - else if (expr->is_identifier () && expr->print_result ()) - { - // FIXME: ugly hack, we need to come up with a way to pass - // nargout to visit_identifier - const jit_operation& fn = jit_typeinfo::print_value (); - jit_const_string *name = factory.create (expr->name ()); - block->append (factory.create (fn, name, expr_result)); - } - } -} - -void -jit_convert::visit_statement_list (tree_statement_list& lst) -{ - for (tree_statement_list::iterator iter = lst.begin (); iter != lst.end(); - ++iter) - { - tree_statement *elt = *iter; - // jwe: Can this ever be null? - assert (elt); - elt->accept (*this); - } -} - -void -jit_convert::visit_switch_case (tree_switch_case&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::visit_switch_case_list (tree_switch_case_list&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::visit_switch_command (tree_switch_command&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::visit_try_catch_command (tree_try_catch_command&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::visit_unwind_protect_command (tree_unwind_protect_command&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::visit_while_command (tree_while_command& wc) -{ - unwind_protect prot; - prot.protect_var (breaks); - prot.protect_var (continues); - breaks.clear (); - continues.clear (); - - jit_block *cond_check = factory.create ("while_cond_check"); - block->append (factory.create (cond_check)); - blocks.push_back (cond_check); - block = cond_check; - - tree_expression *expr = wc.condition (); - assert (expr && "While expression can not be null"); - jit_value *check = visit (expr); - check = create_checked (&jit_typeinfo::logically_true, check); - - jit_block *body = factory.create ("while_body"); - blocks.push_back (body); - - jit_block *tail = factory.create ("while_tail"); - block->append (factory.create (check, body, tail)); - block = body; - - tree_statement_list *loop_body = wc.body (); - bool all_breaking = false; - if (loop_body) - { - try - { - loop_body->accept (*this); - } - catch (const jit_break_exception&) - { - all_breaking = true; - } - } - - finish_breaks (tail, breaks); - - if (! all_breaking || continues.size ()) - { - jit_block *interrupt_check - = factory.create ("interrupt_check"); - blocks.push_back (interrupt_check); - finish_breaks (interrupt_check, continues); - if (! all_breaking) - block->append (factory.create (interrupt_check)); - - block = interrupt_check; - jit_error_check *ec - = factory.create (jit_error_check::var_interrupt, - cond_check, final_block); - block->append (ec); - } - - blocks.push_back (tail); - block = tail; -} - -void -jit_convert::visit_do_until_command (tree_do_until_command&) -{ - throw jit_fail_exception (); -} - -void -jit_convert::initialize (symbol_table::scope_id s) -{ - scope = s; - iterator_count = 0; - for_bounds_count = 0; - short_count = 0; - jit_instruction::reset_ids (); - - entry_block = factory.create ("body"); - final_block = factory.create ("final"); - blocks.push_back (entry_block); - entry_block->mark_alive (); - block = entry_block; -} - -jit_call * -jit_convert::create_checked_impl (jit_call *ret) -{ - block->append (ret); - - jit_block *normal = factory.create (block->name ()); - jit_error_check *check - = factory.create (jit_error_check::var_error_state, ret, - normal, final_block); - block->append (check); - blocks.push_back (normal); - block = normal; - - return ret; -} - -jit_variable * -jit_convert::find_variable (const std::string& vname) const -{ - variable_map::const_iterator iter; - iter = vmap.find (vname); - return iter != vmap.end () ? iter->second : 0; -} - -jit_variable * -jit_convert::get_variable (const std::string& vname) -{ - jit_variable *ret = find_variable (vname); - if (ret) - return ret; - - symbol_table::symbol_record record = symbol_table::find_symbol (vname, scope); - if (record.is_persistent () || record.is_global ()) - throw jit_fail_exception ("Persistent and global not yet supported"); - - if (converting_function) - return create_variable (vname, jit_typeinfo::get_any (), false); - else - { - octave_value val = record.varval (); - jit_type *type = jit_typeinfo::type_of (val); - bounds.push_back (type_bound (type, vname)); - - return create_variable (vname, type); - } -} - -jit_variable * -jit_convert::create_variable (const std::string& vname, jit_type *type, - bool isarg) -{ - jit_variable *var = factory.create (vname); - - if (isarg) - { - jit_extract_argument *extract; - extract = factory.create (type, var); - entry_block->prepend (extract); - } - else - { - jit_call *init = factory.create (&jit_typeinfo::create_undef); - jit_assign *assign = factory.create (var, init); - entry_block->prepend (assign); - entry_block->prepend (init); - } - - return vmap[vname] = var; -} - -std::string -jit_convert::next_name (const char *prefix, size_t& count, bool inc) -{ - std::stringstream ss; - ss << prefix << count; - if (inc) - ++count; - return ss.str (); -} - -jit_instruction * -jit_convert::resolve (tree_index_expression& exp, jit_value *extra_arg, - bool lhs) -{ - std::string type = exp.type_tags (); - if (! (type.size () == 1 && type[0] == '(')) - throw jit_fail_exception ("Unsupported index operation"); - - std::list args = exp.arg_lists (); - if (args.size () != 1) - throw jit_fail_exception ("Bad number of arguments in " - "tree_index_expression"); - - tree_argument_list *arg_list = args.front (); - if (! arg_list) - throw jit_fail_exception ("null argument list"); - - if (arg_list->size () < 1) - throw jit_fail_exception ("Empty arg_list"); - - tree_expression *tree_object = exp.expression (); - jit_value *object; - if (lhs) - { - tree_identifier *id = dynamic_cast (tree_object); - if (! id) - throw jit_fail_exception ("expected identifier"); - object = get_variable (id->name ()); - } - else - object = visit (tree_object); - - size_t narg = arg_list->size (); - tree_argument_list::iterator iter = arg_list->begin (); - bool have_extra = extra_arg; - std::vector call_args (narg + 1 + have_extra); - call_args[0] = object; - - for (size_t idx = 0; iter != arg_list->end (); ++idx, ++iter) - { - unwind_protect prot; - prot.add_method (&end_context, - &std::vector::pop_back); - - jit_magic_end::context ctx (factory, object, idx, narg); - end_context.push_back (ctx); - call_args[idx + 1] = visit (*iter); - } - - if (extra_arg) - call_args[call_args.size () - 1] = extra_arg; - - const jit_operation& fres = lhs ? jit_typeinfo::paren_subsasgn () - : jit_typeinfo::paren_subsref (); - - return create_checked (fres, call_args); -} - -jit_value * -jit_convert::do_assign (tree_expression *exp, jit_value *rhs, bool artificial) -{ - if (! exp) - throw jit_fail_exception ("NULL lhs in assign"); - - if (isa (exp)) - return do_assign (exp->name (), rhs, exp->print_result (), artificial); - else if (tree_index_expression *idx - = dynamic_cast (exp)) - { - jit_value *new_object = resolve (*idx, rhs, true); - do_assign (idx->expression (), new_object, true); - - // FIXME: Will not work for values that must be release/grabed - return rhs; - } - else - throw jit_fail_exception ("Unsupported assignment"); -} - -jit_value * -jit_convert::do_assign (const std::string& lhs, jit_value *rhs, - bool print, bool artificial) -{ - jit_variable *var = get_variable (lhs); - jit_assign *assign = block->append (factory.create (var, rhs)); - - if (artificial) - assign->mark_artificial (); - - if (print) - { - const jit_operation& print_fn = jit_typeinfo::print_value (); - jit_const_string *name = factory.create (lhs); - block->append (factory.create (print_fn, name, var)); - } - - return var; -} - -jit_value * -jit_convert::visit (tree& tee) -{ - unwind_protect prot; - prot.protect_var (result); - - tee.accept (*this); - return result; -} - -void -jit_convert::finish_breaks (jit_block *dest, const block_list& lst) -{ - for (block_list::const_iterator iter = lst.begin (); iter != lst.end (); - ++iter) - { - jit_block *b = *iter; - b->append (factory.create (dest)); - } -} - -// -------------------- jit_convert_llvm -------------------- -llvm::Function * -jit_convert_llvm::convert_loop (llvm::Module *module, - const jit_block_list& blocks, - const std::list& constants) -{ - converting_function = false; - - // for now just init arguments from entry, later we will have to do something - // more interesting - jit_block *entry_block = blocks.front (); - for (jit_block::iterator iter = entry_block->begin (); - iter != entry_block->end (); ++iter) - if (jit_extract_argument *extract - = dynamic_cast (*iter)) - argument_vec.push_back (std::make_pair (extract->name (), true)); - - - jit_type *any = jit_typeinfo::get_any (); - - // argument is an array of octave_base_value*, or octave_base_value** - llvm::Type *arg_type = any->to_llvm (); // this is octave_base_value* - arg_type = arg_type->getPointerTo (); - llvm::FunctionType *ft = llvm::FunctionType::get (llvm::Type::getVoidTy (context), - arg_type, false); - function = llvm::Function::Create (ft, llvm::Function::ExternalLinkage, - "foobar", module); - - try - { - prelude = llvm::BasicBlock::Create (context, "prelude", function); - builder.SetInsertPoint (prelude); - - llvm::Value *arg = function->arg_begin (); - for (size_t i = 0; i < argument_vec.size (); ++i) - { - llvm::Value *loaded_arg = builder.CreateConstInBoundsGEP1_32 (arg, i); - arguments[argument_vec[i].first] = loaded_arg; - } - - convert (blocks, constants); - } catch (const jit_fail_exception& e) - { - function->eraseFromParent (); - throw; - } - - return function; -} - - -jit_function -jit_convert_llvm::convert_function (llvm::Module *module, - const jit_block_list& blocks, - const std::list& constants, - octave_user_function& fcn, - const std::vector& args) -{ - converting_function = true; - - jit_block *final_block = blocks.back (); - jit_return *ret = dynamic_cast (final_block->back ()); - assert (ret); - - creating = jit_function (module, jit_convention::internal, - "foobar", ret->result_type (), args); - function = creating.to_llvm (); - - try - { - prelude = creating.new_block ("prelude"); - builder.SetInsertPoint (prelude); - - tree_parameter_list *plist = fcn.parameter_list (); - if (plist) - { - tree_parameter_list::iterator piter = plist->begin (); - tree_parameter_list::iterator pend = plist->end (); - for (size_t i = 0; i < args.size () && piter != pend; ++i, ++piter) - { - tree_decl_elt *elt = *piter; - std::string arg_name = elt->name (); - arguments[arg_name] = creating.argument (builder, i); - } - } - - convert (blocks, constants); - } catch (const jit_fail_exception& e) - { - function->eraseFromParent (); - throw; - } - - return creating; -} - -void -jit_convert_llvm::convert (const jit_block_list& blocks, - const std::list& constants) -{ - std::list::const_iterator biter; - for (biter = blocks.begin (); biter != blocks.end (); ++biter) - { - jit_block *jblock = *biter; - llvm::BasicBlock *block = llvm::BasicBlock::Create (context, - jblock->name (), - function); - jblock->stash_llvm (block); - } - - jit_block *first = *blocks.begin (); - builder.CreateBr (first->to_llvm ()); - - // constants aren't in the IR, we visit those first - for (std::list::const_iterator iter = constants.begin (); - iter != constants.end (); ++iter) - if (! isa (*iter)) - visit (*iter); - - // convert all instructions - for (biter = blocks.begin (); biter != blocks.end (); ++biter) - visit (*biter); - - // now finish phi nodes - for (biter = blocks.begin (); biter != blocks.end (); ++biter) - { - jit_block& block = **biter; - for (jit_block::iterator piter = block.begin (); - piter != block.end () && isa (*piter); ++piter) - { - jit_instruction *phi = *piter; - finish_phi (static_cast (phi)); - } - } -} - -void -jit_convert_llvm::finish_phi (jit_phi *phi) -{ - llvm::PHINode *llvm_phi = phi->to_llvm (); - for (size_t i = 0; i < phi->argument_count (); ++i) - { - llvm::BasicBlock *pred = phi->incomming_llvm (i); - llvm_phi->addIncoming (phi->argument_llvm (i), pred); - } -} - -void -jit_convert_llvm::visit (jit_const_string& cs) -{ - cs.stash_llvm (builder.CreateGlobalStringPtr (cs.value ())); -} - -void -jit_convert_llvm::visit (jit_const_bool& cb) -{ - cb.stash_llvm (llvm::ConstantInt::get (cb.type_llvm (), cb.value ())); -} - -void -jit_convert_llvm::visit (jit_const_scalar& cs) -{ - cs.stash_llvm (llvm::ConstantFP::get (cs.type_llvm (), cs.value ())); -} - -void -jit_convert_llvm::visit (jit_const_complex& cc) -{ - llvm::Type *scalar_t = jit_typeinfo::get_scalar_llvm (); - Complex value = cc.value (); - llvm::Value *real = llvm::ConstantFP::get (scalar_t, value.real ()); - llvm::Value *imag = llvm::ConstantFP::get (scalar_t, value.imag ()); - cc.stash_llvm (jit_typeinfo::create_complex (real, imag)); -} - -void jit_convert_llvm::visit (jit_const_index& ci) -{ - ci.stash_llvm (llvm::ConstantInt::get (ci.type_llvm (), ci.value ())); -} - -void -jit_convert_llvm::visit (jit_const_range& cr) -{ - llvm::StructType *stype = llvm::cast(cr.type_llvm ()); - llvm::Type *scalar_t = jit_typeinfo::get_scalar_llvm (); - llvm::Type *idx = jit_typeinfo::get_index_llvm (); - const jit_range& rng = cr.value (); - - llvm::Constant *constants[4]; - constants[0] = llvm::ConstantFP::get (scalar_t, rng.base); - constants[1] = llvm::ConstantFP::get (scalar_t, rng.limit); - constants[2] = llvm::ConstantFP::get (scalar_t, rng.inc); - constants[3] = llvm::ConstantInt::get (idx, rng.nelem); - - llvm::Value *as_llvm; - as_llvm = llvm::ConstantStruct::get (stype, - llvm::makeArrayRef (constants, 4)); - cr.stash_llvm (as_llvm); -} - -void -jit_convert_llvm::visit (jit_block& b) -{ - llvm::BasicBlock *block = b.to_llvm (); - builder.SetInsertPoint (block); - for (jit_block::iterator iter = b.begin (); iter != b.end (); ++iter) - visit (*iter); -} - -void -jit_convert_llvm::visit (jit_branch& b) -{ - b.stash_llvm (builder.CreateBr (b.successor_llvm ())); -} - -void -jit_convert_llvm::visit (jit_cond_branch& cb) -{ - llvm::Value *cond = cb.cond_llvm (); - llvm::Value *br; - br = builder.CreateCondBr (cond, cb.successor_llvm (0), - cb.successor_llvm (1)); - cb.stash_llvm (br); -} - -void -jit_convert_llvm::visit (jit_call& call) -{ - const jit_function& ol = call.overload (); - - std::vector args (call.arguments ().size ()); - for (size_t i = 0; i < args.size (); ++i) - args[i] = call.argument (i); - - llvm::Value *ret = ol.call (builder, args); - call.stash_llvm (ret); -} - -void -jit_convert_llvm::visit (jit_extract_argument& extract) -{ - llvm::Value *arg = arguments[extract.name ()]; - assert (arg); - - if (converting_function) - extract.stash_llvm (arg); - else - { - arg = builder.CreateLoad (arg); - - const jit_function& ol = extract.overload (); - extract.stash_llvm (ol.call (builder, arg)); - } -} - -void -jit_convert_llvm::visit (jit_store_argument& store) -{ - const jit_function& ol = store.overload (); - llvm::Value *arg_value = ol.call (builder, store.result ()); - llvm::Value *arg = arguments[store.name ()]; - store.stash_llvm (builder.CreateStore (arg_value, arg)); -} - -void -jit_convert_llvm::visit (jit_return& ret) -{ - jit_value *res = ret.result (); - - if (converting_function) - creating.do_return (builder, res->to_llvm (), false); - else - { - if (res) - builder.CreateRet (res->to_llvm ()); - else - builder.CreateRetVoid (); - } -} - -void -jit_convert_llvm::visit (jit_phi& phi) -{ - // we might not have converted all incoming branches, so we don't - // set incomming branches now - llvm::PHINode *node = llvm::PHINode::Create (phi.type_llvm (), - phi.argument_count ()); - builder.Insert (node); - phi.stash_llvm (node); -} - -void -jit_convert_llvm::visit (jit_variable&) -{ - throw jit_fail_exception ("ERROR: SSA construction should remove all variables"); -} - -void -jit_convert_llvm::visit (jit_error_check& check) -{ - llvm::Value *cond; - - switch (check.check_variable ()) - { - case jit_error_check::var_error_state: - cond = jit_typeinfo::insert_error_check (builder); - break; - case jit_error_check::var_interrupt: - cond = jit_typeinfo::insert_interrupt_check (builder); - break; - default: - panic_impossible (); - } - - llvm::Value *br = builder.CreateCondBr (cond, check.successor_llvm (0), - check.successor_llvm (1)); - check.stash_llvm (br); -} - -void -jit_convert_llvm::visit (jit_assign& assign) -{ - jit_value *new_value = assign.src (); - assign.stash_llvm (new_value->to_llvm ()); - - if (assign.artificial ()) - return; - - jit_value *overwrite = assign.overwrite (); - if (isa (overwrite)) - { - const jit_function& ol = jit_typeinfo::get_release (overwrite->type ()); - if (ol.valid ()) - ol.call (builder, overwrite); - } -} - -void -jit_convert_llvm::visit (jit_argument&) -{} - -void -jit_convert_llvm::visit (jit_magic_end& me) -{ - const jit_function& ol = me.overload (); - - jit_magic_end::context ctx = me.resolve_context (); - llvm::Value *ret = ol.call (builder, ctx.value, ctx.index, ctx.count); - me.stash_llvm (ret); -} - -// -------------------- jit_infer -------------------- -jit_infer::jit_infer (jit_factory& afactory, jit_block_list& ablocks, - const variable_map& avmap) - : blocks (ablocks), factory (afactory), vmap (avmap) {} - -void -jit_infer::infer (void) -{ - construct_ssa (); - - // initialize the worklist to instructions derived from constants - const std::list& constants = factory.constants (); - for (std::list::const_iterator iter = constants.begin (); - iter != constants.end (); ++iter) - append_users (*iter); - - // the entry block terminator may be a regular branch statement - if (entry_block ().terminator ()) - push_worklist (entry_block ().terminator ()); - - // FIXME: Describe algorithm here - while (worklist.size ()) - { - jit_instruction *next = worklist.front (); - worklist.pop_front (); - next->stash_in_worklist (false); - - if (next->infer ()) - { - // terminators need to be handles specially - if (jit_terminator *term = dynamic_cast (next)) - append_users_term (term); - else - append_users (next); - } - } - - remove_dead (); - blocks.label (); - place_releases (); - simplify_phi (); -} - -void -jit_infer::append_users (jit_value *v) -{ - for (jit_use *use = v->first_use (); use; use = use->next ()) - push_worklist (use->user ()); -} - -void -jit_infer::append_users_term (jit_terminator *term) -{ - for (size_t i = 0; i < term->successor_count (); ++i) - { - if (term->alive (i)) - { - jit_block *succ = term->successor (i); - for (jit_block::iterator iter = succ->begin (); iter != succ->end () - && isa (*iter); ++iter) - push_worklist (*iter); - - jit_terminator *sterm = succ->terminator (); - if (sterm) - push_worklist (sterm); - } - } -} - -void -jit_infer::construct_ssa (void) -{ - blocks.label (); - final_block ().compute_idom (entry_block ()); - entry_block ().compute_df (); - entry_block ().create_dom_tree (); - - // insert phi nodes where needed, this is done on a per variable basis - for (variable_map::const_iterator iter = vmap.begin (); iter != vmap.end (); - ++iter) - { - jit_block::df_set visited, added_phi; - std::list ssa_worklist; - iter->second->use_blocks (visited); - ssa_worklist.insert (ssa_worklist.begin (), visited.begin (), - visited.end ()); - - while (ssa_worklist.size ()) - { - jit_block *b = ssa_worklist.front (); - ssa_worklist.pop_front (); - - for (jit_block::df_iterator diter = b->df_begin (); - diter != b->df_end (); ++diter) - { - jit_block *dblock = *diter; - if (! added_phi.count (dblock)) - { - jit_phi *phi = factory.create (iter->second, - dblock->use_count ()); - dblock->prepend (phi); - added_phi.insert (dblock); - } - - if (! visited.count (dblock)) - { - ssa_worklist.push_back (dblock); - visited.insert (dblock); - } - } - } - } - - do_construct_ssa (entry_block (), entry_block ().visit_count ()); -} - -void -jit_infer::do_construct_ssa (jit_block& ablock, size_t avisit_count) -{ - if (ablock.visited (avisit_count)) - return; - - // replace variables with their current SSA value - for (jit_block::iterator iter = ablock.begin (); iter != ablock.end (); - ++iter) - { - jit_instruction *instr = *iter; - instr->construct_ssa (); - instr->push_variable (); - } - - // finish phi nodes of successors - for (size_t i = 0; i < ablock.successor_count (); ++i) - { - jit_block *finish = ablock.successor (i); - - for (jit_block::iterator iter = finish->begin (); iter != finish->end () - && isa (*iter);) - { - jit_phi *phi = static_cast (*iter); - jit_variable *var = phi->dest (); - ++iter; - - if (var->has_top ()) - phi->add_incomming (&ablock, var->top ()); - else - { - // temporaries may have extranious phi nodes which can be removed - assert (! phi->use_count ()); - assert (var->name ().size () && var->name ()[0] == '#'); - phi->remove (); - } - } - } - - for (size_t i = 0; i < ablock.dom_successor_count (); ++i) - do_construct_ssa (*ablock.dom_successor (i), avisit_count); - - ablock.pop_all (); -} - -void -jit_infer::place_releases (void) -{ - std::set temporaries; - for (jit_block_list::iterator iter = blocks.begin (); iter != blocks.end (); - ++iter) - { - jit_block& ablock = **iter; - if (ablock.id () != jit_block::NO_ID) - { - release_temp (ablock, temporaries); - release_dead_phi (ablock); - } - } -} - -void -jit_infer::push_worklist (jit_instruction *instr) -{ - if (! instr->in_worklist ()) - { - instr->stash_in_worklist (true); - worklist.push_back (instr); - } -} - -void -jit_infer::remove_dead () -{ - jit_block_list::iterator biter; - for (biter = blocks.begin (); biter != blocks.end (); ++biter) - { - jit_block *b = *biter; - if (b->alive ()) - { - for (jit_block::iterator iter = b->begin (); iter != b->end () - && isa (*iter);) - { - jit_phi *phi = static_cast (*iter); - if (phi->prune ()) - iter = b->remove (iter); - else - ++iter; - } - } - } - - for (biter = blocks.begin (); biter != blocks.end ();) - { - jit_block *b = *biter; - if (b->alive ()) - { - // FIXME: A special case for jit_error_check, if we generalize to - // we will need to change! - jit_terminator *term = b->terminator (); - if (term && term->successor_count () == 2 && ! term->alive (0)) - { - jit_block *succ = term->successor (1); - term->remove (); - jit_branch *abreak = factory.create (succ); - b->append (abreak); - abreak->infer (); - } - - ++biter; - } - else - { - jit_terminator *term = b->terminator (); - if (term) - term->remove (); - biter = blocks.erase (biter); - } - } -} - -void -jit_infer::release_dead_phi (jit_block& ablock) -{ - jit_block::iterator iter = ablock.begin (); - while (iter != ablock.end () && isa (*iter)) - { - jit_phi *phi = static_cast (*iter); - ++iter; - - jit_use *use = phi->first_use (); - if (phi->use_count () == 1 && isa (use->user ())) - { - // instead of releasing on assign, release on all incomming branches, - // this can get rid of casts inside loops - for (size_t i = 0; i < phi->argument_count (); ++i) - { - jit_value *arg = phi->argument (i); - if (! arg->needs_release ()) - continue; - - jit_block *inc = phi->incomming (i); - jit_block *split = inc->maybe_split (factory, blocks, ablock); - jit_terminator *term = split->terminator (); - jit_call *release - = factory.create (jit_typeinfo::release, arg); - release->infer (); - split->insert_before (term, release); - } - - phi->replace_with (0); - phi->remove (); - } - } -} - -void -jit_infer::release_temp (jit_block& ablock, std::set& temp) -{ - for (jit_block::iterator iter = ablock.begin (); iter != ablock.end (); - ++iter) - { - jit_instruction *instr = *iter; - - // check for temporaries that require release and live across - // multiple blocks - if (instr->needs_release ()) - { - jit_block *fu_block = instr->first_use_block (); - if (fu_block && fu_block != &ablock && instr->needs_release ()) - temp.insert (instr); - } - - if (isa (instr)) - { - // place releases for temporary arguments - for (size_t i = 0; i < instr->argument_count (); ++i) - { - jit_value *arg = instr->argument (i); - if (! arg->needs_release ()) - continue; - - jit_call *release - = factory.create (&jit_typeinfo::release, arg); - release->infer (); - ablock.insert_after (iter, release); - ++iter; - temp.erase (arg); - } - } - } - - if (! temp.size () || ! isa (ablock.terminator ())) - return; - - // FIXME: If we support try/catch or unwind_protect final_block may not be the - // destination - jit_block *split = ablock.maybe_split (factory, blocks, final_block ()); - jit_terminator *term = split->terminator (); - for (std::set::const_iterator iter = temp.begin (); - iter != temp.end (); ++iter) - { - jit_value *value = *iter; - jit_call *release - = factory.create (&jit_typeinfo::release, value); - split->insert_before (term, release); - release->infer (); - } -} - -void -jit_infer::simplify_phi (void) -{ - for (jit_block_list::iterator biter = blocks.begin (); biter != blocks.end (); - ++biter) - { - jit_block &ablock = **biter; - for (jit_block::iterator iter = ablock.begin (); iter != ablock.end () - && isa (*iter); ++iter) - simplify_phi (*static_cast (*iter)); - } -} - -void -jit_infer::simplify_phi (jit_phi& phi) -{ - jit_block& pblock = *phi.parent (); - const jit_operation& cast_fn = jit_typeinfo::cast (phi.type ()); - jit_variable *dest = phi.dest (); - for (size_t i = 0; i < phi.argument_count (); ++i) - { - jit_value *arg = phi.argument (i); - if (arg->type () != phi.type ()) - { - jit_block *pred = phi.incomming (i); - jit_block *split = pred->maybe_split (factory, blocks, pblock); - jit_terminator *term = split->terminator (); - jit_instruction *cast = factory.create (cast_fn, arg); - jit_assign *assign = factory.create (dest, cast); - - split->insert_before (term, cast); - split->insert_before (term, assign); - cast->infer (); - assign->infer (); - phi.stash_argument (i, assign); - } - } -} - -// -------------------- tree_jit -------------------- - -tree_jit::tree_jit (void) : module (0), engine (0) -{ -} - -tree_jit::~tree_jit (void) -{} - -bool -tree_jit::execute (tree_simple_for_command& cmd, const octave_value& bounds) -{ - return instance ().do_execute (cmd, bounds); -} - -bool -tree_jit::execute (tree_while_command& cmd) -{ - return instance ().do_execute (cmd); -} - -bool -tree_jit::execute (octave_user_function& fcn, const octave_value_list& args, - octave_value_list& retval) -{ - return instance ().do_execute (fcn, args, retval); -} - -tree_jit& -tree_jit::instance (void) -{ - static tree_jit ret; - return ret; -} - -bool -tree_jit::initialize (void) -{ - if (engine) - return true; - - if (! module) - { - llvm::InitializeNativeTarget (); - module = new llvm::Module ("octave", context); - } - - // sometimes this fails pre main - engine = llvm::ExecutionEngine::createJIT (module); - - if (! engine) - return false; - - module_pass_manager = new llvm::PassManager (); - module_pass_manager->add (llvm::createAlwaysInlinerPass ()); - - pass_manager = new llvm::FunctionPassManager (module); - pass_manager->add (new llvm::TargetData(*engine->getTargetData ())); - pass_manager->add (llvm::createCFGSimplificationPass ()); - pass_manager->add (llvm::createBasicAliasAnalysisPass ()); - pass_manager->add (llvm::createPromoteMemoryToRegisterPass ()); - pass_manager->add (llvm::createInstructionCombiningPass ()); - pass_manager->add (llvm::createReassociatePass ()); - pass_manager->add (llvm::createGVNPass ()); - pass_manager->add (llvm::createCFGSimplificationPass ()); - pass_manager->doInitialization (); - - jit_typeinfo::initialize (module, engine); - - return true; -} - -bool -tree_jit::do_execute (tree_simple_for_command& cmd, const octave_value& bounds) -{ - const size_t MIN_TRIP_COUNT = 1000; - - size_t tc = trip_count (bounds); - if (! tc || ! initialize () || ! enabled ()) - return false; - - jit_info::vmap extra_vars; - extra_vars["#for_bounds0"] = &bounds; - - jit_info *info = cmd.get_info (); - if (! info || ! info->match (extra_vars)) - { - if (tc < MIN_TRIP_COUNT) - return false; - - delete info; - info = new jit_info (*this, cmd, bounds); - cmd.stash_info (info); - } - - return info->execute (extra_vars); -} - -bool -tree_jit::do_execute (tree_while_command& cmd) -{ - if (! initialize () || ! enabled ()) - return false; - - jit_info *info = cmd.get_info (); - if (! info || ! info->match ()) - { - delete info; - info = new jit_info (*this, cmd); - cmd.stash_info (info); - } - - return info->execute (); -} - -bool -tree_jit::do_execute (octave_user_function& fcn, const octave_value_list& args, - octave_value_list& retval) -{ - if (! initialize () || ! enabled ()) - return false; - - jit_function_info *info = fcn.get_info (); - if (! info || ! info->match (args)) - { - delete info; - info = new jit_function_info (*this, fcn, args); - fcn.stash_info (info); - } - - return info->execute (args, retval); -} - -bool -tree_jit::enabled (void) -{ - // Ideally, we should only disable JIT if there is a breakpoint in the code we - // are about to run. However, we can't figure this out in O(1) time, so we - // conservatively check for the existence of any breakpoints. - return Vjit_enable && ! bp_table::have_breakpoints () - && ! Vdebug_on_interrupt && ! Vdebug_on_error; -} - -size_t -tree_jit::trip_count (const octave_value& bounds) const -{ - if (bounds.is_range ()) - { - Range rng = bounds.range_value (); - return rng.nelem (); - } - - // unsupported type - return 0; -} - - -void -tree_jit::optimize (llvm::Function *fn) -{ - if (Vdebug_jit) - llvm::verifyModule (*module); - - module_pass_manager->run (*module); - pass_manager->run (*fn); - - if (Vdebug_jit) - { - std::string error; - llvm::raw_fd_ostream fout ("test.bc", error, - llvm::raw_fd_ostream::F_Binary); - llvm::WriteBitcodeToFile (module, fout); - } -} - -// -------------------- jit_function_info -------------------- -jit_function_info::jit_function_info (tree_jit& tjit, - octave_user_function& fcn, - const octave_value_list& ov_args) - : argument_types (ov_args.length ()), function (0) -{ - size_t nargs = ov_args.length (); - for (size_t i = 0; i < nargs; ++i) - argument_types[i] = jit_typeinfo::type_of (ov_args(i)); - - jit_function raw_fn; - jit_function wrapper; - - try - { - jit_convert conv (fcn, argument_types); - jit_infer infer (conv.get_factory (), conv.get_blocks (), - conv.get_variable_map ()); - infer.infer (); - - if (Vdebug_jit) - { - jit_block_list& blocks = infer.get_blocks (); - blocks.label (); - std::cout << "-------------------- Compiling function "; - std::cout << "--------------------\n"; - - tree_print_code tpc (std::cout); - tpc.visit_octave_user_function_header (fcn); - tpc.visit_statement_list (*fcn.body ()); - tpc.visit_octave_user_function_trailer (fcn); - blocks.print (std::cout, "octave jit ir"); - } - - jit_factory& factory = conv.get_factory (); - llvm::Module *module = tjit.get_module (); - jit_convert_llvm to_llvm; - raw_fn = to_llvm.convert_function (module, infer.get_blocks (), - factory.constants (), fcn, - argument_types); - - if (Vdebug_jit) - { - std::cout << "-------------------- raw function "; - std::cout << "--------------------\n"; - std::cout << *raw_fn.to_llvm () << std::endl; - llvm::verifyFunction (*raw_fn.to_llvm ()); - } - - std::string wrapper_name = fcn.name () + "_wrapper"; - jit_type *any_t = jit_typeinfo::get_any (); - std::vector wrapper_args (1, jit_typeinfo::get_any_ptr ()); - wrapper = jit_function (module, jit_convention::internal, wrapper_name, - any_t, wrapper_args); - - llvm::BasicBlock *wrapper_body = wrapper.new_block (); - builder.SetInsertPoint (wrapper_body); - - llvm::Value *wrapper_arg = wrapper.argument (builder, 0); - std::vector raw_args (nargs); - for (size_t i = 0; i < nargs; ++i) - { - llvm::Value *arg; - arg = builder.CreateConstInBoundsGEP1_32 (wrapper_arg, i); - arg = builder.CreateLoad (arg); - - jit_type *arg_type = argument_types[i]; - const jit_function& cast = jit_typeinfo::cast (arg_type, any_t); - raw_args[i] = cast.call (builder, arg); - } - - llvm::Value *result = raw_fn.call (builder, raw_args); - if (raw_fn.result ()) - { - jit_type *raw_result_t = raw_fn.result (); - const jit_function& cast = jit_typeinfo::cast (any_t, raw_result_t); - result = cast.call (builder, result); - } - else - { - llvm::Value *zero = builder.getInt32 (0); - result = builder.CreateBitCast (zero, any_t->to_llvm ()); - } - - wrapper.do_return (builder, result); - - llvm::Function *llvm_function = wrapper.to_llvm (); - tjit.optimize (llvm_function); - - if (Vdebug_jit) - { - std::cout << "-------------------- optimized and wrapped "; - std::cout << "--------------------\n"; - std::cout << *llvm_function << std::endl; - llvm::verifyFunction (*llvm_function); - } - - llvm::ExecutionEngine* engine = tjit.get_engine (); - void *void_fn = engine->getPointerToFunction (llvm_function); - function = reinterpret_cast (void_fn); - } - catch (const jit_fail_exception& e) - { - argument_types.clear (); - - if (Vdebug_jit) - { - if (e.known ()) - std::cout << "jit fail: " << e.what () << std::endl; - } - - wrapper.erase (); - raw_fn.erase (); - } -} - -bool -jit_function_info::execute (const octave_value_list& ov_args, - octave_value_list& retval) const -{ - if (! function) - return false; - - // TODO figure out a way to delete ov_args so we avoid duplicating refcount - size_t nargs = ov_args.length (); - std::vector args (nargs); - for (size_t i = 0; i < nargs; ++i) - { - octave_base_value *obv = ov_args(i).internal_rep (); - obv->grab (); - args[i] = obv; - } - - octave_base_value *ret = function (&args[0]); - if (ret) - retval(0) = octave_value (ret); - - octave_quit (); - - return true; -} - -bool -jit_function_info::match (const octave_value_list& ov_args) const -{ - if (! function) - return true; - - size_t nargs = ov_args.length (); - if (nargs != argument_types.size ()) - return false; - - for (size_t i = 0; i < nargs; ++i) - if (jit_typeinfo::type_of (ov_args(i)) != argument_types[i]) - return false; - - return true; -} - -// -------------------- jit_info -------------------- -jit_info::jit_info (tree_jit& tjit, tree& tee) - : engine (tjit.get_engine ()), function (0), llvm_function (0) -{ - compile (tjit, tee); -} - -jit_info::jit_info (tree_jit& tjit, tree& tee, const octave_value& for_bounds) - : engine (tjit.get_engine ()), function (0), llvm_function (0) -{ - compile (tjit, tee, jit_typeinfo::type_of (for_bounds)); -} - -jit_info::~jit_info (void) -{ - if (llvm_function) - llvm_function->eraseFromParent (); -} - -bool -jit_info::execute (const vmap& extra_vars) const -{ - if (! function) - return false; - - std::vector real_arguments (arguments.size ()); - for (size_t i = 0; i < arguments.size (); ++i) - { - if (arguments[i].second) - { - octave_value current = find (extra_vars, arguments[i].first); - octave_base_value *obv = current.internal_rep (); - obv->grab (); - real_arguments[i] = obv; - } - } - - function (&real_arguments[0]); - - for (size_t i = 0; i < arguments.size (); ++i) - { - const std::string& name = arguments[i].first; - - // do not store for loop bounds temporary - if (name.size () && name[0] != '#') - symbol_table::assign (arguments[i].first, real_arguments[i]); - } - - octave_quit (); - - return true; -} - -bool -jit_info::match (const vmap& extra_vars) const -{ - if (! function) - return true; - - for (size_t i = 0; i < bounds.size (); ++i) - { - const std::string& arg_name = bounds[i].second; - octave_value value = find (extra_vars, arg_name); - jit_type *type = jit_typeinfo::type_of (value); - - // FIXME: Check for a parent relationship - if (type != bounds[i].first) - return false; - } - - return true; -} - -void -jit_info::compile (tree_jit& tjit, tree& tee, jit_type *for_bounds) -{ - try - { - jit_convert conv (tee, for_bounds); - jit_infer infer (conv.get_factory (), conv.get_blocks (), - conv.get_variable_map ()); - - infer.infer (); - - if (Vdebug_jit) - { - jit_block_list& blocks = infer.get_blocks (); - blocks.label (); - std::cout << "-------------------- Compiling tree --------------------\n"; - std::cout << tee.str_print_code () << std::endl; - blocks.print (std::cout, "octave jit ir"); - } - - jit_factory& factory = conv.get_factory (); - jit_convert_llvm to_llvm; - llvm_function = to_llvm.convert_loop (tjit.get_module (), - infer.get_blocks (), - factory.constants ()); - arguments = to_llvm.get_arguments (); - bounds = conv.get_bounds (); - } - catch (const jit_fail_exception& e) - { - if (Vdebug_jit) - { - if (e.known ()) - std::cout << "jit fail: " << e.what () << std::endl; - } - } - - if (llvm_function) - { - if (Vdebug_jit) - { - std::cout << "-------------------- llvm ir --------------------"; - std::cout << *llvm_function << std::endl; - llvm::verifyFunction (*llvm_function); - } - - tjit.optimize (llvm_function); - - if (Vdebug_jit) - { - std::cout << "-------------------- optimized llvm ir " - << "--------------------\n"; - std::cout << *llvm_function << std::endl; - } - - void *void_fn = engine->getPointerToFunction (llvm_function); - function = reinterpret_cast (void_fn); - } -} - -octave_value -jit_info::find (const vmap& extra_vars, const std::string& vname) const -{ - vmap::const_iterator iter = extra_vars.find (vname); - return iter == extra_vars.end () ? symbol_table::varval (vname) - : *iter->second; -} - -#endif - -DEFUN (debug_jit, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} debug_jit ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} debug_jit (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} debug_jit (@var{new_val}, \"local\")\n\ -Query or set the internal variable that determines whether\n\ -debugging/tracing is enabled for Octave's JIT compiler.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{jit_enable}\n\ -@end deftypefn") -{ -#if defined (HAVE_LLVM) - return SET_INTERNAL_VARIABLE (debug_jit); -#else - warning ("debug_jit: JIT compiling not available in this version of Octave"); - return octave_value (); -#endif -} - -DEFUN (jit_enable, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} jit_enable ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} jit_enable (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} jit_enable (@var{new_val}, \"local\")\n\ -Query or set the internal variable that enables Octave's JIT compiler.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{debug_jit}\n\ -@end deftypefn") -{ -#if defined (HAVE_LLVM) - return SET_INTERNAL_VARIABLE (jit_enable); -#else - warning ("jit_enable: JIT compiling not available in this version of Octave"); - return octave_value (); -#endif -} - -/* -Test some simple cases that compile. - -%!test -%! for i=1:1e6 -%! if i < 5 -%! break -%! else -%! break -%! endif -%! endfor -%! assert (i, 1); - -%!test -%! while 1 -%! if 1 -%! break -%! else -%! break -%! endif -%! endwhile - -%!test -%! for i=1:1e6 -%! if i == 100 -%! break -%! endif -%! endfor -%! assert (i, 100); - -%!test -%! inc = 1e-5; -%! result = 0; -%! for ii = 0:inc:1 -%! result = result + inc * (1/3 * ii * ii); -%! endfor -%! assert (abs (result - 1/9) < 1e-5); - -%!test -%! inc = 1e-5; -%! result = 0; -%! for ii = 0:inc:1 -%! # the ^ operator's result is complex -%! result = result + inc * (1/3 * ii ^ 2); -%! endfor -%! assert (abs (result - 1/9) < 1e-5); - -%!test -%! temp = 1+1i; -%! nan = NaN; -%! while 1 -%! temp = temp - 1i; -%! temp = temp * nan; -%! break; -%! endwhile -%! assert (imag (temp), 0); - -%!test -%! temp = 1+1i; -%! nan = NaN+1i; -%! while 1 -%! nan = nan - 1i; -%! temp = temp - 1i; -%! temp = temp * nan; -%! break; -%! endwhile -%! assert (imag (temp), 0); - -%!test -%! temp = 1+1i; -%! while 1 -%! temp = temp * 5; -%! break; -%! endwhile -%! assert (temp, 5+5i); - -%!test -%! nr = 1001; -%! mat = zeros (1, nr); -%! for i = 1:nr -%! mat(i) = i; -%! endfor -%! assert (mat == 1:nr); - -%!test -%! nr = 1001; -%! mat = 1:nr; -%! mat(end) = 0; # force mat to a matrix -%! total = 0; -%! for i = 1:nr -%! total = mat(i) + total; -%! endfor -%! assert (sum (mat) == total); - -%!test -%! nr = 1001; -%! mat = [3 1 5]; -%! try -%! for i = 1:nr -%! if i > 500 -%! result = mat(100); -%! else -%! result = i; -%! endif -%! endfor -%! catch -%! end -%! assert (result == 500); - -%!function result = gen_test (n) -%! result = double (rand (1, n) > .01); -%!endfunction - -%!function z = vectorized (A, K) -%! temp = ones (1, K); -%! z = conv (A, temp); -%! z = z > K-1; -%! z = conv (z, temp); -%! z = z(K:end-K+1); -%! z = z >= 1; -%!endfunction - -%!function z = loopy (A, K) -%! z = A; -%! n = numel (A); -%! counter = 0; -%! for ii=1:n -%! if z(ii) -%! counter = counter + 1; -%! else -%! if counter > 0 && counter < K -%! z(ii-counter:ii-1) = 0; -%! endif -%! counter = 0; -%! endif -%! endfor -%! -%! if counter > 0 && counter < K -%! z(end-counter+1:end) = 0; -%! endif -%!endfunction - -%!test -%! test_set = gen_test (10000); -%! assert (all (vectorized (test_set, 3) == loopy (test_set, 3))); - -%!test -%! niter = 1001; -%! i = 0; -%! while (i < niter) -%! i = i + 1; -%! endwhile -%! assert (i == niter); - -%!test -%! niter = 1001; -%! result = 0; -%! m = [5 10]; -%! for i=1:niter -%! result = result + m(end); -%! endfor -%! assert (result == m(end) * niter); - -%!test -%! ndim = 100; -%! result = 0; -%! m = zeros (ndim); -%! m(:) = 1:ndim^2; -%! i = 1; -%! while (i <= ndim) -%! for j = 1:ndim -%! result = result + m(i, j); -%! endfor -%! i = i + 1; -%! endwhile -%! assert (result == sum (sum (m))); - -%!test -%! ndim = 100; -%! m = zeros (ndim); -%! i = 1; -%! while (i <= ndim) -%! for j = 1:ndim -%! m(i, j) = (j - 1) * ndim + i; -%! endfor -%! i = i + 1; -%! endwhile -%! m2 = zeros (ndim); -%! m2(:) = 1:(ndim^2); -%! assert (all (m == m2)); - -%!test -%! ndim = 2; -%! m = zeros (ndim, ndim, ndim, ndim); -%! result = 0; -%! i0 = 1; -%! while (i0 <= ndim) -%! for i1 = 1:ndim -%! for i2 = 1:ndim -%! for i3 = 1:ndim -%! m(i0, i1, i2, i3) = 1; -%! m(i0, i1, i2, i3, 1, 1, 1, 1, 1, 1) = 1; -%! result = result + m(i0, i1, i2, i3); -%! endfor -%! endfor -%! endfor -%! i0 = i0 + 1; -%! endwhile -%! expected = ones (ndim, ndim, ndim, ndim); -%! assert (all (m == expected)); -%! assert (result == sum (expected (:))); - -%!function test_divide () -%! state = warning ("query", "Octave:divide-by-zero").state; -%! unwind_protect -%! warning ("error", "Octave:divide-by-zero"); -%! for i=1:1e5 -%! a = 1; -%! a / 0; -%! endfor -%! unwind_protect_cleanup -%! warning (state, "Octave:divide-by-zero"); -%! end_unwind_protect -%!endfunction - -%!error test_divide () - -%!test -%! while 1 -%! a = 0; -%! result = a / 1; -%! break; -%! endwhile -%! assert (result, 0); - -%!test -%! m = zeros (2, 1001); -%! for i=1:1001 -%! m(end, i) = i; -%! m(end - 1, end - i + 1) = i; -%! endfor -%! m2 = zeros (2, 1001); -%! m2(1, :) = fliplr (1:1001); -%! m2(2, :) = 1:1001; -%! assert (m, m2); - -%!test -%! m = [1 2 3]; -%! for i=1:1001 -%! m = sin (m); -%! break; -%! endfor -%! assert (m == sin ([1 2 3])); - -%!test -%! i = 0; -%! while i < 10 -%! i += 1; -%! endwhile -%! assert (i == 10); - -%!test -%! i = 0; -%! while i < 10 -%! a = ++i; -%! endwhile -%! assert (i == 10); -%! assert (a == 10); -%!test -%! i = 0; -%! while i < 10 -%! a = i++; -%! endwhile -%! assert (i == 10); -%! assert (a == 9); - -%!test -%! num = 2; -%! a = zeros (1, num); -%! i = 1; -%! while i <= num -%! a(i) = norm (eye (i)); -%! ++i; -%! endwhile -%! assert (a, ones (1, num)); - -%!function test_compute_idom () -%! while (li <= length (l1) && si <= length (s1)) -%! if (l1 (li) < s1 (si)) -%! if (li == si) -%! break; -%! endif; -%! li++; -%! else -%! si++; -%! endif; -%! endwhile - -%!error test_compute_idom () - -%!function x = test_overload (a) -%! while 1 -%! x = a; -%! break; -%! endwhile -%!endfunction - -%!assert (test_overload (1), 1); -%!assert (test_overload ([1 2]), [1 2]); - -%!function a = bubble (a = [3 2 1]) -%! swapped = 1; -%! n = length (a); -%! while (swapped) -%! swapped = 0; -%! for i = 1:n-1 -%! if a(i) > a(i + 1) -%! swapped = 1; -%! temp = a(i); -%! a(i) = a(i + 1); -%! a(i + 1) = temp; -%! endif -%! endfor -%! endwhile -%!endfunction - -%!assert (bubble (), [1 2 3]); - -%!test -%! a = 0; -%! b = 1; -%! for i=1:1e3 -%! for j=1:2 -%! a = a + b; -%! endfor -%! endfor -%! assert (a, 2000); -%! assert (b, 1); - -%!test -%! a = [1+1i 1+2i]; -%! b = 0; -%! while 1 -%! b = a(1); -%! break; -%! endwhile -%! assert (b, a(1)); - -%!function test_undef () -%! for i=1:1e7 -%! XXX; -%! endfor -%!endfunction - -%!error (test_undef); - -%!shared id -%! id = @(x) x; - -%!assert (id (1), 1); -%!assert (id (1+1i), 1+1i) -%!assert (id (1, 2), 1) -%!error (id ()) - - -*/ diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/pt-jit.h --- a/libinterp/interp-core/pt-jit.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,444 +0,0 @@ -/* - -Copyright (C) 2012 Max Brister - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Author: Max Brister - -#if !defined (octave_tree_jit_h) -#define octave_tree_jit_h 1 - -#ifdef HAVE_LLVM - -#include "jit-ir.h" -#include "pt-walk.h" -#include "symtab.h" - -class octave_value_list; - -// Convert from the parse tree (AST) to the low level Octave IR. -class -jit_convert : public tree_walker -{ -public: - typedef std::pair type_bound; - typedef std::vector type_bound_vector; - typedef std::map variable_map; - - jit_convert (tree &tee, jit_type *for_bounds = 0); - - jit_convert (octave_user_function& fcn, const std::vector& args); - -#define DECL_ARG(n) const ARG ## n& arg ## n -#define JIT_CREATE_CHECKED(N) \ - template \ - jit_call *create_checked (OCT_MAKE_LIST (DECL_ARG, N)) \ - { \ - jit_call *ret = factory.create (OCT_MAKE_ARG_LIST (arg, N)); \ - return create_checked_impl (ret); \ - } - - JIT_CREATE_CHECKED (1) - JIT_CREATE_CHECKED (2) - JIT_CREATE_CHECKED (3) - JIT_CREATE_CHECKED (4) - -#undef JIT_CREATE_CHECKED -#undef DECL_ARG - - jit_block_list& get_blocks (void) { return blocks; } - - const type_bound_vector& get_bounds (void) const { return bounds; } - - jit_factory& get_factory (void) { return factory; } - - llvm::Function *get_function (void) const { return function; } - - const variable_map &get_variable_map (void) const { return vmap; } - - void visit_anon_fcn_handle (tree_anon_fcn_handle&); - - void visit_argument_list (tree_argument_list&); - - void visit_binary_expression (tree_binary_expression&); - - void visit_break_command (tree_break_command&); - - void visit_colon_expression (tree_colon_expression&); - - void visit_continue_command (tree_continue_command&); - - void visit_global_command (tree_global_command&); - - void visit_persistent_command (tree_persistent_command&); - - void visit_decl_elt (tree_decl_elt&); - - void visit_decl_init_list (tree_decl_init_list&); - - void visit_simple_for_command (tree_simple_for_command&); - - void visit_complex_for_command (tree_complex_for_command&); - - void visit_octave_user_script (octave_user_script&); - - void visit_octave_user_function (octave_user_function&); - - void visit_octave_user_function_header (octave_user_function&); - - void visit_octave_user_function_trailer (octave_user_function&); - - void visit_function_def (tree_function_def&); - - void visit_identifier (tree_identifier&); - - void visit_if_clause (tree_if_clause&); - - void visit_if_command (tree_if_command&); - - void visit_if_command_list (tree_if_command_list&); - - void visit_index_expression (tree_index_expression&); - - void visit_matrix (tree_matrix&); - - void visit_cell (tree_cell&); - - void visit_multi_assignment (tree_multi_assignment&); - - void visit_no_op_command (tree_no_op_command&); - - void visit_constant (tree_constant&); - - void visit_fcn_handle (tree_fcn_handle&); - - void visit_parameter_list (tree_parameter_list&); - - void visit_postfix_expression (tree_postfix_expression&); - - void visit_prefix_expression (tree_prefix_expression&); - - void visit_return_command (tree_return_command&); - - void visit_return_list (tree_return_list&); - - void visit_simple_assignment (tree_simple_assignment&); - - void visit_statement (tree_statement&); - - void visit_statement_list (tree_statement_list&); - - void visit_switch_case (tree_switch_case&); - - void visit_switch_case_list (tree_switch_case_list&); - - void visit_switch_command (tree_switch_command&); - - void visit_try_catch_command (tree_try_catch_command&); - - void visit_unwind_protect_command (tree_unwind_protect_command&); - - void visit_while_command (tree_while_command&); - - void visit_do_until_command (tree_do_until_command&); -private: - std::vector > arguments; - type_bound_vector bounds; - - bool converting_function; - - // the scope of the function we are converting, or the current scope - symbol_table::scope_id scope; - - jit_factory factory; - - // used instead of return values from visit_* functions - jit_value *result; - - jit_block *entry_block; - - jit_block *final_block; - - jit_block *block; - - llvm::Function *function; - - jit_block_list blocks; - - std::vector end_context; - - size_t iterator_count; - size_t for_bounds_count; - size_t short_count; - - variable_map vmap; - - void initialize (symbol_table::scope_id s); - - jit_call *create_checked_impl (jit_call *ret); - - // get an existing vairable. If the variable does not exist, it will not be - // created - jit_variable *find_variable (const std::string& vname) const; - - // get a variable, create it if it does not exist. The type will default to - // the variable's current type in the symbol table. - jit_variable *get_variable (const std::string& vname); - - // create a variable of the given name and given type. Will also insert an - // extract statement - jit_variable *create_variable (const std::string& vname, jit_type *type, - bool isarg = true); - - // The name of the next for loop iterator. If inc is false, then the iterator - // counter will not be incremented. - std::string next_iterator (bool inc = true) - { return next_name ("#iter", iterator_count, inc); } - - std::string next_for_bounds (bool inc = true) - { return next_name ("#for_bounds", for_bounds_count, inc); } - - std::string next_shortcircut_result (bool inc = true) - { return next_name ("#shortcircut_result", short_count, inc); } - - std::string next_name (const char *prefix, size_t& count, bool inc); - - jit_instruction *resolve (tree_index_expression& exp, - jit_value *extra_arg = 0, bool lhs = false); - - jit_value *do_assign (tree_expression *exp, jit_value *rhs, - bool artificial = false); - - jit_value *do_assign (const std::string& lhs, jit_value *rhs, bool print, - bool artificial = false); - - jit_value *visit (tree *tee) { return visit (*tee); } - - jit_value *visit (tree& tee); - - typedef std::list block_list; - block_list breaks; - block_list continues; - - void finish_breaks (jit_block *dest, const block_list& lst); -}; - -// Convert from the low level Octave IR to LLVM -class -jit_convert_llvm : public jit_ir_walker -{ -public: - llvm::Function *convert_loop (llvm::Module *module, - const jit_block_list& blocks, - const std::list& constants); - - jit_function convert_function (llvm::Module *module, - const jit_block_list& blocks, - const std::list& constants, - octave_user_function& fcn, - const std::vector& args); - - // arguments to the llvm::Function for loops - const std::vector >& get_arguments(void) const - { return argument_vec; } - -#define JIT_METH(clname) \ - virtual void visit (jit_ ## clname&); - - JIT_VISIT_IR_CLASSES; - -#undef JIT_METH -private: - // name -> argument index (used for compiling functions) - std::map argument_index; - - std::vector > argument_vec; - - // name -> llvm argument (used for compiling loops) - std::map arguments; - - bool converting_function; - - // only used if we are converting a function - jit_function creating; - - llvm::Function *function; - llvm::BasicBlock *prelude; - - void convert (const jit_block_list& blocks, - const std::list& constants); - - void finish_phi (jit_phi *phi); - - void visit (jit_value *jvalue) - { - return visit (*jvalue); - } - - void visit (jit_value &jvalue) - { - jvalue.accept (*this); - } -}; - -// type inference and SSA construction on the low level Octave IR -class -jit_infer -{ -public: - typedef jit_convert::variable_map variable_map; - - jit_infer (jit_factory& afactory, jit_block_list& ablocks, - const variable_map& avmap); - - jit_block_list& get_blocks (void) const { return blocks; } - - jit_factory& get_factory (void) const { return factory; } - - void infer (void); -private: - jit_block_list& blocks; - jit_factory& factory; - const variable_map& vmap; - std::list worklist; - - void append_users (jit_value *v); - - void append_users_term (jit_terminator *term); - - void construct_ssa (void); - - void do_construct_ssa (jit_block& block, size_t avisit_count); - - jit_block& entry_block (void) { return *blocks.front (); } - - jit_block& final_block (void) { return *blocks.back (); } - - void place_releases (void); - - void push_worklist (jit_instruction *instr); - - void remove_dead (); - - void release_dead_phi (jit_block& ablock); - - void release_temp (jit_block& ablock, std::set& temp); - - void simplify_phi (void); - - void simplify_phi (jit_phi& phi); -}; - -class -tree_jit -{ -public: - ~tree_jit (void); - - static bool execute (tree_simple_for_command& cmd, - const octave_value& bounds); - - static bool execute (tree_while_command& cmd); - - static bool execute (octave_user_function& fcn, const octave_value_list& args, - octave_value_list& retval); - - llvm::ExecutionEngine *get_engine (void) const { return engine; } - - llvm::Module *get_module (void) const { return module; } - - void optimize (llvm::Function *fn); - private: - tree_jit (void); - - static tree_jit& instance (void); - - bool initialize (void); - - bool do_execute (tree_simple_for_command& cmd, const octave_value& bounds); - - bool do_execute (tree_while_command& cmd); - - bool do_execute (octave_user_function& fcn, const octave_value_list& args, - octave_value_list& retval); - - bool enabled (void); - - size_t trip_count (const octave_value& bounds) const; - - llvm::Module *module; - llvm::PassManager *module_pass_manager; - llvm::FunctionPassManager *pass_manager; - llvm::ExecutionEngine *engine; -}; - -class -jit_function_info -{ -public: - jit_function_info (tree_jit& tjit, octave_user_function& fcn, - const octave_value_list& ov_args); - - bool execute (const octave_value_list& ov_args, - octave_value_list& retval) const; - - bool match (const octave_value_list& ov_args) const; -private: - typedef octave_base_value *(*jited_function)(octave_base_value**); - - std::vector argument_types; - jited_function function; -}; - -class -jit_info -{ -public: - // we use a pointer here so we don't have to include ov.h - typedef std::map vmap; - - jit_info (tree_jit& tjit, tree& tee); - - jit_info (tree_jit& tjit, tree& tee, const octave_value& for_bounds); - - ~jit_info (void); - - bool execute (const vmap& extra_vars = vmap ()) const; - - bool match (const vmap& extra_vars = vmap ()) const; -private: - typedef jit_convert::type_bound type_bound; - typedef jit_convert::type_bound_vector type_bound_vector; - typedef void (*jited_function)(octave_base_value**); - - void compile (tree_jit& tjit, tree& tee, jit_type *for_bounds = 0); - - octave_value find (const vmap& extra_vars, const std::string& vname) const; - - llvm::ExecutionEngine *engine; - jited_function function; - llvm::Function *llvm_function; - - std::vector > arguments; - type_bound_vector bounds; -}; - -#endif -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/siglist.c --- a/libinterp/interp-core/siglist.c Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,238 +0,0 @@ -/* - -Copyright (C) 2000-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "siglist.h" - -/* The following is all borrowed from Emacs. */ - -#if ! (defined HAVE_STRSIGNAL || HAVE_DECL_SYS_SIGLIST) - -static char *my_sys_siglist[NSIG]; - -#ifdef sys_siglist -#undef sys_siglist -#endif -#define sys_siglist my_sys_siglist - -#endif - -void -init_signals (void) -{ -#if ! (defined HAVE_STRSIGNAL || HAVE_DECL_SYS_SIGLIST) - - static int initialized = 0; - - if (! initialized) - { - initialized = 1; - -# ifdef SIGABRT - sys_siglist[SIGABRT] = "Aborted"; -# endif -# ifdef SIGAIO - sys_siglist[SIGAIO] = "LAN I/O interrupt"; -# endif -# ifdef SIGALRM - sys_siglist[SIGALRM] = "Alarm clock"; -# endif -# ifdef SIGBUS - sys_siglist[SIGBUS] = "Bus error"; -# endif -# ifdef SIGCLD - sys_siglist[SIGCLD] = "Child status changed"; -# endif -# ifdef SIGCHLD - sys_siglist[SIGCHLD] = "Child status changed"; -# endif -# ifdef SIGCONT - sys_siglist[SIGCONT] = "Continued"; -# endif -# ifdef SIGDANGER - sys_siglist[SIGDANGER] = "Swap space dangerously low"; -# endif -# ifdef SIGDGNOTIFY - sys_siglist[SIGDGNOTIFY] = "Notification message in queue"; -# endif -# ifdef SIGEMT - sys_siglist[SIGEMT] = "Emulation trap"; -# endif -# ifdef SIGFPE - sys_siglist[SIGFPE] = "Arithmetic exception"; -# endif -# ifdef SIGFREEZE - sys_siglist[SIGFREEZE] = "SIGFREEZE"; -# endif -# ifdef SIGGRANT - sys_siglist[SIGGRANT] = "Monitor mode granted"; -# endif -# ifdef SIGHUP - sys_siglist[SIGHUP] = "Hangup"; -# endif -# ifdef SIGILL - sys_siglist[SIGILL] = "Illegal instruction"; -# endif -# ifdef SIGINT - sys_siglist[SIGINT] = "Interrupt"; -# endif -# ifdef SIGIO - sys_siglist[SIGIO] = "I/O possible"; -# endif -# ifdef SIGIOINT - sys_siglist[SIGIOINT] = "I/O intervention required"; -# endif -# ifdef SIGIOT - sys_siglist[SIGIOT] = "IOT trap"; -# endif -# ifdef SIGKILL - sys_siglist[SIGKILL] = "Killed"; -# endif -# ifdef SIGLOST - sys_siglist[SIGLOST] = "Resource lost"; -# endif -# ifdef SIGLWP - sys_siglist[SIGLWP] = "SIGLWP"; -# endif -# ifdef SIGMSG - sys_siglist[SIGMSG] = "Monitor mode data available"; -# endif -# ifdef SIGPHONE - sys_siglist[SIGPHONE] = "SIGPHONE"; -# endif -# ifdef SIGPIPE - sys_siglist[SIGPIPE] = "Broken pipe"; -# endif -# ifdef SIGPOLL - sys_siglist[SIGPOLL] = "Pollable event occurred"; -# endif -# ifdef SIGPROF - sys_siglist[SIGPROF] = "Profiling timer expired"; -# endif -# ifdef SIGPTY - sys_siglist[SIGPTY] = "PTY I/O interrupt"; -# endif -# ifdef SIGPWR - sys_siglist[SIGPWR] = "Power-fail restart"; -# endif -# ifdef SIGQUIT - sys_siglist[SIGQUIT] = "Quit"; -# endif -# ifdef SIGRETRACT - sys_siglist[SIGRETRACT] = "Need to relinguish monitor mode"; -# endif -# ifdef SIGSAK - sys_siglist[SIGSAK] = "Secure attention"; -# endif -# ifdef SIGSEGV - sys_siglist[SIGSEGV] = "Segmentation violation"; -# endif -# ifdef SIGSOUND - sys_siglist[SIGSOUND] = "Sound completed"; -# endif -# ifdef SIGSTKFLT - sys_siglist[SIGSTKFLT] = "Stack fault"; -# endif -# ifdef SIGSTOP - sys_siglist[SIGSTOP] = "Stopped (signal)"; -# endif -# ifdef SIGSTP - sys_siglist[SIGSTP] = "Stopped (user)"; -# endif -# ifdef SIGSYS - sys_siglist[SIGSYS] = "Bad argument to system call"; -# endif -# ifdef SIGTERM - sys_siglist[SIGTERM] = "Terminated"; -# endif -# ifdef SIGTHAW - sys_siglist[SIGTHAW] = "SIGTHAW"; -# endif -# ifdef SIGTRAP - sys_siglist[SIGTRAP] = "Trace/breakpoint trap"; -# endif -# ifdef SIGTSTP - sys_siglist[SIGTSTP] = "Stopped (user)"; -# endif -# ifdef SIGTTIN - sys_siglist[SIGTTIN] = "Stopped (tty input)"; -# endif -# ifdef SIGTTOU - sys_siglist[SIGTTOU] = "Stopped (tty output)"; -# endif -# ifdef SIGUNUSED - sys_siglist[SIGUNUSED] = "SIGUNUSED"; -# endif -# ifdef SIGURG - sys_siglist[SIGURG] = "Urgent I/O condition"; -# endif -# ifdef SIGUSR1 - sys_siglist[SIGUSR1] = "User defined signal 1"; -# endif -# ifdef SIGUSR2 - sys_siglist[SIGUSR2] = "User defined signal 2"; -# endif -# ifdef SIGVTALRM - sys_siglist[SIGVTALRM] = "Virtual timer expired"; -# endif -# ifdef SIGWAITING - sys_siglist[SIGWAITING] = "Process's LWPs are blocked"; -# endif -# ifdef SIGWINCH - sys_siglist[SIGWINCH] = "Window size changed"; -# endif -# ifdef SIGWIND - sys_siglist[SIGWIND] = "SIGWIND"; -# endif -# ifdef SIGXCPU - sys_siglist[SIGXCPU] = "CPU time limit exceeded"; -# endif -# ifdef SIGXFSZ - sys_siglist[SIGXFSZ] = "File size limit exceeded"; -# endif - } - -#endif -} - -#if ! defined (HAVE_STRSIGNAL) - -char * -strsignal (int code) -{ - char *signame = ""; - - if (0 <= code && code < NSIG) - { - /* Cast to suppress warning if the table has const char *. */ - signame = (char *) sys_siglist[code]; - } - - return signame; -} - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/siglist.h --- a/libinterp/interp-core/siglist.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,47 +0,0 @@ -/* - -Copyright (C) 2000-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_siglist_h) -#define octave_siglist_h 1 - -#ifdef __cplusplus -extern "C" -{ -#endif - -/* This is borrowed from Emacs. */ - -#if ! defined (HAVE_DECL_SYS_SIGLIST) -extern char *sys_siglist[]; -#endif - -extern void init_signals (void); - -#if ! defined (HAVE_STRSIGNAL) -extern char *strsignal (int); -#endif - -#ifdef __cplusplus -} -#endif - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/sparse-xdiv.cc --- a/libinterp/interp-core/sparse-xdiv.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,633 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "Array-util.h" -#include "oct-cmplx.h" -#include "quit.h" -#include "error.h" -#include "lo-ieee.h" - -#include "dSparse.h" -#include "dDiagMatrix.h" -#include "CSparse.h" -#include "CDiagMatrix.h" -#include "oct-spparms.h" -#include "sparse-xdiv.h" - -static void -solve_singularity_warning (double rcond) -{ - warning ("matrix singular to machine precision, rcond = %g", rcond); - warning ("attempting to find minimum norm solution"); -} - -template -bool -mx_leftdiv_conform (const T1& a, const T2& b) -{ - octave_idx_type a_nr = a.rows (); - octave_idx_type b_nr = b.rows (); - - if (a_nr != b_nr) - { - octave_idx_type a_nc = a.cols (); - octave_idx_type b_nc = b.cols (); - - gripe_nonconformant ("operator \\", a_nr, a_nc, b_nr, b_nc); - return false; - } - - return true; -} - -#define INSTANTIATE_MX_LEFTDIV_CONFORM(T1, T2) \ - template bool mx_leftdiv_conform (const T1&, const T2&) - -INSTANTIATE_MX_LEFTDIV_CONFORM (SparseMatrix, SparseMatrix); -INSTANTIATE_MX_LEFTDIV_CONFORM (SparseMatrix, SparseComplexMatrix); -INSTANTIATE_MX_LEFTDIV_CONFORM (SparseComplexMatrix, SparseMatrix); -INSTANTIATE_MX_LEFTDIV_CONFORM (SparseComplexMatrix, SparseComplexMatrix); -INSTANTIATE_MX_LEFTDIV_CONFORM (SparseMatrix, Matrix); -INSTANTIATE_MX_LEFTDIV_CONFORM (SparseMatrix, ComplexMatrix); -INSTANTIATE_MX_LEFTDIV_CONFORM (SparseComplexMatrix, Matrix); -INSTANTIATE_MX_LEFTDIV_CONFORM (SparseComplexMatrix, ComplexMatrix); -INSTANTIATE_MX_LEFTDIV_CONFORM (DiagMatrix, SparseMatrix); -INSTANTIATE_MX_LEFTDIV_CONFORM (DiagMatrix, SparseComplexMatrix); -INSTANTIATE_MX_LEFTDIV_CONFORM (ComplexDiagMatrix, SparseMatrix); -INSTANTIATE_MX_LEFTDIV_CONFORM (ComplexDiagMatrix, SparseComplexMatrix); - -template -bool -mx_div_conform (const T1& a, const T2& b) -{ - octave_idx_type a_nc = a.cols (); - octave_idx_type b_nc = b.cols (); - - if (a_nc != b_nc) - { - octave_idx_type a_nr = a.rows (); - octave_idx_type b_nr = b.rows (); - - gripe_nonconformant ("operator /", a_nr, a_nc, b_nr, b_nc); - return false; - } - - return true; -} - -#define INSTANTIATE_MX_DIV_CONFORM(T1, T2) \ - template bool mx_div_conform (const T1&, const T2&) - -INSTANTIATE_MX_DIV_CONFORM (SparseMatrix, SparseMatrix); -INSTANTIATE_MX_DIV_CONFORM (SparseMatrix, SparseComplexMatrix); -INSTANTIATE_MX_DIV_CONFORM (SparseComplexMatrix, SparseMatrix); -INSTANTIATE_MX_DIV_CONFORM (SparseComplexMatrix, SparseComplexMatrix); -INSTANTIATE_MX_DIV_CONFORM (Matrix, SparseMatrix); -INSTANTIATE_MX_DIV_CONFORM (Matrix, SparseComplexMatrix); -INSTANTIATE_MX_DIV_CONFORM (ComplexMatrix, SparseMatrix); -INSTANTIATE_MX_DIV_CONFORM (ComplexMatrix, SparseComplexMatrix); -INSTANTIATE_MX_DIV_CONFORM (SparseMatrix, DiagMatrix); -INSTANTIATE_MX_DIV_CONFORM (SparseMatrix, ComplexDiagMatrix); -INSTANTIATE_MX_DIV_CONFORM (SparseComplexMatrix, DiagMatrix); -INSTANTIATE_MX_DIV_CONFORM (SparseComplexMatrix, ComplexDiagMatrix); - -// Right division functions. X / Y = X * inv (Y) = (inv (Y') * X')' -// -// Y / X: m cm sm scm -// +-- +---+----+----+----+ -// sparse matrix | 1 | 3 | 5 | 7 | -// +---+----+----+----+ -// sparse complex_matrix | 2 | 4 | 6 | 8 | -// +---+----+----+----+ -// diagonal matrix | 9 | 11 | -// +----+----+ -// complex diag. matrix | 10 | 12 | -// +----+----+ - -// -*- 1 -*- -Matrix -xdiv (const Matrix& a, const SparseMatrix& b, MatrixType &typ) -{ - if (! mx_div_conform (a, b)) - return Matrix (); - - Matrix atmp = a.transpose (); - SparseMatrix btmp = b.transpose (); - MatrixType btyp = typ.transpose (); - - octave_idx_type info; - double rcond = 0.0; - Matrix result = btmp.solve (btyp, atmp, info, rcond, - solve_singularity_warning); - - typ = btyp.transpose (); - return result.transpose (); -} - -// -*- 2 -*- -ComplexMatrix -xdiv (const Matrix& a, const SparseComplexMatrix& b, MatrixType &typ) -{ - if (! mx_div_conform (a, b)) - return ComplexMatrix (); - - Matrix atmp = a.transpose (); - SparseComplexMatrix btmp = b.hermitian (); - MatrixType btyp = typ.transpose (); - - octave_idx_type info; - double rcond = 0.0; - ComplexMatrix result - = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); - - typ = btyp.transpose (); - return result.hermitian (); -} - -// -*- 3 -*- -ComplexMatrix -xdiv (const ComplexMatrix& a, const SparseMatrix& b, MatrixType &typ) -{ - if (! mx_div_conform (a, b)) - return ComplexMatrix (); - - ComplexMatrix atmp = a.hermitian (); - SparseMatrix btmp = b.transpose (); - MatrixType btyp = typ.transpose (); - - octave_idx_type info; - double rcond = 0.0; - ComplexMatrix result - = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); - - typ = btyp.transpose (); - return result.hermitian (); -} - -// -*- 4 -*- -ComplexMatrix -xdiv (const ComplexMatrix& a, const SparseComplexMatrix& b, MatrixType &typ) -{ - if (! mx_div_conform (a, b)) - return ComplexMatrix (); - - ComplexMatrix atmp = a.hermitian (); - SparseComplexMatrix btmp = b.hermitian (); - MatrixType btyp = typ.transpose (); - - octave_idx_type info; - double rcond = 0.0; - ComplexMatrix result - = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); - - typ = btyp.transpose (); - return result.hermitian (); -} - -// -*- 5 -*- -SparseMatrix -xdiv (const SparseMatrix& a, const SparseMatrix& b, MatrixType &typ) -{ - if (! mx_div_conform (a, b)) - return SparseMatrix (); - - SparseMatrix atmp = a.transpose (); - SparseMatrix btmp = b.transpose (); - MatrixType btyp = typ.transpose (); - - octave_idx_type info; - double rcond = 0.0; - SparseMatrix result = btmp.solve (btyp, atmp, info, rcond, - solve_singularity_warning); - - typ = btyp.transpose (); - return result.transpose (); -} - -// -*- 6 -*- -SparseComplexMatrix -xdiv (const SparseMatrix& a, const SparseComplexMatrix& b, MatrixType &typ) -{ - if (! mx_div_conform (a, b)) - return SparseComplexMatrix (); - - SparseMatrix atmp = a.transpose (); - SparseComplexMatrix btmp = b.hermitian (); - MatrixType btyp = typ.transpose (); - - octave_idx_type info; - double rcond = 0.0; - SparseComplexMatrix result - = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); - - typ = btyp.transpose (); - return result.hermitian (); -} - -// -*- 7 -*- -SparseComplexMatrix -xdiv (const SparseComplexMatrix& a, const SparseMatrix& b, MatrixType &typ) -{ - if (! mx_div_conform (a, b)) - return SparseComplexMatrix (); - - SparseComplexMatrix atmp = a.hermitian (); - SparseMatrix btmp = b.transpose (); - MatrixType btyp = typ.transpose (); - - octave_idx_type info; - double rcond = 0.0; - SparseComplexMatrix result - = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); - - typ = btyp.transpose (); - return result.hermitian (); -} - -// -*- 8 -*- -SparseComplexMatrix -xdiv (const SparseComplexMatrix& a, const SparseComplexMatrix& b, MatrixType &typ) -{ - if (! mx_div_conform (a, b)) - return SparseComplexMatrix (); - - SparseComplexMatrix atmp = a.hermitian (); - SparseComplexMatrix btmp = b.hermitian (); - MatrixType btyp = typ.transpose (); - - octave_idx_type info; - double rcond = 0.0; - SparseComplexMatrix result - = btmp.solve (btyp, atmp, info, rcond, solve_singularity_warning); - - typ = btyp.transpose (); - return result.hermitian (); -} - -template -RT do_rightdiv_sm_dm (const SM& a, const DM& d) -{ - const octave_idx_type d_nr = d.rows (); - - const octave_idx_type a_nr = a.rows (); - const octave_idx_type a_nc = a.cols (); - - using std::min; - const octave_idx_type nc = min (d_nr, a_nc); - - if ( ! mx_div_conform (a, d)) - return RT (); - - const octave_idx_type nz = a.nnz (); - RT r (a_nr, nc, nz); - - typedef typename DM::element_type DM_elt_type; - const DM_elt_type zero = DM_elt_type (); - - octave_idx_type k_result = 0; - for (octave_idx_type j = 0; j < nc; ++j) - { - octave_quit (); - const DM_elt_type s = d.dgelem (j); - const octave_idx_type colend = a.cidx (j+1); - r.xcidx (j) = k_result; - if (s != zero) - for (octave_idx_type k = a.cidx (j); k < colend; ++k) - { - r.xdata (k_result) = a.data (k) / s; - r.xridx (k_result) = a.ridx (k); - ++k_result; - } - } - r.xcidx (nc) = k_result; - - r.maybe_compress (true); - return r; -} - -// -*- 9 -*- -SparseMatrix -xdiv (const SparseMatrix& a, const DiagMatrix& b, MatrixType &) -{ - return do_rightdiv_sm_dm (a, b); -} - -// -*- 10 -*- -SparseComplexMatrix -xdiv (const SparseMatrix& a, const ComplexDiagMatrix& b, MatrixType &) -{ - return do_rightdiv_sm_dm (a, b); -} - -// -*- 11 -*- -SparseComplexMatrix -xdiv (const SparseComplexMatrix& a, const DiagMatrix& b, MatrixType &) -{ - return do_rightdiv_sm_dm (a, b); -} - -// -*- 12 -*- -SparseComplexMatrix -xdiv (const SparseComplexMatrix& a, const ComplexDiagMatrix& b, MatrixType &) -{ - return do_rightdiv_sm_dm (a, b); -} - -// Funny element by element division operations. -// -// op2 \ op1: s cs -// +-- +---+----+ -// matrix | 1 | 3 | -// +---+----+ -// complex_matrix | 2 | 4 | -// +---+----+ - -Matrix -x_el_div (double a, const SparseMatrix& b) -{ - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.cols (); - - Matrix result; - if (a == 0.) - result = Matrix (nr, nc, octave_NaN); - else if (a > 0.) - result = Matrix (nr, nc, octave_Inf); - else - result = Matrix (nr, nc, -octave_Inf); - - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++) - { - octave_quit (); - result.elem (b.ridx (i), j) = a / b.data (i); - } - - return result; -} - -ComplexMatrix -x_el_div (double a, const SparseComplexMatrix& b) -{ - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.cols (); - - ComplexMatrix result (nr, nc, Complex (octave_NaN, octave_NaN)); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++) - { - octave_quit (); - result.elem (b.ridx (i), j) = a / b.data (i); - } - - return result; -} - -ComplexMatrix -x_el_div (const Complex a, const SparseMatrix& b) -{ - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.cols (); - - ComplexMatrix result (nr, nc, (a / 0.0)); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++) - { - octave_quit (); - result.elem (b.ridx (i), j) = a / b.data (i); - } - - return result; -} - -ComplexMatrix -x_el_div (const Complex a, const SparseComplexMatrix& b) -{ - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.cols (); - - ComplexMatrix result (nr, nc, (a / 0.0)); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++) - { - octave_quit (); - result.elem (b.ridx (i), j) = a / b.data (i); - } - - return result; -} - -// Left division functions. X \ Y = inv (X) * Y -// -// Y \ X : sm scm dm dcm -// +-- +---+----+ -// matrix | 1 | 5 | -// +---+----+ -// complex_matrix | 2 | 6 | -// +---+----+----+----+ -// sparse matrix | 3 | 7 | 9 | 11 | -// +---+----+----+----+ -// sparse complex_matrix | 4 | 8 | 10 | 12 | -// +---+----+----+----+ - -// -*- 1 -*- -Matrix -xleftdiv (const SparseMatrix& a, const Matrix& b, MatrixType &typ) -{ - if (! mx_leftdiv_conform (a, b)) - return Matrix (); - - octave_idx_type info; - double rcond = 0.0; - return a.solve (typ, b, info, rcond, solve_singularity_warning); -} - -// -*- 2 -*- -ComplexMatrix -xleftdiv (const SparseMatrix& a, const ComplexMatrix& b, MatrixType &typ) -{ - if (! mx_leftdiv_conform (a, b)) - return ComplexMatrix (); - - octave_idx_type info; - double rcond = 0.0; - return a.solve (typ, b, info, rcond, solve_singularity_warning); -} - -// -*- 3 -*- -SparseMatrix -xleftdiv (const SparseMatrix& a, const SparseMatrix& b, MatrixType &typ) -{ - if (! mx_leftdiv_conform (a, b)) - return SparseMatrix (); - - octave_idx_type info; - double rcond = 0.0; - return a.solve (typ, b, info, rcond, solve_singularity_warning); -} - -// -*- 4 -*- -SparseComplexMatrix -xleftdiv (const SparseMatrix& a, const SparseComplexMatrix& b, MatrixType &typ) -{ - if (! mx_leftdiv_conform (a, b)) - return SparseComplexMatrix (); - - octave_idx_type info; - double rcond = 0.0; - return a.solve (typ, b, info, rcond, solve_singularity_warning); -} - -// -*- 5 -*- -ComplexMatrix -xleftdiv (const SparseComplexMatrix& a, const Matrix& b, MatrixType &typ) -{ - if (! mx_leftdiv_conform (a, b)) - return ComplexMatrix (); - - octave_idx_type info; - double rcond = 0.0; - return a.solve (typ, b, info, rcond, solve_singularity_warning); -} - -// -*- 6 -*- -ComplexMatrix -xleftdiv (const SparseComplexMatrix& a, const ComplexMatrix& b, MatrixType &typ) -{ - if (! mx_leftdiv_conform (a, b)) - return ComplexMatrix (); - - octave_idx_type info; - double rcond = 0.0; - return a.solve (typ, b, info, rcond, solve_singularity_warning); -} - -// -*- 7 -*- -SparseComplexMatrix -xleftdiv (const SparseComplexMatrix& a, const SparseMatrix& b, MatrixType &typ) -{ - if (! mx_leftdiv_conform (a, b)) - return SparseComplexMatrix (); - - octave_idx_type info; - double rcond = 0.0; - return a.solve (typ, b, info, rcond, solve_singularity_warning); -} - -// -*- 8 -*- -SparseComplexMatrix -xleftdiv (const SparseComplexMatrix& a, const SparseComplexMatrix& b, - MatrixType &typ) -{ - if (! mx_leftdiv_conform (a, b)) - return SparseComplexMatrix (); - - octave_idx_type info; - double rcond = 0.0; - return a.solve (typ, b, info, rcond, solve_singularity_warning); -} - -template -RT do_leftdiv_dm_sm (const DM& d, const SM& a) -{ - const octave_idx_type a_nr = a.rows (); - const octave_idx_type a_nc = a.cols (); - - const octave_idx_type d_nc = d.cols (); - - using std::min; - const octave_idx_type nr = min (d_nc, a_nr); - - if ( ! mx_leftdiv_conform (d, a)) - return RT (); - - const octave_idx_type nz = a.nnz (); - RT r (nr, a_nc, nz); - - typedef typename DM::element_type DM_elt_type; - const DM_elt_type zero = DM_elt_type (); - - octave_idx_type k_result = 0; - for (octave_idx_type j = 0; j < a_nc; ++j) - { - octave_quit (); - const octave_idx_type colend = a.cidx (j+1); - r.xcidx (j) = k_result; - for (octave_idx_type k = a.cidx (j); k < colend; ++k) - { - const octave_idx_type i = a.ridx (k); - if (i < nr) - { - const DM_elt_type s = d.dgelem (i); - if (s != zero) - { - r.xdata (k_result) = a.data (k) / s; - r.xridx (k_result) = i; - ++k_result; - } - } - } - } - r.xcidx (a_nc) = k_result; - - r.maybe_compress (true); - return r; -} - -// -*- 9 -*- -SparseMatrix -xleftdiv (const DiagMatrix& d, const SparseMatrix& a, MatrixType&) -{ - return do_leftdiv_dm_sm (d, a); -} - -// -*- 10 -*- -SparseComplexMatrix -xleftdiv (const DiagMatrix& d, const SparseComplexMatrix& a, MatrixType&) -{ - return do_leftdiv_dm_sm (d, a); -} - -// -*- 11 -*- -SparseComplexMatrix -xleftdiv (const ComplexDiagMatrix& d, const SparseMatrix& a, MatrixType&) -{ - return do_leftdiv_dm_sm (d, a); -} - -// -*- 12 -*- -SparseComplexMatrix -xleftdiv (const ComplexDiagMatrix& d, const SparseComplexMatrix& a, MatrixType&) -{ - return do_leftdiv_dm_sm (d, a); -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/sparse-xdiv.h --- a/libinterp/interp-core/sparse-xdiv.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,93 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_sparse_xdiv_h) -#define octave_sparse_xdiv_h 1 - -#include "oct-cmplx.h" -#include "MatrixType.h" - -class DiagMatrix; -class ComplexDiagMatrix; -class SparseMatrix; -class SparseComplexMatrix; - -extern Matrix xdiv (const Matrix& a, const SparseMatrix& b, MatrixType &typ); -extern ComplexMatrix xdiv (const Matrix& a, const SparseComplexMatrix& b, - MatrixType &typ); -extern ComplexMatrix xdiv (const ComplexMatrix& a, const SparseMatrix& b, - MatrixType &typ); -extern ComplexMatrix xdiv (const ComplexMatrix& a, - const SparseComplexMatrix& b, MatrixType &typ); - -extern SparseMatrix xdiv (const SparseMatrix& a, const SparseMatrix& b, - MatrixType &typ); -extern SparseComplexMatrix xdiv (const SparseMatrix& a, - const SparseComplexMatrix& b, MatrixType &typ); -extern SparseComplexMatrix xdiv (const SparseComplexMatrix& a, - const SparseMatrix& b, MatrixType &typ); -extern SparseComplexMatrix xdiv (const SparseComplexMatrix& a, - const SparseComplexMatrix& b, MatrixType &typ); - -extern SparseMatrix xdiv (const SparseMatrix& a, - const DiagMatrix& b, MatrixType &typ); -extern SparseComplexMatrix xdiv (const SparseMatrix& a, - const ComplexDiagMatrix& b, MatrixType &typ); -extern SparseComplexMatrix xdiv (const SparseComplexMatrix& a, - const DiagMatrix& b, MatrixType &typ); -extern SparseComplexMatrix xdiv (const SparseComplexMatrix& a, - const ComplexDiagMatrix& b, MatrixType &typ); - -extern Matrix x_el_div (double a, const SparseMatrix& b); -extern ComplexMatrix x_el_div (double a, const SparseComplexMatrix& b); -extern ComplexMatrix x_el_div (const Complex a, const SparseMatrix& b); -extern ComplexMatrix x_el_div (const Complex a, - const SparseComplexMatrix& b); - -extern Matrix xleftdiv (const SparseMatrix& a, const Matrix& b, - MatrixType& typ); -extern ComplexMatrix xleftdiv (const SparseMatrix& a, const ComplexMatrix& b, - MatrixType &typ); -extern ComplexMatrix xleftdiv (const SparseComplexMatrix& a, const Matrix& b, - MatrixType &typ); -extern ComplexMatrix xleftdiv (const SparseComplexMatrix& a, - const ComplexMatrix& b, MatrixType &typ); - -extern SparseMatrix xleftdiv (const SparseMatrix& a, const SparseMatrix& b, - MatrixType &typ); -extern SparseComplexMatrix xleftdiv (const SparseMatrix& a, - const SparseComplexMatrix& b, MatrixType &typ); -extern SparseComplexMatrix xleftdiv (const SparseComplexMatrix& a, - const SparseMatrix& b, MatrixType &typ); -extern SparseComplexMatrix xleftdiv (const SparseComplexMatrix& a, - const SparseComplexMatrix& b, MatrixType &typ); - -extern SparseMatrix xleftdiv (const DiagMatrix&, const SparseMatrix&, MatrixType&); -extern SparseComplexMatrix xleftdiv (const ComplexDiagMatrix&, const SparseMatrix&, - MatrixType&); -extern SparseComplexMatrix xleftdiv (const DiagMatrix&, const SparseComplexMatrix&, - MatrixType&); -extern SparseComplexMatrix xleftdiv (const ComplexDiagMatrix&, const SparseComplexMatrix&, - MatrixType&); - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/sparse-xpow.cc --- a/libinterp/interp-core/sparse-xpow.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,766 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include - -#include "Array-util.h" -#include "oct-cmplx.h" -#include "quit.h" - -#include "error.h" -#include "oct-obj.h" -#include "utils.h" - -#include "dSparse.h" -#include "CSparse.h" -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" -#include "sparse-xpow.h" - -static inline int -xisint (double x) -{ - return (D_NINT (x) == x - && ((x >= 0 && x < std::numeric_limits::max ()) - || (x <= 0 && x > std::numeric_limits::min ()))); -} - - -// Safer pow functions. Only two make sense for sparse matrices, the -// others should all promote to full matrices. - -octave_value -xpow (const SparseMatrix& a, double b) -{ - octave_value retval; - - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be a square matrix"); - else - { - if (static_cast (b) == b) - { - int btmp = static_cast (b); - if (btmp == 0) - { - SparseMatrix tmp = SparseMatrix (nr, nr, nr); - for (octave_idx_type i = 0; i < nr; i++) - { - tmp.data (i) = 1.0; - tmp.ridx (i) = i; - } - for (octave_idx_type i = 0; i < nr + 1; i++) - tmp.cidx (i) = i; - - retval = tmp; - } - else - { - SparseMatrix atmp; - if (btmp < 0) - { - btmp = -btmp; - - octave_idx_type info; - double rcond = 0.0; - MatrixType mattyp (a); - - atmp = a.inverse (mattyp, info, rcond, 1); - - if (info == -1) - warning ("inverse: matrix singular to machine\ - precision, rcond = %g", rcond); - } - else - atmp = a; - - SparseMatrix result (atmp); - - btmp--; - - while (btmp > 0) - { - if (btmp & 1) - result = result * atmp; - - btmp >>= 1; - - if (btmp > 0) - atmp = atmp * atmp; - } - - retval = result; - } - } - else - error ("use full(a) ^ full(b)"); - } - - return retval; -} - -octave_value -xpow (const SparseComplexMatrix& a, double b) -{ - octave_value retval; - - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be a square matrix"); - else - { - if (static_cast (b) == b) - { - int btmp = static_cast (b); - if (btmp == 0) - { - SparseMatrix tmp = SparseMatrix (nr, nr, nr); - for (octave_idx_type i = 0; i < nr; i++) - { - tmp.data (i) = 1.0; - tmp.ridx (i) = i; - } - for (octave_idx_type i = 0; i < nr + 1; i++) - tmp.cidx (i) = i; - - retval = tmp; - } - else - { - SparseComplexMatrix atmp; - if (btmp < 0) - { - btmp = -btmp; - - octave_idx_type info; - double rcond = 0.0; - MatrixType mattyp (a); - - atmp = a.inverse (mattyp, info, rcond, 1); - - if (info == -1) - warning ("inverse: matrix singular to machine\ - precision, rcond = %g", rcond); - } - else - atmp = a; - - SparseComplexMatrix result (atmp); - - btmp--; - - while (btmp > 0) - { - if (btmp & 1) - result = result * atmp; - - btmp >>= 1; - - if (btmp > 0) - atmp = atmp * atmp; - } - - retval = result; - } - } - else - error ("use full(a) ^ full(b)"); - } - - return retval; -} - -// Safer pow functions that work elementwise for matrices. -// -// op2 \ op1: s m cs cm -// +-- +---+---+----+----+ -// scalar | | * | 3 | * | 9 | -// +---+---+----+----+ -// matrix | 1 | 4 | 7 | 10 | -// +---+---+----+----+ -// complex_scalar | * | 5 | * | 11 | -// +---+---+----+----+ -// complex_matrix | 2 | 6 | 8 | 12 | -// +---+---+----+----+ -// -// * -> not needed. - -// FIXME -- these functions need to be fixed so that things -// like -// -// a = -1; b = [ 0, 0.5, 1 ]; r = a .^ b -// -// and -// -// a = -1; b = [ 0, 0.5, 1 ]; for i = 1:3, r(i) = a .^ b(i), end -// -// produce identical results. Also, it would be nice if -1^0.5 -// produced a pure imaginary result instead of a complex number with a -// small real part. But perhaps that's really a problem with the math -// library... - -// Handle special case of scalar-sparse-matrix .^ sparse-matrix. -// Forwarding to the scalar elem_xpow function and then converting the -// result back to a sparse matrix is a bit wasteful but it does not -// seem worth the effort to optimize -- how often does this case come up -// in practice? - -template -inline octave_value -scalar_xpow (const S& a, const SM& b) -{ - octave_value val = elem_xpow (a, b); - - if (val.is_complex_type ()) - return SparseComplexMatrix (val.complex_matrix_value ()); - else - return SparseMatrix (val.matrix_value ()); -} - -/* -%!assert (sparse (2) .^ [3, 4], sparse ([8, 16])); -%!assert (sparse (2i) .^ [3, 4], sparse ([-0-8i, 16])); -*/ - -// -*- 1 -*- -octave_value -elem_xpow (double a, const SparseMatrix& b) -{ - octave_value retval; - - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.cols (); - - double d1, d2; - - if (a < 0.0 && ! b.all_integers (d1, d2)) - { - Complex atmp (a); - ComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - { - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result(i, j) = std::pow (atmp, b(i,j)); - } - } - - retval = result; - } - else - { - Matrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - { - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result(i, j) = std::pow (a, b(i,j)); - } - } - - retval = result; - } - - return retval; -} - -// -*- 2 -*- -octave_value -elem_xpow (double a, const SparseComplexMatrix& b) -{ - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.cols (); - - Complex atmp (a); - ComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - { - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result(i, j) = std::pow (atmp, b(i,j)); - } - } - - return result; -} - -// -*- 3 -*- -octave_value -elem_xpow (const SparseMatrix& a, double b) -{ - // FIXME What should a .^ 0 give?? Matlab gives a - // sparse matrix with same structure as a, which is strictly - // incorrect. Keep compatiability. - - octave_value retval; - - octave_idx_type nz = a.nnz (); - - if (b <= 0.0) - { - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - if (static_cast (b) != b && a.any_element_is_negative ()) - { - ComplexMatrix result (nr, nc, Complex (std::pow (0.0, b))); - - // FIXME -- avoid apparent GNU libm bug by - // converting A and B to complex instead of just A. - Complex btmp (b); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = a.cidx (j); i < a.cidx (j+1); i++) - { - octave_quit (); - - Complex atmp (a.data (i)); - - result(a.ridx (i), j) = std::pow (atmp, btmp); - } - - retval = octave_value (result); - } - else - { - Matrix result (nr, nc, (std::pow (0.0, b))); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = a.cidx (j); i < a.cidx (j+1); i++) - { - octave_quit (); - result(a.ridx (i), j) = std::pow (a.data (i), b); - } - - retval = octave_value (result); - } - } - else if (static_cast (b) != b && a.any_element_is_negative ()) - { - SparseComplexMatrix result (a); - - for (octave_idx_type i = 0; i < nz; i++) - { - octave_quit (); - - // FIXME -- avoid apparent GNU libm bug by - // converting A and B to complex instead of just A. - - Complex atmp (a.data (i)); - Complex btmp (b); - - result.data (i) = std::pow (atmp, btmp); - } - - result.maybe_compress (true); - - retval = result; - } - else - { - SparseMatrix result (a); - - for (octave_idx_type i = 0; i < nz; i++) - { - octave_quit (); - result.data (i) = std::pow (a.data (i), b); - } - - result.maybe_compress (true); - - retval = result; - } - - return retval; -} - -// -*- 4 -*- -octave_value -elem_xpow (const SparseMatrix& a, const SparseMatrix& b) -{ - octave_value retval; - - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - - if (a.numel () == 1 && b.numel () > 1) - return scalar_xpow (a(0), b); - - if (nr != b_nr || nc != b_nc) - { - gripe_nonconformant ("operator .^", nr, nc, b_nr, b_nc); - return octave_value (); - } - - int convert_to_complex = 0; - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = a.cidx (j); i < a.cidx (j+1); i++) - { - if (a.data(i) < 0.0) - { - double btmp = b (a.ridx (i), j); - if (static_cast (btmp) != btmp) - { - convert_to_complex = 1; - goto done; - } - } - } - -done: - - // This is a dumb operator for sparse matrices anyway, and there is - // no sensible way to handle the 0.^0 versus the 0.^x cases. Therefore - // allocate a full matrix filled for the 0.^0 case and shrink it later - // as needed - - if (convert_to_complex) - { - SparseComplexMatrix complex_result (nr, nc, Complex (1.0, 0.0)); - - for (octave_idx_type j = 0; j < nc; j++) - { - for (octave_idx_type i = a.cidx (j); i < a.cidx (j+1); i++) - { - octave_quit (); - complex_result.xelem (a.ridx (i), j) = - std::pow (Complex (a.data (i)), Complex (b(a.ridx (i), j))); - } - } - complex_result.maybe_compress (true); - retval = complex_result; - } - else - { - SparseMatrix result (nr, nc, 1.0); - - for (octave_idx_type j = 0; j < nc; j++) - { - for (octave_idx_type i = a.cidx (j); i < a.cidx (j+1); i++) - { - octave_quit (); - result.xelem (a.ridx (i), j) = std::pow (a.data (i), - b(a.ridx (i), j)); - } - } - result.maybe_compress (true); - retval = result; - } - - return retval; -} - -// -*- 5 -*- -octave_value -elem_xpow (const SparseMatrix& a, const Complex& b) -{ - octave_value retval; - - if (b == 0.0) - // Can this case ever happen, due to automatic retyping with maybe_mutate? - retval = octave_value (NDArray (a.dims (), 1)); - else - { - octave_idx_type nz = a.nnz (); - SparseComplexMatrix result (a); - - for (octave_idx_type i = 0; i < nz; i++) - { - octave_quit (); - result.data (i) = std::pow (Complex (a.data (i)), b); - } - - result.maybe_compress (true); - - retval = result; - } - - return retval; -} - -// -*- 6 -*- -octave_value -elem_xpow (const SparseMatrix& a, const SparseComplexMatrix& b) -{ - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - - if (a.numel () == 1 && b.numel () > 1) - return scalar_xpow (a(0), b); - - if (nr != b_nr || nc != b_nc) - { - gripe_nonconformant ("operator .^", nr, nc, b_nr, b_nc); - return octave_value (); - } - - SparseComplexMatrix result (nr, nc, Complex (1.0, 0.0)); - for (octave_idx_type j = 0; j < nc; j++) - { - for (octave_idx_type i = a.cidx (j); i < a.cidx (j+1); i++) - { - octave_quit (); - result.xelem (a.ridx(i), j) = std::pow (a.data (i), b(a.ridx (i), j)); - } - } - - result.maybe_compress (true); - - return result; -} - -// -*- 7 -*- -octave_value -elem_xpow (const Complex& a, const SparseMatrix& b) -{ - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.cols (); - - ComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - { - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - double btmp = b (i, j); - if (xisint (btmp)) - result (i, j) = std::pow (a, static_cast (btmp)); - else - result (i, j) = std::pow (a, btmp); - } - } - - return result; -} - -// -*- 8 -*- -octave_value -elem_xpow (const Complex& a, const SparseComplexMatrix& b) -{ - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.cols (); - - ComplexMatrix result (nr, nc); - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = std::pow (a, b (i, j)); - } - - return result; -} - -// -*- 9 -*- -octave_value -elem_xpow (const SparseComplexMatrix& a, double b) -{ - octave_value retval; - - if (b <= 0) - { - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - ComplexMatrix result (nr, nc, Complex (std::pow (0.0, b))); - - if (xisint (b)) - { - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = a.cidx (j); i < a.cidx (j+1); i++) - { - octave_quit (); - result (a.ridx (i), j) = - std::pow (a.data (i), static_cast (b)); - } - } - else - { - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = a.cidx (j); i < a.cidx (j+1); i++) - { - octave_quit (); - result (a.ridx (i), j) = std::pow (a.data (i), b); - } - } - - retval = result; - } - else - { - octave_idx_type nz = a.nnz (); - - SparseComplexMatrix result (a); - - if (xisint (b)) - { - for (octave_idx_type i = 0; i < nz; i++) - { - octave_quit (); - result.data (i) = std::pow (a.data (i), static_cast (b)); - } - } - else - { - for (octave_idx_type i = 0; i < nz; i++) - { - octave_quit (); - result.data (i) = std::pow (a.data (i), b); - } - } - - result.maybe_compress (true); - - retval = result; - } - - return retval; -} - -// -*- 10 -*- -octave_value -elem_xpow (const SparseComplexMatrix& a, const SparseMatrix& b) -{ - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - - if (a.numel () == 1 && b.numel () > 1) - return scalar_xpow (a(0), b); - - if (nr != b_nr || nc != b_nc) - { - gripe_nonconformant ("operator .^", nr, nc, b_nr, b_nc); - return octave_value (); - } - - SparseComplexMatrix result (nr, nc, Complex (1.0, 0.0)); - for (octave_idx_type j = 0; j < nc; j++) - { - for (octave_idx_type i = a.cidx (j); i < a.cidx (j+1); i++) - { - octave_quit (); - double btmp = b(a.ridx (i), j); - Complex tmp; - - if (xisint (btmp)) - result.xelem (a.ridx (i), j) = std::pow (a.data (i), - static_cast (btmp)); - else - result.xelem (a.ridx (i), j) = std::pow (a.data (i), btmp); - } - } - - result.maybe_compress (true); - - return result; -} - -// -*- 11 -*- -octave_value -elem_xpow (const SparseComplexMatrix& a, const Complex& b) -{ - octave_value retval; - - if (b == 0.0) - // Can this case ever happen, due to automatic retyping with maybe_mutate? - retval = octave_value (NDArray (a.dims (), 1)); - else - { - - octave_idx_type nz = a.nnz (); - - SparseComplexMatrix result (a); - - for (octave_idx_type i = 0; i < nz; i++) - { - octave_quit (); - result.data (i) = std::pow (a.data (i), b); - } - - result.maybe_compress (true); - - retval = result; - } - - return retval; -} - -// -*- 12 -*- -octave_value -elem_xpow (const SparseComplexMatrix& a, const SparseComplexMatrix& b) -{ - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - - if (a.numel () == 1 && b.numel () > 1) - return scalar_xpow (a(0), b); - - if (nr != b_nr || nc != b_nc) - { - gripe_nonconformant ("operator .^", nr, nc, b_nr, b_nc); - return octave_value (); - } - - SparseComplexMatrix result (nr, nc, Complex (1.0, 0.0)); - for (octave_idx_type j = 0; j < nc; j++) - { - for (octave_idx_type i = a.cidx (j); i < a.cidx (j+1); i++) - { - octave_quit (); - result.xelem (a.ridx (i), j) = std::pow (a.data (i), b(a.ridx (i), j)); - } - } - result.maybe_compress (true); - - return result; -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/sparse-xpow.h --- a/libinterp/interp-core/sparse-xpow.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,57 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_sparse_xpow_h) -#define octave_sparse_xpow_h 1 - -#include "oct-cmplx.h" - -class SparseMatrix; -class SparseComplexMatrix; -class octave_value; - -extern octave_value xpow (const SparseMatrix& a, double b); -extern octave_value xpow (const SparseComplexMatrix& a, double b); - -extern octave_value elem_xpow (double a, const SparseMatrix& b); -extern octave_value elem_xpow (double a, const SparseComplexMatrix& b); - -extern octave_value elem_xpow (const SparseMatrix& a, double b); -extern octave_value elem_xpow (const SparseMatrix& a, const SparseMatrix& b); -extern octave_value elem_xpow (const SparseMatrix& a, const Complex& b); -extern octave_value elem_xpow (const SparseMatrix& a, - const SparseComplexMatrix& b); - -extern octave_value elem_xpow (const Complex& a, const SparseMatrix& b); -extern octave_value elem_xpow (const Complex& a, - const SparseComplexMatrix& b); - -extern octave_value elem_xpow (const SparseComplexMatrix& a, double b); -extern octave_value elem_xpow (const SparseComplexMatrix& a, - const SparseMatrix& b); -extern octave_value elem_xpow (const SparseComplexMatrix& a, - const Complex& b); -extern octave_value elem_xpow (const SparseComplexMatrix& a, - const SparseComplexMatrix& b); - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/txt-eng-ft.cc --- a/libinterp/interp-core/txt-eng-ft.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,675 +0,0 @@ -/* - -Copyright (C) 2009-2012 Michael Goffioul - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#if defined (HAVE_FREETYPE) - -#if defined (HAVE_FONTCONFIG) -#include -#endif - -#include - -#include "singleton-cleanup.h" - -#include "error.h" -#include "pr-output.h" -#include "txt-eng-ft.h" - -// FIXME -- maybe issue at most one warning per glyph/font/size/weight -// combination. - -static void -gripe_missing_glyph (char c) -{ - warning_with_id ("Octave:missing-glyph", - "ft_render: skipping missing glyph for character '%c'", - c); -} - -static void -gripe_glyph_render (char c) -{ - warning_with_id ("Octave:glyph-render", - "ft_render: unable to render glyph for character '%c'", - c); -} - -#ifdef _MSC_VER -// This is just a trick to avoid multiply symbols definition. -// PermMatrix.h contains a dllexport'ed Array -// that will make MSVC not to generate new instantiation and -// use the imported one. -#include "PermMatrix.h" -#endif - -class -ft_manager -{ -public: - static bool instance_ok (void) - { - bool retval = true; - - if (! instance) - { - instance = new ft_manager (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); - } - - if (! instance) - { - ::error ("unable to create ft_manager!"); - - retval = false; - } - - return retval; - } - - static void cleanup_instance (void) { delete instance; instance = 0; } - - static FT_Face get_font (const std::string& name, const std::string& weight, - const std::string& angle, double size) - { return (instance_ok () - ? instance->do_get_font (name, weight, angle, size) - : 0); } - -private: - - static ft_manager *instance; - -private: - - // No copying! - - ft_manager (const ft_manager&); - - ft_manager& operator = (const ft_manager&); - - ft_manager (void) - : library (), freetype_initialized (false), fontconfig_initialized (false) - { - if (FT_Init_FreeType (&library)) - ::error ("unable to initialize freetype library"); - else - freetype_initialized = true; - -#if defined (HAVE_FONTCONFIG) - if (! FcInit ()) - ::error ("unable to initialize fontconfig library"); - else - fontconfig_initialized = true; -#endif - } - - ~ft_manager (void) - { - if (freetype_initialized) - FT_Done_FreeType (library); - -#if defined (HAVE_FONTCONFIG) - // FIXME -- Skip the call to FcFini because it can trigger the - // assertion - // - // octave: fccache.c:507: FcCacheFini: Assertion 'fcCacheChains[i] == ((void *)0)' failed. - // - // if (fontconfig_initialized) - // FcFini (); -#endif - } - - - FT_Face do_get_font (const std::string& name, const std::string& weight, - const std::string& angle, double size) - { - FT_Face retval = 0; - - std::string file; - -#if defined (HAVE_FONTCONFIG) - if (fontconfig_initialized) - { - int fc_weight, fc_angle; - - if (weight == "bold") - fc_weight = FC_WEIGHT_BOLD; - else if (weight == "light") - fc_weight = FC_WEIGHT_LIGHT; - else if (weight == "demi") - fc_weight = FC_WEIGHT_DEMIBOLD; - else - fc_weight = FC_WEIGHT_NORMAL; - - if (angle == "italic") - fc_angle = FC_SLANT_ITALIC; - else if (angle == "oblique") - fc_angle = FC_SLANT_OBLIQUE; - else - fc_angle = FC_SLANT_ROMAN; - - FcPattern *pat = FcPatternCreate (); - - FcPatternAddString (pat, FC_FAMILY, - (reinterpret_cast - (name == "*" ? "sans" : name.c_str ()))); - - FcPatternAddInteger (pat, FC_WEIGHT, fc_weight); - FcPatternAddInteger (pat, FC_SLANT, fc_angle); - FcPatternAddDouble (pat, FC_PIXEL_SIZE, size); - - if (FcConfigSubstitute (0, pat, FcMatchPattern)) - { - FcResult res; - FcPattern *match; - - FcDefaultSubstitute (pat); - match = FcFontMatch (0, pat, &res); - - // FIXME -- originally, this test also required that - // res != FcResultNoMatch. Is that really needed? - if (match) - { - unsigned char *tmp; - - FcPatternGetString (match, FC_FILE, 0, &tmp); - file = reinterpret_cast (tmp); - } - else - ::warning ("could not match any font: %s-%s-%s-%g", - name.c_str (), weight.c_str (), angle.c_str (), - size); - - if (match) - FcPatternDestroy (match); - } - - FcPatternDestroy (pat); - } -#endif - - if (file.empty ()) - { -#ifdef __WIN32__ - file = "C:/WINDOWS/Fonts/verdana.ttf"; -#else - // FIXME: find a "standard" font for UNIX platforms -#endif - } - - if (! file.empty () && FT_New_Face (library, file.c_str (), 0, &retval)) - ::warning ("ft_manager: unable to load font: %s", file.c_str ()); - - return retval; - } - -private: - FT_Library library; - bool freetype_initialized; - bool fontconfig_initialized; -}; - -ft_manager* ft_manager::instance = 0; - -// --------------------------------------------------------------------------- - -ft_render::ft_render (void) - : text_processor (), face (0), bbox (1, 4, 0.0), - xoffset (0), yoffset (0), multiline_halign (0), - multiline_align_xoffsets (), mode (MODE_BBOX), - red (0), green (0), blue (0) -{ -} - -ft_render::~ft_render (void) -{ - if (face) - FT_Done_Face (face); -} - -void -ft_render::set_font (const std::string& name, const std::string& weight, - const std::string& angle, double size) -{ - if (face) - FT_Done_Face (face); - - // FIXME: take "fontunits" into account - face = ft_manager::get_font (name, weight, angle, size); - - if (face) - { - if (FT_Set_Char_Size (face, 0, size*64, 0, 0)) - ::warning ("ft_render: unable to set font size to %d", size); - } - else - ::warning ("ft_render: unable to load appropriate font"); -} - -void -ft_render::set_mode (int m) -{ - mode = m; - - switch (mode) - { - case MODE_BBOX: - xoffset = yoffset = 0; - bbox = Matrix (1, 4, 0.0); - break; - case MODE_RENDER: - if (bbox.numel () != 4) - { - ::warning ("ft_render: invalid bounding box, cannot render"); - - xoffset = yoffset = 0; - pixels = uint8NDArray (); - } - else - { - pixels = uint8NDArray (dim_vector (4, bbox(2), bbox(3)), - static_cast (0)); - xoffset = 0; - yoffset = -bbox(1)-1; - } - break; - default: - ::error ("ft_render: invalid mode '%d'", mode); - break; - } -} - -void -ft_render::visit (text_element_string& e) -{ - if (face) - { - int line_index = 0; - FT_UInt box_line_width = 0; - std::string str = e.string_value (); - FT_UInt glyph_index, previous = 0; - - if (mode == MODE_BBOX) - multiline_align_xoffsets.clear (); - else if (mode == MODE_RENDER) - xoffset += multiline_align_xoffsets[line_index]; - - for (size_t i = 0; i < str.length (); i++) - { - glyph_index = FT_Get_Char_Index (face, str[i]); - - if (str[i] != '\n' - && (! glyph_index - || FT_Load_Glyph (face, glyph_index, FT_LOAD_DEFAULT))) - gripe_missing_glyph (str[i]); - else - { - switch (mode) - { - case MODE_RENDER: - if (str[i] == '\n') - { - glyph_index = FT_Get_Char_Index (face, ' '); - if (!glyph_index || FT_Load_Glyph (face, glyph_index, FT_LOAD_DEFAULT)) - { - gripe_missing_glyph (' '); - } - else - { - line_index++; - xoffset = multiline_align_xoffsets[line_index]; - yoffset -= (face->size->metrics.height >> 6); - } - } - else if (FT_Render_Glyph (face->glyph, FT_RENDER_MODE_NORMAL)) - { - gripe_glyph_render (str[i]); - } - else - { - FT_Bitmap& bitmap = face->glyph->bitmap; - int x0, y0; - - if (previous) - { - FT_Vector delta; - - FT_Get_Kerning (face, previous, glyph_index, FT_KERNING_DEFAULT, &delta); - xoffset += (delta.x >> 6); - } - - x0 = xoffset+face->glyph->bitmap_left; - y0 = yoffset+face->glyph->bitmap_top; - - // 'w' seems to have a negative -1 - // face->glyph->bitmap_left, this is so we don't - // index out of bound, and assumes we we allocated - // the right amount of horizontal space in the bbox. - if (x0 < 0) - x0 = 0; - - for (int r = 0; r < bitmap.rows; r++) - for (int c = 0; c < bitmap.width; c++) - { - unsigned char pix = bitmap.buffer[r*bitmap.width+c]; - if (x0+c < 0 || x0+c >= pixels.dim2 () - || y0-r < 0 || y0-r >= pixels.dim3 ()) - { - //::error ("out-of-bound indexing!!"); - } - else if (pixels(3, x0+c, y0-r).value () == 0) - { - pixels(0, x0+c, y0-r) = red; - pixels(1, x0+c, y0-r) = green; - pixels(2, x0+c, y0-r) = blue; - pixels(3, x0+c, y0-r) = pix; - } - } - - xoffset += (face->glyph->advance.x >> 6); - } - break; - - case MODE_BBOX: - if (str[i] == '\n') - { - glyph_index = FT_Get_Char_Index (face, ' '); - if (! glyph_index - || FT_Load_Glyph (face, glyph_index, FT_LOAD_DEFAULT)) - { - gripe_missing_glyph (' '); - } - else - { - multiline_align_xoffsets.push_back (box_line_width); - // Reset the pixel width for this newline, so we don't - // allocate a bounding box larger than the horizontal - // width of the multi-line - box_line_width = 0; - bbox(1) -= (face->size->metrics.height >> 6); - } - } - else - { - // width - if (previous) - { - FT_Vector delta; - - FT_Get_Kerning (face, previous, glyph_index, - FT_KERNING_DEFAULT, &delta); - - box_line_width += (delta.x >> 6); - } - - box_line_width += (face->glyph->advance.x >> 6); - - int asc, desc; - - if (false /*tight*/) - { - desc = face->glyph->metrics.horiBearingY - face->glyph->metrics.height; - asc = face->glyph->metrics.horiBearingY; - } - else - { - asc = face->size->metrics.ascender; - desc = face->size->metrics.descender; - } - - asc = yoffset + (asc >> 6); - desc = yoffset + (desc >> 6); - - if (desc < bbox(1)) - { - bbox(3) += (bbox(1) - desc); - bbox(1) = desc; - } - if (asc > (bbox(3)+bbox(1))) - bbox(3) = asc-bbox(1); - if (bbox(2) < box_line_width) - bbox(2) = box_line_width; - } - break; - } - if (str[i] == '\n') - previous = 0; - else - previous = glyph_index; - } - } - if (mode == MODE_BBOX) - { - /* Push last the width associated with the last line */ - multiline_align_xoffsets.push_back (box_line_width); - - for (unsigned int i = 0; i < multiline_align_xoffsets.size (); i++) - { - /* Center align */ - if (multiline_halign == 1) - multiline_align_xoffsets[i] = (bbox(2) - multiline_align_xoffsets[i])/2; - /* Right align */ - else if (multiline_halign == 2) - multiline_align_xoffsets[i] = (bbox(2) - multiline_align_xoffsets[i]); - /* Left align */ - else - multiline_align_xoffsets[i] = 0; - } - } - } -} - -void -ft_render::reset (void) -{ - set_mode (MODE_BBOX); - set_color (Matrix (1, 3, 0.0)); -} - -void -ft_render::set_color (Matrix c) -{ - if (c.numel () == 3) - { - red = static_cast (c(0)*255); - green = static_cast (c(1)*255); - blue = static_cast (c(2)*255); - } - else - ::warning ("ft_render::set_color: invalid color"); -} - -uint8NDArray -ft_render::render (text_element* elt, Matrix& box, int rotation) -{ - set_mode (MODE_BBOX); - elt->accept (*this); - box = bbox; - - set_mode (MODE_RENDER); - if (pixels.numel () > 0) - { - elt->accept (*this); - - switch (rotation) - { - case ROTATION_0: - break; - case ROTATION_90: - { - Array perm (dim_vector (3, 1)); - perm(0) = 0; - perm(1) = 2; - perm(2) = 1; - pixels = pixels.permute (perm); - - Array idx (dim_vector (3, 1)); - idx(0) = idx_vector (':'); - idx(1) = idx_vector (pixels.dim2 ()-1, -1, -1); - idx(2) = idx_vector (':'); - pixels = uint8NDArray (pixels.index (idx)); - } - break; - case ROTATION_180: - { - Array idx (dim_vector (3, 1)); - idx(0) = idx_vector (':'); - idx(1) = idx_vector (pixels.dim2 ()-1, -1, -1); - idx(2)= idx_vector (pixels.dim3 ()-1, -1, -1); - pixels = uint8NDArray (pixels.index (idx)); - } - break; - case ROTATION_270: - { - Array perm (dim_vector (3, 1)); - perm(0) = 0; - perm(1) = 2; - perm(2) = 1; - pixels = pixels.permute (perm); - - Array idx (dim_vector (3, 1)); - idx(0) = idx_vector (':'); - idx(1) = idx_vector (':'); - idx(2) = idx_vector (pixels.dim3 ()-1, -1, -1); - pixels = uint8NDArray (pixels.index (idx)); - } - break; - } - } - - return pixels; -} - -// Note: -// x-extent accurately measures width of glyphs. -// y-extent is overly large because it is measured from baseline-to-baseline. -// Calling routines, such as ylabel, may need to account for this mismatch. - -Matrix -ft_render::get_extent (text_element *elt, double rotation) -{ - set_mode (MODE_BBOX); - elt->accept (*this); - - Matrix extent (1, 2, 0.0); - - switch (rotation_to_mode (rotation)) - { - case ROTATION_0: - case ROTATION_180: - extent(0) = bbox(2); - extent(1) = bbox(3); - break; - case ROTATION_90: - case ROTATION_270: - extent(0) = bbox(3); - extent(1) = bbox(2); - } - - return extent; -} - -Matrix -ft_render::get_extent (const std::string& txt, double rotation) -{ - text_element *elt = text_parser_none ().parse (txt); - Matrix extent = get_extent (elt, rotation); - delete elt; - - return extent; -} - -int -ft_render::rotation_to_mode (double rotation) const -{ - if (rotation == 0.0) - return ROTATION_0; - else if (rotation == 90.0) - return ROTATION_90; - else if (rotation == 180.0) - return ROTATION_180; - else if (rotation == 270.0) - return ROTATION_270; - else - return ROTATION_0; -} - -void -ft_render::text_to_pixels (const std::string& txt, - uint8NDArray& pixels_, Matrix& box, - int halign, int valign, double rotation) -{ - // FIXME: clip "rotation" between 0 and 360 - int rot_mode = rotation_to_mode (rotation); - - multiline_halign = halign; - - text_element *elt = text_parser_none ().parse (txt); - pixels_ = render (elt, box, rot_mode); - delete elt; - - if (pixels_.numel () == 0) - { - // nothing to render - return; - } - - switch (halign) - { - default: box(0) = 0; break; - case 1: box(0) = -box(2)/2; break; - case 2: box(0) = -box(2); break; - } - switch (valign) - { - default: box(1) = 0; break; - case 1: box(1) = -box(3)/2; break; - case 2: box(1) = -box(3); break; - case 3: break; - case 4: box(1) = -box(3)-box(1); break; - } - - switch (rot_mode) - { - case ROTATION_90: - std::swap (box(0), box(1)); - std::swap (box(2), box(3)); - box(0) = -box(0)-box(2); - break; - case ROTATION_180: - box(0) = -box(0)-box(2); - box(1) = -box(1)-box(3); - break; - case ROTATION_270: - std::swap (box(0), box(1)); - std::swap (box(2), box(3)); - box(1) = -box(1)-box(3); - break; - } -} - -#endif // HAVE_FREETYPE diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/txt-eng-ft.h --- a/libinterp/interp-core/txt-eng-ft.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,107 +0,0 @@ -/* - -Copyright (C) 2009-2012 Michael Goffioul - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if ! defined (txt_eng_ft_h) -#define txt_eng_ft_h 1 - -#if HAVE_FREETYPE - -#include - -#include -#include FT_FREETYPE_H - -#include -#include -#include "txt-eng.h" - -class -OCTINTERP_API -ft_render : public text_processor -{ -public: - enum { - MODE_BBOX = 0, - MODE_RENDER = 1 - }; - - enum { - ROTATION_0 = 0, - ROTATION_90 = 1, - ROTATION_180 = 2, - ROTATION_270 = 3 - }; - -public: - ft_render (void); - - ~ft_render (void); - - void visit (text_element_string& e); - - void reset (void); - - uint8NDArray get_pixels (void) const { return pixels; } - - Matrix get_boundingbox (void) const { return bbox; } - - uint8NDArray render (text_element* elt, Matrix& box, - int rotation = ROTATION_0); - - Matrix get_extent (text_element *elt, double rotation = 0.0); - Matrix get_extent (const std::string& txt, double rotation = 0.0); - - void set_font (const std::string& name, const std::string& weight, - const std::string& angle, double size); - - void set_color (Matrix c); - - void set_mode (int m); - - void text_to_pixels (const std::string& txt, - uint8NDArray& pixels_, Matrix& bbox, - int halign, int valign, double rotation); - -private: - int rotation_to_mode (double rotation) const; - - // No copying! - - ft_render (const ft_render&); - - ft_render& operator = (const ft_render&); - -private: - FT_Face face; - Matrix bbox; - uint8NDArray pixels; - int xoffset; - int yoffset; - int multiline_halign; - std::vector multiline_align_xoffsets; - int mode; - uint8_t red, green, blue; -}; - -#endif // HAVE_FREETYPE - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/txt-eng.h --- a/libinterp/interp-core/txt-eng.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,193 +0,0 @@ -/* - -Copyright (C) 2009-2012 Michael Goffioul - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if ! defined (txt_eng_h) -#define txt_eng_h 1 - -#include "base-list.h" - -class text_element; -class text_element_string; -class text_element_list; -class text_subscript_element; -class text_superscript_element; - -class text_processor; - -class -OCTINTERP_API -text_element -{ -public: - text_element (void) { } - - virtual ~text_element (void) { } - - virtual void accept (text_processor& p) = 0; - -private: - text_element (const text_element&); -}; - -class -OCTINTERP_API -text_element_string : public text_element -{ -public: - text_element_string (const std::string& s = "") - : text_element (), str (s) { } - - ~text_element_string (void) { } - - std::string string_value (void) const { return str; } - - void accept (text_processor& p); - -private: - std::string str; - -private: - text_element_string (const text_element_string &); -}; - -class -OCTINTERP_API -text_element_list : - public text_element, - public octave_base_list -{ -public: - text_element_list (void) - : text_element (), octave_base_list () { } - - ~text_element_list (void) - { - while (! empty ()) - { - iterator it = begin (); - delete (*it); - erase (it); - } - } - - void accept (text_processor& p); -}; - -class -OCTINTERP_API -text_subscript_element : public text_element_list -{ -public: - text_subscript_element (void) - : text_element_list () { } - - ~text_subscript_element (void) { } - - void accept (text_processor& p); -}; - -class -OCTINTERP_API -text_superscript_element : public text_element_list -{ -public: - text_superscript_element (void) - : text_element_list () { } - - ~text_superscript_element (void) { } - - void accept (text_processor& p); -}; - -class -OCTINTERP_API -text_processor -{ -public: - virtual void visit (text_element_string& e) = 0; - - virtual void visit (text_element_list& e) - { - for (text_element_list::iterator it = e.begin (); - it != e.end (); ++it) - { - (*it)->accept (*this); - } - } - - virtual void visit (text_subscript_element& e) - { visit (dynamic_cast (e)); } - - virtual void visit (text_superscript_element& e) - { visit (dynamic_cast (e)); } - - virtual void reset (void) { } - -protected: - text_processor (void) { } - - virtual ~text_processor (void) { } -}; - -#define TEXT_ELEMENT_ACCEPT(cls) \ -inline void \ -cls::accept (text_processor& p) \ -{ p.visit (*this); } - -TEXT_ELEMENT_ACCEPT(text_element_string) -TEXT_ELEMENT_ACCEPT(text_element_list) -TEXT_ELEMENT_ACCEPT(text_subscript_element) -TEXT_ELEMENT_ACCEPT(text_superscript_element) - -class -OCTINTERP_API -text_parser -{ -public: - text_parser (void) { } - - virtual ~text_parser (void) { } - - virtual text_element* parse (const std::string& s) = 0; -}; - -class -OCTINTERP_API -text_parser_none : public text_parser -{ -public: - text_parser_none (void) : text_parser () { } - - ~text_parser_none (void) { } - - // FIXME: is it possible to use reference counting to manage the - // memory for the object returned by the text parser? That would be - // preferable to having to know when and where to delete the object it - // creates... - - text_element* parse (const std::string& s) - { - return new text_element_string (s); - } -}; - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/unwind-prot.cc --- a/libinterp/interp-core/unwind-prot.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,35 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton -Copyright (C) 2009 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "error.h" -#include "unwind-prot.h" - -void unwind_protect_safe::gripe_exception (void) -{ - // FIXME: can this throw an exception? - error ("internal: unhandled exception in unwind_protect handler"); -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/unwind-prot.h --- a/libinterp/interp-core/unwind-prot.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,143 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_unwind_prot_h) -#define octave_unwind_prot_h 1 - -#include -#include - -#include "action-container.h" - -class -OCTINTERP_API -unwind_protect : public action_container -{ -public: - - unwind_protect (void) : lifo () { } - - // Destructor should not raise an exception, so all actions - // registered should be exception-safe (but setting error_state is - // allowed). If you're not sure, see unwind_protect_safe. - - ~unwind_protect (void) { run (); } - - virtual void add (elem *new_elem) - { - lifo.push (new_elem); - } - - void add (void (*fcn) (void *), void *ptr = 0) GCC_ATTR_DEPRECATED - { - add (new fcn_arg_elem (fcn, ptr)); - } - - operator bool (void) const { return ! empty (); } - - void run_top (void) GCC_ATTR_DEPRECATED { run_first (); } - - void run_first (void) - { - if (! empty ()) - { - // No leak on exception! - std::auto_ptr ptr (lifo.top ()); - lifo.pop (); - ptr->run (); - } - } - - void run_top (int num) GCC_ATTR_DEPRECATED { run (num); } - - void discard_top (void) GCC_ATTR_DEPRECATED { discard_first (); } - - void discard_first (void) - { - if (! empty ()) - { - elem *ptr = lifo.top (); - lifo.pop (); - delete ptr; - } - } - - void discard_top (int num) GCC_ATTR_DEPRECATED { discard (num); } - - size_t size (void) const { return lifo.size (); } - -protected: - - std::stack lifo; - -private: - - // No copying! - - unwind_protect (const unwind_protect&); - - unwind_protect& operator = (const unwind_protect&); -}; - -// Like unwind_protect, but this one will guard against the -// possibility of seeing an exception (or interrupt) in the cleanup -// actions. Not that we can do much about it, but at least we won't -// crash. - -class -OCTINTERP_API -unwind_protect_safe : public unwind_protect -{ -private: - - static void gripe_exception (void); - -public: - - unwind_protect_safe (void) : unwind_protect () { } - - ~unwind_protect_safe (void) - { - while (! empty ()) - { - try - { - run_first (); - } - catch (...) // Yes, the black hole. Remember we're in a dtor. - { - gripe_exception (); - } - } - } - -private: - - // No copying! - - unwind_protect_safe (const unwind_protect_safe&); - - unwind_protect_safe& operator = (const unwind_protect_safe&); -}; - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/xdiv.cc --- a/libinterp/interp-core/xdiv.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1000 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton -Copyright (C) 2008 Jaroslav Hajek -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "Array-util.h" -#include "CMatrix.h" -#include "dMatrix.h" -#include "CNDArray.h" -#include "dNDArray.h" -#include "fCMatrix.h" -#include "fMatrix.h" -#include "fCNDArray.h" -#include "fNDArray.h" -#include "oct-cmplx.h" -#include "dDiagMatrix.h" -#include "fDiagMatrix.h" -#include "CDiagMatrix.h" -#include "fCDiagMatrix.h" -#include "quit.h" - -#include "error.h" -#include "xdiv.h" - -static inline bool -result_ok (octave_idx_type info) -{ - assert (info != -1); - - return (info != -2); -} - -static void -solve_singularity_warning (double rcond) -{ - warning_with_id ("Octave:singular-matrix-div", - "matrix singular to machine precision, rcond = %g", rcond); -} - -template -bool -mx_leftdiv_conform (const T1& a, const T2& b, blas_trans_type blas_trans) -{ - octave_idx_type a_nr = blas_trans == blas_no_trans ? a.rows () : a.cols (); - octave_idx_type b_nr = b.rows (); - - if (a_nr != b_nr) - { - octave_idx_type a_nc = blas_trans == blas_no_trans ? a.cols () : a.rows (); - octave_idx_type b_nc = b.cols (); - - gripe_nonconformant ("operator \\", a_nr, a_nc, b_nr, b_nc); - return false; - } - - return true; -} - -#define INSTANTIATE_MX_LEFTDIV_CONFORM(T1, T2) \ - template bool mx_leftdiv_conform (const T1&, const T2&, blas_trans_type) - -INSTANTIATE_MX_LEFTDIV_CONFORM (Matrix, Matrix); -INSTANTIATE_MX_LEFTDIV_CONFORM (Matrix, ComplexMatrix); -INSTANTIATE_MX_LEFTDIV_CONFORM (ComplexMatrix, Matrix); -INSTANTIATE_MX_LEFTDIV_CONFORM (ComplexMatrix, ComplexMatrix); - -template -bool -mx_div_conform (const T1& a, const T2& b) -{ - octave_idx_type a_nc = a.cols (); - octave_idx_type b_nc = b.cols (); - - if (a_nc != b_nc) - { - octave_idx_type a_nr = a.rows (); - octave_idx_type b_nr = b.rows (); - - gripe_nonconformant ("operator /", a_nr, a_nc, b_nr, b_nc); - return false; - } - - return true; -} - -#define INSTANTIATE_MX_DIV_CONFORM(T1, T2) \ - template bool mx_div_conform (const T1&, const T2&) - -INSTANTIATE_MX_DIV_CONFORM (Matrix, Matrix); -INSTANTIATE_MX_DIV_CONFORM (Matrix, ComplexMatrix); -INSTANTIATE_MX_DIV_CONFORM (ComplexMatrix, Matrix); -INSTANTIATE_MX_DIV_CONFORM (ComplexMatrix, ComplexMatrix); - -// Right division functions. -// -// op2 / op1: m cm -// +-- +---+----+ -// matrix | 1 | 3 | -// +---+----+ -// complex_matrix | 2 | 4 | -// +---+----+ - -// -*- 1 -*- -Matrix -xdiv (const Matrix& a, const Matrix& b, MatrixType &typ) -{ - if (! mx_div_conform (a, b)) - return Matrix (); - - octave_idx_type info; - double rcond = 0.0; - - Matrix result - = b.solve (typ, a.transpose (), info, rcond, - solve_singularity_warning, true, blas_trans); - - return result.transpose (); -} - -// -*- 2 -*- -ComplexMatrix -xdiv (const Matrix& a, const ComplexMatrix& b, MatrixType &typ) -{ - if (! mx_div_conform (a, b)) - return ComplexMatrix (); - - octave_idx_type info; - double rcond = 0.0; - - ComplexMatrix result - = b.solve (typ, a.transpose (), info, rcond, - solve_singularity_warning, true, blas_trans); - - return result.transpose (); -} - -// -*- 3 -*- -ComplexMatrix -xdiv (const ComplexMatrix& a, const Matrix& b, MatrixType &typ) -{ - if (! mx_div_conform (a, b)) - return ComplexMatrix (); - - octave_idx_type info; - double rcond = 0.0; - - ComplexMatrix result - = b.solve (typ, a.transpose (), info, rcond, - solve_singularity_warning, true, blas_trans); - - return result.transpose (); -} - -// -*- 4 -*- -ComplexMatrix -xdiv (const ComplexMatrix& a, const ComplexMatrix& b, MatrixType &typ) -{ - if (! mx_div_conform (a, b)) - return ComplexMatrix (); - - octave_idx_type info; - double rcond = 0.0; - - ComplexMatrix result - = b.solve (typ, a.transpose (), info, rcond, - solve_singularity_warning, true, blas_trans); - - return result.transpose (); -} - -// Funny element by element division operations. -// -// op2 \ op1: s cs -// +-- +---+----+ -// matrix | 1 | 3 | -// +---+----+ -// complex_matrix | 2 | 4 | -// +---+----+ - -Matrix -x_el_div (double a, const Matrix& b) -{ - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.columns (); - - Matrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = a / b (i, j); - } - - return result; -} - -ComplexMatrix -x_el_div (double a, const ComplexMatrix& b) -{ - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.columns (); - - ComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = a / b (i, j); - } - - return result; -} - -ComplexMatrix -x_el_div (const Complex a, const Matrix& b) -{ - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.columns (); - - ComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = a / b (i, j); - } - - return result; -} - -ComplexMatrix -x_el_div (const Complex a, const ComplexMatrix& b) -{ - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.columns (); - - ComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = a / b (i, j); - } - - return result; -} - -// Funny element by element division operations. -// -// op2 \ op1: s cs -// +-- +---+----+ -// N-d array | 1 | 3 | -// +---+----+ -// complex N-d array | 2 | 4 | -// +---+----+ - -NDArray -x_el_div (double a, const NDArray& b) -{ - NDArray result (b.dims ()); - - for (octave_idx_type i = 0; i < b.length (); i++) - { - octave_quit (); - result (i) = a / b (i); - } - - return result; -} - -ComplexNDArray -x_el_div (double a, const ComplexNDArray& b) -{ - ComplexNDArray result (b.dims ()); - - for (octave_idx_type i = 0; i < b.length (); i++) - { - octave_quit (); - result (i) = a / b (i); - } - - return result; -} - -ComplexNDArray -x_el_div (const Complex a, const NDArray& b) -{ - ComplexNDArray result (b.dims ()); - - for (octave_idx_type i = 0; i < b.length (); i++) - { - octave_quit (); - result (i) = a / b (i); - } - - return result; -} - -ComplexNDArray -x_el_div (const Complex a, const ComplexNDArray& b) -{ - ComplexNDArray result (b.dims ()); - - for (octave_idx_type i = 0; i < b.length (); i++) - { - octave_quit (); - result (i) = a / b (i); - } - - return result; -} - -// Left division functions. -// -// op2 \ op1: m cm -// +-- +---+----+ -// matrix | 1 | 3 | -// +---+----+ -// complex_matrix | 2 | 4 | -// +---+----+ - -// -*- 1 -*- -Matrix -xleftdiv (const Matrix& a, const Matrix& b, MatrixType &typ, blas_trans_type transt) -{ - if (! mx_leftdiv_conform (a, b, transt)) - return Matrix (); - - octave_idx_type info; - double rcond = 0.0; - return a.solve (typ, b, info, rcond, solve_singularity_warning, true, transt); -} - -// -*- 2 -*- -ComplexMatrix -xleftdiv (const Matrix& a, const ComplexMatrix& b, MatrixType &typ, blas_trans_type transt) -{ - if (! mx_leftdiv_conform (a, b, transt)) - return ComplexMatrix (); - - octave_idx_type info; - double rcond = 0.0; - - return a.solve (typ, b, info, rcond, solve_singularity_warning, true, transt); -} - -// -*- 3 -*- -ComplexMatrix -xleftdiv (const ComplexMatrix& a, const Matrix& b, MatrixType &typ, blas_trans_type transt) -{ - if (! mx_leftdiv_conform (a, b, transt)) - return ComplexMatrix (); - - octave_idx_type info; - double rcond = 0.0; - return a.solve (typ, b, info, rcond, solve_singularity_warning, true, transt); -} - -// -*- 4 -*- -ComplexMatrix -xleftdiv (const ComplexMatrix& a, const ComplexMatrix& b, MatrixType &typ, blas_trans_type transt) -{ - if (! mx_leftdiv_conform (a, b, transt)) - return ComplexMatrix (); - - octave_idx_type info; - double rcond = 0.0; - return a.solve (typ, b, info, rcond, solve_singularity_warning, true, transt); -} - -static void -solve_singularity_warning (float rcond) -{ - warning ("matrix singular to machine precision, rcond = %g", rcond); - warning ("attempting to find minimum norm solution"); -} - -INSTANTIATE_MX_LEFTDIV_CONFORM (FloatMatrix, FloatMatrix); -INSTANTIATE_MX_LEFTDIV_CONFORM (FloatMatrix, FloatComplexMatrix); -INSTANTIATE_MX_LEFTDIV_CONFORM (FloatComplexMatrix, FloatMatrix); -INSTANTIATE_MX_LEFTDIV_CONFORM (FloatComplexMatrix, FloatComplexMatrix); - -INSTANTIATE_MX_DIV_CONFORM (FloatMatrix, FloatMatrix); -INSTANTIATE_MX_DIV_CONFORM (FloatMatrix, FloatComplexMatrix); -INSTANTIATE_MX_DIV_CONFORM (FloatComplexMatrix, FloatMatrix); -INSTANTIATE_MX_DIV_CONFORM (FloatComplexMatrix, FloatComplexMatrix); - -// Right division functions. -// -// op2 / op1: m cm -// +-- +---+----+ -// matrix | 1 | 3 | -// +---+----+ -// complex_matrix | 2 | 4 | -// +---+----+ - -// -*- 1 -*- -FloatMatrix -xdiv (const FloatMatrix& a, const FloatMatrix& b, MatrixType &typ) -{ - if (! mx_div_conform (a, b)) - return FloatMatrix (); - - octave_idx_type info; - float rcond = 0.0; - - FloatMatrix result - = b.solve (typ, a.transpose (), info, rcond, - solve_singularity_warning, true, blas_trans); - - return result.transpose (); -} - -// -*- 2 -*- -FloatComplexMatrix -xdiv (const FloatMatrix& a, const FloatComplexMatrix& b, MatrixType &typ) -{ - if (! mx_div_conform (a, b)) - return FloatComplexMatrix (); - - octave_idx_type info; - float rcond = 0.0; - - FloatComplexMatrix result - = b.solve (typ, a.transpose (), info, rcond, - solve_singularity_warning, true, blas_trans); - - return result.transpose (); -} - -// -*- 3 -*- -FloatComplexMatrix -xdiv (const FloatComplexMatrix& a, const FloatMatrix& b, MatrixType &typ) -{ - if (! mx_div_conform (a, b)) - return FloatComplexMatrix (); - - octave_idx_type info; - float rcond = 0.0; - - FloatComplexMatrix result - = b.solve (typ, a.transpose (), info, rcond, - solve_singularity_warning, true, blas_trans); - - return result.transpose (); -} - -// -*- 4 -*- -FloatComplexMatrix -xdiv (const FloatComplexMatrix& a, const FloatComplexMatrix& b, MatrixType &typ) -{ - if (! mx_div_conform (a, b)) - return FloatComplexMatrix (); - - octave_idx_type info; - float rcond = 0.0; - - FloatComplexMatrix result - = b.solve (typ, a.transpose (), info, rcond, - solve_singularity_warning, true, blas_trans); - - return result.transpose (); -} - -// Funny element by element division operations. -// -// op2 \ op1: s cs -// +-- +---+----+ -// matrix | 1 | 3 | -// +---+----+ -// complex_matrix | 2 | 4 | -// +---+----+ - -FloatMatrix -x_el_div (float a, const FloatMatrix& b) -{ - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.columns (); - - FloatMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = a / b (i, j); - } - - return result; -} - -FloatComplexMatrix -x_el_div (float a, const FloatComplexMatrix& b) -{ - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.columns (); - - FloatComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = a / b (i, j); - } - - return result; -} - -FloatComplexMatrix -x_el_div (const FloatComplex a, const FloatMatrix& b) -{ - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.columns (); - - FloatComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = a / b (i, j); - } - - return result; -} - -FloatComplexMatrix -x_el_div (const FloatComplex a, const FloatComplexMatrix& b) -{ - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.columns (); - - FloatComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = a / b (i, j); - } - - return result; -} - -// Funny element by element division operations. -// -// op2 \ op1: s cs -// +-- +---+----+ -// N-d array | 1 | 3 | -// +---+----+ -// complex N-d array | 2 | 4 | -// +---+----+ - -FloatNDArray -x_el_div (float a, const FloatNDArray& b) -{ - FloatNDArray result (b.dims ()); - - for (octave_idx_type i = 0; i < b.length (); i++) - { - octave_quit (); - result (i) = a / b (i); - } - - return result; -} - -FloatComplexNDArray -x_el_div (float a, const FloatComplexNDArray& b) -{ - FloatComplexNDArray result (b.dims ()); - - for (octave_idx_type i = 0; i < b.length (); i++) - { - octave_quit (); - result (i) = a / b (i); - } - - return result; -} - -FloatComplexNDArray -x_el_div (const FloatComplex a, const FloatNDArray& b) -{ - FloatComplexNDArray result (b.dims ()); - - for (octave_idx_type i = 0; i < b.length (); i++) - { - octave_quit (); - result (i) = a / b (i); - } - - return result; -} - -FloatComplexNDArray -x_el_div (const FloatComplex a, const FloatComplexNDArray& b) -{ - FloatComplexNDArray result (b.dims ()); - - for (octave_idx_type i = 0; i < b.length (); i++) - { - octave_quit (); - result (i) = a / b (i); - } - - return result; -} - -// Left division functions. -// -// op2 \ op1: m cm -// +-- +---+----+ -// matrix | 1 | 3 | -// +---+----+ -// complex_matrix | 2 | 4 | -// +---+----+ - -// -*- 1 -*- -FloatMatrix -xleftdiv (const FloatMatrix& a, const FloatMatrix& b, MatrixType &typ, blas_trans_type transt) -{ - if (! mx_leftdiv_conform (a, b, transt)) - return FloatMatrix (); - - octave_idx_type info; - float rcond = 0.0; - return a.solve (typ, b, info, rcond, solve_singularity_warning, true, transt); -} - -// -*- 2 -*- -FloatComplexMatrix -xleftdiv (const FloatMatrix& a, const FloatComplexMatrix& b, MatrixType &typ, blas_trans_type transt) -{ - if (! mx_leftdiv_conform (a, b, transt)) - return FloatComplexMatrix (); - - octave_idx_type info; - float rcond = 0.0; - - return a.solve (typ, b, info, rcond, solve_singularity_warning, true, transt); -} - -// -*- 3 -*- -FloatComplexMatrix -xleftdiv (const FloatComplexMatrix& a, const FloatMatrix& b, MatrixType &typ, blas_trans_type transt) -{ - if (! mx_leftdiv_conform (a, b, transt)) - return FloatComplexMatrix (); - - octave_idx_type info; - float rcond = 0.0; - return a.solve (typ, b, info, rcond, solve_singularity_warning, true, transt); -} - -// -*- 4 -*- -FloatComplexMatrix -xleftdiv (const FloatComplexMatrix& a, const FloatComplexMatrix& b, MatrixType &typ, blas_trans_type transt) -{ - if (! mx_leftdiv_conform (a, b, transt)) - return FloatComplexMatrix (); - - octave_idx_type info; - float rcond = 0.0; - return a.solve (typ, b, info, rcond, solve_singularity_warning, true, transt); -} - -// Diagonal matrix division. - -template -MT -mdm_div_impl (const MT& a, const DMT& d) -{ - if (! mx_div_conform (a, d)) - return MT (); - - octave_idx_type m = a.rows (), n = d.rows (), l = d.length (); - MT x (m, n); - typedef typename DMT::element_type S; - typedef typename MT::element_type T; - const T *aa = a.data (); - const S *dd = d.data (); - T *xx = x.fortran_vec (); - - for (octave_idx_type j = 0; j < l; j++) - { - const S del = dd[j]; - if (del != S ()) - for (octave_idx_type i = 0; i < m; i++) - xx[i] = aa[i] / del; - else - for (octave_idx_type i = 0; i < m; i++) - xx[i] = T (); - aa += m; xx += m; - } - - for (octave_idx_type i = l*m; i < n*m; i++) - xx[i] = T (); - - return x; -} - -// Right division functions. -// -// op2 / op1: dm cdm -// +-- +---+----+ -// matrix | 1 | | -// +---+----+ -// complex_matrix | 2 | 3 | -// +---+----+ - -// -*- 1 -*- -Matrix -xdiv (const Matrix& a, const DiagMatrix& b) -{ return mdm_div_impl (a, b); } - -// -*- 2 -*- -ComplexMatrix -xdiv (const ComplexMatrix& a, const DiagMatrix& b) -{ return mdm_div_impl (a, b); } - -// -*- 3 -*- -ComplexMatrix -xdiv (const ComplexMatrix& a, const ComplexDiagMatrix& b) -{ return mdm_div_impl (a, b); } - -// Right division functions, float type. -// -// op2 / op1: dm cdm -// +-- +---+----+ -// matrix | 1 | | -// +---+----+ -// complex_matrix | 2 | 3 | -// +---+----+ - -// -*- 1 -*- -FloatMatrix -xdiv (const FloatMatrix& a, const FloatDiagMatrix& b) -{ return mdm_div_impl (a, b); } - -// -*- 2 -*- -FloatComplexMatrix -xdiv (const FloatComplexMatrix& a, const FloatDiagMatrix& b) -{ return mdm_div_impl (a, b); } - -// -*- 3 -*- -FloatComplexMatrix -xdiv (const FloatComplexMatrix& a, const FloatComplexDiagMatrix& b) -{ return mdm_div_impl (a, b); } - -template -MT -dmm_leftdiv_impl (const DMT& d, const MT& a) -{ - if (! mx_leftdiv_conform (d, a, blas_no_trans)) - return MT (); - - octave_idx_type m = d.cols (), n = a.cols (), k = a.rows (), l = d.length (); - MT x (m, n); - typedef typename DMT::element_type S; - typedef typename MT::element_type T; - const T *aa = a.data (); - const S *dd = d.data (); - T *xx = x.fortran_vec (); - - for (octave_idx_type j = 0; j < n; j++) - { - for (octave_idx_type i = 0; i < l; i++) - xx[i] = dd[i] != S () ? aa[i] / dd[i] : T (); - for (octave_idx_type i = l; i < m; i++) - xx[i] = T (); - aa += k; xx += m; - } - - return x; -} - -// Left division functions. -// -// op2 \ op1: m cm -// +---+----+ -// diag_matrix | 1 | 2 | -// +---+----+ -// complex_diag_matrix | | 3 | -// +---+----+ - -// -*- 1 -*- -Matrix -xleftdiv (const DiagMatrix& a, const Matrix& b) -{ return dmm_leftdiv_impl (a, b); } - -// -*- 2 -*- -ComplexMatrix -xleftdiv (const DiagMatrix& a, const ComplexMatrix& b) -{ return dmm_leftdiv_impl (a, b); } - -// -*- 3 -*- -ComplexMatrix -xleftdiv (const ComplexDiagMatrix& a, const ComplexMatrix& b) -{ return dmm_leftdiv_impl (a, b); } - -// Left division functions, float type. -// -// op2 \ op1: m cm -// +---+----+ -// diag_matrix | 1 | 2 | -// +---+----+ -// complex_diag_matrix | | 3 | -// +---+----+ - -// -*- 1 -*- -FloatMatrix -xleftdiv (const FloatDiagMatrix& a, const FloatMatrix& b) -{ return dmm_leftdiv_impl (a, b); } - -// -*- 2 -*- -FloatComplexMatrix -xleftdiv (const FloatDiagMatrix& a, const FloatComplexMatrix& b) -{ return dmm_leftdiv_impl (a, b); } - -// -*- 3 -*- -FloatComplexMatrix -xleftdiv (const FloatComplexDiagMatrix& a, const FloatComplexMatrix& b) -{ return dmm_leftdiv_impl (a, b); } - -// Diagonal by diagonal matrix division. - -template -MT -dmdm_div_impl (const MT& a, const DMT& d) -{ - if (! mx_div_conform (a, d)) - return MT (); - - octave_idx_type m = a.rows (), n = d.rows (), k = d.cols (); - octave_idx_type l = std::min (m, n), lk = std::min (l, k); - MT x (m, n); - typedef typename DMT::element_type S; - typedef typename MT::element_type T; - const T *aa = a.data (); - const S *dd = d.data (); - T *xx = x.fortran_vec (); - - for (octave_idx_type i = 0; i < lk; i++) - xx[i] = dd[i] != S () ? aa[i] / dd[i] : T (); - for (octave_idx_type i = lk; i < l; i++) - xx[i] = T (); - - return x; -} - -// Right division functions. -// -// op2 / op1: dm cdm -// +-- +---+----+ -// diag_matrix | 1 | | -// +---+----+ -// complex_diag_matrix | 2 | 3 | -// +---+----+ - -// -*- 1 -*- -DiagMatrix -xdiv (const DiagMatrix& a, const DiagMatrix& b) -{ return dmdm_div_impl (a, b); } - -// -*- 2 -*- -ComplexDiagMatrix -xdiv (const ComplexDiagMatrix& a, const DiagMatrix& b) -{ return dmdm_div_impl (a, b); } - -// -*- 3 -*- -ComplexDiagMatrix -xdiv (const ComplexDiagMatrix& a, const ComplexDiagMatrix& b) -{ return dmdm_div_impl (a, b); } - -// Right division functions, float type. -// -// op2 / op1: dm cdm -// +-- +---+----+ -// diag_matrix | 1 | | -// +---+----+ -// complex_diag_matrix | 2 | 3 | -// +---+----+ - -// -*- 1 -*- -FloatDiagMatrix -xdiv (const FloatDiagMatrix& a, const FloatDiagMatrix& b) -{ return dmdm_div_impl (a, b); } - -// -*- 2 -*- -FloatComplexDiagMatrix -xdiv (const FloatComplexDiagMatrix& a, const FloatDiagMatrix& b) -{ return dmdm_div_impl (a, b); } - -// -*- 3 -*- -FloatComplexDiagMatrix -xdiv (const FloatComplexDiagMatrix& a, const FloatComplexDiagMatrix& b) -{ return dmdm_div_impl (a, b); } - -template -MT -dmdm_leftdiv_impl (const DMT& d, const MT& a) -{ - if (! mx_leftdiv_conform (d, a, blas_no_trans)) - return MT (); - - octave_idx_type m = d.cols (), n = a.cols (), k = d.rows (); - octave_idx_type l = std::min (m, n), lk = std::min (l, k); - MT x (m, n); - typedef typename DMT::element_type S; - typedef typename MT::element_type T; - const T *aa = a.data (); - const S *dd = d.data (); - T *xx = x.fortran_vec (); - - for (octave_idx_type i = 0; i < lk; i++) - xx[i] = dd[i] != S () ? aa[i] / dd[i] : T (); - for (octave_idx_type i = lk; i < l; i++) - xx[i] = T (); - - return x; -} - -// Left division functions. -// -// op2 \ op1: dm cdm -// +---+----+ -// diag_matrix | 1 | 2 | -// +---+----+ -// complex_diag_matrix | | 3 | -// +---+----+ - -// -*- 1 -*- -DiagMatrix -xleftdiv (const DiagMatrix& a, const DiagMatrix& b) -{ return dmdm_leftdiv_impl (a, b); } - -// -*- 2 -*- -ComplexDiagMatrix -xleftdiv (const DiagMatrix& a, const ComplexDiagMatrix& b) -{ return dmdm_leftdiv_impl (a, b); } - -// -*- 3 -*- -ComplexDiagMatrix -xleftdiv (const ComplexDiagMatrix& a, const ComplexDiagMatrix& b) -{ return dmdm_leftdiv_impl (a, b); } - -// Left division functions, float type. -// -// op2 \ op1: dm cdm -// +---+----+ -// diag_matrix | 1 | 2 | -// +---+----+ -// complex_diag_matrix | | 3 | -// +---+----+ - -// -*- 1 -*- -FloatDiagMatrix -xleftdiv (const FloatDiagMatrix& a, const FloatDiagMatrix& b) -{ return dmdm_leftdiv_impl (a, b); } - -// -*- 2 -*- -FloatComplexDiagMatrix -xleftdiv (const FloatDiagMatrix& a, const FloatComplexDiagMatrix& b) -{ return dmdm_leftdiv_impl (a, b); } - -// -*- 3 -*- -FloatComplexDiagMatrix -xleftdiv (const FloatComplexDiagMatrix& a, const FloatComplexDiagMatrix& b) -{ return dmdm_leftdiv_impl (a, b); } diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/xdiv.h --- a/libinterp/interp-core/xdiv.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,129 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton -Copyright (C) 2008 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_xdiv_h) -#define octave_xdiv_h 1 - -#include "mx-defs.h" -#include "MatrixType.h" - -extern Matrix xdiv (const Matrix& a, const Matrix& b, MatrixType &typ); -extern ComplexMatrix xdiv (const Matrix& a, const ComplexMatrix& b, - MatrixType &typ); -extern ComplexMatrix xdiv (const ComplexMatrix& a, const Matrix& b, - MatrixType &typ); -extern ComplexMatrix xdiv (const ComplexMatrix& a, const ComplexMatrix& b, - MatrixType &typ); - -extern Matrix x_el_div (double a, const Matrix& b); -extern ComplexMatrix x_el_div (double a, const ComplexMatrix& b); -extern ComplexMatrix x_el_div (const Complex a, const Matrix& b); -extern ComplexMatrix x_el_div (const Complex a, const ComplexMatrix& b); - -extern NDArray x_el_div (double a, const NDArray& b); -extern ComplexNDArray x_el_div (double a, const ComplexNDArray& b); -extern ComplexNDArray x_el_div (const Complex a, const NDArray& b); -extern ComplexNDArray x_el_div (const Complex a, const ComplexNDArray& b); - -extern Matrix xleftdiv (const Matrix& a, const Matrix& b, MatrixType &typ, - blas_trans_type transt = blas_no_trans); -extern ComplexMatrix xleftdiv (const Matrix& a, const ComplexMatrix& b, - MatrixType &typ, blas_trans_type transt = blas_no_trans); -extern ComplexMatrix xleftdiv (const ComplexMatrix& a, const Matrix& b, - MatrixType &typ, blas_trans_type transt = blas_no_trans); -extern ComplexMatrix xleftdiv (const ComplexMatrix& a, const ComplexMatrix& b, - MatrixType &typ, blas_trans_type transt = blas_no_trans); - -extern FloatMatrix xdiv (const FloatMatrix& a, const FloatMatrix& b, MatrixType &typ); -extern FloatComplexMatrix xdiv (const FloatMatrix& a, const FloatComplexMatrix& b, - MatrixType &typ); -extern FloatComplexMatrix xdiv (const FloatComplexMatrix& a, const FloatMatrix& b, - MatrixType &typ); -extern FloatComplexMatrix xdiv (const FloatComplexMatrix& a, const FloatComplexMatrix& b, - MatrixType &typ); - -extern FloatMatrix x_el_div (float a, const FloatMatrix& b); -extern FloatComplexMatrix x_el_div (float a, const FloatComplexMatrix& b); -extern FloatComplexMatrix x_el_div (const FloatComplex a, const FloatMatrix& b); -extern FloatComplexMatrix x_el_div (const FloatComplex a, const FloatComplexMatrix& b); - -extern FloatNDArray x_el_div (float a, const FloatNDArray& b); -extern FloatComplexNDArray x_el_div (float a, const FloatComplexNDArray& b); -extern FloatComplexNDArray x_el_div (const FloatComplex a, const FloatNDArray& b); -extern FloatComplexNDArray x_el_div (const FloatComplex a, const FloatComplexNDArray& b); - -extern FloatMatrix xleftdiv (const FloatMatrix& a, const FloatMatrix& b, MatrixType &typ, - blas_trans_type transt = blas_no_trans); -extern FloatComplexMatrix xleftdiv (const FloatMatrix& a, const FloatComplexMatrix& b, - MatrixType &typ, blas_trans_type transt = blas_no_trans); -extern FloatComplexMatrix xleftdiv (const FloatComplexMatrix& a, const FloatMatrix& b, - MatrixType &typ, blas_trans_type transt = blas_no_trans); -extern FloatComplexMatrix xleftdiv (const FloatComplexMatrix& a, const FloatComplexMatrix& b, - MatrixType &typ, blas_trans_type transt = blas_no_trans); - - -extern Matrix xdiv (const Matrix& a, const DiagMatrix& b); -extern ComplexMatrix xdiv (const ComplexMatrix& a, const DiagMatrix& b); -extern ComplexMatrix xdiv (const ComplexMatrix& a, const ComplexDiagMatrix& b); - -extern DiagMatrix xdiv (const DiagMatrix& a, const DiagMatrix& b); -extern ComplexDiagMatrix xdiv (const ComplexDiagMatrix& a, const DiagMatrix& b); -extern ComplexDiagMatrix xdiv (const ComplexDiagMatrix& a, const ComplexDiagMatrix& b); - -extern FloatMatrix xdiv (const FloatMatrix& a, const FloatDiagMatrix& b); -extern FloatComplexMatrix xdiv (const FloatComplexMatrix& a, - const FloatDiagMatrix& b); -extern FloatComplexMatrix xdiv (const FloatMatrix& a, - const FloatComplexDiagMatrix& b); -extern FloatComplexMatrix xdiv (const FloatComplexMatrix& a, - const FloatComplexDiagMatrix& b); - -extern FloatDiagMatrix xdiv (const FloatDiagMatrix& a, const FloatDiagMatrix& b); -extern FloatComplexDiagMatrix xdiv (const FloatComplexDiagMatrix& a, - const FloatDiagMatrix& b); -extern FloatComplexDiagMatrix xdiv (const FloatComplexDiagMatrix& a, - const FloatComplexDiagMatrix& b); - -extern Matrix xleftdiv (const DiagMatrix& a, const Matrix& b); -extern ComplexMatrix xleftdiv (const DiagMatrix& a, const ComplexMatrix& b); -extern ComplexMatrix xleftdiv (const ComplexDiagMatrix& a, const ComplexMatrix& b); - -extern DiagMatrix xleftdiv (const DiagMatrix& a, const DiagMatrix& b); -extern ComplexDiagMatrix xleftdiv (const DiagMatrix& a, const ComplexDiagMatrix& b); -extern ComplexDiagMatrix xleftdiv (const ComplexDiagMatrix& a, const ComplexDiagMatrix& b); - -extern FloatMatrix xleftdiv (const FloatDiagMatrix& a, - const FloatMatrix& b); -extern FloatComplexMatrix xleftdiv (const FloatDiagMatrix& a, - const FloatComplexMatrix& b); -extern FloatComplexMatrix xleftdiv (const FloatComplexDiagMatrix& a, - const FloatComplexMatrix& b); - -extern FloatDiagMatrix xleftdiv (const FloatDiagMatrix& a, - const FloatDiagMatrix& b); -extern FloatComplexDiagMatrix xleftdiv (const FloatDiagMatrix& a, - const FloatComplexDiagMatrix& b); -extern FloatComplexDiagMatrix xleftdiv (const FloatComplexDiagMatrix& a, - const FloatComplexDiagMatrix& b); - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/xgl2ps.c --- a/libinterp/interp-core/xgl2ps.c Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,36 +0,0 @@ -/* - -Copyright (C) 2009-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -/* - * Wrapper for "imported" file gl2ps.c so that config.h will be included - * before any other system or gnulib headers. - */ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#if defined (HAVE_OPENGL) - -#include "gl2ps.c" - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/xnorm.cc --- a/libinterp/interp-core/xnorm.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,212 +0,0 @@ -/* - -Copyright (C) 2008-2012 VZLU Prague, a.s. - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// author: Jaroslav Hajek - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include "oct-norm.h" - -#include "error.h" -#include "xnorm.h" -#include "ov.h" -#include "gripes.h" - -octave_value xnorm (const octave_value& x, const octave_value& p) -{ - octave_value retval; - - bool isvector = (x.columns () == 1 || x.rows () == 1); - bool iscomplex = x.is_complex_type (); - bool issparse = x.is_sparse_type (); - bool isfloat = x.is_single_type (); - - if (isfloat || x.is_double_type ()) - { - if (isvector) - { - if (isfloat & iscomplex) - retval = xnorm (x.float_complex_column_vector_value (), - p.float_value ()); - else if (isfloat) - retval = xnorm (x.float_column_vector_value (), - p.float_value ()); - else if (iscomplex) - retval = xnorm (x.complex_column_vector_value (), - p.double_value ()); - else - retval = xnorm (x.column_vector_value (), - p.double_value ()); - } - else if (issparse) - { - if (iscomplex) - retval = xnorm (x.sparse_complex_matrix_value (), - p.double_value ()); - else - retval = xnorm (x.sparse_matrix_value (), - p.double_value ()); - } - else - { - if (isfloat & iscomplex) - retval = xnorm (x.float_complex_matrix_value (), - p.float_value ()); - else if (isfloat) - retval = xnorm (x.float_matrix_value (), - p.float_value ()); - else if (iscomplex) - retval = xnorm (x.complex_matrix_value (), - p.double_value ()); - else - retval = xnorm (x.matrix_value (), - p.double_value ()); - } - } - else - gripe_wrong_type_arg ("xnorm", x, true); - - return retval; -} - -octave_value xcolnorms (const octave_value& x, const octave_value& p) -{ - octave_value retval; - - bool iscomplex = x.is_complex_type (); - bool issparse = x.is_sparse_type (); - bool isfloat = x.is_single_type (); - - if (isfloat || x.is_double_type ()) - { - if (issparse) - { - if (iscomplex) - retval = xcolnorms (x.sparse_complex_matrix_value (), - p.double_value ()); - else - retval = xcolnorms (x.sparse_matrix_value (), - p.double_value ()); - } - else - { - if (isfloat & iscomplex) - retval = xcolnorms (x.float_complex_matrix_value (), - p.float_value ()); - else if (isfloat) - retval = xcolnorms (x.float_matrix_value (), - p.float_value ()); - else if (iscomplex) - retval = xcolnorms (x.complex_matrix_value (), - p.double_value ()); - else - retval = xcolnorms (x.matrix_value (), - p.double_value ()); - } - } - else - gripe_wrong_type_arg ("xcolnorms", x, true); - - return retval; -} - -octave_value xrownorms (const octave_value& x, const octave_value& p) -{ - octave_value retval; - - bool iscomplex = x.is_complex_type (); - bool issparse = x.is_sparse_type (); - bool isfloat = x.is_single_type (); - - if (isfloat || x.is_double_type ()) - { - if (issparse) - { - if (iscomplex) - retval = xrownorms (x.sparse_complex_matrix_value (), - p.double_value ()); - else - retval = xrownorms (x.sparse_matrix_value (), - p.double_value ()); - } - else - { - if (isfloat & iscomplex) - retval = xrownorms (x.float_complex_matrix_value (), - p.float_value ()); - else if (isfloat) - retval = xrownorms (x.float_matrix_value (), - p.float_value ()); - else if (iscomplex) - retval = xrownorms (x.complex_matrix_value (), - p.double_value ()); - else - retval = xrownorms (x.matrix_value (), - p.double_value ()); - } - } - else - gripe_wrong_type_arg ("xrownorms", x, true); - - return retval; -} - -octave_value xfrobnorm (const octave_value& x) -{ - octave_value retval; - - bool iscomplex = x.is_complex_type (); - bool issparse = x.is_sparse_type (); - bool isfloat = x.is_single_type (); - - if (isfloat || x.is_double_type ()) - { - if (issparse) - { - if (iscomplex) - retval = xfrobnorm (x.sparse_complex_matrix_value ()); - else - retval = xfrobnorm (x.sparse_matrix_value ()); - } - else - { - if (isfloat & iscomplex) - retval = xfrobnorm (x.float_complex_matrix_value ()); - else if (isfloat) - retval = xfrobnorm (x.float_matrix_value ()); - else if (iscomplex) - retval = xfrobnorm (x.complex_matrix_value ()); - else - retval = xfrobnorm (x.matrix_value ()); - } - } - else - gripe_wrong_type_arg ("xfrobnorm", x, true); - - return retval; -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/xnorm.h --- a/libinterp/interp-core/xnorm.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,37 +0,0 @@ -/* - -Copyright (C) 2008-2012 VZLU Prague, a.s. - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// author: Jaroslav Hajek - -#if !defined (octave_xnorm_h) -#define octave_xnorm_h 1 - -#include "oct-norm.h" - -class octave_value; - -extern OCTINTERP_API octave_value xnorm (const octave_value& x, const octave_value& p); -extern OCTINTERP_API octave_value xcolnorms (const octave_value& x, const octave_value& p); -extern OCTINTERP_API octave_value xrownorms (const octave_value& x, const octave_value& p); -extern OCTINTERP_API octave_value xfrobnorm (const octave_value& x); - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/xpow.cc --- a/libinterp/interp-core/xpow.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2859 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include - -#include "Array-util.h" -#include "CColVector.h" -#include "CDiagMatrix.h" -#include "fCDiagMatrix.h" -#include "CMatrix.h" -#include "EIG.h" -#include "fEIG.h" -#include "dDiagMatrix.h" -#include "fDiagMatrix.h" -#include "dMatrix.h" -#include "PermMatrix.h" -#include "mx-cm-cdm.h" -#include "oct-cmplx.h" -#include "Range.h" -#include "quit.h" - -#include "error.h" -#include "oct-obj.h" -#include "utils.h" -#include "xpow.h" - -#include "bsxfun.h" - -#ifdef _OPENMP -#include -#endif - -static inline int -xisint (double x) -{ - return (D_NINT (x) == x - && ((x >= 0 && x < std::numeric_limits::max ()) - || (x <= 0 && x > std::numeric_limits::min ()))); -} - -// Safer pow functions. -// -// op2 \ op1: s m cs cm -// +-- +---+---+----+----+ -// scalar | | 1 | 5 | 7 | 11 | -// +---+---+----+----+ -// matrix | 2 | * | 8 | * | -// +---+---+----+----+ -// complex_scalar | 3 | 6 | 9 | 12 | -// +---+---+----+----+ -// complex_matrix | 4 | * | 10 | * | -// +---+---+----+----+ - -// -*- 1 -*- -octave_value -xpow (double a, double b) -{ - double retval; - - if (a < 0.0 && ! xisint (b)) - { - Complex atmp (a); - - return std::pow (atmp, b); - } - else - retval = std::pow (a, b); - - return retval; -} - -// -*- 2 -*- -octave_value -xpow (double a, const Matrix& b) -{ - octave_value retval; - - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.cols (); - - if (nr == 0 || nc == 0 || nr != nc) - error ("for x^A, A must be a square matrix"); - else - { - EIG b_eig (b); - - if (! error_state) - { - ComplexColumnVector lambda (b_eig.eigenvalues ()); - ComplexMatrix Q (b_eig.eigenvectors ()); - - for (octave_idx_type i = 0; i < nr; i++) - { - Complex elt = lambda(i); - if (std::imag (elt) == 0.0) - lambda(i) = std::pow (a, std::real (elt)); - else - lambda(i) = std::pow (a, elt); - } - ComplexDiagMatrix D (lambda); - - ComplexMatrix C = Q * D * Q.inverse (); - if (a > 0) - retval = real (C); - else - retval = C; - } - else - error ("xpow: matrix diagonalization failed"); - } - - return retval; -} - -// -*- 3 -*- -octave_value -xpow (double a, const Complex& b) -{ - Complex result = std::pow (a, b); - return result; -} - -// -*- 4 -*- -octave_value -xpow (double a, const ComplexMatrix& b) -{ - octave_value retval; - - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.cols (); - - if (nr == 0 || nc == 0 || nr != nc) - error ("for x^A, A must be a square matrix"); - else - { - EIG b_eig (b); - - if (! error_state) - { - ComplexColumnVector lambda (b_eig.eigenvalues ()); - ComplexMatrix Q (b_eig.eigenvectors ()); - - for (octave_idx_type i = 0; i < nr; i++) - { - Complex elt = lambda(i); - if (std::imag (elt) == 0.0) - lambda(i) = std::pow (a, std::real (elt)); - else - lambda(i) = std::pow (a, elt); - } - ComplexDiagMatrix D (lambda); - - retval = ComplexMatrix (Q * D * Q.inverse ()); - } - else - error ("xpow: matrix diagonalization failed"); - } - - return retval; -} - -// -*- 5 -*- -octave_value -xpow (const Matrix& a, double b) -{ - octave_value retval; - - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be a square matrix"); - else - { - if (static_cast (b) == b) - { - int btmp = static_cast (b); - if (btmp == 0) - { - retval = DiagMatrix (nr, nr, 1.0); - } - else - { - // Too much copying? - // FIXME -- we shouldn't do this if the exponent is - // large... - - Matrix atmp; - if (btmp < 0) - { - btmp = -btmp; - - octave_idx_type info; - double rcond = 0.0; - MatrixType mattype (a); - - atmp = a.inverse (mattype, info, rcond, 1); - - if (info == -1) - warning ("inverse: matrix singular to machine\ - precision, rcond = %g", rcond); - } - else - atmp = a; - - Matrix result (atmp); - - btmp--; - - while (btmp > 0) - { - if (btmp & 1) - result = result * atmp; - - btmp >>= 1; - - if (btmp > 0) - atmp = atmp * atmp; - } - - retval = result; - } - } - else - { - EIG a_eig (a); - - if (! error_state) - { - ComplexColumnVector lambda (a_eig.eigenvalues ()); - ComplexMatrix Q (a_eig.eigenvectors ()); - - for (octave_idx_type i = 0; i < nr; i++) - lambda(i) = std::pow (lambda(i), b); - - ComplexDiagMatrix D (lambda); - - retval = ComplexMatrix (Q * D * Q.inverse ()); - } - else - error ("xpow: matrix diagonalization failed"); - } - } - - return retval; -} - -// -*- 5d -*- -octave_value -xpow (const DiagMatrix& a, double b) -{ - octave_value retval; - - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be a square matrix"); - else - { - if (static_cast (b) == b) - { - DiagMatrix r (nr, nc); - for (octave_idx_type i = 0; i < nc; i++) - r.dgelem (i) = std::pow (a.dgelem (i), b); - retval = r; - } - else - { - ComplexDiagMatrix r (nr, nc); - for (octave_idx_type i = 0; i < nc; i++) - r.dgelem (i) = std::pow (static_cast (a.dgelem (i)), b); - retval = r; - } - } - - return retval; -} - -// -*- 5p -*- -octave_value -xpow (const PermMatrix& a, double b) -{ - octave_value retval; - int btmp = static_cast (b); - if (btmp == b) - return a.power (btmp); - else - return xpow (Matrix (a), b); -} - -// -*- 6 -*- -octave_value -xpow (const Matrix& a, const Complex& b) -{ - octave_value retval; - - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be a square matrix"); - else - { - EIG a_eig (a); - - if (! error_state) - { - ComplexColumnVector lambda (a_eig.eigenvalues ()); - ComplexMatrix Q (a_eig.eigenvectors ()); - - for (octave_idx_type i = 0; i < nr; i++) - lambda(i) = std::pow (lambda(i), b); - - ComplexDiagMatrix D (lambda); - - retval = ComplexMatrix (Q * D * Q.inverse ()); - } - else - error ("xpow: matrix diagonalization failed"); - } - - return retval; -} - -// -*- 7 -*- -octave_value -xpow (const Complex& a, double b) -{ - Complex result; - - if (xisint (b)) - result = std::pow (a, static_cast (b)); - else - result = std::pow (a, b); - - return result; -} - -// -*- 8 -*- -octave_value -xpow (const Complex& a, const Matrix& b) -{ - octave_value retval; - - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.cols (); - - if (nr == 0 || nc == 0 || nr != nc) - error ("for x^A, A must be a square matrix"); - else - { - EIG b_eig (b); - - if (! error_state) - { - ComplexColumnVector lambda (b_eig.eigenvalues ()); - ComplexMatrix Q (b_eig.eigenvectors ()); - - for (octave_idx_type i = 0; i < nr; i++) - { - Complex elt = lambda(i); - if (std::imag (elt) == 0.0) - lambda(i) = std::pow (a, std::real (elt)); - else - lambda(i) = std::pow (a, elt); - } - ComplexDiagMatrix D (lambda); - - retval = ComplexMatrix (Q * D * Q.inverse ()); - } - else - error ("xpow: matrix diagonalization failed"); - } - - return retval; -} - -// -*- 9 -*- -octave_value -xpow (const Complex& a, const Complex& b) -{ - Complex result; - result = std::pow (a, b); - return result; -} - -// -*- 10 -*- -octave_value -xpow (const Complex& a, const ComplexMatrix& b) -{ - octave_value retval; - - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.cols (); - - if (nr == 0 || nc == 0 || nr != nc) - error ("for x^A, A must be a square matrix"); - else - { - EIG b_eig (b); - - if (! error_state) - { - ComplexColumnVector lambda (b_eig.eigenvalues ()); - ComplexMatrix Q (b_eig.eigenvectors ()); - - for (octave_idx_type i = 0; i < nr; i++) - { - Complex elt = lambda(i); - if (std::imag (elt) == 0.0) - lambda(i) = std::pow (a, std::real (elt)); - else - lambda(i) = std::pow (a, elt); - } - ComplexDiagMatrix D (lambda); - - retval = ComplexMatrix (Q * D * Q.inverse ()); - } - else - error ("xpow: matrix diagonalization failed"); - } - - return retval; -} - -// -*- 11 -*- -octave_value -xpow (const ComplexMatrix& a, double b) -{ - octave_value retval; - - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be a square matrix"); - else - { - if (static_cast (b) == b) - { - int btmp = static_cast (b); - if (btmp == 0) - { - retval = DiagMatrix (nr, nr, 1.0); - } - else - { - // Too much copying? - // FIXME -- we shouldn't do this if the exponent is - // large... - - ComplexMatrix atmp; - if (btmp < 0) - { - btmp = -btmp; - - octave_idx_type info; - double rcond = 0.0; - MatrixType mattype (a); - - atmp = a.inverse (mattype, info, rcond, 1); - - if (info == -1) - warning ("inverse: matrix singular to machine\ - precision, rcond = %g", rcond); - } - else - atmp = a; - - ComplexMatrix result (atmp); - - btmp--; - - while (btmp > 0) - { - if (btmp & 1) - result = result * atmp; - - btmp >>= 1; - - if (btmp > 0) - atmp = atmp * atmp; - } - - retval = result; - } - } - else - { - EIG a_eig (a); - - if (! error_state) - { - ComplexColumnVector lambda (a_eig.eigenvalues ()); - ComplexMatrix Q (a_eig.eigenvectors ()); - - for (octave_idx_type i = 0; i < nr; i++) - lambda(i) = std::pow (lambda(i), b); - - ComplexDiagMatrix D (lambda); - - retval = ComplexMatrix (Q * D * Q.inverse ()); - } - else - error ("xpow: matrix diagonalization failed"); - } - } - - return retval; -} - -// -*- 12 -*- -octave_value -xpow (const ComplexMatrix& a, const Complex& b) -{ - octave_value retval; - - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be a square matrix"); - else - { - EIG a_eig (a); - - if (! error_state) - { - ComplexColumnVector lambda (a_eig.eigenvalues ()); - ComplexMatrix Q (a_eig.eigenvectors ()); - - for (octave_idx_type i = 0; i < nr; i++) - lambda(i) = std::pow (lambda(i), b); - - ComplexDiagMatrix D (lambda); - - retval = ComplexMatrix (Q * D * Q.inverse ()); - } - else - error ("xpow: matrix diagonalization failed"); - } - - return retval; -} - -// -*- 12d -*- -octave_value -xpow (const ComplexDiagMatrix& a, const Complex& b) -{ - octave_value retval; - - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be a square matrix"); - else - { - ComplexDiagMatrix r (nr, nc); - for (octave_idx_type i = 0; i < nc; i++) - r(i, i) = std::pow (a(i, i), b); - retval = r; - } - - return retval; -} - -// mixed -octave_value -xpow (const ComplexDiagMatrix& a, double b) -{ - return xpow (a, static_cast (b)); -} - -octave_value -xpow (const DiagMatrix& a, const Complex& b) -{ - return xpow (ComplexDiagMatrix (a), b); -} - - -// Safer pow functions that work elementwise for matrices. -// -// op2 \ op1: s m cs cm -// +-- +---+---+----+----+ -// scalar | | * | 3 | * | 9 | -// +---+---+----+----+ -// matrix | 1 | 4 | 7 | 10 | -// +---+---+----+----+ -// complex_scalar | * | 5 | * | 11 | -// +---+---+----+----+ -// complex_matrix | 2 | 6 | 8 | 12 | -// +---+---+----+----+ -// -// * -> not needed. - -// FIXME -- these functions need to be fixed so that things -// like -// -// a = -1; b = [ 0, 0.5, 1 ]; r = a .^ b -// -// and -// -// a = -1; b = [ 0, 0.5, 1 ]; for i = 1:3, r(i) = a .^ b(i), end -// -// produce identical results. Also, it would be nice if -1^0.5 -// produced a pure imaginary result instead of a complex number with a -// small real part. But perhaps that's really a problem with the math -// library... - -// -*- 1 -*- -octave_value -elem_xpow (double a, const Matrix& b) -{ - octave_value retval; - - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.cols (); - - double d1, d2; - - if (a < 0.0 && ! b.all_integers (d1, d2)) - { - Complex atmp (a); - ComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = std::pow (atmp, b (i, j)); - } - - retval = result; - } - else - { - Matrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = std::pow (a, b (i, j)); - } - - retval = result; - } - - return retval; -} - -// -*- 2 -*- -octave_value -elem_xpow (double a, const ComplexMatrix& b) -{ - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.cols (); - - ComplexMatrix result (nr, nc); - Complex atmp (a); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = std::pow (atmp, b (i, j)); - } - - return result; -} - -static inline bool -same_sign (double a, double b) -{ - return (a >= 0 && b >= 0) || (a <= 0 && b <= 0); -} - -octave_value -elem_xpow (double a, const Range& r) -{ - octave_value retval; - - // Only optimize powers with ranges that are integer and monotonic in - // magnitude. - if (r.nelem () > 1 && r.all_elements_are_ints () - && same_sign (r.base (), r.limit ())) - { - octave_idx_type n = r.nelem (); - Matrix result (1, n); - if (same_sign (r.base (), r.inc ())) - { - double base = std::pow (a, r.base ()); - double inc = std::pow (a, r.inc ()); - result(0) = base; - for (octave_idx_type i = 1; i < n; i++) - result(i) = (base *= inc); - } - else - { - // Don't use Range::limit () here. - double limit = std::pow (a, r.base () + (n-1) * r.inc ()); - double inc = std::pow (a, -r.inc ()); - result(n-1) = limit; - for (octave_idx_type i = n-2; i >= 0; i--) - result(i) = (limit *= inc); - } - - retval = result; - } - else - retval = elem_xpow (a, r.matrix_value ()); - - return retval; -} - -// -*- 3 -*- -octave_value -elem_xpow (const Matrix& a, double b) -{ - octave_value retval; - - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - if (! xisint (b) && a.any_element_is_negative ()) - { - ComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - - Complex atmp (a (i, j)); - - result (i, j) = std::pow (atmp, b); - } - - retval = result; - } - else - { - Matrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = std::pow (a (i, j), b); - } - - retval = result; - } - - return retval; -} - -// -*- 4 -*- -octave_value -elem_xpow (const Matrix& a, const Matrix& b) -{ - octave_value retval; - - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - - if (nr != b_nr || nc != b_nc) - { - gripe_nonconformant ("operator .^", nr, nc, b_nr, b_nc); - return octave_value (); - } - - int convert_to_complex = 0; - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - double atmp = a (i, j); - double btmp = b (i, j); - if (atmp < 0.0 && static_cast (btmp) != btmp) - { - convert_to_complex = 1; - goto done; - } - } - -done: - - if (convert_to_complex) - { - ComplexMatrix complex_result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - Complex atmp (a (i, j)); - Complex btmp (b (i, j)); - complex_result (i, j) = std::pow (atmp, btmp); - } - - retval = complex_result; - } - else - { - Matrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = std::pow (a (i, j), b (i, j)); - } - - retval = result; - } - - return retval; -} - -// -*- 5 -*- -octave_value -elem_xpow (const Matrix& a, const Complex& b) -{ - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - ComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = std::pow (Complex (a (i, j)), b); - } - - return result; -} - -// -*- 6 -*- -octave_value -elem_xpow (const Matrix& a, const ComplexMatrix& b) -{ - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - - if (nr != b_nr || nc != b_nc) - { - gripe_nonconformant ("operator .^", nr, nc, b_nr, b_nc); - return octave_value (); - } - - ComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = std::pow (Complex (a (i, j)), b (i, j)); - } - - return result; -} - -// -*- 7 -*- -octave_value -elem_xpow (const Complex& a, const Matrix& b) -{ - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.cols (); - - ComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - double btmp = b (i, j); - if (xisint (btmp)) - result (i, j) = std::pow (a, static_cast (btmp)); - else - result (i, j) = std::pow (a, btmp); - } - - return result; -} - -// -*- 8 -*- -octave_value -elem_xpow (const Complex& a, const ComplexMatrix& b) -{ - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.cols (); - - ComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = std::pow (a, b (i, j)); - } - - return result; -} - -octave_value -elem_xpow (const Complex& a, const Range& r) -{ - octave_value retval; - - // Only optimize powers with ranges that are integer and monotonic in - // magnitude. - if (r.nelem () > 1 && r.all_elements_are_ints () - && same_sign (r.base (), r.limit ())) - { - octave_idx_type n = r.nelem (); - ComplexMatrix result (1, n); - - if (same_sign (r.base (), r.inc ())) - { - Complex base = std::pow (a, r.base ()); - Complex inc = std::pow (a, r.inc ()); - result(0) = base; - for (octave_idx_type i = 1; i < n; i++) - result(i) = (base *= inc); - } - else - { - // Don't use Range::limit () here. - Complex limit = std::pow (a, r.base () + (n-1) * r.inc ()); - Complex inc = std::pow (a, -r.inc ()); - result(n-1) = limit; - for (octave_idx_type i = n-2; i >= 0; i--) - result(i) = (limit *= inc); - } - - retval = result; - } - else - retval = elem_xpow (a, r.matrix_value ()); - - - return retval; -} - -// -*- 9 -*- -octave_value -elem_xpow (const ComplexMatrix& a, double b) -{ - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - ComplexMatrix result (nr, nc); - - if (xisint (b)) - { - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = std::pow (a (i, j), static_cast (b)); - } - } - else - { - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = std::pow (a (i, j), b); - } - } - - return result; -} - -// -*- 10 -*- -octave_value -elem_xpow (const ComplexMatrix& a, const Matrix& b) -{ - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - - if (nr != b_nr || nc != b_nc) - { - gripe_nonconformant ("operator .^", nr, nc, b_nr, b_nc); - return octave_value (); - } - - ComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - double btmp = b (i, j); - if (xisint (btmp)) - result (i, j) = std::pow (a (i, j), static_cast (btmp)); - else - result (i, j) = std::pow (a (i, j), btmp); - } - - return result; -} - -// -*- 11 -*- -octave_value -elem_xpow (const ComplexMatrix& a, const Complex& b) -{ - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - ComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = std::pow (a (i, j), b); - } - - return result; -} - -// -*- 12 -*- -octave_value -elem_xpow (const ComplexMatrix& a, const ComplexMatrix& b) -{ - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - - if (nr != b_nr || nc != b_nc) - { - gripe_nonconformant ("operator .^", nr, nc, b_nr, b_nc); - return octave_value (); - } - - ComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = std::pow (a (i, j), b (i, j)); - } - - return result; -} - -// Safer pow functions that work elementwise for N-d arrays. -// -// op2 \ op1: s nd cs cnd -// +-- +---+---+----+----+ -// scalar | | * | 3 | * | 9 | -// +---+---+----+----+ -// N_d | 1 | 4 | 7 | 10 | -// +---+---+----+----+ -// complex_scalar | * | 5 | * | 11 | -// +---+---+----+----+ -// complex_N_d | 2 | 6 | 8 | 12 | -// +---+---+----+----+ -// -// * -> not needed. - -// FIXME -- these functions need to be fixed so that things -// like -// -// a = -1; b = [ 0, 0.5, 1 ]; r = a .^ b -// -// and -// -// a = -1; b = [ 0, 0.5, 1 ]; for i = 1:3, r(i) = a .^ b(i), end -// -// produce identical results. Also, it would be nice if -1^0.5 -// produced a pure imaginary result instead of a complex number with a -// small real part. But perhaps that's really a problem with the math -// library... - -// -*- 1 -*- -octave_value -elem_xpow (double a, const NDArray& b) -{ - octave_value retval; - - if (a < 0.0 && ! b.all_integers ()) - { - Complex atmp (a); - ComplexNDArray result (b.dims ()); - for (octave_idx_type i = 0; i < b.length (); i++) - { - octave_quit (); - result(i) = std::pow (atmp, b(i)); - } - - retval = result; - } - else - { - NDArray result (b.dims ()); - for (octave_idx_type i = 0; i < b.length (); i++) - { - octave_quit (); - result (i) = std::pow (a, b(i)); - } - - retval = result; - } - - return retval; -} - -// -*- 2 -*- -octave_value -elem_xpow (double a, const ComplexNDArray& b) -{ - ComplexNDArray result (b.dims ()); - - for (octave_idx_type i = 0; i < b.length (); i++) - { - octave_quit (); - result(i) = std::pow (a, b(i)); - } - - return result; -} - -// -*- 3 -*- -octave_value -elem_xpow (const NDArray& a, double b) -{ - octave_value retval; - - if (! xisint (b)) - { - if (a.any_element_is_negative ()) - { - ComplexNDArray result (a.dims ()); - - for (octave_idx_type i = 0; i < a.length (); i++) - { - octave_quit (); - - Complex atmp (a (i)); - - result(i) = std::pow (atmp, b); - } - - retval = result; - } - else - { - NDArray result (a.dims ()); - for (octave_idx_type i = 0; i < a.length (); i++) - { - octave_quit (); - result(i) = std::pow (a(i), b); - } - - retval = result; - } - } - else - { - NoAlias result (a.dims ()); - - int ib = static_cast (b); - if (ib == 2) - { - for (octave_idx_type i = 0; i < a.length (); i++) - result(i) = a(i) * a(i); - } - else if (ib == 3) - { - for (octave_idx_type i = 0; i < a.length (); i++) - result(i) = a(i) * a(i) * a(i); - } - else if (ib == -1) - { - for (octave_idx_type i = 0; i < a.length (); i++) - result(i) = 1.0 / a(i); - } - else - { - for (octave_idx_type i = 0; i < a.length (); i++) - { - octave_quit (); - result(i) = std::pow (a(i), ib); - } - } - - retval = result; - } - - return retval; -} - -// -*- 4 -*- -octave_value -elem_xpow (const NDArray& a, const NDArray& b) -{ - octave_value retval; - - dim_vector a_dims = a.dims (); - dim_vector b_dims = b.dims (); - - if (a_dims != b_dims) - { - if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) - { - //Potentially complex results - NDArray xa = octave_value_extract (a); - NDArray xb = octave_value_extract (b); - if (! xb.all_integers () && xa.any_element_is_negative ()) - return octave_value (bsxfun_pow (ComplexNDArray (xa), xb)); - else - return octave_value (bsxfun_pow (xa, xb)); - } - else - { - gripe_nonconformant ("operator .^", a_dims, b_dims); - return octave_value (); - } - } - - int len = a.length (); - - bool convert_to_complex = false; - - for (octave_idx_type i = 0; i < len; i++) - { - octave_quit (); - double atmp = a(i); - double btmp = b(i); - if (atmp < 0.0 && static_cast (btmp) != btmp) - { - convert_to_complex = true; - goto done; - } - } - -done: - - if (convert_to_complex) - { - ComplexNDArray complex_result (a_dims); - - for (octave_idx_type i = 0; i < len; i++) - { - octave_quit (); - Complex atmp (a(i)); - complex_result(i) = std::pow (atmp, b(i)); - } - - retval = complex_result; - } - else - { - NDArray result (a_dims); - - for (octave_idx_type i = 0; i < len; i++) - { - octave_quit (); - result(i) = std::pow (a(i), b(i)); - } - - retval = result; - } - - return retval; -} - -// -*- 5 -*- -octave_value -elem_xpow (const NDArray& a, const Complex& b) -{ - ComplexNDArray result (a.dims ()); - - for (octave_idx_type i = 0; i < a.length (); i++) - { - octave_quit (); - result(i) = std::pow (a(i), b); - } - - return result; -} - -// -*- 6 -*- -octave_value -elem_xpow (const NDArray& a, const ComplexNDArray& b) -{ - dim_vector a_dims = a.dims (); - dim_vector b_dims = b.dims (); - - if (a_dims != b_dims) - { - if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) - { - return bsxfun_pow (a, b); - } - else - { - gripe_nonconformant ("operator .^", a_dims, b_dims); - return octave_value (); - } - } - - ComplexNDArray result (a_dims); - - for (octave_idx_type i = 0; i < a.length (); i++) - { - octave_quit (); - result(i) = std::pow (a(i), b(i)); - } - - return result; -} - -// -*- 7 -*- -octave_value -elem_xpow (const Complex& a, const NDArray& b) -{ - ComplexNDArray result (b.dims ()); - - for (octave_idx_type i = 0; i < b.length (); i++) - { - octave_quit (); - double btmp = b(i); - if (xisint (btmp)) - result(i) = std::pow (a, static_cast (btmp)); - else - result(i) = std::pow (a, btmp); - } - - return result; -} - -// -*- 8 -*- -octave_value -elem_xpow (const Complex& a, const ComplexNDArray& b) -{ - ComplexNDArray result (b.dims ()); - - for (octave_idx_type i = 0; i < b.length (); i++) - { - octave_quit (); - result(i) = std::pow (a, b(i)); - } - - return result; -} - -// -*- 9 -*- -octave_value -elem_xpow (const ComplexNDArray& a, double b) -{ - ComplexNDArray result (a.dims ()); - - if (xisint (b)) - { - if (b == -1) - { - for (octave_idx_type i = 0; i < a.length (); i++) - result.xelem (i) = 1.0 / a(i); - } - else - { - for (octave_idx_type i = 0; i < a.length (); i++) - { - octave_quit (); - result(i) = std::pow (a(i), static_cast (b)); - } - } - } - else - { - for (octave_idx_type i = 0; i < a.length (); i++) - { - octave_quit (); - result(i) = std::pow (a(i), b); - } - } - - return result; -} - -// -*- 10 -*- -octave_value -elem_xpow (const ComplexNDArray& a, const NDArray& b) -{ - dim_vector a_dims = a.dims (); - dim_vector b_dims = b.dims (); - - if (a_dims != b_dims) - { - if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) - { - return bsxfun_pow (a, b); - } - else - { - gripe_nonconformant ("operator .^", a_dims, b_dims); - return octave_value (); - } - } - - ComplexNDArray result (a_dims); - - for (octave_idx_type i = 0; i < a.length (); i++) - { - octave_quit (); - double btmp = b(i); - if (xisint (btmp)) - result(i) = std::pow (a(i), static_cast (btmp)); - else - result(i) = std::pow (a(i), btmp); - } - - return result; -} - -// -*- 11 -*- -octave_value -elem_xpow (const ComplexNDArray& a, const Complex& b) -{ - ComplexNDArray result (a.dims ()); - - for (octave_idx_type i = 0; i < a.length (); i++) - { - octave_quit (); - result(i) = std::pow (a(i), b); - } - - return result; -} - -// -*- 12 -*- -octave_value -elem_xpow (const ComplexNDArray& a, const ComplexNDArray& b) -{ - dim_vector a_dims = a.dims (); - dim_vector b_dims = b.dims (); - - if (a_dims != b_dims) - { - if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) - { - return bsxfun_pow (a, b); - } - else - { - gripe_nonconformant ("operator .^", a_dims, b_dims); - return octave_value (); - } - } - - ComplexNDArray result (a_dims); - - for (octave_idx_type i = 0; i < a.length (); i++) - { - octave_quit (); - result(i) = std::pow (a(i), b(i)); - } - - return result; -} - -static inline int -xisint (float x) -{ - return (D_NINT (x) == x - && ((x >= 0 && x < std::numeric_limits::max ()) - || (x <= 0 && x > std::numeric_limits::min ()))); -} - -// Safer pow functions. -// -// op2 \ op1: s m cs cm -// +-- +---+---+----+----+ -// scalar | | 1 | 5 | 7 | 11 | -// +---+---+----+----+ -// matrix | 2 | * | 8 | * | -// +---+---+----+----+ -// complex_scalar | 3 | 6 | 9 | 12 | -// +---+---+----+----+ -// complex_matrix | 4 | * | 10 | * | -// +---+---+----+----+ - -// -*- 1 -*- -octave_value -xpow (float a, float b) -{ - float retval; - - if (a < 0.0 && ! xisint (b)) - { - FloatComplex atmp (a); - - return std::pow (atmp, b); - } - else - retval = std::pow (a, b); - - return retval; -} - -// -*- 2 -*- -octave_value -xpow (float a, const FloatMatrix& b) -{ - octave_value retval; - - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.cols (); - - if (nr == 0 || nc == 0 || nr != nc) - error ("for x^A, A must be a square matrix"); - else - { - FloatEIG b_eig (b); - - if (! error_state) - { - FloatComplexColumnVector lambda (b_eig.eigenvalues ()); - FloatComplexMatrix Q (b_eig.eigenvectors ()); - - for (octave_idx_type i = 0; i < nr; i++) - { - FloatComplex elt = lambda(i); - if (std::imag (elt) == 0.0) - lambda(i) = std::pow (a, std::real (elt)); - else - lambda(i) = std::pow (a, elt); - } - FloatComplexDiagMatrix D (lambda); - - FloatComplexMatrix C = Q * D * Q.inverse (); - - if (a > 0) - retval = real (C); - else - retval = C; - } - else - error ("xpow: matrix diagonalization failed"); - } - - return retval; -} - -// -*- 3 -*- -octave_value -xpow (float a, const FloatComplex& b) -{ - FloatComplex result = std::pow (a, b); - return result; -} - -// -*- 4 -*- -octave_value -xpow (float a, const FloatComplexMatrix& b) -{ - octave_value retval; - - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.cols (); - - if (nr == 0 || nc == 0 || nr != nc) - error ("for x^A, A must be a square matrix"); - else - { - FloatEIG b_eig (b); - - if (! error_state) - { - FloatComplexColumnVector lambda (b_eig.eigenvalues ()); - FloatComplexMatrix Q (b_eig.eigenvectors ()); - - for (octave_idx_type i = 0; i < nr; i++) - { - FloatComplex elt = lambda(i); - if (std::imag (elt) == 0.0) - lambda(i) = std::pow (a, std::real (elt)); - else - lambda(i) = std::pow (a, elt); - } - FloatComplexDiagMatrix D (lambda); - - retval = FloatComplexMatrix (Q * D * Q.inverse ()); - } - else - error ("xpow: matrix diagonalization failed"); - } - - return retval; -} - -// -*- 5 -*- -octave_value -xpow (const FloatMatrix& a, float b) -{ - octave_value retval; - - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be a square matrix"); - else - { - if (static_cast (b) == b) - { - int btmp = static_cast (b); - if (btmp == 0) - { - retval = FloatDiagMatrix (nr, nr, 1.0); - } - else - { - // Too much copying? - // FIXME -- we shouldn't do this if the exponent is - // large... - - FloatMatrix atmp; - if (btmp < 0) - { - btmp = -btmp; - - octave_idx_type info; - float rcond = 0.0; - MatrixType mattype (a); - - atmp = a.inverse (mattype, info, rcond, 1); - - if (info == -1) - warning ("inverse: matrix singular to machine\ - precision, rcond = %g", rcond); - } - else - atmp = a; - - FloatMatrix result (atmp); - - btmp--; - - while (btmp > 0) - { - if (btmp & 1) - result = result * atmp; - - btmp >>= 1; - - if (btmp > 0) - atmp = atmp * atmp; - } - - retval = result; - } - } - else - { - FloatEIG a_eig (a); - - if (! error_state) - { - FloatComplexColumnVector lambda (a_eig.eigenvalues ()); - FloatComplexMatrix Q (a_eig.eigenvectors ()); - - for (octave_idx_type i = 0; i < nr; i++) - lambda(i) = std::pow (lambda(i), b); - - FloatComplexDiagMatrix D (lambda); - - retval = FloatComplexMatrix (Q * D * Q.inverse ()); - } - else - error ("xpow: matrix diagonalization failed"); - } - } - - return retval; -} - -// -*- 5d -*- -octave_value -xpow (const FloatDiagMatrix& a, float b) -{ - octave_value retval; - - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be a square matrix"); - else - { - if (static_cast (b) == b) - { - FloatDiagMatrix r (nr, nc); - for (octave_idx_type i = 0; i < nc; i++) - r.dgelem (i) = std::pow (a.dgelem (i), b); - retval = r; - } - else - { - FloatComplexDiagMatrix r (nr, nc); - for (octave_idx_type i = 0; i < nc; i++) - r.dgelem (i) = std::pow (static_cast (a.dgelem (i)), b); - retval = r; - } - } - - return retval; -} - -// -*- 6 -*- -octave_value -xpow (const FloatMatrix& a, const FloatComplex& b) -{ - octave_value retval; - - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be a square matrix"); - else - { - FloatEIG a_eig (a); - - if (! error_state) - { - FloatComplexColumnVector lambda (a_eig.eigenvalues ()); - FloatComplexMatrix Q (a_eig.eigenvectors ()); - - for (octave_idx_type i = 0; i < nr; i++) - lambda(i) = std::pow (lambda(i), b); - - FloatComplexDiagMatrix D (lambda); - - retval = FloatComplexMatrix (Q * D * Q.inverse ()); - } - else - error ("xpow: matrix diagonalization failed"); - } - - return retval; -} - -// -*- 7 -*- -octave_value -xpow (const FloatComplex& a, float b) -{ - FloatComplex result; - - if (xisint (b)) - result = std::pow (a, static_cast (b)); - else - result = std::pow (a, b); - - return result; -} - -// -*- 8 -*- -octave_value -xpow (const FloatComplex& a, const FloatMatrix& b) -{ - octave_value retval; - - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.cols (); - - if (nr == 0 || nc == 0 || nr != nc) - error ("for x^A, A must be a square matrix"); - else - { - FloatEIG b_eig (b); - - if (! error_state) - { - FloatComplexColumnVector lambda (b_eig.eigenvalues ()); - FloatComplexMatrix Q (b_eig.eigenvectors ()); - - for (octave_idx_type i = 0; i < nr; i++) - { - FloatComplex elt = lambda(i); - if (std::imag (elt) == 0.0) - lambda(i) = std::pow (a, std::real (elt)); - else - lambda(i) = std::pow (a, elt); - } - FloatComplexDiagMatrix D (lambda); - - retval = FloatComplexMatrix (Q * D * Q.inverse ()); - } - else - error ("xpow: matrix diagonalization failed"); - } - - return retval; -} - -// -*- 9 -*- -octave_value -xpow (const FloatComplex& a, const FloatComplex& b) -{ - FloatComplex result; - result = std::pow (a, b); - return result; -} - -// -*- 10 -*- -octave_value -xpow (const FloatComplex& a, const FloatComplexMatrix& b) -{ - octave_value retval; - - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.cols (); - - if (nr == 0 || nc == 0 || nr != nc) - error ("for x^A, A must be a square matrix"); - else - { - FloatEIG b_eig (b); - - if (! error_state) - { - FloatComplexColumnVector lambda (b_eig.eigenvalues ()); - FloatComplexMatrix Q (b_eig.eigenvectors ()); - - for (octave_idx_type i = 0; i < nr; i++) - { - FloatComplex elt = lambda(i); - if (std::imag (elt) == 0.0) - lambda(i) = std::pow (a, std::real (elt)); - else - lambda(i) = std::pow (a, elt); - } - FloatComplexDiagMatrix D (lambda); - - retval = FloatComplexMatrix (Q * D * Q.inverse ()); - } - else - error ("xpow: matrix diagonalization failed"); - } - - return retval; -} - -// -*- 11 -*- -octave_value -xpow (const FloatComplexMatrix& a, float b) -{ - octave_value retval; - - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be a square matrix"); - else - { - if (static_cast (b) == b) - { - int btmp = static_cast (b); - if (btmp == 0) - { - retval = FloatDiagMatrix (nr, nr, 1.0); - } - else - { - // Too much copying? - // FIXME -- we shouldn't do this if the exponent is - // large... - - FloatComplexMatrix atmp; - if (btmp < 0) - { - btmp = -btmp; - - octave_idx_type info; - float rcond = 0.0; - MatrixType mattype (a); - - atmp = a.inverse (mattype, info, rcond, 1); - - if (info == -1) - warning ("inverse: matrix singular to machine\ - precision, rcond = %g", rcond); - } - else - atmp = a; - - FloatComplexMatrix result (atmp); - - btmp--; - - while (btmp > 0) - { - if (btmp & 1) - result = result * atmp; - - btmp >>= 1; - - if (btmp > 0) - atmp = atmp * atmp; - } - - retval = result; - } - } - else - { - FloatEIG a_eig (a); - - if (! error_state) - { - FloatComplexColumnVector lambda (a_eig.eigenvalues ()); - FloatComplexMatrix Q (a_eig.eigenvectors ()); - - for (octave_idx_type i = 0; i < nr; i++) - lambda(i) = std::pow (lambda(i), b); - - FloatComplexDiagMatrix D (lambda); - - retval = FloatComplexMatrix (Q * D * Q.inverse ()); - } - else - error ("xpow: matrix diagonalization failed"); - } - } - - return retval; -} - -// -*- 12 -*- -octave_value -xpow (const FloatComplexMatrix& a, const FloatComplex& b) -{ - octave_value retval; - - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be a square matrix"); - else - { - FloatEIG a_eig (a); - - if (! error_state) - { - FloatComplexColumnVector lambda (a_eig.eigenvalues ()); - FloatComplexMatrix Q (a_eig.eigenvectors ()); - - for (octave_idx_type i = 0; i < nr; i++) - lambda(i) = std::pow (lambda(i), b); - - FloatComplexDiagMatrix D (lambda); - - retval = FloatComplexMatrix (Q * D * Q.inverse ()); - } - else - error ("xpow: matrix diagonalization failed"); - } - - return retval; -} - -// -*- 12d -*- -octave_value -xpow (const FloatComplexDiagMatrix& a, const FloatComplex& b) -{ - octave_value retval; - - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - if (nr == 0 || nc == 0 || nr != nc) - error ("for A^b, A must be a square matrix"); - else - { - FloatComplexDiagMatrix r (nr, nc); - for (octave_idx_type i = 0; i < nc; i++) - r(i, i) = std::pow (a(i, i), b); - retval = r; - } - - return retval; -} - -// mixed -octave_value -xpow (const FloatComplexDiagMatrix& a, float b) -{ - return xpow (a, static_cast (b)); -} - -octave_value -xpow (const FloatDiagMatrix& a, const FloatComplex& b) -{ - return xpow (FloatComplexDiagMatrix (a), b); -} - -// Safer pow functions that work elementwise for matrices. -// -// op2 \ op1: s m cs cm -// +-- +---+---+----+----+ -// scalar | | * | 3 | * | 9 | -// +---+---+----+----+ -// matrix | 1 | 4 | 7 | 10 | -// +---+---+----+----+ -// complex_scalar | * | 5 | * | 11 | -// +---+---+----+----+ -// complex_matrix | 2 | 6 | 8 | 12 | -// +---+---+----+----+ -// -// * -> not needed. - -// FIXME -- these functions need to be fixed so that things -// like -// -// a = -1; b = [ 0, 0.5, 1 ]; r = a .^ b -// -// and -// -// a = -1; b = [ 0, 0.5, 1 ]; for i = 1:3, r(i) = a .^ b(i), end -// -// produce identical results. Also, it would be nice if -1^0.5 -// produced a pure imaginary result instead of a complex number with a -// small real part. But perhaps that's really a problem with the math -// library... - -// -*- 1 -*- -octave_value -elem_xpow (float a, const FloatMatrix& b) -{ - octave_value retval; - - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.cols (); - - float d1, d2; - - if (a < 0.0 && ! b.all_integers (d1, d2)) - { - FloatComplex atmp (a); - FloatComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = std::pow (atmp, b (i, j)); - } - - retval = result; - } - else - { - FloatMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = std::pow (a, b (i, j)); - } - - retval = result; - } - - return retval; -} - -// -*- 2 -*- -octave_value -elem_xpow (float a, const FloatComplexMatrix& b) -{ - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.cols (); - - FloatComplexMatrix result (nr, nc); - FloatComplex atmp (a); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = std::pow (atmp, b (i, j)); - } - - return result; -} - -// -*- 3 -*- -octave_value -elem_xpow (const FloatMatrix& a, float b) -{ - octave_value retval; - - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - if (! xisint (b) && a.any_element_is_negative ()) - { - FloatComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - - FloatComplex atmp (a (i, j)); - - result (i, j) = std::pow (atmp, b); - } - - retval = result; - } - else - { - FloatMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = std::pow (a (i, j), b); - } - - retval = result; - } - - return retval; -} - -// -*- 4 -*- -octave_value -elem_xpow (const FloatMatrix& a, const FloatMatrix& b) -{ - octave_value retval; - - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - - if (nr != b_nr || nc != b_nc) - { - gripe_nonconformant ("operator .^", nr, nc, b_nr, b_nc); - return octave_value (); - } - - int convert_to_complex = 0; - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - float atmp = a (i, j); - float btmp = b (i, j); - if (atmp < 0.0 && static_cast (btmp) != btmp) - { - convert_to_complex = 1; - goto done; - } - } - -done: - - if (convert_to_complex) - { - FloatComplexMatrix complex_result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - FloatComplex atmp (a (i, j)); - FloatComplex btmp (b (i, j)); - complex_result (i, j) = std::pow (atmp, btmp); - } - - retval = complex_result; - } - else - { - FloatMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = std::pow (a (i, j), b (i, j)); - } - - retval = result; - } - - return retval; -} - -// -*- 5 -*- -octave_value -elem_xpow (const FloatMatrix& a, const FloatComplex& b) -{ - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - FloatComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = std::pow (FloatComplex (a (i, j)), b); - } - - return result; -} - -// -*- 6 -*- -octave_value -elem_xpow (const FloatMatrix& a, const FloatComplexMatrix& b) -{ - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - - if (nr != b_nr || nc != b_nc) - { - gripe_nonconformant ("operator .^", nr, nc, b_nr, b_nc); - return octave_value (); - } - - FloatComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = std::pow (FloatComplex (a (i, j)), b (i, j)); - } - - return result; -} - -// -*- 7 -*- -octave_value -elem_xpow (const FloatComplex& a, const FloatMatrix& b) -{ - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.cols (); - - FloatComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - float btmp = b (i, j); - if (xisint (btmp)) - result (i, j) = std::pow (a, static_cast (btmp)); - else - result (i, j) = std::pow (a, btmp); - } - - return result; -} - -// -*- 8 -*- -octave_value -elem_xpow (const FloatComplex& a, const FloatComplexMatrix& b) -{ - octave_idx_type nr = b.rows (); - octave_idx_type nc = b.cols (); - - FloatComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = std::pow (a, b (i, j)); - } - - return result; -} - -// -*- 9 -*- -octave_value -elem_xpow (const FloatComplexMatrix& a, float b) -{ - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - FloatComplexMatrix result (nr, nc); - - if (xisint (b)) - { - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = std::pow (a (i, j), static_cast (b)); - } - } - else - { - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = std::pow (a (i, j), b); - } - } - - return result; -} - -// -*- 10 -*- -octave_value -elem_xpow (const FloatComplexMatrix& a, const FloatMatrix& b) -{ - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - - if (nr != b_nr || nc != b_nc) - { - gripe_nonconformant ("operator .^", nr, nc, b_nr, b_nc); - return octave_value (); - } - - FloatComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - float btmp = b (i, j); - if (xisint (btmp)) - result (i, j) = std::pow (a (i, j), static_cast (btmp)); - else - result (i, j) = std::pow (a (i, j), btmp); - } - - return result; -} - -// -*- 11 -*- -octave_value -elem_xpow (const FloatComplexMatrix& a, const FloatComplex& b) -{ - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - FloatComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = std::pow (a (i, j), b); - } - - return result; -} - -// -*- 12 -*- -octave_value -elem_xpow (const FloatComplexMatrix& a, const FloatComplexMatrix& b) -{ - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - - if (nr != b_nr || nc != b_nc) - { - gripe_nonconformant ("operator .^", nr, nc, b_nr, b_nc); - return octave_value (); - } - - FloatComplexMatrix result (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - result (i, j) = std::pow (a (i, j), b (i, j)); - } - - return result; -} - -// Safer pow functions that work elementwise for N-d arrays. -// -// op2 \ op1: s nd cs cnd -// +-- +---+---+----+----+ -// scalar | | * | 3 | * | 9 | -// +---+---+----+----+ -// N_d | 1 | 4 | 7 | 10 | -// +---+---+----+----+ -// complex_scalar | * | 5 | * | 11 | -// +---+---+----+----+ -// complex_N_d | 2 | 6 | 8 | 12 | -// +---+---+----+----+ -// -// * -> not needed. - -// FIXME -- these functions need to be fixed so that things -// like -// -// a = -1; b = [ 0, 0.5, 1 ]; r = a .^ b -// -// and -// -// a = -1; b = [ 0, 0.5, 1 ]; for i = 1:3, r(i) = a .^ b(i), end -// -// produce identical results. Also, it would be nice if -1^0.5 -// produced a pure imaginary result instead of a complex number with a -// small real part. But perhaps that's really a problem with the math -// library... - -// -*- 1 -*- -octave_value -elem_xpow (float a, const FloatNDArray& b) -{ - octave_value retval; - - if (a < 0.0 && ! b.all_integers ()) - { - FloatComplex atmp (a); - FloatComplexNDArray result (b.dims ()); - for (octave_idx_type i = 0; i < b.length (); i++) - { - octave_quit (); - result(i) = std::pow (atmp, b(i)); - } - - retval = result; - } - else - { - FloatNDArray result (b.dims ()); - for (octave_idx_type i = 0; i < b.length (); i++) - { - octave_quit (); - result (i) = std::pow (a, b(i)); - } - - retval = result; - } - - return retval; -} - -// -*- 2 -*- -octave_value -elem_xpow (float a, const FloatComplexNDArray& b) -{ - FloatComplexNDArray result (b.dims ()); - - for (octave_idx_type i = 0; i < b.length (); i++) - { - octave_quit (); - result(i) = std::pow (a, b(i)); - } - - return result; -} - -// -*- 3 -*- -octave_value -elem_xpow (const FloatNDArray& a, float b) -{ - octave_value retval; - - if (! xisint (b)) - { - if (a.any_element_is_negative ()) - { - FloatComplexNDArray result (a.dims ()); - - for (octave_idx_type i = 0; i < a.length (); i++) - { - octave_quit (); - - FloatComplex atmp (a (i)); - - result(i) = std::pow (atmp, b); - } - - retval = result; - } - else - { - FloatNDArray result (a.dims ()); - for (octave_idx_type i = 0; i < a.length (); i++) - { - octave_quit (); - result(i) = std::pow (a(i), b); - } - - retval = result; - } - } - else - { - NoAlias result (a.dims ()); - - int ib = static_cast (b); - if (ib == 2) - { - for (octave_idx_type i = 0; i < a.length (); i++) - result(i) = a(i) * a(i); - } - else if (ib == 3) - { - for (octave_idx_type i = 0; i < a.length (); i++) - result(i) = a(i) * a(i) * a(i); - } - else if (ib == -1) - { - for (octave_idx_type i = 0; i < a.length (); i++) - result(i) = 1.0f / a(i); - } - else - { - for (octave_idx_type i = 0; i < a.length (); i++) - { - octave_quit (); - result(i) = std::pow (a(i), ib); - } - } - - retval = result; - } - - return retval; -} - -// -*- 4 -*- -octave_value -elem_xpow (const FloatNDArray& a, const FloatNDArray& b) -{ - octave_value retval; - - dim_vector a_dims = a.dims (); - dim_vector b_dims = b.dims (); - - if (a_dims != b_dims) - { - if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) - { - //Potentially complex results - FloatNDArray xa = octave_value_extract (a); - FloatNDArray xb = octave_value_extract (b); - if (! xb.all_integers () && xa.any_element_is_negative ()) - return octave_value (bsxfun_pow (FloatComplexNDArray (xa), xb)); - else - return octave_value (bsxfun_pow (xa, xb)); - } - else - { - gripe_nonconformant ("operator .^", a_dims, b_dims); - return octave_value (); - } - } - - int len = a.length (); - - bool convert_to_complex = false; - - for (octave_idx_type i = 0; i < len; i++) - { - octave_quit (); - float atmp = a(i); - float btmp = b(i); - if (atmp < 0.0 && static_cast (btmp) != btmp) - { - convert_to_complex = true; - goto done; - } - } - -done: - - if (convert_to_complex) - { - FloatComplexNDArray complex_result (a_dims); - - for (octave_idx_type i = 0; i < len; i++) - { - octave_quit (); - FloatComplex atmp (a(i)); - complex_result(i) = std::pow (atmp, b(i)); - } - - retval = complex_result; - } - else - { - FloatNDArray result (a_dims); - - for (octave_idx_type i = 0; i < len; i++) - { - octave_quit (); - result(i) = std::pow (a(i), b(i)); - } - - retval = result; - } - - return retval; -} - -// -*- 5 -*- -octave_value -elem_xpow (const FloatNDArray& a, const FloatComplex& b) -{ - FloatComplexNDArray result (a.dims ()); - - for (octave_idx_type i = 0; i < a.length (); i++) - { - octave_quit (); - result(i) = std::pow (a(i), b); - } - - return result; -} - -// -*- 6 -*- -octave_value -elem_xpow (const FloatNDArray& a, const FloatComplexNDArray& b) -{ - dim_vector a_dims = a.dims (); - dim_vector b_dims = b.dims (); - - if (a_dims != b_dims) - { - if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) - { - return bsxfun_pow (a, b); - } - else - { - gripe_nonconformant ("operator .^", a_dims, b_dims); - return octave_value (); - } - } - - FloatComplexNDArray result (a_dims); - - for (octave_idx_type i = 0; i < a.length (); i++) - { - octave_quit (); - result(i) = std::pow (a(i), b(i)); - } - - return result; -} - -// -*- 7 -*- -octave_value -elem_xpow (const FloatComplex& a, const FloatNDArray& b) -{ - FloatComplexNDArray result (b.dims ()); - - for (octave_idx_type i = 0; i < b.length (); i++) - { - octave_quit (); - float btmp = b(i); - if (xisint (btmp)) - result(i) = std::pow (a, static_cast (btmp)); - else - result(i) = std::pow (a, btmp); - } - - return result; -} - -// -*- 8 -*- -octave_value -elem_xpow (const FloatComplex& a, const FloatComplexNDArray& b) -{ - FloatComplexNDArray result (b.dims ()); - - for (octave_idx_type i = 0; i < b.length (); i++) - { - octave_quit (); - result(i) = std::pow (a, b(i)); - } - - return result; -} - -// -*- 9 -*- -octave_value -elem_xpow (const FloatComplexNDArray& a, float b) -{ - FloatComplexNDArray result (a.dims ()); - - if (xisint (b)) - { - if (b == -1) - { - for (octave_idx_type i = 0; i < a.length (); i++) - result.xelem (i) = 1.0f / a(i); - } - else - { - for (octave_idx_type i = 0; i < a.length (); i++) - { - octave_quit (); - result(i) = std::pow (a(i), static_cast (b)); - } - } - } - else - { - for (octave_idx_type i = 0; i < a.length (); i++) - { - octave_quit (); - result(i) = std::pow (a(i), b); - } - } - - return result; -} - -// -*- 10 -*- -octave_value -elem_xpow (const FloatComplexNDArray& a, const FloatNDArray& b) -{ - dim_vector a_dims = a.dims (); - dim_vector b_dims = b.dims (); - - if (a_dims != b_dims) - { - if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) - { - return bsxfun_pow (a, b); - } - else - { - gripe_nonconformant ("operator .^", a_dims, b_dims); - return octave_value (); - } - } - - FloatComplexNDArray result (a_dims); - - for (octave_idx_type i = 0; i < a.length (); i++) - { - octave_quit (); - float btmp = b(i); - if (xisint (btmp)) - result(i) = std::pow (a(i), static_cast (btmp)); - else - result(i) = std::pow (a(i), btmp); - } - - return result; -} - -// -*- 11 -*- -octave_value -elem_xpow (const FloatComplexNDArray& a, const FloatComplex& b) -{ - FloatComplexNDArray result (a.dims ()); - - for (octave_idx_type i = 0; i < a.length (); i++) - { - octave_quit (); - result(i) = std::pow (a(i), b); - } - - return result; -} - -// -*- 12 -*- -octave_value -elem_xpow (const FloatComplexNDArray& a, const FloatComplexNDArray& b) -{ - dim_vector a_dims = a.dims (); - dim_vector b_dims = b.dims (); - - if (a_dims != b_dims) - { - if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) - { - return bsxfun_pow (a, b); - } - else - { - gripe_nonconformant ("operator .^", a_dims, b_dims); - return octave_value (); - } - } - - FloatComplexNDArray result (a_dims); - - for (octave_idx_type i = 0; i < a.length (); i++) - { - octave_quit (); - result(i) = std::pow (a(i), b(i)); - } - - return result; -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/xpow.h --- a/libinterp/interp-core/xpow.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,158 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_xpow_h) -#define octave_xpow_h 1 - -#include "oct-cmplx.h" - -class Matrix; -class ComplexMatrix; -class FloatMatrix; -class FloatComplexMatrix; -class DiagMatrix; -class ComplexDiagMatrix; -class FloatDiagMatrix; -class FloatComplexDiagMatrix; -class PermMatrix; -class NDArray; -class FloatNDArray; -class ComplexNDArray; -class FloatComplexNDArray; -class octave_value; -class Range; - -extern OCTINTERP_API octave_value xpow (double a, double b); -extern OCTINTERP_API octave_value xpow (double a, const Matrix& b); -extern OCTINTERP_API octave_value xpow (double a, const Complex& b); -extern OCTINTERP_API octave_value xpow (double a, const ComplexMatrix& b); - -extern OCTINTERP_API octave_value xpow (const Matrix& a, double b); -extern OCTINTERP_API octave_value xpow (const Matrix& a, const Complex& b); - -extern OCTINTERP_API octave_value xpow (const DiagMatrix& a, double b); -extern OCTINTERP_API octave_value xpow (const DiagMatrix& a, const Complex& b); - -extern OCTINTERP_API octave_value xpow (const PermMatrix& a, double b); - -extern OCTINTERP_API octave_value xpow (const Complex& a, double b); -extern OCTINTERP_API octave_value xpow (const Complex& a, const Matrix& b); -extern OCTINTERP_API octave_value xpow (const Complex& a, const Complex& b); -extern OCTINTERP_API octave_value xpow (const Complex& a, const ComplexMatrix& b); - -extern OCTINTERP_API octave_value xpow (const ComplexMatrix& a, double b); -extern OCTINTERP_API octave_value xpow (const ComplexMatrix& a, const Complex& b); - -extern OCTINTERP_API octave_value xpow (const ComplexDiagMatrix& a, double b); -extern OCTINTERP_API octave_value xpow (const ComplexDiagMatrix& a, const Complex& b); - -extern OCTINTERP_API octave_value elem_xpow (double a, const Matrix& b); -extern OCTINTERP_API octave_value elem_xpow (double a, const ComplexMatrix& b); -extern OCTINTERP_API octave_value elem_xpow (double a, const Range& r); - -extern OCTINTERP_API octave_value elem_xpow (const Matrix& a, double b); -extern OCTINTERP_API octave_value elem_xpow (const Matrix& a, const Matrix& b); -extern OCTINTERP_API octave_value elem_xpow (const Matrix& a, const Complex& b); -extern OCTINTERP_API octave_value elem_xpow (const Matrix& a, const ComplexMatrix& b); - -extern OCTINTERP_API octave_value elem_xpow (const Complex& a, const Matrix& b); -extern OCTINTERP_API octave_value elem_xpow (const Complex& a, const ComplexMatrix& b); -extern OCTINTERP_API octave_value elem_xpow (const Complex& a, const Range& r); - -extern OCTINTERP_API octave_value elem_xpow (const ComplexMatrix& a, double b); -extern OCTINTERP_API octave_value elem_xpow (const ComplexMatrix& a, const Matrix& b); -extern OCTINTERP_API octave_value elem_xpow (const ComplexMatrix& a, const Complex& b); -extern OCTINTERP_API octave_value elem_xpow (const ComplexMatrix& a, const ComplexMatrix& b); - - -extern OCTINTERP_API octave_value elem_xpow (double a, const NDArray& b); -extern OCTINTERP_API octave_value elem_xpow (double a, const ComplexNDArray& b); - -extern OCTINTERP_API octave_value elem_xpow (const NDArray& a, double b); -extern OCTINTERP_API octave_value elem_xpow (const NDArray& a, const NDArray& b); -extern OCTINTERP_API octave_value elem_xpow (const NDArray& a, const Complex& b); -extern OCTINTERP_API octave_value elem_xpow (const NDArray& a, const ComplexNDArray& b); - -extern OCTINTERP_API octave_value elem_xpow (const Complex& a, const NDArray& b); -extern OCTINTERP_API octave_value elem_xpow (const Complex& a, const ComplexNDArray& b); - -extern OCTINTERP_API octave_value elem_xpow (const ComplexNDArray& a, double b); -extern OCTINTERP_API octave_value elem_xpow (const ComplexNDArray& a, const NDArray& b); -extern OCTINTERP_API octave_value elem_xpow (const ComplexNDArray& a, const Complex& b); -extern OCTINTERP_API octave_value elem_xpow (const ComplexNDArray& a, const ComplexNDArray& b); - -extern OCTINTERP_API octave_value xpow (float a, float b); -extern OCTINTERP_API octave_value xpow (float a, const FloatMatrix& b); -extern OCTINTERP_API octave_value xpow (float a, const FloatComplex& b); -extern OCTINTERP_API octave_value xpow (float a, const FloatComplexMatrix& b); - -extern OCTINTERP_API octave_value xpow (const FloatMatrix& a, float b); -extern OCTINTERP_API octave_value xpow (const FloatMatrix& a, const FloatComplex& b); - -extern OCTINTERP_API octave_value xpow (const FloatDiagMatrix& a, float b); -extern OCTINTERP_API octave_value xpow (const FloatDiagMatrix& a, const FloatComplex& b); - -extern OCTINTERP_API octave_value xpow (const FloatComplex& a, float b); -extern OCTINTERP_API octave_value xpow (const FloatComplex& a, const FloatMatrix& b); -extern OCTINTERP_API octave_value xpow (const FloatComplex& a, const FloatComplex& b); -extern OCTINTERP_API octave_value xpow (const FloatComplex& a, const FloatComplexMatrix& b); - -extern OCTINTERP_API octave_value xpow (const FloatComplexMatrix& a, float b); -extern OCTINTERP_API octave_value xpow (const FloatComplexMatrix& a, const FloatComplex& b); - -extern OCTINTERP_API octave_value xpow (const FloatComplexDiagMatrix& a, float b); -extern OCTINTERP_API octave_value xpow (const FloatComplexDiagMatrix& a, const FloatComplex& b); - -extern OCTINTERP_API octave_value elem_xpow (float a, const FloatMatrix& b); -extern OCTINTERP_API octave_value elem_xpow (float a, const FloatComplexMatrix& b); - -extern OCTINTERP_API octave_value elem_xpow (const FloatMatrix& a, float b); -extern OCTINTERP_API octave_value elem_xpow (const FloatMatrix& a, const FloatMatrix& b); -extern OCTINTERP_API octave_value elem_xpow (const FloatMatrix& a, const FloatComplex& b); -extern OCTINTERP_API octave_value elem_xpow (const FloatMatrix& a, const FloatComplexMatrix& b); - -extern OCTINTERP_API octave_value elem_xpow (const FloatComplex& a, const FloatMatrix& b); -extern OCTINTERP_API octave_value elem_xpow (const FloatComplex& a, const FloatComplexMatrix& b); - -extern OCTINTERP_API octave_value elem_xpow (const FloatComplexMatrix& a, float b); -extern OCTINTERP_API octave_value elem_xpow (const FloatComplexMatrix& a, const FloatMatrix& b); -extern OCTINTERP_API octave_value elem_xpow (const FloatComplexMatrix& a, const FloatComplex& b); -extern OCTINTERP_API octave_value elem_xpow (const FloatComplexMatrix& a, const FloatComplexMatrix& b); - - -extern OCTINTERP_API octave_value elem_xpow (float a, const FloatNDArray& b); -extern OCTINTERP_API octave_value elem_xpow (float a, const FloatComplexNDArray& b); - -extern OCTINTERP_API octave_value elem_xpow (const FloatNDArray& a, float b); -extern OCTINTERP_API octave_value elem_xpow (const FloatNDArray& a, const FloatNDArray& b); -extern OCTINTERP_API octave_value elem_xpow (const FloatNDArray& a, const FloatComplex& b); -extern OCTINTERP_API octave_value elem_xpow (const FloatNDArray& a, const FloatComplexNDArray& b); - -extern OCTINTERP_API octave_value elem_xpow (const FloatComplex& a, const FloatNDArray& b); -extern OCTINTERP_API octave_value elem_xpow (const FloatComplex& a, const FloatComplexNDArray& b); - -extern OCTINTERP_API octave_value elem_xpow (const FloatComplexNDArray& a, float b); -extern OCTINTERP_API octave_value elem_xpow (const FloatComplexNDArray& a, const FloatNDArray& b); -extern OCTINTERP_API octave_value elem_xpow (const FloatComplexNDArray& a, const FloatComplex& b); -extern OCTINTERP_API octave_value elem_xpow (const FloatComplexNDArray& a, const FloatComplexNDArray& b); - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/zfstream.cc --- a/libinterp/interp-core/zfstream.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,630 +0,0 @@ -/* - -Copyright (C) 2005-2012 Ludwig Schwardt, Kevin Ruland - - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -/* - - This file is adapted from the zlib 1.2.2 contrib/iostream3 code, - written by - - Ludwig Schwardt - original version by Kevin Ruland - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "zfstream.h" - -#ifdef HAVE_ZLIB - -#include // for strcpy, strcat, strlen (mode strings) -#include // for BUFSIZ - -// Internal buffer sizes (default and "unbuffered" versions) -#define STASHED_CHARACTERS 16 -#define BIGBUFSIZE (256 * 1024 + STASHED_CHARACTERS) -#define SMALLBUFSIZE 1 - -/*****************************************************************************/ - -// Default constructor -gzfilebuf::gzfilebuf () -: file(0), io_mode(std::ios_base::openmode(0)), own_fd(false), - buffer(0), buffer_size(BIGBUFSIZE), own_buffer(true) -{ - // No buffers to start with - this->disable_buffer (); -} - -// Destructor -gzfilebuf::~gzfilebuf () -{ - // Sync output buffer and close only if responsible for file - // (i.e. attached streams should be left open at this stage) - this->sync (); - if (own_fd) - this->close (); - // Make sure internal buffer is deallocated - this->disable_buffer (); -} - -// Set compression level and strategy -int -gzfilebuf::setcompression (int comp_level, - int comp_strategy) -{ - return gzsetparams (file, comp_level, comp_strategy); -} - -// Open gzipped file -gzfilebuf* -gzfilebuf::open (const char *name, - std::ios_base::openmode mode) -{ - // Fail if file already open - if (this->is_open ()) - return 0; - // Don't support simultaneous read/write access (yet) - if ((mode & std::ios_base::in) && (mode & std::ios_base::out)) - return 0; - - // Build mode string for gzopen and check it [27.8.1.3.2] - char char_mode[6] = "\0\0\0\0\0"; - if (! this->open_mode (mode, char_mode)) - return 0; - - // Attempt to open file - if ((file = gzopen (name, char_mode)) == 0) - return 0; - - // On success, allocate internal buffer and set flags - this->enable_buffer (); - io_mode = mode; - own_fd = true; - return this; -} - -// Attach to gzipped file -gzfilebuf* -gzfilebuf::attach (int fd, - std::ios_base::openmode mode) -{ - // Fail if file already open - if (this->is_open ()) - return 0; - // Don't support simultaneous read/write access (yet) - if ((mode & std::ios_base::in) && (mode & std::ios_base::out)) - return 0; - - // Build mode string for gzdopen and check it [27.8.1.3.2] - char char_mode[6] = "\0\0\0\0\0"; - if (! this->open_mode (mode, char_mode)) - return 0; - - // Attempt to attach to file - if ((file = gzdopen (fd, char_mode)) == 0) - return 0; - - // On success, allocate internal buffer and set flags - this->enable_buffer (); - io_mode = mode; - own_fd = false; - return this; -} - -// Close gzipped file -gzfilebuf* -gzfilebuf::close () -{ - // Fail immediately if no file is open - if (! this->is_open ()) - return 0; - // Assume success - gzfilebuf* retval = this; - // Attempt to sync and close gzipped file - if (this->sync () == -1) - retval = 0; - if (gzclose (file) < 0) - retval = 0; - // File is now gone anyway (postcondition [27.8.1.3.8]) - file = 0; - own_fd = false; - // Destroy internal buffer if it exists - this->disable_buffer (); - return retval; -} - -/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ - -// Convert int open mode to mode string -bool -gzfilebuf::open_mode (std::ios_base::openmode mode, - char* c_mode) const -{ - // FIXME -- do we need testb? - // bool testb = mode & std::ios_base::binary; - bool testi = mode & std::ios_base::in; - bool testo = mode & std::ios_base::out; - bool testt = mode & std::ios_base::trunc; - bool testa = mode & std::ios_base::app; - - // Check for valid flag combinations - see [27.8.1.3.2] (Table 92) - // Original zfstream hardcoded the compression level to maximum here... - // Double the time for less than 1% size improvement seems - // excessive though - keeping it at the default level - // To change back, just append "9" to the next three mode strings - if (!testi && testo && !testt && !testa) - strcpy (c_mode, "w"); - if (!testi && testo && !testt && testa) - strcpy (c_mode, "a"); - if (!testi && testo && testt && !testa) - strcpy (c_mode, "w"); - if (testi && !testo && !testt && !testa) - strcpy (c_mode, "r"); - // No read/write mode yet -// if (testi && testo && !testt && !testa) -// strcpy(c_mode, "r+"); -// if (testi && testo && testt && !testa) -// strcpy(c_mode, "w+"); - - // Mode string should be empty for invalid combination of flags - if (strlen (c_mode) == 0) - return false; - - strcat (c_mode, "b"); - - return true; -} - -// Determine number of characters in internal get buffer -std::streamsize -gzfilebuf::showmanyc () -{ - // Calls to underflow will fail if file not opened for reading - if (! this->is_open () || !(io_mode & std::ios_base::in)) - return -1; - // Make sure get area is in use - if (this->gptr () && (this->gptr () < this->egptr ())) - return std::streamsize (this->egptr () - this->gptr ()); - else - return 0; -} - -// Puts back a character to the stream in two cases. Firstly, when there -// is no putback position available, and secondly when the character putback -// differs from the one in the file. We can only support the first case -// with gzipped files. -gzfilebuf::int_type -gzfilebuf::pbackfail (gzfilebuf::int_type c) -{ - if (this->is_open ()) - { - if (gzseek (file, this->gptr () - this->egptr () - 1, SEEK_CUR) < 0) - return traits_type::eof (); - - // Invalidates contents of the buffer - enable_buffer (); - - // Attempt to fill internal buffer from gzipped file - // (buffer must be guaranteed to exist...) - int bytes_read = gzread (file, buffer, buffer_size); - // Indicates error or EOF - if (bytes_read <= 0) - { - // Reset get area - this->setg (buffer, buffer, buffer); - return traits_type::eof (); - } - - // Make all bytes read from file available as get area - this->setg (buffer, buffer, buffer + bytes_read); - - // If next character in get area differs from putback character - // flag a failure - gzfilebuf::int_type ret = traits_type::to_int_type (*(this->gptr ())); - if (ret != c) - return traits_type::eof (); - else - return ret; - } - else - return traits_type::eof (); -} - -// Fill get area from gzipped file -gzfilebuf::int_type -gzfilebuf::underflow () -{ - // If something is left in the get area by chance, return it - // (this shouldn't normally happen, as underflow is only supposed - // to be called when gptr >= egptr, but it serves as error check) - if (this->gptr () && (this->gptr () < this->egptr ())) - return traits_type::to_int_type (*(this->gptr ())); - - // If the file hasn't been opened for reading, produce error - if (! this->is_open () || !(io_mode & std::ios_base::in)) - return traits_type::eof (); - - // Copy the final characters to the front of the buffer - int stash = 0; - if (this->eback () && buffer && buffer_size > STASHED_CHARACTERS) - { - char_type *ptr1 = buffer; - char_type *ptr2 = this->egptr () - STASHED_CHARACTERS + 1; - if (ptr2 > this->eback ()) - while (stash++ <= STASHED_CHARACTERS) - *ptr1++ = *ptr2++; - } - - // Attempt to fill internal buffer from gzipped file - // (buffer must be guaranteed to exist...) - int bytes_read = gzread (file, buffer + stash, buffer_size - stash); - - // Indicates error or EOF - if (bytes_read <= 0) - { - // Reset get area - this->setg (buffer, buffer, buffer); - return traits_type::eof (); - } - // Make all bytes read from file plus the stash available as get area - this->setg (buffer, buffer + stash, buffer + bytes_read + stash); - - // Return next character in get area - return traits_type::to_int_type (*(this->gptr ())); -} - -// Write put area to gzipped file -gzfilebuf::int_type -gzfilebuf::overflow (int_type c) -{ - // Determine whether put area is in use - if (this->pbase ()) - { - // Double-check pointer range - if (this->pptr () > this->epptr () || this->pptr () < this->pbase ()) - return traits_type::eof (); - // Add extra character to buffer if not EOF - if (! traits_type::eq_int_type (c, traits_type::eof ())) - { - *(this->pptr ()) = traits_type::to_char_type (c); - this->pbump (1); - } - // Number of characters to write to file - int bytes_to_write = this->pptr () - this->pbase (); - // Overflow doesn't fail if nothing is to be written - if (bytes_to_write > 0) - { - // If the file hasn't been opened for writing, produce error - if (! this->is_open () || !(io_mode & std::ios_base::out)) - return traits_type::eof (); - // If gzipped file won't accept all bytes written to it, fail - if (gzwrite (file, this->pbase (), bytes_to_write) != bytes_to_write) - return traits_type::eof (); - // Reset next pointer to point to pbase on success - this->pbump (-bytes_to_write); - } - } - // Write extra character to file if not EOF - else if (! traits_type::eq_int_type (c, traits_type::eof ())) - { - // If the file hasn't been opened for writing, produce error - if (! this->is_open () || !(io_mode & std::ios_base::out)) - return traits_type::eof (); - // Impromptu char buffer (allows "unbuffered" output) - char_type last_char = traits_type::to_char_type (c); - // If gzipped file won't accept this character, fail - if (gzwrite (file, &last_char, 1) != 1) - return traits_type::eof (); - } - - // If you got here, you have succeeded (even if c was EOF) - // The return value should therefore be non-EOF - if (traits_type::eq_int_type (c, traits_type::eof ())) - return traits_type::not_eof (c); - else - return c; -} - -// Assign new buffer -std::streambuf* -gzfilebuf::setbuf (char_type* p, - std::streamsize n) -{ - // First make sure stuff is sync'ed, for safety - if (this->sync () == -1) - return 0; - // If buffering is turned off on purpose via setbuf(0,0), still allocate one... - // "Unbuffered" only really refers to put [27.8.1.4.10], while get needs at - // least a buffer of size 1 (very inefficient though, therefore make it bigger?) - // This follows from [27.5.2.4.3]/12 (gptr needs to point at something, it seems) - if (!p || !n) - { - // Replace existing buffer (if any) with small internal buffer - this->disable_buffer (); - buffer = 0; - buffer_size = 0; - own_buffer = true; - this->enable_buffer (); - } - else - { - // Replace existing buffer (if any) with external buffer - this->disable_buffer (); - buffer = p; - buffer_size = n; - own_buffer = false; - this->enable_buffer (); - } - return this; -} - -// Write put area to gzipped file (i.e. ensures that put area is empty) -int -gzfilebuf::sync () -{ - return traits_type::eq_int_type (this->overflow (), traits_type::eof ()) ? -1 : 0; -} - -/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ - -// Allocate internal buffer -void -gzfilebuf::enable_buffer () -{ - // If internal buffer required, allocate one - if (own_buffer && !buffer) - { - // Check for buffered vs. "unbuffered" - if (buffer_size > 0) - { - // Allocate internal buffer - buffer = new char_type [buffer_size]; - // Get area starts empty and will be expanded by underflow as need arises - this->setg (buffer, buffer, buffer); - // Setup entire internal buffer as put area. - // The one-past-end pointer actually points to the last element of the buffer, - // so that overflow(c) can safely add the extra character c to the sequence. - // These pointers remain in place for the duration of the buffer - this->setp (buffer, buffer + buffer_size - 1); - } - else - { - // Even in "unbuffered" case, (small?) get buffer is still required - buffer_size = SMALLBUFSIZE; - buffer = new char_type [buffer_size]; - this->setg (buffer, buffer, buffer); - // "Unbuffered" means no put buffer - this->setp (0, 0); - } - } - else - { - // If buffer already allocated, reset buffer pointers just to make sure no - // stale chars are lying around - this->setg (buffer, buffer, buffer); - this->setp (buffer, buffer + buffer_size - 1); - } -} - -// Destroy internal buffer -void -gzfilebuf::disable_buffer () -{ - // If internal buffer exists, deallocate it - if (own_buffer && buffer) - { - // Preserve unbuffered status by zeroing size - if (! this->pbase ()) - buffer_size = 0; - delete[] buffer; - buffer = 0; - this->setg (0, 0, 0); - this->setp (0, 0); - } - else - { - // Reset buffer pointers to initial state if external buffer exists - this->setg (buffer, buffer, buffer); - if (buffer) - this->setp (buffer, buffer + buffer_size - 1); - else - this->setp (0, 0); - } -} - -/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ - -// Seek functions -gzfilebuf::pos_type -gzfilebuf::seekoff (off_type off, std::ios_base::seekdir way, - std::ios_base::openmode) -{ - pos_type ret = pos_type (off_type (-1)); - - if (this->is_open ()) - { - off_type computed_off = off; - - if ((io_mode & std::ios_base::in) && way == std::ios_base::cur) - computed_off += this->gptr () - this->egptr (); - - // Handle tellg/tellp as a special case up front, no need to seek - // or invalidate get/put buffers - if (off == 0 && way == std::ios_base::cur) - return pos_type (gztell (file) + computed_off); - - if (way == std::ios_base::beg) - ret = pos_type (gzseek (file, computed_off, SEEK_SET)); - else if (way == std::ios_base::cur) - ret = pos_type (gzseek (file, computed_off, SEEK_CUR)); - else - // Can't seek from end of a gzipped file, so this will give -1 - ret = pos_type (gzseek (file, computed_off, SEEK_END)); - - if (io_mode & std::ios_base::in) - // Invalidates contents of the buffer - enable_buffer (); - else - // flush contents of buffer to file - overflow (); - } - - return ret; -} - -gzfilebuf::pos_type -gzfilebuf::seekpos (pos_type sp, std::ios_base::openmode) -{ - pos_type ret = pos_type (off_type (-1)); - - if (this->is_open ()) - { - ret = pos_type (gzseek (file, sp, SEEK_SET)); - - if (io_mode & std::ios_base::in) - // Invalidates contents of the buffer - enable_buffer (); - else - // flush contents of buffer to file - overflow (); - } - - return ret; -} - -/*****************************************************************************/ - -// Default constructor initializes stream buffer -gzifstream::gzifstream () -: std::istream (0), sb () -{ this->init (&sb); } - -// Initialize stream buffer and open file -gzifstream::gzifstream (const char* name, - std::ios_base::openmode mode) -: std::istream (0), sb () -{ - this->init (&sb); - this->open (name, mode); -} - -// Initialize stream buffer and attach to file -gzifstream::gzifstream (int fd, - std::ios_base::openmode mode) -: std::istream (0), sb () -{ - this->init (&sb); - this->attach (fd, mode); -} - -// Open file and go into fail() state if unsuccessful -void -gzifstream::open (const char* name, - std::ios_base::openmode mode) -{ - if (! sb.open (name, mode | std::ios_base::in)) - this->setstate (std::ios_base::failbit); - else - this->clear (); -} - -// Attach to file and go into fail() state if unsuccessful -void -gzifstream::attach (int fd, - std::ios_base::openmode mode) -{ - if (! sb.attach (fd, mode | std::ios_base::in)) - this->setstate (std::ios_base::failbit); - else - this->clear (); -} - -// Close file -void -gzifstream::close () -{ - if (! sb.close ()) - this->setstate (std::ios_base::failbit); -} - -/*****************************************************************************/ - -// Default constructor initializes stream buffer -gzofstream::gzofstream () -: std::ostream (0), sb () -{ this->init (&sb); } - -// Initialize stream buffer and open file -gzofstream::gzofstream (const char* name, - std::ios_base::openmode mode) -: std::ostream (0), sb () -{ - this->init (&sb); - this->open (name, mode); -} - -// Initialize stream buffer and attach to file -gzofstream::gzofstream (int fd, - std::ios_base::openmode mode) -: std::ostream (0), sb () -{ - this->init (&sb); - this->attach (fd, mode); -} - -// Open file and go into fail() state if unsuccessful -void -gzofstream::open (const char* name, - std::ios_base::openmode mode) -{ - if (! sb.open (name, mode | std::ios_base::out)) - this->setstate (std::ios_base::failbit); - else - this->clear (); -} - -// Attach to file and go into fail() state if unsuccessful -void -gzofstream::attach (int fd, - std::ios_base::openmode mode) -{ - if (! sb.attach (fd, mode | std::ios_base::out)) - this->setstate (std::ios_base::failbit); - else - this->clear (); -} - -// Close file -void -gzofstream::close () -{ - if (! sb.close ()) - this->setstate (std::ios_base::failbit); -} - -#endif // HAVE_ZLIB diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interp-core/zfstream.h --- a/libinterp/interp-core/zfstream.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,515 +0,0 @@ -/* - -Copyright (C) 2005-2012 Ludwig Schwardt, Kevin Ruland - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -/* - - This file is adapted from the zlib 1.2.2 contrib/iostream3 code, - written by - - Ludwig Schwardt - original version by Kevin Ruland - -*/ - -#ifndef ZFSTREAM_H -#define ZFSTREAM_H - -#ifdef HAVE_ZLIB - -#include - -#include "zlib.h" - -/*****************************************************************************/ - -/** - * @brief Gzipped file stream buffer class. - * - * This class implements basic_filebuf for gzipped files. It doesn't yet support - * seeking (allowed by zlib but slow/limited), putback and read/write access - * (tricky). Otherwise, it attempts to be a drop-in replacement for the standard - * file streambuf. -*/ -class gzfilebuf : public std::streambuf -{ -public: - // Default constructor. - gzfilebuf (); - - // Destructor. - virtual - ~gzfilebuf (); - - /** - * @brief Set compression level and strategy on the fly. - * @param comp_level Compression level (see zlib.h for allowed values) - * @param comp_strategy Compression strategy (see zlib.h for allowed values) - * @return Z_OK on success, Z_STREAM_ERROR otherwise. - * - * Unfortunately, these parameters cannot be modified separately, as the - * previous zfstream version assumed. Since the strategy is seldom changed, - * it can default and setcompression(level) then becomes like the old - * setcompressionlevel(level). - */ - int - setcompression (int comp_level, - int comp_strategy = Z_DEFAULT_STRATEGY); - - /** - * @brief Check if file is open. - * @return True if file is open. - */ - bool - is_open () const { return (file != 0); } - - /** - * @brief Open gzipped file. - * @param name File name. - * @param mode Open mode flags. - * @return @c this on success, NULL on failure. - */ - gzfilebuf* - open (const char* name, - std::ios_base::openmode mode); - - /** - * @brief Attach to already open gzipped file. - * @param fd File descriptor. - * @param mode Open mode flags. - * @return @c this on success, NULL on failure. - */ - gzfilebuf* - attach (int fd, - std::ios_base::openmode mode); - - /** - * @brief Close gzipped file. - * @return @c this on success, NULL on failure. - */ - gzfilebuf* - close (); - -protected: - /** - * @brief Convert ios open mode int to mode string used by zlib. - * @return True if valid mode flag combination. - */ - bool - open_mode (std::ios_base::openmode mode, - char* c_mode) const; - - /** - * @brief Number of characters available in stream buffer. - * @return Number of characters. - * - * This indicates number of characters in get area of stream buffer. - * These characters can be read without accessing the gzipped file. - */ - virtual std::streamsize - showmanyc (); - - /** - * @brief Fill get area from gzipped file. - * @return First character in get area on success, EOF on error. - * - * This actually reads characters from gzipped file to stream - * buffer. Always buffered. - */ - virtual int_type - underflow (); - - /** - * @brief Write put area to gzipped file. - * @param c Extra character to add to buffer contents. - * @return Non-EOF on success, EOF on error. - * - * This actually writes characters in stream buffer to - * gzipped file. With unbuffered output this is done one - * character at a time. - */ - virtual int_type - overflow (int_type c = traits_type::eof ()); - - /** - * @brief Installs external stream buffer. - * @param p Pointer to char buffer. - * @param n Size of external buffer. - * @return @c this on success, NULL on failure. - * - * Call setbuf(0,0) to enable unbuffered output. - */ - virtual std::streambuf* - setbuf (char_type* p, - std::streamsize n); - - /** - * @brief Flush stream buffer to file. - * @return 0 on success, -1 on error. - * - * This calls underflow(EOF) to do the job. - */ - virtual int - sync (); - - /** - * @brief Alters the stream positions. - * - * Each derived class provides its own appropriate behavior. - */ - virtual pos_type - seekoff (off_type off, std::ios_base::seekdir way, - std::ios_base::openmode mode = - std::ios_base::in|std::ios_base::out); - - /** - * @brief Alters the stream positions. - * - * Each derived class provides its own appropriate behavior. - */ - virtual pos_type - seekpos (pos_type sp, std::ios_base::openmode mode = - std::ios_base::in|std::ios_base::out); - - virtual int_type - pbackfail (int_type c = traits_type::eof ()); - -// -// Some future enhancements -// -// virtual int_type uflow(); -// virtual int_type pbackfail(int_type c = traits_type::eof()); - -private: - - // No copying! - - gzfilebuf (const gzfilebuf&); - - gzfilebuf& operator = (const gzfilebuf&); - - /** - * @brief Allocate internal buffer. - * - * This function is safe to call multiple times. It will ensure - * that a proper internal buffer exists if it is required. If the - * buffer already exists or is external, the buffer pointers will be - * reset to their original state. - */ - void - enable_buffer (); - - /** - * @brief Destroy internal buffer. - * - * This function is safe to call multiple times. It will ensure - * that the internal buffer is deallocated if it exists. In any - * case, it will also reset the buffer pointers. - */ - void - disable_buffer (); - - /** - * Underlying file pointer. - */ - gzFile file; - - /** - * Mode in which file was opened. - */ - std::ios_base::openmode io_mode; - - /** - * @brief True if this object owns file descriptor. - * - * This makes the class responsible for closing the file - * upon destruction. - */ - bool own_fd; - - /** - * @brief Stream buffer. - * - * For simplicity this remains allocated on the free store for the - * entire life span of the gzfilebuf object, unless replaced by setbuf. - */ - char_type* buffer; - - /** - * @brief Stream buffer size. - * - * Defaults to system default buffer size (typically 8192 bytes). - * Modified by setbuf. - */ - std::streamsize buffer_size; - - /** - * @brief True if this object owns stream buffer. - * - * This makes the class responsible for deleting the buffer - * upon destruction. - */ - bool own_buffer; -}; - -/*****************************************************************************/ - -/** - * @brief Gzipped file input stream class. - * - * This class implements ifstream for gzipped files. Seeking and putback - * is not supported yet. -*/ -class gzifstream : public std::istream -{ -public: - // Default constructor - gzifstream (); - - /** - * @brief Construct stream on gzipped file to be opened. - * @param name File name. - * @param mode Open mode flags (forced to contain ios::in). - */ - explicit - gzifstream (const char* name, - std::ios_base::openmode mode = std::ios_base::in); - - /** - * @brief Construct stream on already open gzipped file. - * @param fd File descriptor. - * @param mode Open mode flags (forced to contain ios::in). - */ - explicit - gzifstream (int fd, - std::ios_base::openmode mode = std::ios_base::in); - - /** - * Obtain underlying stream buffer. - */ - gzfilebuf* - rdbuf () const - { return const_cast(&sb); } - - /** - * @brief Check if file is open. - * @return True if file is open. - */ - bool - is_open () { return sb.is_open (); } - - /** - * @brief Open gzipped file. - * @param name File name. - * @param mode Open mode flags (forced to contain ios::in). - * - * Stream will be in state good() if file opens successfully; - * otherwise in state fail(). This differs from the behavior of - * ifstream, which never sets the state to good() and therefore - * won't allow you to reuse the stream for a second file unless - * you manually clear() the state. The choice is a matter of - * convenience. - */ - void - open (const char* name, - std::ios_base::openmode mode = std::ios_base::in); - - /** - * @brief Attach to already open gzipped file. - * @param fd File descriptor. - * @param mode Open mode flags (forced to contain ios::in). - * - * Stream will be in state good() if attach succeeded; otherwise - * in state fail(). - */ - void - attach (int fd, - std::ios_base::openmode mode = std::ios_base::in); - - /** - * @brief Close gzipped file. - * - * Stream will be in state fail() if close failed. - */ - void - close (); - -private: - /** - * Underlying stream buffer. - */ - gzfilebuf sb; -}; - -/*****************************************************************************/ - -/** - * @brief Gzipped file output stream class. - * - * This class implements ofstream for gzipped files. Seeking and putback - * is not supported yet. -*/ -class gzofstream : public std::ostream -{ -public: - // Default constructor - gzofstream (); - - /** - * @brief Construct stream on gzipped file to be opened. - * @param name File name. - * @param mode Open mode flags (forced to contain ios::out). - */ - explicit - gzofstream (const char* name, - std::ios_base::openmode mode = std::ios_base::out); - - /** - * @brief Construct stream on already open gzipped file. - * @param fd File descriptor. - * @param mode Open mode flags (forced to contain ios::out). - */ - explicit - gzofstream (int fd, - std::ios_base::openmode mode = std::ios_base::out); - - /** - * Obtain underlying stream buffer. - */ - gzfilebuf* - rdbuf () const - { return const_cast(&sb); } - - /** - * @brief Check if file is open. - * @return True if file is open. - */ - bool - is_open () { return sb.is_open (); } - - /** - * @brief Open gzipped file. - * @param name File name. - * @param mode Open mode flags (forced to contain ios::out). - * - * Stream will be in state good() if file opens successfully; - * otherwise in state fail(). This differs from the behavior of - * ofstream, which never sets the state to good() and therefore - * won't allow you to reuse the stream for a second file unless - * you manually clear() the state. The choice is a matter of - * convenience. - */ - void - open (const char* name, - std::ios_base::openmode mode = std::ios_base::out); - - /** - * @brief Attach to already open gzipped file. - * @param fd File descriptor. - * @param mode Open mode flags (forced to contain ios::out). - * - * Stream will be in state good() if attach succeeded; otherwise - * in state fail(). - */ - void - attach (int fd, - std::ios_base::openmode mode = std::ios_base::out); - - /** - * @brief Close gzipped file. - * - * Stream will be in state fail() if close failed. - */ - void - close (); - -private: - /** - * Underlying stream buffer. - */ - gzfilebuf sb; -}; - -/*****************************************************************************/ - -/** - * @brief Gzipped file output stream manipulator class. - * - * This class defines a two-argument manipulator for gzofstream. It is used - * as base for the setcompression(int,int) manipulator. -*/ -template - class gzomanip2 - { - public: - // Allows insertor to peek at internals - template - friend gzofstream& - operator<<(gzofstream&, - const gzomanip2&); - - // Constructor - gzomanip2 (gzofstream& (*f)(gzofstream&, T1, T2), - T1 v1, - T2 v2); - private: - // Underlying manipulator function - gzofstream& - (*func)(gzofstream&, T1, T2); - - // Arguments for manipulator function - T1 val1; - T2 val2; - }; - -/*****************************************************************************/ - -// Manipulator function thunks through to stream buffer -inline gzofstream& -setcompression (gzofstream &gzs, int l, int s = Z_DEFAULT_STRATEGY) -{ - (gzs.rdbuf ())->setcompression (l, s); - return gzs; -} - -// Manipulator constructor stores arguments -template - inline - gzomanip2::gzomanip2 (gzofstream &(*f)(gzofstream &, T1, T2), - T1 v1, - T2 v2) - : func(f), val1(v1), val2(v2) - { } - -// Insertor applies underlying manipulator function to stream -template - inline gzofstream& - operator<<(gzofstream& s, const gzomanip2& m) - { return (*m.func)(s, m.val1, m.val2); } - -// Insert this onto stream to simplify setting of compression level -inline gzomanip2 -setcompression (int l, int s = Z_DEFAULT_STRATEGY) -{ return gzomanip2(&setcompression, l, s); } - -#endif // HAVE_ZLIB - -#endif // ZFSTREAM_H diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/data.cc --- a/libinterp/interpfcn/data.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,7432 +0,0 @@ -/* - -Copyright (C) 1994-2012 John W. Eaton -Copyright (C) 2009 Jaroslav Hajek -Copyright (C) 2009-2010 VZLU Prague -Copyright (C) 2012 Carlo de Falco - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#ifdef HAVE_SYS_RESOURCE_H -#include -#endif - -#include -#include - -#include - -#include "lo-ieee.h" -#include "lo-math.h" -#include "oct-base64.h" -#include "oct-time.h" -#include "str-vec.h" -#include "quit.h" -#include "mx-base.h" -#include "oct-binmap.h" - -#include "Cell.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "oct-map.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-class.h" -#include "ov-float.h" -#include "ov-complex.h" -#include "ov-flt-complex.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-cx-sparse.h" -#include "parse.h" -#include "pt-mat.h" -#include "utils.h" -#include "variables.h" -#include "pager.h" -#include "xnorm.h" - -#if ! defined (CLOCKS_PER_SEC) -#if defined (CLK_TCK) -#define CLOCKS_PER_SEC CLK_TCK -#else -#error "no definition for CLOCKS_PER_SEC!" -#endif -#endif - -#if ! defined (HAVE_HYPOTF) && defined (HAVE__HYPOTF) -#define hypotf _hypotf -#define HAVE_HYPOTF 1 -#endif - -#define ANY_ALL(FCN) \ - \ - octave_value retval; \ - \ - int nargin = args.length (); \ - \ - if (nargin == 1 || nargin == 2) \ - { \ - int dim = (nargin == 1 ? -1 : args(1).int_value (true) - 1); \ - \ - if (! error_state) \ - { \ - if (dim >= -1) \ - retval = args(0).FCN (dim); \ - else \ - error (#FCN ": invalid dimension argument = %d", dim + 1); \ - } \ - else \ - error (#FCN ": expecting dimension argument to be an integer"); \ - } \ - else \ - print_usage (); \ - \ - return retval - -DEFUN (all, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} all (@var{x})\n\ -@deftypefnx {Built-in Function} {} all (@var{x}, @var{dim})\n\ -For a vector argument, return true (logical 1) if all elements of the vector\n\ -are nonzero.\n\ -\n\ -For a matrix argument, return a row vector of logical ones and\n\ -zeros with each element indicating whether all of the elements of the\n\ -corresponding column of the matrix are nonzero. For example:\n\ -\n\ -@example\n\ -@group\n\ -all ([2, 3; 1, 0]))\n\ - @result{} [ 1, 0 ]\n\ -@end group\n\ -@end example\n\ -\n\ -If the optional argument @var{dim} is supplied, work along dimension\n\ -@var{dim}.\n\ -@seealso{any}\n\ -@end deftypefn") -{ - ANY_ALL (all); -} - -/* -%!test -%! x = ones (3); -%! x(1,1) = 0; -%! assert (all (all (rand (3) + 1) == [1, 1, 1]) == 1); -%! assert (all (all (x) == [0, 1, 1]) == 1); -%! assert (all (x, 1) == [0, 1, 1]); -%! assert (all (x, 2) == [0; 1; 1]); - -%!test -%! x = ones (3, "single"); -%! x(1,1) = 0; -%! assert (all (all (single (rand (3) + 1)) == [1, 1, 1]) == 1); -%! assert (all (all (x) == [0, 1, 1]) == 1); -%! assert (all (x, 1) == [0, 1, 1]); -%! assert (all (x, 2) == [0; 1; 1]); - -%!error all () -%!error all (1, 2, 3) -*/ - -DEFUN (any, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} any (@var{x})\n\ -@deftypefnx {Built-in Function} {} any (@var{x}, @var{dim})\n\ -For a vector argument, return true (logical 1) if any element of the vector\n\ -is nonzero.\n\ -\n\ -For a matrix argument, return a row vector of logical ones and\n\ -zeros with each element indicating whether any of the elements of the\n\ -corresponding column of the matrix are nonzero. For example:\n\ -\n\ -@example\n\ -@group\n\ -any (eye (2, 4))\n\ - @result{} [ 1, 1, 0, 0 ]\n\ -@end group\n\ -@end example\n\ -\n\ -If the optional argument @var{dim} is supplied, work along dimension\n\ -@var{dim}. For example:\n\ -\n\ -@example\n\ -@group\n\ -any (eye (2, 4), 2)\n\ - @result{} [ 1; 1 ]\n\ -@end group\n\ -@end example\n\ -@seealso{all}\n\ -@end deftypefn") -{ - ANY_ALL (any); -} - -/* -%!test -%! x = zeros (3); -%! x(3,3) = 1; -%! assert (all (any (x) == [0, 0, 1]) == 1); -%! assert (all (any (ones (3)) == [1, 1, 1]) == 1); -%! assert (any (x, 1) == [0, 0, 1]); -%! assert (any (x, 2) == [0; 0; 1]); - -%!test -%! x = zeros (3, "single"); -%! x(3,3) = 1; -%! assert (all (any (x) == [0, 0, 1]) == 1); -%! assert (all (any (ones (3, "single")) == [1, 1, 1]) == 1); -%! assert (any (x, 1) == [0, 0, 1]); -%! assert (any (x, 2) == [0; 0; 1]); - -%!error any () -%!error any (1, 2, 3) -*/ - -// These mapping functions may also be useful in other places, eh? - -DEFUN (atan2, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} atan2 (@var{y}, @var{x})\n\ -Compute atan (@var{y} / @var{x}) for corresponding elements of @var{y}\n\ -and @var{x}. Signal an error if @var{y} and @var{x} do not match in size\n\ -and orientation.\n\ -@seealso{tan, tand, tanh, atanh}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2) - { - if (! args(0).is_numeric_type ()) - gripe_wrong_type_arg ("atan2", args(0)); - else if (! args(1).is_numeric_type ()) - gripe_wrong_type_arg ("atan2", args(1)); - else if (args(0).is_complex_type () || args(1).is_complex_type ()) - error ("atan2: not defined for complex numbers"); - else if (args(0).is_single_type () || args(1).is_single_type ()) - { - if (args(0).is_scalar_type () && args(1).is_scalar_type ()) - retval = atan2f (args(0).float_value (), args(1).float_value ()); - else - { - FloatNDArray a0 = args(0).float_array_value (); - FloatNDArray a1 = args(1).float_array_value (); - retval = binmap (a0, a1, ::atan2f, "atan2"); - } - } - else - { - bool a0_scalar = args(0).is_scalar_type (); - bool a1_scalar = args(1).is_scalar_type (); - if (a0_scalar && a1_scalar) - retval = atan2 (args(0).scalar_value (), args(1).scalar_value ()); - else if ((a0_scalar || args(0).is_sparse_type ()) - && (a1_scalar || args(1).is_sparse_type ())) - { - SparseMatrix m0 = args(0).sparse_matrix_value (); - SparseMatrix m1 = args(1).sparse_matrix_value (); - retval = binmap (m0, m1, ::atan2, "atan2"); - } - else - { - NDArray a0 = args(0).array_value (); - NDArray a1 = args(1).array_value (); - retval = binmap (a0, a1, ::atan2, "atan2"); - } - } - } - else - print_usage (); - - return retval; -} - -/* -%!assert (size (atan2 (zeros (0, 2), zeros (0, 2))), [0, 2]) -%!assert (size (atan2 (rand (2, 3, 4), zeros (2, 3, 4))), [2, 3, 4]) -%!assert (size (atan2 (rand (2, 3, 4), 1)), [2, 3, 4]) -%!assert (size (atan2 (1, rand (2, 3, 4))), [2, 3, 4]) -%!assert (size (atan2 (1, 2)), [1, 1]) - -%!test -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); -%! v = [0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]; -%! y = [0, rt3, 1, rt3, -rt3, -1, -rt3, 0]; -%! x = [1, 3, 1, 1, 1, 1, 3, 1]; -%! assert (atan2 (y, x), v, sqrt (eps)); - -%!test -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); -%! v = single ([0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]); -%! y = single ([0, rt3, 1, rt3, -rt3, -1, -rt3, 0]); -%! x = single ([1, 3, 1, 1, 1, 1, 3, 1]); -%! assert (atan2 (y, x), v, sqrt (eps ("single"))); - -%!error atan2 () -%!error atan2 (1, 2, 3) -*/ - - -static octave_value -do_hypot (const octave_value& x, const octave_value& y) -{ - octave_value retval; - - octave_value arg0 = x, arg1 = y; - if (! arg0.is_numeric_type ()) - gripe_wrong_type_arg ("hypot", arg0); - else if (! arg1.is_numeric_type ()) - gripe_wrong_type_arg ("hypot", arg1); - else - { - if (arg0.is_complex_type ()) - arg0 = arg0.abs (); - if (arg1.is_complex_type ()) - arg1 = arg1.abs (); - - if (arg0.is_single_type () || arg1.is_single_type ()) - { - if (arg0.is_scalar_type () && arg1.is_scalar_type ()) - retval = hypotf (arg0.float_value (), arg1.float_value ()); - else - { - FloatNDArray a0 = arg0.float_array_value (); - FloatNDArray a1 = arg1.float_array_value (); - retval = binmap (a0, a1, ::hypotf, "hypot"); - } - } - else - { - bool a0_scalar = arg0.is_scalar_type (); - bool a1_scalar = arg1.is_scalar_type (); - if (a0_scalar && a1_scalar) - retval = hypot (arg0.scalar_value (), arg1.scalar_value ()); - else if ((a0_scalar || arg0.is_sparse_type ()) - && (a1_scalar || arg1.is_sparse_type ())) - { - SparseMatrix m0 = arg0.sparse_matrix_value (); - SparseMatrix m1 = arg1.sparse_matrix_value (); - retval = binmap (m0, m1, ::hypot, "hypot"); - } - else - { - NDArray a0 = arg0.array_value (); - NDArray a1 = arg1.array_value (); - retval = binmap (a0, a1, ::hypot, "hypot"); - } - } - } - - return retval; -} - -DEFUN (hypot, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} hypot (@var{x}, @var{y})\n\ -@deftypefnx {Built-in Function} {} hypot (@var{x}, @var{y}, @var{z}, @dots{})\n\ -Compute the element-by-element square root of the sum of the squares of\n\ -@var{x} and @var{y}. This is equivalent to\n\ -@code{sqrt (@var{x}.^2 + @var{y}.^2)}, but calculated in a manner that\n\ -avoids overflows for large values of @var{x} or @var{y}.\n\ -@code{hypot} can also be called with more than 2 arguments; in this case,\n\ -the arguments are accumulated from left to right:\n\ -\n\ -@example\n\ -@group\n\ -hypot (hypot (@var{x}, @var{y}), @var{z})\n\ -hypot (hypot (hypot (@var{x}, @var{y}), @var{z}), @var{w}), etc.\n\ -@end group\n\ -@end example\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2) - { - retval = do_hypot (args(0), args(1)); - } - else if (nargin >= 3) - { - retval = args(0); - for (int i = 1; i < nargin && ! error_state; i++) - retval = do_hypot (retval, args(i)); - } - else - print_usage (); - - return retval; -} - -/* -%!assert (size (hypot (zeros (0, 2), zeros (0, 2))), [0, 2]) -%!assert (size (hypot (rand (2, 3, 4), zeros (2, 3, 4))), [2, 3, 4]) -%!assert (size (hypot (rand (2, 3, 4), 1)), [2, 3, 4]) -%!assert (size (hypot (1, rand (2, 3, 4))), [2, 3, 4]) -%!assert (size (hypot (1, 2)), [1, 1]) -%!assert (hypot (1:10, 1:10), sqrt (2) * [1:10], 16*eps) -%!assert (hypot (single (1:10), single (1:10)), single (sqrt (2) * [1:10])) -*/ - -template -void -map_2_xlog2 (const Array& x, Array& f, Array& e) -{ - f = Array(x.dims ()); - e = Array(x.dims ()); - for (octave_idx_type i = 0; i < x.numel (); i++) - { - int exp; - f.xelem (i) = xlog2 (x(i), exp); - e.xelem (i) = exp; - } -} - -DEFUN (log2, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} log2 (@var{x})\n\ -@deftypefnx {Mapping Function} {[@var{f}, @var{e}] =} log2 (@var{x})\n\ -Compute the base-2 logarithm of each element of @var{x}.\n\ -\n\ -If called with two output arguments, split @var{x} into\n\ -binary mantissa and exponent so that\n\ -@tex\n\ -${1 \\over 2} \\le \\left| f \\right| < 1$\n\ -@end tex\n\ -@ifnottex\n\ -@code{1/2 <= abs(f) < 1}\n\ -@end ifnottex\n\ -and @var{e} is an integer. If\n\ -@tex\n\ -$x = 0$, $f = e = 0$.\n\ -@end tex\n\ -@ifnottex\n\ -@code{x = 0}, @code{f = e = 0}.\n\ -@end ifnottex\n\ -@seealso{pow2, log, log10, exp}\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - if (nargout < 2) - retval(0) = args(0).log2 (); - else if (args(0).is_single_type ()) - { - if (args(0).is_real_type ()) - { - FloatNDArray f; - FloatNDArray x = args(0).float_array_value (); - // FIXME -- should E be an int value? - FloatMatrix e; - map_2_xlog2 (x, f, e); - retval(1) = e; - retval(0) = f; - } - else if (args(0).is_complex_type ()) - { - FloatComplexNDArray f; - FloatComplexNDArray x = args(0).float_complex_array_value (); - // FIXME -- should E be an int value? - FloatNDArray e; - map_2_xlog2 (x, f, e); - retval(1) = e; - retval(0) = f; - } - } - else if (args(0).is_real_type ()) - { - NDArray f; - NDArray x = args(0).array_value (); - // FIXME -- should E be an int value? - Matrix e; - map_2_xlog2 (x, f, e); - retval(1) = e; - retval(0) = f; - } - else if (args(0).is_complex_type ()) - { - ComplexNDArray f; - ComplexNDArray x = args(0).complex_array_value (); - // FIXME -- should E be an int value? - NDArray e; - map_2_xlog2 (x, f, e); - retval(1) = e; - retval(0) = f; - } - else - gripe_wrong_type_arg ("log2", args(0)); - } - else - print_usage (); - - return retval; -} - -/* -%!assert (log2 ([1/4, 1/2, 1, 2, 4]), [-2, -1, 0, 1, 2]) -%!assert (log2 (Inf), Inf) -%!assert (isnan (log2 (NaN))) -%!assert (log2 (4*i), 2 + log2 (1*i)) -%!assert (log2 (complex (0,Inf)), Inf + log2 (i)) - -%!test -%! [f, e] = log2 ([0,-1; 2,-4; Inf,-Inf]); -%! assert (f, [0,-0.5; 0.5,-0.5; Inf,-Inf]); -%! assert (e(1:2,:), [0,1;2,3]); - -%!test -%! [f, e] = log2 (complex (zeros (3, 2), [0,-1; 2,-4; Inf,-Inf])); -%! assert (f, complex (zeros (3, 2), [0,-0.5; 0.5,-0.5; Inf,-Inf])); -%! assert (e(1:2,:), [0,1; 2,3]); -*/ - -DEFUN (rem, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} rem (@var{x}, @var{y})\n\ -@deftypefnx {Mapping Function} {} fmod (@var{x}, @var{y})\n\ -Return the remainder of the division @code{@var{x} / @var{y}}, computed\n\ -using the expression\n\ -\n\ -@example\n\ -x - y .* fix (x ./ y)\n\ -@end example\n\ -\n\ -An error message is printed if the dimensions of the arguments do not\n\ -agree, or if either of the arguments is complex.\n\ -@seealso{mod}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2) - { - if (! args(0).is_numeric_type ()) - gripe_wrong_type_arg ("rem", args(0)); - else if (! args(1).is_numeric_type ()) - gripe_wrong_type_arg ("rem", args(1)); - else if (args(0).is_complex_type () || args(1).is_complex_type ()) - error ("rem: not defined for complex numbers"); - else if (args(0).is_integer_type () || args(1).is_integer_type ()) - { - builtin_type_t btyp0 = args(0).builtin_type (); - builtin_type_t btyp1 = args(1).builtin_type (); - if (btyp0 == btyp_double || btyp0 == btyp_float) - btyp0 = btyp1; - if (btyp1 == btyp_double || btyp1 == btyp_float) - btyp1 = btyp0; - - if (btyp0 == btyp1) - { - switch (btyp0) - { -#define MAKE_INT_BRANCH(X) \ - case btyp_ ## X: \ - { \ - X##NDArray a0 = args(0).X##_array_value (); \ - X##NDArray a1 = args(1).X##_array_value (); \ - retval = binmap (a0, a1, rem, "rem"); \ - } \ - break - MAKE_INT_BRANCH (int8); - MAKE_INT_BRANCH (int16); - MAKE_INT_BRANCH (int32); - MAKE_INT_BRANCH (int64); - MAKE_INT_BRANCH (uint8); - MAKE_INT_BRANCH (uint16); - MAKE_INT_BRANCH (uint32); - MAKE_INT_BRANCH (uint64); -#undef MAKE_INT_BRANCH - default: - panic_impossible (); - } - } - else - error ("rem: cannot combine %s and %d", - args(0).class_name ().c_str (), args(1).class_name ().c_str ()); - } - else if (args(0).is_single_type () || args(1).is_single_type ()) - { - if (args(0).is_scalar_type () && args(1).is_scalar_type ()) - retval = xrem (args(0).float_value (), args(1).float_value ()); - else - { - FloatNDArray a0 = args(0).float_array_value (); - FloatNDArray a1 = args(1).float_array_value (); - retval = binmap (a0, a1, xrem, "rem"); - } - } - else - { - bool a0_scalar = args(0).is_scalar_type (); - bool a1_scalar = args(1).is_scalar_type (); - if (a0_scalar && a1_scalar) - retval = xrem (args(0).scalar_value (), args(1).scalar_value ()); - else if ((a0_scalar || args(0).is_sparse_type ()) - && (a1_scalar || args(1).is_sparse_type ())) - { - SparseMatrix m0 = args(0).sparse_matrix_value (); - SparseMatrix m1 = args(1).sparse_matrix_value (); - retval = binmap (m0, m1, xrem, "rem"); - } - else - { - NDArray a0 = args(0).array_value (); - NDArray a1 = args(1).array_value (); - retval = binmap (a0, a1, xrem, "rem"); - } - } - } - else - print_usage (); - - return retval; -} - -/* -%!assert (rem ([1, 2, 3; -1, -2, -3], 2), [1, 0, 1; -1, 0, -1]) -%!assert (rem ([1, 2, 3; -1, -2, -3], 2 * ones (2, 3)),[1, 0, 1; -1, 0, -1]) -%!assert (rem (uint8 ([1, 2, 3; -1, -2, -3]), uint8 (2)), uint8 ([1, 0, 1; -1, 0, -1])) -%!assert (uint8 (rem ([1, 2, 3; -1, -2, -3], 2 * ones (2, 3))),uint8 ([1, 0, 1; -1, 0, -1])) - -%!error rem (uint (8), int8 (5)) -%!error rem (uint8 ([1, 2]), uint8 ([3, 4, 5])) -%!error rem () -%!error rem (1, 2, 3) -%!error rem ([1, 2], [3, 4, 5]) -%!error rem (i, 1) -*/ - -/* - -%!assert (size (fmod (zeros (0, 2), zeros (0, 2))), [0, 2]) -%!assert (size (fmod (rand (2, 3, 4), zeros (2, 3, 4))), [2, 3, 4]) -%!assert (size (fmod (rand (2, 3, 4), 1)), [2, 3, 4]) -%!assert (size (fmod (1, rand (2, 3, 4))), [2, 3, 4]) -%!assert (size (fmod (1, 2)), [1, 1]) -*/ - -DEFALIAS (fmod, rem) - -DEFUN (mod, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} mod (@var{x}, @var{y})\n\ -Compute the modulo of @var{x} and @var{y}. Conceptually this is given by\n\ -\n\ -@example\n\ -x - y .* floor (x ./ y)\n\ -@end example\n\ -\n\ -@noindent\n\ -and is written such that the correct modulus is returned for\n\ -integer types. This function handles negative values correctly. That\n\ -is, @code{mod (-1, 3)} is 2, not -1, as @code{rem (-1, 3)} returns.\n\ -@code{mod (@var{x}, 0)} returns @var{x}.\n\ -\n\ -An error results if the dimensions of the arguments do not agree, or if\n\ -either of the arguments is complex.\n\ -@seealso{rem}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2) - { - if (! args(0).is_numeric_type ()) - gripe_wrong_type_arg ("mod", args(0)); - else if (! args(1).is_numeric_type ()) - gripe_wrong_type_arg ("mod", args(1)); - else if (args(0).is_complex_type () || args(1).is_complex_type ()) - error ("mod: not defined for complex numbers"); - else if (args(0).is_integer_type () || args(1).is_integer_type ()) - { - builtin_type_t btyp0 = args(0).builtin_type (); - builtin_type_t btyp1 = args(1).builtin_type (); - if (btyp0 == btyp_double || btyp0 == btyp_float) - btyp0 = btyp1; - if (btyp1 == btyp_double || btyp1 == btyp_float) - btyp1 = btyp0; - - if (btyp0 == btyp1) - { - switch (btyp0) - { -#define MAKE_INT_BRANCH(X) \ - case btyp_ ## X: \ - { \ - X##NDArray a0 = args(0).X##_array_value (); \ - X##NDArray a1 = args(1).X##_array_value (); \ - retval = binmap (a0, a1, mod, "mod"); \ - } \ - break - MAKE_INT_BRANCH (int8); - MAKE_INT_BRANCH (int16); - MAKE_INT_BRANCH (int32); - MAKE_INT_BRANCH (int64); - MAKE_INT_BRANCH (uint8); - MAKE_INT_BRANCH (uint16); - MAKE_INT_BRANCH (uint32); - MAKE_INT_BRANCH (uint64); -#undef MAKE_INT_BRANCH - default: - panic_impossible (); - } - } - else - error ("mod: cannot combine %s and %d", - args(0).class_name ().c_str (), args(1).class_name ().c_str ()); - } - else if (args(0).is_single_type () || args(1).is_single_type ()) - { - if (args(0).is_scalar_type () && args(1).is_scalar_type ()) - retval = xmod (args(0).float_value (), args(1).float_value ()); - else - { - FloatNDArray a0 = args(0).float_array_value (); - FloatNDArray a1 = args(1).float_array_value (); - retval = binmap (a0, a1, xmod, "mod"); - } - } - else - { - bool a0_scalar = args(0).is_scalar_type (); - bool a1_scalar = args(1).is_scalar_type (); - if (a0_scalar && a1_scalar) - retval = xmod (args(0).scalar_value (), args(1).scalar_value ()); - else if ((a0_scalar || args(0).is_sparse_type ()) - && (a1_scalar || args(1).is_sparse_type ())) - { - SparseMatrix m0 = args(0).sparse_matrix_value (); - SparseMatrix m1 = args(1).sparse_matrix_value (); - retval = binmap (m0, m1, xmod, "mod"); - } - else - { - NDArray a0 = args(0).array_value (); - NDArray a1 = args(1).array_value (); - retval = binmap (a0, a1, xmod, "mod"); - } - } - } - else - print_usage (); - - return retval; -} - -/* -## empty input test -%!assert (isempty (mod ([], []))) - -## x mod y, y != 0 tests -%!assert (mod (5, 3), 2) -%!assert (mod (-5, 3), 1) -%!assert (mod (0, 3), 0) -%!assert (mod ([-5, 5, 0], [3, 3, 3]), [1, 2, 0]) -%!assert (mod ([-5; 5; 0], [3; 3; 3]), [1; 2; 0]) -%!assert (mod ([-5, 5; 0, 3], [3, 3 ; 3, 1]), [1, 2 ; 0, 0]) - -## x mod 0 tests -%!assert (mod (5, 0), 5) -%!assert (mod (-5, 0), -5) -%!assert (mod ([-5, 5, 0], [3, 0, 3]), [1, 5, 0]) -%!assert (mod ([-5; 5; 0], [3; 0; 3]), [1; 5; 0]) -%!assert (mod ([-5, 5; 0, 3], [3, 0 ; 3, 1]), [1, 5 ; 0, 0]) -%!assert (mod ([-5, 5; 0, 3], [0, 0 ; 0, 0]), [-5, 5; 0, 3]) - -## mixed scalar/matrix tests -%!assert (mod ([-5, 5; 0, 3], 0), [-5, 5; 0, 3]) -%!assert (mod ([-5, 5; 0, 3], 3), [1, 2; 0, 0]) -%!assert (mod (-5, [0,0; 0,0]), [-5, -5; -5, -5]) -%!assert (mod (-5, [3,0; 3,1]), [1, -5; 1, 0]) -%!assert (mod (-5, [3,2; 3,1]), [1, 1; 1, 0]) - -## integer types -%!assert (mod (uint8 (5), uint8 (4)), uint8 (1)) -%!assert (mod (uint8 ([1:5]), uint8 (4)), uint8 ([1,2,3,0,1])) -%!assert (mod (uint8 ([1:5]), uint8 (0)), uint8 ([1:5])) -%!error (mod (uint8 (5), int8 (4))) - -## mixed integer/real types -%!assert (mod (uint8 (5), 4), uint8 (1)) -%!assert (mod (5, uint8 (4)), uint8 (1)) -%!assert (mod (uint8 ([1:5]), 4), uint8 ([1,2,3,0,1])) - -## non-integer real numbers -%!assert (mod (2.1, 0.1), 0) -%!assert (mod (2.1, 0.2), 0.1, eps) -*/ - -// FIXME: Need to convert the reduction functions of this file for single precision - -#define NATIVE_REDUCTION_1(FCN, TYPE, DIM) \ - (arg.is_ ## TYPE ## _type ()) \ - { \ - TYPE ## NDArray tmp = arg. TYPE ##_array_value (); \ - \ - if (! error_state) \ - { \ - retval = tmp.FCN (DIM); \ - } \ - } - -#define NATIVE_REDUCTION(FCN, BOOL_FCN) \ - \ - octave_value retval; \ - \ - int nargin = args.length (); \ - \ - bool isnative = false; \ - bool isdouble = false; \ - \ - if (nargin > 1 && args(nargin - 1).is_string ()) \ - { \ - std::string str = args(nargin - 1).string_value (); \ - \ - if (! error_state) \ - { \ - if (str == "native") \ - isnative = true; \ - else if (str == "double") \ - isdouble = true; \ - else \ - error ("sum: unrecognized string argument"); \ - nargin --; \ - } \ - } \ - \ - if (nargin == 1 || nargin == 2) \ - { \ - octave_value arg = args(0); \ - \ - int dim = (nargin == 1 ? -1 : args(1).int_value (true) - 1); \ - \ - if (! error_state) \ - { \ - if (dim >= -1) \ - { \ - if (arg.is_sparse_type ()) \ - { \ - if (arg.is_real_type ()) \ - { \ - SparseMatrix tmp = arg.sparse_matrix_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else \ - { \ - SparseComplexMatrix tmp = arg.sparse_complex_matrix_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - } \ - else \ - { \ - if (isnative) \ - { \ - if NATIVE_REDUCTION_1 (FCN, uint8, dim) \ - else if NATIVE_REDUCTION_1 (FCN, uint16, dim) \ - else if NATIVE_REDUCTION_1 (FCN, uint32, dim) \ - else if NATIVE_REDUCTION_1 (FCN, uint64, dim) \ - else if NATIVE_REDUCTION_1 (FCN, int8, dim) \ - else if NATIVE_REDUCTION_1 (FCN, int16, dim) \ - else if NATIVE_REDUCTION_1 (FCN, int32, dim) \ - else if NATIVE_REDUCTION_1 (FCN, int64, dim) \ - else if (arg.is_bool_type ()) \ - { \ - boolNDArray tmp = arg.bool_array_value (); \ - if (! error_state) \ - retval = boolNDArray (tmp.BOOL_FCN (dim)); \ - } \ - else if (arg.is_char_matrix ()) \ - { \ - error (#FCN, ": invalid char type"); \ - } \ - else if (!isdouble && arg.is_single_type ()) \ - { \ - if (arg.is_complex_type ()) \ - { \ - FloatComplexNDArray tmp = \ - arg.float_complex_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else if (arg.is_real_type ()) \ - { \ - FloatNDArray tmp = arg.float_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - } \ - else if (arg.is_complex_type ()) \ - { \ - ComplexNDArray tmp = arg.complex_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else if (arg.is_real_type ()) \ - { \ - NDArray tmp = arg.array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else \ - { \ - gripe_wrong_type_arg (#FCN, arg); \ - return retval; \ - } \ - } \ - else if (arg.is_bool_type ()) \ - { \ - boolNDArray tmp = arg.bool_array_value (); \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else if (!isdouble && arg.is_single_type ()) \ - { \ - if (arg.is_real_type ()) \ - { \ - FloatNDArray tmp = arg.float_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else if (arg.is_complex_type ()) \ - { \ - FloatComplexNDArray tmp = \ - arg.float_complex_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - } \ - else if (arg.is_real_type ()) \ - { \ - NDArray tmp = arg.array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else if (arg.is_complex_type ()) \ - { \ - ComplexNDArray tmp = arg.complex_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else \ - { \ - gripe_wrong_type_arg (#FCN, arg); \ - return retval; \ - } \ - } \ - } \ - else \ - error (#FCN ": invalid dimension argument = %d", dim + 1); \ - } \ - \ - } \ - else \ - print_usage (); \ - \ - return retval - -#define DATA_REDUCTION(FCN) \ - \ - octave_value retval; \ - \ - int nargin = args.length (); \ - \ - if (nargin == 1 || nargin == 2) \ - { \ - octave_value arg = args(0); \ - \ - int dim = (nargin == 1 ? -1 : args(1).int_value (true) - 1); \ - \ - if (! error_state) \ - { \ - if (dim >= -1) \ - { \ - if (arg.is_real_type ()) \ - { \ - if (arg.is_sparse_type ()) \ - { \ - SparseMatrix tmp = arg.sparse_matrix_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else if (arg.is_single_type ()) \ - { \ - FloatNDArray tmp = arg.float_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else \ - { \ - NDArray tmp = arg.array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - } \ - else if (arg.is_complex_type ()) \ - { \ - if (arg.is_sparse_type ()) \ - { \ - SparseComplexMatrix tmp = arg.sparse_complex_matrix_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else if (arg.is_single_type ()) \ - { \ - FloatComplexNDArray tmp = arg.float_complex_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else \ - { \ - ComplexNDArray tmp = arg.complex_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - } \ - else \ - { \ - gripe_wrong_type_arg (#FCN, arg); \ - return retval; \ - } \ - } \ - else \ - error (#FCN ": invalid dimension argument = %d", dim + 1); \ - } \ - } \ - else \ - print_usage (); \ - \ - return retval - -DEFUN (cumprod, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} cumprod (@var{x})\n\ -@deftypefnx {Built-in Function} {} cumprod (@var{x}, @var{dim})\n\ -Cumulative product of elements along dimension @var{dim}. If\n\ -@var{dim} is omitted, it defaults to the first non-singleton dimension.\n\ -\n\ -@seealso{prod, cumsum}\n\ -@end deftypefn") -{ - DATA_REDUCTION (cumprod); -} - -/* -%!assert (cumprod ([1, 2, 3]), [1, 2, 6]) -%!assert (cumprod ([-1; -2; -3]), [-1; 2; -6]) -%!assert (cumprod ([i, 2+i, -3+2i, 4]), [i, -1+2i, -1-8i, -4-32i]) -%!assert (cumprod ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i]), [1, 2, 3; i, 4i, 9i; -1+i, -8+8i, -27+27i]) - -%!assert (cumprod (single ([1, 2, 3])), single ([1, 2, 6])) -%!assert (cumprod (single ([-1; -2; -3])), single ([-1; 2; -6])) -%!assert (cumprod (single ([i, 2+i, -3+2i, 4])), single ([i, -1+2i, -1-8i, -4-32i])) -%!assert (cumprod (single ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single ([1, 2, 3; i, 4i, 9i; -1+i, -8+8i, -27+27i])) - -%!assert (cumprod ([2, 3; 4, 5], 1), [2, 3; 8, 15]) -%!assert (cumprod ([2, 3; 4, 5], 2), [2, 6; 4, 20]) - -%!assert (cumprod (single ([2, 3; 4, 5]), 1), single ([2, 3; 8, 15])) -%!assert (cumprod (single ([2, 3; 4, 5]), 2), single ([2, 6; 4, 20])) - -%!error cumprod () -*/ - -DEFUN (cumsum, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} cumsum (@var{x})\n\ -@deftypefnx {Built-in Function} {} cumsum (@var{x}, @var{dim})\n\ -@deftypefnx {Built-in Function} {} cumsum (@dots{}, \"native\")\n\ -@deftypefnx {Built-in Function} {} cumsum (@dots{}, \"double\")\n\ -@deftypefnx {Built-in Function} {} cumsum (@dots{}, \"extra\")\n\ -Cumulative sum of elements along dimension @var{dim}. If @var{dim}\n\ -is omitted, it defaults to the first non-singleton dimension.\n\ -\n\ -See @code{sum} for an explanation of the optional parameters \"native\",\n\ -\"double\", and \"extra\".\n\ -@seealso{sum, cumprod}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - bool isnative = false; - bool isdouble = false; - - if (nargin > 1 && args(nargin - 1).is_string ()) - { - std::string str = args(nargin - 1).string_value (); - - if (! error_state) - { - if (str == "native") - isnative = true; - else if (str == "double") - isdouble = true; - else - error ("sum: unrecognized string argument"); - nargin --; - } - } - - if (error_state) - return retval; - - if (nargin == 1 || nargin == 2) - { - octave_value arg = args(0); - - int dim = -1; - if (nargin == 2) - { - dim = args(1).int_value () - 1; - if (dim < 0) - error ("cumsum: invalid dimension argument = %d", dim + 1); - } - - if (! error_state) - { - switch (arg.builtin_type ()) - { - case btyp_double: - if (arg.is_sparse_type ()) - retval = arg.sparse_matrix_value ().cumsum (dim); - else - retval = arg.array_value ().cumsum (dim); - break; - case btyp_complex: - if (arg.is_sparse_type ()) - retval = arg.sparse_complex_matrix_value ().cumsum (dim); - else - retval = arg.complex_array_value ().cumsum (dim); - break; - case btyp_float: - if (isdouble) - retval = arg.array_value ().cumsum (dim); - else - retval = arg.float_array_value ().cumsum (dim); - break; - case btyp_float_complex: - if (isdouble) - retval = arg.complex_array_value ().cumsum (dim); - else - retval = arg.float_complex_array_value ().cumsum (dim); - break; - -#define MAKE_INT_BRANCH(X) \ - case btyp_ ## X: \ - if (isnative) \ - retval = arg.X ## _array_value ().cumsum (dim); \ - else \ - retval = arg.array_value ().cumsum (dim); \ - break - MAKE_INT_BRANCH (int8); - MAKE_INT_BRANCH (int16); - MAKE_INT_BRANCH (int32); - MAKE_INT_BRANCH (int64); - MAKE_INT_BRANCH (uint8); - MAKE_INT_BRANCH (uint16); - MAKE_INT_BRANCH (uint32); - MAKE_INT_BRANCH (uint64); -#undef MAKE_INT_BRANCH - - case btyp_bool: - if (arg.is_sparse_type ()) - { - SparseMatrix cs = arg.sparse_matrix_value ().cumsum (dim); - if (isnative) - retval = cs != 0.0; - else - retval = cs; - } - else - { - NDArray cs = arg.bool_array_value ().cumsum (dim); - if (isnative) - retval = cs != 0.0; - else - retval = cs; - } - break; - - default: - gripe_wrong_type_arg ("cumsum", arg); - } - } - } - else - print_usage (); - - return retval; -} - -/* -%!assert (cumsum ([1, 2, 3]), [1, 3, 6]) -%!assert (cumsum ([-1; -2; -3]), [-1; -3; -6]) -%!assert (cumsum ([i, 2+i, -3+2i, 4]), [i, 2+2i, -1+4i, 3+4i]) -%!assert (cumsum ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i]), [1, 2, 3; 1+i, 2+2i, 3+3i; 2+2i, 4+4i, 6+6i]) - -%!assert (cumsum (single ([1, 2, 3])), single ([1, 3, 6])) -%!assert (cumsum (single ([-1; -2; -3])), single ([-1; -3; -6])) -%!assert (cumsum (single ([i, 2+i, -3+2i, 4])), single ([i, 2+2i, -1+4i, 3+4i])) -%!assert (cumsum (single ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single ([1, 2, 3; 1+i, 2+2i, 3+3i; 2+2i, 4+4i, 6+6i])) - -%!assert (cumsum ([1, 2; 3, 4], 1), [1, 2; 4, 6]) -%!assert (cumsum ([1, 2; 3, 4], 2), [1, 3; 3, 7]) - -%!assert (cumsum (single ([1, 2; 3, 4]), 1), single ([1, 2; 4, 6])) -%!assert (cumsum (single ([1, 2; 3, 4]), 2), single ([1, 3; 3, 7])) - -%!error cumsum () -*/ - -DEFUN (diag, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{M} =} diag (@var{v})\n\ -@deftypefnx {Built-in Function} {@var{M} =} diag (@var{v}, @var{k})\n\ -@deftypefnx {Built-in Function} {@var{M} =} diag (@var{v}, @var{m}, @var{n})\n\ -@deftypefnx {Built-in Function} {@var{v} =} diag (@var{M})\n\ -@deftypefnx {Built-in Function} {@var{v} =} diag (@var{M}, @var{k})\n\ -Return a diagonal matrix with vector @var{v} on diagonal @var{k}. The\n\ -second argument is optional. If it is positive, the vector is placed on\n\ -the @var{k}-th super-diagonal. If it is negative, it is placed on the\n\ -@var{-k}-th sub-diagonal. The default value of @var{k} is 0, and the\n\ -vector is placed on the main diagonal. For example:\n\ -\n\ -@example\n\ -@group\n\ -diag ([1, 2, 3], 1)\n\ - @result{} 0 1 0 0\n\ - 0 0 2 0\n\ - 0 0 0 3\n\ - 0 0 0 0\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -The 3-input form returns a diagonal matrix with vector @var{v} on the main\n\ -diagonal and the resulting matrix being of size @var{m} rows x @var{n}\n\ -columns.\n\ -\n\ -Given a matrix argument, instead of a vector, @code{diag} extracts the\n\ -@var{k}-th diagonal of the matrix.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1 && args(0).is_defined ()) - retval = args(0).diag (); - else if (nargin == 2 && args(0).is_defined () && args(1).is_defined ()) - { - octave_idx_type k = args(1).int_value (); - - if (error_state) - error ("diag: invalid argument K"); - else - retval = args(0).diag (k); - } - else if (nargin == 3) - { - octave_value arg0 = args(0); - - if (arg0.ndims () == 2 && (arg0.rows () == 1 || arg0.columns () == 1)) - { - octave_idx_type m = args(1).int_value (); - octave_idx_type n = args(2).int_value (); - - if (! error_state) - retval = arg0.diag (m, n); - else - error ("diag: invalid dimensions"); - } - else - error ("diag: V must be a vector"); - } - else - print_usage (); - - return retval; -} - -/* - -%!assert (full (diag ([1; 2; 3])), [1, 0, 0; 0, 2, 0; 0, 0, 3]) -%!assert (diag ([1; 2; 3], 1), [0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0]) -%!assert (diag ([1; 2; 3], 2), [0, 0, 1, 0, 0; 0, 0, 0, 2, 0; 0, 0, 0, 0, 3; 0, 0, 0, 0, 0; 0, 0, 0, 0, 0]) -%!assert (diag ([1; 2; 3],-1), [0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0]) -%!assert (diag ([1; 2; 3],-2), [0, 0, 0, 0, 0; 0, 0, 0, 0, 0; 1, 0, 0, 0, 0; 0, 2, 0, 0, 0; 0, 0, 3, 0, 0]) - -%!assert (diag ([1, 0, 0; 0, 2, 0; 0, 0, 3]), [1; 2; 3]) -%!assert (diag ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0], 1), [1; 2; 3]) -%!assert (diag ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0], -1), [1; 2; 3]) -%!assert (diag (ones (1, 0), 2), zeros (2)) -%!assert (diag (1:3, 4, 2), [1, 0; 0, 2; 0, 0; 0, 0]) - -%!assert (full (diag (single ([1; 2; 3]))), single ([1, 0, 0; 0, 2, 0; 0, 0, 3])) -%!assert (diag (single ([1; 2; 3]), 1), single ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0])) -%!assert (diag (single ([1; 2; 3]), 2), single ([0, 0, 1, 0, 0; 0, 0, 0, 2, 0; 0, 0, 0, 0, 3; 0, 0, 0, 0, 0; 0, 0, 0, 0, 0])) -%!assert (diag (single ([1; 2; 3]),-1), single ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0])) -%!assert (diag (single ([1; 2; 3]),-2), single ([0, 0, 0, 0, 0; 0, 0, 0, 0, 0; 1, 0, 0, 0, 0; 0, 2, 0, 0, 0; 0, 0, 3, 0, 0])) - -%!assert (diag (single ([1, 0, 0; 0, 2, 0; 0, 0, 3])), single ([1; 2; 3])) -%!assert (diag (single ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0]), 1), single ([1; 2; 3])) -%!assert (diag (single ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0]), -1), single ([1; 2; 3])) - -%!assert (diag (int8 ([1; 2; 3])), int8 ([1, 0, 0; 0, 2, 0; 0, 0, 3])) -%!assert (diag (int8 ([1; 2; 3]), 1), int8 ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0])) -%!assert (diag (int8 ([1; 2; 3]), 2), int8 ([0, 0, 1, 0, 0; 0, 0, 0, 2, 0; 0, 0, 0, 0, 3; 0, 0, 0, 0, 0; 0, 0, 0, 0, 0])) -%!assert (diag (int8 ([1; 2; 3]),-1), int8 ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0])) -%!assert (diag (int8 ([1; 2; 3]),-2), int8 ([0, 0, 0, 0, 0; 0, 0, 0, 0, 0; 1, 0, 0, 0, 0; 0, 2, 0, 0, 0; 0, 0, 3, 0, 0])) - -%!assert (diag (int8 ([1, 0, 0; 0, 2, 0; 0, 0, 3])), int8 ([1; 2; 3])) -%!assert (diag (int8 ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0]), 1), int8 ([1; 2; 3])) -%!assert (diag (int8 ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0]), -1), int8 ([1; 2; 3])) - -## bug #37411 -%!assert (diag (diag ([5, 2, 3])(:,1)), diag([5 0 0 ])) -%!assert (diag (diag ([5, 2, 3])(:,1), 2), [0 0 5 0 0; zeros(4, 5)]) -%!assert (diag (diag ([5, 2, 3])(:,1), -2), [[0 0 5 0 0]', zeros(5, 4)]) - -## Test non-square size -%!assert (diag ([1,2,3], 6, 3), [1 0 0; 0 2 0; 0 0 3; 0 0 0; 0 0 0; 0 0 0]) -%!assert (diag (1, 2, 3), [1,0,0; 0,0,0]); -%!assert (diag ({1}, 2, 3), {1,[],[]; [],[],[]}); -%!assert (diag ({1,2}, 3, 4), {1,[],[],[]; [],2,[],[]; [],[],[],[]}); - -%% Test input validation -%!error diag () -%!error diag (1,2,3,4) -%!error diag (ones (2), 3, 3) -%!error diag (1:3, -4, 3) - -%!assert (diag (1, 3, 3), diag ([1, 0, 0])) -%!assert (diag (i, 3, 3), diag ([i, 0, 0])) -%!assert (diag (single (1), 3, 3), diag ([single(1), 0, 0])) -%!assert (diag (single (i), 3, 3), diag ([single(i), 0, 0])) -%!assert (diag ([1, 2], 3, 3), diag ([1, 2, 0])) -%!assert (diag ([1, 2]*i, 3, 3), diag ([1, 2, 0]*i)) -%!assert (diag (single ([1, 2]), 3, 3), diag (single ([1, 2, 0]))) -%!assert (diag (single ([1, 2]*i), 3, 3), diag (single ([1, 2, 0]*i))) -*/ - -DEFUN (prod, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} prod (@var{x})\n\ -@deftypefnx {Built-in Function} {} prod (@var{x}, @var{dim})\n\ -Product of elements along dimension @var{dim}. If @var{dim} is\n\ -omitted, it defaults to the first non-singleton dimension.\n\ -@seealso{cumprod, sum}\n\ -@end deftypefn") -{ - DATA_REDUCTION (prod); -} - -/* -%!assert (prod ([1, 2, 3]), 6) -%!assert (prod ([-1; -2; -3]), -6) -%!assert (prod ([i, 2+i, -3+2i, 4]), -4 - 32i) -%!assert (prod ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i]), [-1+i, -8+8i, -27+27i]) - -%!assert (prod (single ([1, 2, 3])), single (6)) -%!assert (prod (single ([-1; -2; -3])), single (-6)) -%!assert (prod (single ([i, 2+i, -3+2i, 4])), single (-4 - 32i)) -%!assert (prod (single ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single ([-1+i, -8+8i, -27+27i])) - -%!assert (prod ([1, 2; 3, 4], 1), [3, 8]) -%!assert (prod ([1, 2; 3, 4], 2), [2; 12]) -%!assert (prod (zeros (1, 0)), 1) -%!assert (prod (zeros (1, 0), 1), zeros (1, 0)) -%!assert (prod (zeros (1, 0), 2), 1) -%!assert (prod (zeros (0, 1)), 1) -%!assert (prod (zeros (0, 1), 1), 1) -%!assert (prod (zeros (0, 1), 2), zeros (0, 1)) -%!assert (prod (zeros (2, 0)), zeros (1, 0)) -%!assert (prod (zeros (2, 0), 1), zeros (1, 0)) -%!assert (prod (zeros (2, 0), 2), [1; 1]) -%!assert (prod (zeros (0, 2)), [1, 1]) -%!assert (prod (zeros (0, 2), 1), [1, 1]) -%!assert (prod (zeros (0, 2), 2), zeros (0, 1)) - -%!assert (prod (single ([1, 2; 3, 4]), 1), single ([3, 8])) -%!assert (prod (single ([1, 2; 3, 4]), 2), single ([2; 12])) -%!assert (prod (zeros (1, 0, "single")), single (1)) -%!assert (prod (zeros (1, 0, "single"), 1), zeros (1, 0, "single")) -%!assert (prod (zeros (1, 0, "single"), 2), single (1)) -%!assert (prod (zeros (0, 1, "single")), single (1)) -%!assert (prod (zeros (0, 1, "single"), 1), single (1)) -%!assert (prod (zeros (0, 1, "single"), 2), zeros (0, 1, "single")) -%!assert (prod (zeros (2, 0, "single")), zeros (1, 0, "single")) -%!assert (prod (zeros (2, 0, "single"), 1), zeros (1, 0, "single")) -%!assert (prod (zeros (2, 0, "single"), 2), single ([1; 1])) -%!assert (prod (zeros (0, 2, "single")), single ([1, 1])) -%!assert (prod (zeros (0, 2, "single"), 1), single ([1, 1])) -%!assert (prod (zeros (0, 2, "single"), 2), zeros (0, 1, "single")) - -%!error prod () -*/ - -static bool -all_scalar_1x1 (const octave_value_list& args) -{ - int n_args = args.length (); - for (int i = 0; i < n_args; i++) - if (args(i).numel () != 1) - return false; - - return true; -} - -template -static void -single_type_concat (Array& result, - const octave_value_list& args, - int dim) -{ - int n_args = args.length (); - if (! (equal_types::value - || equal_types::value) - && all_scalar_1x1 (args)) - { - // Optimize all scalars case. - dim_vector dv (1, 1); - if (dim == -1 || dim == -2) - dim = -dim - 1; - else if (dim >= 2) - dv.resize (dim+1, 1); - dv(dim) = n_args; - - result.clear (dv); - - for (int j = 0; j < n_args && ! error_state; j++) - { - octave_quit (); - - result(j) = octave_value_extract (args(j)); - } - } - else - { - OCTAVE_LOCAL_BUFFER (Array, array_list, n_args); - - for (int j = 0; j < n_args && ! error_state; j++) - { - octave_quit (); - - array_list[j] = octave_value_extract (args(j)); - } - - if (! error_state) - result = Array::cat (dim, n_args, array_list); - } -} - -template -static void -single_type_concat (Sparse& result, - const octave_value_list& args, - int dim) -{ - int n_args = args.length (); - OCTAVE_LOCAL_BUFFER (Sparse, sparse_list, n_args); - - for (int j = 0; j < n_args && ! error_state; j++) - { - octave_quit (); - - sparse_list[j] = octave_value_extract (args(j)); - } - - if (! error_state) - result = Sparse::cat (dim, n_args, sparse_list); -} - -// Dispatcher. -template -static TYPE -do_single_type_concat (const octave_value_list& args, int dim) -{ - TYPE result; - - single_type_concat (result, args, dim); - - return result; -} - -template -static void -single_type_concat_map (octave_map& result, - const octave_value_list& args, - int dim) -{ - int n_args = args.length (); - OCTAVE_LOCAL_BUFFER (MAP, map_list, n_args); - - for (int j = 0; j < n_args && ! error_state; j++) - { - octave_quit (); - - map_list[j] = octave_value_extract (args(j)); - } - - if (! error_state) - result = octave_map::cat (dim, n_args, map_list); -} - -static octave_map -do_single_type_concat_map (const octave_value_list& args, - int dim) -{ - octave_map result; - if (all_scalar_1x1 (args)) // optimize all scalars case. - single_type_concat_map (result, args, dim); - else - single_type_concat_map (result, args, dim); - - return result; -} - -static octave_value -attempt_type_conversion (const octave_value& ov, std::string dtype) -{ - octave_value retval; - - // First try to find function in the class of OV that can convert to - // the dispatch type dtype. It will have the name of the dispatch - // type. - - std::string cname = ov.class_name (); - - octave_value fcn = symbol_table::find_method (dtype, cname); - - if (fcn.is_defined ()) - { - octave_value_list result - = fcn.do_multi_index_op (1, octave_value_list (1, ov)); - - if (! error_state && result.length () > 0) - retval = result(0); - else - error ("conversion from %s to %s failed", dtype.c_str (), - cname.c_str ()); - } - else - { - // No conversion function available. Try the constructor for the - // dispatch type. - - fcn = symbol_table::find_method (dtype, dtype); - - if (fcn.is_defined ()) - { - octave_value_list result - = fcn.do_multi_index_op (1, octave_value_list (1, ov)); - - if (! error_state && result.length () > 0) - retval = result(0); - else - error ("%s constructor failed for %s argument", dtype.c_str (), - cname.c_str ()); - } - else - error ("no constructor for %s!", dtype.c_str ()); - } - - return retval; -} - -octave_value -do_class_concat (const octave_value_list& ovl, std::string cattype, int dim) -{ - octave_value retval; - - // Get dominant type for list - - std::string dtype = get_dispatch_type (ovl); - - octave_value fcn = symbol_table::find_method (cattype, dtype); - - if (fcn.is_defined ()) - { - // Have method for dominant type, so call it and let it handle - // conversions. - - octave_value_list tmp2 = fcn.do_multi_index_op (1, ovl); - - if (! error_state) - { - if (tmp2.length () > 0) - retval = tmp2(0); - else - { - error ("%s/%s method did not return a value", - dtype.c_str (), cattype.c_str ()); - goto done; - } - } - else - goto done; - } - else - { - // No method for dominant type, so attempt type conversions for - // all elements that are not of the dominant type, then do the - // default operation for octave_class values. - - octave_idx_type j = 0; - octave_idx_type len = ovl.length (); - octave_value_list tmp (len, octave_value ()); - for (octave_idx_type k = 0; k < len; k++) - { - octave_value elt = ovl(k); - - std::string t1_type = elt.class_name (); - - if (t1_type == dtype) - tmp(j++) = elt; - else if (elt.is_object () || ! elt.is_empty ()) - { - tmp(j++) = attempt_type_conversion (elt, dtype); - - if (error_state) - goto done; - } - } - - tmp.resize (j); - - octave_map m = do_single_type_concat_map (tmp, dim); - - std::string cname = tmp(0).class_name (); - std::list parents = tmp(0).parent_class_name_list (); - - retval = octave_value (new octave_class (m, cname, parents)); - } - - done: - return retval; -} - -static octave_value -do_cat (const octave_value_list& xargs, int dim, std::string fname) -{ - octave_value retval; - - // We may need to convert elements of the list to cells, so make a - // copy. This should be efficient, it is done mostly by incrementing - // reference counts. - octave_value_list args = xargs; - - int n_args = args.length (); - - if (n_args == 0) - retval = Matrix (); - else if (n_args == 1) - retval = args(0); - else if (n_args > 1) - { - std::string result_type; - - bool all_sq_strings_p = true; - bool all_dq_strings_p = true; - bool all_real_p = true; - bool all_cmplx_p = true; - bool any_sparse_p = false; - bool any_cell_p = false; - bool any_class_p = false; - - bool first_elem_is_struct = false; - - for (int i = 0; i < n_args; i++) - { - if (i == 0) - { - result_type = args(i).class_name (); - - first_elem_is_struct = args(i).is_map (); - } - else - result_type = get_concat_class (result_type, args(i).class_name ()); - - if (all_sq_strings_p && ! args(i).is_sq_string ()) - all_sq_strings_p = false; - if (all_dq_strings_p && ! args(i).is_dq_string ()) - all_dq_strings_p = false; - if (all_real_p && ! args(i).is_real_type ()) - all_real_p = false; - if (all_cmplx_p && ! (args(i).is_complex_type () || args(i).is_real_type ())) - all_cmplx_p = false; - if (!any_sparse_p && args(i).is_sparse_type ()) - any_sparse_p = true; - if (!any_cell_p && args(i).is_cell ()) - any_cell_p = true; - if (!any_class_p && args(i).is_object ()) - any_class_p = true; - } - - if (any_cell_p && ! any_class_p && ! first_elem_is_struct) - { - for (int i = 0; i < n_args; i++) - { - if (! args(i).is_cell ()) - args(i) = Cell (args(i)); - } - } - - if (any_class_p) - { - retval = do_class_concat (args, fname, dim); - } - else if (result_type == "double") - { - if (any_sparse_p) - { - if (all_real_p) - retval = do_single_type_concat (args, dim); - else - retval = do_single_type_concat (args, dim); - } - else - { - if (all_real_p) - retval = do_single_type_concat (args, dim); - else - retval = do_single_type_concat (args, dim); - } - } - else if (result_type == "single") - { - if (all_real_p) - retval = do_single_type_concat (args, dim); - else - retval = do_single_type_concat (args, dim); - } - else if (result_type == "char") - { - char type = all_dq_strings_p ? '"' : '\''; - - maybe_warn_string_concat (all_dq_strings_p, all_sq_strings_p); - - charNDArray result = do_single_type_concat (args, dim); - - retval = octave_value (result, type); - } - else if (result_type == "logical") - { - if (any_sparse_p) - retval = do_single_type_concat (args, dim); - else - retval = do_single_type_concat (args, dim); - } - else if (result_type == "int8") - retval = do_single_type_concat (args, dim); - else if (result_type == "int16") - retval = do_single_type_concat (args, dim); - else if (result_type == "int32") - retval = do_single_type_concat (args, dim); - else if (result_type == "int64") - retval = do_single_type_concat (args, dim); - else if (result_type == "uint8") - retval = do_single_type_concat (args, dim); - else if (result_type == "uint16") - retval = do_single_type_concat (args, dim); - else if (result_type == "uint32") - retval = do_single_type_concat (args, dim); - else if (result_type == "uint64") - retval = do_single_type_concat (args, dim); - else if (result_type == "cell") - retval = do_single_type_concat (args, dim); - else if (result_type == "struct") - retval = do_single_type_concat_map (args, dim); - else - { - dim_vector dv = args(0).dims (); - - // Default concatenation. - bool (dim_vector::*concat_rule) (const dim_vector&, int) = &dim_vector::concat; - - if (dim == -1 || dim == -2) - { - concat_rule = &dim_vector::hvcat; - dim = -dim - 1; - } - - for (int i = 1; i < args.length (); i++) - { - if (! (dv.*concat_rule) (args(i).dims (), dim)) - { - // Dimensions do not match. - error ("cat: dimension mismatch"); - return retval; - } - } - - // The lines below might seem crazy, since we take a copy - // of the first argument, resize it to be empty and then resize - // it to be full. This is done since it means that there is no - // recopying of data, as would happen if we used a single resize. - // It should be noted that resize operation is also significantly - // slower than the do_cat_op function, so it makes sense to have - // an empty matrix and copy all data. - // - // We might also start with a empty octave_value using - // tmp = octave_value_typeinfo::lookup_type - // (args(1).type_name()); - // and then directly resize. However, for some types there might - // be some additional setup needed, and so this should be avoided. - - octave_value tmp = args (0); - tmp = tmp.resize (dim_vector (0,0)).resize (dv); - - if (error_state) - return retval; - - int dv_len = dv.length (); - Array ra_idx (dim_vector (dv_len, 1), 0); - - for (int j = 0; j < n_args; j++) - { - // Can't fast return here to skip empty matrices as something - // like cat (1,[],single ([])) must return an empty matrix of - // the right type. - tmp = do_cat_op (tmp, args (j), ra_idx); - - if (error_state) - return retval; - - dim_vector dv_tmp = args (j).dims (); - - if (dim >= dv_len) - { - if (j > 1) - error ("%s: indexing error", fname.c_str ()); - break; - } - else - ra_idx (dim) += (dim < dv_tmp.length () ? - dv_tmp (dim) : 1); - } - retval = tmp; - } - } - else - print_usage (); - - return retval; -} - -DEFUN (horzcat, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} horzcat (@var{array1}, @var{array2}, @dots{}, @var{arrayN})\n\ -Return the horizontal concatenation of N-D array objects, @var{array1},\n\ -@var{array2}, @dots{}, @var{arrayN} along dimension 2.\n\ -\n\ -Arrays may also be concatenated horizontally using the syntax for creating\n\ -new matrices. For example:\n\ -\n\ -@example\n\ -@var{hcat} = [ @var{array1}, @var{array2}, @dots{} ]\n\ -@end example\n\ -@seealso{cat, vertcat}\n\ -@end deftypefn") -{ - return do_cat (args, -2, "horzcat"); -} - -/* -## Test concatenation with all zero matrices -%!assert (horzcat ("", 65*ones (1,10)), "AAAAAAAAAA"); -%!assert (horzcat (65*ones (1,10), ""), "AAAAAAAAAA"); - -%!assert (class (horzcat (int64 (1), int64 (1))), "int64") -%!assert (class (horzcat (int64 (1), int32 (1))), "int64") -%!assert (class (horzcat (int64 (1), int16 (1))), "int64") -%!assert (class (horzcat (int64 (1), int8 (1))), "int64") -%!assert (class (horzcat (int64 (1), uint64 (1))), "int64") -%!assert (class (horzcat (int64 (1), uint32 (1))), "int64") -%!assert (class (horzcat (int64 (1), uint16 (1))), "int64") -%!assert (class (horzcat (int64 (1), uint8 (1))), "int64") -%!assert (class (horzcat (int64 (1), single (1))), "int64") -%!assert (class (horzcat (int64 (1), double (1))), "int64") -%!assert (class (horzcat (int64 (1), cell (1))), "cell") -%!assert (class (horzcat (int64 (1), true)), "int64") -%!assert (class (horzcat (int64 (1), "a")), "char") - -%!assert (class (horzcat (int32 (1), int64 (1))), "int32") -%!assert (class (horzcat (int32 (1), int32 (1))), "int32") -%!assert (class (horzcat (int32 (1), int16 (1))), "int32") -%!assert (class (horzcat (int32 (1), int8 (1))), "int32") -%!assert (class (horzcat (int32 (1), uint64 (1))), "int32") -%!assert (class (horzcat (int32 (1), uint32 (1))), "int32") -%!assert (class (horzcat (int32 (1), uint16 (1))), "int32") -%!assert (class (horzcat (int32 (1), uint8 (1))), "int32") -%!assert (class (horzcat (int32 (1), single (1))), "int32") -%!assert (class (horzcat (int32 (1), double (1))), "int32") -%!assert (class (horzcat (int32 (1), cell (1))), "cell") -%!assert (class (horzcat (int32 (1), true)), "int32") -%!assert (class (horzcat (int32 (1), "a")), "char") - -%!assert (class (horzcat (int16 (1), int64 (1))), "int16") -%!assert (class (horzcat (int16 (1), int32 (1))), "int16") -%!assert (class (horzcat (int16 (1), int16 (1))), "int16") -%!assert (class (horzcat (int16 (1), int8 (1))), "int16") -%!assert (class (horzcat (int16 (1), uint64 (1))), "int16") -%!assert (class (horzcat (int16 (1), uint32 (1))), "int16") -%!assert (class (horzcat (int16 (1), uint16 (1))), "int16") -%!assert (class (horzcat (int16 (1), uint8 (1))), "int16") -%!assert (class (horzcat (int16 (1), single (1))), "int16") -%!assert (class (horzcat (int16 (1), double (1))), "int16") -%!assert (class (horzcat (int16 (1), cell (1))), "cell") -%!assert (class (horzcat (int16 (1), true)), "int16") -%!assert (class (horzcat (int16 (1), "a")), "char") - -%!assert (class (horzcat (int8 (1), int64 (1))), "int8") -%!assert (class (horzcat (int8 (1), int32 (1))), "int8") -%!assert (class (horzcat (int8 (1), int16 (1))), "int8") -%!assert (class (horzcat (int8 (1), int8 (1))), "int8") -%!assert (class (horzcat (int8 (1), uint64 (1))), "int8") -%!assert (class (horzcat (int8 (1), uint32 (1))), "int8") -%!assert (class (horzcat (int8 (1), uint16 (1))), "int8") -%!assert (class (horzcat (int8 (1), uint8 (1))), "int8") -%!assert (class (horzcat (int8 (1), single (1))), "int8") -%!assert (class (horzcat (int8 (1), double (1))), "int8") -%!assert (class (horzcat (int8 (1), cell (1))), "cell") -%!assert (class (horzcat (int8 (1), true)), "int8") -%!assert (class (horzcat (int8 (1), "a")), "char") - -%!assert (class (horzcat (uint64 (1), int64 (1))), "uint64") -%!assert (class (horzcat (uint64 (1), int32 (1))), "uint64") -%!assert (class (horzcat (uint64 (1), int16 (1))), "uint64") -%!assert (class (horzcat (uint64 (1), int8 (1))), "uint64") -%!assert (class (horzcat (uint64 (1), uint64 (1))), "uint64") -%!assert (class (horzcat (uint64 (1), uint32 (1))), "uint64") -%!assert (class (horzcat (uint64 (1), uint16 (1))), "uint64") -%!assert (class (horzcat (uint64 (1), uint8 (1))), "uint64") -%!assert (class (horzcat (uint64 (1), single (1))), "uint64") -%!assert (class (horzcat (uint64 (1), double (1))), "uint64") -%!assert (class (horzcat (uint64 (1), cell (1))), "cell") -%!assert (class (horzcat (uint64 (1), true)), "uint64") -%!assert (class (horzcat (uint64 (1), "a")), "char") - -%!assert (class (horzcat (uint32 (1), int64 (1))), "uint32") -%!assert (class (horzcat (uint32 (1), int32 (1))), "uint32") -%!assert (class (horzcat (uint32 (1), int16 (1))), "uint32") -%!assert (class (horzcat (uint32 (1), int8 (1))), "uint32") -%!assert (class (horzcat (uint32 (1), uint64 (1))), "uint32") -%!assert (class (horzcat (uint32 (1), uint32 (1))), "uint32") -%!assert (class (horzcat (uint32 (1), uint16 (1))), "uint32") -%!assert (class (horzcat (uint32 (1), uint8 (1))), "uint32") -%!assert (class (horzcat (uint32 (1), single (1))), "uint32") -%!assert (class (horzcat (uint32 (1), double (1))), "uint32") -%!assert (class (horzcat (uint32 (1), cell (1))), "cell") -%!assert (class (horzcat (uint32 (1), true)), "uint32") -%!assert (class (horzcat (uint32 (1), "a")), "char") - -%!assert (class (horzcat (uint16 (1), int64 (1))), "uint16") -%!assert (class (horzcat (uint16 (1), int32 (1))), "uint16") -%!assert (class (horzcat (uint16 (1), int16 (1))), "uint16") -%!assert (class (horzcat (uint16 (1), int8 (1))), "uint16") -%!assert (class (horzcat (uint16 (1), uint64 (1))), "uint16") -%!assert (class (horzcat (uint16 (1), uint32 (1))), "uint16") -%!assert (class (horzcat (uint16 (1), uint16 (1))), "uint16") -%!assert (class (horzcat (uint16 (1), uint8 (1))), "uint16") -%!assert (class (horzcat (uint16 (1), single (1))), "uint16") -%!assert (class (horzcat (uint16 (1), double (1))), "uint16") -%!assert (class (horzcat (uint16 (1), cell (1))), "cell") -%!assert (class (horzcat (uint16 (1), true)), "uint16") -%!assert (class (horzcat (uint16 (1), "a")), "char") - -%!assert (class (horzcat (uint8 (1), int64 (1))), "uint8") -%!assert (class (horzcat (uint8 (1), int32 (1))), "uint8") -%!assert (class (horzcat (uint8 (1), int16 (1))), "uint8") -%!assert (class (horzcat (uint8 (1), int8 (1))), "uint8") -%!assert (class (horzcat (uint8 (1), uint64 (1))), "uint8") -%!assert (class (horzcat (uint8 (1), uint32 (1))), "uint8") -%!assert (class (horzcat (uint8 (1), uint16 (1))), "uint8") -%!assert (class (horzcat (uint8 (1), uint8 (1))), "uint8") -%!assert (class (horzcat (uint8 (1), single (1))), "uint8") -%!assert (class (horzcat (uint8 (1), double (1))), "uint8") -%!assert (class (horzcat (uint8 (1), cell (1))), "cell") -%!assert (class (horzcat (uint8 (1), true)), "uint8") -%!assert (class (horzcat (uint8 (1), "a")), "char") - -%!assert (class (horzcat (single (1), int64 (1))), "int64") -%!assert (class (horzcat (single (1), int32 (1))), "int32") -%!assert (class (horzcat (single (1), int16 (1))), "int16") -%!assert (class (horzcat (single (1), int8 (1))), "int8") -%!assert (class (horzcat (single (1), uint64 (1))), "uint64") -%!assert (class (horzcat (single (1), uint32 (1))), "uint32") -%!assert (class (horzcat (single (1), uint16 (1))), "uint16") -%!assert (class (horzcat (single (1), uint8 (1))), "uint8") -%!assert (class (horzcat (single (1), single (1))), "single") -%!assert (class (horzcat (single (1), double (1))), "single") -%!assert (class (horzcat (single (1), cell (1))), "cell") -%!assert (class (horzcat (single (1), true)), "single") -%!assert (class (horzcat (single (1), "a")), "char") - -%!assert (class (horzcat (double (1), int64 (1))), "int64") -%!assert (class (horzcat (double (1), int32 (1))), "int32") -%!assert (class (horzcat (double (1), int16 (1))), "int16") -%!assert (class (horzcat (double (1), int8 (1))), "int8") -%!assert (class (horzcat (double (1), uint64 (1))), "uint64") -%!assert (class (horzcat (double (1), uint32 (1))), "uint32") -%!assert (class (horzcat (double (1), uint16 (1))), "uint16") -%!assert (class (horzcat (double (1), uint8 (1))), "uint8") -%!assert (class (horzcat (double (1), single (1))), "single") -%!assert (class (horzcat (double (1), double (1))), "double") -%!assert (class (horzcat (double (1), cell (1))), "cell") -%!assert (class (horzcat (double (1), true)), "double") -%!assert (class (horzcat (double (1), "a")), "char") - -%!assert (class (horzcat (cell (1), int64 (1))), "cell") -%!assert (class (horzcat (cell (1), int32 (1))), "cell") -%!assert (class (horzcat (cell (1), int16 (1))), "cell") -%!assert (class (horzcat (cell (1), int8 (1))), "cell") -%!assert (class (horzcat (cell (1), uint64 (1))), "cell") -%!assert (class (horzcat (cell (1), uint32 (1))), "cell") -%!assert (class (horzcat (cell (1), uint16 (1))), "cell") -%!assert (class (horzcat (cell (1), uint8 (1))), "cell") -%!assert (class (horzcat (cell (1), single (1))), "cell") -%!assert (class (horzcat (cell (1), double (1))), "cell") -%!assert (class (horzcat (cell (1), cell (1))), "cell") -%!assert (class (horzcat (cell (1), true)), "cell") -%!assert (class (horzcat (cell (1), "a")), "cell") - -%!assert (class (horzcat (true, int64 (1))), "int64") -%!assert (class (horzcat (true, int32 (1))), "int32") -%!assert (class (horzcat (true, int16 (1))), "int16") -%!assert (class (horzcat (true, int8 (1))), "int8") -%!assert (class (horzcat (true, uint64 (1))), "uint64") -%!assert (class (horzcat (true, uint32 (1))), "uint32") -%!assert (class (horzcat (true, uint16 (1))), "uint16") -%!assert (class (horzcat (true, uint8 (1))), "uint8") -%!assert (class (horzcat (true, single (1))), "single") -%!assert (class (horzcat (true, double (1))), "double") -%!assert (class (horzcat (true, cell (1))), "cell") -%!assert (class (horzcat (true, true)), "logical") -%!assert (class (horzcat (true, "a")), "char") - -%!assert (class (horzcat ("a", int64 (1))), "char") -%!assert (class (horzcat ("a", int32 (1))), "char") -%!assert (class (horzcat ("a", int16 (1))), "char") -%!assert (class (horzcat ("a", int8 (1))), "char") -%!assert (class (horzcat ("a", int64 (1))), "char") -%!assert (class (horzcat ("a", int32 (1))), "char") -%!assert (class (horzcat ("a", int16 (1))), "char") -%!assert (class (horzcat ("a", int8 (1))), "char") -%!assert (class (horzcat ("a", single (1))), "char") -%!assert (class (horzcat ("a", double (1))), "char") -%!assert (class (horzcat ("a", cell (1))), "cell") -%!assert (class (horzcat ("a", true)), "char") -%!assert (class (horzcat ("a", "a")), "char") - -%!assert (class (horzcat (cell (1), struct ("foo", "bar"))), "cell") - -%!error horzcat (struct ("foo", "bar"), cell (1)) -*/ - -DEFUN (vertcat, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} vertcat (@var{array1}, @var{array2}, @dots{}, @var{arrayN})\n\ -Return the vertical concatenation of N-D array objects, @var{array1},\n\ -@var{array2}, @dots{}, @var{arrayN} along dimension 1.\n\ -\n\ -Arrays may also be concatenated vertically using the syntax for creating\n\ -new matrices. For example:\n\ -\n\ -@example\n\ -@var{vcat} = [ @var{array1}; @var{array2}; @dots{} ]\n\ -@end example\n\ -@seealso{cat, horzcat}\n\ -@end deftypefn") -{ - return do_cat (args, -1, "vertcat"); -} - -/* -%!test -%! c = {"foo"; "bar"; "bazoloa"}; -%! assert (vertcat (c, "a", "bc", "def"), {"foo"; "bar"; "bazoloa"; "a"; "bc"; "def"}); -*/ - -DEFUN (cat, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} cat (@var{dim}, @var{array1}, @var{array2}, @dots{}, @var{arrayN})\n\ -Return the concatenation of N-D array objects, @var{array1},\n\ -@var{array2}, @dots{}, @var{arrayN} along dimension @var{dim}.\n\ -\n\ -@example\n\ -@group\n\ -A = ones (2, 2);\n\ -B = zeros (2, 2);\n\ -cat (2, A, B)\n\ - @result{} 1 1 0 0\n\ - 1 1 0 0\n\ -@end group\n\ -@end example\n\ -\n\ -Alternatively, we can concatenate @var{A} and @var{B} along the\n\ -second dimension in the following way:\n\ -\n\ -@example\n\ -@group\n\ -[A, B]\n\ -@end group\n\ -@end example\n\ -\n\ -@var{dim} can be larger than the dimensions of the N-D array objects\n\ -and the result will thus have @var{dim} dimensions as the\n\ -following example shows:\n\ -\n\ -@example\n\ -@group\n\ -cat (4, ones (2, 2), zeros (2, 2))\n\ - @result{} ans(:,:,1,1) =\n\ -\n\ - 1 1\n\ - 1 1\n\ -\n\ - ans(:,:,1,2) =\n\ -\n\ - 0 0\n\ - 0 0\n\ -@end group\n\ -@end example\n\ -@seealso{horzcat, vertcat}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () > 0) - { - int dim = args(0).int_value () - 1; - - if (! error_state) - { - if (dim >= 0) - retval = do_cat (args.slice (1, args.length () - 1), dim, "cat"); - else - error ("cat: DIM must be a valid dimension"); - } - else - error ("cat: DIM must be an integer"); - } - else - print_usage (); - - return retval; -} - -/* -%!function ret = __testcat (t1, t2, tr, cmplx) -%! assert (cat (1, cast ([], t1), cast ([], t2)), cast ([], tr)); -%! -%! assert (cat (1, cast (1, t1), cast (2, t2)), cast ([1; 2], tr)); -%! assert (cat (1, cast (1, t1), cast ([2; 3], t2)), cast ([1; 2; 3], tr)); -%! assert (cat (1, cast ([1; 2], t1), cast (3, t2)), cast ([1; 2; 3], tr)); -%! assert (cat (1, cast ([1; 2], t1), cast ([3; 4], t2)), cast ([1; 2; 3; 4], tr)); -%! assert (cat (2, cast (1, t1), cast (2, t2)), cast ([1, 2], tr)); -%! assert (cat (2, cast (1, t1), cast ([2, 3], t2)), cast ([1, 2, 3], tr)); -%! assert (cat (2, cast ([1, 2], t1), cast (3, t2)), cast ([1, 2, 3], tr)); -%! assert (cat (2, cast ([1, 2], t1), cast ([3, 4], t2)), cast ([1, 2, 3, 4], tr)); -%! -%! assert ([cast(1, t1); cast(2, t2)], cast ([1; 2], tr)); -%! assert ([cast(1, t1); cast([2; 3], t2)], cast ([1; 2; 3], tr)); -%! assert ([cast([1; 2], t1); cast(3, t2)], cast ([1; 2; 3], tr)); -%! assert ([cast([1; 2], t1); cast([3; 4], t2)], cast ([1; 2; 3; 4], tr)); -%! assert ([cast(1, t1), cast(2, t2)], cast ([1, 2], tr)); -%! assert ([cast(1, t1), cast([2, 3], t2)], cast ([1, 2, 3], tr)); -%! assert ([cast([1, 2], t1), cast(3, t2)], cast ([1, 2, 3], tr)); -%! assert ([cast([1, 2], t1), cast([3, 4], t2)], cast ([1, 2, 3, 4], tr)); -%! -%! if (nargin == 3 || cmplx) -%! assert (cat (1, cast (1i, t1), cast (2, t2)), cast ([1i; 2], tr)); -%! assert (cat (1, cast (1i, t1), cast ([2; 3], t2)), cast ([1i; 2; 3], tr)); -%! assert (cat (1, cast ([1i; 2], t1), cast (3, t2)), cast ([1i; 2; 3], tr)); -%! assert (cat (1, cast ([1i; 2], t1), cast ([3; 4], t2)), cast ([1i; 2; 3; 4], tr)); -%! assert (cat (2, cast (1i, t1), cast (2, t2)), cast ([1i, 2], tr)); -%! assert (cat (2, cast (1i, t1), cast ([2, 3], t2)), cast ([1i, 2, 3], tr)); -%! assert (cat (2, cast ([1i, 2], t1), cast (3, t2)), cast ([1i, 2, 3], tr)); -%! assert (cat (2, cast ([1i, 2], t1), cast ([3, 4], t2)), cast ([1i, 2, 3, 4], tr)); -%! -%! assert ([cast(1i, t1); cast(2, t2)], cast ([1i; 2], tr)); -%! assert ([cast(1i, t1); cast([2; 3], t2)], cast ([1i; 2; 3], tr)); -%! assert ([cast([1i; 2], t1); cast(3, t2)], cast ([1i; 2; 3], tr)); -%! assert ([cast([1i; 2], t1); cast([3; 4], t2)], cast ([1i; 2; 3; 4], tr)); -%! assert ([cast(1i, t1), cast(2, t2)], cast ([1i, 2], tr)); -%! assert ([cast(1i, t1), cast([2, 3], t2)], cast ([1i, 2, 3], tr)); -%! assert ([cast([1i, 2], t1), cast(3, t2)], cast ([1i, 2, 3], tr)); -%! assert ([cast([1i, 2], t1), cast([3, 4], t2)], cast ([1i, 2, 3, 4], tr)); -%! -%! assert (cat (1, cast (1, t1), cast (2i, t2)), cast ([1; 2i], tr)); -%! assert (cat (1, cast (1, t1), cast ([2i; 3], t2)), cast ([1; 2i; 3], tr)); -%! assert (cat (1, cast ([1; 2], t1), cast (3i, t2)), cast ([1; 2; 3i], tr)); -%! assert (cat (1, cast ([1; 2], t1), cast ([3i; 4], t2)), cast ([1; 2; 3i; 4], tr)); -%! assert (cat (2, cast (1, t1), cast (2i, t2)), cast ([1, 2i], tr)); -%! assert (cat (2, cast (1, t1), cast ([2i, 3], t2)), cast ([1, 2i, 3], tr)); -%! assert (cat (2, cast ([1, 2], t1), cast (3i, t2)), cast ([1, 2, 3i], tr)); -%! assert (cat (2, cast ([1, 2], t1), cast ([3i, 4], t2)), cast ([1, 2, 3i, 4], tr)); -%! -%! assert ([cast(1, t1); cast(2i, t2)], cast ([1; 2i], tr)); -%! assert ([cast(1, t1); cast([2i; 3], t2)], cast ([1; 2i; 3], tr)); -%! assert ([cast([1; 2], t1); cast(3i, t2)], cast ([1; 2; 3i], tr)); -%! assert ([cast([1; 2], t1); cast([3i; 4], t2)], cast ([1; 2; 3i; 4], tr)); -%! assert ([cast(1, t1), cast(2i, t2)], cast ([1, 2i], tr)); -%! assert ([cast(1, t1), cast([2i, 3], t2)], cast ([1, 2i, 3], tr)); -%! assert ([cast([1, 2], t1), cast(3i, t2)], cast ([1, 2, 3i], tr)); -%! assert ([cast([1, 2], t1), cast([3i, 4], t2)], cast ([1, 2, 3i, 4], tr)); -%! -%! assert (cat (1, cast (1i, t1), cast (2i, t2)), cast ([1i; 2i], tr)); -%! assert (cat (1, cast (1i, t1), cast ([2i; 3], t2)), cast ([1i; 2i; 3], tr)); -%! assert (cat (1, cast ([1i; 2], t1), cast (3i, t2)), cast ([1i; 2; 3i], tr)); -%! assert (cat (1, cast ([1i; 2], t1), cast ([3i; 4], t2)), cast ([1i; 2; 3i; 4], tr)); -%! assert (cat (2, cast (1i, t1), cast (2i, t2)), cast ([1i, 2i], tr)); -%! assert (cat (2, cast (1i, t1), cast ([2i, 3], t2)), cast ([1i, 2i, 3], tr)); -%! assert (cat (2, cast ([1i, 2], t1), cast (3i, t2)), cast ([1i, 2, 3i], tr)); -%! assert (cat (2, cast ([1i, 2], t1), cast ([3i, 4], t2)), cast ([1i, 2, 3i, 4], tr)); -%! -%! assert ([cast(1i, t1); cast(2i, t2)], cast ([1i; 2i], tr)); -%! assert ([cast(1i, t1); cast([2i; 3], t2)], cast ([1i; 2i; 3], tr)); -%! assert ([cast([1i; 2], t1); cast(3i, t2)], cast ([1i; 2; 3i], tr)); -%! assert ([cast([1i; 2], t1); cast([3i; 4], t2)], cast ([1i; 2; 3i; 4], tr)); -%! assert ([cast(1i, t1), cast(2i, t2)], cast ([1i, 2i], tr)); -%! assert ([cast(1i, t1), cast([2i, 3], t2)], cast ([1i, 2i, 3], tr)); -%! assert ([cast([1i, 2], t1), cast(3i, t2)], cast ([1i, 2, 3i], tr)); -%! assert ([cast([1i, 2], t1), cast([3i, 4], t2)], cast ([1i, 2, 3i, 4], tr)); -%! endif -%! ret = true; -%!endfunction - -%!assert (__testcat ("double", "double", "double")) -%!assert (__testcat ("single", "double", "single")) -%!assert (__testcat ("double", "single", "single")) -%!assert (__testcat ("single", "single", "single")) - -%!assert (__testcat ("double", "int8", "int8", false)) -%!assert (__testcat ("int8", "double", "int8", false)) -%!assert (__testcat ("single", "int8", "int8", false)) -%!assert (__testcat ("int8", "single", "int8", false)) -%!assert (__testcat ("int8", "int8", "int8", false)) -%!assert (__testcat ("double", "int16", "int16", false)) -%!assert (__testcat ("int16", "double", "int16", false)) -%!assert (__testcat ("single", "int16", "int16", false)) -%!assert (__testcat ("int16", "single", "int16", false)) -%!assert (__testcat ("int16", "int16", "int16", false)) -%!assert (__testcat ("double", "int32", "int32", false)) -%!assert (__testcat ("int32", "double", "int32", false)) -%!assert (__testcat ("single", "int32", "int32", false)) -%!assert (__testcat ("int32", "single", "int32", false)) -%!assert (__testcat ("int32", "int32", "int32", false)) -%!assert (__testcat ("double", "int64", "int64", false)) -%!assert (__testcat ("int64", "double", "int64", false)) -%!assert (__testcat ("single", "int64", "int64", false)) -%!assert (__testcat ("int64", "single", "int64", false)) -%!assert (__testcat ("int64", "int64", "int64", false)) - -%!assert (__testcat ("double", "uint8", "uint8", false)) -%!assert (__testcat ("uint8", "double", "uint8", false)) -%!assert (__testcat ("single", "uint8", "uint8", false)) -%!assert (__testcat ("uint8", "single", "uint8", false)) -%!assert (__testcat ("uint8", "uint8", "uint8", false)) -%!assert (__testcat ("double", "uint16", "uint16", false)) -%!assert (__testcat ("uint16", "double", "uint16", false)) -%!assert (__testcat ("single", "uint16", "uint16", false)) -%!assert (__testcat ("uint16", "single", "uint16", false)) -%!assert (__testcat ("uint16", "uint16", "uint16", false)) -%!assert (__testcat ("double", "uint32", "uint32", false)) -%!assert (__testcat ("uint32", "double", "uint32", false)) -%!assert (__testcat ("single", "uint32", "uint32", false)) -%!assert (__testcat ("uint32", "single", "uint32", false)) -%!assert (__testcat ("uint32", "uint32", "uint32", false)) -%!assert (__testcat ("double", "uint64", "uint64", false)) -%!assert (__testcat ("uint64", "double", "uint64", false)) -%!assert (__testcat ("single", "uint64", "uint64", false)) -%!assert (__testcat ("uint64", "single", "uint64", false)) -%!assert (__testcat ("uint64", "uint64", "uint64", false)) - -%!assert (cat (3, [], [1,2;3,4]), [1,2;3,4]) -%!assert (cat (3, [1,2;3,4], []), [1,2;3,4]) -%!assert (cat (3, [], [1,2;3,4], []), [1,2;3,4]) -%!assert (cat (3, [], [], []), zeros (0, 0, 3)) - -%!assert (cat (3, [], [], 1, 2), cat (3, 1, 2)) -%!assert (cat (3, [], [], [1,2;3,4]), [1,2;3,4]) -%!assert (cat (4, [], [], [1,2;3,4]), [1,2;3,4]) - -%!assert ([zeros(3,2,2); ones(1,2,2)], repmat ([0;0;0;1],[1,2,2]) ) -%!assert ([zeros(3,2,2); ones(1,2,2)], vertcat (zeros (3,2,2), ones (1,2,2)) ) - -%!error cat (3, cat (3, [], []), [1,2;3,4]) -%!error cat (3, zeros (0, 0, 2), [1,2;3,4]) -*/ - -static octave_value -do_permute (const octave_value_list& args, bool inv) -{ - octave_value retval; - - if (args.length () == 2 && args(1).length () >= args(1).ndims ()) - { - Array vec = args(1).int_vector_value (); - - // FIXME -- maybe we should create an idx_vector object - // here and pass that to permute? - - int n = vec.length (); - - for (int i = 0; i < n; i++) - vec(i)--; - - octave_value ret = args(0).permute (vec, inv); - - if (! error_state) - retval = ret; - } - else - print_usage (); - - return retval; -} - -DEFUN (permute, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} permute (@var{A}, @var{perm})\n\ -Return the generalized transpose for an N-D array object @var{A}.\n\ -The permutation vector @var{perm} must contain the elements\n\ -@code{1:ndims (A)} (in any order, but each element must appear only once).\n\ -@seealso{ipermute}\n\ -@end deftypefn") -{ - return do_permute (args, false); -} - -DEFUN (ipermute, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ipermute (@var{A}, @var{iperm})\n\ -The inverse of the @code{permute} function. The expression\n\ -\n\ -@example\n\ -ipermute (permute (A, perm), perm)\n\ -@end example\n\ -\n\ -@noindent\n\ -returns the original array @var{A}.\n\ -@seealso{permute}\n\ -@end deftypefn") -{ - return do_permute (args, true); -} - -DEFUN (length, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} length (@var{a})\n\ -Return the \"length\" of the object @var{a}. For matrix objects, the\n\ -length is the number of rows or columns, whichever is greater (this\n\ -odd definition is used for compatibility with @sc{matlab}).\n\ -@seealso{size}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).length (); - else - print_usage (); - - return retval; -} - -DEFUN (ndims, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ndims (@var{a})\n\ -Return the number of dimensions of @var{a}.\n\ -For any array, the result will always be larger than or equal to 2.\n\ -Trailing singleton dimensions are not counted.\n\ -\n\ -@example\n\ -@group\n\ -ndims (ones (4, 1, 2, 1))\n\ - @result{} 3\n\ -@end group\n\ -@end example\n\ -@seealso{size}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).ndims (); - else - print_usage (); - - return retval; -} - -DEFUN (numel, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} numel (@var{a})\n\ -@deftypefnx {Built-in Function} {} numel (@var{a}, @var{idx1}, @var{idx2}, @dots{})\n\ -Return the number of elements in the object @var{a}.\n\ -Optionally, if indices @var{idx1}, @var{idx2}, @dots{} are supplied,\n\ -return the number of elements that would result from the indexing\n\ -\n\ -@example\n\ -@var{a}(@var{idx1}, @var{idx2}, @dots{})\n\ -@end example\n\ -\n\ -Note that the indices do not have to be numerical. For example,\n\ -\n\ -@example\n\ -@group\n\ -@var{a} = 1;\n\ -@var{b} = ones (2, 3);\n\ -numel (@var{a}, @var{b})\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -will return 6, as this is the number of ways to index with @var{b}.\n\ -\n\ -This method is also called when an object appears as lvalue with cs-list\n\ -indexing, i.e., @code{object@{@dots{}@}} or @code{object(@dots{}).field}.\n\ -@seealso{size}\n\ -@end deftypefn") -{ - octave_value retval; - octave_idx_type nargin = args.length (); - - if (nargin == 1) - retval = args(0).numel (); - else if (nargin > 1) - { - // Don't use numel (const octave_value_list&) here as that corresponds to - // an overloaded call, not to builtin! - retval = dims_to_numel (args(0).dims (), args.slice (1, nargin-1)); - } - else - print_usage (); - - return retval; -} - -DEFUN (size, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} size (@var{a})\n\ -@deftypefnx {Built-in Function} {} size (@var{a}, @var{dim})\n\ -Return the number of rows and columns of @var{a}.\n\ -\n\ -With one input argument and one output argument, the result is returned\n\ -in a row vector. If there are multiple output arguments, the number of\n\ -rows is assigned to the first, and the number of columns to the second,\n\ -etc. For example:\n\ -\n\ -@example\n\ -@group\n\ -size ([1, 2; 3, 4; 5, 6])\n\ - @result{} [ 3, 2 ]\n\ -\n\ -[nr, nc] = size ([1, 2; 3, 4; 5, 6])\n\ - @result{} nr = 3\n\ - @result{} nc = 2\n\ -@end group\n\ -@end example\n\ -\n\ -If given a second argument, @code{size} will return the size of the\n\ -corresponding dimension. For example,\n\ -\n\ -@example\n\ -@group\n\ -size ([1, 2; 3, 4; 5, 6], 2)\n\ - @result{} 2\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -returns the number of columns in the given matrix.\n\ -@seealso{numel, ndims, length, rows, columns}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 1) - { - const dim_vector dimensions = args(0).dims (); - - if (nargout > 1) - { - const dim_vector rdims = dimensions.redim (nargout); - retval.resize (nargout); - for (int i = 0; i < nargout; i++) - retval(i) = rdims(i); - } - else - { - int ndims = dimensions.length (); - - NoAlias m (1, ndims); - - for (int i = 0; i < ndims; i++) - m(i) = dimensions(i); - - retval(0) = m; - } - } - else if (nargin == 2 && nargout < 2) - { - octave_idx_type nd = args(1).int_value (true); - - if (error_state) - error ("size: DIM must be a scalar"); - else - { - const dim_vector dv = args(0).dims (); - - if (nd > 0) - { - if (nd <= dv.length ()) - retval(0) = dv(nd-1); - else - retval(0) = 1; - } - else - error ("size: requested dimension DIM (= %d) out of range", nd); - } - } - else - print_usage (); - - return retval; -} - -DEFUN (size_equal, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} size_equal (@var{a}, @var{b}, @dots{})\n\ -Return true if the dimensions of all arguments agree.\n\ -Trailing singleton dimensions are ignored.\n\ -Called with a single or no argument, size_equal returns true.\n\ -@seealso{size, numel, ndims}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - retval = true; - - if (nargin >= 1) - { - dim_vector a_dims = args(0).dims (); - - for (int i = 1; i < nargin; ++i) - { - dim_vector b_dims = args(i).dims (); - - if (a_dims != b_dims) - { - retval = false; - break; - } - } - } - - return retval; -} - -DEFUN (nnz, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{scalar} =} nnz (@var{a})\n\ -Return the number of non zero elements in @var{a}.\n\ -@seealso{sparse, nzmax}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).nnz (); - else - print_usage (); - - return retval; -} - -DEFUN (nzmax, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{scalar} =} nzmax (@var{SM})\n\ -Return the amount of storage allocated to the sparse matrix @var{SM}.\n\ -Note that Octave tends to crop unused memory at the first opportunity\n\ -for sparse objects. There are some cases of user created sparse objects\n\ -where the value returned by @dfn{nzmax} will not be the same as @dfn{nnz},\n\ -but in general they will give the same result.\n\ -@seealso{nnz, spalloc, sparse}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).nzmax (); - else - print_usage (); - - return retval; -} - -DEFUN (rows, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} rows (@var{a})\n\ -Return the number of rows of @var{a}.\n\ -@seealso{columns, size, length, numel, isscalar, isvector, ismatrix}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).rows (); - else - print_usage (); - - return retval; -} - -DEFUN (columns, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} columns (@var{a})\n\ -Return the number of columns of @var{a}.\n\ -@seealso{rows, size, length, numel, isscalar, isvector, ismatrix}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).columns (); - else - print_usage (); - - return retval; -} - -DEFUN (sum, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} sum (@var{x})\n\ -@deftypefnx {Built-in Function} {} sum (@var{x}, @var{dim})\n\ -@deftypefnx {Built-in Function} {} sum (@dots{}, \"native\")\n\ -@deftypefnx {Built-in Function} {} sum (@dots{}, \"double\")\n\ -@deftypefnx {Built-in Function} {} sum (@dots{}, \"extra\")\n\ -Sum of elements along dimension @var{dim}. If @var{dim} is\n\ -omitted, it defaults to the first non-singleton dimension.\n\ -\n\ -If the optional argument \"native\" is given, then the sum is performed\n\ -in the same type as the original argument, rather than in the default\n\ -double type. For example:\n\ -\n\ -@example\n\ -@group\n\ -sum ([true, true])\n\ - @result{} 2\n\ -sum ([true, true], \"native\")\n\ - @result{} true\n\ -@end group\n\ -@end example\n\ -\n\ -On the contrary, if \"double\" is given, the sum is performed in double\n\ -precision even for single precision inputs.\n\ -\n\ -For double precision inputs, \"extra\" indicates that a more accurate\n\ -algorithm than straightforward summation is to be used. For single precision\n\ -inputs, \"extra\" is the same as \"double\". Otherwise, \"extra\" has no\n\ -effect.\n\ -@seealso{cumsum, sumsq, prod}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - bool isnative = false; - bool isdouble = false; - bool isextra = false; - - if (nargin > 1 && args(nargin - 1).is_string ()) - { - std::string str = args(nargin - 1).string_value (); - - if (! error_state) - { - if (str == "native") - isnative = true; - else if (str == "double") - isdouble = true; - else if (str == "extra") - isextra = true; - else - error ("sum: unrecognized string argument"); - nargin --; - } - } - - if (error_state) - return retval; - - if (nargin == 1 || nargin == 2) - { - octave_value arg = args(0); - - int dim = -1; - if (nargin == 2) - { - dim = args(1).int_value () - 1; - if (dim < 0) - error ("sum: invalid dimension DIM = %d", dim + 1); - } - - if (! error_state) - { - switch (arg.builtin_type ()) - { - case btyp_double: - if (arg.is_sparse_type ()) - { - if (isextra) - warning ("sum: 'extra' not yet implemented for sparse matrices"); - retval = arg.sparse_matrix_value ().sum (dim); - } - else if (isextra) - retval = arg.array_value ().xsum (dim); - else - retval = arg.array_value ().sum (dim); - break; - case btyp_complex: - if (arg.is_sparse_type ()) - { - if (isextra) - warning ("sum: 'extra' not yet implemented for sparse matrices"); - retval = arg.sparse_complex_matrix_value ().sum (dim); - } - else if (isextra) - retval = arg.complex_array_value ().xsum (dim); - else - retval = arg.complex_array_value ().sum (dim); - break; - case btyp_float: - if (isdouble || isextra) - retval = arg.float_array_value ().dsum (dim); - else - retval = arg.float_array_value ().sum (dim); - break; - case btyp_float_complex: - if (isdouble || isextra) - retval = arg.float_complex_array_value ().dsum (dim); - else - retval = arg.float_complex_array_value ().sum (dim); - break; - -#define MAKE_INT_BRANCH(X) \ - case btyp_ ## X: \ - if (isnative) \ - retval = arg.X ## _array_value ().sum (dim); \ - else \ - retval = arg.X ## _array_value ().dsum (dim); \ - break - MAKE_INT_BRANCH (int8); - MAKE_INT_BRANCH (int16); - MAKE_INT_BRANCH (int32); - MAKE_INT_BRANCH (int64); - MAKE_INT_BRANCH (uint8); - MAKE_INT_BRANCH (uint16); - MAKE_INT_BRANCH (uint32); - MAKE_INT_BRANCH (uint64); -#undef MAKE_INT_BRANCH - // GAGME: Accursed Matlab compatibility... - case btyp_char: - if (isextra) - retval = arg.array_value (true).xsum (dim); - else - retval = arg.array_value (true).sum (dim); - break; - case btyp_bool: - if (arg.is_sparse_type ()) - { - if (isnative) - retval = arg.sparse_bool_matrix_value ().any (dim); - else - retval = arg.sparse_bool_matrix_value ().sum (dim); - } - else if (isnative) - retval = arg.bool_array_value ().any (dim); - else - retval = arg.bool_array_value ().sum (dim); - break; - - default: - gripe_wrong_type_arg ("sum", arg); - } - } - } - else - print_usage (); - - return retval; -} - -/* -%!assert (sum ([true,true]), 2) -%!assert (sum ([true,true],"native"), true) -%!assert (sum (int8 ([127,10,-20])), 117) -%!assert (sum (int8 ([127,10,-20]),'native'), int8 (107)) - -%!assert (sum ([1, 2, 3]), 6) -%!assert (sum ([-1; -2; -3]), -6) -%!assert (sum ([i, 2+i, -3+2i, 4]), 3+4i) -%!assert (sum ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i]), [2+2i, 4+4i, 6+6i]) - -%!assert (sum (single ([1, 2, 3])), single (6)) -%!assert (sum (single ([-1; -2; -3])), single (-6)) -%!assert (sum (single ([i, 2+i, -3+2i, 4])), single (3+4i)) -%!assert (sum (single ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single ([2+2i, 4+4i, 6+6i])) - -%!assert (sum ([1, 2; 3, 4], 1), [4, 6]) -%!assert (sum ([1, 2; 3, 4], 2), [3; 7]) -%!assert (sum (zeros (1, 0)), 0) -%!assert (sum (zeros (1, 0), 1), zeros (1, 0)) -%!assert (sum (zeros (1, 0), 2), 0) -%!assert (sum (zeros (0, 1)), 0) -%!assert (sum (zeros (0, 1), 1), 0) -%!assert (sum (zeros (0, 1), 2), zeros (0, 1)) -%!assert (sum (zeros (2, 0)), zeros (1, 0)) -%!assert (sum (zeros (2, 0), 1), zeros (1, 0)) -%!assert (sum (zeros (2, 0), 2), [0; 0]) -%!assert (sum (zeros (0, 2)), [0, 0]) -%!assert (sum (zeros (0, 2), 1), [0, 0]) -%!assert (sum (zeros (0, 2), 2), zeros (0, 1)) -%!assert (sum (zeros (2, 2, 0, 3)), zeros (1, 2, 0, 3)) -%!assert (sum (zeros (2, 2, 0, 3), 2), zeros (2, 1, 0, 3)) -%!assert (sum (zeros (2, 2, 0, 3), 3), zeros (2, 2, 1, 3)) -%!assert (sum (zeros (2, 2, 0, 3), 4), zeros (2, 2, 0)) -%!assert (sum (zeros (2, 2, 0, 3), 7), zeros (2, 2, 0, 3)) - -%!assert (sum (single ([1, 2; 3, 4]), 1), single ([4, 6])) -%!assert (sum (single ([1, 2; 3, 4]), 2), single ([3; 7])) -%!assert (sum (zeros (1, 0, "single")), single (0)) -%!assert (sum (zeros (1, 0, "single"), 1), zeros (1, 0, "single")) -%!assert (sum (zeros (1, 0, "single"), 2), single (0)) -%!assert (sum (zeros (0, 1, "single")), single (0)) -%!assert (sum (zeros (0, 1, "single"), 1), single (0)) -%!assert (sum (zeros (0, 1, "single"), 2), zeros (0, 1, "single")) -%!assert (sum (zeros (2, 0, "single")), zeros (1, 0, "single")) -%!assert (sum (zeros (2, 0, "single"), 1), zeros (1, 0, "single")) -%!assert (sum (zeros (2, 0, "single"), 2), single ([0; 0])) -%!assert (sum (zeros (0, 2, "single")), single ([0, 0])) -%!assert (sum (zeros (0, 2, "single"), 1), single ([0, 0])) -%!assert (sum (zeros (0, 2, "single"), 2), zeros (0, 1, "single")) -%!assert (sum (zeros (2, 2, 0, 3, "single")), zeros (1, 2, 0, 3, "single")) -%!assert (sum (zeros (2, 2, 0, 3, "single"), 2), zeros (2, 1, 0, 3, "single")) -%!assert (sum (zeros (2, 2, 0, 3, "single"), 3), zeros (2, 2, 1, 3, "single")) -%!assert (sum (zeros (2, 2, 0, 3, "single"), 4), zeros (2, 2, 0, "single")) -%!assert (sum (zeros (2, 2, 0, 3, "single"), 7), zeros (2, 2, 0, 3, "single")) - -;-) -%!assert (sum ("Octave") + "8", sumsq (primes (17))) - -%!error sum () -*/ - -DEFUN (sumsq, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} sumsq (@var{x})\n\ -@deftypefnx {Built-in Function} {} sumsq (@var{x}, @var{dim})\n\ -Sum of squares of elements along dimension @var{dim}. If @var{dim}\n\ -is omitted, it defaults to the first non-singleton dimension.\n\ -\n\ -This function is conceptually equivalent to computing\n\ -\n\ -@example\n\ -sum (x .* conj (x), dim)\n\ -@end example\n\ -\n\ -@noindent\n\ -but it uses less memory and avoids calling @code{conj} if @var{x} is real.\n\ -@seealso{sum, prod}\n\ -@end deftypefn") -{ - DATA_REDUCTION (sumsq); -} - -/* -%!assert (sumsq ([1, 2, 3]), 14) -%!assert (sumsq ([-1; -2; 4i]), 21) -%!assert (sumsq ([1, 2, 3; 2, 3, 4; 4i, 6i, 2]), [21, 49, 29]) - -%!assert (sumsq (single ([1, 2, 3])), single (14)) -%!assert (sumsq (single ([-1; -2; 4i])), single (21)) -%!assert (sumsq (single ([1, 2, 3; 2, 3, 4; 4i, 6i, 2])), single ([21, 49, 29])) - -%!assert (sumsq ([1, 2; 3, 4], 1), [10, 20]) -%!assert (sumsq ([1, 2; 3, 4], 2), [5; 25]) - -%!assert (sumsq (single ([1, 2; 3, 4]), 1), single ([10, 20])) -%!assert (sumsq (single ([1, 2; 3, 4]), 2), single ([5; 25])) - -%!error sumsq () -*/ - -DEFUN (islogical, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} islogical (@var{x})\n\ -@deftypefnx {Built-in Function} {} isbool (@var{x})\n\ -Return true if @var{x} is a logical object.\n\ -@seealso{isfloat, isinteger, ischar, isnumeric, isa}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).is_bool_type (); - else - print_usage (); - - return retval; -} - -DEFALIAS (isbool, islogical); - -/* -%!assert (islogical (true), true) -%!assert (islogical (false), true) -%!assert (islogical ([true, false]), true) -%!assert (islogical (1), false) -%!assert (islogical (1i), false) -%!assert (islogical ([1,1]), false) -%!assert (islogical (single (1)), false) -%!assert (islogical (single (1i)), false) -%!assert (islogical (single ([1,1])), false) -%!assert (islogical (sparse ([true, false])), true) -%!assert (islogical (sparse ([1, 0])), false) -*/ - -DEFUN (isinteger, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isinteger (@var{x})\n\ -Return true if @var{x} is an integer object (int8, uint8, int16, etc.).\n\ -Note that @w{@code{isinteger (14)}} is false because numeric constants in\n\ -Octave are double precision floating point values.\n\ -@seealso{isfloat, ischar, islogical, isnumeric, isa}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).is_integer_type (); - else - print_usage (); - - return retval; -} - -DEFUN (iscomplex, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} iscomplex (@var{x})\n\ -Return true if @var{x} is a complex-valued numeric object.\n\ -@seealso{isreal, isnumeric, islogical, ischar, isfloat, isa}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).is_complex_type (); - else - print_usage (); - - return retval; -} - -DEFUN (isfloat, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isfloat (@var{x})\n\ -Return true if @var{x} is a floating-point numeric object.\n\ -Objects of class double or single are floating-point objects.\n\ -@seealso{isinteger, ischar, islogical, isnumeric, isa}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).is_float_type (); - else - print_usage (); - - return retval; -} - -// FIXME -- perhaps this should be implemented with an -// octave_value member function? - -DEFUN (complex, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} complex (@var{x})\n\ -@deftypefnx {Built-in Function} {} complex (@var{re}, @var{im})\n\ -Return a complex result from real arguments. With 1 real argument @var{x},\n\ -return the complex result @code{@var{x} + 0i}. With 2 real arguments,\n\ -return the complex result @code{@var{re} + @var{im}}. @code{complex} can\n\ -often be more convenient than expressions such as @code{a + i*b}.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -complex ([1, 2], [3, 4])\n\ - @result{} [ 1 + 3i 2 + 4i ]\n\ -@end group\n\ -@end example\n\ -@seealso{real, imag, iscomplex, abs, arg}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - octave_value arg = args(0); - - if (arg.is_complex_type ()) - retval = arg; - else - { - if (arg.is_sparse_type ()) - { - SparseComplexMatrix val = arg.sparse_complex_matrix_value (); - - if (! error_state) - retval = octave_value (new octave_sparse_complex_matrix (val)); - } - else if (arg.is_single_type ()) - { - if (arg.numel () == 1) - { - FloatComplex val = arg.float_complex_value (); - - if (! error_state) - retval = octave_value (new octave_float_complex (val)); - } - else - { - FloatComplexNDArray val = arg.float_complex_array_value (); - - if (! error_state) - retval = octave_value (new octave_float_complex_matrix (val)); - } - } - else - { - if (arg.numel () == 1) - { - Complex val = arg.complex_value (); - - if (! error_state) - retval = octave_value (new octave_complex (val)); - } - else - { - ComplexNDArray val = arg.complex_array_value (); - - if (! error_state) - retval = octave_value (new octave_complex_matrix (val)); - } - } - - if (error_state) - error ("complex: invalid conversion"); - } - } - else if (nargin == 2) - { - octave_value re = args(0); - octave_value im = args(1); - - if (re.is_sparse_type () && im.is_sparse_type ()) - { - const SparseMatrix re_val = re.sparse_matrix_value (); - const SparseMatrix im_val = im.sparse_matrix_value (); - - if (!error_state) - { - if (re.numel () == 1) - { - SparseComplexMatrix result; - if (re_val.nnz () == 0) - result = Complex (0, 1) * SparseComplexMatrix (im_val); - else - { - result = SparseComplexMatrix (im_val.dims (), re_val (0)); - octave_idx_type nr = im_val.rows (); - octave_idx_type nc = im_val.cols (); - - for (octave_idx_type j = 0; j < nc; j++) - { - octave_idx_type off = j * nr; - for (octave_idx_type i = im_val.cidx (j); - i < im_val.cidx (j + 1); i++) - result.data (im_val.ridx (i) + off) = - result.data (im_val.ridx (i) + off) + - Complex (0, im_val.data (i)); - } - } - retval = octave_value (new octave_sparse_complex_matrix (result)); - } - else if (im.numel () == 1) - { - SparseComplexMatrix result; - if (im_val.nnz () == 0) - result = SparseComplexMatrix (re_val); - else - { - result = SparseComplexMatrix (re_val.rows (), re_val.cols (), Complex (0, im_val (0))); - octave_idx_type nr = re_val.rows (); - octave_idx_type nc = re_val.cols (); - - for (octave_idx_type j = 0; j < nc; j++) - { - octave_idx_type off = j * nr; - for (octave_idx_type i = re_val.cidx (j); - i < re_val.cidx (j + 1); i++) - result.data (re_val.ridx (i) + off) = - result.data (re_val.ridx (i) + off) + - re_val.data (i); - } - } - retval = octave_value (new octave_sparse_complex_matrix (result)); - } - else - { - if (re_val.dims () == im_val.dims ()) - { - SparseComplexMatrix result = SparseComplexMatrix (re_val) - + Complex (0, 1) * SparseComplexMatrix (im_val); - retval = octave_value (new octave_sparse_complex_matrix (result)); - } - else - error ("complex: dimension mismatch"); - } - } - } - else if (re.is_single_type () || im.is_single_type ()) - { - if (re.numel () == 1) - { - float re_val = re.float_value (); - - if (im.numel () == 1) - { - float im_val = im.double_value (); - - if (! error_state) - retval = octave_value (new octave_float_complex (FloatComplex (re_val, im_val))); - } - else - { - const FloatNDArray im_val = im.float_array_value (); - - if (! error_state) - { - FloatComplexNDArray result (im_val.dims (), FloatComplex ()); - - for (octave_idx_type i = 0; i < im_val.numel (); i++) - result.xelem (i) = FloatComplex (re_val, im_val(i)); - - retval = octave_value (new octave_float_complex_matrix (result)); - } - } - } - else - { - const FloatNDArray re_val = re.float_array_value (); - - if (im.numel () == 1) - { - float im_val = im.float_value (); - - if (! error_state) - { - FloatComplexNDArray result (re_val.dims (), FloatComplex ()); - - for (octave_idx_type i = 0; i < re_val.numel (); i++) - result.xelem (i) = FloatComplex (re_val(i), im_val); - - retval = octave_value (new octave_float_complex_matrix (result)); - } - } - else - { - const FloatNDArray im_val = im.float_array_value (); - - if (! error_state) - { - if (re_val.dims () == im_val.dims ()) - { - FloatComplexNDArray result (re_val.dims (), FloatComplex ()); - - for (octave_idx_type i = 0; i < re_val.numel (); i++) - result.xelem (i) = FloatComplex (re_val(i), im_val(i)); - - retval = octave_value (new octave_float_complex_matrix (result)); - } - else - error ("complex: dimension mismatch"); - } - } - } - } - else if (re.numel () == 1) - { - double re_val = re.double_value (); - - if (im.numel () == 1) - { - double im_val = im.double_value (); - - if (! error_state) - retval = octave_value (new octave_complex (Complex (re_val, im_val))); - } - else - { - const NDArray im_val = im.array_value (); - - if (! error_state) - { - ComplexNDArray result (im_val.dims (), Complex ()); - - for (octave_idx_type i = 0; i < im_val.numel (); i++) - result.xelem (i) = Complex (re_val, im_val(i)); - - retval = octave_value (new octave_complex_matrix (result)); - } - } - } - else - { - const NDArray re_val = re.array_value (); - - if (im.numel () == 1) - { - double im_val = im.double_value (); - - if (! error_state) - { - ComplexNDArray result (re_val.dims (), Complex ()); - - for (octave_idx_type i = 0; i < re_val.numel (); i++) - result.xelem (i) = Complex (re_val(i), im_val); - - retval = octave_value (new octave_complex_matrix (result)); - } - } - else - { - const NDArray im_val = im.array_value (); - - if (! error_state) - { - if (re_val.dims () == im_val.dims ()) - { - ComplexNDArray result (re_val.dims (), Complex ()); - - for (octave_idx_type i = 0; i < re_val.numel (); i++) - result.xelem (i) = Complex (re_val(i), im_val(i)); - - retval = octave_value (new octave_complex_matrix (result)); - } - else - error ("complex: dimension mismatch"); - } - } - } - - if (error_state) - error ("complex: invalid conversion"); - } - else - print_usage (); - - return retval; -} - -DEFUN (isreal, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isreal (@var{x})\n\ -Return true if @var{x} is a non-complex matrix or scalar.\n\ -For compatibility with @sc{matlab}, this includes logical and character\n\ -matrices.\n\ -@seealso{iscomplex, isnumeric, isa}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).is_real_type (); - else - print_usage (); - - return retval; -} - -DEFUN (isempty, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isempty (@var{a})\n\ -Return true if @var{a} is an empty matrix (any one of its dimensions is\n\ -zero). Otherwise, return false.\n\ -@seealso{isnull, isa}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - retval = args(0).is_empty (); - else - print_usage (); - - return retval; -} - -/* -%% Debian bug #706376 -%!assert (isempty (speye(2^16)), false) -*/ - -DEFUN (isnumeric, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isnumeric (@var{x})\n\ -Return true if @var{x} is a numeric object, i.e., an integer, real, or\n\ -complex array. Logical and character arrays are not considered to be\n\ -numeric.\n\ -@seealso{isinteger, isfloat, isreal, iscomplex, islogical, ischar, iscell, isstruct, isa}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).is_numeric_type (); - else - print_usage (); - - return retval; -} - -/* -%!assert (isnumeric (1), true) -%!assert (isnumeric (1i), true) -%!assert (isnumeric ([1,1]), true) -%!assert (isnumeric (single (1)), true) -%!assert (isnumeric (single (1i)), true) -%!assert (isnumeric (single ([1,1])), true) -%!assert (isnumeric (int8 (1)), true) -%!assert (isnumeric (uint8 ([1,1])), true) -%!assert (isnumeric ("Hello World"), false) -%!assert (isnumeric (true), false) -%!assert (isnumeric (false), false) -%!assert (isnumeric ([true, false]), false) -%!assert (isnumeric (sparse ([true, false])), false) -*/ - -DEFUN (ismatrix, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ismatrix (@var{a})\n\ -Return true if @var{a} is a numeric, logical, or character matrix.\n\ -Scalars (1x1 matrices) and vectors (@nospell{1xN} or @nospell{Nx1} matrices)\n\ -are subsets of the more general N-dimensional matrix and @code{ismatrix}\n\ -will return true for these objects as well.\n\ -@seealso{isscalar, isvector, iscell, isstruct, issparse, isa}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - { - octave_value arg = args(0); - - retval = arg.is_matrix_type () || arg.is_scalar_type () || arg.is_range (); - } - else - print_usage (); - - return retval; -} - -/* -%!assert (ismatrix ([])) -%!assert (ismatrix (1)) -%!assert (ismatrix ([1, 2, 3])) -%!assert (ismatrix ([1, 2; 3, 4])) -%!assert (ismatrix (zeros (3, 2, 4))) - -%!assert (ismatrix (single ([]))) -%!assert (ismatrix (single (1))) -%!assert (ismatrix (single ([1, 2, 3]))) -%!assert (ismatrix (single ([1, 2; 3, 4]))) - -%!assert (ismatrix ("t")) -%!assert (ismatrix ("test")) -%!assert (ismatrix (["test"; "ing"])) - -%!test -%! s.a = 1; -%! assert (ismatrix (s), false); - -%!error ismatrix () -%!error ismatrix ([1, 2; 3, 4], 2) -*/ - -static octave_value -fill_matrix (const octave_value_list& args, int val, const char *fcn) -{ - octave_value retval; - - int nargin = args.length (); - - oct_data_conv::data_type dt = oct_data_conv::dt_double; - - dim_vector dims (1, 1); - - if (nargin > 0 && args(nargin-1).is_string ()) - { - std::string nm = args(nargin-1).string_value (); - nargin--; - - dt = oct_data_conv::string_to_data_type (nm); - - if (error_state) - return retval; - } - - switch (nargin) - { - case 0: - break; - - case 1: - get_dimensions (args(0), fcn, dims); - break; - - default: - { - dims.resize (nargin); - - for (int i = 0; i < nargin; i++) - { - dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); - - if (error_state) - { - error ("%s: expecting scalar integer arguments", fcn); - break; - } - } - } - break; - } - - if (! error_state) - { - dims.chop_trailing_singletons (); - - check_dimensions (dims, fcn); - - // FIXME -- perhaps this should be made extensible by - // using the class name to lookup a function to call to create - // the new value. - - // Note that automatic narrowing will handle conversion from - // NDArray to scalar. - - if (! error_state) - { - switch (dt) - { - case oct_data_conv::dt_int8: - retval = int8NDArray (dims, val); - break; - - case oct_data_conv::dt_uint8: - retval = uint8NDArray (dims, val); - break; - - case oct_data_conv::dt_int16: - retval = int16NDArray (dims, val); - break; - - case oct_data_conv::dt_uint16: - retval = uint16NDArray (dims, val); - break; - - case oct_data_conv::dt_int32: - retval = int32NDArray (dims, val); - break; - - case oct_data_conv::dt_uint32: - retval = uint32NDArray (dims, val); - break; - - case oct_data_conv::dt_int64: - retval = int64NDArray (dims, val); - break; - - case oct_data_conv::dt_uint64: - retval = uint64NDArray (dims, val); - break; - - case oct_data_conv::dt_single: - retval = FloatNDArray (dims, val); - break; - - case oct_data_conv::dt_double: - { - if (val == 1 && dims.length () == 2 && dims (0) == 1) - retval = Range (1.0, 0.0, dims (1)); // packed form - else - retval = NDArray (dims, val); - } - break; - - case oct_data_conv::dt_logical: - retval = boolNDArray (dims, val); - break; - - default: - error ("%s: invalid class name", fcn); - break; - } - } - } - - return retval; -} - -static octave_value -fill_matrix (const octave_value_list& args, double val, float fval, - const char *fcn) -{ - octave_value retval; - - int nargin = args.length (); - - oct_data_conv::data_type dt = oct_data_conv::dt_double; - - dim_vector dims (1, 1); - - if (nargin > 0 && args(nargin-1).is_string ()) - { - std::string nm = args(nargin-1).string_value (); - nargin--; - - dt = oct_data_conv::string_to_data_type (nm); - - if (error_state) - return retval; - } - - switch (nargin) - { - case 0: - break; - - case 1: - get_dimensions (args(0), fcn, dims); - break; - - default: - { - dims.resize (nargin); - - for (int i = 0; i < nargin; i++) - { - dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); - - if (error_state) - { - error ("%s: expecting scalar integer arguments", fcn); - break; - } - } - } - break; - } - - if (! error_state) - { - dims.chop_trailing_singletons (); - - check_dimensions (dims, fcn); - - // Note that automatic narrowing will handle conversion from - // NDArray to scalar. - - if (! error_state) - { - switch (dt) - { - case oct_data_conv::dt_single: - retval = FloatNDArray (dims, fval); - break; - - case oct_data_conv::dt_double: - retval = NDArray (dims, val); - break; - - default: - error ("%s: invalid class name", fcn); - break; - } - } - } - - return retval; -} - -static octave_value -fill_matrix (const octave_value_list& args, double val, const char *fcn) -{ - octave_value retval; - - int nargin = args.length (); - - oct_data_conv::data_type dt = oct_data_conv::dt_double; - - dim_vector dims (1, 1); - - if (nargin > 0 && args(nargin-1).is_string ()) - { - std::string nm = args(nargin-1).string_value (); - nargin--; - - dt = oct_data_conv::string_to_data_type (nm); - - if (error_state) - return retval; - } - - switch (nargin) - { - case 0: - break; - - case 1: - get_dimensions (args(0), fcn, dims); - break; - - default: - { - dims.resize (nargin); - - for (int i = 0; i < nargin; i++) - { - dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); - - if (error_state) - { - error ("%s: expecting scalar integer arguments", fcn); - break; - } - } - } - break; - } - - if (! error_state) - { - dims.chop_trailing_singletons (); - - check_dimensions (dims, fcn); - - // Note that automatic narrowing will handle conversion from - // NDArray to scalar. - - if (! error_state) - { - switch (dt) - { - case oct_data_conv::dt_single: - retval = FloatNDArray (dims, static_cast (val)); - break; - - case oct_data_conv::dt_double: - retval = NDArray (dims, val); - break; - - default: - error ("%s: invalid class name", fcn); - break; - } - } - } - - return retval; -} - -static octave_value -fill_matrix (const octave_value_list& args, const Complex& val, - const char *fcn) -{ - octave_value retval; - - int nargin = args.length (); - - oct_data_conv::data_type dt = oct_data_conv::dt_double; - - dim_vector dims (1, 1); - - if (nargin > 0 && args(nargin-1).is_string ()) - { - std::string nm = args(nargin-1).string_value (); - nargin--; - - dt = oct_data_conv::string_to_data_type (nm); - - if (error_state) - return retval; - } - - switch (nargin) - { - case 0: - break; - - case 1: - get_dimensions (args(0), fcn, dims); - break; - - default: - { - dims.resize (nargin); - - for (int i = 0; i < nargin; i++) - { - dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); - - if (error_state) - { - error ("%s: expecting scalar integer arguments", fcn); - break; - } - } - } - break; - } - - if (! error_state) - { - dims.chop_trailing_singletons (); - - check_dimensions (dims, fcn); - - // Note that automatic narrowing will handle conversion from - // NDArray to scalar. - - if (! error_state) - { - switch (dt) - { - case oct_data_conv::dt_single: - retval = FloatComplexNDArray (dims, static_cast (val)); - break; - - case oct_data_conv::dt_double: - retval = ComplexNDArray (dims, val); - break; - - default: - error ("%s: invalid class name", fcn); - break; - } - } - } - - return retval; -} - -static octave_value -fill_matrix (const octave_value_list& args, bool val, const char *fcn) -{ - octave_value retval; - - int nargin = args.length (); - - dim_vector dims (1, 1); - - switch (nargin) - { - case 0: - break; - - case 1: - get_dimensions (args(0), fcn, dims); - break; - - default: - { - dims.resize (nargin); - - for (int i = 0; i < nargin; i++) - { - dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); - - if (error_state) - { - error ("%s: expecting scalar integer arguments", fcn); - break; - } - } - } - break; - } - - if (! error_state) - { - dims.chop_trailing_singletons (); - - check_dimensions (dims, fcn); - - // Note that automatic narrowing will handle conversion from - // NDArray to scalar. - - if (! error_state) - retval = boolNDArray (dims, val); - } - - return retval; -} - -DEFUN (ones, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ones (@var{n})\n\ -@deftypefnx {Built-in Function} {} ones (@var{m}, @var{n})\n\ -@deftypefnx {Built-in Function} {} ones (@var{m}, @var{n}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} ones ([@var{m} @var{n} @dots{}])\n\ -@deftypefnx {Built-in Function} {} ones (@dots{}, @var{class})\n\ -Return a matrix or N-dimensional array whose elements are all 1.\n\ -If invoked with a single scalar integer argument @var{n}, return a square\n\ -@nospell{NxN} matrix. If invoked with two or more scalar\n\ -integer arguments, or a vector of integer values, return an array with\n\ -the given dimensions.\n\ -\n\ -If you need to create a matrix whose values are all the same, you should\n\ -use an expression like\n\ -\n\ -@example\n\ -val_matrix = val * ones (m, n)\n\ -@end example\n\ -\n\ -The optional argument @var{class} specifies the class of the return array\n\ -and defaults to double. For example:\n\ -\n\ -@example\n\ -val = ones (m,n, \"uint8\")\n\ -@end example\n\ -@seealso{zeros}\n\ -@end deftypefn") -{ - return fill_matrix (args, 1, "ones"); -} - -/* -%!assert (ones (3), [1, 1, 1; 1, 1, 1; 1, 1, 1]) -%!assert (ones (2, 3), [1, 1, 1; 1, 1, 1]) -%!assert (ones (3, 2), [1, 1; 1, 1; 1, 1]) -%!assert (size (ones (3, 4, 5)), [3, 4, 5]) - -%!assert (ones (3, "single"), single ([1, 1, 1; 1, 1, 1; 1, 1, 1])) -%!assert (ones (2, 3, "single"), single ([1, 1, 1; 1, 1, 1])) -%!assert (ones (3, 2, "single"), single ([1, 1; 1, 1; 1, 1])) -%!assert (size (ones (3, 4, 5, "single")), [3, 4, 5]) - -%!assert (ones (3, "int8"), int8 ([1, 1, 1; 1, 1, 1; 1, 1, 1])) -%!assert (ones (2, 3, "int8"), int8 ([1, 1, 1; 1, 1, 1])) -%!assert (ones (3, 2, "int8"), int8 ([1, 1; 1, 1; 1, 1])) -%!assert (size (ones (3, 4, 5, "int8")), [3, 4, 5]) -*/ - -DEFUN (zeros, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} zeros (@var{n})\n\ -@deftypefnx {Built-in Function} {} zeros (@var{m}, @var{n})\n\ -@deftypefnx {Built-in Function} {} zeros (@var{m}, @var{n}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} zeros ([@var{m} @var{n} @dots{}])\n\ -@deftypefnx {Built-in Function} {} zeros (@dots{}, @var{class})\n\ -Return a matrix or N-dimensional array whose elements are all 0.\n\ -If invoked with a single scalar integer argument, return a square\n\ -@nospell{NxN} matrix. If invoked with two or more scalar\n\ -integer arguments, or a vector of integer values, return an array with\n\ -the given dimensions.\n\ -\n\ -The optional argument @var{class} specifies the class of the return array\n\ -and defaults to double. For example:\n\ -\n\ -@example\n\ -val = zeros (m,n, \"uint8\")\n\ -@end example\n\ -@seealso{ones}\n\ -@end deftypefn") -{ - return fill_matrix (args, 0, "zeros"); -} - -/* -%!assert (zeros (3), [0, 0, 0; 0, 0, 0; 0, 0, 0]) -%!assert (zeros (2, 3), [0, 0, 0; 0, 0, 0]) -%!assert (zeros (3, 2), [0, 0; 0, 0; 0, 0]) -%!assert (size (zeros (3, 4, 5)), [3, 4, 5]) - -%!assert (zeros (3, "single"), single ([0, 0, 0; 0, 0, 0; 0, 0, 0])) -%!assert (zeros (2, 3, "single"), single ([0, 0, 0; 0, 0, 0])) -%!assert (zeros (3, 2, "single"), single ([0, 0; 0, 0; 0, 0])) -%!assert (size (zeros (3, 4, 5, "single")), [3, 4, 5]) - -%!assert (zeros (3, "int8"), int8 ([0, 0, 0; 0, 0, 0; 0, 0, 0])) -%!assert (zeros (2, 3, "int8"), int8 ([0, 0, 0; 0, 0, 0])) -%!assert (zeros (3, 2, "int8"), int8 ([0, 0; 0, 0; 0, 0])) -%!assert (size (zeros (3, 4, 5, "int8")), [3, 4, 5]) -*/ - -DEFUN (Inf, args, , - "-*- texinfo -*-\n\ -@c List other form of function in documentation index\n\ -@findex inf\n\ -\n\ -@deftypefn {Built-in Function} {} Inf\n\ -@deftypefnx {Built-in Function} {} Inf (@var{n})\n\ -@deftypefnx {Built-in Function} {} Inf (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} Inf (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} Inf (@dots{}, @var{class})\n\ -Return a scalar, matrix or N-dimensional array whose elements are all equal\n\ -to the IEEE representation for positive infinity.\n\ -\n\ -Infinity is produced when results are too large to be represented using the\n\ -the IEEE floating point format for numbers. Two common examples which\n\ -produce infinity are division by zero and overflow.\n\ -\n\ -@example\n\ -@group\n\ -[ 1/0 e^800 ]\n\ -@result{} Inf Inf\n\ -@end group\n\ -@end example\n\ -\n\ -When called with no arguments, return a scalar with the value @samp{Inf}.\n\ -When called with a single argument, return a square matrix with the dimension\n\ -specified. When called with more than one scalar argument the first two\n\ -arguments are taken as the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{isinf, NaN}\n\ -@end deftypefn") -{ - return fill_matrix (args, lo_ieee_inf_value (), - lo_ieee_float_inf_value (), "Inf"); -} - -DEFALIAS (inf, Inf); - -/* -%!assert (inf (3), [Inf, Inf, Inf; Inf, Inf, Inf; Inf, Inf, Inf]) -%!assert (inf (2, 3), [Inf, Inf, Inf; Inf, Inf, Inf]) -%!assert (inf (3, 2), [Inf, Inf; Inf, Inf; Inf, Inf]) -%!assert (size (inf (3, 4, 5)), [3, 4, 5]) - -%!assert (inf (3, "single"), single ([Inf, Inf, Inf; Inf, Inf, Inf; Inf, Inf, Inf])) -%!assert (inf (2, 3, "single"), single ([Inf, Inf, Inf; Inf, Inf, Inf])) -%!assert (inf (3, 2, "single"), single ([Inf, Inf; Inf, Inf; Inf, Inf])) -%!assert (size (inf (3, 4, 5, "single")), [3, 4, 5]) - -%!error (inf (3, "int8")) -%!error (inf (2, 3, "int8")) -%!error (inf (3, 2, "int8")) -%!error (inf (3, 4, 5, "int8")) -*/ - -DEFUN (NaN, args, , - "-*- texinfo -*-\n\ -@c List other form of function in documentation index\n\ -@findex nan\n\ -\n\ -@deftypefn {Built-in Function} {} NaN\n\ -@deftypefnx {Built-in Function} {} NaN (@var{n})\n\ -@deftypefnx {Built-in Function} {} NaN (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} NaN (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} NaN (@dots{}, @var{class})\n\ -Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ -to the IEEE symbol NaN (Not a Number).\n\ -NaN is the result of operations which do not produce a well defined numerical\n\ -result. Common operations which produce a NaN are arithmetic with infinity\n\ -@tex\n\ -($\\infty - \\infty$), zero divided by zero ($0/0$),\n\ -@end tex\n\ -@ifnottex\n\ -(Inf - Inf), zero divided by zero (0/0),\n\ -@end ifnottex\n\ -and any operation involving another NaN value (5 + NaN).\n\ -\n\ -Note that NaN always compares not equal to NaN (NaN != NaN). This behavior\n\ -is specified by the IEEE standard for floating point arithmetic. To\n\ -find NaN values, use the @code{isnan} function.\n\ -\n\ -When called with no arguments, return a scalar with the value @samp{NaN}.\n\ -When called with a single argument, return a square matrix with the dimension\n\ -specified. When called with more than one scalar argument the first two\n\ -arguments are taken as the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{isnan, Inf}\n\ -@end deftypefn") -{ - return fill_matrix (args, lo_ieee_nan_value (), - lo_ieee_float_nan_value (), "NaN"); -} - -DEFALIAS (nan, NaN); - -/* -%!assert (NaN (3), [NaN, NaN, NaN; NaN, NaN, NaN; NaN, NaN, NaN]) -%!assert (NaN (2, 3), [NaN, NaN, NaN; NaN, NaN, NaN]) -%!assert (NaN (3, 2), [NaN, NaN; NaN, NaN; NaN, NaN]) -%!assert (size (NaN (3, 4, 5)), [3, 4, 5]) - -%!assert (NaN (3, "single"), single ([NaN, NaN, NaN; NaN, NaN, NaN; NaN, NaN, NaN])) -%!assert (NaN (2, 3, "single"), single ([NaN, NaN, NaN; NaN, NaN, NaN])) -%!assert (NaN (3, 2, "single"), single ([NaN, NaN; NaN, NaN; NaN, NaN])) -%!assert (size (NaN (3, 4, 5, "single")), [3, 4, 5]) - -%!error (NaN (3, "int8")) -%!error (NaN (2, 3, "int8")) -%!error (NaN (3, 2, "int8")) -%!error (NaN (3, 4, 5, "int8")) -*/ - -DEFUN (e, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} e\n\ -@deftypefnx {Built-in Function} {} e (@var{n})\n\ -@deftypefnx {Built-in Function} {} e (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} e (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} e (@dots{}, @var{class})\n\ -Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ -to the base of natural logarithms. The constant\n\ -@tex\n\ -$e$ satisfies the equation $\\log (e) = 1$.\n\ -@end tex\n\ -@ifnottex\n\ -@samp{e} satisfies the equation @code{log} (e) = 1.\n\ -@end ifnottex\n\ -\n\ -When called with no arguments, return a scalar with the value @math{e}. When\n\ -called with a single argument, return a square matrix with the dimension\n\ -specified. When called with more than one scalar argument the first two\n\ -arguments are taken as the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{log, exp, pi, I}\n\ -@end deftypefn") -{ -#if defined (M_E) - double e_val = M_E; -#else - double e_val = exp (1.0); -#endif - - return fill_matrix (args, e_val, "e"); -} - -DEFUN (eps, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} eps\n\ -@deftypefnx {Built-in Function} {} eps (@var{x})\n\ -@deftypefnx {Built-in Function} {} eps (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} eps (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} eps (@dots{}, @var{class})\n\ -Return a scalar, matrix or N-dimensional array whose elements are all eps,\n\ -the machine precision. More precisely, @code{eps} is the relative spacing\n\ -between any two adjacent numbers in the machine's floating point system.\n\ -This number is obviously system dependent. On machines that support IEEE\n\ -floating point arithmetic, @code{eps} is approximately\n\ -@tex\n\ -$2.2204\\times10^{-16}$ for double precision and $1.1921\\times10^{-7}$\n\ -@end tex\n\ -@ifnottex\n\ -2.2204e-16 for double precision and 1.1921e-07\n\ -@end ifnottex\n\ -for single precision.\n\ -\n\ -When called with no arguments, return a scalar with the value\n\ -@code{eps (1.0)}.\n\ -Given a single argument @var{x}, return the distance between @var{x} and\n\ -the next largest value.\n\ -When called with more than one argument the first two arguments are taken as\n\ -the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{realmax, realmin, intmax, bitmax}\n\ -@end deftypefn") -{ - int nargin = args.length (); - octave_value retval; - - if (nargin == 1 && ! args(0).is_string ()) - { - if (args(0).is_single_type ()) - { - Array x = args(0).float_array_value (); - - if (! error_state) - { - Array epsval (x.dims ()); - - for (octave_idx_type i = 0; i < x.numel (); i++) - { - float val = ::fabsf (x(i)); - if (xisnan (val) || xisinf (val)) - epsval(i) = lo_ieee_nan_value (); - else if (val < std::numeric_limits::min ()) - epsval(i) = powf (2.0, -149e0); - else - { - int expon; - frexpf (val, &expon); - epsval(i) = std::pow (static_cast (2.0), - static_cast (expon - 24)); - } - } - retval = epsval; - } - } - else - { - Array x = args(0).array_value (); - - if (! error_state) - { - Array epsval (x.dims ()); - - for (octave_idx_type i = 0; i < x.numel (); i++) - { - double val = ::fabs (x(i)); - if (xisnan (val) || xisinf (val)) - epsval(i) = lo_ieee_nan_value (); - else if (val < std::numeric_limits::min ()) - epsval(i) = pow (2.0, -1074e0); - else - { - int expon; - frexp (val, &expon); - epsval(i) = std::pow (static_cast (2.0), - static_cast (expon - 53)); - } - retval = epsval; - } - } - } - } - else - retval = fill_matrix (args, std::numeric_limits::epsilon (), - std::numeric_limits::epsilon (), "eps"); - - return retval; -} - -/* -%!assert (eps (1/2), 2^(-53)) -%!assert (eps (1), 2^(-52)) -%!assert (eps (2), 2^(-51)) -%!assert (eps (realmax), 2^971) -%!assert (eps (0), 2^(-1074)) -%!assert (eps (realmin/2), 2^(-1074)) -%!assert (eps (realmin/16), 2^(-1074)) -%!assert (eps (Inf), NaN) -%!assert (eps (NaN), NaN) -%!assert (eps ([1/2 1 2 realmax 0 realmin/2 realmin/16 Inf NaN]), -%! [2^(-53) 2^(-52) 2^(-51) 2^971 2^(-1074) 2^(-1074) 2^(-1074) NaN NaN]) -%!assert (eps (single (1/2)), single (2^(-24))) -%!assert (eps (single (1)), single (2^(-23))) -%!assert (eps (single (2)), single (2^(-22))) -%!assert (eps (realmax ("single")), single (2^104)) -%!assert (eps (single (0)), single (2^(-149))) -%!assert (eps (realmin ("single")/2), single (2^(-149))) -%!assert (eps (realmin ("single")/16), single (2^(-149))) -%!assert (eps (single (Inf)), single (NaN)) -%!assert (eps (single (NaN)), single (NaN)) -%!assert (eps (single ([1/2 1 2 realmax("single") 0 realmin("single")/2 realmin("single")/16 Inf NaN])), -%! single ([2^(-24) 2^(-23) 2^(-22) 2^104 2^(-149) 2^(-149) 2^(-149) NaN NaN])) - -*/ - -DEFUN (pi, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} pi\n\ -@deftypefnx {Built-in Function} {} pi (@var{n})\n\ -@deftypefnx {Built-in Function} {} pi (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} pi (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} pi (@dots{}, @var{class})\n\ -Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ -to the ratio of the circumference of a circle to its\n\ -@tex\n\ -diameter($\\pi$).\n\ -@end tex\n\ -@ifnottex\n\ -diameter.\n\ -@end ifnottex\n\ -Internally, @code{pi} is computed as @samp{4.0 * atan (1.0)}.\n\ -\n\ -When called with no arguments, return a scalar with the value of\n\ -@tex\n\ -$\\pi$.\n\ -@end tex\n\ -@ifnottex\n\ -pi.\n\ -@end ifnottex\n\ -When called with a single argument, return a square matrix with the dimension\n\ -specified. When called with more than one scalar argument the first two\n\ -arguments are taken as the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{e, I}\n\ -@end deftypefn") -{ -#if defined (M_PI) - double pi_val = M_PI; -#else - double pi_val = 4.0 * atan (1.0); -#endif - - return fill_matrix (args, pi_val, "pi"); -} - -DEFUN (realmax, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} realmax\n\ -@deftypefnx {Built-in Function} {} realmax (@var{n})\n\ -@deftypefnx {Built-in Function} {} realmax (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} realmax (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} realmax (@dots{}, @var{class})\n\ -Return a scalar, matrix or N-dimensional array whose elements are all equal\n\ -to the largest floating point number that is representable. The actual\n\ -value is system dependent. On machines that support IEEE\n\ -floating point arithmetic, @code{realmax} is approximately\n\ -@tex\n\ -$1.7977\\times10^{308}$ for double precision and $3.4028\\times10^{38}$\n\ -@end tex\n\ -@ifnottex\n\ -1.7977e+308 for double precision and 3.4028e+38\n\ -@end ifnottex\n\ -for single precision.\n\ -\n\ -When called with no arguments, return a scalar with the value\n\ -@code{realmax (\"double\")}.\n\ -When called with a single argument, return a square matrix with the dimension\n\ -specified. When called with more than one scalar argument the first two\n\ -arguments are taken as the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{realmin, intmax, bitmax, eps}\n\ -@end deftypefn") -{ - return fill_matrix (args, std::numeric_limits::max (), - std::numeric_limits::max (), "realmax"); -} - -DEFUN (realmin, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} realmin\n\ -@deftypefnx {Built-in Function} {} realmin (@var{n})\n\ -@deftypefnx {Built-in Function} {} realmin (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} realmin (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} realmin (@dots{}, @var{class})\n\ -Return a scalar, matrix or N-dimensional array whose elements are all equal\n\ -to the smallest normalized floating point number that is representable.\n\ -The actual value is system dependent. On machines that support\n\ -IEEE floating point arithmetic, @code{realmin} is approximately\n\ -@tex\n\ -$2.2251\\times10^{-308}$ for double precision and $1.1755\\times10^{-38}$\n\ -@end tex\n\ -@ifnottex\n\ -2.2251e-308 for double precision and 1.1755e-38\n\ -@end ifnottex\n\ -for single precision.\n\ -\n\ -When called with no arguments, return a scalar with the value\n\ -@code{realmin (\"double\")}.\n\ -When called with a single argument, return a square matrix with the dimension\n\ -specified. When called with more than one scalar argument the first two\n\ -arguments are taken as the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{realmax, intmin, eps}\n\ -@end deftypefn") -{ - return fill_matrix (args, std::numeric_limits::min (), - std::numeric_limits::min (), "realmin"); -} - -DEFUN (I, args, , - "-*- texinfo -*-\n\ -@c List other forms of function in documentation index\n\ -@findex i\n\ -@findex j\n\ -@findex J\n\ -\n\ -@deftypefn {Built-in Function} {} I\n\ -@deftypefnx {Built-in Function} {} I (@var{n})\n\ -@deftypefnx {Built-in Function} {} I (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} I (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} I (@dots{}, @var{class})\n\ -Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ -to the pure imaginary unit, defined as\n\ -@tex\n\ -$\\sqrt{-1}$.\n\ -@end tex\n\ -@ifnottex\n\ -@code{sqrt (-1)}.\n\ -@end ifnottex\n\ -\n\ -I, and its equivalents i, j, and J, are functions so any of the names may\n\ -be reused for other purposes (such as i for a counter variable).\n\ -\n\ -When called with no arguments, return a scalar with the value @math{i}. When\n\ -called with a single argument, return a square matrix with the dimension\n\ -specified. When called with more than one scalar argument the first two\n\ -arguments are taken as the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{e, pi, log, exp}\n\ -@end deftypefn") -{ - return fill_matrix (args, Complex (0.0, 1.0), "I"); -} - -DEFALIAS (i, I); -DEFALIAS (J, I); -DEFALIAS (j, I); - -DEFUN (NA, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} NA\n\ -@deftypefnx {Built-in Function} {} NA (@var{n})\n\ -@deftypefnx {Built-in Function} {} NA (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} NA (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} NA (@dots{}, @var{class})\n\ -Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ -to the special constant used to designate missing values.\n\ -\n\ -Note that NA always compares not equal to NA (NA != NA).\n\ -To find NA values, use the @code{isna} function.\n\ -\n\ -When called with no arguments, return a scalar with the value @samp{NA}.\n\ -When called with a single argument, return a square matrix with the dimension\n\ -specified. When called with more than one scalar argument the first two\n\ -arguments are taken as the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{isna}\n\ -@end deftypefn") -{ - return fill_matrix (args, lo_ieee_na_value (), - lo_ieee_float_na_value (), "NA"); -} - -/* -%!assert (single (NA ("double")), NA ("single")) -%!assert (double (NA ("single")), NA ("double")) -*/ - -DEFUN (false, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} false (@var{x})\n\ -@deftypefnx {Built-in Function} {} false (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} false (@var{n}, @var{m}, @var{k}, @dots{})\n\ -Return a matrix or N-dimensional array whose elements are all logical 0.\n\ -If invoked with a single scalar integer argument, return a square\n\ -matrix of the specified size. If invoked with two or more scalar\n\ -integer arguments, or a vector of integer values, return an array with\n\ -given dimensions.\n\ -@seealso{true}\n\ -@end deftypefn") -{ - return fill_matrix (args, false, "false"); -} - -DEFUN (true, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} true (@var{x})\n\ -@deftypefnx {Built-in Function} {} true (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} true (@var{n}, @var{m}, @var{k}, @dots{})\n\ -Return a matrix or N-dimensional array whose elements are all logical 1.\n\ -If invoked with a single scalar integer argument, return a square\n\ -matrix of the specified size. If invoked with two or more scalar\n\ -integer arguments, or a vector of integer values, return an array with\n\ -given dimensions.\n\ -@seealso{false}\n\ -@end deftypefn") -{ - return fill_matrix (args, true, "true"); -} - -template -octave_value -identity_matrix (int nr, int nc) -{ - octave_value retval; - - typename MT::element_type one (1); - - if (nr == 1 && nc == 1) - retval = one; - else - { - dim_vector dims (nr, nc); - - typename MT::element_type zero (0); - - MT m (dims, zero); - - if (nr > 0 && nc > 0) - { - int n = std::min (nr, nc); - - for (int i = 0; i < n; i++) - m(i,i) = one; - } - - retval = m; - } - - return retval; -} - -#define INSTANTIATE_EYE(T) \ - template octave_value identity_matrix (int, int) - -INSTANTIATE_EYE (int8NDArray); -INSTANTIATE_EYE (uint8NDArray); -INSTANTIATE_EYE (int16NDArray); -INSTANTIATE_EYE (uint16NDArray); -INSTANTIATE_EYE (int32NDArray); -INSTANTIATE_EYE (uint32NDArray); -INSTANTIATE_EYE (int64NDArray); -INSTANTIATE_EYE (uint64NDArray); -INSTANTIATE_EYE (FloatNDArray); -INSTANTIATE_EYE (NDArray); -INSTANTIATE_EYE (boolNDArray); - -static octave_value -identity_matrix (int nr, int nc, oct_data_conv::data_type dt) -{ - octave_value retval; - - // FIXME -- perhaps this should be made extensible by using - // the class name to lookup a function to call to create the new - // value. - - if (! error_state) - { - switch (dt) - { - case oct_data_conv::dt_int8: - retval = identity_matrix (nr, nc); - break; - - case oct_data_conv::dt_uint8: - retval = identity_matrix (nr, nc); - break; - - case oct_data_conv::dt_int16: - retval = identity_matrix (nr, nc); - break; - - case oct_data_conv::dt_uint16: - retval = identity_matrix (nr, nc); - break; - - case oct_data_conv::dt_int32: - retval = identity_matrix (nr, nc); - break; - - case oct_data_conv::dt_uint32: - retval = identity_matrix (nr, nc); - break; - - case oct_data_conv::dt_int64: - retval = identity_matrix (nr, nc); - break; - - case oct_data_conv::dt_uint64: - retval = identity_matrix (nr, nc); - break; - - case oct_data_conv::dt_single: - retval = FloatDiagMatrix (nr, nc, 1.0f); - break; - - case oct_data_conv::dt_double: - retval = DiagMatrix (nr, nc, 1.0); - break; - - case oct_data_conv::dt_logical: - retval = identity_matrix (nr, nc); - break; - - default: - error ("eye: invalid class name"); - break; - } - } - - return retval; -} - -#undef INT_EYE_MATRIX - -DEFUN (eye, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} eye (@var{n})\n\ -@deftypefnx {Built-in Function} {} eye (@var{m}, @var{n})\n\ -@deftypefnx {Built-in Function} {} eye ([@var{m} @var{n}])\n\ -@deftypefnx {Built-in Function} {} eye (@dots{}, @var{class})\n\ -Return an identity matrix. If invoked with a single scalar argument @var{n},\n\ -return a square @nospell{NxN} identity matrix. If\n\ -supplied two scalar arguments (@var{m}, @var{n}), @code{eye} takes them to be\n\ -the number of rows and columns. If given a vector with two elements,\n\ -@code{eye} uses the values of the elements as the number of rows and columns,\n\ -respectively. For example:\n\ -\n\ -@example\n\ -@group\n\ -eye (3)\n\ - @result{} 1 0 0\n\ - 0 1 0\n\ - 0 0 1\n\ -@end group\n\ -@end example\n\ -\n\ -The following expressions all produce the same result:\n\ -\n\ -@example\n\ -@group\n\ -eye (2)\n\ -@equiv{}\n\ -eye (2, 2)\n\ -@equiv{}\n\ -eye (size ([1, 2; 3, 4])\n\ -@end group\n\ -@end example\n\ -\n\ -The optional argument @var{class}, allows @code{eye} to return an array of\n\ -the specified type, like\n\ -\n\ -@example\n\ -val = zeros (n,m, \"uint8\")\n\ -@end example\n\ -\n\ -Calling @code{eye} with no arguments is equivalent to calling it\n\ -with an argument of 1. Any negative dimensions are treated as zero. \n\ -These odd definitions are for compatibility with @sc{matlab}.\n\ -@seealso{speye, ones, zeros}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - oct_data_conv::data_type dt = oct_data_conv::dt_double; - - // Check for type information. - - if (nargin > 0 && args(nargin-1).is_string ()) - { - std::string nm = args(nargin-1).string_value (); - nargin--; - - dt = oct_data_conv::string_to_data_type (nm); - - if (error_state) - return retval; - } - - switch (nargin) - { - case 0: - retval = identity_matrix (1, 1, dt); - break; - - case 1: - { - octave_idx_type nr, nc; - get_dimensions (args(0), "eye", nr, nc); - - if (! error_state) - retval = identity_matrix (nr, nc, dt); - } - break; - - case 2: - { - octave_idx_type nr, nc; - get_dimensions (args(0), args(1), "eye", nr, nc); - - if (! error_state) - retval = identity_matrix (nr, nc, dt); - } - break; - - default: - print_usage (); - break; - } - - return retval; -} - -/* -%!assert (full (eye (3)), [1, 0, 0; 0, 1, 0; 0, 0, 1]) -%!assert (full (eye (2, 3)), [1, 0, 0; 0, 1, 0]) - -%!assert (full (eye (3,"single")), single ([1, 0, 0; 0, 1, 0; 0, 0, 1])) -%!assert (full (eye (2, 3,"single")), single ([1, 0, 0; 0, 1, 0])) - -%!assert (eye (3, "int8"), int8 ([1, 0, 0; 0, 1, 0; 0, 0, 1])) -%!assert (eye (2, 3, "int8"), int8 ([1, 0, 0; 0, 1, 0])) - -%!error eye (1, 2, 3) -*/ - -template -static octave_value -do_linspace (const octave_value& base, const octave_value& limit, - octave_idx_type n) -{ - typedef typename MT::column_vector_type CVT; - typedef typename MT::element_type T; - - octave_value retval; - - if (base.is_scalar_type ()) - { - T bs = octave_value_extract (base); - if (limit.is_scalar_type ()) - { - T ls = octave_value_extract (limit); - retval = linspace (bs, ls, n); - } - else - { - CVT lv = octave_value_extract (limit); - CVT bv (lv.length (), bs); - retval = linspace (bv, lv, n); - } - } - else - { - CVT bv = octave_value_extract (base); - if (limit.is_scalar_type ()) - { - T ls = octave_value_extract (limit); - CVT lv (bv.length (), ls); - retval = linspace (bv, lv, n); - } - else - { - CVT lv = octave_value_extract (limit); - retval = linspace (bv, lv, n); - } - } - - return retval; -} - -DEFUN (linspace, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} linspace (@var{base}, @var{limit})\n\ -@deftypefnx {Built-in Function} {} linspace (@var{base}, @var{limit}, @var{n})\n\ -Return a row vector with @var{n} linearly spaced elements between\n\ -@var{base} and @var{limit}. If the number of elements is greater than one,\n\ -then the endpoints @var{base} and @var{limit} are always included in\n\ -the range. If @var{base} is greater than @var{limit}, the elements are\n\ -stored in decreasing order. If the number of points is not specified, a\n\ -value of 100 is used.\n\ -\n\ -The @code{linspace} function always returns a row vector if both\n\ -@var{base} and @var{limit} are scalars. If one, or both, of them are column\n\ -vectors, @code{linspace} returns a matrix.\n\ -\n\ -For compatibility with @sc{matlab}, return the second argument (@var{limit})\n\ -if fewer than two values are requested.\n\ -@seealso{logspace}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - octave_idx_type npoints = 100; - - if (nargin != 2 && nargin != 3) - { - print_usage (); - return retval; - } - - if (nargin == 3) - { - // Apparently undocumented Matlab. If the third arg is an empty - // numeric value, the number of points defaults to 1. - - octave_value arg_3 = args(2); - - if (arg_3.is_numeric_type () && arg_3.is_empty ()) - npoints = 1; - else - npoints = arg_3.idx_type_value (); - } - - if (! error_state) - { - octave_value arg_1 = args(0); - octave_value arg_2 = args(1); - - if (arg_1.is_single_type () || arg_2.is_single_type ()) - { - if (arg_1.is_complex_type () || arg_2.is_complex_type ()) - retval = do_linspace (arg_1, arg_2, npoints); - else - retval = do_linspace (arg_1, arg_2, npoints); - - } - else - { - if (arg_1.is_complex_type () || arg_2.is_complex_type ()) - retval = do_linspace (arg_1, arg_2, npoints); - else - retval = do_linspace (arg_1, arg_2, npoints); - } - } - else - error ("linspace: N must be an integer"); - - return retval; -} - - -/* -%!test -%! x1 = linspace (1, 2); -%! x2 = linspace (1, 2, 10); -%! x3 = linspace (1, -2, 10); -%! assert (size (x1) == [1, 100] && x1(1) == 1 && x1(100) == 2); -%! assert (size (x2) == [1, 10] && x2(1) == 1 && x2(10) == 2); -%! assert (size (x3) == [1, 10] && x3(1) == 1 && x3(10) == -2); - -%assert (linspace ([1, 2; 3, 4], 5, 6), linspace (1, 5, 6)) - -%assert (linspace (0, 1, []), 1) - -%!error linspace () -%!error linspace (1, 2, 3, 4) -*/ - -// FIXME -- should accept dimensions as separate args for N-d -// arrays as well as 1-d and 2-d arrays. - -DEFUN (resize, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} resize (@var{x}, @var{m})\n\ -@deftypefnx {Built-in Function} {} resize (@var{x}, @var{m}, @var{n}, @dots{})\n\ -@deftypefnx {Built-in Function} {} resize (@var{x}, [@var{m} @var{n} @dots{}])\n\ -Resize @var{x} cutting off elements as necessary.\n\ -\n\ -In the result, element with certain indices is equal to the corresponding\n\ -element of @var{x} if the indices are within the bounds of @var{x};\n\ -otherwise, the element is set to zero.\n\ -\n\ -In other words, the statement\n\ -\n\ -@example\n\ -y = resize (x, dv)\n\ -@end example\n\ -\n\ -@noindent\n\ -is equivalent to the following code:\n\ -\n\ -@example\n\ -@group\n\ -y = zeros (dv, class (x));\n\ -sz = min (dv, size (x));\n\ -for i = 1:length (sz)\n\ - idx@{i@} = 1:sz(i);\n\ -endfor\n\ -y(idx@{:@}) = x(idx@{:@});\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -but is performed more efficiently.\n\ -\n\ -If only @var{m} is supplied, and it is a scalar, the dimension of the\n\ -result is @var{m}-by-@var{m}.\n\ -If @var{m}, @var{n}, @dots{} are all scalars, then the dimensions of\n\ -the result are @var{m}-by-@var{n}-by-@dots{}.\n\ -If given a vector as input, then the\n\ -dimensions of the result are given by the elements of that vector.\n\ -\n\ -An object can be resized to more dimensions than it has;\n\ -in such case the missing dimensions are assumed to be 1.\n\ -Resizing an object to fewer dimensions is not possible.\n\ -@seealso{reshape, postpad, prepad, cat}\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - - if (nargin == 2) - { - Array vec = args(1).vector_value (); - int ndim = vec.length (); - if (ndim == 1) - { - octave_idx_type m = static_cast (vec(0)); - retval = args(0); - retval = retval.resize (dim_vector (m, m), true); - } - else - { - dim_vector dv; - dv.resize (ndim); - for (int i = 0; i < ndim; i++) - dv(i) = static_cast (vec(i)); - retval = args(0); - retval = retval.resize (dv, true); - } - } - else if (nargin > 2) - { - dim_vector dv; - dv.resize (nargin - 1); - for (octave_idx_type i = 1; i < nargin; i++) - dv(i-1) = static_cast (args(i).scalar_value ()); - if (!error_state) - { - retval = args(0); - retval = retval.resize (dv, true); - } - - } - else - print_usage (); - return retval; -} - -// FIXME -- should use octave_idx_type for dimensions. - -DEFUN (reshape, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} reshape (@var{A}, @var{m}, @var{n}, @dots{})\n\ -@deftypefnx {Built-in Function} {} reshape (@var{A}, [@var{m} @var{n} @dots{}])\n\ -@deftypefnx {Built-in Function} {} reshape (@var{A}, @dots{}, [], @dots{})\n\ -@deftypefnx {Built-in Function} {} reshape (@var{A}, @var{size})\n\ -Return a matrix with the specified dimensions (@var{m}, @var{n}, @dots{})\n\ -whose elements are taken from the matrix @var{A}. The elements of the\n\ -matrix are accessed in column-major order (like Fortran arrays are stored).\n\ -\n\ -The following code demonstrates reshaping a 1x4 row vector into a 2x2 square\n\ -matrix.\n\ -\n\ -@example\n\ -@group\n\ -reshape ([1, 2, 3, 4], 2, 2)\n\ - @result{} 1 3\n\ - 2 4\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -Note that the total number of elements in the original\n\ -matrix (@code{prod (size (@var{A}))}) must match the total number of elements\n\ -in the new matrix (@code{prod ([@var{m} @var{n} @dots{}])}).\n\ -\n\ -A single dimension of the return matrix may be left unspecified and Octave\n\ -will determine its size automatically. An empty matrix ([]) is used to flag\n\ -the unspecified dimension.\n\ -@seealso{resize, vec, postpad, cat, squeeze}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - dim_vector new_dims; - - if (nargin == 2) - { - Array new_size = args(1).octave_idx_type_vector_value (); - - new_dims = dim_vector::alloc (new_size.length ()); - - for (octave_idx_type i = 0; i < new_size.length (); i++) - { - if (new_size(i) < 0) - { - error ("reshape: SIZE must be non-negative"); - break; - } - else - new_dims(i) = new_size(i); - } - } - else if (nargin > 2) - { - new_dims = dim_vector::alloc (nargin-1); - int empty_dim = -1; - - for (int i = 1; i < nargin; i++) - { - if (args(i).is_empty ()) - { - if (empty_dim > 0) - { - error ("reshape: only a single dimension can be unknown"); - break; - } - else - { - empty_dim = i; - new_dims(i-1) = 1; - } - } - else - { - new_dims(i-1) = args(i).idx_type_value (); - - if (error_state) - break; - else if (new_dims(i-1) < 0) - { - error ("reshape: SIZE must be non-negative"); - break; - } - } - } - - if (! error_state && (empty_dim > 0)) - { - octave_idx_type nel = new_dims.numel (); - - if (nel == 0) - new_dims(empty_dim-1) = 0; - else - { - octave_idx_type a_nel = args(0).numel (); - octave_idx_type size_empty_dim = a_nel / nel; - - if (a_nel != size_empty_dim * nel) - error ("reshape: SIZE is not divisible by the product of known dimensions (= %d)", nel); - else - new_dims(empty_dim-1) = size_empty_dim; - } - } - } - else - { - print_usage (); - return retval; - } - - if (! error_state) - retval = args(0).reshape (new_dims); - - return retval; -} - -/* -%!assert (size (reshape (ones (4, 4), 2, 8)), [2, 8]) -%!assert (size (reshape (ones (4, 4), 8, 2)), [8, 2]) -%!assert (size (reshape (ones (15, 4), 1, 60)), [1, 60]) -%!assert (size (reshape (ones (15, 4), 60, 1)), [60, 1]) - -%!assert (size (reshape (ones (4, 4, "single"), 2, 8)), [2, 8]) -%!assert (size (reshape (ones (4, 4, "single"), 8, 2)), [8, 2]) -%!assert (size (reshape (ones (15, 4, "single"), 1, 60)), [1, 60]) -%!assert (size (reshape (ones (15, 4, "single"), 60, 1)), [60, 1]) - -%!test -%! s.a = 1; -%! fail ("reshape (s, 2, 3)"); - -%!error reshape () -%!error reshape (1, 2, 3, 4) -*/ - -DEFUN (vec, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{v} =} vec (@var{x})\n\ -@deftypefnx {Built-in Function} {@var{v} =} vec (@var{x}, @var{dim})\n\ -Return the vector obtained by stacking the columns of the matrix @var{x}\n\ -one above the other. Without @var{dim} this is equivalent to\n\ -@code{@var{x}(:)}. If @var{dim} is supplied, the dimensions of @var{v}\n\ -are set to @var{dim} with all elements along the last dimension.\n\ -This is equivalent to @code{shiftdim (@var{x}(:), 1-@var{dim})}.\n\ -@seealso{vech, resize, cat}\n\ -@end deftypefn") -{ - octave_value retval; - int dim = 1; - - int nargin = args.length (); - - if (nargin < 1 || nargin > 2) - print_usage () ; - - if (! error_state && nargin == 2) - { - dim = args(1).idx_type_value (); - - if (dim < 1) - error ("vec: DIM must be greater than zero"); - } - - if (! error_state) - { - octave_value colon (octave_value::magic_colon_t); - octave_value arg = args(0); - retval = arg.single_subsref ("(", colon); - - - if (! error_state && dim > 1) - { - dim_vector new_dims = dim_vector::alloc (dim); - - for (int i = 0; i < dim-1; i++) - new_dims(i) = 1; - - new_dims(dim-1) = retval.numel (); - - retval = retval.reshape (new_dims); - } - } - - return retval; -} - -/* -%!assert (vec ([1, 2; 3, 4]), [1; 3; 2; 4]) -%!assert (vec ([1, 3, 2, 4]), [1; 3; 2; 4]) -%!assert (vec ([1, 2, 3, 4], 2), [1, 2, 3, 4]) -%!assert (vec ([1, 2; 3, 4]), vec ([1, 2; 3, 4], 1)) -%!assert (vec ([1, 2; 3, 4], 1), [1; 3; 2; 4]) -%!assert (vec ([1, 2; 3, 4], 2), [1, 3, 2, 4]) -%!assert (vec ([1, 3; 2, 4], 3), reshape ([1, 2, 3, 4], 1, 1, 4)) -%!assert (vec ([1, 3; 2, 4], 3), shiftdim (vec ([1, 3; 2, 4]), -2)) - -%!error vec () -%!error vec (1, 2, 3) -%!error vec ([1, 2; 3, 4], 0) -*/ - -DEFUN (squeeze, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} squeeze (@var{x})\n\ -Remove singleton dimensions from @var{x} and return the result.\n\ -Note that for compatibility with @sc{matlab}, all objects have\n\ -a minimum of two dimensions and row vectors are left unchanged.\n\ -@seealso{reshape}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).squeeze (); - else - print_usage (); - - return retval; -} - -DEFUN (full, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{FM} =} full (@var{SM})\n\ -Return a full storage matrix from a sparse, diagonal, permutation matrix\n\ -or a range.\n\ -@seealso{sparse}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).full_value (); - else - print_usage (); - - return retval; -} - -// Compute various norms of the vector X. - -DEFUN (norm, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} norm (@var{A})\n\ -@deftypefnx {Built-in Function} {} norm (@var{A}, @var{p})\n\ -@deftypefnx {Built-in Function} {} norm (@var{A}, @var{p}, @var{opt})\n\ -Compute the p-norm of the matrix @var{A}. If the second argument is\n\ -missing, @code{p = 2} is assumed.\n\ -\n\ -If @var{A} is a matrix (or sparse matrix):\n\ -\n\ -@table @asis\n\ -@item @var{p} = @code{1}\n\ -1-norm, the largest column sum of the absolute values of @var{A}.\n\ -\n\ -@item @var{p} = @code{2}\n\ -Largest singular value of @var{A}.\n\ -\n\ -@item @var{p} = @code{Inf} or @code{\"inf\"}\n\ -@cindex infinity norm\n\ -Infinity norm, the largest row sum of the absolute values of @var{A}.\n\ -\n\ -@item @var{p} = @code{\"fro\"}\n\ -@cindex Frobenius norm\n\ -Frobenius norm of @var{A}, @code{sqrt (sum (diag (@var{A}' * @var{A})))}.\n\ -\n\ -@item other @var{p}, @code{@var{p} > 1}\n\ -@cindex general p-norm\n\ -maximum @code{norm (A*x, p)} such that @code{norm (x, p) == 1}\n\ -@end table\n\ -\n\ -If @var{A} is a vector or a scalar:\n\ -\n\ -@table @asis\n\ -@item @var{p} = @code{Inf} or @code{\"inf\"}\n\ -@code{max (abs (@var{A}))}.\n\ -\n\ -@item @var{p} = @code{-Inf}\n\ -@code{min (abs (@var{A}))}.\n\ -\n\ -@item @var{p} = @code{\"fro\"}\n\ -Frobenius norm of @var{A}, @code{sqrt (sumsq (abs (A)))}.\n\ -\n\ -@item @var{p} = 0\n\ -Hamming norm - the number of nonzero elements.\n\ -\n\ -@item other @var{p}, @code{@var{p} > 1}\n\ -p-norm of @var{A}, @code{(sum (abs (@var{A}) .^ @var{p})) ^ (1/@var{p})}.\n\ -\n\ -@item other @var{p} @code{@var{p} < 1}\n\ -the p-pseudonorm defined as above.\n\ -@end table\n\ -\n\ -If @var{opt} is the value @code{\"rows\"}, treat each row as a vector and\n\ -compute its norm. The result is returned as a column vector.\n\ -Similarly, if @var{opt} is @code{\"columns\"} or @code{\"cols\"} then compute\n\ -the norms of each column and return a row vector.\n\ -@seealso{cond, svd}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin >= 1 && nargin <= 3) - { - octave_value x_arg = args(0); - - if (x_arg.ndims () == 2) - { - enum { sfmatrix, sfcols, sfrows, sffrob, sfinf } strflag = sfmatrix; - if (nargin > 1 && args(nargin-1).is_string ()) - { - std::string str = args(nargin-1).string_value (); - if (str == "cols" || str == "columns") - strflag = sfcols; - else if (str == "rows") - strflag = sfrows; - else if (str == "fro") - strflag = sffrob; - else if (str == "inf") - strflag = sfinf; - else - error ("norm: unrecognized option: %s", str.c_str ()); - // we've handled the last parameter, so act as if it was removed - nargin --; - } - else if (nargin > 1 && ! args(1).is_scalar_type ()) - gripe_wrong_type_arg ("norm", args(1), true); - - if (! error_state) - { - octave_value p_arg = (nargin > 1) ? args(1) : octave_value (2); - switch (strflag) - { - case sfmatrix: - retval(0) = xnorm (x_arg, p_arg); - break; - case sfcols: - retval(0) = xcolnorms (x_arg, p_arg); - break; - case sfrows: - retval(0) = xrownorms (x_arg, p_arg); - break; - case sffrob: - retval(0) = xfrobnorm (x_arg); - break; - case sfinf: - retval(0) = xnorm (x_arg, octave_Inf); - break; - } - } - } - else - error ("norm: only valid for 2-D objects"); - } - else - print_usage (); - - return retval; -} - -/* -%!shared x -%! x = [1, -3, 4, 5, -7]; -%!assert (norm (x,1), 20) -%!assert (norm (x,2), 10) -%!assert (norm (x,3), 8.24257059961711, -4*eps) -%!assert (norm (x,Inf), 7) -%!assert (norm (x,-Inf), 1) -%!assert (norm (x,"inf"), 7) -%!assert (norm (x,"fro"), 10, -eps) -%!assert (norm (x), 10) -%!assert (norm ([1e200, 1]), 1e200) -%!assert (norm ([3+4i, 3-4i, sqrt(31)]), 9, -4*eps) -%!shared m -%! m = magic (4); -%!assert (norm (m,1), 34) -%!assert (norm (m,2), 34, -eps) -%!assert (norm (m,Inf), 34) -%!assert (norm (m,"inf"), 34) -%!shared m2, flo, fhi -%! m2 = [1,2;3,4]; -%! flo = 1e-300; -%! fhi = 1e+300; -%!assert (norm (flo*m2,"fro"), sqrt (30)*flo, -eps) -%!assert (norm (fhi*m2,"fro"), sqrt (30)*fhi, -eps) - -%!shared x -%! x = single ([1, -3, 4, 5, -7]); -%!assert (norm (x,1), single (20)) -%!assert (norm (x,2), single (10)) -%!assert (norm (x,3), single (8.24257059961711), -4*eps ("single")) -%!assert (norm (x,Inf), single (7)) -%!assert (norm (x,-Inf), single (1)) -%!assert (norm (x,"inf"), single (7)) -%!assert (norm (x,"fro"), single (10), -eps ("single")) -%!assert (norm (x), single (10)) -%!assert (norm (single ([1e200, 1])), single (1e200)) -%!assert (norm (single ([3+4i, 3-4i, sqrt(31)])), single (9), -4*eps ("single")) -%!shared m -%! m = single (magic (4)); -%!assert (norm (m,1), single (34)) -%!assert (norm (m,2), single (34), -eps ("single")) -%!assert (norm (m,Inf), single (34)) -%!assert (norm (m,"inf"), single (34)) -%!shared m2, flo, fhi -%! m2 = single ([1,2;3,4]); -%! flo = single (1e-300); -%! fhi = single (1e+300); -%!assert (norm (flo*m2,"fro"), single (sqrt (30)*flo), -eps ("single")) -%!assert (norm (fhi*m2,"fro"), single (sqrt (30)*fhi), -eps ("single")) - -%!test -%! ## Test for norm returning NaN on sparse matrix (bug #30631) -%! A = sparse (2,2); -%! A(2,1) = 1; -%! assert (norm (A), 1); -*/ - -static octave_value -unary_op_defun_body (octave_value::unary_op op, - const octave_value_list& args) -{ - octave_value retval; - if (args.length () == 1) - retval = do_unary_op (op, args(0)); - else - print_usage (); - - return retval; -} - -DEFUN (not, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} not (@var{x})\n\ -Return the logical NOT of @var{x}. This function is equivalent to\n\ -@code{! x}.\n\ -@seealso{and, or, xor}\n\ -@end deftypefn") -{ - return unary_op_defun_body (octave_value::op_not, args); -} - -DEFUN (uplus, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} uplus (@var{x})\n\ -This function and @w{@xcode{+ x}} are equivalent.\n\ -@seealso{uminus, plus, minus}\n\ -@end deftypefn") -{ - return unary_op_defun_body (octave_value::op_uplus, args); -} - -DEFUN (uminus, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} uminus (@var{x})\n\ -This function and @w{@xcode{- x}} are equivalent.\n\ -@seealso{uplus, minus}\n\ -@end deftypefn") -{ - return unary_op_defun_body (octave_value::op_uminus, args); -} - -DEFUN (transpose, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} transpose (@var{x})\n\ -Return the transpose of @var{x}.\n\ -This function and @xcode{x.'} are equivalent.\n\ -@seealso{ctranspose}\n\ -@end deftypefn") -{ - return unary_op_defun_body (octave_value::op_transpose, args); -} - -/* -%!assert (2.', 2) -%!assert (2i.', 2i) -%!assert ([1:4].', [1;2;3;4]) -%!assert ([1;2;3;4].', [1:4]) -%!assert ([1,2;3,4].', [1,3;2,4]) -%!assert ([1,2i;3,4].', [1,3;2i,4]) - -%!assert (transpose ([1,2;3,4]), [1,3;2,4]) - -%!assert (single (2).', single (2)) -%!assert (single (2i).', single (2i)) -%!assert (single ([1:4]).', single ([1;2;3;4])) -%!assert (single ([1;2;3;4]).', single ([1:4])) -%!assert (single ([1,2;3,4]).', single ([1,3;2,4])) -%!assert (single ([1,2i;3,4]).', single ([1,3;2i,4])) - -%!assert (transpose (single ([1,2;3,4])), single ([1,3;2,4])) -*/ - -DEFUN (ctranspose, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ctranspose (@var{x})\n\ -Return the complex conjugate transpose of @var{x}.\n\ -This function and @xcode{x'} are equivalent.\n\ -@seealso{transpose}\n\ -@end deftypefn") -{ - return unary_op_defun_body (octave_value::op_hermitian, args); -} - -/* -%!assert (2', 2) -%!assert (2i', -2i) -%!assert ([1:4]', [1;2;3;4]) -%!assert ([1;2;3;4]', [1:4]) -%!assert ([1,2;3,4]', [1,3;2,4]) -%!assert ([1,2i;3,4]', [1,3;-2i,4]) - -%!assert (ctranspose ([1,2i;3,4]), [1,3;-2i,4]) - -%!assert (single (2)', single (2)) -%!assert (single (2i)', single (-2i)) -%!assert (single ([1:4])', single ([1;2;3;4])) -%!assert (single ([1;2;3;4])', single ([1:4])) -%!assert (single ([1,2;3,4])', single ([1,3;2,4])) -%!assert (single ([1,2i;3,4])', single ([1,3;-2i,4])) - -%!assert (ctranspose (single ([1,2i;3,4])), single ([1,3;-2i,4])) -*/ - -static octave_value -binary_op_defun_body (octave_value::binary_op op, - const octave_value_list& args) -{ - octave_value retval; - - if (args.length () == 2) - retval = do_binary_op (op, args(0), args(1)); - else - print_usage (); - - return retval; -} - -static octave_value -binary_assoc_op_defun_body (octave_value::binary_op op, - octave_value::assign_op aop, - const octave_value_list& args) -{ - octave_value retval; - int nargin = args.length (); - - switch (nargin) - { - case 0: - print_usage (); - break; - case 1: - retval = args(0); - break; - case 2: - retval = do_binary_op (op, args(0), args(1)); - break; - default: - retval = do_binary_op (op, args(0), args(1)); - for (int i = 2; i < nargin; i++) - retval.assign (aop, args(i)); - break; - } - - return retval; -} - -DEFUN (plus, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} plus (@var{x}, @var{y})\n\ -@deftypefnx {Built-in Function} {} plus (@var{x1}, @var{x2}, @dots{})\n\ -This function and @w{@xcode{x + y}} are equivalent.\n\ -If more arguments are given, the summation is applied\n\ -cumulatively from left to right:\n\ -\n\ -@example\n\ -(@dots{}((x1 + x2) + x3) + @dots{})\n\ -@end example\n\ -\n\ -At least one argument is required.\n\ -@seealso{minus, uplus}\n\ -@end deftypefn") -{ - return binary_assoc_op_defun_body (octave_value::op_add, - octave_value::op_add_eq, args); -} - -DEFUN (minus, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} minus (@var{x}, @var{y})\n\ -This function and @w{@xcode{x - y}} are equivalent.\n\ -@seealso{plus, uminus}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_sub, args); -} - -DEFUN (mtimes, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} mtimes (@var{x}, @var{y})\n\ -@deftypefnx {Built-in Function} {} mtimes (@var{x1}, @var{x2}, @dots{})\n\ -Return the matrix multiplication product of inputs.\n\ -This function and @w{@xcode{x * y}} are equivalent.\n\ -If more arguments are given, the multiplication is applied\n\ -cumulatively from left to right:\n\ -\n\ -@example\n\ -(@dots{}((x1 * x2) * x3) * @dots{})\n\ -@end example\n\ -\n\ -At least one argument is required.\n\ -@seealso{times, plus, minus, rdivide, mrdivide, mldivide, mpower}\n\ -@end deftypefn") -{ - return binary_assoc_op_defun_body (octave_value::op_mul, - octave_value::op_mul_eq, args); -} - -DEFUN (mrdivide, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} mrdivide (@var{x}, @var{y})\n\ -Return the matrix right division of @var{x} and @var{y}.\n\ -This function and @w{@xcode{x / y}} are equivalent.\n\ -@seealso{mldivide, rdivide, plus, minus}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_div, args); -} - -DEFUN (mpower, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} mpower (@var{x}, @var{y})\n\ -Return the matrix power operation of @var{x} raised to the @var{y} power.\n\ -This function and @w{@xcode{x ^ y}} are equivalent.\n\ -@seealso{power, mtimes, plus, minus}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_pow, args); -} - -DEFUN (mldivide, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} mldivide (@var{x}, @var{y})\n\ -Return the matrix left division of @var{x} and @var{y}.\n\ -This function and @w{@xcode{x @xbackslashchar{} y}} are equivalent.\n\ -@seealso{mrdivide, ldivide, rdivide}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_ldiv, args); -} - -DEFUN (lt, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} lt (@var{x}, @var{y})\n\ -This function is equivalent to @w{@code{x < y}}.\n\ -@seealso{le, eq, ge, gt, ne}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_lt, args); -} - -DEFUN (le, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} le (@var{x}, @var{y})\n\ -This function is equivalent to @w{@code{x <= y}}.\n\ -@seealso{eq, ge, gt, ne, lt}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_le, args); -} - -DEFUN (eq, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} eq (@var{x}, @var{y})\n\ -Return true if the two inputs are equal.\n\ -This function is equivalent to @w{@code{x == y}}.\n\ -@seealso{ne, isequal, le, ge, gt, ne, lt}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_eq, args); -} - -DEFUN (ge, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ge (@var{x}, @var{y})\n\ -This function is equivalent to @w{@code{x >= y}}.\n\ -@seealso{le, eq, gt, ne, lt}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_ge, args); -} - -DEFUN (gt, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} gt (@var{x}, @var{y})\n\ -This function is equivalent to @w{@code{x > y}}.\n\ -@seealso{le, eq, ge, ne, lt}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_gt, args); -} - -DEFUN (ne, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ne (@var{x}, @var{y})\n\ -Return true if the two inputs are not equal.\n\ -This function is equivalent to @w{@code{x != y}}.\n\ -@seealso{eq, isequal, le, ge, lt}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_ne, args); -} - -DEFUN (times, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} times (@var{x}, @var{y})\n\ -@deftypefnx {Built-in Function} {} times (@var{x1}, @var{x2}, @dots{})\n\ -Return the element-by-element multiplication product of inputs.\n\ -This function and @w{@xcode{x .* y}} are equivalent.\n\ -If more arguments are given, the multiplication is applied\n\ -cumulatively from left to right:\n\ -\n\ -@example\n\ -(@dots{}((x1 .* x2) .* x3) .* @dots{})\n\ -@end example\n\ -\n\ -At least one argument is required.\n\ -@seealso{mtimes, rdivide}\n\ -@end deftypefn") -{ - return binary_assoc_op_defun_body (octave_value::op_el_mul, - octave_value::op_el_mul_eq, args); -} - -DEFUN (rdivide, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} rdivide (@var{x}, @var{y})\n\ -Return the element-by-element right division of @var{x} and @var{y}.\n\ -This function and @w{@xcode{x ./ y}} are equivalent.\n\ -@seealso{ldivide, mrdivide, times, plus}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_el_div, args); -} - -DEFUN (power, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} power (@var{x}, @var{y})\n\ -Return the element-by-element operation of @var{x} raised to the\n\ -@var{y} power. If several complex results are possible,\n\ -returns the one with smallest non-negative argument (angle). Use\n\ -@code{realpow}, @code{realsqrt}, @code{cbrt}, or @code{nthroot} if a\n\ -real result is preferred.\n\ -\n\ -This function and @w{@xcode{x .^ y}} are equivalent.\n\ -@seealso{mpower, realpow, realsqrt, cbrt, nthroot}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_el_pow, args); -} - -DEFUN (ldivide, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ldivide (@var{x}, @var{y})\n\ -Return the element-by-element left division of @var{x} and @var{y}.\n\ -This function and @w{@xcode{x .@xbackslashchar{} y}} are equivalent.\n\ -@seealso{rdivide, mldivide, times, plus}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_el_ldiv, args); -} - -DEFUN (and, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} and (@var{x}, @var{y})\n\ -@deftypefnx {Built-in Function} {} and (@var{x1}, @var{x2}, @dots{})\n\ -Return the logical AND of @var{x} and @var{y}.\n\ -This function is equivalent to @w{@code{x & y}}.\n\ -If more arguments are given, the logical and is applied\n\ -cumulatively from left to right:\n\ -\n\ -@example\n\ -(@dots{}((x1 & x2) & x3) & @dots{})\n\ -@end example\n\ -\n\ -At least one argument is required.\n\ -@seealso{or, not, xor}\n\ -@end deftypefn") -{ - return binary_assoc_op_defun_body (octave_value::op_el_and, - octave_value::op_el_and_eq, args); -} - -DEFUN (or, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} or (@var{x}, @var{y})\n\ -@deftypefnx {Built-in Function} {} or (@var{x1}, @var{x2}, @dots{})\n\ -Return the logical OR of @var{x} and @var{y}.\n\ -This function is equivalent to @w{@code{x | y}}.\n\ -If more arguments are given, the logical or is applied\n\ -cumulatively from left to right:\n\ -\n\ -@example\n\ -(@dots{}((x1 | x2) | x3) | @dots{})\n\ -@end example\n\ -\n\ -At least one argument is required.\n\ -@seealso{and, not, xor}\n\ -@end deftypefn") -{ - return binary_assoc_op_defun_body (octave_value::op_el_or, - octave_value::op_el_or_eq, args); -} - -static double tic_toc_timestamp = -1.0; - -DEFUN (tic, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} tic ()\n\ -@deftypefnx {Built-in Function} {@var{id} =} tic ()\n\ -@deftypefnx {Built-in Function} {} toc ()\n\ -@deftypefnx {Built-in Function} {} toc (@var{id})\n\ -@deftypefnx {Built-in Function} {@var{val} =} toc (@dots{})\n\ -Set or check a wall-clock timer. Calling @code{tic} without an\n\ -output argument sets the internal timer state. Subsequent calls\n\ -to @code{toc} return the number of seconds since the timer was set.\n\ -For example,\n\ -\n\ -@example\n\ -@group\n\ -tic ();\n\ -# many computations later@dots{}\n\ -elapsed_time = toc ();\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -will set the variable @code{elapsed_time} to the number of seconds since\n\ -the most recent call to the function @code{tic}.\n\ -\n\ -If called with one output argument, @code{tic} returns a scalar\n\ -of type @code{uint64} that may be later passed to @code{toc}.\n\ -\n\ -@example\n\ -@group\n\ -id = tic; sleep (5); toc (id)\n\ - @result{} 5.0010\n\ -@end group\n\ -@end example\n\ -\n\ -Calling @code{tic} and @code{toc} this way allows nested timing calls.\n\ -\n\ -If you are more interested in the CPU time that your process used, you\n\ -should use the @code{cputime} function instead. The @code{tic} and\n\ -@code{toc} functions report the actual wall clock time that elapsed\n\ -between the calls. This may include time spent processing other jobs or\n\ -doing nothing at all.\n\ -@seealso{toc, cputime}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin != 0) - warning ("tic: ignoring extra arguments"); - - octave_time now; - - double tmp = now.double_value (); - - if (nargout > 0) - { - double ip = 0.0; - double frac = modf (tmp, &ip); - uint64_t microsecs = static_cast (CLOCKS_PER_SEC * frac); - microsecs += CLOCKS_PER_SEC * static_cast (ip); - retval = octave_uint64 (microsecs); - } - else - tic_toc_timestamp = tmp; - - return retval; -} - -DEFUN (toc, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} toc ()\n\ -@deftypefnx {Built-in Function} {} toc (@var{id})\n\ -@deftypefnx {Built-in Function} {@var{val} =} toc (@dots{})\n\ -@seealso{tic, cputime}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - double start_time = tic_toc_timestamp; - - if (nargin > 1) - print_usage (); - else - { - if (nargin == 1) - { - octave_uint64 id = args(0).uint64_scalar_value (); - - if (! error_state) - { - uint64_t val = id.value (); - - start_time - = (static_cast (val / CLOCKS_PER_SEC) - + static_cast (val % CLOCKS_PER_SEC) / CLOCKS_PER_SEC); - - // FIXME -- should we also check to see whether the start - // time is after the beginning of this Octave session? - } - else - error ("toc: invalid ID"); - } - - if (! error_state) - { - if (start_time < 0) - error ("toc called before timer set"); - else - { - octave_time now; - - double tmp = now.double_value () - start_time; - - if (nargout > 0) - retval = tmp; - else - octave_stdout << "Elapsed time is " << tmp << " seconds.\n"; - } - } - } - - return retval; -} - -/* -%!shared id -%! id = tic (); -%!assert (isa (id, "uint64")) -%!assert (isa (toc (id), "double")) -*/ - -DEFUN (cputime, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{total}, @var{user}, @var{system}] =} cputime ();\n\ -Return the CPU time used by your Octave session. The first output is\n\ -the total time spent executing your process and is equal to the sum of\n\ -second and third outputs, which are the number of CPU seconds spent\n\ -executing in user mode and the number of CPU seconds spent executing in\n\ -system mode, respectively. If your system does not have a way to report\n\ -CPU time usage, @code{cputime} returns 0 for each of its output values.\n\ -Note that because Octave used some CPU time to start, it is reasonable\n\ -to check to see if @code{cputime} works by checking to see if the total\n\ -CPU time used is nonzero.\n\ -@seealso{tic, toc}\n\ -@end deftypefn") -{ - octave_value_list retval; - int nargin = args.length (); - double usr = 0.0; - double sys = 0.0; - - if (nargin != 0) - warning ("tic: ignoring extra arguments"); - -#if defined (HAVE_GETRUSAGE) - - struct rusage ru; - - getrusage (RUSAGE_SELF, &ru); - - usr = static_cast (ru.ru_utime.tv_sec) + - static_cast (ru.ru_utime.tv_usec) * 1e-6; - - sys = static_cast (ru.ru_stime.tv_sec) + - static_cast (ru.ru_stime.tv_usec) * 1e-6; - -#else - - struct tms t; - - times (&t); - - unsigned long ticks; - unsigned long seconds; - unsigned long fraction; - - ticks = t.tms_utime + t.tms_cutime; - fraction = ticks % CLOCKS_PER_SEC; - seconds = ticks / CLOCKS_PER_SEC; - - usr = static_cast (seconds) + static_cast(fraction) / - static_cast(CLOCKS_PER_SEC); - - ticks = t.tms_stime + t.tms_cstime; - fraction = ticks % CLOCKS_PER_SEC; - seconds = ticks / CLOCKS_PER_SEC; - - sys = static_cast (seconds) + static_cast(fraction) / - static_cast(CLOCKS_PER_SEC); - -#endif - - retval(2) = sys; - retval(1) = usr; - retval(0) = sys + usr; - - return retval; -} - -DEFUN (sort, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{s}, @var{i}] =} sort (@var{x})\n\ -@deftypefnx {Built-in Function} {[@var{s}, @var{i}] =} sort (@var{x}, @var{dim})\n\ -@deftypefnx {Built-in Function} {[@var{s}, @var{i}] =} sort (@var{x}, @var{mode})\n\ -@deftypefnx {Built-in Function} {[@var{s}, @var{i}] =} sort (@var{x}, @var{dim}, @var{mode})\n\ -Return a copy of @var{x} with the elements arranged in increasing\n\ -order. For matrices, @code{sort} orders the elements within columns\n\ -\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -sort ([1, 2; 2, 3; 3, 1])\n\ - @result{} 1 1\n\ - 2 2\n\ - 3 3\n\ -@end group\n\ -@end example\n\ -\n\ -If the optional argument @var{dim} is given, then the matrix is sorted\n\ -along the dimension defined by @var{dim}. The optional argument @code{mode}\n\ -defines the order in which the values will be sorted. Valid values of\n\ -@code{mode} are \"ascend\" or \"descend\".\n\ -\n\ -The @code{sort} function may also be used to produce a matrix\n\ -containing the original row indices of the elements in the sorted\n\ -matrix. For example:\n\ -\n\ -@example\n\ -@group\n\ -[s, i] = sort ([1, 2; 2, 3; 3, 1])\n\ - @result{} s = 1 1\n\ - 2 2\n\ - 3 3\n\ - @result{} i = 1 3\n\ - 2 1\n\ - 3 2\n\ -@end group\n\ -@end example\n\ -\n\ -For equal elements, the indices are such that equal elements are listed\n\ -in the order in which they appeared in the original list.\n\ -\n\ -Sorting of complex entries is done first by magnitude (@code{abs (@var{z})})\n\ -and for any ties by phase angle (@code{angle (z)}). For example:\n\ -\n\ -@example\n\ -@group\n\ -sort ([1+i; 1; 1-i])\n\ - @result{} 1 + 0i\n\ - 1 - 1i\n\ - 1 + 1i\n\ -@end group\n\ -@end example\n\ -\n\ -NaN values are treated as being greater than any other value and are sorted\n\ -to the end of the list.\n\ -\n\ -The @code{sort} function may also be used to sort strings and cell arrays\n\ -of strings, in which case ASCII dictionary order (uppercase 'A' precedes\n\ -lowercase 'a') of the strings is used.\n\ -\n\ -The algorithm used in @code{sort} is optimized for the sorting of partially\n\ -ordered lists.\n\ -@seealso{sortrows, issorted}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - sortmode smode = ASCENDING; - - if (nargin < 1 || nargin > 3) - { - print_usage (); - return retval; - } - - bool return_idx = nargout > 1; - - octave_value arg = args(0); - - int dim = 0; - if (nargin > 1) - { - if (args(1).is_string ()) - { - std::string mode = args(1).string_value (); - if (mode == "ascend") - smode = ASCENDING; - else if (mode == "descend") - smode = DESCENDING; - else - { - error ("sort: MODE must be either \"ascend\" or \"descend\""); - return retval; - } - } - else - dim = args(1).nint_value () - 1; - } - - if (nargin > 2) - { - if (args(1).is_string ()) - { - print_usage (); - return retval; - } - - if (! args(2).is_string ()) - { - error ("sort: MODE must be a string"); - return retval; - } - std::string mode = args(2).string_value (); - if (mode == "ascend") - smode = ASCENDING; - else if (mode == "descend") - smode = DESCENDING; - else - { - error ("sort: MODE must be either \"ascend\" or \"descend\""); - return retval; - } - } - - const dim_vector dv = arg.dims (); - if (nargin == 1 || args(1).is_string ()) - { - // Find first non singleton dimension - dim = dv.first_non_singleton (); - } - else - { - if (dim < 0) - { - error ("sort: DIM must be a valid dimension"); - return retval; - } - } - - if (return_idx) - { - retval.resize (2); - - Array sidx; - - retval(0) = arg.sort (sidx, dim, smode); - retval(1) = idx_vector (sidx, dv(dim)); // No checking, the extent is known. - } - else - retval(0) = arg.sort (dim, smode); - - return retval; -} - -/* -## Double -%!assert (sort ([NaN, 1, -1, 2, Inf]), [-1, 1, 2, Inf, NaN]) -%!assert (sort ([NaN, 1, -1, 2, Inf], 1), [NaN, 1, -1, 2, Inf]) -%!assert (sort ([NaN, 1, -1, 2, Inf], 2), [-1, 1, 2, Inf, NaN]) -%!assert (sort ([NaN, 1, -1, 2, Inf], 3), [NaN, 1, -1, 2, Inf]) -%!assert (sort ([NaN, 1, -1, 2, Inf], "ascend"), [-1, 1, 2, Inf, NaN]) -%!assert (sort ([NaN, 1, -1, 2, Inf], 2, "ascend"), [-1, 1, 2, Inf, NaN]) -%!assert (sort ([NaN, 1, -1, 2, Inf], "descend"), [NaN, Inf, 2, 1, -1]) -%!assert (sort ([NaN, 1, -1, 2, Inf], 2, "descend"), [NaN, Inf, 2, 1, -1]) -%!assert (sort ([3, 1, 7, 5; 8, 2, 6, 4]), [3, 1, 6, 4; 8, 2, 7, 5]) -%!assert (sort ([3, 1, 7, 5; 8, 2, 6, 4], 1), [3, 1, 6, 4; 8, 2, 7, 5]) -%!assert (sort ([3, 1, 7, 5; 8, 2, 6, 4], 2), [1, 3, 5, 7; 2, 4, 6, 8]) -%!assert (sort (1), 1) - -%!test -%! [v, i] = sort ([NaN, 1, -1, Inf, 1]); -%! assert (v, [-1, 1, 1, Inf, NaN]); -%! assert (i, [3, 2, 5, 4, 1]); - -## Complex -%!assert (sort ([NaN, 1i, -1, 2, Inf]), [1i, -1, 2, Inf, NaN]) -%!assert (sort ([NaN, 1i, -1, 2, Inf], 1), [NaN, 1i, -1, 2, Inf]) -%!assert (sort ([NaN, 1i, -1, 2, Inf], 2), [1i, -1, 2, Inf, NaN]) -%!assert (sort ([NaN, 1i, -1, 2, Inf], 3), [NaN, 1i, -1, 2, Inf]) -%!assert (sort ([NaN, 1i, -1, 2, Inf], "ascend"), [1i, -1, 2, Inf, NaN]) -%!assert (sort ([NaN, 1i, -1, 2, Inf], 2, "ascend"), [1i, -1, 2, Inf, NaN]) -%!assert (sort ([NaN, 1i, -1, 2, Inf], "descend"), [NaN, Inf, 2, -1, 1i]) -%!assert (sort ([NaN, 1i, -1, 2, Inf], 2, "descend"), [NaN, Inf, 2, -1, 1i]) -%!assert (sort ([3, 1i, 7, 5; 8, 2, 6, 4]), [3, 1i, 6, 4; 8, 2, 7, 5]) -%!assert (sort ([3, 1i, 7, 5; 8, 2, 6, 4], 1), [3, 1i, 6, 4; 8, 2, 7, 5]) -%!assert (sort ([3, 1i, 7, 5; 8, 2, 6, 4], 2), [1i, 3, 5, 7; 2, 4, 6, 8]) -%!assert (sort (1i), 1i) - -%!test -%! [v, i] = sort ([NaN, 1i, -1, Inf, 1, 1i]); -%! assert (v, [1, 1i, 1i, -1, Inf, NaN]); -%! assert (i, [5, 2, 6, 3, 4, 1]); - -## Single -%!assert (sort (single ([NaN, 1, -1, 2, Inf])), single ([-1, 1, 2, Inf, NaN])) -%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 1), single ([NaN, 1, -1, 2, Inf])) -%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 2), single ([-1, 1, 2, Inf, NaN])) -%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 3), single ([NaN, 1, -1, 2, Inf])) -%!assert (sort (single ([NaN, 1, -1, 2, Inf]), "ascend"), single ([-1, 1, 2, Inf, NaN])) -%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 2, "ascend"), single ([-1, 1, 2, Inf, NaN])) -%!assert (sort (single ([NaN, 1, -1, 2, Inf]), "descend"), single ([NaN, Inf, 2, 1, -1])) -%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 2, "descend"), single ([NaN, Inf, 2, 1, -1])) -%!assert (sort (single ([3, 1, 7, 5; 8, 2, 6, 4])), single ([3, 1, 6, 4; 8, 2, 7, 5])) -%!assert (sort (single ([3, 1, 7, 5; 8, 2, 6, 4]), 1), single ([3, 1, 6, 4; 8, 2, 7, 5])) -%!assert (sort (single ([3, 1, 7, 5; 8, 2, 6, 4]), 2), single ([1, 3, 5, 7; 2, 4, 6, 8])) -%!assert (sort (single (1)), single (1)) - -%!test -%! [v, i] = sort (single ([NaN, 1, -1, Inf, 1])); -%! assert (v, single ([-1, 1, 1, Inf, NaN])); -%! assert (i, [3, 2, 5, 4, 1]); - -## Single Complex -%!assert (sort (single ([NaN, 1i, -1, 2, Inf])), single ([1i, -1, 2, Inf, NaN])) -%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 1), single ([NaN, 1i, -1, 2, Inf])) -%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 2), single ([1i, -1, 2, Inf, NaN])) -%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 3), single ([NaN, 1i, -1, 2, Inf])) -%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), "ascend"), single ([1i, -1, 2, Inf, NaN])) -%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 2, "ascend"), single ([1i, -1, 2, Inf, NaN])) -%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), "descend"), single ([NaN, Inf, 2, -1, 1i])) -%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 2, "descend"), single ([NaN, Inf, 2, -1, 1i])) -%!assert (sort (single ([3, 1i, 7, 5; 8, 2, 6, 4])), single ([3, 1i, 6, 4; 8, 2, 7, 5])) -%!assert (sort (single ([3, 1i, 7, 5; 8, 2, 6, 4]), 1), single ([3, 1i, 6, 4; 8, 2, 7, 5])) -%!assert (sort (single ([3, 1i, 7, 5; 8, 2, 6, 4]), 2), single ([1i, 3, 5, 7; 2, 4, 6, 8])) -%!assert (sort (single (1i)), single (1i)) - -%!test -%! [v, i] = sort (single ([NaN, 1i, -1, Inf, 1, 1i])); -%! assert (v, single ([1, 1i, 1i, -1, Inf, NaN])); -%! assert (i, [5, 2, 6, 3, 4, 1]); - -## Bool -%!assert (sort ([true, false, true, false]), [false, false, true, true]) -%!assert (sort ([true, false, true, false], 1), [true, false, true, false]) -%!assert (sort ([true, false, true, false], 2), [false, false, true, true]) -%!assert (sort ([true, false, true, false], 3), [true, false, true, false]) -%!assert (sort ([true, false, true, false], "ascend"), [false, false, true, true]) -%!assert (sort ([true, false, true, false], 2, "ascend"), [false, false, true, true]) -%!assert (sort ([true, false, true, false], "descend"), [true, true, false, false]) -%!assert (sort ([true, false, true, false], 2, "descend"), [true, true, false, false]) -%!assert (sort (true), true) - -%!test -%! [v, i] = sort ([true, false, true, false]); -%! assert (v, [false, false, true, true]); -%! assert (i, [2, 4, 1, 3]); - -## Sparse Double -%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf])), sparse ([-1, 0, 0, 1, 2, Inf, NaN])) -%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 1), sparse ([0, NaN, 1, 0, -1, 2, Inf])) -%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 2), sparse ([-1, 0, 0, 1, 2, Inf, NaN])) -%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 3), sparse ([0, NaN, 1, 0, -1, 2, Inf])) -%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), "ascend"), sparse ([-1, 0, 0, 1, 2, Inf, NaN])) -%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 2, "ascend"), sparse ([-1, 0, 0, 1, 2, Inf, NaN])) -%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), "descend"), sparse ([NaN, Inf, 2, 1, 0, 0, -1])) -%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 2, "descend"), sparse ([NaN, Inf, 2, 1, 0, 0, -1])) - -%!shared a -%! a = randn (10, 10); -%! a(a < 0) = 0; -%!assert (sort (sparse (a)), sparse (sort (a))) -%!assert (sort (sparse (a), 1), sparse (sort (a, 1))) -%!assert (sort (sparse (a), 2), sparse (sort (a, 2))) -%!test -%! [v, i] = sort (a); -%! [vs, is] = sort (sparse (a)); -%! assert (vs, sparse (v)); -%! assert (is, i); - -## Sparse Complex -%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf])), sparse ([0, 0, 1i, -1, 2, Inf, NaN])) -%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 1), sparse ([0, NaN, 1i, 0, -1, 2, Inf])) -%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 2), sparse ([0, 0, 1i, -1, 2, Inf, NaN])) -%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 3), sparse ([0, NaN, 1i, 0, -1, 2, Inf])) -%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), "ascend"), sparse ([0, 0, 1i, -1, 2, Inf, NaN])) -%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 2, "ascend"), sparse ([0, 0, 1i, -1, 2, Inf, NaN])) -%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), "descend"), sparse ([NaN, Inf, 2, -1, 1i, 0, 0])) -%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 2, "descend"), sparse ([NaN, Inf, 2, -1, 1i, 0, 0])) - -%!shared a -%! a = randn (10, 10); -%! a(a < 0) = 0; -%! a = 1i * a; -%!assert (sort (sparse (a)), sparse (sort (a))) -%!assert (sort (sparse (a), 1), sparse (sort (a, 1))) -%!assert (sort (sparse (a), 2), sparse (sort (a, 2))) -%!test -%! [v, i] = sort (a); -%! [vs, is] = sort (sparse (a)); -%! assert (vs, sparse (v)); -%! assert (is, i); - -## Sparse Bool -%!assert (sort (sparse ([true, false, true, false])), sparse ([false, false, true, true])) -%!assert (sort (sparse ([true, false, true, false]), 1), sparse ([true, false, true, false])) -%!assert (sort (sparse ([true, false, true, false]), 2), sparse ([false, false, true, true])) -%!assert (sort (sparse ([true, false, true, false]), 3), sparse ([true, false, true, false])) -%!assert (sort (sparse ([true, false, true, false]), "ascend"), sparse ([false, false, true, true])) -%!assert (sort (sparse ([true, false, true, false]), 2, "ascend"), sparse ([false, false, true, true])) -%!assert (sort (sparse ([true, false, true, false]), "descend"), sparse ([true, true, false, false])) -%!assert (sort (sparse ([true, false, true, false]), 2, "descend"), sparse ([true, true, false, false])) - -%!test -%! [v, i] = sort (sparse ([true, false, true, false])); -%! assert (v, sparse ([false, false, true, true])); -%! assert (i, [2, 4, 1, 3]); - -## Cell string array -%!shared a, b, c -%! a = {"Alice", "Cecile", "Eric", "Barry", "David"}; -%! b = {"Alice", "Barry", "Cecile", "David", "Eric"}; -%! c = {"Eric", "David", "Cecile", "Barry", "Alice"}; -%!assert (sort (a), b) -%!assert (sort (a, 1), a) -%!assert (sort (a, 2), b) -%!assert (sort (a, 3), a) -%!assert (sort (a, "ascend"), b) -%!assert (sort (a, 2, "ascend"), b) -%!assert (sort (a, "descend"), c) -%!assert (sort (a, 2, "descend"), c) - -%!test -%! [v, i] = sort (a); -%! assert (i, [1, 4, 2, 5, 3]); - -%!error sort () -%!error sort (1, 2, 3, 4) -*/ - -// Sort the rows of the matrix @var{a} according to the order -// specified by @var{mode}, which can either be 'ascend' or 'descend' -// and return the index vector corresponding to the sort order. -// -// This function does not yet support sparse matrices. - -DEFUN (__sort_rows_idx__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __sort_rows_idx__ (@var{a}, @var{mode})\n\ -Undocumented internal function.\n\ -@end deftypefn\n") -{ - octave_value retval; - - int nargin = args.length (); - sortmode smode = ASCENDING; - - if (nargin < 1 || nargin > 2 || (nargin == 2 && ! args(1).is_string ())) - { - print_usage (); - return retval; - } - - if (nargin > 1) - { - std::string mode = args(1).string_value (); - if (mode == "ascend") - smode = ASCENDING; - else if (mode == "descend") - smode = DESCENDING; - else - { - error ("__sort_rows_idx__: MODE must be either \"ascend\" or \"descend\""); - return retval; - } - } - - octave_value arg = args(0); - - if (arg.is_sparse_type ()) - error ("__sort_rows_idx__: sparse matrices not yet supported"); - if (arg.ndims () == 2) - { - Array idx = arg.sort_rows_idx (smode); - - retval = octave_value (idx, true, true); - } - else - error ("__sort_rows_idx__: needs a 2-dimensional object"); - - return retval; -} - -static sortmode -get_sort_mode_option (const octave_value& arg, const char *argn) -{ - // FIXME -- we initialize to UNSORTED here to avoid a GCC warning - // about possibly using sortmode uninitialized. - // FIXME -- shouldn't these modes be scoped inside a class? - sortmode smode = UNSORTED; - - std::string mode = arg.string_value (); - - if (error_state) - error ("issorted: expecting %s argument to be a character string", argn); - else if (mode == "ascending") - smode = ASCENDING; - else if (mode == "descending") - smode = DESCENDING; - else if (mode == "either") - smode = UNSORTED; - else - error ("issorted: MODE must be \"ascending\", \"descending\", or \"either\""); - - return smode; -} - -DEFUN (issorted, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} issorted (@var{a})\n\ -@deftypefnx {Built-in Function} {} issorted (@var{a}, @var{mode})\n\ -@deftypefnx {Built-in Function} {} issorted (@var{a}, \"rows\", @var{mode})\n\ -Return true if the array is sorted according to @var{mode}, which\n\ -may be either \"ascending\", \"descending\", or \"either\". By default,\n\ - @var{mode} is \"ascending\". NaNs are treated in the same manner as\n\ -@code{sort}.\n\ -\n\ -If the optional argument \"rows\" is supplied, check whether\n\ -the array is sorted by rows as output by the function @code{sortrows}\n\ -(with no options).\n\ -\n\ -This function does not support sparse matrices.\n\ -@seealso{sort, sortrows}\n\ -@end deftypefn\n") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin < 1 || nargin > 3) - { - print_usage (); - return retval; - } - - bool by_rows = false; - - sortmode smode = ASCENDING; - - if (nargin > 1) - { - octave_value mode_arg; - - if (nargin == 3) - smode = get_sort_mode_option (args(2), "third"); - - std::string tmp = args(1).string_value (); - - if (! error_state) - { - if (tmp == "rows") - by_rows = true; - else - smode = get_sort_mode_option (args(1), "second"); - } - else - error ("expecting second argument to be character string"); - - if (error_state) - return retval; - } - - octave_value arg = args(0); - - if (by_rows) - { - if (arg.is_sparse_type ()) - error ("issorted: sparse matrices not yet supported"); - if (arg.ndims () == 2) - retval = arg.is_sorted_rows (smode) != UNSORTED; - else - error ("issorted: A must be a 2-dimensional object"); - } - else - { - if (arg.dims ().is_vector ()) - retval = args(0).is_sorted (smode) != UNSORTED; - else - error ("issorted: needs a vector"); - } - - return retval; -} - -/* -%!shared sm, um, sv, uv -%! sm = [1, 2; 3, 4]; -%! um = [3, 1; 2, 4]; -%! sv = [1, 2, 3, 4]; -%! uv = [2, 1, 4, 3]; -%!assert (issorted (sm, "rows")) -%!assert (!issorted (um, "rows")) -%!assert (issorted (sv)) -%!assert (!issorted (uv)) -%!assert (issorted (sv')) -%!assert (!issorted (uv')) -%!assert (issorted (sm, "rows", "ascending")) -%!assert (!issorted (um, "rows", "ascending")) -%!assert (issorted (sv, "ascending")) -%!assert (!issorted (uv, "ascending")) -%!assert (issorted (sv', "ascending")) -%!assert (!issorted (uv', "ascending")) -%!assert (!issorted (sm, "rows", "descending")) -%!assert (issorted (flipud (sm), "rows", "descending")) -%!assert (!issorted (sv, "descending")) -%!assert (issorted (fliplr (sv), "descending")) -%!assert (!issorted (sv', "descending")) -%!assert (issorted (fliplr (sv)', "descending")) -%!assert (!issorted (um, "rows", "either")) -%!assert (!issorted (uv, "either")) -%!assert (issorted (sm, "rows", "either")) -%!assert (issorted (flipud (sm), "rows", "either")) -%!assert (issorted (sv, "either")) -%!assert (issorted (fliplr (sv), "either")) -%!assert (issorted (sv', "either")) -%!assert (issorted (fliplr (sv)', "either")) -*/ - -DEFUN (nth_element, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} nth_element (@var{x}, @var{n})\n\ -@deftypefnx {Built-in Function} {} nth_element (@var{x}, @var{n}, @var{dim})\n\ -Select the n-th smallest element of a vector, using the ordering defined by\n\ -@code{sort}. In other words, the result is equivalent to\n\ -@code{sort(@var{x})(@var{n})}.\n\ -@var{n} can also be a contiguous range, either ascending @code{l:u}\n\ -or descending @code{u:-1:l}, in which case a range of elements is returned.\n\ -If @var{x} is an array, @code{nth_element} operates along the dimension\n\ -defined by @var{dim}, or the first non-singleton dimension if @var{dim} is\n\ -not given.\n\ -\n\ -nth_element encapsulates the C++ standard library algorithms nth_element and\n\ -partial_sort. On average, the complexity of the operation is O(M*log(K)),\n\ -where @w{@code{M = size (@var{x}, @var{dim})}} and\n\ -@w{@code{K = length (@var{n})}}.\n\ -This function is intended for cases where the ratio K/M is small; otherwise,\n\ -it may be better to use @code{sort}.\n\ -@seealso{sort, min, max}\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - - if (nargin == 2 || nargin == 3) - { - octave_value argx = args(0); - - int dim = -1; - if (nargin == 3) - { - dim = args(2).int_value (true) - 1; - if (dim < 0) - error ("nth_element: DIM must be a valid dimension"); - } - if (dim < 0) - dim = argx.dims ().first_non_singleton (); - - idx_vector n = args(1).index_vector (); - - if (error_state) - return retval; - - switch (argx.builtin_type ()) - { - case btyp_double: - retval = argx.array_value ().nth_element (n, dim); - break; - case btyp_float: - retval = argx.float_array_value ().nth_element (n, dim); - break; - case btyp_complex: - retval = argx.complex_array_value ().nth_element (n, dim); - break; - case btyp_float_complex: - retval = argx.float_complex_array_value ().nth_element (n, dim); - break; -#define MAKE_INT_BRANCH(X) \ - case btyp_ ## X: \ - retval = argx.X ## _array_value ().nth_element (n, dim); \ - break - - MAKE_INT_BRANCH (int8); - MAKE_INT_BRANCH (int16); - MAKE_INT_BRANCH (int32); - MAKE_INT_BRANCH (int64); - MAKE_INT_BRANCH (uint8); - MAKE_INT_BRANCH (uint16); - MAKE_INT_BRANCH (uint32); - MAKE_INT_BRANCH (uint64); -#undef MAKE_INT_BRANCH - default: - if (argx.is_cellstr ()) - retval = argx.cellstr_value ().nth_element (n, dim); - else - gripe_wrong_type_arg ("nth_element", argx); - } - } - else - print_usage (); - - return retval; -} - -template -static NDT -do_accumarray_sum (const idx_vector& idx, const NDT& vals, - octave_idx_type n = -1) -{ - typedef typename NDT::element_type T; - if (n < 0) - n = idx.extent (0); - else if (idx.extent (n) > n) - error ("accumarray: index out of range"); - - NDT retval (dim_vector (n, 1), T ()); - - if (vals.numel () == 1) - retval.idx_add (idx, vals (0)); - else if (vals.numel () == idx.length (n)) - retval.idx_add (idx, vals); - else - error ("accumarray: dimensions mismatch"); - - return retval; -} - -DEFUN (__accumarray_sum__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __accumarray_sum__ (@var{idx}, @var{vals}, @var{n})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - if (nargin >= 2 && nargin <= 3 && args(0).is_numeric_type ()) - { - idx_vector idx = args(0).index_vector (); - octave_idx_type n = -1; - if (nargin == 3) - n = args(2).idx_type_value (true); - - if (! error_state) - { - octave_value vals = args(1); - if (vals.is_range ()) - { - Range r = vals.range_value (); - if (r.inc () == 0) - vals = r.base (); - } - - if (vals.is_single_type ()) - { - if (vals.is_complex_type ()) - retval = do_accumarray_sum (idx, vals.float_complex_array_value (), n); - else - retval = do_accumarray_sum (idx, vals.float_array_value (), n); - } - else if (vals.is_numeric_type () || vals.is_bool_type ()) - { - if (vals.is_complex_type ()) - retval = do_accumarray_sum (idx, vals.complex_array_value (), n); - else - retval = do_accumarray_sum (idx, vals.array_value (), n); - } - else - gripe_wrong_type_arg ("accumarray", vals); - } - } - else - print_usage (); - - return retval; -} - -template -static NDT -do_accumarray_minmax (const idx_vector& idx, const NDT& vals, - octave_idx_type n, bool ismin, - const typename NDT::element_type& zero_val) -{ - typedef typename NDT::element_type T; - if (n < 0) - n = idx.extent (0); - else if (idx.extent (n) > n) - error ("accumarray: index out of range"); - - NDT retval (dim_vector (n, 1), zero_val); - - // Pick minimizer or maximizer. - void (MArray::*op) (const idx_vector&, const MArray&) = - ismin ? (&MArray::idx_min) : (&MArray::idx_max); - - octave_idx_type l = idx.length (n); - if (vals.numel () == 1) - (retval.*op) (idx, NDT (dim_vector (l, 1), vals(0))); - else if (vals.numel () == l) - (retval.*op) (idx, vals); - else - error ("accumarray: dimensions mismatch"); - - return retval; -} - -static octave_value_list -do_accumarray_minmax_fun (const octave_value_list& args, - bool ismin) -{ - octave_value retval; - int nargin = args.length (); - if (nargin >= 3 && nargin <= 4 && args(0).is_numeric_type ()) - { - idx_vector idx = args(0).index_vector (); - octave_idx_type n = -1; - if (nargin == 4) - n = args(3).idx_type_value (true); - - if (! error_state) - { - octave_value vals = args(1), zero = args (2); - - switch (vals.builtin_type ()) - { - case btyp_double: - retval = do_accumarray_minmax (idx, vals.array_value (), n, ismin, - zero.double_value ()); - break; - case btyp_float: - retval = do_accumarray_minmax (idx, vals.float_array_value (), n, ismin, - zero.float_value ()); - break; - case btyp_complex: - retval = do_accumarray_minmax (idx, vals.complex_array_value (), n, ismin, - zero.complex_value ()); - break; - case btyp_float_complex: - retval = do_accumarray_minmax (idx, vals.float_complex_array_value (), n, ismin, - zero.float_complex_value ()); - break; -#define MAKE_INT_BRANCH(X) \ - case btyp_ ## X: \ - retval = do_accumarray_minmax (idx, vals.X ## _array_value (), n, ismin, \ - zero.X ## _scalar_value ()); \ - break - - MAKE_INT_BRANCH (int8); - MAKE_INT_BRANCH (int16); - MAKE_INT_BRANCH (int32); - MAKE_INT_BRANCH (int64); - MAKE_INT_BRANCH (uint8); - MAKE_INT_BRANCH (uint16); - MAKE_INT_BRANCH (uint32); - MAKE_INT_BRANCH (uint64); -#undef MAKE_INT_BRANCH - case btyp_bool: - retval = do_accumarray_minmax (idx, vals.array_value (), n, ismin, - zero.bool_value ()); - break; - default: - gripe_wrong_type_arg ("accumarray", vals); - } - } - } - else - print_usage (); - - return retval; -} - -DEFUN (__accumarray_min__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __accumarray_min__ (@var{idx}, @var{vals}, @var{zero}, @var{n})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - return do_accumarray_minmax_fun (args, true); -} - -DEFUN (__accumarray_max__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __accumarray_max__ (@var{idx}, @var{vals}, @var{zero}, @var{n})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - return do_accumarray_minmax_fun (args, false); -} - -template -static NDT -do_accumdim_sum (const idx_vector& idx, const NDT& vals, - int dim = -1, octave_idx_type n = -1) -{ - typedef typename NDT::element_type T; - if (n < 0) - n = idx.extent (0); - else if (idx.extent (n) > n) - error ("accumdim: index out of range"); - - dim_vector vals_dim = vals.dims (), rdv = vals_dim; - - if (dim < 0) - dim = vals.dims ().first_non_singleton (); - else if (dim >= rdv.length ()) - rdv.resize (dim+1, 1); - - rdv(dim) = n; - - NDT retval (rdv, T ()); - - if (idx.length () != vals_dim(dim)) - error ("accumdim: dimension mismatch"); - - retval.idx_add_nd (idx, vals, dim); - - return retval; -} - -DEFUN (__accumdim_sum__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __accumdim_sum__ (@var{idx}, @var{vals}, @var{dim}, @var{n})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - if (nargin >= 2 && nargin <= 4 && args(0).is_numeric_type ()) - { - idx_vector idx = args(0).index_vector (); - int dim = -1; - if (nargin >= 3) - dim = args(2).int_value () - 1; - - octave_idx_type n = -1; - if (nargin == 4) - n = args(3).idx_type_value (true); - - if (! error_state) - { - octave_value vals = args(1); - - if (vals.is_single_type ()) - { - if (vals.is_complex_type ()) - retval = do_accumdim_sum (idx, vals.float_complex_array_value (), dim, n); - else - retval = do_accumdim_sum (idx, vals.float_array_value (), dim, n); - } - else if (vals.is_numeric_type () || vals.is_bool_type ()) - { - if (vals.is_complex_type ()) - retval = do_accumdim_sum (idx, vals.complex_array_value (), dim, n); - else - retval = do_accumdim_sum (idx, vals.array_value (), dim, n); - } - else - gripe_wrong_type_arg ("accumdim", vals); - } - } - else - print_usage (); - - return retval; -} - -template -static NDT -do_merge (const Array& mask, - const NDT& tval, const NDT& fval) -{ - typedef typename NDT::element_type T; - dim_vector dv = mask.dims (); - NDT retval (dv); - - bool tscl = tval.numel () == 1, fscl = fval.numel () == 1; - - if ((! tscl && tval.dims () != dv) - || (! fscl && fval.dims () != dv)) - error ("merge: MASK, TVAL, and FVAL dimensions must match"); - else - { - T *rv = retval.fortran_vec (); - octave_idx_type n = retval.numel (); - - const T *tv = tval.data (), *fv = fval.data (); - const bool *mv = mask.data (); - - if (tscl) - { - if (fscl) - { - T ts = tv[0], fs = fv[0]; - for (octave_idx_type i = 0; i < n; i++) - rv[i] = mv[i] ? ts : fs; - } - else - { - T ts = tv[0]; - for (octave_idx_type i = 0; i < n; i++) - rv[i] = mv[i] ? ts : fv[i]; - } - } - else - { - if (fscl) - { - T fs = fv[0]; - for (octave_idx_type i = 0; i < n; i++) - rv[i] = mv[i] ? tv[i] : fs; - } - else - { - for (octave_idx_type i = 0; i < n; i++) - rv[i] = mv[i] ? tv[i] : fv[i]; - } - } - } - - return retval; -} - -#define MAKE_INT_BRANCH(INTX) \ - else if (tval.is_ ## INTX ## _type () && fval.is_ ## INTX ## _type ()) \ - { \ - retval = do_merge (mask, \ - tval.INTX ## _array_value (), \ - fval.INTX ## _array_value ()); \ - } - -DEFUN (merge, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} merge (@var{mask}, @var{tval}, @var{fval})\n\ -@deftypefnx {Built-in Function} {} ifelse (@var{mask}, @var{tval}, @var{fval})\n\ -Merge elements of @var{true_val} and @var{false_val}, depending on the\n\ -value of @var{mask}. If @var{mask} is a logical scalar, the other two\n\ -arguments can be arbitrary values. Otherwise, @var{mask} must be a logical\n\ -array, and @var{tval}, @var{fval} should be arrays of matching class, or\n\ -cell arrays. In the scalar mask case, @var{tval} is returned if @var{mask}\n\ -is true, otherwise @var{fval} is returned.\n\ -\n\ -In the array mask case, both @var{tval} and @var{fval} must be either\n\ -scalars or arrays with dimensions equal to @var{mask}. The result is\n\ -constructed as follows:\n\ -\n\ -@example\n\ -@group\n\ -result(mask) = tval(mask);\n\ -result(! mask) = fval(! mask);\n\ -@end group\n\ -@end example\n\ -\n\ -@var{mask} can also be arbitrary numeric type, in which case\n\ -it is first converted to logical.\n\ -@seealso{logical, diff}\n\ -@end deftypefn") -{ - int nargin = args.length (); - octave_value retval; - - if (nargin == 3 && (args(0).is_bool_type () || args(0).is_numeric_type ())) - { - octave_value mask_val = args(0); - - if (mask_val.is_scalar_type ()) - retval = mask_val.is_true () ? args(1) : args(2); - else - { - boolNDArray mask = mask_val.bool_array_value (); - octave_value tval = args(1), fval = args(2); - if (tval.is_double_type () && fval.is_double_type ()) - { - if (tval.is_complex_type () || fval.is_complex_type ()) - retval = do_merge (mask, - tval.complex_array_value (), - fval.complex_array_value ()); - else - retval = do_merge (mask, - tval.array_value (), - fval.array_value ()); - } - else if (tval.is_single_type () && fval.is_single_type ()) - { - if (tval.is_complex_type () || fval.is_complex_type ()) - retval = do_merge (mask, - tval.float_complex_array_value (), - fval.float_complex_array_value ()); - else - retval = do_merge (mask, - tval.float_array_value (), - fval.float_array_value ()); - } - else if (tval.is_string () && fval.is_string ()) - { - bool sq_string = tval.is_sq_string () || fval.is_sq_string (); - retval = octave_value (do_merge (mask, - tval.char_array_value (), - fval.char_array_value ()), - sq_string ? '\'' : '"'); - } - else if (tval.is_cell () && fval.is_cell ()) - { - retval = do_merge (mask, - tval.cell_value (), - fval.cell_value ()); - } - - MAKE_INT_BRANCH (int8) - MAKE_INT_BRANCH (int16) - MAKE_INT_BRANCH (int32) - MAKE_INT_BRANCH (int64) - MAKE_INT_BRANCH (uint8) - MAKE_INT_BRANCH (uint16) - MAKE_INT_BRANCH (uint32) - MAKE_INT_BRANCH (uint64) - - else - error ("merge: cannot merge %s with %s with array mask", - tval.class_name ().c_str (), - fval.class_name ().c_str ()); - } - } - else - print_usage (); - - return retval; -} - -DEFALIAS (ifelse, merge); - -#undef MAKE_INT_BRANCH - -template -static SparseT -do_sparse_diff (const SparseT& array, octave_idx_type order, - int dim) -{ - SparseT retval = array; - if (dim == 1) - { - octave_idx_type k = retval.columns (); - while (order > 0 && k > 0) - { - idx_vector col1 (':'), col2 (':'), sl1 (1, k), sl2 (0, k-1); - retval = SparseT (retval.index (col1, sl1)) - SparseT (retval.index (col2, sl2)); - assert (retval.columns () == k-1); - order--; - k--; - } - } - else - { - octave_idx_type k = retval.rows (); - while (order > 0 && k > 0) - { - idx_vector col1 (':'), col2 (':'), sl1 (1, k), sl2 (0, k-1); - retval = SparseT (retval.index (sl1, col1)) - SparseT (retval.index (sl2, col2)); - assert (retval.rows () == k-1); - order--; - k--; - } - } - - return retval; -} - -static octave_value -do_diff (const octave_value& array, octave_idx_type order, - int dim = -1) -{ - octave_value retval; - - const dim_vector& dv = array.dims (); - if (dim == -1) - { - dim = array.dims ().first_non_singleton (); - - // Bother Matlab. This behavior is really wicked. - if (dv(dim) <= order) - { - if (dv(dim) == 1) - retval = array.resize (dim_vector (0, 0)); - else - { - retval = array; - while (order > 0) - { - if (dim == dv.length ()) - { - retval = do_diff (array, order, dim - 1); - order = 0; - } - else if (dv(dim) == 1) - dim++; - else - { - retval = do_diff (array, dv(dim) - 1, dim); - order -= dv(dim) - 1; - dim++; - } - } - } - - return retval; - } - } - - if (array.is_integer_type ()) - { - if (array.is_int8_type ()) - retval = array.int8_array_value ().diff (order, dim); - else if (array.is_int16_type ()) - retval = array.int16_array_value ().diff (order, dim); - else if (array.is_int32_type ()) - retval = array.int32_array_value ().diff (order, dim); - else if (array.is_int64_type ()) - retval = array.int64_array_value ().diff (order, dim); - else if (array.is_uint8_type ()) - retval = array.uint8_array_value ().diff (order, dim); - else if (array.is_uint16_type ()) - retval = array.uint16_array_value ().diff (order, dim); - else if (array.is_uint32_type ()) - retval = array.uint32_array_value ().diff (order, dim); - else if (array.is_uint64_type ()) - retval = array.uint64_array_value ().diff (order, dim); - else - panic_impossible (); - } - else if (array.is_sparse_type ()) - { - if (array.is_complex_type ()) - retval = do_sparse_diff (array.sparse_complex_matrix_value (), order, dim); - else - retval = do_sparse_diff (array.sparse_matrix_value (), order, dim); - } - else if (array.is_single_type ()) - { - if (array.is_complex_type ()) - retval = array.float_complex_array_value ().diff (order, dim); - else - retval = array.float_array_value ().diff (order, dim); - } - else - { - if (array.is_complex_type ()) - retval = array.complex_array_value ().diff (order, dim); - else - retval = array.array_value ().diff (order, dim); - } - - return retval; -} - -DEFUN (diff, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} diff (@var{x})\n\ -@deftypefnx {Built-in Function} {} diff (@var{x}, @var{k})\n\ -@deftypefnx {Built-in Function} {} diff (@var{x}, @var{k}, @var{dim})\n\ -If @var{x} is a vector of length @math{n}, @code{diff (@var{x})} is the\n\ -vector of first differences\n\ -@tex\n\ - $x_2 - x_1, \\ldots{}, x_n - x_{n-1}$.\n\ -@end tex\n\ -@ifnottex\n\ - @var{x}(2) - @var{x}(1), @dots{}, @var{x}(n) - @var{x}(n-1).\n\ -@end ifnottex\n\ -\n\ -If @var{x} is a matrix, @code{diff (@var{x})} is the matrix of column\n\ -differences along the first non-singleton dimension.\n\ -\n\ -The second argument is optional. If supplied, @code{diff (@var{x},\n\ -@var{k})}, where @var{k} is a non-negative integer, returns the\n\ -@var{k}-th differences. It is possible that @var{k} is larger than\n\ -the first non-singleton dimension of the matrix. In this case,\n\ -@code{diff} continues to take the differences along the next\n\ -non-singleton dimension.\n\ -\n\ -The dimension along which to take the difference can be explicitly\n\ -stated with the optional variable @var{dim}. In this case the\n\ -@var{k}-th order differences are calculated along this dimension.\n\ -In the case where @var{k} exceeds @code{size (@var{x}, @var{dim})}\n\ -an empty matrix is returned.\n\ -@seealso{sort, merge}\n\ -@end deftypefn") -{ - int nargin = args.length (); - octave_value retval; - - if (nargin < 1 || nargin > 3) - print_usage (); - else if (! (args(0).is_numeric_type () || args(0).is_bool_type ())) - error ("diff: X must be numeric or logical"); - - if (! error_state) - { - int dim = -1; - octave_idx_type order = 1; - if (nargin > 1) - { - if (args(1).is_scalar_type ()) - order = args(1).idx_type_value (true, false); - else if (! args(1).is_zero_by_zero ()) - error ("order K must be a scalar or []"); - if (! error_state && order < 0) - error ("order K must be non-negative"); - } - - if (nargin > 2) - { - dim = args(2).int_value (true, false); - if (! error_state && (dim < 1 || dim > args(0).ndims ())) - error ("DIM must be a valid dimension"); - else - dim -= 1; - } - - if (! error_state) - retval = do_diff (args(0), order, dim); - } - - return retval; -} - -/* -%!assert (diff ([1, 2, 3, 4]), [1, 1, 1]) -%!assert (diff ([1, 3, 7, 19], 2), [2, 8]) -%!assert (diff ([1, 2; 5, 4; 8, 7; 9, 6; 3, 1]), [4, 2; 3, 3; 1, -1; -6, -5]) -%!assert (diff ([1, 2; 5, 4; 8, 7; 9, 6; 3, 1], 3), [-1, -5; -5, 0]) -%!assert (isempty (diff (1))) - -%!error diff () -%!error diff (1, 2, 3, 4) -%!error diff ("foo") -%!error diff ([1, 2; 3, 4], -1) -*/ - -template -static Array -do_repelems (const Array& src, const Array& rep) -{ - Array retval; - - assert (rep.ndims () == 2 && rep.rows () == 2); - - octave_idx_type n = rep.columns (), l = 0; - for (octave_idx_type i = 0; i < n; i++) - { - octave_idx_type k = rep(1, i); - if (k < 0) - { - error ("repelems: second row must contain non-negative numbers"); - return retval; - } - - l += k; - } - - retval.clear (1, l); - T *dest = retval.fortran_vec (); - l = 0; - for (octave_idx_type i = 0; i < n; i++) - { - octave_idx_type k = rep(1, i); - std::fill_n (dest, k, src.checkelem (rep(0, i) - 1)); - dest += k; - } - - return retval; -} - -DEFUN (repelems, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} repelems (@var{x}, @var{r})\n\ -Construct a vector of repeated elements from @var{x}. @var{r}\n\ -is a 2x@var{N} integer matrix specifying which elements to repeat and\n\ -how often to repeat each element.\n\ -\n\ -Entries in the first row, @var{r}(1,j), select an element to repeat.\n\ -The corresponding entry in the second row, @var{r}(2,j), specifies\n\ -the repeat count. If @var{x} is a matrix then the columns of @var{x} are\n\ -imagined to be stacked on top of each other for purposes of the selection\n\ -index. A row vector is always returned.\n\ -\n\ -Conceptually the result is calculated as follows:\n\ -\n\ -@example\n\ -@group\n\ -y = [];\n\ -for i = 1:columns (@var{r})\n\ - y = [y, @var{x}(@var{r}(1,i)*ones(1, @var{r}(2,i)))];\n\ -endfor\n\ -@end group\n\ -@end example\n\ -@seealso{repmat, cat}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 2) - { - octave_value x = args(0); - - const Matrix rm = args(1).matrix_value (); - if (error_state) - return retval; - else if (rm.rows () != 2 || rm.ndims () != 2) - { - error ("repelems: R must be a matrix with two rows"); - return retval; - } - else - { - NoAlias< Array > r (rm.dims ()); - - for (octave_idx_type i = 0; i < rm.numel (); i++) - { - octave_idx_type rx = rm(i); - if (static_cast (rx) != rm(i)) - { - error ("repelems: R must be a matrix of integers"); - return retval; - } - - r(i) = rx; - } - - switch (x.builtin_type ()) - { -#define BTYP_BRANCH(X, EX) \ - case btyp_ ## X: \ - retval = do_repelems (x.EX ## _value (), r); \ - break - - BTYP_BRANCH (double, array); - BTYP_BRANCH (float, float_array); - BTYP_BRANCH (complex, complex_array); - BTYP_BRANCH (float_complex, float_complex_array); - BTYP_BRANCH (bool, bool_array); - BTYP_BRANCH (char, char_array); - - BTYP_BRANCH (int8, int8_array); - BTYP_BRANCH (int16, int16_array); - BTYP_BRANCH (int32, int32_array); - BTYP_BRANCH (int64, int64_array); - BTYP_BRANCH (uint8, uint8_array); - BTYP_BRANCH (uint16, uint16_array); - BTYP_BRANCH (uint32, uint32_array); - BTYP_BRANCH (uint64, uint64_array); - - BTYP_BRANCH (cell, cell); - //BTYP_BRANCH (struct, map);//FIXME -#undef BTYP_BRANCH - - default: - gripe_wrong_type_arg ("repelems", x); - } - } - } - else - print_usage (); - - return retval; -} - -DEFUN (base64_encode, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{s} =} base64_encode (@var{x})\n\ -Encode a double matrix or array @var{x} into the base64 format string\n\ -@var{s}.\n\ -\n\ -@seealso{base64_decode}\n\ -@end deftypefn") -{ - octave_value_list retval; - int nargin = args.length (); - - if (nargin != 1) - print_usage (); - else - { - if (! args(0).is_numeric_type ()) - error ("base64_encode: encoding is supported only for numeric arrays"); - else if (args(0).is_complex_type () - || args(0).is_sparse_type ()) - error ("base64_encode: encoding complex or sparse data is not supported"); - else if (args(0).is_integer_type ()) - { -#define MAKE_INT_BRANCH(X) \ - if (args(0).is_ ## X ## _type ()) \ - { \ - const X##NDArray in = args(0). X## _array_value (); \ - size_t inlen = \ - in.numel () * sizeof (X## _t) / sizeof (char); \ - const char* inc = \ - reinterpret_cast (in.data ()); \ - char* out; \ - if (! error_state \ - && octave_base64_encode (inc, inlen, &out)) \ - retval(0) = octave_value (out); \ - } - - MAKE_INT_BRANCH(int8) - else MAKE_INT_BRANCH(int16) - else MAKE_INT_BRANCH(int32) - else MAKE_INT_BRANCH(int64) - else MAKE_INT_BRANCH(uint8) - else MAKE_INT_BRANCH(uint16) - else MAKE_INT_BRANCH(uint32) - else MAKE_INT_BRANCH(uint64) -#undef MAKE_INT_BRANCH - - else - panic_impossible (); - } - else if (args(0).is_single_type ()) - { - const Array in = args(0).float_array_value (); - size_t inlen; - inlen = in.numel () * sizeof (float) / sizeof (char); - const char* inc; - inc = reinterpret_cast (in.data ()); - char* out; - if (! error_state - && octave_base64_encode (inc, inlen, &out)) - retval(0) = octave_value (out); - } - else - { - const Array in = args(0).array_value (); - size_t inlen; - inlen = in.numel () * sizeof (double) / sizeof (char); - const char* inc; - inc = reinterpret_cast (in.data ()); - char* out; - if (! error_state - && octave_base64_encode (inc, inlen, &out)) - retval(0) = octave_value (out); - } - } - return retval; -} - -/* -%!assert (base64_encode (single (pi)), "2w9JQA==") -%!assert (base64_encode (uint8 ([0 0 0])), "AAAA") -%!assert (base64_encode (uint16 ([0 0 0])), "AAAAAAAA") -%!assert (base64_encode (uint32 ([0 0 0])), "AAAAAAAAAAAAAAAA") -%!assert (base64_encode (uint64 ([0 0 0])), "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA") -%!assert (base64_encode (uint8 ([255 255 255])), "////") - -%!error base64_encode () -%!error base64_encode (1,2) -%!error base64_encode ("A string") -%!error base64_encode ({"A cell array"}) -%!error base64_encode (struct ()) -*/ - -DEFUN (base64_decode, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{x} =} base64_decode (@var{s})\n\ -@deftypefnx {Built-in Function} {@var{x} =} base64_decode (@var{s}, @var{dims})\n\ -Decode the double matrix or array @var{x} from the base64 encoded string\n\ -@var{s}. The optional input parameter @var{dims} should be a vector\n\ -containing the dimensions of the decoded array.\n\ -@seealso{base64_encode}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin < 1 || nargin > 2) - print_usage (); - else - { - dim_vector dims; - - if (nargin > 1) - { - const Array size = - args(1).octave_idx_type_vector_value (); - - if (! error_state) - { - dims = dim_vector::alloc (size.length ()); - for (octave_idx_type i = 0; i < size.length (); i++) - dims(i) = size(i); - } - } - - const std::string str = args(0).string_value (); - - if (! error_state) - { - Array res = octave_base64_decode (str); - - if (nargin > 1) - res = res.reshape (dims); - - retval = res; - } - } - - return retval; -} - -/* -%!assert (base64_decode (base64_encode (pi)), pi) -%! -%!test -%! in = randn (10); -%! outv = base64_decode (base64_encode (in)); -%! outm = base64_decode (base64_encode (in), size (in)); -%! assert (outv, in(:).'); -%! assert (outm, in); - -%!error base64_decode () -%!error base64_decode (1,2,3) -%!error base64_decode (1, "this is not a valid set of dimensions") -%!error base64_decode (1) -%!error base64_decode ("AQ=") -%!error base64_decode ("AQ==") -*/ diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/data.h --- a/libinterp/interpfcn/data.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,34 +0,0 @@ -/* - -Copyright (C) 2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_data_h) -#define octave_data_h 1 - -#include - -class octave_value; -class octave_value_list; - -extern OCTINTERP_API octave_value -do_class_concat (const octave_value_list& ovl, std::string cattype, int dim); - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/debug.cc --- a/libinterp/interpfcn/debug.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1458 +0,0 @@ -/* - -Copyright (C) 2001-2012 Ben Sapp -Copyright (C) 2007-2009 John Swensen - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include -#include -#include -#include - -#include "file-stat.h" -#include "singleton-cleanup.h" - -#include "defun.h" -#include "error.h" -#include "help.h" -#include "input.h" -#include "pager.h" -#include "octave-link.h" -#include "oct-obj.h" -#include "utils.h" -#include "parse.h" -#include "symtab.h" -#include "gripes.h" -#include "ov.h" -#include "ov-usr-fcn.h" -#include "ov-fcn.h" -#include "ov-struct.h" -#include "pt-pr-code.h" -#include "pt-bp.h" -#include "pt-eval.h" -#include "pt-stmt.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "variables.h" - -#include "debug.h" - -// Initialize the singleton object -bp_table *bp_table::instance = 0; - -static std::string -snarf_file (const std::string& fname) -{ - std::string retval; - - file_stat fs (fname); - - if (fs) - { - size_t sz = fs.size (); - - std::ifstream file (fname.c_str (), std::ios::in|std::ios::binary); - - if (file) - { - std::string buf (sz+1, 0); - - file.read (&buf[0], sz+1); - - if (file.eof ()) - { - // Expected to read the entire file. - - retval = buf; - } - else - error ("error reading file %s", fname.c_str ()); - } - } - - return retval; -} - -static std::deque -get_line_offsets (const std::string& buf) -{ - // This could maybe be smarter. Is deque the right thing to use - // here? - - std::deque offsets; - - offsets.push_back (0); - - size_t len = buf.length (); - - for (size_t i = 0; i < len; i++) - { - char c = buf[i]; - - if (c == '\r' && ++i < len) - { - c = buf[i]; - - if (c == '\n') - offsets.push_back (i+1); - else - offsets.push_back (i); - } - else if (c == '\n') - offsets.push_back (i+1); - } - - offsets.push_back (len); - - return offsets; -} - -std::string -get_file_line (const std::string& fname, size_t line) -{ - std::string retval; - - static std::string last_fname; - - static std::string buf; - - static std::deque offsets; - - if (fname != last_fname) - { - buf = snarf_file (fname); - - offsets = get_line_offsets (buf); - } - - if (line > 0) - line--; - - if (line < offsets.size () - 1) - { - size_t bol = offsets[line]; - size_t eol = offsets[line+1]; - - while (eol > 0 && eol > bol && (buf[eol-1] == '\n' || buf[eol-1] == '\r')) - eol--; - - retval = buf.substr (bol, eol - bol); - } - - return retval; -} - -// Return a pointer to the user-defined function FNAME. If FNAME is -// empty, search backward for the first user-defined function in the -// current call stack. - -static octave_user_code * -get_user_code (const std::string& fname = std::string ()) -{ - octave_user_code *dbg_fcn = 0; - - if (fname.empty ()) - dbg_fcn = octave_call_stack::caller_user_code (); - else - { - octave_value fcn = symbol_table::find_function (fname); - - if (fcn.is_defined () && fcn.is_user_code ()) - dbg_fcn = fcn.user_code_value (); - } - - return dbg_fcn; -} - -static void -parse_dbfunction_params (const char *who, const octave_value_list& args, - std::string& symbol_name, bp_table::intmap& lines) -{ - int nargin = args.length (); - int idx = 0; - int list_idx = 0; - symbol_name = std::string (); - lines = bp_table::intmap (); - - if (args.length () == 0) - return; - - // If we are already in a debugging function. - if (octave_call_stack::caller_user_code ()) - { - idx = 0; - symbol_name = get_user_code ()->name (); - } - else if (args(0).is_map ()) - { - // Problem because parse_dbfunction_params() can only pass out a - // single function - } - else if (args(0).is_string ()) - { - symbol_name = args(0).string_value (); - if (error_state) - return; - idx = 1; - } - else - error ("%s: invalid parameter specified", who); - - for (int i = idx; i < nargin; i++ ) - { - if (args(i).is_string ()) - { - int line = atoi (args(i).string_value ().c_str ()); - if (error_state) - break; - lines[list_idx++] = line; - } - else if (args(i).is_map ()) - octave_stdout << who << ": accepting a struct" << std::endl; - else - { - const NDArray arg = args(i).array_value (); - - if (error_state) - break; - - for (octave_idx_type j = 0; j < arg.nelem (); j++) - { - int line = static_cast (arg.elem (j)); - if (error_state) - break; - lines[list_idx++] = line; - } - - if (error_state) - break; - } - } -} - -bool -bp_table::instance_ok (void) -{ - bool retval = true; - - if (! instance) - { - instance = new bp_table (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); - } - - if (! instance) - { - ::error ("unable to create breakpoint table!"); - retval = false; - } - - return retval; -} - -bool -bp_table::do_add_breakpoint_1 (octave_user_code *fcn, - const std::string& fname, - const bp_table::intmap& line, - bp_table::intmap& retval) -{ - bool found = false; - - tree_statement_list *cmds = fcn->body (); - - std::string file = fcn->fcn_file_name (); - - if (cmds) - { - retval = cmds->add_breakpoint (file, line); - - for (intmap_iterator p = retval.begin (); p != retval.end (); p++) - { - if (p->second != 0) - { - bp_set.insert (fname); - found = true; - break; - } - } - } - - return found; -} - -bp_table::intmap -bp_table::do_add_breakpoint (const std::string& fname, - const bp_table::intmap& line) -{ - intmap retval; - - octave_user_code *dbg_fcn = get_user_code (fname); - - if (dbg_fcn) - { - if (! do_add_breakpoint_1 (dbg_fcn, fname, line, retval)) - { - // Search subfunctions in the order they appear in the file. - - const std::list subfcn_names - = dbg_fcn->subfunction_names (); - - std::map subfcns - = dbg_fcn->subfunctions (); - - for (std::list::const_iterator p = subfcn_names.begin (); - p != subfcn_names.end (); p++) - { - std::map::const_iterator - q = subfcns.find (*p); - - if (q != subfcns.end ()) - { - octave_user_code *dbg_subfcn = q->second.user_code_value (); - - if (do_add_breakpoint_1 (dbg_subfcn, fname, line, retval)) - break; - } - } - } - } - else - error ("add_breakpoint: unable to find the requested function\n"); - - tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; - - return retval; -} - - -int -bp_table::do_remove_breakpoint_1 (octave_user_code *fcn, - const std::string& fname, - const bp_table::intmap& line) -{ - int retval = 0; - - std::string file = fcn->fcn_file_name (); - - tree_statement_list *cmds = fcn->body (); - - // FIXME -- move the operation on cmds to the - // tree_statement_list class? - - if (cmds) - { - octave_value_list results = cmds->list_breakpoints (); - - if (results.length () > 0) - { - octave_idx_type len = line.size (); - - for (int i = 0; i < len; i++) - { - const_intmap_iterator p = line.find (i); - - if (p != line.end ()) - { - int lineno = p->second; - - cmds->delete_breakpoint (lineno); - - if (! file.empty ()) - octave_link::update_breakpoint (false, file, lineno); - } - } - - results = cmds->list_breakpoints (); - - bp_set_iterator it = bp_set.find (fname); - if (results.length () == 0 && it != bp_set.end ()) - bp_set.erase (it); - } - - retval = results.length (); - } - - return retval; -} - -int -bp_table::do_remove_breakpoint (const std::string& fname, - const bp_table::intmap& line) -{ - int retval = 0; - - octave_idx_type len = line.size (); - - if (len == 0) - { - intmap results = remove_all_breakpoints_in_file (fname); - retval = results.size (); - } - else - { - octave_user_code *dbg_fcn = get_user_code (fname); - - if (dbg_fcn) - { - retval = do_remove_breakpoint_1 (dbg_fcn, fname, line); - - // Search subfunctions in the order they appear in the file. - - const std::list subfcn_names - = dbg_fcn->subfunction_names (); - - std::map subfcns - = dbg_fcn->subfunctions (); - - for (std::list::const_iterator p = subfcn_names.begin (); - p != subfcn_names.end (); p++) - { - std::map::const_iterator - q = subfcns.find (*p); - - if (q != subfcns.end ()) - { - octave_user_code *dbg_subfcn = q->second.user_code_value (); - - retval += do_remove_breakpoint_1 (dbg_subfcn, fname, line); - } - } - } - else - error ("remove_breakpoint: unable to find the requested function\n"); - } - - tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; - - return retval; -} - -bp_table::intmap -bp_table::do_remove_all_breakpoints_in_file_1 (octave_user_code *fcn, - const std::string& fname) -{ - intmap retval; - - std::string file = fcn->fcn_file_name (); - - tree_statement_list *cmds = fcn->body (); - - if (cmds) - { - retval = cmds->remove_all_breakpoints (file); - - bp_set_iterator it = bp_set.find (fname); - if (it != bp_set.end ()) - bp_set.erase (it); - } - - return retval; -} - -bp_table::intmap -bp_table::do_remove_all_breakpoints_in_file (const std::string& fname, - bool silent) -{ - intmap retval; - - octave_user_code *dbg_fcn = get_user_code (fname); - - if (dbg_fcn) - { - retval = do_remove_all_breakpoints_in_file_1 (dbg_fcn, fname); - - // Order is not important here. - - typedef std::map::const_iterator - subfcns_const_iterator; - - std::map subfcns = dbg_fcn->subfunctions (); - - for (subfcns_const_iterator p = subfcns.begin (); - p != subfcns.end (); p++) - { - octave_user_code *dbg_subfcn = p->second.user_code_value (); - - intmap tmp = do_remove_all_breakpoints_in_file_1 (dbg_subfcn, fname); - - // Merge new list with retval. - retval.insert (tmp.begin (), tmp.end ()); - } - } - else if (! silent) - error ("remove_all_breakpoint_in_file: " - "unable to find the requested function\n"); - - tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; - - return retval; -} - -void -bp_table::do_remove_all_breakpoints (void) -{ - for (const_bp_set_iterator it = bp_set.begin (); it != bp_set.end (); it++) - remove_all_breakpoints_in_file (*it); - - - tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; -} - -std::string -do_find_bkpt_list (octave_value_list slist, - std::string match) -{ - std::string retval; - - for (int i = 0; i < slist.length (); i++) - { - if (slist (i).string_value () == match) - { - retval = slist(i).string_value (); - break; - } - } - - return retval; -} - - -bp_table::fname_line_map -bp_table::do_get_breakpoint_list (const octave_value_list& fname_list) -{ - fname_line_map retval; - - for (bp_set_iterator it = bp_set.begin (); it != bp_set.end (); it++) - { - if (fname_list.length () == 0 - || do_find_bkpt_list (fname_list, *it) != "") - { - octave_user_code *f = get_user_code (*it); - - if (f) - { - tree_statement_list *cmds = f->body (); - - // FIXME -- move the operation on cmds to the - // tree_statement_list class? - if (cmds) - { - octave_value_list bkpts = cmds->list_breakpoints (); - octave_idx_type len = bkpts.length (); - - if (len > 0) - { - bp_table::intmap bkpts_vec; - - for (int i = 0; i < len; i++) - bkpts_vec[i] = bkpts (i).double_value (); - - std::string symbol_name = f->name (); - - retval[symbol_name] = bkpts_vec; - } - } - } - } - } - - return retval; -} - -static octave_value -intmap_to_ov (const bp_table::intmap& line) -{ - int idx = 0; - - NDArray retval (dim_vector (1, line.size ())); - - for (size_t i = 0; i < line.size (); i++) - { - bp_table::const_intmap_iterator p = line.find (i); - - if (p != line.end ()) - { - int lineno = p->second; - retval(idx++) = lineno; - } - } - - retval.resize (dim_vector (1, idx)); - - return retval; -} - -DEFUN (dbstop, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{rline} =} dbstop (\"@var{func}\")\n\ -@deftypefnx {Built-in Function} {@var{rline} =} dbstop (\"@var{func}\", @var{line})\n\ -@deftypefnx {Built-in Function} {@var{rline} =} dbstop (\"@var{func}\", @var{line1}, @var{line2}, @dots{})\n\ -Set a breakpoint in function @var{func}.\n\ -\n\ -Arguments are\n\ -\n\ -@table @var\n\ -@item func\n\ -Function name as a string variable. When already in debug\n\ -mode this should be left out and only the line should be given.\n\ -\n\ -@item line\n\ -Line number where the breakpoint should be set. Multiple\n\ -lines may be given as separate arguments or as a vector.\n\ -@end table\n\ -\n\ -When called with a single argument @var{func}, the breakpoint\n\ -is set at the first executable line in the named function.\n\ -\n\ -The optional output @var{rline} is the real line number where the\n\ -breakpoint was set. This can differ from specified line if\n\ -the line is not executable. For example, if a breakpoint attempted on a\n\ -blank line then Octave will set the real breakpoint at the\n\ -next executable line.\n\ -@seealso{dbclear, dbstatus, dbstep, debug_on_error, debug_on_warning, debug_on_interrupt}\n\ -@end deftypefn") -{ - bp_table::intmap retval; - std::string symbol_name; - bp_table::intmap lines; - - parse_dbfunction_params ("dbstop", args, symbol_name, lines); - - if (lines.size () == 0) - lines[0] = 1; - - if (! error_state) - retval = bp_table::add_breakpoint (symbol_name, lines); - - return intmap_to_ov (retval); -} - -DEFUN (dbclear, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} dbclear (\"@var{func}\")\n\ -@deftypefnx {Built-in Function} {} dbclear (\"@var{func}\", @var{line}, @dots{})\n\ -@deftypefnx {Built-in Function} {} dbclear (@var{line}, @dots{})\n\ -Delete a breakpoint in the function @var{func}.\n\ -\n\ -Arguments are\n\ -\n\ -@table @var\n\ -@item func\n\ -Function name as a string variable. When already in debug\n\ -mode this argument should be omitted and only the line number should be\n\ -given.\n\ -\n\ -@item line\n\ -Line number from which to remove a breakpoint. Multiple\n\ -lines may be given as separate arguments or as a vector.\n\ -@end table\n\ -\n\ -When called without a line number specification all breakpoints\n\ -in the named function are cleared.\n\ -\n\ -If the requested line is not a breakpoint no action is performed.\n\ -@seealso{dbstop, dbstatus, dbwhere}\n\ -@end deftypefn") -{ - octave_value retval; - std::string symbol_name = ""; - bp_table::intmap lines; - - parse_dbfunction_params ("dbclear", args, symbol_name, lines); - - if (! error_state) - bp_table::remove_breakpoint (symbol_name, lines); - - return retval; -} - -DEFUN (dbstatus, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} dbstatus ()\n\ -@deftypefnx {Built-in Function} {@var{brk_list} =} dbstatus ()\n\ -@deftypefnx {Built-in Function} {@var{brk_list} =} dbstatus (\"@var{func}\")\n\ -Report the location of active breakpoints.\n\ -\n\ -When called with no input or output arguments, print the list of\n\ -all functions with breakpoints and the line numbers where those\n\ -breakpoints are set.\n\ -If a function name @var{func} is specified then only report breakpoints\n\ -for the named function.\n\ -\n\ -The optional return argument @var{brk_list} is a struct array with the\n\ -following fields.\n\ -\n\ -@table @asis\n\ -@item name\n\ -The name of the function with a breakpoint.\n\ -\n\ -@item file\n\ -The name of the m-file where the function code is located.\n\ -\n\ -@item line\n\ -A line number, or vector of line numbers, with a breakpoint.\n\ -@end table\n\ -\n\ -@seealso{dbclear, dbwhere}\n\ -@end deftypefn") -{ - octave_map retval; - int nargin = args.length (); - octave_value_list fcn_list; - bp_table::fname_line_map bp_list; - std::string symbol_name; - - if (nargin != 0 && nargin != 1) - { - error ("dbstatus: only zero or one arguments accepted\n"); - return octave_value (); - } - - if (nargin == 1) - { - if (args(0).is_string ()) - { - symbol_name = args(0).string_value (); - fcn_list(0) = symbol_name; - bp_list = bp_table::get_breakpoint_list (fcn_list); - } - else - gripe_wrong_type_arg ("dbstatus", args(0)); - } - else - { - octave_user_code *dbg_fcn = get_user_code (); - if (dbg_fcn) - { - symbol_name = dbg_fcn->name (); - fcn_list(0) = symbol_name; - } - - bp_list = bp_table::get_breakpoint_list (fcn_list); - } - - if (nargout == 0) - { - // Print out the breakpoint information. - - for (bp_table::fname_line_map_iterator it = bp_list.begin (); - it != bp_list.end (); it++) - { - bp_table::intmap m = it->second; - - size_t nel = m.size (); - - octave_stdout << "breakpoint in " << it->first; - if (nel > 1) - octave_stdout << " at lines "; - else - octave_stdout << " at line "; - - for (size_t j = 0; j < nel; j++) - octave_stdout << m[j] << ((j < nel - 1) ? ", " : "."); - - if (nel > 0) - octave_stdout << std::endl; - } - return octave_value (); - } - else - { - // Fill in an array for return. - - int i = 0; - Cell names (dim_vector (bp_list.size (), 1)); - Cell file (dim_vector (bp_list.size (), 1)); - Cell line (dim_vector (bp_list.size (), 1)); - - for (bp_table::const_fname_line_map_iterator it = bp_list.begin (); - it != bp_list.end (); it++) - { - names(i) = it->first; - line(i) = intmap_to_ov (it->second); - file(i) = do_which (it->first); - i++; - } - - retval.assign ("name", names); - retval.assign ("file", file); - retval.assign ("line", line); - - return octave_value (retval); - } -} - -DEFUN (dbwhere, , , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} dbwhere\n\ -In debugging mode, report the current file and line number where\n\ -execution is stopped.\n\ -@seealso{dbstatus, dbcont, dbstep, dbup}\n\ -@end deftypefn") -{ - octave_value retval; - - octave_user_code *dbg_fcn = get_user_code (); - - if (dbg_fcn) - { - bool have_file = true; - - std::string name = dbg_fcn->fcn_file_name (); - - if (name.empty ()) - { - have_file = false; - - name = dbg_fcn->name (); - } - - octave_stdout << "stopped in " << name << " at "; - - int l = octave_call_stack::caller_user_code_line (); - - if (l > 0) - { - octave_stdout << " line " << l << std::endl; - - if (have_file) - { - std::string line = get_file_line (name, l); - - if (! line.empty ()) - octave_stdout << l << ": " << line << std::endl; - } - } - else - octave_stdout << " " << std::endl; - } - else - error ("dbwhere: must be inside a user function to use dbwhere\n"); - - return retval; -} - -// Copied and modified from the do_type command in help.cc -// Maybe we could share some code? -void -do_dbtype (std::ostream& os, const std::string& name, int start, int end) -{ - std::string ff = fcn_file_in_path (name); - - if (! ff.empty ()) - { - std::ifstream fs (ff.c_str (), std::ios::in); - - if (fs) - { - char ch; - int line = 1; - bool isnewline = true; - - // FIXME: Why not use line-oriented input here [getline()]? - while (fs.get (ch) && line <= end) - { - if (isnewline && line >= start) - { - os << line << "\t"; - isnewline = false; - } - - if (line >= start) - { - os << ch; - } - - if (ch == '\n') - { - line++; - isnewline = true; - } - } - } - else - os << "dbtype: unable to open '" << ff << "' for reading!\n"; - } - else - os << "dbtype: unknown function " << name << "\n"; - - os.flush (); -} - -DEFUN (dbtype, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} dbtype\n\ -@deftypefnx {Command} {} dbtype @var{lineno}\n\ -@deftypefnx {Command} {} dbtype @var{startl:endl}\n\ -@deftypefnx {Command} {} dbtype @var{startl:end}\n\ -@deftypefnx {Command} {} dbtype @var{func}\n\ -@deftypefnx {Command} {} dbtype @var{func} @var{lineno}\n\ -@deftypefnx {Command} {} dbtype @var{func} @var{startl:endl}\n\ -@deftypefnx {Command} {} dbtype @var{func} @var{startl:end}\n\ -Display a script file with line numbers.\n\ -\n\ -When called with no arguments in debugging mode, display the script file\n\ -currently being debugged. An optional range specification can be used to\n\ -list only a portion of the file. The special keyword \"end\" is a valid\n\ -line number specification for the last line of the file.\n\ -\n\ -When called with the name of a function, list that script file with line\n\ -numbers.\n\ -@seealso{dbwhere, dbstatus, dbstop}\n\ -@end deftypefn") -{ - octave_value retval; - octave_user_code *dbg_fcn; - - int nargin = args.length (); - string_vector argv = args.make_argv ("dbtype"); - - if (! error_state) - { - switch (nargin) - { - case 0: // dbtype - dbg_fcn = get_user_code (); - - if (dbg_fcn) - do_dbtype (octave_stdout, dbg_fcn->name (), 0, - std::numeric_limits::max ()); - else - error ("dbtype: must be inside a user function to give no arguments to dbtype\n"); - break; - - case 1: // (dbtype func) || (dbtype start:end) - { - std::string arg = argv[1]; - - size_t ind = arg.find (':'); - - if (ind != std::string::npos) // (dbtype start:end) - { - dbg_fcn = get_user_code (); - - if (dbg_fcn) - { - std::string start_str = arg.substr (0, ind); - std::string end_str = arg.substr (ind + 1); - - int start, end; - start = atoi (start_str.c_str ()); - if (end_str == "end") - end = std::numeric_limits::max (); - else - end = atoi (end_str.c_str ()); - - if (std::min (start, end) <= 0) - error ("dbtype: start and end lines must be >= 1\n"); - - if (start <= end) - do_dbtype (octave_stdout, dbg_fcn->name (), start, end); - else - error ("dbtype: start line must be less than end line\n"); - } - } - else // (dbtype func) - { - dbg_fcn = get_user_code (arg); - - if (dbg_fcn) - do_dbtype (octave_stdout, dbg_fcn->name (), 0, - std::numeric_limits::max ()); - else - error ("dbtype: function <%s> not found\n", arg.c_str ()); - } - } - break; - - case 2: // (dbtype func start:end) , (dbtype func start) - dbg_fcn = get_user_code (argv[1]); - - if (dbg_fcn) - { - std::string arg = argv[2]; - int start, end; - size_t ind = arg.find (':'); - - if (ind != std::string::npos) - { - std::string start_str = arg.substr (0, ind); - std::string end_str = arg.substr (ind + 1); - - start = atoi (start_str.c_str ()); - if (end_str == "end") - end = std::numeric_limits::max (); - else - end = atoi (end_str.c_str ()); - } - else - { - start = atoi (arg.c_str ()); - end = start; - } - - if (std::min (start, end) <= 0) - error ("dbtype: start and end lines must be >= 1\n"); - - if (start <= end) - do_dbtype (octave_stdout, dbg_fcn->name (), start, end); - else - error ("dbtype: start line must be less than end line\n"); - } - else - error ("dbtype: function <%s> not found\n", argv[1].c_str ()); - - break; - - default: - error ("dbtype: expecting zero, one, or two arguments\n"); - } - } - - return retval; -} - -DEFUN (dblist, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} dblist\n\ -@deftypefnx {Command} {} dblist @var{n}\n\ -In debugging mode, list @var{n} lines of the function being debugged\n\ -centered around the the current line to be executed. If unspecified @var{n}\n\ -defaults to 10 (+/- 5 lines)\n\ -@seealso{dbwhere, dbtype}\n\ -@end deftypefn") -{ - octave_value retval; - - int n = 10; - - if (args.length () == 1) - { - octave_value arg = args(0); - - if (arg.is_string ()) - { - std::string s_arg = arg.string_value (); - - n = atoi (s_arg.c_str ()); - } - else - n = args(0).int_value (); - - if (n < 0) - error ("dblist: N must be a non-negative integer"); - } - - octave_user_code *dbg_fcn = get_user_code (); - - if (dbg_fcn) - { - bool have_file = true; - - std::string name = dbg_fcn->fcn_file_name (); - - if (name.empty ()) - { - have_file = false; - name = dbg_fcn->name (); - } - - int l = octave_call_stack::caller_user_code_line (); - - if (l > 0) - { - if (have_file) - { - int l_min = std::max (l - n/2, 0); - int l_max = l + n/2; - do_dbtype (octave_stdout, dbg_fcn->name (), l_min, l-1); - - std::string line = get_file_line (name, l); - if (! line.empty ()) - octave_stdout << l << "-->\t" << line << std::endl; - - do_dbtype (octave_stdout, dbg_fcn->name (), l+1, l_max); - } - } - else - { - octave_stdout << "dblist: unable to determine source code line" - << std::endl; - } - } - else - error ("dblist: must be inside a user function to use dblist\n"); - - return retval; -} - -static octave_value_list -do_dbstack (const octave_value_list& args, int nargout, std::ostream& os) -{ - octave_value_list retval; - - unwind_protect frame; - - octave_idx_type curr_frame = -1; - - size_t nskip = 0; - - if (args.length () == 1) - { - int n = 0; - - octave_value arg = args(0); - - if (arg.is_string ()) - { - std::string s_arg = arg.string_value (); - - n = atoi (s_arg.c_str ()); - } - else - n = args(0).int_value (); - - if (n > 0) - nskip = n; - else - error ("dbstack: N must be a non-negative integer"); - } - - if (! error_state) - { - octave_map stk = octave_call_stack::backtrace (nskip, curr_frame); - - if (nargout == 0) - { - octave_idx_type nframes_to_display = stk.numel (); - - if (nframes_to_display > 0) - { - os << "stopped in:\n\n"; - - Cell names = stk.contents ("name"); - Cell files = stk.contents ("file"); - Cell lines = stk.contents ("line"); - - bool show_top_level = true; - - size_t max_name_len = 0; - - for (octave_idx_type i = 0; i < nframes_to_display; i++) - { - std::string name = names(i).string_value (); - - max_name_len = std::max (name.length (), max_name_len); - } - - for (octave_idx_type i = 0; i < nframes_to_display; i++) - { - std::string name = names(i).string_value (); - std::string file = files(i).string_value (); - int line = lines(i).int_value (); - - if (show_top_level && i == curr_frame) - show_top_level = false; - - os << (i == curr_frame ? " --> " : " ") - << std::setw (max_name_len) << name - << " at line " << line - << " [" << file << "]" - << std::endl; - } - - if (show_top_level) - os << " --> top level" << std::endl; - } - } - else - { - retval(1) = curr_frame < 0 ? 1 : curr_frame + 1; - retval(0) = stk; - } - } - - return retval; -} - -// A function that can be easily called from a debugger print the Octave -// stack. This can be useful for finding what line of code the -// interpreter is currently executing when the debugger is stopped in -// some C++ function, for example. - -void -show_octave_dbstack (void) -{ - do_dbstack (octave_value_list (), 0, std::cerr); -} - -DEFUN (dbstack, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Command} {} dbstack\n\ -@deftypefnx {Command} {} dbstack @var{n}\n\ -@deftypefnx {Built-in Function} {[@var{stack}, @var{idx}] =} dbstack (@dots{})\n\ -Display or return current debugging function stack information.\n\ -With optional argument @var{n}, omit the @var{n} innermost stack frames.\n\ -\n\ -The optional return argument @var{stack} is a struct array with the\n\ -following fields:\n\ -\n\ -@table @asis\n\ -@item file\n\ -The name of the m-file where the function code is located.\n\ -\n\ -@item name\n\ -The name of the function with a breakpoint.\n\ -\n\ -@item line\n\ -The line number of an active breakpoint.\n\ -\n\ -@item column\n\ -The column number of the line where the breakpoint begins.\n\ -\n\ -@item scope\n\ -Undocumented.\n\ -\n\ -@item context\n\ -Undocumented.\n\ -@end table\n\ -\n\ -The return argument @var{idx} specifies which element of the @var{stack}\n\ -struct array is currently active.\n\ -@seealso{dbup, dbdown, dbwhere, dbstatus}\n\ -@end deftypefn") -{ - return do_dbstack (args, nargout, octave_stdout); -} - -static void -do_dbupdown (const octave_value_list& args, const std::string& who) -{ - int n = 1; - - if (args.length () == 1) - { - octave_value arg = args(0); - - if (arg.is_string ()) - { - std::string s_arg = arg.string_value (); - - n = atoi (s_arg.c_str ()); - } - else - n = args(0).int_value (); - } - - if (! error_state) - { - if (who == "dbup") - n = -n; - - if (! octave_call_stack::goto_frame_relative (n, true)) - error ("%s: invalid stack frame", who.c_str ()); - } -} - -DEFUN (dbup, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} dbup\n\ -@deftypefnx {Built-in Function} {} dbup (@var{n})\n\ -In debugging mode, move up the execution stack @var{n} frames.\n\ -If @var{n} is omitted, move up one frame.\n\ -@seealso{dbstack, dbdown}\n\ -@end deftypefn") -{ - octave_value retval; - - do_dbupdown (args, "dbup"); - - return retval; -} - -DEFUN (dbdown, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} dbdown\n\ -@deftypefnx {Built-in Function} {} dbdown (@var{n})\n\ -In debugging mode, move down the execution stack @var{n} frames.\n\ -If @var{n} is omitted, move down one frame.\n\ -@seealso{dbstack, dbup}\n\ -@end deftypefn") -{ - octave_value retval; - - do_dbupdown (args, "dbdown"); - - return retval; -} - -DEFUN (dbstep, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} dbstep\n\ -@deftypefnx {Command} {} dbstep @var{n}\n\ -@deftypefnx {Command} {} dbstep in\n\ -@deftypefnx {Command} {} dbstep out\n\ -@deftypefnx {Command} {} dbnext @dots{}\n\ -In debugging mode, execute the next @var{n} lines of code.\n\ -If @var{n} is omitted, execute the next single line of code.\n\ -If the next line of code is itself defined in terms of an m-file remain in\n\ -the existing function.\n\ -\n\ -Using @code{dbstep in} will cause execution of the next line to step into\n\ -any m-files defined on the next line. Using @code{dbstep out} will cause\n\ -execution to continue until the current function returns.\n\ -\n\ -@code{dbnext} is an alias for @code{dbstep}.\n\ -@seealso{dbcont, dbquit}\n\ -@end deftypefn") -{ - if (Vdebugging) - { - int nargin = args.length (); - - if (nargin > 1) - print_usage (); - else if (nargin == 1) - { - if (args(0).is_string ()) - { - std::string arg = args(0).string_value (); - - if (! error_state) - { - if (arg == "in") - { - Vdebugging = false; - - tree_evaluator::dbstep_flag = -1; - } - else if (arg == "out") - { - Vdebugging = false; - - tree_evaluator::dbstep_flag = -2; - } - else - { - int n = atoi (arg.c_str ()); - - if (n > 0) - { - Vdebugging = false; - - tree_evaluator::dbstep_flag = n; - } - else - error ("dbstep: invalid argument"); - } - } - } - else - error ("dbstep: input argument must be a character string"); - } - else - { - Vdebugging = false; - - tree_evaluator::dbstep_flag = 1; - } - } - else - error ("dbstep: can only be called in debug mode"); - - return octave_value_list (); -} - -DEFALIAS (dbnext, dbstep); - -DEFUN (dbcont, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} dbcont\n\ -Leave command-line debugging mode and continue code execution normally.\n\ -@seealso{dbstep, dbquit}\n\ -@end deftypefn") -{ - if (Vdebugging) - { - if (args.length () == 0) - { - Vdebugging = false; - - tree_evaluator::reset_debug_state (); - } - else - print_usage (); - } - else - error ("dbcont: can only be called in debug mode"); - - return octave_value_list (); -} - -DEFUN (dbquit, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} dbquit\n\ -Quit debugging mode immediately without further code execution and\n\ -return to the Octave prompt.\n\ -@seealso{dbcont, dbstep}\n\ -@end deftypefn") -{ - if (Vdebugging) - { - if (args.length () == 0) - { - Vdebugging = false; - - tree_evaluator::reset_debug_state (); - - octave_throw_interrupt_exception (); - } - else - print_usage (); - } - else - error ("dbquit: can only be called in debug mode"); - - return octave_value_list (); -} - -DEFUN (isdebugmode, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isdebugmode ()\n\ -Return true if in debugging mode, otherwise false.\n\ -@seealso{dbwhere, dbstack, dbstatus}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 0) - retval = Vdebugging; - else - print_usage (); - - return retval; -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/debug.h --- a/libinterp/interpfcn/debug.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,143 +0,0 @@ -/* - -Copyright (C) 2001-2012 Ben Sapp - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_debug_h) -#define octave_debug_h 1 - -#include -#include -#include "ov.h" -#include "dRowVector.h" - -class octave_value_list; -class octave_user_code; - -// Interface to breakpoints,. - -class -OCTINTERP_API -bp_table -{ -private: - - bp_table (void) : bp_set () { } - - ~bp_table (void) { } - -public: - - typedef std::map intmap; - - typedef intmap::const_iterator const_intmap_iterator; - typedef intmap::iterator intmap_iterator; - - typedef std::map fname_line_map; - - typedef fname_line_map::const_iterator const_fname_line_map_iterator; - typedef fname_line_map::iterator fname_line_map_iterator; - - static bool instance_ok (void); - - // Add a breakpoint at the nearest executable line. - static intmap add_breakpoint (const std::string& fname = "", - const intmap& lines = intmap ()) - { - return instance_ok () - ? instance->do_add_breakpoint (fname, lines) : intmap (); - } - - // Remove a breakpoint from a line in file. - static int remove_breakpoint (const std::string& fname = "", - const intmap& lines = intmap ()) - { - return instance_ok () - ? instance->do_remove_breakpoint (fname, lines) : 0; - } - - // Remove all the breakpoints in a specified file. - static intmap remove_all_breakpoints_in_file (const std::string& fname, - bool silent = false) - { - return instance_ok () - ? instance->do_remove_all_breakpoints_in_file (fname, silent) : intmap (); - } - - // Remove all the breakpoints registered with octave. - static void remove_all_breakpoints (void) - { - if (instance_ok ()) - instance->do_remove_all_breakpoints (); - } - - // Return all breakpoints. Each element of the map is a vector - // containing the breakpoints corresponding to a given function name. - static fname_line_map - get_breakpoint_list (const octave_value_list& fname_list) - { - return instance_ok () - ? instance->do_get_breakpoint_list (fname_list) : fname_line_map (); - } - - static bool - have_breakpoints (void) - { - return instance_ok () ? instance->do_have_breakpoints () : 0; - } - -private: - - typedef std::set::const_iterator const_bp_set_iterator; - typedef std::set::iterator bp_set_iterator; - - // Set of function names containing at least one breakpoint. - std::set bp_set; - - static bp_table *instance; - - static void cleanup_instance (void) { delete instance; instance = 0; } - - bool do_add_breakpoint_1 (octave_user_code *fcn, const std::string& fname, - const intmap& line, intmap& retval); - - intmap do_add_breakpoint (const std::string& fname, const intmap& lines); - - int do_remove_breakpoint_1 (octave_user_code *fcn, const std::string&, - const intmap& lines); - - int do_remove_breakpoint (const std::string&, const intmap& lines); - - intmap do_remove_all_breakpoints_in_file_1 (octave_user_code *fcn, - const std::string& fname); - - intmap do_remove_all_breakpoints_in_file (const std::string& fname, - bool silent); - - void do_remove_all_breakpoints (void); - - fname_line_map do_get_breakpoint_list (const octave_value_list& fname_list); - - bool do_have_breakpoints (void) { return (! bp_set.empty ()); } -}; - -extern std::string get_file_line (const std::string& fname, size_t line); - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/defaults.cc --- a/libinterp/interpfcn/defaults.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,606 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include -#include -#include - -#include -#include - -#include "dir-ops.h" -#include "oct-env.h" -#include "file-stat.h" -#include "pathsearch.h" -#include "str-vec.h" - -#include -#include "defun.h" -#include "error.h" -#include "file-ops.h" -#include "gripes.h" -#include "help.h" -#include "input.h" -#include "load-path.h" -#include "oct-obj.h" -#include "ov.h" -#include "parse.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "variables.h" -#include - -std::string Voctave_home; - -std::string Vbin_dir; -std::string Vinfo_dir; -std::string Vdata_dir; -std::string Vlibexec_dir; -std::string Varch_lib_dir; -std::string Vlocal_arch_lib_dir; -std::string Vlocal_api_arch_lib_dir; -std::string Vlocal_ver_arch_lib_dir; - -std::string Vlocal_ver_oct_file_dir; -std::string Vlocal_api_oct_file_dir; -std::string Vlocal_oct_file_dir; - -std::string Vlocal_ver_fcn_file_dir; -std::string Vlocal_api_fcn_file_dir; -std::string Vlocal_fcn_file_dir; - -std::string Voct_etc_dir; -std::string Voct_locale_dir; - -std::string Voct_file_dir; -std::string Vfcn_file_dir; - -std::string Vimage_dir; - -// The path that will be searched for programs that we execute. -// (--exec-path path) -static std::string VEXEC_PATH; - -// Name of the editor to be invoked by the edit_history command. -std::string VEDITOR; - -static std::string VIMAGE_PATH; - -std::string Vlocal_site_defaults_file; -std::string Vsite_defaults_file; - -std::string Vbuilt_in_docstrings_file; - -std::string -subst_octave_home (const std::string& s) -{ - std::string retval; - - std::string prefix = OCTAVE_PREFIX; - - retval = s; - - if (Voctave_home != prefix) - { - octave_idx_type len = prefix.length (); - - if (s.substr (0, len) == prefix) - retval.replace (0, len, Voctave_home); - } - - if (file_ops::dir_sep_char () != '/') - std::replace (retval.begin (), retval.end (), '/', - file_ops::dir_sep_char ()); - - return retval; -} - -static void -set_octave_home (void) -{ - std::string oh = octave_env::getenv ("OCTAVE_HOME"); - - Voctave_home = oh.empty () ? std::string (OCTAVE_PREFIX) : oh; -} - -static void -set_default_info_dir (void) -{ - Vinfo_dir = subst_octave_home (OCTAVE_INFODIR); -} - -static void -set_default_data_dir (void) -{ - Vdata_dir = subst_octave_home (OCTAVE_DATADIR); -} - -static void -set_default_libexec_dir (void) -{ - Vlibexec_dir = subst_octave_home (OCTAVE_LIBEXECDIR); -} - -static void -set_default_arch_lib_dir (void) -{ - Varch_lib_dir = subst_octave_home (OCTAVE_ARCHLIBDIR); -} - -static void -set_default_local_arch_lib_dir (void) -{ - Vlocal_arch_lib_dir = subst_octave_home (OCTAVE_LOCALARCHLIBDIR); -} - -static void -set_default_local_api_arch_lib_dir (void) -{ - Vlocal_api_arch_lib_dir = subst_octave_home (OCTAVE_LOCALAPIARCHLIBDIR); -} - -static void -set_default_local_ver_arch_lib_dir (void) -{ - Vlocal_ver_arch_lib_dir = subst_octave_home (OCTAVE_LOCALVERARCHLIBDIR); -} - -static void -set_default_local_ver_oct_file_dir (void) -{ - Vlocal_ver_oct_file_dir = subst_octave_home (OCTAVE_LOCALVEROCTFILEDIR); -} - -static void -set_default_local_api_oct_file_dir (void) -{ - Vlocal_api_oct_file_dir = subst_octave_home (OCTAVE_LOCALAPIOCTFILEDIR); -} - -static void -set_default_local_oct_file_dir (void) -{ - Vlocal_oct_file_dir = subst_octave_home (OCTAVE_LOCALOCTFILEDIR); -} - -static void -set_default_local_ver_fcn_file_dir (void) -{ - Vlocal_ver_fcn_file_dir = subst_octave_home (OCTAVE_LOCALVERFCNFILEDIR); -} - -static void -set_default_local_api_fcn_file_dir (void) -{ - Vlocal_api_fcn_file_dir = subst_octave_home (OCTAVE_LOCALAPIFCNFILEDIR); -} - -static void -set_default_local_fcn_file_dir (void) -{ - Vlocal_fcn_file_dir = subst_octave_home (OCTAVE_LOCALFCNFILEDIR); -} - -static void -set_default_fcn_file_dir (void) -{ - Vfcn_file_dir = subst_octave_home (OCTAVE_FCNFILEDIR); -} - -static void -set_default_image_dir (void) -{ - Vimage_dir = subst_octave_home (OCTAVE_IMAGEDIR); -} - -static void -set_default_oct_etc_dir (void) -{ - Voct_etc_dir = subst_octave_home (OCTAVE_OCTETCDIR); -} - -static void -set_default_oct_locale_dir (void) -{ - Voct_locale_dir = subst_octave_home (OCTAVE_OCTLOCALEDIR); -} - -static void -set_default_oct_file_dir (void) -{ - Voct_file_dir = subst_octave_home (OCTAVE_OCTFILEDIR); -} - -static void -set_default_bin_dir (void) -{ - Vbin_dir = subst_octave_home (OCTAVE_BINDIR); -} - -void -set_exec_path (const std::string& path_arg) -{ - std::string tpath = path_arg; - - if (tpath.empty ()) - tpath = octave_env::getenv ("OCTAVE_EXEC_PATH"); - - if (tpath.empty ()) - tpath = Vlocal_ver_arch_lib_dir + dir_path::path_sep_str () - + Vlocal_api_arch_lib_dir + dir_path::path_sep_str () - + Vlocal_arch_lib_dir + dir_path::path_sep_str () - + Varch_lib_dir + dir_path::path_sep_str () - + Vbin_dir; - - VEXEC_PATH = tpath; - - // FIXME -- should we really be modifying PATH in the environment? - // The way things are now, Octave will ignore directories set in the - // PATH with calls like - // - // setenv ("PATH", "/my/path"); - // - // To fix this, I think Octave should be searching the combination of - // PATH and EXEC_PATH for programs that it executes instead of setting - // the PATH in the environment and relying on the shell to do the - // searching. - - // This is static so that even if set_exec_path is called more than - // once, shell_path is the original PATH from the environment, - // before we start modifying it. - static std::string shell_path = octave_env::getenv ("PATH"); - - if (! shell_path.empty ()) - tpath = shell_path + dir_path::path_sep_str () + tpath; - - octave_env::putenv ("PATH", tpath); -} - -void -set_image_path (const std::string& path) -{ - VIMAGE_PATH = "."; - - std::string tpath = path; - - if (tpath.empty ()) - tpath = octave_env::getenv ("OCTAVE_IMAGE_PATH"); - - if (! tpath.empty ()) - VIMAGE_PATH += dir_path::path_sep_str () + tpath; - - tpath = genpath (Vimage_dir, ""); - - if (! tpath.empty ()) - VIMAGE_PATH += dir_path::path_sep_str () + tpath; -} - -static void -set_default_doc_cache_file (void) -{ - if (Vdoc_cache_file.empty ()) - { - std::string def_file = subst_octave_home (OCTAVE_DOC_CACHE_FILE); - - std::string env_file = octave_env::getenv ("OCTAVE_DOC_CACHE_FILE"); - - Vdoc_cache_file = env_file.empty () ? def_file : env_file; - } -} - -static void -set_default_texi_macros_file (void) -{ - if (Vtexi_macros_file.empty ()) - { - std::string def_file = subst_octave_home (OCTAVE_TEXI_MACROS_FILE); - - std::string env_file = octave_env::getenv ("OCTAVE_TEXI_MACROS_FILE"); - - Vtexi_macros_file = env_file.empty () ? def_file : env_file; - } -} - -static void -set_default_info_file (void) -{ - if (Vinfo_file.empty ()) - { - std::string std_info_file = subst_octave_home (OCTAVE_INFOFILE); - - std::string oct_info_file = octave_env::getenv ("OCTAVE_INFO_FILE"); - - Vinfo_file = oct_info_file.empty () ? std_info_file : oct_info_file; - } -} - -static void -set_default_info_prog (void) -{ - if (Vinfo_program.empty ()) - { - std::string oct_info_prog = octave_env::getenv ("OCTAVE_INFO_PROGRAM"); - - if (oct_info_prog.empty ()) - Vinfo_program = "info"; - else - Vinfo_program = std::string (oct_info_prog); - } -} - -static void -set_default_editor (void) -{ - VEDITOR = "emacs"; - - std::string env_editor = octave_env::getenv ("EDITOR"); - - if (! env_editor.empty ()) - VEDITOR = env_editor; -} - -static void -set_local_site_defaults_file (void) -{ - std::string lsf = octave_env::getenv ("OCTAVE_SITE_INITFILE"); - - if (lsf.empty ()) - { - Vlocal_site_defaults_file = subst_octave_home (OCTAVE_LOCALSTARTUPFILEDIR); - Vlocal_site_defaults_file.append ("/octaverc"); - } - else - Vlocal_site_defaults_file = lsf; -} - -static void -set_site_defaults_file (void) -{ - std::string sf = octave_env::getenv ("OCTAVE_VERSION_INITFILE"); - - if (sf.empty ()) - { - Vsite_defaults_file = subst_octave_home (OCTAVE_STARTUPFILEDIR); - Vsite_defaults_file.append ("/octaverc"); - } - else - Vsite_defaults_file = sf; -} - -static void -set_built_in_docstrings_file (void) -{ - if (Vbuilt_in_docstrings_file.empty ()) - { - std::string df = octave_env::getenv ("OCTAVE_BUILT_IN_DOCSTRINGS_FILE"); - - if (df.empty ()) - Vbuilt_in_docstrings_file - = Voct_etc_dir + file_ops::dir_sep_str () + "built-in-docstrings"; - else - Vbuilt_in_docstrings_file = df; - } -} - -void -install_defaults (void) -{ - // OCTAVE_HOME must be set first! - - set_octave_home (); - - set_default_info_dir (); - - set_default_data_dir (); - - set_default_libexec_dir (); - - set_default_arch_lib_dir (); - - set_default_local_ver_arch_lib_dir (); - set_default_local_api_arch_lib_dir (); - set_default_local_arch_lib_dir (); - - set_default_local_ver_oct_file_dir (); - set_default_local_api_oct_file_dir (); - set_default_local_oct_file_dir (); - - set_default_local_ver_fcn_file_dir (); - set_default_local_api_fcn_file_dir (); - set_default_local_fcn_file_dir (); - - set_default_oct_etc_dir (); - set_default_oct_locale_dir (); - - set_default_fcn_file_dir (); - set_default_oct_file_dir (); - - set_default_image_dir (); - - set_default_bin_dir (); - - set_exec_path (); - - set_image_path (); - - set_default_doc_cache_file (); - - set_default_texi_macros_file (); - - set_default_info_file (); - - set_default_info_prog (); - - set_default_editor (); - - set_local_site_defaults_file (); - - set_site_defaults_file (); - - set_built_in_docstrings_file (); -} - -DEFUN (EDITOR, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} EDITOR ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} EDITOR (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} EDITOR (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the editor to\n\ -use with the @code{edit_history} command. The default value is taken from\n\ -the environment variable @w{@env{EDITOR}} when Octave starts. If the\n\ -environment variable is not initialized, @w{@env{EDITOR}} will be set to\n\ -@code{\"emacs\"}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{edit_history}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (EDITOR); -} - -/* -%!test -%! orig_val = EDITOR (); -%! old_val = EDITOR ("X"); -%! assert (orig_val, old_val); -%! assert (EDITOR (), "X"); -%! EDITOR (orig_val); -%! assert (EDITOR (), orig_val); - -%!error (EDITOR (1, 2)) -*/ - -DEFUN (EXEC_PATH, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} EXEC_PATH ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} EXEC_PATH (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} EXEC_PATH (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies a colon separated\n\ -list of directories to append to the shell PATH when executing external\n\ -programs. The initial value of is taken from the environment variable\n\ -@w{@env{OCTAVE_EXEC_PATH}}, but that value can be overridden by\n\ -the command line argument @option{--exec-path PATH}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - octave_value retval = SET_NONEMPTY_INTERNAL_STRING_VARIABLE (EXEC_PATH); - - if (args.length () > 0) - set_exec_path (VEXEC_PATH); - - return retval; -} - -/* -%!test -%! orig_val = EXEC_PATH (); -%! old_val = EXEC_PATH ("X"); -%! assert (orig_val, old_val); -%! assert (EXEC_PATH (), "X"); -%! EXEC_PATH (orig_val); -%! assert (EXEC_PATH (), orig_val); - -%!error (EXEC_PATH (1, 2)) -*/ - -DEFUN (IMAGE_PATH, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} IMAGE_PATH ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} IMAGE_PATH (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} IMAGE_PATH (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies a colon separated\n\ -list of directories in which to search for image files.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (IMAGE_PATH); -} - -/* -%!test -%! orig_val = IMAGE_PATH (); -%! old_val = IMAGE_PATH ("X"); -%! assert (orig_val, old_val); -%! assert (IMAGE_PATH (), "X"); -%! IMAGE_PATH (orig_val); -%! assert (IMAGE_PATH (), orig_val); - -%!error (IMAGE_PATH (1, 2)) -*/ - -DEFUN (OCTAVE_HOME, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} OCTAVE_HOME ()\n\ -Return the name of the top-level Octave installation directory.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 0) - retval = Voctave_home; - else - print_usage (); - - return retval; -} - -/* -%!assert (ischar (OCTAVE_HOME ())) -%!error OCTAVE_HOME (1) -*/ - -DEFUNX ("OCTAVE_VERSION", FOCTAVE_VERSION, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} OCTAVE_VERSION ()\n\ -Return the version number of Octave, as a string.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - retval = OCTAVE_VERSION; - else - print_usage (); - - return retval; -} - -/* -%!assert (ischar (OCTAVE_VERSION ())) -%!error OCTAVE_VERSION (1) -*/ diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/defaults.in.h --- a/libinterp/interpfcn/defaults.in.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,231 +0,0 @@ -// %NO_EDIT_WARNING% -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_defaults_h) -#define octave_defaults_h 1 - -#include - -#include "pathsearch.h" - -#ifndef OCTAVE_CANONICAL_HOST_TYPE -#define OCTAVE_CANONICAL_HOST_TYPE %OCTAVE_CANONICAL_HOST_TYPE% -#endif - -#ifndef OCTAVE_DEFAULT_PAGER -#define OCTAVE_DEFAULT_PAGER %OCTAVE_DEFAULT_PAGER% -#endif - -#ifndef OCTAVE_ARCHLIBDIR -#define OCTAVE_ARCHLIBDIR %OCTAVE_ARCHLIBDIR% -#endif - -#ifndef OCTAVE_BINDIR -#define OCTAVE_BINDIR %OCTAVE_BINDIR% -#endif - -#ifndef OCTAVE_DATADIR -#define OCTAVE_DATADIR %OCTAVE_DATADIR% -#endif - -#ifndef OCTAVE_DATAROOTDIR -#define OCTAVE_DATAROOTDIR %OCTAVE_DATAROOTDIR% -#endif - -#ifndef OCTAVE_DOC_CACHE_FILE -#define OCTAVE_DOC_CACHE_FILE %OCTAVE_DOC_CACHE_FILE% -#endif - -#ifndef OCTAVE_TEXI_MACROS_FILE -#define OCTAVE_TEXI_MACROS_FILE %OCTAVE_TEXI_MACROS_FILE% -#endif - -#ifndef OCTAVE_EXEC_PREFIX -#define OCTAVE_EXEC_PREFIX %OCTAVE_EXEC_PREFIX% -#endif - -#ifndef OCTAVE_FCNFILEDIR -#define OCTAVE_FCNFILEDIR %OCTAVE_FCNFILEDIR% -#endif - -#ifndef OCTAVE_IMAGEDIR -#define OCTAVE_IMAGEDIR %OCTAVE_IMAGEDIR% -#endif - -#ifndef OCTAVE_INCLUDEDIR -#define OCTAVE_INCLUDEDIR %OCTAVE_INCLUDEDIR% -#endif - -#ifndef OCTAVE_INFODIR -#define OCTAVE_INFODIR %OCTAVE_INFODIR% -#endif - -#ifndef OCTAVE_INFOFILE -#define OCTAVE_INFOFILE %OCTAVE_INFOFILE% -#endif - -#ifndef OCTAVE_LIBDIR -#define OCTAVE_LIBDIR %OCTAVE_LIBDIR% -#endif - -#ifndef OCTAVE_LIBEXECDIR -#define OCTAVE_LIBEXECDIR %OCTAVE_LIBEXECDIR% -#endif - -#ifndef OCTAVE_LIBEXECDIR -#define OCTAVE_LIBEXECDIR %OCTAVE_LIBEXECDIR% -#endif - -#ifndef OCTAVE_LOCALAPIFCNFILEDIR -#define OCTAVE_LOCALAPIFCNFILEDIR %OCTAVE_LOCALAPIFCNFILEDIR% -#endif - -#ifndef OCTAVE_LOCALAPIOCTFILEDIR -#define OCTAVE_LOCALAPIOCTFILEDIR %OCTAVE_LOCALAPIOCTFILEDIR% -#endif - -#ifndef OCTAVE_LOCALARCHLIBDIR -#define OCTAVE_LOCALARCHLIBDIR %OCTAVE_LOCALARCHLIBDIR% -#endif - -#ifndef OCTAVE_LOCALFCNFILEDIR -#define OCTAVE_LOCALFCNFILEDIR %OCTAVE_LOCALFCNFILEDIR% -#endif - -#ifndef OCTAVE_LOCALOCTFILEDIR -#define OCTAVE_LOCALOCTFILEDIR %OCTAVE_LOCALOCTFILEDIR% -#endif - -#ifndef OCTAVE_LOCALSTARTUPFILEDIR -#define OCTAVE_LOCALSTARTUPFILEDIR %OCTAVE_LOCALSTARTUPFILEDIR% -#endif - -#ifndef OCTAVE_LOCALAPIARCHLIBDIR -#define OCTAVE_LOCALAPIARCHLIBDIR %OCTAVE_LOCALAPIARCHLIBDIR% -#endif - -#ifndef OCTAVE_LOCALVERARCHLIBDIR -#define OCTAVE_LOCALVERARCHLIBDIR %OCTAVE_LOCALVERARCHLIBDIR% -#endif - -#ifndef OCTAVE_LOCALVERFCNFILEDIR -#define OCTAVE_LOCALVERFCNFILEDIR %OCTAVE_LOCALVERFCNFILEDIR% -#endif - -#ifndef OCTAVE_LOCALVEROCTFILEDIR -#define OCTAVE_LOCALVEROCTFILEDIR %OCTAVE_LOCALVEROCTFILEDIR% -#endif - -#ifndef OCTAVE_MAN1DIR -#define OCTAVE_MAN1DIR %OCTAVE_MAN1DIR% -#endif - -#ifndef OCTAVE_MAN1EXT -#define OCTAVE_MAN1EXT %OCTAVE_MAN1EXT% -#endif - -#ifndef OCTAVE_MANDIR -#define OCTAVE_MANDIR %OCTAVE_MANDIR% -#endif - -#ifndef OCTAVE_OCTFILEDIR -#define OCTAVE_OCTFILEDIR %OCTAVE_OCTFILEDIR% -#endif - -#ifndef OCTAVE_OCTETCDIR -#define OCTAVE_OCTETCDIR %OCTAVE_OCTETCDIR% -#endif - -#ifndef OCTAVE_OCTLOCALEDIR -#define OCTAVE_OCTLOCALEDIR %OCTAVE_OCTLOCALEDIR% -#endif - -#ifndef OCTAVE_OCTINCLUDEDIR -#define OCTAVE_OCTINCLUDEDIR %OCTAVE_OCTINCLUDEDIR% -#endif - -#ifndef OCTAVE_OCTLIBDIR -#define OCTAVE_OCTLIBDIR %OCTAVE_OCTLIBDIR% -#endif - -#ifndef OCTAVE_OCTTESTSDIR -#define OCTAVE_OCTTESTSDIR %OCTAVE_OCTTESTSDIR% -#endif - -#ifndef OCTAVE_PREFIX -#define OCTAVE_PREFIX %OCTAVE_PREFIX% -#endif - -#ifndef OCTAVE_STARTUPFILEDIR -#define OCTAVE_STARTUPFILEDIR %OCTAVE_STARTUPFILEDIR% -#endif - -#ifndef OCTAVE_RELEASE -#define OCTAVE_RELEASE %OCTAVE_RELEASE% -#endif - -extern OCTINTERP_API std::string Voctave_home; - -extern OCTINTERP_API std::string Vbin_dir; -extern OCTINTERP_API std::string Vinfo_dir; -extern OCTINTERP_API std::string Vdata_dir; -extern OCTINTERP_API std::string Vlibexec_dir; -extern OCTINTERP_API std::string Varch_lib_dir; -extern OCTINTERP_API std::string Vlocal_arch_lib_dir; -extern OCTINTERP_API std::string Vlocal_ver_arch_lib_dir; - -extern OCTINTERP_API std::string Vlocal_ver_oct_file_dir; -extern OCTINTERP_API std::string Vlocal_api_oct_file_dir; -extern OCTINTERP_API std::string Vlocal_oct_file_dir; - -extern OCTINTERP_API std::string Vlocal_ver_fcn_file_dir; -extern OCTINTERP_API std::string Vlocal_api_fcn_file_dir; -extern OCTINTERP_API std::string Vlocal_fcn_file_dir; - -extern OCTINTERP_API std::string Voct_etc_dir; -extern OCTINTERP_API std::string Voct_locale_dir; - -extern OCTINTERP_API std::string Voct_file_dir; -extern OCTINTERP_API std::string Vfcn_file_dir; - -extern OCTINTERP_API std::string Vimage_dir; - -// Name of the editor to be invoked by the edit_history command. -extern OCTINTERP_API std::string VEDITOR; - -extern OCTINTERP_API std::string Vlocal_site_defaults_file; -extern OCTINTERP_API std::string Vsite_defaults_file; - -extern OCTINTERP_API std::string Vbuilt_in_docstrings_file; - -// Name of the FFTW wisdom program. -extern OCTINTERP_API std::string Vfftw_wisdom_program; - -extern OCTINTERP_API std::string subst_octave_home (const std::string&); - -extern OCTINTERP_API void install_defaults (void); - -extern OCTINTERP_API void set_exec_path (const std::string& path = std::string ()); -extern OCTINTERP_API void set_image_path (const std::string& path = std::string ()); - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/defun.cc --- a/libinterp/interpfcn/defun.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,200 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include "defun.h" -#include "dynamic-ld.h" -#include "error.h" -#include "help.h" -#include "ov.h" -#include "ov-builtin.h" -#include "ov-dld-fcn.h" -#include "ov-fcn.h" -#include "ov-mex-fcn.h" -#include "ov-usr-fcn.h" -#include "oct-obj.h" -#include "oct-lvalue.h" -#include "pager.h" -#include "symtab.h" -#include "toplev.h" -#include "variables.h" -#include "parse.h" - -// Print the usage part of the doc string of FCN (user-defined or DEFUN). -void -print_usage (void) -{ - const octave_function *cur = octave_call_stack::current (); - if (cur) - print_usage (cur->name ()); - else - error ("print_usage: invalid function"); -} - -void -print_usage (const std::string& name) -{ - feval ("print_usage", octave_value (name), 0); -} - -void -check_version (const std::string& version, const std::string& fcn) -{ - if (version != OCTAVE_API_VERSION) - { - error ("API version %s found in .oct file function '%s'\n" - " does not match the running Octave (API version %s)\n" - " this can lead to incorrect results or other failures\n" - " you can fix this problem by recompiling this .oct file", - version.c_str (), fcn.c_str (), OCTAVE_API_VERSION); - } -} - -// Install variables and functions in the symbol tables. - -void -install_builtin_function (octave_builtin::fcn f, const std::string& name, - const std::string& file, const std::string& doc, - bool /* can_hide_function -- not yet implemented */) -{ - octave_value fcn (new octave_builtin (f, name, file, doc)); - - symbol_table::install_built_in_function (name, fcn); -} - -void -install_dld_function (octave_dld_function::fcn f, const std::string& name, - const octave_shlib& shl, const std::string& doc, - bool relative) -{ - octave_dld_function *fcn = new octave_dld_function (f, shl, name, doc); - - if (relative) - fcn->mark_relative (); - - octave_value fval (fcn); - - symbol_table::install_built_in_function (name, fval); -} - -void -install_mex_function (void *fptr, bool fmex, const std::string& name, - const octave_shlib& shl, bool relative) -{ - octave_mex_function *fcn = new octave_mex_function (fptr, fmex, shl, name); - - if (relative) - fcn->mark_relative (); - - octave_value fval (fcn); - - symbol_table::install_built_in_function (name, fval); -} - -void -alias_builtin (const std::string& alias, const std::string& name) -{ - symbol_table::alias_built_in_function (alias, name); -} - -octave_shlib -get_current_shlib (void) -{ - octave_shlib retval; - - octave_function *curr_fcn = octave_call_stack::current (); - if (curr_fcn) - { - if (curr_fcn->is_dld_function ()) - { - octave_dld_function *dld = dynamic_cast (curr_fcn); - retval = dld->get_shlib (); - } - else if (curr_fcn->is_mex_function ()) - { - octave_mex_function *mex = dynamic_cast (curr_fcn); - retval = mex->get_shlib (); - } - } - - return retval; -} - -bool defun_isargout (int nargout, int iout) -{ - const std::list *lvalue_list = octave_builtin::curr_lvalue_list; - if (iout >= std::max (nargout, 1)) - return false; - else if (lvalue_list) - { - int k = 0; - for (std::list::const_iterator p = lvalue_list->begin (); - p != lvalue_list->end (); p++) - { - if (k == iout) - return ! p->is_black_hole (); - k += p->numel (); - if (k > iout) - break; - } - - return true; - } - else - return true; -} - -void defun_isargout (int nargout, int nout, bool *isargout) -{ - const std::list *lvalue_list = octave_builtin::curr_lvalue_list; - if (lvalue_list) - { - int k = 0; - for (std::list::const_iterator p = lvalue_list->begin (); - p != lvalue_list->end () && k < nout; p++) - { - if (p->is_black_hole ()) - isargout[k++] = false; - else - { - int l = std::min (k + p->numel (), - static_cast (nout)); - while (k < l) - isargout[k++] = true; - } - } - } - else - for (int i = 0; i < nout; i++) - isargout[i] = true; - - for (int i = std::max (nargout, 1); i < nout; i++) - isargout[i] = false; -} - diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/defun.h --- a/libinterp/interpfcn/defun.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,66 +0,0 @@ -/* - -Copyright (C) 1994-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_defun_h) -#define octave_defun_h 1 - -#if defined (octave_defun_dld_h) -#error defun.h and defun-dld.h both included in same file! -#endif - -#include "defun-int.h" - -// Define a builtin function. -// -// name is the name of the function, unqouted. -// -// args_name is the name of the octave_value_list variable used to pass -// the argument list to this function. -// -// nargout_name is the name of the int variable used to pass the -// number of output arguments this function is expected to produce. -// -// doc is the simple help text for the function. - -#define DEFUN(name, args_name, nargout_name, doc) \ - DEFUN_INTERNAL (name, args_name, nargout_name, doc) - -// This one can be used when 'name' cannot be used directly (if it is -// already defined as a macro). In that case, name is already a -// quoted string, and the internal name of the function must be passed -// too (the convention is to use a prefix of "F", so "foo" becomes "Ffoo"). - -#define DEFUNX(name, fname, args_name, nargout_name, doc) \ - DEFUNX_INTERNAL (name, fname, args_name, nargout_name, doc) - -// This is a function with a name that can't be hidden by a variable. -#define DEFCONSTFUN(name, args_name, nargout_name, doc) \ - DEFCONSTFUN_INTERNAL (name, args_name, nargout_name, doc) - -// Make alias another name for the existing function name. This macro -// must be used in the same file where name is defined, after the -// definition for name. - -#define DEFALIAS(alias, name) \ - DEFALIAS_INTERNAL (alias, name) - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/dirfns.cc --- a/libinterp/interpfcn/dirfns.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,789 +0,0 @@ -/* - -Copyright (C) 1994-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include -#include -#include - -#include -#include - -#include -#include - -#include "file-ops.h" -#include "file-stat.h" -#include "glob-match.h" -#include "oct-env.h" -#include "pathsearch.h" -#include "str-vec.h" - -#include "Cell.h" -#include "defun.h" -#include "dir-ops.h" -#include "dirfns.h" -#include "error.h" -#include "gripes.h" -#include "input.h" -#include "load-path.h" -#include "octave-link.h" -#include "oct-obj.h" -#include "pager.h" -#include "procstream.h" -#include "sysdep.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" - -// TRUE means we ask for confirmation before recursively removing a -// directory tree. -static bool Vconfirm_recursive_rmdir = true; - -// The time we last time we changed directories. -octave_time Vlast_chdir_time = 0.0; - -static int -octave_change_to_directory (const std::string& newdir) -{ - std::string xdir = file_ops::tilde_expand (newdir); - - int cd_ok = octave_env::chdir (xdir); - - if (cd_ok) - { - Vlast_chdir_time.stamp (); - - // FIXME -- should these actions be handled as a list of functions - // to call so users can add their own chdir handlers? - - load_path::update (); - - octave_link::change_directory (octave_env::get_current_directory ()); - } - else - error ("%s: %s", newdir.c_str (), gnulib::strerror (errno)); - - return cd_ok; -} - -DEFUN (cd, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Command} {} cd dir\n\ -@deftypefnx {Command} {} chdir dir\n\ -Change the current working directory to @var{dir}. If @var{dir} is\n\ -omitted, the current directory is changed to the user's home\n\ -directory. For example,\n\ -\n\ -@example\n\ -cd ~/octave\n\ -@end example\n\ -\n\ -@noindent\n\ -changes the current working directory to @file{~/octave}. If the\n\ -directory does not exist, an error message is printed and the working\n\ -directory is not changed.\n\ -@seealso{mkdir, rmdir, dir}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("cd"); - - if (error_state) - return retval; - - if (argc > 1) - { - std::string dirname = argv[1]; - - if (dirname.length () > 0 - && ! octave_change_to_directory (dirname)) - { - return retval; - } - } - else - { - // Behave like Unixy shells for "cd" by itself, but be Matlab - // compatible if doing "current_dir = cd". - - if (nargout == 0) - { - std::string home_dir = octave_env::get_home_directory (); - - if (home_dir.empty () || ! octave_change_to_directory (home_dir)) - return retval; - } - else - retval = octave_value (octave_env::get_current_directory ()); - } - - return retval; -} - -DEFALIAS (chdir, cd); - -DEFUN (pwd, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} pwd ()\n\ -Return the current working directory.\n\ -@seealso{dir, ls}\n\ -@end deftypefn") -{ - return octave_value (octave_env::get_current_directory ()); -} - -DEFUN (readdir, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{files}, @var{err}, @var{msg}] =} readdir (@var{dir})\n\ -Return names of the files in the directory @var{dir} as a cell array of\n\ -strings. If an error occurs, return an empty cell array in @var{files}.\n\ -\n\ -If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ -Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ -system-dependent error message.\n\ -@seealso{ls, dir, glob}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(2) = std::string (); - retval(1) = -1.0; - retval(0) = Cell (); - - if (args.length () == 1) - { - std::string dirname = args(0).string_value (); - - if (error_state) - gripe_wrong_type_arg ("readdir", args(0)); - else - { - dir_entry dir (dirname); - - if (dir) - { - string_vector dirlist = dir.read (); - retval(1) = 0.0; - retval(0) = Cell (dirlist.sort ()); - } - else - { - retval(2) = dir.error (); - } - } - } - else - print_usage (); - - return retval; -} - -// FIXME -- should maybe also allow second arg to specify -// mode? OTOH, that might cause trouble with compatibility later... - -DEFUNX ("mkdir", Fmkdir, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} mkdir (@var{dir})\n\ -@deftypefnx {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} mkdir (@var{parent}, @var{dir})\n\ -Create a directory named @var{dir} in the directory @var{parent}.\n\ -\n\ -If successful, @var{status} is 1, with @var{msg} and @var{msgid} empty\n\ -character strings. Otherwise, @var{status} is 0, @var{msg} contains a\n\ -system-dependent error message, and @var{msgid} contains a unique\n\ -message identifier.\n\ -@seealso{rmdir}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(2) = std::string (); - retval(1) = std::string (); - retval(0) = false; - - int nargin = args.length (); - - std::string dirname; - - if (nargin == 2) - { - std::string parent = args(0).string_value (); - std::string dir = args(1).string_value (); - - if (error_state) - { - gripe_wrong_type_arg ("mkdir", args(0)); - return retval; - } - else - dirname = file_ops::concat (parent, dir); - } - else if (nargin == 1) - { - dirname = args(0).string_value (); - - if (error_state) - { - gripe_wrong_type_arg ("mkdir", args(0)); - return retval; - } - } - - if (nargin == 1 || nargin == 2) - { - std::string msg; - - dirname = file_ops::tilde_expand (dirname); - - file_stat fs (dirname); - - if (fs && fs.is_dir ()) - { - // For compatibility with Matlab, we return true when the - // directory already exists. - - retval(2) = "mkdir"; - retval(1) = "directory exists"; - retval(0) = true; - } - else - { - int status = octave_mkdir (dirname, 0777, msg); - - if (status < 0) - { - retval(2) = "mkdir"; - retval(1) = msg; - } - else - retval(0) = true; - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("rmdir", Frmdir, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} rmdir (@var{dir})\n\ -@deftypefnx {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} rmdir (@var{dir}, \"s\")\n\ -Remove the directory named @var{dir}.\n\ -\n\ -If successful, @var{status} is 1, with @var{msg} and @var{msgid} empty\n\ -character strings. Otherwise, @var{status} is 0, @var{msg} contains a\n\ -system-dependent error message, and @var{msgid} contains a unique\n\ -message identifier.\n\ -\n\ -If the optional second parameter is supplied with value @code{\"s\"},\n\ -recursively remove all subdirectories as well.\n\ -@seealso{mkdir, confirm_recursive_rmdir}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(2) = std::string (); - retval(1) = std::string (); - retval(0) = false; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - std::string dirname = args(0).string_value (); - - if (error_state) - gripe_wrong_type_arg ("rmdir", args(0)); - else - { - std::string fulldir = file_ops::tilde_expand (dirname); - int status = -1; - std::string msg; - - if (nargin == 2) - { - if (args(1).string_value () == "s") - { - bool doit = true; - - if (interactive && Vconfirm_recursive_rmdir) - { - std::string prompt - = "remove entire contents of " + fulldir + "? "; - - doit = octave_yes_or_no (prompt); - } - - if (doit) - status = octave_recursive_rmdir (fulldir, msg); - } - else - error ("rmdir: expecting second argument to be \"s\""); - } - else - status = octave_rmdir (fulldir, msg); - - if (status < 0) - { - retval(2) = "rmdir"; - retval(1) = msg; - } - else - retval(0) = true; - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("link", Flink, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} link (@var{old}, @var{new})\n\ -Create a new link (also known as a hard link) to an existing file.\n\ -\n\ -If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ -Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ -system-dependent error message.\n\ -@seealso{symlink}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1.0; - - if (args.length () == 2) - { - std::string from = args(0).string_value (); - - if (error_state) - gripe_wrong_type_arg ("link", args(0)); - else - { - std::string to = args(1).string_value (); - - if (error_state) - gripe_wrong_type_arg ("link", args(1)); - else - { - std::string msg; - - int status = octave_link (from, to, msg); - - retval(0) = status; - - if (status < 0) - retval(1) = msg; - } - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("symlink", Fsymlink, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} symlink (@var{old}, @var{new})\n\ -Create a symbolic link @var{new} which contains the string @var{old}.\n\ -\n\ -If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ -Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ -system-dependent error message.\n\ -@seealso{link, readlink}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1.0; - - if (args.length () == 2) - { - std::string from = args(0).string_value (); - - if (error_state) - gripe_wrong_type_arg ("symlink", args(0)); - else - { - std::string to = args(1).string_value (); - - if (error_state) - gripe_wrong_type_arg ("symlink", args(1)); - else - { - std::string msg; - - int status = octave_symlink (from, to, msg); - - retval(0) = status; - - if (status < 0) - retval(1) = msg; - } - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("readlink", Freadlink, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{result}, @var{err}, @var{msg}] =} readlink (@var{symlink})\n\ -Read the value of the symbolic link @var{symlink}.\n\ -\n\ -If successful, @var{result} contains the contents of the symbolic link\n\ -@var{symlink}, @var{err} is 0 and @var{msg} is an empty string.\n\ -Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ -system-dependent error message.\n\ -@seealso{link, symlink}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(2) = std::string (); - retval(1) = -1.0; - retval(0) = std::string (); - - if (args.length () == 1) - { - std::string symlink = args(0).string_value (); - - if (error_state) - gripe_wrong_type_arg ("readlink", args(0)); - else - { - std::string result; - std::string msg; - - int status = octave_readlink (symlink, result, msg); - - if (status < 0) - retval(2) = msg; - retval(1) = status; - retval(0) = result; - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("rename", Frename, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} rename (@var{old}, @var{new})\n\ -Change the name of file @var{old} to @var{new}.\n\ -\n\ -If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ -Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ -system-dependent error message.\n\ -@seealso{ls, dir}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1.0; - - if (args.length () == 2) - { - std::string from = args(0).string_value (); - - if (error_state) - gripe_wrong_type_arg ("rename", args(0)); - else - { - std::string to = args(1).string_value (); - - if (error_state) - gripe_wrong_type_arg ("rename", args(1)); - else - { - std::string msg; - - int status = octave_rename (from, to, msg); - - retval(0) = status; - - if (status < 0) - retval(1) = msg; - } - } - } - else - print_usage (); - - return retval; -} - -DEFUN (glob, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} glob (@var{pattern})\n\ -Given an array of pattern strings (as a char array or a cell array) in\n\ -@var{pattern}, return a cell array of file names that match any of\n\ -them, or an empty cell array if no patterns match. The pattern strings are\n\ -interpreted as filename globbing patterns (as they are used by Unix shells).\n\ -Within a pattern\n\ -\n\ -@table @code\n\ -@item *\n\ -matches any string, including the null string,\n\ -\n\ -@item ?\n\ -matches any single character, and\n\ -\n\ -@item [@dots{}]\n\ -matches any of the enclosed characters.\n\ -@end table\n\ -\n\ -Tilde expansion\n\ -is performed on each of the patterns before looking for matching file\n\ -names. For example:\n\ -\n\ -@example\n\ -ls\n\ - @result{}\n\ - file1 file2 file3 myfile1 myfile1b\n\ -glob (\"*file1\")\n\ - @result{}\n\ - @{\n\ - [1,1] = file1\n\ - [2,1] = myfile1\n\ - @}\n\ -glob (\"myfile?\")\n\ - @result{}\n\ - @{\n\ - [1,1] = myfile1\n\ - @}\n\ -glob (\"file[12]\")\n\ - @result{}\n\ - @{\n\ - [1,1] = file1\n\ - [2,1] = file2\n\ - @}\n\ -@end example\n\ -@seealso{ls, dir, readdir}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - { - string_vector pat = args(0).all_strings (); - - if (error_state) - gripe_wrong_type_arg ("glob", args(0)); - else - { - glob_match pattern (file_ops::tilde_expand (pat)); - - retval = Cell (pattern.glob ()); - } - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! tmpdir = tmpnam; -%! filename = {"file1", "file2", "file3", "myfile1", "myfile1b"}; -%! if (mkdir (tmpdir)) -%! cwd = pwd; -%! cd (tmpdir); -%! if strcmp (canonicalize_file_name (pwd), canonicalize_file_name (tmpdir)) -%! a = 0; -%! for n = 1:5 -%! save (filename{n}, "a"); -%! endfor -%! else -%! rmdir (tmpdir); -%! error ("Couldn't change to temporary dir"); -%! endif -%! else -%! error ("Couldn't create temporary directory"); -%! endif -%! result1 = glob ("*file1"); -%! result2 = glob ("myfile?"); -%! result3 = glob ("file[12]"); -%! for n = 1:5 -%! delete (filename{n}); -%! endfor -%! cd (cwd); -%! rmdir (tmpdir); -%! assert (result1, {"file1"; "myfile1"}); -%! assert (result2, {"myfile1"}); -%! assert (result3, {"file1"; "file2"}); -*/ - -DEFUNX ("fnmatch", Ffnmatch, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fnmatch (@var{pattern}, @var{string})\n\ -Return 1 or zero for each element of @var{string} that matches any of\n\ -the elements of the string array @var{pattern}, using the rules of\n\ -filename pattern matching. For example:\n\ -\n\ -@example\n\ -@group\n\ -fnmatch (\"a*b\", @{\"ab\"; \"axyzb\"; \"xyzab\"@})\n\ - @result{} [ 1; 1; 0 ]\n\ -@end group\n\ -@end example\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 2) - { - string_vector pat = args(0).all_strings (); - string_vector str = args(1).all_strings (); - - if (error_state) - gripe_wrong_type_arg ("fnmatch", args(0)); - else - { - glob_match pattern (file_ops::tilde_expand (pat)); - - retval = pattern.match (str); - } - } - else - print_usage (); - - return retval; -} - -DEFUN (filesep, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} filesep ()\n\ -@deftypefnx {Built-in Function} {} filesep (\"all\")\n\ -Return the system-dependent character used to separate directory names.\n\ -\n\ -If \"all\" is given, the function returns all valid file separators in\n\ -the form of a string. The list of file separators is system-dependent.\n\ -It is @samp{/} (forward slash) under UNIX or @w{Mac OS X}, @samp{/} and\n\ -@samp{\\} (forward and backward slashes) under Windows.\n\ -@seealso{pathsep}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 0) - retval = file_ops::dir_sep_str (); - else if (args.length () == 1) - { - std::string s = args(0).string_value (); - - if (! error_state) - { - if (s == "all") - retval = file_ops::dir_sep_chars (); - else - gripe_wrong_type_arg ("filesep", args(0)); - } - else - gripe_wrong_type_arg ("filesep", args(0)); - } - else - print_usage (); - - return retval; -} - -DEFUN (pathsep, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} pathsep ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} pathsep (@var{new_val})\n\ -Query or set the character used to separate directories in a path.\n\ -@seealso{filesep}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargout > 0 || nargin == 0) - retval = dir_path::path_sep_str (); - - if (nargin == 1) - { - std::string sval = args(0).string_value (); - - if (! error_state) - { - switch (sval.length ()) - { - case 1: - dir_path::path_sep_char (sval[0]); - break; - - case 0: - dir_path::path_sep_char ('\0'); - break; - - default: - error ("pathsep: argument must be a single character"); - break; - } - } - else - error ("pathsep: argument must be a single character"); - } - else if (nargin > 1) - print_usage (); - - return retval; -} - -DEFUN (confirm_recursive_rmdir, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} confirm_recursive_rmdir ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} confirm_recursive_rmdir (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} confirm_recursive_rmdir (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave\n\ -will ask for confirmation before recursively removing a directory tree.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (confirm_recursive_rmdir); -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/dirfns.h --- a/libinterp/interpfcn/dirfns.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,35 +0,0 @@ -/* - -Copyright (C) 1994-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_dirfns_h) -#define octave_dirfns_h 1 - -#include - -#include - -#include "oct-time.h" - -// The time we last time we changed directories. -extern octave_time Vlast_chdir_time; - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/error.cc --- a/libinterp/interpfcn/error.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2040 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include -#include -#include - -#include "defun.h" -#include "error.h" -#include "input.h" -#include "pager.h" -#include "oct-obj.h" -#include "oct-map.h" -#include "utils.h" -#include "ov.h" -#include "ov-usr-fcn.h" -#include "pt-pr-code.h" -#include "pt-stmt.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "variables.h" - -// TRUE means that Octave will try to beep obnoxiously before printing -// error messages. -static bool Vbeep_on_error = false; - -// TRUE means that Octave will try to enter the debugger when an error -// is encountered. This will also inhibit printing of the normal -// traceback message (you will only see the top-level error message). -bool Vdebug_on_error = false; - -// TRUE means that Octave will try to enter the debugger when a warning -// is encountered. -bool Vdebug_on_warning = false; - -// TRUE means that Octave will try to display a stack trace when a -// warning is encountered. -static bool Vbacktrace_on_warning = false; - -// TRUE means that Octave will print a verbose warning. Currently unused. -static bool Vverbose_warning; - -// TRUE means that Octave will print no warnings, but lastwarn will be -//updated -static bool Vquiet_warning = false; - -// A structure containing (most of) the current state of warnings. -static octave_map warning_options; - -// The text of the last error message. -static std::string Vlast_error_message; - -// The text of the last warning message. -static std::string Vlast_warning_message; - -// The last warning message id. -static std::string Vlast_warning_id; - -// The last error message id. -static std::string Vlast_error_id; - -// The last file in which an error occured -static octave_map Vlast_error_stack; - -// Current error state. -// -// Valid values: -// -// -2: an error has occurred, but don't print any messages. -// -1: an error has occurred, we are printing a traceback -// 0: no error -// 1: an error has occurred -// -int error_state = 0; - -// Current warning state. -// -// Valid values: -// -// 0: no warning -// 1: a warning has occurred -// -int warning_state = 0; - -// Tell the error handler whether to print messages, or just store -// them for later. Used for handling errors in eval() and -// the 'unwind_protect' statement. -int buffer_error_messages = 0; - -// TRUE means error messages are turned off. -bool discard_error_messages = false; - -// TRUE means warning messages are turned off. -bool discard_warning_messages = false; - -void -reset_error_handler (void) -{ - error_state = 0; - warning_state = 0; - buffer_error_messages = 0; - discard_error_messages = false; -} - -static void -initialize_warning_options (const std::string& state) -{ - octave_scalar_map initw; - - initw.setfield ("identifier", "all"); - initw.setfield ("state", state); - - warning_options = initw; -} - -static octave_map -initialize_last_error_stack (void) -{ - return octave_call_stack::empty_backtrace (); -} - -// Warning messages are never buffered. - -static void -vwarning (const char *name, const char *id, const char *fmt, va_list args) -{ - if (discard_warning_messages) - return; - - flush_octave_stdout (); - - std::ostringstream output_buf; - - if (name) - output_buf << name << ": "; - - octave_vformat (output_buf, fmt, args); - - output_buf << std::endl; - - // FIXME -- we really want to capture the message before it - // has all the formatting goop attached to it. We probably also - // want just the message, not the traceback information. - - std::string msg_string = output_buf.str (); - - if (! warning_state) - { - // This is the first warning in a possible series. - - Vlast_warning_id = id; - Vlast_warning_message = msg_string; - } - - if (! Vquiet_warning) - { - octave_diary << msg_string; - - std::cerr << msg_string; - } -} - -static void -verror (bool save_last_error, std::ostream& os, - const char *name, const char *id, const char *fmt, va_list args, - bool with_cfn = false) -{ - if (discard_error_messages) - return; - - if (! buffer_error_messages) - flush_octave_stdout (); - - // FIXME -- we really want to capture the message before it - // has all the formatting goop attached to it. We probably also - // want just the message, not the traceback information. - - std::ostringstream output_buf; - - octave_vformat (output_buf, fmt, args); - - std::string base_msg = output_buf.str (); - - bool to_beep_or_not_to_beep_p = Vbeep_on_error && ! error_state; - - std::string msg_string; - - if (to_beep_or_not_to_beep_p) - msg_string = "\a"; - - if (name) - msg_string += std::string (name) + ": "; - - // If with_fcn is specified, we'll attempt to prefix the message with the name - // of the current executing function. But we'll do so only if: - // 1. the name is not empty (anonymous function) - // 2. it is not already there (including the following colon) - if (with_cfn) - { - octave_function *curfcn = octave_call_stack::current (); - if (curfcn) - { - std::string cfn = curfcn->name (); - if (! cfn.empty ()) - { - cfn += ':'; - if (cfn.length () > base_msg.length () - || base_msg.compare (0, cfn.length (), cfn) != 0) - { - msg_string += cfn + ' '; - } - } - } - } - - msg_string += base_msg + "\n"; - - if (! error_state && save_last_error) - { - // This is the first error in a possible series. - - Vlast_error_id = id; - Vlast_error_message = base_msg; - - octave_user_code *fcn = octave_call_stack::caller_user_code (); - - if (fcn) - { - octave_idx_type curr_frame = -1; - - Vlast_error_stack = octave_call_stack::backtrace (0, curr_frame); - } - else - Vlast_error_stack = initialize_last_error_stack (); - } - - if (! buffer_error_messages) - { - octave_diary << msg_string; - os << msg_string; - } -} - -// Note that we don't actually print any message if the error string -// is just "" or "\n". This allows error ("") and error ("\n") to -// just set the error state. - -static void -error_1 (std::ostream& os, const char *name, const char *id, - const char *fmt, va_list args, bool with_cfn = false) -{ - if (error_state != -2) - { - if (fmt) - { - if (*fmt) - { - size_t len = strlen (fmt); - - if (len > 0) - { - if (fmt[len - 1] == '\n') - { - if (len > 1) - { - char *tmp_fmt = strsave (fmt); - tmp_fmt[len - 1] = '\0'; - verror (true, os, name, id, tmp_fmt, args, with_cfn); - delete [] tmp_fmt; - } - - error_state = -2; - } - else - { - verror (true, os, name, id, fmt, args, with_cfn); - - if (! error_state) - error_state = 1; - } - } - } - } - else - panic ("error_1: invalid format"); - } -} - -void -vmessage (const char *name, const char *fmt, va_list args) -{ - verror (false, std::cerr, name, "", fmt, args); -} - -void -message (const char *name, const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - vmessage (name, fmt, args); - va_end (args); -} - -void -vmessage_with_id (const char *name, const char *id, const char *fmt, - va_list args) -{ - verror (false, std::cerr, name, id, fmt, args); -} - -void -message_with_id (const char *name, const char *id, const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - vmessage_with_id (name, id, fmt, args); - va_end (args); -} - -void -usage_1 (const char *id, const char *fmt, va_list args) -{ - verror (true, std::cerr, "usage", id, fmt, args); - error_state = -1; -} - -void -vusage (const char *fmt, va_list args) -{ - usage_1 ("", fmt, args); -} - -void -usage (const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - vusage (fmt, args); - va_end (args); -} - -void -vusage_with_id (const char *id, const char *fmt, va_list args) -{ - usage_1 (id, fmt, args); -} - -void -usage_with_id (const char *id, const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - vusage_with_id (id, fmt, args); - va_end (args); -} - -static void -pr_where_2 (const char *fmt, va_list args) -{ - if (fmt) - { - if (*fmt) - { - size_t len = strlen (fmt); - - if (len > 0) - { - if (fmt[len - 1] == '\n') - { - if (len > 1) - { - char *tmp_fmt = strsave (fmt); - tmp_fmt[len - 1] = '\0'; - verror (false, std::cerr, 0, "", tmp_fmt, args); - delete [] tmp_fmt; - } - } - else - verror (false, std::cerr, 0, "", fmt, args); - } - } - } - else - panic ("pr_where_2: invalid format"); -} - -static void -pr_where_1 (const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - pr_where_2 (fmt, args); - va_end (args); -} - -static void -pr_where (const char *who) -{ - octave_idx_type curr_frame = -1; - - octave_map stk = octave_call_stack::backtrace (0, curr_frame); - - octave_idx_type nframes_to_display = stk.numel (); - - if (nframes_to_display > 0) - { - pr_where_1 ("%s: called from\n", who); - - Cell names = stk.contents ("name"); - Cell lines = stk.contents ("line"); - Cell columns = stk.contents ("column"); - - for (octave_idx_type i = 0; i < nframes_to_display; i++) - { - octave_value name = names(i); - octave_value line = lines(i); - octave_value column = columns(i); - - std::string nm = name.string_value (); - - pr_where_1 (" %s at line %d column %d\n", nm.c_str (), - line.int_value (), column.int_value ()); - } - } -} - -static void -error_2 (const char *id, const char *fmt, va_list args, bool with_cfn = false) -{ - int init_state = error_state; - - error_1 (std::cerr, "error", id, fmt, args, with_cfn); - - if ((interactive || forced_interactive) - && Vdebug_on_error && init_state == 0 - && octave_call_stack::caller_user_code ()) - { - unwind_protect frame; - frame.protect_var (Vdebug_on_error); - Vdebug_on_error = false; - - error_state = 0; - - pr_where ("error"); - - do_keyboard (octave_value_list ()); - } -} - -void -verror (const char *fmt, va_list args) -{ - error_2 ("", fmt, args); -} - -void -error (const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - verror (fmt, args); - va_end (args); -} - -void -verror_with_cfn (const char *fmt, va_list args) -{ - error_2 ("", fmt, args, true); -} - -void -error_with_cfn (const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - verror_with_cfn (fmt, args); - va_end (args); -} - -void -verror_with_id (const char *id, const char *fmt, va_list args) -{ - error_2 (id, fmt, args); -} - -void -error_with_id (const char *id, const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - verror_with_id (id, fmt, args); - va_end (args); -} - -void -verror_with_id_cfn (const char *id, const char *fmt, va_list args) -{ - error_2 (id, fmt, args, true); -} - -void -error_with_id_cfn (const char *id, const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - verror_with_id_cfn (id, fmt, args); - va_end (args); -} - -static int -check_state (const std::string& state) -{ - // -1: not found - // 0: found, "off" - // 1: found, "on" - // 2: found, "error" - - if (state == "off") - return 0; - else if (state == "on") - return 1; - else if (state == "error") - return 2; - else - return -1; -} - -// For given warning ID, return 0 if warnings are disabled, 1 if -// enabled, and 2 if the given ID should be an error instead of a -// warning. - -int -warning_enabled (const std::string& id) -{ - int retval = 0; - - int all_state = -1; - int id_state = -1; - - octave_idx_type nel = warning_options.numel (); - - if (nel > 0) - { - Cell identifier = warning_options.contents ("identifier"); - Cell state = warning_options.contents ("state"); - - bool all_found = false; - bool id_found = false; - - for (octave_idx_type i = 0; i < nel; i++) - { - octave_value ov = identifier(i); - std::string ovs = ov.string_value (); - - if (! all_found && ovs == "all") - { - all_state = check_state (state(i).string_value ()); - - if (all_state >= 0) - all_found = true; - } - - if (! id_found && ovs == id) - { - id_state = check_state (state(i).string_value ()); - - if (id_state >= 0) - id_found = true; - } - - if (all_found && id_found) - break; - } - } - - // If "all" is not present, assume warnings are enabled. - if (all_state == -1) - all_state = 1; - - if (all_state == 0) - { - if (id_state >= 0) - retval = id_state; - } - else if (all_state == 1) - { - if (id_state == 0 || id_state == 2) - retval = id_state; - else - retval = all_state; - } - else if (all_state == 2) - { - if (id_state == 0) - retval= id_state; - else - retval = all_state; - } - - return retval; -} - -static void -warning_1 (const char *id, const char *fmt, va_list args) -{ - int warn_opt = warning_enabled (id); - - if (warn_opt == 2) - { - // Handle this warning as an error. - - error_2 (id, fmt, args); - } - else if (warn_opt == 1) - { - vwarning ("warning", id, fmt, args); - - if (! symbol_table::at_top_level () - && Vbacktrace_on_warning - && ! warning_state - && ! discard_warning_messages) - pr_where ("warning"); - - warning_state = 1; - - if ((interactive || forced_interactive) - && Vdebug_on_warning - && octave_call_stack::caller_user_code ()) - { - unwind_protect frame; - frame.protect_var (Vdebug_on_warning); - Vdebug_on_warning = false; - - do_keyboard (octave_value_list ()); - } - } -} - -void -vwarning (const char *fmt, va_list args) -{ - warning_1 ("", fmt, args); -} - -void -warning (const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - vwarning (fmt, args); - va_end (args); -} - -void -vwarning_with_id (const char *id, const char *fmt, va_list args) -{ - warning_1 (id, fmt, args); -} - -void -warning_with_id (const char *id, const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - vwarning_with_id (id, fmt, args); - va_end (args); -} - -void -vparse_error (const char *fmt, va_list args) -{ - error_1 (std::cerr, 0, "", fmt, args); -} - -void -parse_error (const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - vparse_error (fmt, args); - va_end (args); -} - -void -vparse_error_with_id (const char *id, const char *fmt, va_list args) -{ - error_1 (std::cerr, 0, id, fmt, args); -} - -void -parse_error_with_id (const char *id, const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - vparse_error_with_id (id, fmt, args); - va_end (args); -} - -void -rethrow_error (const char *id, const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - error_1 (std::cerr, 0, id, fmt, args); - va_end (args); -} - -void -panic (const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - buffer_error_messages = 0; - discard_error_messages = false; - verror (false, std::cerr, "panic", "", fmt, args); - va_end (args); - abort (); -} - -static void -defun_usage_message_1 (const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - error_1 (octave_stdout, 0, "", fmt, args); - va_end (args); -} - -void -defun_usage_message (const std::string& msg) -{ - defun_usage_message_1 ("%s", msg.c_str ()); -} - -typedef void (*error_fun)(const char *, const char *, ...); - -extern octave_value_list Fsprintf (const octave_value_list&, int); - -static std::string -handle_message (error_fun f, const char *id, const char *msg, - const octave_value_list& args, bool have_fmt) -{ - std::string retval; - - std::string tstr; - - int nargin = args.length (); - - if (nargin > 0) - { - octave_value arg; - - if (have_fmt) - { - octave_value_list tmp = Fsprintf (args, 1); - arg = tmp(0); - } - else - arg = args(0); - - if (arg.is_defined ()) - { - if (arg.is_string ()) - { - tstr = arg.string_value (); - msg = tstr.c_str (); - - if (! msg) - return retval; - } - else if (arg.is_empty ()) - return retval; - } - } - -// Ugh. - - size_t len = strlen (msg); - - if (len > 0) - { - if (msg[len - 1] == '\n') - { - if (len > 1) - { - char *tmp_msg = strsave (msg); - tmp_msg[len - 1] = '\0'; - f (id, "%s\n", tmp_msg); - retval = tmp_msg; - delete [] tmp_msg; - } - } - else - { - f (id, "%s", msg); - retval = msg; - } - } - - return retval; -} - -DEFUN (rethrow, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} rethrow (@var{err})\n\ -Reissue a previous error as defined by @var{err}. @var{err} is a structure\n\ -that must contain at least the 'message' and 'identifier' fields. @var{err}\n\ -can also contain a field 'stack' that gives information on the assumed\n\ -location of the error. Typically @var{err} is returned from\n\ -@code{lasterror}.\n\ -@seealso{lasterror, lasterr, error}\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - - if (nargin != 1) - print_usage (); - else - { - const octave_scalar_map err = args(0).scalar_map_value (); - - if (! error_state) - { - if (err.contains ("message") && err.contains ("identifier")) - { - std::string msg = err.contents ("message").string_value (); - std::string id = err.contents ("identifier").string_value (); - int len = msg.length (); - - std::string file; - std::string nm; - int l = -1; - int c = -1; - - octave_map err_stack = initialize_last_error_stack (); - - if (err.contains ("stack")) - { - err_stack = err.contents ("stack").map_value (); - - if (err_stack.numel () > 0) - { - if (err_stack.contains ("file")) - file = err_stack.contents ("file")(0).string_value (); - - if (err_stack.contains ("name")) - nm = err_stack.contents ("name")(0).string_value (); - - if (err_stack.contains ("line")) - l = err_stack.contents ("line")(0).nint_value (); - - if (err_stack.contains ("column")) - c = err_stack.contents ("column")(0).nint_value (); - } - } - - // Ugh. - char *tmp_msg = strsave (msg.c_str ()); - if (tmp_msg[len-1] == '\n') - { - if (len > 1) - { - tmp_msg[len - 1] = '\0'; - rethrow_error (id.c_str (), "%s\n", tmp_msg); - } - } - else - rethrow_error (id.c_str (), "%s", tmp_msg); - delete [] tmp_msg; - - // FIXME -- is this the right thing to do for - // Vlast_error_stack? Should it be saved and restored - // with unwind_protect? - - Vlast_error_stack = err_stack; - - if (err.contains ("stack")) - { - if (file.empty ()) - { - if (nm.empty ()) - { - if (l > 0) - { - if (c > 0) - pr_where_1 ("error: near line %d, column %d", - l, c); - else - pr_where_1 ("error: near line %d", l); - } - } - else - { - if (l > 0) - { - if (c > 0) - pr_where_1 ("error: called from '%s' near line %d, column %d", - nm.c_str (), l, c); - else - pr_where_1 ("error: called from '%d' near line %d", nm.c_str (), l); - } - } - } - else - { - if (nm.empty ()) - { - if (l > 0) - { - if (c > 0) - pr_where_1 ("error: in file %s near line %d, column %d", - file.c_str (), l, c); - else - pr_where_1 ("error: in file %s near line %d", file.c_str (), l); - } - } - else - { - if (l > 0) - { - if (c > 0) - pr_where_1 ("error: called from '%s' in file %s near line %d, column %d", - nm.c_str (), file.c_str (), l, c); - else - pr_where_1 ("error: called from '%d' in file %s near line %d", nm.c_str (), file.c_str (), l); - } - } - } - } - } - else - error ("rethrow: ERR structure must contain the fields 'message and 'identifier'"); - } - } - return retval; -} - -// Determine whether the first argument to error or warning function -// should be handled as the message identifier or as the format string. - -static bool -maybe_extract_message_id (const std::string& caller, - const octave_value_list& args, - octave_value_list& nargs, - std::string& id) -{ - nargs = args; - id = std::string (); - - int nargin = args.length (); - - bool have_fmt = nargin > 1; - - if (nargin > 0) - { - std::string arg1 = args(0).string_value (); - - if (! error_state) - { - // For compatibility with Matlab, an identifier must contain - // ':', but not at the beginning or the end, and it must not - // contain '%' (even if it is not a valid conversion - // operator) or whitespace. - - if (arg1.find_first_of ("% \f\n\r\t\v") == std::string::npos - && arg1.find (':') != std::string::npos - && arg1[0] != ':' - && arg1[arg1.length ()-1] != ':') - { - if (nargin > 1) - { - id = arg1; - - nargs.resize (nargin-1); - - for (int i = 1; i < nargin; i++) - nargs(i-1) = args(i); - } - else - nargs(0) = "call to " + caller - + " with message identifier requires message"; - } - } - } - - return have_fmt; -} - -DEFUN (error, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} error (@var{template}, @dots{})\n\ -@deftypefnx {Built-in Function} {} error (@var{id}, @var{template}, @dots{})\n\ -Format the optional arguments under the control of the template string\n\ -@var{template} using the same rules as the @code{printf} family of\n\ -functions (@pxref{Formatted Output}) and print the resulting message\n\ -on the @code{stderr} stream. The message is prefixed by the character\n\ -string @samp{error: }.\n\ -\n\ -Calling @code{error} also sets Octave's internal error state such that\n\ -control will return to the top level without evaluating any more\n\ -commands. This is useful for aborting from functions or scripts.\n\ -\n\ -If the error message does not end with a new line character, Octave will\n\ -print a traceback of all the function calls leading to the error. For\n\ -example, given the following function definitions:\n\ -\n\ -@example\n\ -@group\n\ -function f () g (); end\n\ -function g () h (); end\n\ -function h () nargin == 1 || error (\"nargin != 1\"); end\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -calling the function @code{f} will result in a list of messages that\n\ -can help you to quickly locate the exact location of the error:\n\ -\n\ -@example\n\ -@group\n\ -f ()\n\ -error: nargin != 1\n\ -error: called from:\n\ -error: error at line -1, column -1\n\ -error: h at line 1, column 27\n\ -error: g at line 1, column 15\n\ -error: f at line 1, column 15\n\ -@end group\n\ -@end example\n\ -\n\ -If the error message ends in a new line character, Octave will print the\n\ -message but will not display any traceback messages as it returns\n\ -control to the top level. For example, modifying the error message\n\ -in the previous example to end in a new line causes Octave to only print\n\ -a single message:\n\ -\n\ -@example\n\ -@group\n\ -function h () nargin == 1 || error (\"nargin != 1\\n\"); end\n\ -f ()\n\ -error: nargin != 1\n\ -@end group\n\ -@end example\n\ -\n\ -A null string (\"\") input to @code{error} will be ignored and the code\n\ -will continue running as if the statement were a NOP@. This is for\n\ -compatibility with @sc{matlab}. It also makes it possible to write code such\n\ -as\n\ -\n\ -@example\n\ -@group\n\ -err_msg = \"\";\n\ -if (CONDITION 1)\n\ - err_msg = \"CONDITION 1 found\";\n\ -elseif (CONDITION2)\n\ - err_msg = \"CONDITION 2 found\";\n\ -@dots{}\n\ -endif\n\ -error (err_msg);\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -which will only stop execution if an error has been found.\n\ -\n\ -Implementation Note: For compatibility with @sc{matlab}, escape\n\ -sequences (e.g., \"\\n\" => newline) are processed in @var{template}\n\ -regardless of whether @var{template} has been defined within single quotes\n\ -as long as there are two or more input arguments.\n\ -Use a second backslash to stop interpolation of the escape sequence (e.g.,\n\ -\"\\\\n\") or use the @code{regexptranslate} function.\n\ -@seealso{warning, lasterror}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - octave_value_list nargs = args; - - std::string id; - - if (nargin == 0) - print_usage (); - else - { - bool have_fmt = false; - - if (nargin == 1 && args(0).is_map ()) - { - // empty struct is not an error. return and resume calling function. - if (args(0).is_empty ()) - return retval; - - octave_value_list tmp; - - octave_scalar_map m = args(0).scalar_map_value (); - - // empty struct is not an error. return and resume calling function. - if (m.nfields () == 0) - return retval; - - if (m.contains ("message")) - { - octave_value c = m.getfield ("message"); - - if (c.is_string ()) - nargs(0) = c.string_value (); - } - - if (m.contains ("identifier")) - { - octave_value c = m.getfield ("identifier"); - - if (c.is_string ()) - id = c.string_value (); - } - - // FIXME -- also need to handle "stack" field in error - // structure, but that will require some more significant - // surgery on handle_message, error_with_id, etc. - } - else - { - have_fmt = maybe_extract_message_id ("error", args, nargs, id); - - if (error_state) - return retval; - } - - handle_message (error_with_id, id.c_str (), "unspecified error", - nargs, have_fmt); - } - - return retval; -} - -static octave_scalar_map -warning_query (const std::string& id_arg) -{ - octave_scalar_map retval; - - std::string id = id_arg; - - if (id == "last") - id = Vlast_warning_id; - - Cell ident = warning_options.contents ("identifier"); - Cell state = warning_options.contents ("state"); - - octave_idx_type nel = ident.numel (); - - bool found = false; - - std::string val; - - for (octave_idx_type i = 0; i < nel; i++) - { - if (ident(i).string_value () == id) - { - val = state(i).string_value (); - found = true; - break; - } - } - - if (! found) - { - for (octave_idx_type i = 0; i < nel; i++) - { - if (ident(i).string_value () == "all") - { - val = state(i).string_value (); - found = true; - break; - } - } - } - - if (found) - { - retval.assign ("identifier", id); - retval.assign ("state", val); - } - else - error ("warning: unable to find default warning state!"); - - return retval; -} - -DEFUN (warning, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} warning (@var{template}, @dots{})\n\ -@deftypefnx {Built-in Function} {} warning (@var{id}, @var{template}, @dots{})\n\ -@deftypefnx {Built-in Function} {} warning (\"on\", @var{id})\n\ -@deftypefnx {Built-in Function} {} warning (\"off\", @var{id})\n\ -@deftypefnx {Built-in Function} {} warning (\"query\", @var{id})\n\ -@deftypefnx {Built-in Function} {} warning (\"error\", @var{id})\n\ -@deftypefnx {Built-in Function} {} warning (@var{state}, @var{id}, \"local\")\n\ -Format the optional arguments under the control of the template string\n\ -@var{template} using the same rules as the @code{printf} family of\n\ -functions (@pxref{Formatted Output}) and print the resulting message\n\ -on the @code{stderr} stream. The message is prefixed by the character\n\ -string @samp{warning: }.\n\ -You should use this function when you want to notify the user\n\ -of an unusual condition, but only when it makes sense for your program\n\ -to go on.\n\ -\n\ -The optional message identifier allows users to enable or disable\n\ -warnings tagged by @var{id}. A message identifier is of the form\n\ -\"NAMESPACE:WARNING-NAME\". Octave's own warnings use the \"Octave\"\n\ -namespace (@pxref{docXwarning_ids}). The special identifier @samp{\"all\"}\n\ -may be used to set the state of all warnings.\n\ -\n\ -If the first argument is @samp{\"on\"} or @samp{\"off\"}, set the state\n\ -of a particular warning using the identifier @var{id}. If the first\n\ -argument is @samp{\"query\"}, query the state of this warning instead.\n\ -If the identifier is omitted, a value of @samp{\"all\"} is assumed. If\n\ -you set the state of a warning to @samp{\"error\"}, the warning named by\n\ -@var{id} is handled as if it were an error instead. So, for example, the\n\ -following handles all warnings as errors:\n\ -\n\ -@example\n\ -@group\n\ -warning (\"error\");\n\ -@end group\n\ -@end example\n\ -\n\ -If the state is @samp{\"on\"}, @samp{\"off\"}, or @samp{\"error\"}\n\ -and the third argument is @samp{\"local\"}, then the warning state\n\ -will be set temporarily, until the end of the current function.\n\ -Changes to warning states that are set locally affect the current\n\ -function and all functions called from the current scope. The\n\ -previous warning state is restored on return from the current\n\ -function. The \"local\" option is ignored if used in the top-level\n\ -workspace.\n\ -\n\ -Implementation Note: For compatibility with @sc{matlab}, escape\n\ -sequences (e.g., \"\\n\" => newline) are processed in @var{template}\n\ -regardless of whether @var{template} has been defined within single quotes\n\ -as long as there are two or more input arguments.\n\ -Use a second backslash to stop interpolation of the escape sequence (e.g.,\n\ -\"\\\\n\") or use the @code{regexptranslate} function.\n\ -@seealso{warning_ids, lastwarn, error}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - int argc = nargin + 1; - - bool done = false; - - if (argc > 1 && args.all_strings_p ()) - { - string_vector argv = args.make_argv ("warning"); - - if (! error_state) - { - std::string arg1 = argv(1); - std::string arg2 = "all"; - - if (argc >= 3) - arg2 = argv(2); - - if (arg1 == "on" || arg1 == "off" || arg1 == "error") - { - octave_map old_warning_options = warning_options; - - if (argc == 4 && argv(3) == "local" - && ! symbol_table::at_top_level ()) - { - symbol_table::scope_id scope - = octave_call_stack::current_scope (); - - symbol_table::context_id context - = octave_call_stack::current_context (); - - octave_scalar_map val = warning_query (arg2); - - octave_value curr_state = val.contents ("state"); - - // FIXME -- this might be better with a dictionary - // object. - - octave_value curr_warning_states - = symbol_table::varval (".saved_warning_states.", - scope, context); - - octave_map m; - - if (curr_warning_states.is_defined ()) - m = curr_warning_states.map_value (); - else - { - string_vector fields (2); - - fields(0) = "identifier"; - fields(1) = "state"; - - m = octave_map (dim_vector (0, 1), fields); - } - - if (error_state) - panic_impossible (); - - Cell ids = m.contents ("identifier"); - Cell states = m.contents ("state"); - - octave_idx_type nel = states.numel (); - bool found = false; - octave_idx_type i; - for (i = 0; i < nel; i++) - { - std::string id = ids(i).string_value (); - - if (error_state) - panic_impossible (); - - if (id == arg2) - { - states(i) = curr_state; - found = true; - break; - } - } - - if (! found) - { - m.resize (dim_vector (nel+1, 1)); - - ids.resize (dim_vector (nel+1, 1)); - states.resize (dim_vector (nel+1, 1)); - - ids(nel) = arg2; - states(nel) = curr_state; - } - - m.contents ("identifier") = ids; - m.contents ("state") = states; - - symbol_table::assign - (".saved_warning_states.", m, scope, context); - - // Now ignore the "local" argument and continue to - // handle the current setting. - argc--; - } - - if (arg2 == "all") - { - octave_map tmp; - - Cell id (1, 1); - Cell st (1, 1); - - id(0) = arg2; - st(0) = arg1; - - // Since internal Octave functions are not - // compatible, turning all warnings into errors - // should leave the state of - // Octave:matlab-incompatible alone. - - if (arg1 == "error" - && warning_options.contains ("identifier")) - { - octave_idx_type n = 1; - - Cell tid = warning_options.contents ("identifier"); - Cell tst = warning_options.contents ("state"); - - for (octave_idx_type i = 0; i < tid.numel (); i++) - { - octave_value vid = tid(i); - - if (vid.is_string ()) - { - std::string key = vid.string_value (); - - if (key == "Octave:matlab-incompatible" - || key == "Octave:single-quote-string") - { - id.resize (dim_vector (1, n+1)); - st.resize (dim_vector (1, n+1)); - - id(n) = tid(i); - st(n) = tst(i); - - n++; - } - } - } - } - - tmp.assign ("identifier", id); - tmp.assign ("state", st); - - warning_options = tmp; - - done = true; - } - else if (arg2 == "backtrace") - { - if (arg1 != "error") - { - Vbacktrace_on_warning = (arg1 == "on"); - done = true; - } - } - else if (arg2 == "debug") - { - if (arg1 != "error") - { - Vdebug_on_warning = (arg1 == "on"); - done = true; - } - } - else if (arg2 == "verbose") - { - if (arg1 != "error") - { - Vverbose_warning = (arg1 == "on"); - done = true; - } - } - else if (arg2 == "quiet") - { - if (arg1 != "error") - { - Vquiet_warning = (arg1 == "on"); - done = true; - } - } - else - { - if (arg2 == "last") - arg2 = Vlast_warning_id; - - if (arg2 == "all") - initialize_warning_options (arg1); - else - { - Cell ident = warning_options.contents ("identifier"); - Cell state = warning_options.contents ("state"); - - octave_idx_type nel = ident.numel (); - - bool found = false; - - for (octave_idx_type i = 0; i < nel; i++) - { - if (ident(i).string_value () == arg2) - { - // FIXME -- if state for "all" is - // same as arg1, we can simply remove the - // item from the list. - - state(i) = arg1; - warning_options.assign ("state", state); - found = true; - break; - } - } - - if (! found) - { - // FIXME -- if state for "all" is - // same as arg1, we don't need to do anything. - - ident.resize (dim_vector (1, nel+1)); - state.resize (dim_vector (1, nel+1)); - - ident(nel) = arg2; - state(nel) = arg1; - - warning_options.clear (); - - warning_options.assign ("identifier", ident); - warning_options.assign ("state", state); - } - } - - done = true; - } - - if (done && nargout > 0) - retval = old_warning_options; - } - else if (arg1 == "query") - { - if (arg2 == "all") - retval = warning_options; - else if (arg2 == "backtrace" || arg2 == "debug" - || arg2 == "verbose" || arg2 == "quiet") - { - octave_scalar_map tmp; - tmp.assign ("identifier", arg2); - if (arg2 == "backtrace") - tmp.assign ("state", Vbacktrace_on_warning ? "on" : "off"); - else if (arg2 == "debug") - tmp.assign ("state", Vdebug_on_warning ? "on" : "off"); - else if (arg2 == "verbose") - tmp.assign ("state", Vverbose_warning ? "on" : "off"); - else - tmp.assign ("state", Vquiet_warning ? "on" : "off"); - - retval = tmp; - } - else - retval = warning_query (arg2); - - done = true; - } - } - } - else if (argc == 1) - { - retval = warning_options; - - done = true; - } - else if (argc == 2) - { - octave_value arg = args(0); - - octave_map old_warning_options = warning_options; - - if (arg.is_map ()) - { - octave_map m = arg.map_value (); - - if (m.contains ("identifier") && m.contains ("state")) - warning_options = m; - else - error ("warning: expecting structure with fields 'identifier' and 'state'"); - - done = true; - - if (nargout > 0) - retval = old_warning_options; - } - } - - if (! (error_state || done)) - { - octave_value_list nargs = args; - - std::string id; - - bool have_fmt = maybe_extract_message_id ("warning", args, nargs, id); - - if (error_state) - return retval; - - std::string prev_msg = Vlast_warning_message; - - std::string curr_msg = handle_message (warning_with_id, id.c_str (), - "unspecified warning", nargs, - have_fmt); - - if (nargout > 0) - retval = prev_msg; - } - - return retval; -} - -octave_value_list -set_warning_state (const std::string& id, const std::string& state) -{ - octave_value_list args; - - args(1) = id; - args(0) = state; - - return Fwarning (args, 1); -} - -octave_value_list -set_warning_state (const octave_value_list& args) -{ - return Fwarning (args, 1); -} - -void -disable_warning (const std::string& id) -{ - set_warning_state (id, "off"); -} - -void -initialize_default_warning_state (void) -{ - initialize_warning_options ("on"); - - // Most people will want to have the following disabled. - - disable_warning ("Octave:array-to-scalar"); - disable_warning ("Octave:array-to-vector"); - disable_warning ("Octave:imag-to-real"); - disable_warning ("Octave:matlab-incompatible"); - disable_warning ("Octave:missing-semicolon"); - disable_warning ("Octave:neg-dim-as-zero"); - disable_warning ("Octave:resize-on-range-error"); - disable_warning ("Octave:separator-insert"); - disable_warning ("Octave:single-quote-string"); - disable_warning ("Octave:str-to-num"); - disable_warning ("Octave:mixed-string-concat"); - disable_warning ("Octave:variable-switch-label"); - - // This should be an error unless we are in maximum braindamage mode. - // FIXME: Not quite right. This sets the error state even for braindamage - // mode. Also, this error is not triggered in normal mode because another - // error handler catches it first and gives: - // error: subscript indices must be either positive integers or logicals - set_warning_state ("Octave:noninteger-range-as-index", "error"); - -} - -DEFUN (lasterror, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{lasterr} =} lasterror ()\n\ -@deftypefnx {Built-in Function} {} lasterror (@var{err})\n\ -@deftypefnx {Built-in Function} {} lasterror (\"reset\")\n\ -Query or set the last error message structure. When called without\n\ -arguments, return a structure containing the last error message and other\n\ -information related to this error. The elements of the structure are:\n\ -\n\ -@table @asis\n\ -@item 'message'\n\ -The text of the last error message\n\ -\n\ -@item 'identifier'\n\ -The message identifier of this error message\n\ -\n\ -@item 'stack'\n\ -A structure containing information on where the message occurred. This may\n\ -be an empty structure if the information cannot\n\ -be obtained. The fields of the structure are:\n\ -\n\ -@table @asis\n\ -@item 'file'\n\ -The name of the file where the error occurred\n\ -\n\ -@item 'name'\n\ -The name of function in which the error occurred\n\ -\n\ -@item 'line'\n\ -The line number at which the error occurred\n\ -\n\ -@item 'column'\n\ -An optional field with the column number at which the error occurred\n\ -@end table\n\ -@end table\n\ -\n\ -The last error structure may be set by passing a scalar structure, @var{err},\n\ -as input. Any fields of @var{err} that match those above are set while any\n\ -unspecified fields are initialized with default values.\n\ -\n\ -If @code{lasterror} is called with the argument \"reset\", all fields are\n\ -set to their default values.\n\ -@seealso{lasterr, error, lastwarn}\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - - unwind_protect frame; - - frame.protect_var (error_state); - error_state = 0; - - if (nargin < 2) - { - octave_scalar_map err; - - err.assign ("message", Vlast_error_message); - err.assign ("identifier", Vlast_error_id); - - err.assign ("stack", octave_value (Vlast_error_stack)); - - if (nargin == 1) - { - if (args(0).is_string ()) - { - if (args(0).string_value () == "reset") - { - Vlast_error_message = std::string (); - Vlast_error_id = std::string (); - - Vlast_error_stack = initialize_last_error_stack (); - } - else - error ("lasterror: unrecognized string argument"); - } - else if (args(0).is_map ()) - { - octave_scalar_map new_err = args(0).scalar_map_value (); - octave_scalar_map new_err_stack; - std::string new_error_message; - std::string new_error_id; - std::string new_error_file; - std::string new_error_name; - int new_error_line = -1; - int new_error_column = -1; - - if (! error_state && new_err.contains ("message")) - { - const std::string tmp = - new_err.getfield ("message").string_value (); - new_error_message = tmp; - } - - if (! error_state && new_err.contains ("identifier")) - { - const std::string tmp = - new_err.getfield ("identifier").string_value (); - new_error_id = tmp; - } - - if (! error_state && new_err.contains ("stack")) - { - new_err_stack = - new_err.getfield ("stack").scalar_map_value (); - - if (! error_state && new_err_stack.contains ("file")) - { - const std::string tmp = - new_err_stack.getfield ("file").string_value (); - new_error_file = tmp; - } - - if (! error_state && new_err_stack.contains ("name")) - { - const std::string tmp = - new_err_stack.getfield ("name").string_value (); - new_error_name = tmp; - } - - if (! error_state && new_err_stack.contains ("line")) - { - const int tmp = - new_err_stack.getfield ("line").nint_value (); - new_error_line = tmp; - } - - if (! error_state && new_err_stack.contains ("column")) - { - const int tmp = - new_err_stack.getfield ("column").nint_value (); - new_error_column = tmp; - } - } - - if (! error_state) - { - Vlast_error_message = new_error_message; - Vlast_error_id = new_error_id; - - if (new_err.contains ("stack")) - { - new_err_stack.setfield ("file", new_error_file); - new_err_stack.setfield ("name", new_error_name); - new_err_stack.setfield ("line", new_error_line); - new_err_stack.setfield ("column", new_error_column); - Vlast_error_stack = new_err_stack; - } - else - { - // No stack field. Fill it in with backtrace info. - octave_idx_type curr_frame = -1; - - Vlast_error_stack - = octave_call_stack::backtrace (0, curr_frame); - } - } - } - else - error ("lasterror: argument must be a structure or a string"); - } - - if (! error_state) - retval = err; - } - else - print_usage (); - - return retval; -} - -DEFUN (lasterr, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{msg}, @var{msgid}] =} lasterr ()\n\ -@deftypefnx {Built-in Function} {} lasterr (@var{msg})\n\ -@deftypefnx {Built-in Function} {} lasterr (@var{msg}, @var{msgid})\n\ -Query or set the last error message. When called without input arguments,\n\ -return the last error message and message identifier. With one\n\ -argument, set the last error message to @var{msg}. With two arguments,\n\ -also set the last message identifier.\n\ -@seealso{lasterror, error, lastwarn}\n\ -@end deftypefn") -{ - octave_value_list retval; - - unwind_protect frame; - - frame.protect_var (error_state); - error_state = 0; - - int argc = args.length () + 1; - - if (argc < 4) - { - string_vector argv = args.make_argv ("lasterr"); - - if (! error_state) - { - std::string prev_error_id = Vlast_error_id; - std::string prev_error_message = Vlast_error_message; - - if (argc > 2) - Vlast_error_id = argv(2); - - if (argc > 1) - Vlast_error_message = argv(1); - - if (argc == 1 || nargout > 0) - { - retval(1) = prev_error_id; - retval(0) = prev_error_message; - } - } - else - error ("lasterr: expecting arguments to be character strings"); - } - else - print_usage (); - - return retval; -} - -DEFUN (lastwarn, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{msg}, @var{msgid}] =} lastwarn ()\n\ -@deftypefnx {Built-in Function} {} lastwarn (@var{msg})\n\ -@deftypefnx {Built-in Function} {} lastwarn (@var{msg}, @var{msgid})\n\ -Query or set the last warning message. When called without input arguments,\n\ -return the last warning message and message identifier. With one\n\ -argument, set the last warning message to @var{msg}. With two arguments,\n\ -also set the last message identifier.\n\ -@seealso{warning, lasterror, lasterr}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - if (argc < 4) - { - string_vector argv = args.make_argv ("lastwarn"); - - if (! error_state) - { - std::string prev_warning_id = Vlast_warning_id; - std::string prev_warning_message = Vlast_warning_message; - - if (argc > 2) - Vlast_warning_id = argv(2); - - if (argc > 1) - Vlast_warning_message = argv(1); - - if (argc == 1 || nargout > 0) - { - warning_state = 0; - retval(1) = prev_warning_id; - retval(0) = prev_warning_message; - } - } - else - error ("lastwarn: expecting arguments to be character strings"); - } - else - print_usage (); - - return retval; -} - -DEFUN (usage, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} usage (@var{msg})\n\ -Print the message @var{msg}, prefixed by the string @samp{usage: }, and\n\ -set Octave's internal error state such that control will return to the\n\ -top level without evaluating any more commands. This is useful for\n\ -aborting from functions.\n\ -\n\ -After @code{usage} is evaluated, Octave will print a traceback of all\n\ -the function calls leading to the usage message.\n\ -\n\ -You should use this function for reporting problems errors that result\n\ -from an improper call to a function, such as calling a function with an\n\ -incorrect number of arguments, or with arguments of the wrong type. For\n\ -example, most functions distributed with Octave begin with code like\n\ -this\n\ -\n\ -@example\n\ -@group\n\ -if (nargin != 2)\n\ - usage (\"foo (a, b)\");\n\ -endif\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -to check for the proper number of arguments.\n\ -@end deftypefn") -{ - octave_value_list retval; - handle_message (usage_with_id, "", "unknown", args, true); - return retval; -} - -DEFUN (beep_on_error, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} beep_on_error ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} beep_on_error (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} beep_on_error (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave will try\n\ -to ring the terminal bell before printing an error message.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (beep_on_error); -} - -DEFUN (debug_on_error, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} debug_on_error ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} debug_on_error (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} debug_on_error (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave will try\n\ -to enter the debugger when an error is encountered. This will also\n\ -inhibit printing of the normal traceback message (you will only see\n\ -the top-level error message).\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{debug_on_warning, debug_on_interrupt}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (debug_on_error); -} - -DEFUN (debug_on_warning, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} debug_on_warning ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} debug_on_warning (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} debug_on_warning (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave will try\n\ -to enter the debugger when a warning is encountered.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{debug_on_error, debug_on_interrupt}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (debug_on_warning); -} - -std::string -last_error_message (void) -{ - return Vlast_error_message; -} - -std::string -last_error_id (void) -{ - return Vlast_error_id; -} - -std::string -last_warning_message (void) -{ - return Vlast_warning_message; -} - -std::string -last_warning_id (void) -{ - return Vlast_warning_id; -} - -void -interpreter_try (unwind_protect& frame) -{ - frame.protect_var (error_state); - frame.protect_var (buffer_error_messages); - frame.protect_var (Vdebug_on_error); - frame.protect_var (Vdebug_on_warning); - - buffer_error_messages++; - Vdebug_on_error = false; - Vdebug_on_warning = false; -} - - diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/error.h --- a/libinterp/interpfcn/error.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,142 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_error_h) -#define octave_error_h 1 - -#include -#include - -class octave_value_list; -class unwind_protect; - -#define panic_impossible() \ - panic ("impossible state reached in file '%s' at line %d", \ - __FILE__, __LINE__) - -extern OCTINTERP_API void reset_error_handler (void); - -extern OCTINTERP_API int warning_enabled (const std::string& id); - -extern OCTINTERP_API void vmessage (const char *name, const char *fmt, va_list args); -extern OCTINTERP_API void message (const char *name, const char *fmt, ...); - -extern OCTINTERP_API void vusage (const char *fmt, va_list args); -extern OCTINTERP_API void usage (const char *fmt, ...); - -extern OCTINTERP_API void vwarning (const char *fmt, va_list args); -extern OCTINTERP_API void warning (const char *fmt, ...); - -extern OCTINTERP_API void verror (const char *fmt, va_list args); -extern OCTINTERP_API void error (const char *fmt, ...); - -extern OCTINTERP_API void verror_with_cfn (const char *fmt, va_list args); -extern OCTINTERP_API void error_with_cfn (const char *fmt, ...); - -extern OCTINTERP_API void vparse_error (const char *fmt, va_list args); -extern OCTINTERP_API void parse_error (const char *fmt, ...); - -extern OCTINTERP_API void -vmessage_with_id (const char *id, const char *name, const char *fmt, va_list args); - -extern OCTINTERP_API void -message_with_id (const char *id, const char *name, const char *fmt, ...); - -extern OCTINTERP_API void -vusage_with_id (const char *id, const char *fmt, va_list args); - -extern OCTINTERP_API void -usage_with_id (const char *id, const char *fmt, ...); - -extern OCTINTERP_API void -vwarning_with_id (const char *id, const char *fmt, va_list args); - -extern OCTINTERP_API void -warning_with_id (const char *id, const char *fmt, ...); - -extern OCTINTERP_API void -verror_with_id (const char *id, const char *fmt, va_list args); - -extern OCTINTERP_API void -error_with_id (const char *id, const char *fmt, ...); - -extern OCTINTERP_API void -verror_with_id_cfn (const char *id, const char *fmt, va_list args); - -extern OCTINTERP_API void -error_with_id_cfn (const char *id, const char *fmt, ...); - -extern OCTINTERP_API void -vparse_error_with_id (const char *id, const char *fmt, va_list args); - -extern OCTINTERP_API void -parse_error_with_id (const char *id, const char *fmt, ...); - -extern OCTINTERP_API void panic (const char *fmt, ...) GCC_ATTR_NORETURN; - -// Helper function for print_usage defined in defun.cc. -extern OCTINTERP_API void defun_usage_message (const std::string& msg); - -extern OCTINTERP_API octave_value_list -set_warning_state (const std::string& id, const std::string& state); - -extern OCTINTERP_API octave_value_list -set_warning_state (const octave_value_list& args); - -extern OCTINTERP_API void disable_warning (const std::string& id); -extern OCTINTERP_API void initialize_default_warning_state (void); - -// TRUE means that Octave will try to enter the debugger when an error -// is encountered. This will also inhibit printing of the normal -// traceback message (you will only see the top-level error message). -extern OCTINTERP_API bool Vdebug_on_error; - -// TRUE means that Octave will try to enter the debugger when a warning -// is encountered. -extern OCTINTERP_API bool Vdebug_on_warning; - -// Current error state. -extern OCTINTERP_API int error_state; - -// Current warning state. -extern OCTINTERP_API int warning_state; - -// Tell the error handler whether to print messages, or just store -// them for later. Used for handling errors in eval() and -// the 'unwind_protect' statement. -extern OCTINTERP_API int buffer_error_messages; - -// TRUE means error messages are turned off. -extern OCTINTERP_API bool discard_error_messages; - -// TRUE means warning messages are turned off. -extern OCTINTERP_API bool discard_warning_messages; - -// Helper functions to pass last error and warning messages and ids -extern OCTINTERP_API std::string last_error_message (void); -extern OCTINTERP_API std::string last_error_id (void); -extern OCTINTERP_API std::string last_warning_message (void); -extern OCTINTERP_API std::string last_warning_id (void); - -extern OCTINTERP_API void interpreter_try (unwind_protect&); - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/file-io.cc --- a/libinterp/interpfcn/file-io.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2308 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Originally written by John C. Campbell -// -// Thomas Baier added the original versions of -// the following functions: -// -// popen -// pclose -// execute (now popen2.m) -// sync_system (now merged with system) -// async_system (now merged with system) - -// Extensively revised by John W. Eaton , -// April 1996. - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include -#include -#include -#include - -#include -#include -#include - -#ifdef HAVE_ZLIB_H -#include -#endif - -#include "error.h" -#include "file-ops.h" -#include "file-stat.h" -#include "lo-ieee.h" -#include "oct-env.h" -#include "oct-locbuf.h" - -#include "defun.h" -#include "file-io.h" -#include "load-path.h" -#include "oct-fstrm.h" -#include "oct-iostrm.h" -#include "oct-map.h" -#include "oct-obj.h" -#include "oct-prcstrm.h" -#include "oct-stream.h" -#include "oct-strstrm.h" -#include "pager.h" -#include "sysdep.h" -#include "utils.h" -#include "variables.h" - -static octave_value stdin_file; -static octave_value stdout_file; -static octave_value stderr_file; - -static octave_stream stdin_stream; -static octave_stream stdout_stream; -static octave_stream stderr_stream; - -void -initialize_file_io (void) -{ - stdin_stream = octave_istream::create (&std::cin, "stdin"); - - // This uses octave_stdout (see pager.h), not std::cout so that Octave's - // standard output stream will pass through the pager. - - stdout_stream = octave_ostream::create (&octave_stdout, "stdout"); - - stderr_stream = octave_ostream::create (&std::cerr, "stderr"); - - stdin_file = octave_stream_list::insert (stdin_stream); - stdout_file = octave_stream_list::insert (stdout_stream); - stderr_file = octave_stream_list::insert (stderr_stream); -} - -void -close_files (void) -{ - octave_stream_list::clear (); -} - -// List of files to delete when we exit or crash. -// -// FIXME -- this should really be static, but that causes -// problems on some systems. -std::stack tmp_files; - -void -mark_for_deletion (const std::string& file) -{ - tmp_files.push (file); -} - -void -cleanup_tmp_files (void) -{ - while (! tmp_files.empty ()) - { - std::string filename = tmp_files.top (); - tmp_files.pop (); - gnulib::unlink (filename.c_str ()); - } -} - -static void -normalize_fopen_mode (std::string& mode, bool& use_zlib) -{ - use_zlib = false; - - if (! mode.empty ()) - { - // Could probably be faster, but does it really matter? - - // Accept 'W', 'R', and 'A' as 'w', 'r', and 'a' but we warn about - // them because Matlab says they don't perform "automatic - // flushing" but we don't know precisely what action that implies. - - size_t pos = mode.find ('W'); - - if (pos != std::string::npos) - { - warning_with_id ("Octave:fopen-mode", - "fopen: treating mode \"W\" as equivalent to \"w\""); - mode[pos] = 'w'; - } - - pos = mode.find ('R'); - - if (pos != std::string::npos) - { - warning_with_id ("Octave:fopen-mode", - "fopen: treating mode \"R\" as equivalent to \"r\""); - mode[pos] = 'r'; - } - - pos = mode.find ('A'); - - if (pos != std::string::npos) - { - warning_with_id ("Octave:fopen-mode", - "fopen: treating mode \"A\" as equivalent to \"a\""); - mode[pos] = 'a'; - } - - pos = mode.find ('z'); - - if (pos != std::string::npos) - { -#if defined (HAVE_ZLIB) - use_zlib = true; - mode.erase (pos, 1); -#else - error ("this version of Octave does not support gzipped files"); -#endif - } - - if (! error_state) - { - // Use binary mode if 't' is not specified, but don't add - // 'b' if it is already present. - - size_t bpos = mode.find ('b'); - size_t tpos = mode.find ('t'); - - if (bpos == std::string::npos && tpos == std::string::npos) - mode += 'b'; - } - } -} - -static std::ios::openmode -fopen_mode_to_ios_mode (const std::string& mode) -{ - std::ios::openmode retval = std::ios::in; - - if (! error_state) - { - if (mode == "rt") - retval = std::ios::in; - else if (mode == "wt") - retval = std::ios::out | std::ios::trunc; - else if (mode == "at") - retval = std::ios::out | std::ios::app; - else if (mode == "r+t" || mode == "rt+") - retval = std::ios::in | std::ios::out; - else if (mode == "w+t" || mode == "wt+") - retval = std::ios::in | std::ios::out | std::ios::trunc; - else if (mode == "a+t" || mode == "at+") - retval = std::ios::in | std::ios::out | std::ios::app; - else if (mode == "rb" || mode == "r") - retval = std::ios::in | std::ios::binary; - else if (mode == "wb" || mode == "w") - retval = std::ios::out | std::ios::trunc | std::ios::binary; - else if (mode == "ab" || mode == "a") - retval = std::ios::out | std::ios::app | std::ios::binary; - else if (mode == "r+b" || mode == "rb+" || mode == "r+") - retval = std::ios::in | std::ios::out | std::ios::binary; - else if (mode == "w+b" || mode == "wb+" || mode == "w+") - retval = (std::ios::in | std::ios::out | std::ios::trunc - | std::ios::binary); - else if (mode == "a+b" || mode == "ab+" || mode == "a+") - retval = (std::ios::in | std::ios::out | std::ios::app - | std::ios::binary); - else - ::error ("invalid mode specified"); - } - - return retval; -} - -DEFUN (fclose, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fclose (@var{fid})\n\ -@deftypefnx {Built-in Function} {} fclose (\"all\")\n\ -Close the specified file. If successful, @code{fclose} returns 0,\n\ -otherwise, it returns -1. The second form of the @code{fclose} call closes\n\ -all open files except @code{stdout}, @code{stderr}, and @code{stdin}.\n\ -@seealso{fopen, freport}\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 1) - retval = octave_stream_list::remove (args(0), "fclose"); - else - print_usage (); - - return retval; -} - -DEFUN (fclear, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fclear (@var{fid})\n\ -Clear the stream state for the specified file.\n\ -@seealso{fopen}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - int fid = octave_stream_list::get_file_number (args (0)); - - octave_stream os = octave_stream_list::lookup (fid, "fclear"); - - if (! error_state) - os.clearerr (); - } - else - print_usage (); - - return retval; -} - -DEFUN (fflush, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fflush (@var{fid})\n\ -Flush output to @var{fid}. This is useful for ensuring that all\n\ -pending output makes it to the screen before some other event occurs.\n\ -For example, it is always a good idea to flush the standard output\n\ -stream before calling @code{input}.\n\ -\n\ -@code{fflush} returns 0 on success and an OS dependent error value\n\ -(@minus{}1 on Unix) on error.\n\ -@seealso{fopen, fclose}\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 1) - { - // FIXME -- any way to avoid special case for stdout? - - int fid = octave_stream_list::get_file_number (args (0)); - - if (fid == 1) - { - flush_octave_stdout (); - - retval = 0; - } - else - { - octave_stream os = octave_stream_list::lookup (fid, "fflush"); - - if (! error_state) - retval = os.flush (); - } - } - else - print_usage (); - - return retval; -} - -DEFUN (fgetl, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{str} =} fgetl (@var{fid})\n\ -@deftypefnx {Built-in Function} {@var{str} =} fgetl (@var{fid}, @var{len})\n\ -Read characters from a file, stopping after a newline, or EOF,\n\ -or @var{len} characters have been read. The characters read, excluding\n\ -the possible trailing newline, are returned as a string.\n\ -\n\ -If @var{len} is omitted, @code{fgetl} reads until the next newline\n\ -character.\n\ -\n\ -If there are no more characters to read, @code{fgetl} returns @minus{}1.\n\ -\n\ -To read a line and return the terminating newline see @code{fgets}.\n\ -@seealso{fgets, fscanf, fread, fopen}\n\ -@end deftypefn") -{ - static std::string who = "fgetl"; - - octave_value_list retval; - - retval(1) = 0; - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - octave_stream os = octave_stream_list::lookup (args(0), who); - - if (! error_state) - { - octave_value len_arg = (nargin == 2) ? args(1) : octave_value (); - - bool err = false; - - std::string tmp = os.getl (len_arg, err, who); - - if (! (error_state || err)) - { - retval(1) = tmp.length (); - retval(0) = tmp; - } - } - } - else - print_usage (); - - return retval; -} - -DEFUN (fgets, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{str} =} fgets (@var{fid})\n\ -@deftypefnx {Built-in Function} {@var{str} =} fgets (@var{fid}, @var{len})\n\ -Read characters from a file, stopping after a newline, or EOF,\n\ -or @var{len} characters have been read. The characters read, including\n\ -the possible trailing newline, are returned as a string.\n\ -\n\ -If @var{len} is omitted, @code{fgets} reads until the next newline\n\ -character.\n\ -\n\ -If there are no more characters to read, @code{fgets} returns @minus{}1.\n\ -\n\ -To read a line and discard the terminating newline see @code{fgetl}.\n\ -@seealso{fputs, fgetl, fscanf, fread, fopen}\n\ -@end deftypefn") -{ - static std::string who = "fgets"; - - octave_value_list retval; - - retval(1) = 0.0; - retval(0) = -1.0; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - octave_stream os = octave_stream_list::lookup (args(0), who); - - if (! error_state) - { - octave_value len_arg = (nargin == 2) ? args(1) : octave_value (); - - bool err = false; - - std::string tmp = os.gets (len_arg, err, who); - - if (! (error_state || err)) - { - retval(1) = tmp.length (); - retval(0) = tmp; - } - } - } - else - print_usage (); - - return retval; -} - -DEFUN (fskipl, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{nlines} =} fskipl (@var{fid})\n\ -@deftypefnx {Built-in Function} {@var{nlines} =} fskipl (@var{fid}, @var{count})\n\ -@deftypefnx {Built-in Function} {@var{nlines} =} fskipl (@var{fid}, Inf)\n\ -Read and skip @var{count} lines from the file descriptor @var{fid}.\n\ -@code{fskipl} discards characters until an end-of-line is encountered exactly\n\ -@var{count}-times, or until the end-of-file marker is found.\n\ -\n\ -If @var{count} is omitted, it defaults to 1. @var{count} may also be\n\ -@code{Inf}, in which case lines are skipped until the end of the file.\n\ -This form is suitable for counting the number of lines in a file.\n\ -\n\ -Returns the number of lines skipped (end-of-line sequences encountered).\n\ -@seealso{fgetl, fgets, fscanf, fopen}\n\ -@end deftypefn") -{ - static std::string who = "fskipl"; - - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - octave_stream os = octave_stream_list::lookup (args(0), who); - - if (! error_state) - { - octave_value count_arg = (nargin == 2) ? args(1) : octave_value (); - - bool err = false; - - off_t tmp = os.skipl (count_arg, err, who); - - if (! (error_state || err)) - retval = tmp; - } - } - else - print_usage (); - - return retval; -} - - -static octave_stream -do_stream_open (const std::string& name, const std::string& mode_arg, - const std::string& arch, int& fid) -{ - octave_stream retval; - - fid = -1; - - std::string mode = mode_arg; - bool use_zlib = false; - normalize_fopen_mode (mode, use_zlib); - - std::ios::openmode md = fopen_mode_to_ios_mode (mode); - - if (! error_state) - { - oct_mach_info::float_format flt_fmt = - oct_mach_info::string_to_float_format (arch); - - if (! error_state) - { - std::string fname = file_ops::tilde_expand (name); - - file_stat fs (fname); - - if (! (md & std::ios::out - || octave_env::absolute_pathname (fname) - || octave_env::rooted_relative_pathname (fname))) - { - if (! fs.exists ()) - { - std::string tmp - = octave_env::make_absolute (load_path::find_file (fname)); - - if (! tmp.empty ()) - { - warning_with_id ("Octave:fopen-file-in-path", - "fopen: file found in load path"); - fname = tmp; - } - } - } - - if (! fs.is_dir ()) - { -#if defined (HAVE_ZLIB) - if (use_zlib) - { - FILE *fptr = gnulib::fopen (fname.c_str (), mode.c_str ()); - - int fd = fileno (fptr); - - gzFile gzf = ::gzdopen (fd, mode.c_str ()); - - if (fptr) - retval = octave_zstdiostream::create (fname, gzf, fd, - md, flt_fmt); - else - retval.error (gnulib::strerror (errno)); - } - else -#endif - { - FILE *fptr = gnulib::fopen (fname.c_str (), mode.c_str ()); - - retval = octave_stdiostream::create (fname, fptr, md, flt_fmt); - - if (! fptr) - retval.error (gnulib::strerror (errno)); - } - - } - } - } - - return retval; -} - -static octave_stream -do_stream_open (const octave_value& tc_name, const octave_value& tc_mode, - const octave_value& tc_arch, const char *fcn, int& fid) -{ - octave_stream retval; - - fid = -1; - - std::string name = tc_name.string_value (); - - if (! error_state) - { - std::string mode = tc_mode.string_value (); - - if (! error_state) - { - std::string arch = tc_arch.string_value (); - - if (! error_state) - retval = do_stream_open (name, mode, arch, fid); - else - ::error ("%s: architecture type must be a string", fcn); - } - else - ::error ("%s: file mode must be a string", fcn); - } - else - ::error ("%s: file name must be a string", fcn); - - return retval; -} - -DEFUN (fopen, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{fid}, @var{msg}] =} fopen (@var{name}, @var{mode}, @var{arch})\n\ -@deftypefnx {Built-in Function} {@var{fid_list} =} fopen (\"all\")\n\ -@deftypefnx {Built-in Function} {[@var{file}, @var{mode}, @var{arch}] =} fopen (@var{fid})\n\ -The first form of the @code{fopen} function opens the named file with\n\ -the specified mode (read-write, read-only, etc.) and architecture\n\ -interpretation (IEEE big endian, IEEE little endian, etc.), and returns\n\ -an integer value that may be used to refer to the file later. If an\n\ -error occurs, @var{fid} is set to @minus{}1 and @var{msg} contains the\n\ -corresponding system error message. The @var{mode} is a one or two\n\ -character string that specifies whether the file is to be opened for\n\ -reading, writing, or both.\n\ -\n\ -The second form of the @code{fopen} function returns a vector of file ids\n\ -corresponding to all the currently open files, excluding the\n\ -@code{stdin}, @code{stdout}, and @code{stderr} streams.\n\ -\n\ -The third form of the @code{fopen} function returns information about the\n\ -open file given its file id.\n\ -\n\ -For example,\n\ -\n\ -@example\n\ -myfile = fopen (\"splat.dat\", \"r\", \"ieee-le\");\n\ -@end example\n\ -\n\ -@noindent\n\ -opens the file @file{splat.dat} for reading. If necessary, binary\n\ -numeric values will be read assuming they are stored in IEEE format with\n\ -the least significant bit first, and then converted to the native\n\ -representation.\n\ -\n\ -Opening a file that is already open simply opens it again and returns a\n\ -separate file id. It is not an error to open a file several times,\n\ -though writing to the same file through several different file ids may\n\ -produce unexpected results.\n\ -\n\ -The possible values @samp{mode} may have are\n\ -\n\ -@table @asis\n\ -@item @samp{r}\n\ -Open a file for reading.\n\ -\n\ -@item @samp{w}\n\ -Open a file for writing. The previous contents are discarded.\n\ -\n\ -@item @samp{a}\n\ -Open or create a file for writing at the end of the file.\n\ -\n\ -@item @samp{r+}\n\ -Open an existing file for reading and writing.\n\ -\n\ -@item @samp{w+}\n\ -Open a file for reading or writing. The previous contents are\n\ -discarded.\n\ -\n\ -@item @samp{a+}\n\ -Open or create a file for reading or writing at the end of the\n\ -file.\n\ -@end table\n\ -\n\ -Append a \"t\" to the mode string to open the file in text mode or a\n\ -\"b\" to open in binary mode. On Windows and Macintosh systems, text\n\ -mode reading and writing automatically converts linefeeds to the\n\ -appropriate line end character for the system (carriage-return linefeed\n\ -on Windows, carriage-return on Macintosh). The default if no mode is\n\ -specified is binary mode.\n\ -\n\ -Additionally, you may append a \"z\" to the mode string to open a\n\ -gzipped file for reading or writing. For this to be successful, you\n\ -must also open the file in binary mode.\n\ -\n\ -The parameter @var{arch} is a string specifying the default data format\n\ -for the file. Valid values for @var{arch} are:\n\ -\n\ -@table @samp\n\ -@item native\n\ -The format of the current machine (this is the default).\n\ -\n\ -@item ieee-be\n\ -IEEE big endian format.\n\ -\n\ -@item ieee-le\n\ -IEEE little endian format.\n\ -\n\ -@item vaxd\n\ -VAX D floating format.\n\ -\n\ -@item vaxg\n\ -VAX G floating format.\n\ -\n\ -@item cray\n\ -Cray floating format.\n\ -@end table\n\ -\n\ -@noindent\n\ -however, conversions are currently only supported for @samp{native}\n\ -@samp{ieee-be}, and @samp{ieee-le} formats.\n\ -@seealso{fclose, fgets, fgetl, fscanf, fread, fputs, fdisp, fprintf, fwrite, fskipl, fseek, frewind, ftell, feof, ferror, fclear, fflush, freport}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(0) = -1.0; - - int nargin = args.length (); - - if (nargin == 1) - { - if (args(0).is_string ()) - { - // If there is only one argument and it is a string but it - // is not the string "all", we assume it is a file to open - // with MODE = "r". To open a file called "all", you have - // to supply more than one argument. - - if (nargout < 2 && args(0).string_value () == "all") - return octave_stream_list::open_file_numbers (); - } - else - { - string_vector tmp = octave_stream_list::get_info (args(0)); - - if (! error_state) - { - retval(2) = tmp(2); - retval(1) = tmp(1); - retval(0) = tmp(0); - } - - return retval; - } - } - - if (nargin > 0 && nargin < 4) - { - octave_value mode = (nargin == 2 || nargin == 3) - ? args(1) : octave_value ("r"); - - octave_value arch = (nargin == 3) - ? args(2) : octave_value ("native"); - - int fid = -1; - - octave_stream os = do_stream_open (args(0), mode, arch, "fopen", fid); - - if (os && ! error_state) - { - retval(1) = ""; - retval(0) = octave_stream_list::insert (os); - } - else - { - int error_number = 0; - - retval(1) = os.error (false, error_number); - retval(0) = -1.0; - } - } - else - print_usage (); - - return retval; -} - -DEFUN (freport, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} freport ()\n\ -Print a list of which files have been opened, and whether they are open\n\ -for reading, writing, or both. For example:\n\ -\n\ -@example\n\ -@group\n\ -freport ()\n\ -\n\ - @print{} number mode name\n\ - @print{}\n\ - @print{} 0 r stdin\n\ - @print{} 1 w stdout\n\ - @print{} 2 w stderr\n\ - @print{} 3 r myfile\n\ -@end group\n\ -@end example\n\ -@seealso{fopen, fclose}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin > 0) - warning ("freport: ignoring extra arguments"); - - octave_stdout << octave_stream_list::list_open_files (); - - return retval; -} - -DEFUN (frewind, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} frewind (@var{fid})\n\ -Move the file pointer to the beginning of the file @var{fid}, returning\n\ -0 for success, and -1 if an error was encountered. It is equivalent to\n\ -@code{fseek (@var{fid}, 0, SEEK_SET)}.\n\ -@seealso{fseek, ftell, fopen}\n\ -@end deftypefn") -{ - octave_value retval; - - int result = -1; - - int nargin = args.length (); - - if (nargin == 1) - { - octave_stream os = octave_stream_list::lookup (args(0), "frewind"); - - if (! error_state) - result = os.rewind (); - } - else - print_usage (); - - if (nargout > 0) - retval = result; - - return retval; -} - -DEFUN (fseek, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fseek (@var{fid}, @var{offset})\n\ -@deftypefnx {Built-in Function} {} fseek (@var{fid}, @var{offset}, @var{origin})\n\ -@deftypefnx {Built-in Function} {@var{status} =} fseek (@dots{})\n\ -Set the file pointer to any location within the file @var{fid}.\n\ -\n\ -The pointer is positioned @var{offset} characters from the @var{origin},\n\ -which may be one of the predefined variables @w{@code{SEEK_CUR}} (current\n\ -position), @w{@code{SEEK_SET}} (beginning), or @w{@code{SEEK_END}} (end of\n\ -file) or strings \"cof\", \"bof\" or \"eof\". If @var{origin} is omitted,\n\ -@w{@code{SEEK_SET}} is assumed. @var{offset} may be positive, negative, or zero but not all combinations of @var{origin} and @var{offset} can be realized.\n\ -\n\ -Return 0 on success and -1 on error.\n\ -@seealso{fskipl, frewind, ftell, fopen}\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 2 || nargin == 3) - { - octave_stream os = octave_stream_list::lookup (args(0), "fseek"); - - if (! error_state) - { - octave_value origin_arg = (nargin == 3) - ? args(2) : octave_value (-1.0); - - retval = os.seek (args(1), origin_arg); - } - } - else - print_usage (); - - return retval; -} - -DEFUN (ftell, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ftell (@var{fid})\n\ -Return the position of the file pointer as the number of characters\n\ -from the beginning of the file @var{fid}.\n\ -@seealso{fseek, feof, fopen}\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 1) - { - octave_stream os = octave_stream_list::lookup (args(0), "ftell"); - - if (! error_state) - retval = os.tell (); - } - else - print_usage (); - - return retval; -} - -DEFUN (fprintf, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fprintf (@var{fid}, @var{template}, @dots{})\n\ -This function is just like @code{printf}, except that the output is\n\ -written to the stream @var{fid} instead of @code{stdout}.\n\ -If @var{fid} is omitted, the output is written to @code{stdout}.\n\ -@seealso{fputs, fdisp, fwrite, fscanf, printf, sprintf, fopen}\n\ -@end deftypefn") -{ - static std::string who = "fprintf"; - - octave_value retval; - - int result = -1; - - int nargin = args.length (); - - if (nargin > 1 || (nargin > 0 && args(0).is_string ())) - { - octave_stream os; - int fmt_n = 0; - - if (args(0).is_string ()) - { - os = octave_stream_list::lookup (1, who); - } - else - { - fmt_n = 1; - os = octave_stream_list::lookup (args(0), who); - } - - if (! error_state) - { - if (args(fmt_n).is_string ()) - { - octave_value_list tmp_args; - - if (nargin > 1 + fmt_n) - { - tmp_args.resize (nargin-fmt_n-1, octave_value ()); - - for (int i = fmt_n + 1; i < nargin; i++) - tmp_args(i-fmt_n-1) = args(i); - } - - result = os.printf (args(fmt_n), tmp_args, who); - } - else - ::error ("%s: format TEMPLATE must be a string", who.c_str ()); - } - } - else - print_usage (); - - if (nargout > 0) - retval = result; - - return retval; -} - -DEFUN (printf, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} printf (@var{template}, @dots{})\n\ -Print optional arguments under the control of the template string\n\ -@var{template} to the stream @code{stdout} and return the number of\n\ -characters printed.\n\ -@ifclear OCTAVE_MANUAL\n\ -\n\ -See the Formatted Output section of the GNU Octave manual for a\n\ -complete description of the syntax of the template string.\n\ -@end ifclear\n\ -@seealso{fprintf, sprintf, scanf}\n\ -@end deftypefn") -{ - static std::string who = "printf"; - - octave_value retval; - - int result = -1; - - int nargin = args.length (); - - if (nargin > 0) - { - if (args(0).is_string ()) - { - octave_value_list tmp_args; - - if (nargin > 1) - { - tmp_args.resize (nargin-1, octave_value ()); - - for (int i = 1; i < nargin; i++) - tmp_args(i-1) = args(i); - } - - result = stdout_stream.printf (args(0), tmp_args, who); - } - else - ::error ("%s: format TEMPLATE must be a string", who.c_str ()); - } - else - print_usage (); - - if (nargout > 0) - retval = result; - - return retval; -} - -DEFUN (fputs, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fputs (@var{fid}, @var{string})\n\ -Write a string to a file with no formatting.\n\ -\n\ -Return a non-negative number on success and EOF on error.\n\ -@seealso{fdisp, fprintf, fwrite, fopen}\n\ -@end deftypefn") -{ - static std::string who = "fputs"; - - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 2) - { - octave_stream os = octave_stream_list::lookup (args(0), who); - - if (! error_state) - retval = os.puts (args(1), who); - } - else - print_usage (); - - return retval; -} - -DEFUN (puts, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} puts (@var{string})\n\ -Write a string to the standard output with no formatting.\n\ -\n\ -Return a non-negative number on success and EOF on error.\n\ -@seealso{fputs, disp}\n\ -@end deftypefn") -{ - static std::string who = "puts"; - - octave_value retval = -1; - - if (args.length () == 1) - retval = stdout_stream.puts (args(0), who); - else - print_usage (); - - return retval; -} - -DEFUN (sprintf, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} sprintf (@var{template}, @dots{})\n\ -This is like @code{printf}, except that the output is returned as a\n\ -string. Unlike the C library function, which requires you to provide a\n\ -suitably sized string as an argument, Octave's @code{sprintf} function\n\ -returns the string, automatically sized to hold all of the items\n\ -converted.\n\ -@seealso{printf, fprintf, sscanf}\n\ -@end deftypefn") -{ - static std::string who = "sprintf"; - - octave_value_list retval; - - int nargin = args.length (); - - if (nargin > 0) - { - retval(2) = -1.0; - retval(1) = "unknown error"; - retval(0) = ""; - - octave_ostrstream *ostr = new octave_ostrstream (); - - octave_stream os (ostr); - - if (os.is_valid ()) - { - octave_value fmt_arg = args(0); - - if (fmt_arg.is_string ()) - { - octave_value_list tmp_args; - - if (nargin > 1) - { - tmp_args.resize (nargin-1, octave_value ()); - - for (int i = 1; i < nargin; i++) - tmp_args(i-1) = args(i); - } - - retval(2) = os.printf (fmt_arg, tmp_args, who); - retval(1) = os.error (); - retval(0) = octave_value (ostr->str (), - fmt_arg.is_sq_string () ? '\'' : '"'); - } - else - ::error ("%s: format TEMPLATE must be a string", who.c_str ()); - } - else - ::error ("%s: unable to create output buffer", who.c_str ()); - } - else - print_usage (); - - return retval; -} - -DEFUN (fscanf, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{val}, @var{count}, @var{errmsg}] =} fscanf (@var{fid}, @var{template}, @var{size})\n\ -@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}, @var{errmsg}] =} fscanf (@var{fid}, @var{template}, \"C\")\n\ -In the first form, read from @var{fid} according to @var{template},\n\ -returning the result in the matrix @var{val}.\n\ -\n\ -The optional argument @var{size} specifies the amount of data to read\n\ -and may be one of\n\ -\n\ -@table @code\n\ -@item Inf\n\ -Read as much as possible, returning a column vector.\n\ -\n\ -@item @var{nr}\n\ -Read up to @var{nr} elements, returning a column vector.\n\ -\n\ -@item [@var{nr}, Inf]\n\ -Read as much as possible, returning a matrix with @var{nr} rows. If the\n\ -number of elements read is not an exact multiple of @var{nr}, the last\n\ -column is padded with zeros.\n\ -\n\ -@item [@var{nr}, @var{nc}]\n\ -Read up to @code{@var{nr} * @var{nc}} elements, returning a matrix with\n\ -@var{nr} rows. If the number of elements read is not an exact multiple\n\ -of @var{nr}, the last column is padded with zeros.\n\ -@end table\n\ -\n\ -@noindent\n\ -If @var{size} is omitted, a value of @code{Inf} is assumed.\n\ -\n\ -A string is returned if @var{template} specifies only character\n\ -conversions.\n\ -\n\ -The number of items successfully read is returned in @var{count}.\n\ -\n\ -If an error occurs, @var{errmsg} contains a system-dependent error message.\n\ -\n\ -In the second form, read from @var{fid} according to @var{template},\n\ -with each conversion specifier in @var{template} corresponding to a\n\ -single scalar return value. This form is more ``C-like'', and also\n\ -compatible with previous versions of Octave. The number of successful\n\ -conversions is returned in @var{count}\n\ -@ifclear OCTAVE_MANUAL\n\ -\n\ -See the Formatted Input section of the GNU Octave manual for a\n\ -complete description of the syntax of the template string.\n\ -@end ifclear\n\ -@seealso{fgets, fgetl, fread, scanf, sscanf, fopen}\n\ -@end deftypefn") -{ - static std::string who = "fscanf"; - - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 3 && args(2).is_string ()) - { - octave_stream os = octave_stream_list::lookup (args(0), who); - - if (! error_state) - { - if (args(1).is_string ()) - retval = os.oscanf (args(1), who); - else - ::error ("%s: format TEMPLATE must be a string", who.c_str ()); - } - } - else - { - retval(2) = "unknown error"; - retval(1) = 0.0; - retval(0) = Matrix (); - - if (nargin == 2 || nargin == 3) - { - octave_stream os = octave_stream_list::lookup (args(0), who); - - if (! error_state) - { - if (args(1).is_string ()) - { - octave_idx_type count = 0; - - Array size = (nargin == 3) - ? args(2).vector_value () - : Array (dim_vector (1, 1), lo_ieee_inf_value ()); - - if (! error_state) - { - octave_value tmp = os.scanf (args(1), size, count, who); - - if (! error_state) - { - retval(2) = os.error (); - retval(1) = count; - retval(0) = tmp; - } - } - } - else - ::error ("%s: format must be a string", who.c_str ()); - } - } - else - print_usage (); - } - - return retval; -} - -static std::string -get_sscanf_data (const octave_value& val) -{ - std::string retval; - - if (val.is_string ()) - { - octave_value tmp = val.reshape (dim_vector (1, val.numel ())); - - retval = tmp.string_value (); - } - else - ::error ("sscanf: argument STRING must be a string"); - - return retval; -} - -DEFUN (sscanf, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{val}, @var{count}, @var{errmsg}, @var{pos}] =} sscanf (@var{string}, @var{template}, @var{size})\n\ -@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}, @var{errmsg}] =} sscanf (@var{string}, @var{template}, \"C\")\n\ -This is like @code{fscanf}, except that the characters are taken from the\n\ -string @var{string} instead of from a stream. Reaching the end of the\n\ -string is treated as an end-of-file condition. In addition to the values\n\ -returned by @code{fscanf}, the index of the next character to be read\n\ -is returned in @var{pos}.\n\ -@seealso{fscanf, scanf, sprintf}\n\ -@end deftypefn") -{ - static std::string who = "sscanf"; - - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 3 && args(2).is_string ()) - { - std::string data = get_sscanf_data (args(0)); - - if (! error_state) - { - octave_stream os = octave_istrstream::create (data); - - if (os.is_valid ()) - { - if (args(1).is_string ()) - retval = os.oscanf (args(1), who); - else - ::error ("%s: format TEMPLATE must be a string", who.c_str ()); - } - else - ::error ("%s: unable to create temporary input buffer", - who.c_str ()); - } - else - ::error ("%s: argument STRING must be a string", who.c_str ()); - } - else - { - if (nargin == 2 || nargin == 3) - { - retval(3) = -1.0; - retval(2) = "unknown error"; - retval(1) = 0.0; - retval(0) = Matrix (); - - std::string data = get_sscanf_data (args(0)); - - if (! error_state) - { - octave_stream os = octave_istrstream::create (data); - - if (os.is_valid ()) - { - if (args(1).is_string ()) - { - octave_idx_type count = 0; - - Array size = (nargin == 3) - ? args(2).vector_value () - : Array (dim_vector (1, 1), - lo_ieee_inf_value ()); - - octave_value tmp = os.scanf (args(1), size, count, who); - - if (! error_state) - { - // FIXME -- is this the right thing to do? - // Extract error message first, because getting - // position will clear it. - std::string errmsg = os.error (); - - retval(3) - = (os.eof () ? data.length () : os.tell ()) + 1; - retval(2) = errmsg; - retval(1) = count; - retval(0) = tmp; - } - } - else - ::error ("%s: format TEMPLATE must be a string", who.c_str ()); - } - else - ::error ("%s: unable to create temporary input buffer", - who.c_str ()); - } - } - else - print_usage (); - } - - return retval; -} - -DEFUN (scanf, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{val}, @var{count}, @var{errmsg}] =} scanf (@var{template}, @var{size})\n\ -@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}, @var{errmsg}]] =} scanf (@var{template}, \"C\")\n\ -This is equivalent to calling @code{fscanf} with @var{fid} = @code{stdin}.\n\ -\n\ -It is currently not useful to call @code{scanf} in interactive\n\ -programs.\n\ -@seealso{fscanf, sscanf, printf}\n\ -@end deftypefn") -{ - int nargin = args.length (); - - octave_value_list tmp_args (nargin+1, octave_value ()); - - tmp_args (0) = 0.0; - for (int i = 0; i < nargin; i++) - tmp_args (i+1) = args (i); - - return Ffscanf (tmp_args, nargout); -} - -static octave_value -do_fread (octave_stream& os, const octave_value& size_arg, - const octave_value& prec_arg, const octave_value& skip_arg, - const octave_value& arch_arg, octave_idx_type& count) -{ - octave_value retval; - - count = -1; - - Array size = size_arg.vector_value (); - - if (! error_state) - { - std::string prec = prec_arg.string_value (); - - if (! error_state) - { - int block_size = 1; - oct_data_conv::data_type input_type; - oct_data_conv::data_type output_type; - - oct_data_conv::string_to_data_type (prec, block_size, - input_type, output_type); - - if (! error_state) - { - int skip = skip_arg.int_value (true); - - if (! error_state) - { - std::string arch = arch_arg.string_value (); - - if (! error_state) - { - oct_mach_info::float_format flt_fmt - = oct_mach_info::string_to_float_format (arch); - - if (! error_state) - retval = os.read (size, block_size, input_type, - output_type, skip, flt_fmt, count); - } - else - ::error ("fread: ARCH architecture type must be a string"); - } - else - ::error ("fread: SKIP must be an integer"); - } - else - ::error ("fread: invalid PRECISION specified"); - } - else - ::error ("fread: PRECISION must be a string"); - } - else - ::error ("fread: invalid SIZE specified"); - - return retval; -} - -DEFUN (fread, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{val}, @var{count}] =} fread (@var{fid}, @var{size}, @var{precision}, @var{skip}, @var{arch})\n\ -Read binary data of type @var{precision} from the specified file ID\n\ -@var{fid}.\n\ -\n\ -The optional argument @var{size} specifies the amount of data to read\n\ -and may be one of\n\ -\n\ -@table @code\n\ -@item Inf\n\ -Read as much as possible, returning a column vector.\n\ -\n\ -@item @var{nr}\n\ -Read up to @var{nr} elements, returning a column vector.\n\ -\n\ -@item [@var{nr}, Inf]\n\ -Read as much as possible, returning a matrix with @var{nr} rows. If the\n\ -number of elements read is not an exact multiple of @var{nr}, the last\n\ -column is padded with zeros.\n\ -\n\ -@item [@var{nr}, @var{nc}]\n\ -Read up to @code{@var{nr} * @var{nc}} elements, returning a matrix with\n\ -@var{nr} rows. If the number of elements read is not an exact multiple\n\ -of @var{nr}, the last column is padded with zeros.\n\ -@end table\n\ -\n\ -@noindent\n\ -If @var{size} is omitted, a value of @code{Inf} is assumed.\n\ -\n\ -The optional argument @var{precision} is a string specifying the type of\n\ -data to read and may be one of\n\ -\n\ -@table @asis\n\ -@item \"schar\"\n\ -@itemx \"signed char\"\n\ -Signed character.\n\ -\n\ -@item \"uchar\"\n\ -@itemx \"unsigned char\"\n\ -Unsigned character.\n\ -\n\ -@item \"int8\"\n\ -@itemx \"integer*1\"\n\ -\n\ -8-bit signed integer.\n\ -\n\ -@item \"int16\"\n\ -@itemx \"integer*2\"\n\ -16-bit signed integer.\n\ -\n\ -@item \"int32\"\n\ -@itemx \"integer*4\"\n\ -32-bit signed integer.\n\ -\n\ -@item \"int64\"\n\ -@itemx \"integer*8\"\n\ -64-bit signed integer.\n\ -\n\ -@item \"uint8\"\n\ -8-bit unsigned integer.\n\ -\n\ -@item \"uint16\"\n\ -16-bit unsigned integer.\n\ -\n\ -@item \"uint32\"\n\ -32-bit unsigned integer.\n\ -\n\ -@item \"uint64\"\n\ -64-bit unsigned integer.\n\ -\n\ -@item \"single\"\n\ -@itemx \"float32\"\n\ -@itemx \"real*4\"\n\ -32-bit floating point number.\n\ -\n\ -@item \"double\"\n\ -@itemx \"float64\"\n\ -@itemx \"real*8\"\n\ -64-bit floating point number.\n\ -\n\ -@item \"char\"\n\ -@itemx \"char*1\"\n\ -Single character.\n\ -\n\ -@item \"short\"\n\ -Short integer (size is platform dependent).\n\ -\n\ -@item \"int\"\n\ -Integer (size is platform dependent).\n\ -\n\ -@item \"long\"\n\ -Long integer (size is platform dependent).\n\ -\n\ -@item \"ushort\"\n\ -@itemx \"unsigned short\"\n\ -Unsigned short integer (size is platform dependent).\n\ -\n\ -@item \"uint\"\n\ -@itemx \"unsigned int\"\n\ -Unsigned integer (size is platform dependent).\n\ -\n\ -@item \"ulong\"\n\ -@itemx \"unsigned long\"\n\ -Unsigned long integer (size is platform dependent).\n\ -\n\ -@item \"float\"\n\ -Single precision floating point number (size is platform dependent).\n\ -@end table\n\ -\n\ -@noindent\n\ -The default precision is @code{\"uchar\"}.\n\ -\n\ -The @var{precision} argument may also specify an optional repeat\n\ -count. For example, @samp{32*single} causes @code{fread} to read\n\ -a block of 32 single precision floating point numbers. Reading in\n\ -blocks is useful in combination with the @var{skip} argument.\n\ -\n\ -The @var{precision} argument may also specify a type conversion.\n\ -For example, @samp{int16=>int32} causes @code{fread} to read 16-bit\n\ -integer values and return an array of 32-bit integer values. By\n\ -default, @code{fread} returns a double precision array. The special\n\ -form @samp{*TYPE} is shorthand for @samp{TYPE=>TYPE}.\n\ -\n\ -The conversion and repeat counts may be combined. For example, the\n\ -specification @samp{32*single=>single} causes @code{fread} to read\n\ -blocks of single precision floating point values and return an array\n\ -of single precision values instead of the default array of double\n\ -precision values.\n\ -\n\ -The optional argument @var{skip} specifies the number of bytes to skip\n\ -after each element (or block of elements) is read. If it is not\n\ -specified, a value of 0 is assumed. If the final block read is not\n\ -complete, the final skip is omitted. For example,\n\ -\n\ -@example\n\ -fread (f, 10, \"3*single=>single\", 8)\n\ -@end example\n\ -\n\ -@noindent\n\ -will omit the final 8-byte skip because the last read will not be\n\ -a complete block of 3 values.\n\ -\n\ -The optional argument @var{arch} is a string specifying the data format\n\ -for the file. Valid values are\n\ -\n\ -@table @code\n\ -@item \"native\"\n\ -The format of the current machine.\n\ -\n\ -@item \"ieee-be\"\n\ -IEEE big endian.\n\ -\n\ -@item \"ieee-le\"\n\ -IEEE little endian.\n\ -\n\ -@item \"vaxd\"\n\ -VAX D floating format.\n\ -\n\ -@item \"vaxg\"\n\ -VAX G floating format.\n\ -\n\ -@item \"cray\"\n\ -Cray floating format.\n\ -@end table\n\ -\n\ -@noindent\n\ -Conversions are currently only supported for @code{\"ieee-be\"} and\n\ -@code{\"ieee-le\"} formats.\n\ -\n\ -The data read from the file is returned in @var{val}, and the number of\n\ -values read is returned in @code{count}\n\ -@seealso{fwrite, fgets, fgetl, fscanf, fopen}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin > 0 && nargin < 6) - { - retval(1) = -1.0; - retval(0) = Matrix (); - - octave_stream os = octave_stream_list::lookup (args(0), "fread"); - - if (! error_state) - { - octave_value size = lo_ieee_inf_value (); - octave_value prec = "uchar"; - octave_value skip = 0; - octave_value arch = "unknown"; - - int idx = 1; - - if (nargin > idx && ! args(idx).is_string ()) - size = args(idx++); - - if (nargin > idx) - prec = args(idx++); - - if (nargin > idx) - skip = args(idx++); - - if (nargin > idx) - arch = args(idx++); - else if (skip.is_string ()) - { - arch = skip; - skip = 0; - } - - octave_idx_type count = -1; - - octave_value tmp = do_fread (os, size, prec, skip, arch, count); - - retval(1) = count; - retval(0) = tmp; - } - } - else - print_usage (); - - return retval; -} - -static int -do_fwrite (octave_stream& os, const octave_value& data, - const octave_value& prec_arg, const octave_value& skip_arg, - const octave_value& arch_arg) -{ - int retval = -1; - - std::string prec = prec_arg.string_value (); - - if (! error_state) - { - int block_size = 1; - oct_data_conv::data_type output_type; - - oct_data_conv::string_to_data_type (prec, block_size, output_type); - - if (! error_state) - { - int skip = skip_arg.int_value (true); - - if (! error_state) - { - std::string arch = arch_arg.string_value (); - - if (! error_state) - { - oct_mach_info::float_format flt_fmt - = oct_mach_info::string_to_float_format (arch); - - if (! error_state) - retval = os.write (data, block_size, output_type, - skip, flt_fmt); - } - else - ::error ("fwrite: ARCH architecture type must be a string"); - } - else - ::error ("fwrite: SKIP must be an integer"); - } - else - ::error ("fwrite: invalid PRECISION specified"); - } - else - ::error ("fwrite: PRECISION must be a string"); - - return retval; -} - -DEFUN (fwrite, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{count} =} fwrite (@var{fid}, @var{data}, @var{precision}, @var{skip}, @var{arch})\n\ -Write data in binary form of type @var{precision} to the specified file\n\ -ID @var{fid}, returning the number of values successfully written to the\n\ -file.\n\ -\n\ -The argument @var{data} is a matrix of values that are to be written to\n\ -the file. The values are extracted in column-major order.\n\ -\n\ -The remaining arguments @var{precision}, @var{skip}, and @var{arch} are\n\ -optional, and are interpreted as described for @code{fread}.\n\ -\n\ -The behavior of @code{fwrite} is undefined if the values in @var{data}\n\ -are too large to fit in the specified precision.\n\ -@seealso{fread, fputs, fprintf, fopen}\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin > 1 && nargin < 6) - { - octave_stream os = octave_stream_list::lookup (args(0), "fwrite"); - - if (! error_state) - { - octave_value prec = "uchar"; - octave_value skip = 0; - octave_value arch = "unknown"; - - int idx = 1; - - octave_value data = args(idx++); - - if (nargin > idx) - prec = args(idx++); - - if (nargin > idx) - skip = args(idx++); - - if (nargin > idx) - arch = args(idx++); - else if (skip.is_string ()) - { - arch = skip; - skip = 0; - } - - double status = do_fwrite (os, data, prec, skip, arch); - - retval = status; - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("feof", Ffeof, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} feof (@var{fid})\n\ -Return 1 if an end-of-file condition has been encountered for a given\n\ -file and 0 otherwise. Note that it will only return 1 if the end of the\n\ -file has already been encountered, not if the next read operation will\n\ -result in an end-of-file condition.\n\ -@seealso{fread, fopen}\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 1) - { - octave_stream os = octave_stream_list::lookup (args(0), "feof"); - - if (! error_state) - retval = os.eof () ? 1.0 : 0.0; - } - else - print_usage (); - - return retval; -} - -DEFUNX ("ferror", Fferror, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} ferror (@var{fid})\n\ -@deftypefnx {Built-in Function} {[@var{err}, @var{msg}] =} ferror (@var{fid}, \"clear\")\n\ -Return 1 if an error condition has been encountered for the file ID\n\ -@var{fid} and 0 otherwise. Note that it will only return 1 if an error\n\ -has already been encountered, not if the next operation will result in\n\ -an error condition.\n\ -\n\ -The second argument is optional. If it is supplied, also clear the\n\ -error condition.\n\ -@seealso{fclear, fopen}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - octave_stream os = octave_stream_list::lookup (args(0), "ferror"); - - if (! error_state) - { - bool clear = false; - - if (nargin == 2) - { - std::string opt = args(1).string_value (); - - if (! error_state) - clear = (opt == "clear"); - else - return retval; - } - - int error_number = 0; - - std::string error_message = os.error (clear, error_number); - - retval(1) = error_number; - retval(0) = error_message; - } - } - else - print_usage (); - - return retval; -} - -DEFUN (popen, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{fid} =} popen (@var{command}, @var{mode})\n\ -Start a process and create a pipe. The name of the command to run is\n\ -given by @var{command}. The file identifier corresponding to the input\n\ -or output stream of the process is returned in @var{fid}. The argument\n\ -@var{mode} may be\n\ -\n\ -@table @code\n\ -@item \"r\"\n\ -The pipe will be connected to the standard output of the process, and\n\ -open for reading.\n\ -\n\ -@item \"w\"\n\ -The pipe will be connected to the standard input of the process, and\n\ -open for writing.\n\ -@end table\n\ -\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -fid = popen (\"ls -ltr / | tail -3\", \"r\");\n\ -while (ischar (s = fgets (fid)))\n\ - fputs (stdout, s);\n\ -endwhile\n\ -\n\ - @print{} drwxr-xr-x 33 root root 3072 Feb 15 13:28 etc\n\ - @print{} drwxr-xr-x 3 root root 1024 Feb 15 13:28 lib\n\ - @print{} drwxrwxrwt 15 root root 2048 Feb 17 14:53 tmp\n\ -@end group\n\ -@end example\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 2) - { - std::string name = args(0).string_value (); - - if (! error_state) - { - std::string mode = args(1).string_value (); - - if (! error_state) - { - if (mode == "r") - { - octave_stream ips = octave_iprocstream::create (name); - - retval = octave_stream_list::insert (ips); - } - else if (mode == "w") - { - octave_stream ops = octave_oprocstream::create (name); - - retval = octave_stream_list::insert (ops); - } - else - ::error ("popen: invalid MODE specified"); - } - else - ::error ("popen: MODE must be a string"); - } - else - ::error ("popen: COMMAND must be a string"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("pclose", Fpclose, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} pclose (@var{fid})\n\ -Close a file identifier that was opened by @code{popen}. You may also\n\ -use @code{fclose} for the same purpose.\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 1) - retval = octave_stream_list::remove (args(0), "pclose"); - else - print_usage (); - - return retval; -} - -DEFUNX ("tmpnam", Ftmpnam, args, , - "-*- texinfo -*-\n\ -@c List other forms of function in documentation index\n\ -@findex octave_tmp_file_name\n\ -\n\ -@deftypefn {Built-in Function} {} tmpnam ()\n\ -@deftypefnx {Built-in Function} {} tmpnam (@var{dir})\n\ -@deftypefnx {Built-in Function} {} tmpnam (@var{dir}, @var{prefix})\n\ -Return a unique temporary file name as a string.\n\ -\n\ -If @var{prefix} is omitted, a value of @code{\"oct-\"} is used.\n\ -If @var{dir} is also omitted, the default directory for temporary files\n\ -is used. If @var{dir} is provided, it must exist, otherwise the default\n\ -directory for temporary files is used. Since the named file is not\n\ -opened, by @code{tmpnam}, it is possible (though relatively unlikely)\n\ -that it will not be available by the time your program attempts to open it.\n\ -@seealso{tmpfile, mkstemp, P_tmpdir}\n\ -@end deftypefn") -{ - octave_value retval; - - int len = args.length (); - - if (len < 3) - { - std::string dir = len > 0 ? args(0).string_value () : std::string (); - - if (! error_state) - { - std::string pfx - = len > 1 ? args(1).string_value () : std::string ("oct-"); - - if (! error_state) - retval = octave_tempnam (dir, pfx); - else - ::error ("PREFIX must be a string"); - } - else - ::error ("DIR argument must be a string"); - } - else - print_usage (); - - return retval; -} - -DEFALIAS (octave_tmp_file_name, tmpnam); - -DEFUN (tmpfile, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{fid}, @var{msg}] =} tmpfile ()\n\ -Return the file ID corresponding to a new temporary file with a unique\n\ -name. The file is opened in binary read/write (@code{\"w+b\"}) mode.\n\ -The file will be deleted automatically when it is closed or when Octave\n\ -exits.\n\ -\n\ -If successful, @var{fid} is a valid file ID and @var{msg} is an empty\n\ -string. Otherwise, @var{fid} is -1 and @var{msg} contains a\n\ -system-dependent error message.\n\ -@seealso{tmpnam, mkstemp, P_tmpdir}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 0) - { - FILE *fid = gnulib::tmpfile (); - - if (fid) - { - std::string nm; - - std::ios::openmode md = fopen_mode_to_ios_mode ("w+b"); - - octave_stream s = octave_stdiostream::create (nm, fid, md); - - if (s) - retval(0) = octave_stream_list::insert (s); - else - error ("tmpfile: failed to create octave_stdiostream object"); - - } - else - { - retval(1) = gnulib::strerror (errno); - retval(0) = -1; - } - } - else - print_usage (); - - return retval; -} - -DEFUN (mkstemp, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{fid}, @var{name}, @var{msg}] =} mkstemp (@var{template}, @var{delete})\n\ -Return the file ID corresponding to a new temporary file with a unique\n\ -name created from @var{template}. The last six characters of @var{template}\n\ -must be @code{XXXXXX} and these are replaced with a string that makes the\n\ -filename unique. The file is then created with mode read/write and\n\ -permissions that are system dependent (on GNU/Linux systems, the permissions\n\ -will be 0600 for versions of glibc 2.0.7 and later). The file is opened\n\ -in binary mode and with the @w{@code{O_EXCL}} flag.\n\ -\n\ -If the optional argument @var{delete} is supplied and is true,\n\ -the file will be deleted automatically when Octave exits.\n\ -\n\ -If successful, @var{fid} is a valid file ID, @var{name} is the name of\n\ -the file, and @var{msg} is an empty string. Otherwise, @var{fid}\n\ -is -1, @var{name} is empty, and @var{msg} contains a system-dependent\n\ -error message.\n\ -@seealso{tmpfile, tmpnam, P_tmpdir}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(2) = std::string (); - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - std::string tmpl8 = args(0).string_value (); - - if (! error_state) - { - OCTAVE_LOCAL_BUFFER (char, tmp, tmpl8.size () + 1); - strcpy (tmp, tmpl8.c_str ()); - - int fd = gnulib::mkostemp (tmp, O_BINARY); - - if (fd < 0) - { - retval(2) = gnulib::strerror (errno); - retval(0) = fd; - } - else - { - const char *fopen_mode = "w+b"; - - FILE *fid = fdopen (fd, fopen_mode); - - if (fid) - { - std::string nm = tmp; - - std::ios::openmode md = fopen_mode_to_ios_mode (fopen_mode); - - octave_stream s = octave_stdiostream::create (nm, fid, md); - - if (s) - { - retval(1) = nm; - retval(0) = octave_stream_list::insert (s); - - if (nargin == 2 && args(1).is_true ()) - mark_for_deletion (nm); - } - else - error ("mkstemp: failed to create octave_stdiostream object"); - } - else - { - retval(2) = gnulib::strerror (errno); - retval(0) = -1; - } - } - } - else - error ("mkstemp: TEMPLATE argument must be a string"); - } - else - print_usage (); - - return retval; -} - -static int -convert (int x, int ibase, int obase) -{ - int retval = 0; - - int tmp = x % obase; - - if (tmp > ibase - 1) - ::error ("umask: invalid digit"); - else - { - retval = tmp; - int mult = ibase; - while ((x = (x - tmp) / obase)) - { - tmp = x % obase; - if (tmp > ibase - 1) - { - ::error ("umask: invalid digit"); - break; - } - retval += mult * tmp; - mult *= ibase; - } - } - - return retval; -} - -DEFUNX ("umask", Fumask, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} umask (@var{mask})\n\ -Set the permission mask for file creation. The parameter @var{mask}\n\ -is an integer, interpreted as an octal number. If successful,\n\ -returns the previous value of the mask (as an integer to be\n\ -interpreted as an octal number); otherwise an error message is printed.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int status = 0; - - if (args.length () == 1) - { - int mask = args(0).int_value (true); - - if (! error_state) - { - if (mask < 0) - { - status = -1; - ::error ("umask: MASK must be a positive integer value"); - } - else - { - int oct_mask = convert (mask, 8, 10); - - if (! error_state) - status = convert (octave_umask (oct_mask), 10, 8); - } - } - else - { - status = -1; - ::error ("umask: MASK must be an integer"); - } - } - else - print_usage (); - - if (status >= 0) - retval(0) = status; - - return retval; -} - -static octave_value -const_value (const char *, const octave_value_list& args, int val) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - retval = val; - else - print_usage (); - - return retval; -} - -DEFUNX ("P_tmpdir", FP_tmpdir, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} P_tmpdir ()\n\ -Return the default name of the directory for temporary files on\n\ -this system. The name of this directory is system dependent.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - retval = get_P_tmpdir (); - else - print_usage (); - - return retval; -} - -// NOTE: the values of SEEK_SET, SEEK_CUR, and SEEK_END have to be -// this way for Matlab compatibility. - -DEFUNX ("SEEK_SET", FSEEK_SET, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} SEEK_SET ()\n\ -@deftypefnx {Built-in Function} {} SEEK_CUR ()\n\ -@deftypefnx {Built-in Function} {} SEEK_END ()\n\ -Return the numerical value to pass to @code{fseek} to perform\n\ -one of the following actions:\n\ -\n\ -@table @code\n\ -@item SEEK_SET\n\ -Position file relative to the beginning.\n\ -\n\ -@item SEEK_CUR\n\ -Position file relative to the current position.\n\ -\n\ -@item SEEK_END\n\ -Position file relative to the end.\n\ -@end table\n\ -@seealso{fseek}\n\ -@end deftypefn") -{ - return const_value ("SEEK_SET", args, -1); -} - -DEFUNX ("SEEK_CUR", FSEEK_CUR, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} SEEK_CUR ()\n\ -Return the numerical value to pass to @code{fseek} to\n\ -position the file pointer relative to the current position.\n\ -@seealso{SEEK_SET, SEEK_END}.\n\ -@end deftypefn") -{ - return const_value ("SEEK_CUR", args, 0); -} - -DEFUNX ("SEEK_END", FSEEK_END, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} SEEK_END ()\n\ -Return the numerical value to pass to @code{fseek} to\n\ -position the file pointer relative to the end of the file.\n\ -@seealso{SEEK_SET, SEEK_CUR}.\n\ -@end deftypefn") -{ - return const_value ("SEEK_END", args, 1); -} - -static octave_value -const_value (const char *, const octave_value_list& args, - const octave_value& val) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - retval = val; - else - print_usage (); - - return retval; -} - -DEFUNX ("stdin", Fstdin, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} stdin ()\n\ -Return the numeric value corresponding to the standard input stream.\n\ -When Octave is used interactively, this is filtered through the command\n\ -line editing functions.\n\ -@seealso{stdout, stderr}\n\ -@end deftypefn") -{ - return const_value ("stdin", args, stdin_file); -} - -DEFUNX ("stdout", Fstdout, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} stdout ()\n\ -Return the numeric value corresponding to the standard output stream.\n\ -Data written to the standard output is normally filtered through the pager.\n\ -@seealso{stdin, stderr}\n\ -@end deftypefn") -{ - return const_value ("stdout", args, stdout_file); -} - -DEFUNX ("stderr", Fstderr, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} stderr ()\n\ -Return the numeric value corresponding to the standard error stream.\n\ -Even if paging is turned on, the standard error is not sent to the\n\ -pager. It is useful for error messages and prompts.\n\ -@seealso{stdin, stdout}\n\ -@end deftypefn") -{ - return const_value ("stderr", args, stderr_file); -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/file-io.h --- a/libinterp/interpfcn/file-io.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,36 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Written by John C. Campbell - -#if !defined (octave_file_io_h) -#define octave_file_io_h 1 - -extern OCTINTERP_API void initialize_file_io (void); - -extern OCTINTERP_API void close_files (void); - -extern OCTINTERP_API void mark_for_deletion (const std::string&); - -extern OCTINTERP_API void cleanup_tmp_files (void); - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/graphics.cc --- a/libinterp/interpfcn/graphics.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10468 +0,0 @@ -/* - -Copyright (C) 2007-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include -#include - -#include -#include -#include -#include -#include -#include - -#include "cmd-edit.h" -#include "file-ops.h" -#include "file-stat.h" -#include "oct-locbuf.h" -#include "singleton-cleanup.h" - -#include "builtins.h" -#include "cutils.h" -#include "defun.h" -#include "display.h" -#include "error.h" -#include "graphics.h" -#include "input.h" -#include "ov.h" -#include "oct-obj.h" -#include "oct-map.h" -#include "ov-fcn-handle.h" -#include "pager.h" -#include "parse.h" -#include "toplev.h" -#include "txt-eng-ft.h" -#include "unwind-prot.h" - -// forward declarations -static octave_value xget (const graphics_handle& h, const caseless_str& name); - -static void -gripe_set_invalid (const std::string& pname) -{ - error ("set: invalid value for %s property", pname.c_str ()); -} - -// Check to see that PNAME matches just one of PNAMES uniquely. -// Return the full name of the match, or an empty caseless_str object -// if there is no match, or the match is ambiguous. - -static caseless_str -validate_property_name (const std::string& who, const std::string& what, - const std::set& pnames, - const caseless_str& pname) -{ - size_t len = pname.length (); - std::set matches; - - for (std::set::const_iterator p = pnames.begin (); - p != pnames.end (); p++) - { - if (pname.compare (*p, len)) - { - if (len == p->length ()) - { - // Exact match. - return pname; - } - - matches.insert (*p); - } - } - - size_t num_matches = matches.size (); - - if (num_matches == 0) - { - error ("%s: unknown %s property %s", - who.c_str (), what.c_str (), pname.c_str ()); - } - else if (num_matches > 1) - { - string_vector sv (matches); - - std::ostringstream os; - - sv.list_in_columns (os); - - std::string match_list = os.str (); - - error ("%s: ambiguous %s property name %s; possible matches:\n\n%s", - who.c_str (), what.c_str (), pname.c_str (), match_list.c_str ()); - } - else if (num_matches == 1) - { - // Exact match was handled above. - - std::string possible_match = *(matches.begin ()); - - warning_with_id ("Octave:abbreviated-property-match", - "%s: allowing %s to match %s property %s", - who.c_str (), pname.c_str (), what.c_str (), - possible_match.c_str ()); - - return possible_match; - } - - return caseless_str (); -} - -static Matrix -jet_colormap (void) -{ - Matrix cmap (64, 3, 0.0); - - // Produce X in the same manner as linspace so that - // jet_colormap and jet.m produce *exactly* the same result. - double delta = 1.0 / 63.0; - - for (octave_idx_type i = 0; i < 64; i++) - { - // This is the jet colormap. It would be nice to be able - // to feval the jet function but since there is a static - // property object that includes a colormap_property - // object, we need to initialize this before main is even - // called, so calling an interpreted function is not - // possible. - - double x = i*delta; - - if (x >= 3.0/8.0 && x < 5.0/8.0) - cmap(i,0) = 4.0 * x - 3.0/2.0; - else if (x >= 5.0/8.0 && x < 7.0/8.0) - cmap(i,0) = 1.0; - else if (x >= 7.0/8.0) - cmap(i,0) = -4.0 * x + 9.0/2.0; - - if (x >= 1.0/8.0 && x < 3.0/8.0) - cmap(i,1) = 4.0 * x - 1.0/2.0; - else if (x >= 3.0/8.0 && x < 5.0/8.0) - cmap(i,1) = 1.0; - else if (x >= 5.0/8.0 && x < 7.0/8.0) - cmap(i,1) = -4.0 * x + 7.0/2.0; - - if (x < 1.0/8.0) - cmap(i,2) = 4.0 * x + 1.0/2.0; - else if (x >= 1.0/8.0 && x < 3.0/8.0) - cmap(i,2) = 1.0; - else if (x >= 3.0/8.0 && x < 5.0/8.0) - cmap(i,2) = -4.0 * x + 5.0/2.0; - } - - return cmap; -} - -static double -default_screendepth (void) -{ - return display_info::depth (); -} - -static Matrix -default_screensize (void) -{ - Matrix retval (1, 4, 1.0); - - retval(2) = display_info::width (); - retval(3) = display_info::height (); - - return retval; -} - -static double -default_screenpixelsperinch (void) -{ - return (display_info::x_dpi () + display_info::y_dpi ()) / 2; -} - -static Matrix -default_colororder (void) -{ - Matrix retval (7, 3, 0.0); - - retval(0,2) = 1.0; - - retval(1,1) = 0.5; - - retval(2,0) = 1.0; - - retval(3,1) = 0.75; - retval(3,2) = 0.75; - - retval(4,0) = 0.75; - retval(4,2) = 0.75; - - retval(5,0) = 0.75; - retval(5,1) = 0.75; - - retval(6,0) = 0.25; - retval(6,1) = 0.25; - retval(6,2) = 0.25; - - return retval; -} - -static Matrix -default_lim (bool logscale = false) -{ - Matrix m (1, 2, 0); - - if (logscale) - { - m(0) = 0.1; - m(1) = 1.0; - } - else - m(1) = 1; - - return m; -} - -static Matrix -default_data (void) -{ - Matrix retval (1, 2); - - retval(0) = 0; - retval(1) = 1; - - return retval; -} - -static Matrix -default_axes_position (void) -{ - Matrix m (1, 4, 0.0); - m(0) = 0.13; - m(1) = 0.11; - m(2) = 0.775; - m(3) = 0.815; - return m; -} - -static Matrix -default_axes_outerposition (void) -{ - Matrix m (1, 4, 0.0); - m(2) = m(3) = 1.0; - return m; -} - -static Matrix -default_axes_tick (void) -{ - Matrix m (1, 6, 0.0); - m(0) = 0.0; - m(1) = 0.2; - m(2) = 0.4; - m(3) = 0.6; - m(4) = 0.8; - m(5) = 1.0; - return m; -} - -static Matrix -default_axes_ticklength (void) -{ - Matrix m (1, 2, 0.0); - m(0) = 0.01; - m(1) = 0.025; - return m; -} - -static Matrix -default_figure_position (void) -{ - Matrix m (1, 4, 0.0); - m(0) = 300; - m(1) = 200; - m(2) = 560; - m(3) = 420; - return m; -} - -static Matrix -default_figure_papersize (void) -{ - Matrix m (1, 2, 0.0); - m(0) = 8.5; - m(1) = 11.0; - return m; -} - -static Matrix -default_figure_paperposition (void) -{ - Matrix m (1, 4, 0.0); - m(0) = 0.25; - m(1) = 2.50; - m(2) = 8.00; - m(3) = 6.00; - return m; -} - -static Matrix -default_control_position (void) -{ - Matrix retval (1, 4, 0.0); - - retval(0) = 0; - retval(1) = 0; - retval(2) = 80; - retval(3) = 30; - - return retval; -} - -static Matrix -default_control_sliderstep (void) -{ - Matrix retval (1, 2, 0.0); - - retval(0) = 0.01; - retval(1) = 0.1; - - return retval; -} - -static Matrix -default_panel_position (void) -{ - Matrix retval (1, 4, 0.0); - - retval(0) = 0; - retval(1) = 0; - retval(2) = 0.5; - retval(3) = 0.5; - - return retval; -} - -static double -convert_font_size (double font_size, const caseless_str& from_units, - const caseless_str& to_units, double parent_height = 0) -{ - // Simple case where from_units == to_units - - if (from_units.compare (to_units)) - return font_size; - - // Converts the given fontsize using the following transformation: - // => points => - - double points_size = 0; - double res = 0; - - if (from_units.compare ("points")) - points_size = font_size; - else - { - res = xget (0, "screenpixelsperinch").double_value (); - - if (from_units.compare ("pixels")) - points_size = font_size * 72.0 / res; - else if (from_units.compare ("inches")) - points_size = font_size * 72.0; - else if (from_units.compare ("centimeters")) - points_size = font_size * 72.0 / 2.54; - else if (from_units.compare ("normalized")) - points_size = font_size * parent_height * 72.0 / res; - } - - double new_font_size = 0; - - if (to_units.compare ("points")) - new_font_size = points_size; - else - { - if (res <= 0) - res = xget (0, "screenpixelsperinch").double_value (); - - if (to_units.compare ("pixels")) - new_font_size = points_size * res / 72.0; - else if (to_units.compare ("inches")) - new_font_size = points_size / 72.0; - else if (to_units.compare ("centimeters")) - new_font_size = points_size * 2.54 / 72.0; - else if (to_units.compare ("normalized")) - { - // Avoid setting font size to (0/0) = NaN - - if (parent_height > 0) - new_font_size = points_size * res / (parent_height * 72.0); - } - } - - return new_font_size; -} - -static Matrix -convert_position (const Matrix& pos, const caseless_str& from_units, - const caseless_str& to_units, const Matrix& parent_dim) -{ - Matrix retval (1, pos.numel ()); - double res = 0; - bool is_rectangle = (pos.numel () == 4); - bool is_2d = (pos.numel () == 2); - - if (from_units.compare ("pixels")) - retval = pos; - else if (from_units.compare ("normalized")) - { - retval(0) = pos(0) * parent_dim(0) + 1; - retval(1) = pos(1) * parent_dim(1) + 1; - if (is_rectangle) - { - retval(2) = pos(2) * parent_dim(0); - retval(3) = pos(3) * parent_dim(1); - } - else if (! is_2d) - retval(2) = 0; - } - else if (from_units.compare ("characters")) - { - if (res <= 0) - res = xget (0, "screenpixelsperinch").double_value (); - - double f = 0.0; - - // FIXME -- this assumes the system font is Helvetica 10pt - // (for which "x" requires 6x12 pixels at 74.951 pixels/inch) - f = 12.0 * res / 74.951; - - if (f > 0) - { - retval(0) = 0.5 * pos(0) * f; - retval(1) = pos(1) * f; - if (is_rectangle) - { - retval(2) = 0.5 * pos(2) * f; - retval(3) = pos(3) * f; - } - else if (! is_2d) - retval(2) = 0; - } - } - else - { - if (res <= 0) - res = xget (0, "screenpixelsperinch").double_value (); - - double f = 0.0; - - if (from_units.compare ("points")) - f = res / 72.0; - else if (from_units.compare ("inches")) - f = res; - else if (from_units.compare ("centimeters")) - f = res / 2.54; - - if (f > 0) - { - retval(0) = pos(0) * f + 1; - retval(1) = pos(1) * f + 1; - if (is_rectangle) - { - retval(2) = pos(2) * f; - retval(3) = pos(3) * f; - } - else if (! is_2d) - retval(2) = 0; - } - } - - if (! to_units.compare ("pixels")) - { - if (to_units.compare ("normalized")) - { - retval(0) = (retval(0) - 1) / parent_dim(0); - retval(1) = (retval(1) - 1) / parent_dim(1); - if (is_rectangle) - { - retval(2) /= parent_dim(0); - retval(3) /= parent_dim(1); - } - else if (! is_2d) - retval(2) = 0; - } - else if (to_units.compare ("characters")) - { - if (res <= 0) - res = xget (0, "screenpixelsperinch").double_value (); - - double f = 0.0; - - f = 12.0 * res / 74.951; - - if (f > 0) - { - retval(0) = 2 * retval(0) / f; - retval(1) = retval(1) / f; - if (is_rectangle) - { - retval(2) = 2 * retval(2) / f; - retval(3) = retval(3) / f; - } - else if (! is_2d) - retval(2) = 0; - } - } - else - { - if (res <= 0) - res = xget (0, "screenpixelsperinch").double_value (); - - double f = 0.0; - - if (to_units.compare ("points")) - f = res / 72.0; - else if (to_units.compare ("inches")) - f = res; - else if (to_units.compare ("centimeters")) - f = res / 2.54; - - if (f > 0) - { - retval(0) = (retval(0) - 1) / f; - retval(1) = (retval(1) - 1) / f; - if (is_rectangle) - { - retval(2) /= f; - retval(3) /= f; - } - else if (! is_2d) - retval(2) = 0; - } - } - } - else if (! is_rectangle && ! is_2d) - retval(2) = 0; - - return retval; -} - -static Matrix -convert_text_position (const Matrix& pos, const text::properties& props, - const caseless_str& from_units, - const caseless_str& to_units) -{ - graphics_object go = gh_manager::get_object (props.get___myhandle__ ()); - graphics_object ax = go.get_ancestor ("axes"); - - Matrix retval; - - if (ax.valid_object ()) - { - const axes::properties& ax_props = - dynamic_cast (ax.get_properties ()); - graphics_xform ax_xform = ax_props.get_transform (); - bool is_rectangle = (pos.numel () == 4); - Matrix ax_bbox = ax_props.get_boundingbox (true), - ax_size = ax_bbox.extract_n (0, 2, 1, 2); - - if (from_units.compare ("data")) - { - if (is_rectangle) - { - ColumnVector v1 = ax_xform.transform (pos(0), pos(1), 0), - v2 = ax_xform.transform (pos(0) + pos(2), - pos(1) + pos(3), 0); - - retval.resize (1, 4); - - retval(0) = v1(0) - ax_bbox(0) + 1; - retval(1) = ax_bbox(1) + ax_bbox(3) - v1(1) + 1; - retval(2) = v2(0) - v1(0); - retval(3) = v1(1) - v2(1); - } - else - { - ColumnVector v = ax_xform.transform (pos(0), pos(1), pos(2)); - - retval.resize (1, 3); - - retval(0) = v(0) - ax_bbox(0) + 1; - retval(1) = ax_bbox(1) + ax_bbox(3) - v(1) + 1; - retval(2) = 0; - } - } - else - retval = convert_position (pos, from_units, "pixels", ax_size); - - if (! to_units.compare ("pixels")) - { - if (to_units.compare ("data")) - { - if (is_rectangle) - { - ColumnVector v1 = ax_xform.untransform (retval(0) + ax_bbox(0) - 1, - ax_bbox(1) + ax_bbox(3) - retval(1) + 1), - v2 = ax_xform.untransform (retval(0) + retval(2) + ax_bbox(0) - 1, - ax_bbox(1) + ax_bbox(3) - (retval(1) + retval(3)) + 1); - - retval.resize (1, 4); - - retval(0) = v1(0); - retval(1) = v1(1); - retval(2) = v2(0) - v1(0); - retval(3) = v2(1) - v1(1); - } - else - { - ColumnVector v = ax_xform.untransform (retval(0) + ax_bbox(0) - 1, - ax_bbox(1) + ax_bbox(3) - retval(1) + 1); - - retval.resize (1, 3); - - retval(0) = v(0); - retval(1) = v(1); - retval(2) = v(2); - } - } - else - retval = convert_position (retval, "pixels", to_units, ax_size); - } - } - - return retval; -} - -// This function always returns the screensize in pixels -static Matrix -screen_size_pixels (void) -{ - graphics_object obj = gh_manager::get_object (0); - Matrix sz = obj.get ("screensize").matrix_value (); - return convert_position (sz, obj.get ("units").string_value (), "pixels", sz.extract_n (0, 2, 1, 2)).extract_n (0, 2, 1, 2); -} - -static void -convert_cdata_2 (bool is_scaled, double clim_0, double clim_1, - const double *cmapv, double x, octave_idx_type lda, - octave_idx_type nc, octave_idx_type i, double *av) -{ - if (is_scaled) - x = xround ((nc - 1) * (x - clim_0) / (clim_1 - clim_0)); - else - x = xround (x - 1); - - if (xisnan (x)) - { - av[i] = x; - av[i+lda] = x; - av[i+2*lda] = x; - } - else - { - if (x < 0) - x = 0; - else if (x >= nc) - x = (nc - 1); - - octave_idx_type idx = static_cast (x); - - av[i] = cmapv[idx]; - av[i+lda] = cmapv[idx+nc]; - av[i+2*lda] = cmapv[idx+2*nc]; - } -} - -template -void -convert_cdata_1 (bool is_scaled, double clim_0, double clim_1, - const double *cmapv, const T *cv, octave_idx_type lda, - octave_idx_type nc, double *av) -{ - for (octave_idx_type i = 0; i < lda; i++) - convert_cdata_2 (is_scaled, clim_0, clim_1, cmapv, cv[i], lda, nc, i, av); -} - -static octave_value -convert_cdata (const base_properties& props, const octave_value& cdata, - bool is_scaled, int cdim) -{ - dim_vector dv (cdata.dims ()); - - if (dv.length () == cdim && dv(cdim-1) == 3) - return cdata; - - Matrix cmap (1, 3, 0.0); - Matrix clim (1, 2, 0.0); - - graphics_object go = gh_manager::get_object (props.get___myhandle__ ()); - graphics_object fig = go.get_ancestor ("figure"); - - if (fig.valid_object ()) - { - Matrix _cmap = fig.get (caseless_str ("colormap")).matrix_value (); - - if (! error_state) - cmap = _cmap; - } - - if (is_scaled) - { - graphics_object ax = go.get_ancestor ("axes"); - - if (ax.valid_object ()) - { - Matrix _clim = ax.get (caseless_str ("clim")).matrix_value (); - - if (! error_state) - clim = _clim; - } - } - - dv.resize (cdim); - dv(cdim-1) = 3; - - NDArray a (dv); - - octave_idx_type lda = a.numel () / static_cast (3); - octave_idx_type nc = cmap.rows (); - - double *av = a.fortran_vec (); - const double *cmapv = cmap.data (); - - double clim_0 = clim(0); - double clim_1 = clim(1); - -#define CONVERT_CDATA_1(ARRAY_T, VAL_FN) \ - do \ - { \ - ARRAY_T tmp = cdata. VAL_FN ## array_value (); \ - \ - convert_cdata_1 (is_scaled, clim_0, clim_1, cmapv, \ - tmp.data (), lda, nc, av); \ - } \ - while (0) - - if (cdata.is_uint8_type ()) - CONVERT_CDATA_1 (uint8NDArray, uint8_); - else if (cdata.is_single_type ()) - CONVERT_CDATA_1 (FloatNDArray, float_); - else if (cdata.is_double_type ()) - CONVERT_CDATA_1 (NDArray, ); - else - error ("unsupported type for cdata (= %s)", cdata.type_name ().c_str ()); - -#undef CONVERT_CDATA_1 - - return octave_value (a); -} - -template -static void -get_array_limits (const Array& m, double& emin, double& emax, - double& eminp, double& emaxp) -{ - const T *data = m.data (); - octave_idx_type n = m.numel (); - - for (octave_idx_type i = 0; i < n; i++) - { - double e = double (data[i]); - - // Don't need to test for NaN here as NaN>x and NaN emax) - emax = e; - - if (e > 0 && e < eminp) - eminp = e; - - if (e < 0 && e > emaxp) - emaxp = e; - } - } -} - -static bool -lookup_object_name (const caseless_str& name, caseless_str& go_name, - caseless_str& rest) -{ - int len = name.length (); - int offset = 0; - bool result = false; - - if (len >= 4) - { - caseless_str pfx = name.substr (0, 4); - - if (pfx.compare ("axes") || pfx.compare ("line") - || pfx.compare ("text")) - offset = 4; - else if (len >= 5) - { - pfx = name.substr (0, 5); - - if (pfx.compare ("image") || pfx.compare ("patch")) - offset = 5; - else if (len >= 6) - { - pfx = name.substr (0, 6); - - if (pfx.compare ("figure") || pfx.compare ("uimenu")) - offset = 6; - else if (len >= 7) - { - pfx = name.substr (0, 7); - - if (pfx.compare ("surface") || pfx.compare ("hggroup") - || pfx.compare ("uipanel")) - offset = 7; - else if (len >= 9) - { - pfx = name.substr (0, 9); - - if (pfx.compare ("uicontrol") - || pfx.compare ("uitoolbar")) - offset = 9; - else if (len >= 10) - { - pfx = name.substr (0, 10); - - if (pfx.compare ("uipushtool")) - offset = 10; - else if (len >= 12) - { - pfx = name.substr (0, 12); - - if (pfx.compare ("uitoggletool")) - offset = 12; - else if (len >= 13) - { - pfx = name.substr (0, 13); - - if (pfx.compare ("uicontextmenu")) - offset = 13; - } - } - } - } - } - } - } - - if (offset > 0) - { - go_name = pfx; - rest = name.substr (offset); - result = true; - } - } - - return result; -} - -static base_graphics_object* -make_graphics_object_from_type (const caseless_str& type, - const graphics_handle& h = graphics_handle (), - const graphics_handle& p = graphics_handle ()) -{ - base_graphics_object *go = 0; - - if (type.compare ("figure")) - go = new figure (h, p); - else if (type.compare ("axes")) - go = new axes (h, p); - else if (type.compare ("line")) - go = new line (h, p); - else if (type.compare ("text")) - go = new text (h, p); - else if (type.compare ("image")) - go = new image (h, p); - else if (type.compare ("patch")) - go = new patch (h, p); - else if (type.compare ("surface")) - go = new surface (h, p); - else if (type.compare ("hggroup")) - go = new hggroup (h, p); - else if (type.compare ("uimenu")) - go = new uimenu (h, p); - else if (type.compare ("uicontrol")) - go = new uicontrol (h, p); - else if (type.compare ("uipanel")) - go = new uipanel (h, p); - else if (type.compare ("uicontextmenu")) - go = new uicontextmenu (h, p); - else if (type.compare ("uitoolbar")) - go = new uitoolbar (h, p); - else if (type.compare ("uipushtool")) - go = new uipushtool (h, p); - else if (type.compare ("uitoggletool")) - go = new uitoggletool (h, p); - return go; -} - -// --------------------------------------------------------------------- - -bool -base_property::set (const octave_value& v, bool do_run, bool do_notify_toolkit) -{ - if (do_set (v)) - { - - // Notify graphics toolkit. - if (id >= 0 && do_notify_toolkit) - { - graphics_object go = gh_manager::get_object (parent); - if (go) - go.update (id); - } - - // run listeners - if (do_run && ! error_state) - run_listeners (POSTSET); - - return true; - } - - return false; -} - - -void -base_property::run_listeners (listener_mode mode) -{ - const octave_value_list& l = listeners[mode]; - - for (int i = 0; i < l.length (); i++) - { - gh_manager::execute_listener (parent, l(i)); - - if (error_state) - break; - } -} - -radio_values::radio_values (const std::string& opt_string) - : default_val (), possible_vals () -{ - size_t beg = 0; - size_t len = opt_string.length (); - bool done = len == 0; - - while (! done) - { - size_t end = opt_string.find ('|', beg); - - if (end == std::string::npos) - { - end = len; - done = true; - } - - std::string t = opt_string.substr (beg, end-beg); - - // Might want more error checking here... - if (t[0] == '{') - { - t = t.substr (1, t.length () - 2); - default_val = t; - } - else if (beg == 0) // ensure default value - default_val = t; - - possible_vals.insert (t); - - beg = end + 1; - } -} - -std::string -radio_values::values_as_string (void) const -{ - std::string retval; - for (std::set::const_iterator it = possible_vals.begin (); - it != possible_vals.end (); it++) - { - if (retval == "") - { - if (*it == default_value ()) - retval = "{" + *it + "}"; - else - retval = *it; - } - else - { - if (*it == default_value ()) - retval += " | {" + *it + "}"; - else - retval += " | " + *it; - } - } - if (retval != "") - retval = "[ " + retval + " ]"; - return retval; -} - -Cell -radio_values::values_as_cell (void) const -{ - octave_idx_type i = 0; - Cell retval (nelem (), 1); - for (std::set::const_iterator it = possible_vals.begin (); - it != possible_vals.end (); it++) - retval(i++) = std::string (*it); - return retval; -} - -bool -color_values::str2rgb (std::string str) -{ - double tmp_rgb[3] = {0, 0, 0}; - bool retval = true; - unsigned int len = str.length (); - - std::transform (str.begin (), str.end (), str.begin (), tolower); - - if (str.compare (0, len, "blue", 0, len) == 0) - tmp_rgb[2] = 1; - else if (str.compare (0, len, "black", 0, len) == 0 - || str.compare (0, len, "k", 0, len) == 0) - tmp_rgb[0] = tmp_rgb[1] = tmp_rgb[2] = 0; - else if (str.compare (0, len, "red", 0, len) == 0) - tmp_rgb[0] = 1; - else if (str.compare (0, len, "green", 0, len) == 0) - tmp_rgb[1] = 1; - else if (str.compare (0, len, "yellow", 0, len) == 0) - tmp_rgb[0] = tmp_rgb[1] = 1; - else if (str.compare (0, len, "magenta", 0, len) == 0) - tmp_rgb[0] = tmp_rgb[2] = 1; - else if (str.compare (0, len, "cyan", 0, len) == 0) - tmp_rgb[1] = tmp_rgb[2] = 1; - else if (str.compare (0, len, "white", 0, len) == 0 - || str.compare (0, len, "w", 0, len) == 0) - tmp_rgb[0] = tmp_rgb[1] = tmp_rgb[2] = 1; - else - retval = false; - - if (retval) - { - for (int i = 0; i < 3; i++) - xrgb(i) = tmp_rgb[i]; - } - - return retval; -} - -bool -color_property::do_set (const octave_value& val) -{ - if (val.is_string ()) - { - std::string s = val.string_value (); - - if (! s.empty ()) - { - std::string match; - - if (radio_val.contains (s, match)) - { - if (current_type != radio_t || match != current_val) - { - if (s.length () != match.length ()) - warning_with_id ("Octave:abbreviated-property-match", - "%s: allowing %s to match %s value %s", - "set", s.c_str (), get_name ().c_str (), - match.c_str ()); - current_val = match; - current_type = radio_t; - return true; - } - } - else - { - color_values col (s); - if (! error_state) - { - if (current_type != color_t || col != color_val) - { - color_val = col; - current_type = color_t; - return true; - } - } - else - error ("invalid value for color property \"%s\" (value = %s)", - get_name ().c_str (), s.c_str ()); - } - } - else - error ("invalid value for color property \"%s\"", - get_name ().c_str ()); - } - else if (val.is_numeric_type ()) - { - Matrix m = val.matrix_value (); - - if (m.numel () == 3) - { - color_values col (m(0), m(1), m(2)); - if (! error_state) - { - if (current_type != color_t || col != color_val) - { - color_val = col; - current_type = color_t; - return true; - } - } - } - else - error ("invalid value for color property \"%s\"", - get_name ().c_str ()); - } - else - error ("invalid value for color property \"%s\"", - get_name ().c_str ()); - - return false; -} - -bool -double_radio_property::do_set (const octave_value& val) -{ - if (val.is_string ()) - { - std::string s = val.string_value (); - std::string match; - - if (! s.empty () && radio_val.contains (s, match)) - { - if (current_type != radio_t || match != current_val) - { - if (s.length () != match.length ()) - warning_with_id ("Octave:abbreviated-property-match", - "%s: allowing %s to match %s value %s", - "set", s.c_str (), get_name ().c_str (), - match.c_str ()); - current_val = match; - current_type = radio_t; - return true; - } - } - else - error ("invalid value for double_radio property \"%s\"", - get_name ().c_str ()); - } - else if (val.is_scalar_type () && val.is_real_type ()) - { - double new_dval = val.double_value (); - - if (current_type != double_t || new_dval != dval) - { - dval = new_dval; - current_type = double_t; - return true; - } - } - else - error ("invalid value for double_radio property \"%s\"", - get_name ().c_str ()); - - return false; -} - -bool -array_property::validate (const octave_value& v) -{ - bool xok = false; - - // FIXME -- should we always support []? - if (v.is_empty () && v.is_numeric_type ()) - return true; - - // check value type - if (type_constraints.size () > 0) - { - if(type_constraints.find (v.class_name()) != type_constraints.end()) - xok = true; - - // check if complex is allowed (it's also of class "double", so - // checking that alone is not enough to ensure real type) - if (type_constraints.find ("real") != type_constraints.end () - && v.is_complex_type ()) - xok = false; - } - else - xok = v.is_numeric_type (); - - if (xok) - { - dim_vector vdims = v.dims (); - int vlen = vdims.length (); - - xok = false; - - // check value size - if (size_constraints.size () > 0) - for (std::list::const_iterator it = size_constraints.begin (); - ! xok && it != size_constraints.end (); ++it) - { - dim_vector itdims = (*it); - - if (itdims.length () == vlen) - { - xok = true; - - for (int i = 0; xok && i < vlen; i++) - if (itdims(i) >= 0 && itdims(i) != vdims(i)) - xok = false; - } - } - else - return true; - } - - return xok; -} - -bool -array_property::is_equal (const octave_value& v) const -{ - if (data.type_name () == v.type_name ()) - { - if (data.dims () == v.dims ()) - { - -#define CHECK_ARRAY_EQUAL(T,F,A) \ - { \ - if (data.numel () == 1) \ - return data.F ## scalar_value () == \ - v.F ## scalar_value (); \ - else \ - { \ - /* Keep copy of array_value to allow sparse/bool arrays */ \ - /* that are converted, to not be deallocated early */ \ - const A m1 = data.F ## array_value (); \ - const T* d1 = m1.data (); \ - const A m2 = v.F ## array_value (); \ - const T* d2 = m2.data ();\ - \ - bool flag = true; \ - \ - for (int i = 0; flag && i < data.numel (); i++) \ - if (d1[i] != d2[i]) \ - flag = false; \ - \ - return flag; \ - } \ - } - - if (data.is_double_type () || data.is_bool_type ()) - CHECK_ARRAY_EQUAL (double, , NDArray) - else if (data.is_single_type ()) - CHECK_ARRAY_EQUAL (float, float_, FloatNDArray) - else if (data.is_int8_type ()) - CHECK_ARRAY_EQUAL (octave_int8, int8_, int8NDArray) - else if (data.is_int16_type ()) - CHECK_ARRAY_EQUAL (octave_int16, int16_, int16NDArray) - else if (data.is_int32_type ()) - CHECK_ARRAY_EQUAL (octave_int32, int32_, int32NDArray) - else if (data.is_int64_type ()) - CHECK_ARRAY_EQUAL (octave_int64, int64_, int64NDArray) - else if (data.is_uint8_type ()) - CHECK_ARRAY_EQUAL (octave_uint8, uint8_, uint8NDArray) - else if (data.is_uint16_type ()) - CHECK_ARRAY_EQUAL (octave_uint16, uint16_, uint16NDArray) - else if (data.is_uint32_type ()) - CHECK_ARRAY_EQUAL (octave_uint32, uint32_, uint32NDArray) - else if (data.is_uint64_type ()) - CHECK_ARRAY_EQUAL (octave_uint64, uint64_, uint64NDArray) - } - } - - return false; -} - -void -array_property::get_data_limits (void) -{ - xmin = xminp = octave_Inf; - xmax = xmaxp = -octave_Inf; - - if (! data.is_empty ()) - { - if (data.is_integer_type ()) - { - if (data.is_int8_type ()) - get_array_limits (data.int8_array_value (), xmin, xmax, xminp, xmaxp); - else if (data.is_uint8_type ()) - get_array_limits (data.uint8_array_value (), xmin, xmax, xminp, xmaxp); - else if (data.is_int16_type ()) - get_array_limits (data.int16_array_value (), xmin, xmax, xminp, xmaxp); - else if (data.is_uint16_type ()) - get_array_limits (data.uint16_array_value (), xmin, xmax, xminp, xmaxp); - else if (data.is_int32_type ()) - get_array_limits (data.int32_array_value (), xmin, xmax, xminp, xmaxp); - else if (data.is_uint32_type ()) - get_array_limits (data.uint32_array_value (), xmin, xmax, xminp, xmaxp); - else if (data.is_int64_type ()) - get_array_limits (data.int64_array_value (), xmin, xmax, xminp, xmaxp); - else if (data.is_uint64_type ()) - get_array_limits (data.uint64_array_value (), xmin, xmax, xminp, xmaxp); - } - else - get_array_limits (data.array_value (), xmin, xmax, xminp, xmaxp); - } -} - -bool -handle_property::do_set (const octave_value& v) -{ - double dv = v.double_value (); - - if (! error_state) - { - graphics_handle gh = gh_manager::lookup (dv); - - if (xisnan (gh.value ()) || gh.ok ()) - { - if (current_val != gh) - { - current_val = gh; - return true; - } - } - else - error ("set: invalid graphics handle (= %g) for property \"%s\"", - dv, get_name ().c_str ()); - } - else - error ("set: invalid graphics handle for property \"%s\"", - get_name ().c_str ()); - - return false; -} - -Matrix -children_property::do_get_children (bool return_hidden) const -{ - Matrix retval (children_list.size (), 1); - octave_idx_type k = 0; - - graphics_object go = gh_manager::get_object (0); - - root_figure::properties& props = - dynamic_cast (go.get_properties ()); - - if (! props.is_showhiddenhandles ()) - { - for (const_children_list_iterator p = children_list.begin (); - p != children_list.end (); p++) - { - graphics_handle kid = *p; - - if (gh_manager::is_handle_visible (kid)) - { - if (! return_hidden) - retval(k++) = *p; - } - else if (return_hidden) - retval(k++) = *p; - } - - retval.resize (k, 1); - } - else - { - for (const_children_list_iterator p = children_list.begin (); - p != children_list.end (); p++) - retval(k++) = *p; - } - - return retval; -} - -void -children_property::do_delete_children (bool clear) -{ - for (children_list_iterator p = children_list.begin (); - p != children_list.end (); p++) - { - graphics_object go = gh_manager::get_object (*p); - - if (go.valid_object ()) - gh_manager::free (*p); - - } - - if (clear) - children_list.clear (); -} - -bool -callback_property::validate (const octave_value& v) const -{ - // case 1: function handle - // case 2: cell array with first element being a function handle - // case 3: string corresponding to known function name - // case 4: evaluatable string - // case 5: empty matrix - - if (v.is_function_handle ()) - return true; - else if (v.is_string ()) - // complete validation will be done at execution-time - return true; - else if (v.is_cell () && v.length () > 0 - && (v.rows () == 1 || v.columns () == 1) - && v.cell_value ()(0).is_function_handle ()) - return true; - else if (v.is_empty ()) - return true; - - return false; -} - -// If TRUE, we are executing any callback function, or the functions it -// calls. Used to determine handle visibility inside callback -// functions. -static bool executing_callback = false; - -void -callback_property::execute (const octave_value& data) const -{ - unwind_protect frame; - - // We are executing the callback function associated with this - // callback property. When set to true, we avoid recursive calls to - // callback routines. - frame.protect_var (executing); - - // We are executing a callback function, so allow handles that have - // their handlevisibility property set to "callback" to be visible. - frame.protect_var (executing_callback); - - if (! executing) - { - executing = true; - executing_callback = true; - - if (callback.is_defined () && ! callback.is_empty ()) - gh_manager::execute_callback (get_parent (), callback, data); - } -} - -// Used to cache dummy graphics objects from which dynamic -// properties can be cloned. -static std::map dprop_obj_map; - -property -property::create (const std::string& name, const graphics_handle& h, - const caseless_str& type, const octave_value_list& args) -{ - property retval; - - if (type.compare ("string")) - { - std::string val = (args.length () > 0 ? args(0).string_value () : ""); - - if (! error_state) - retval = property (new string_property (name, h, val)); - } - else if (type.compare ("any")) - { - octave_value val = - (args.length () > 0 ? args(0) : octave_value (Matrix ())); - - retval = property (new any_property (name, h, val)); - } - else if (type.compare ("radio")) - { - if (args.length () > 0) - { - std::string vals = args(0).string_value (); - - if (! error_state) - { - retval = property (new radio_property (name, h, vals)); - - if (args.length () > 1) - retval.set (args(1)); - } - else - error ("addproperty: invalid argument for radio property, expected a string value"); - } - else - error ("addproperty: missing possible values for radio property"); - } - else if (type.compare ("double")) - { - double d = (args.length () > 0 ? args(0).double_value () : 0); - - if (! error_state) - retval = property (new double_property (name, h, d)); - } - else if (type.compare ("handle")) - { - double hh = (args.length () > 0 ? args(0).double_value () : octave_NaN); - - if (! error_state) - { - graphics_handle gh (hh); - - retval = property (new handle_property (name, h, gh)); - } - } - else if (type.compare ("boolean")) - { - retval = property (new bool_property (name, h, false)); - - if (args.length () > 0) - retval.set (args(0)); - } - else if (type.compare ("data")) - { - retval = property (new array_property (name, h, Matrix ())); - - if (args.length () > 0) - { - retval.set (args(0)); - - // FIXME -- additional argument could define constraints, - // but is this really useful? - } - } - else if (type.compare ("color")) - { - color_values cv (0, 0, 0); - radio_values rv; - - if (args.length () > 1) - rv = radio_values (args(1).string_value ()); - - if (! error_state) - { - retval = property (new color_property (name, h, cv, rv)); - - if (! error_state) - { - if (args.length () > 0 && ! args(0).is_empty ()) - retval.set (args(0)); - else - retval.set (rv.default_value ()); - } - } - } - else - { - caseless_str go_name, go_rest; - - if (lookup_object_name (type, go_name, go_rest)) - { - graphics_object go; - - std::map::const_iterator it = - dprop_obj_map.find (go_name); - - if (it == dprop_obj_map.end ()) - { - base_graphics_object *bgo = - make_graphics_object_from_type (go_name); - - if (bgo) - { - go = graphics_object (bgo); - - dprop_obj_map[go_name] = go; - } - } - else - go = it->second; - - if (go.valid_object ()) - { - property prop = go.get_properties ().get_property (go_rest); - - if (! error_state) - { - retval = prop.clone (); - - retval.set_parent (h); - retval.set_name (name); - - if (args.length () > 0) - retval.set (args(0)); - } - } - else - error ("addproperty: invalid object type (= %s)", - go_name.c_str ()); - } - else - error ("addproperty: unsupported type for dynamic property (= %s)", - type.c_str ()); - } - - return retval; -} - -static void -finalize_r (const graphics_handle& h) -{ - graphics_object go = gh_manager::get_object (h); - - if (go) - { - Matrix children = go.get_properties ().get_all_children (); - - for (int k = 0; k < children.numel (); k++) - finalize_r (children(k)); - - go.finalize (); - } -} - -static void -initialize_r (const graphics_handle& h) -{ - graphics_object go = gh_manager::get_object (h); - - if (go) - { - Matrix children = go.get_properties ().get_all_children (); - - go.initialize (); - - for (int k = 0; k < children.numel (); k++) - initialize_r (children(k)); - } -} - -void -figure::properties::set_toolkit (const graphics_toolkit& b) -{ - if (toolkit) - finalize_r (get___myhandle__ ()); - - toolkit = b; - __graphics_toolkit__ = b.get_name (); - __plot_stream__ = Matrix (); - - if (toolkit) - initialize_r (get___myhandle__ ()); - - mark_modified (); -} - -// --------------------------------------------------------------------- - -void -property_list::set (const caseless_str& name, const octave_value& val) -{ - size_t offset = 0; - - size_t len = name.length (); - - if (len > 4) - { - caseless_str pfx = name.substr (0, 4); - - if (pfx.compare ("axes") || pfx.compare ("line") - || pfx.compare ("text")) - offset = 4; - else if (len > 5) - { - pfx = name.substr (0, 5); - - if (pfx.compare ("image") || pfx.compare ("patch")) - offset = 5; - else if (len > 6) - { - pfx = name.substr (0, 6); - - if (pfx.compare ("figure") || pfx.compare ("uimenu")) - offset = 6; - else if (len > 7) - { - pfx = name.substr (0, 7); - - if (pfx.compare ("surface") || pfx.compare ("hggroup") - || pfx.compare ("uipanel")) - offset = 7; - else if (len > 9) - { - pfx = name.substr (0, 9); - - if (pfx.compare ("uicontrol") - || pfx.compare ("uitoolbar")) - offset = 9; - else if (len > 10) - { - pfx = name.substr (0, 10); - - if (pfx.compare ("uipushtool")) - offset = 10; - else if (len > 12) - { - pfx = name.substr (0, 12); - - if (pfx.compare ("uitoogletool")) - offset = 12; - else if (len > 13) - { - pfx = name.substr (0, 13); - - if (pfx.compare ("uicontextmenu")) - offset = 13; - } - } - } - } - } - } - } - - if (offset > 0) - { - // FIXME -- should we validate property names and values here? - - std::string pname = name.substr (offset); - - std::transform (pfx.begin (), pfx.end (), pfx.begin (), tolower); - std::transform (pname.begin (), pname.end (), pname.begin (), tolower); - - bool has_property = false; - if (pfx == "axes") - has_property = axes::properties::has_core_property (pname); - else if (pfx == "line") - has_property = line::properties::has_core_property (pname); - else if (pfx == "text") - has_property = text::properties::has_core_property (pname); - else if (pfx == "image") - has_property = image::properties::has_core_property (pname); - else if (pfx == "patch") - has_property = patch::properties::has_core_property (pname); - else if (pfx == "figure") - has_property = figure::properties::has_core_property (pname); - else if (pfx == "surface") - has_property = surface::properties::has_core_property (pname); - else if (pfx == "hggroup") - has_property = hggroup::properties::has_core_property (pname); - else if (pfx == "uimenu") - has_property = uimenu::properties::has_core_property (pname); - else if (pfx == "uicontrol") - has_property = uicontrol::properties::has_core_property (pname); - else if (pfx == "uipanel") - has_property = uipanel::properties::has_core_property (pname); - else if (pfx == "uicontextmenu") - has_property = uicontextmenu::properties::has_core_property (pname); - else if (pfx == "uitoolbar") - has_property = uitoolbar::properties::has_core_property (pname); - else if (pfx == "uipushtool") - has_property = uipushtool::properties::has_core_property (pname); - - if (has_property) - { - bool remove = false; - if (val.is_string ()) - { - std::string tval = val.string_value (); - - remove = (tval.compare ("remove") == 0); - } - - pval_map_type& pval_map = plist_map[pfx]; - - if (remove) - { - pval_map_iterator p = pval_map.find (pname); - - if (p != pval_map.end ()) - pval_map.erase (p); - } - else - pval_map[pname] = val; - } - else - error ("invalid %s property '%s'", pfx.c_str (), pname.c_str ()); - } - } - - if (! error_state && offset == 0) - error ("invalid default property specification"); -} - -octave_value -property_list::lookup (const caseless_str& name) const -{ - octave_value retval; - - size_t offset = 0; - - size_t len = name.length (); - - if (len > 4) - { - caseless_str pfx = name.substr (0, 4); - - if (pfx.compare ("axes") || pfx.compare ("line") - || pfx.compare ("text")) - offset = 4; - else if (len > 5) - { - pfx = name.substr (0, 5); - - if (pfx.compare ("image") || pfx.compare ("patch")) - offset = 5; - else if (len > 6) - { - pfx = name.substr (0, 6); - - if (pfx.compare ("figure") || pfx.compare ("uimenu")) - offset = 6; - else if (len > 7) - { - pfx = name.substr (0, 7); - - if (pfx.compare ("surface") || pfx.compare ("hggroup") - || pfx.compare ("uipanel")) - offset = 7; - else if (len > 9) - { - pfx = name.substr (0, 9); - - if (pfx.compare ("uicontrol") - || pfx.compare ("uitoolbar")) - offset = 9; - else if (len > 10) - { - pfx = name.substr (0, 10); - - if (pfx.compare ("uipushtool")) - offset = 10; - else if (len > 12) - { - pfx = name.substr (0, 12); - - if (pfx.compare ("uitoggletool")) - offset = 12; - else if (len > 13) - { - pfx = name.substr (0, 13); - - if (pfx.compare ("uicontextmenu")) - offset = 13; - } - } - } - } - } - } - } - - if (offset > 0) - { - std::string pname = name.substr (offset); - - std::transform (pfx.begin (), pfx.end (), pfx.begin (), tolower); - std::transform (pname.begin (), pname.end (), pname.begin (), tolower); - - plist_map_const_iterator p = find (pfx); - - if (p != end ()) - { - const pval_map_type& pval_map = p->second; - - pval_map_const_iterator q = pval_map.find (pname); - - if (q != pval_map.end ()) - retval = q->second; - } - } - } - - return retval; -} - -octave_scalar_map -property_list::as_struct (const std::string& prefix_arg) const -{ - octave_scalar_map m; - - for (plist_map_const_iterator p = begin (); p != end (); p++) - { - std::string prefix = prefix_arg + p->first; - - const pval_map_type pval_map = p->second; - - for (pval_map_const_iterator q = pval_map.begin (); - q != pval_map.end (); - q++) - m.assign (prefix + q->first, q->second); - } - - return m; -} - -graphics_handle::graphics_handle (const octave_value& a) - : val (octave_NaN) -{ - if (a.is_empty ()) - /* do nothing */; - else - { - double tval = a.double_value (); - - if (! error_state) - val = tval; - else - error ("invalid graphics handle"); - } -} - -// Set properties given as a cs-list of name, value pairs. - -void -graphics_object::set (const octave_value_list& args) -{ - int nargin = args.length (); - - if (nargin == 0) - error ("graphics_object::set: Nothing to set"); - else if (nargin % 2 == 0) - { - for (int i = 0; i < nargin; i += 2) - { - caseless_str name = args(i).string_value (); - - if (! error_state) - { - octave_value val = args(i+1); - - set_value_or_default (name, val); - - if (error_state) - break; - } - else - error ("set: expecting argument %d to be a property name", i); - } - } - else - error ("set: invalid number of arguments"); -} - -/* -## test set with name, value pairs -%!test -%! set (gcf, "visible", "off"); -%! h = plot (1:10, 10:-1:1); -%! set (h, "linewidth", 10, "marker", "x"); -%! assert (get (h, "linewidth"), 10); -%! assert (get (h, "marker"), "x"); -*/ - -// Set properties given in two cell arrays containing names and values. -void -graphics_object::set (const Array& names, - const Cell& values, octave_idx_type row) -{ - if (names.numel () != values.columns ()) - { - error ("set: number of names must match number of value columns (%d != %d)", - names.numel (), values.columns ()); - } - - octave_idx_type k = names.columns (); - - for (octave_idx_type column = 0; column < k; column++) - { - caseless_str name = names(column); - octave_value val = values(row, column); - - set_value_or_default (name, val); - - if (error_state) - break; - } -} - -/* -## test set with cell array arguments -%!test -%! set (gcf, "visible", "off"); -%! h = plot (1:10, 10:-1:1); -%! set (h, {"linewidth", "marker"}, {10, "x"}); -%! assert (get (h, "linewidth"), 10); -%! assert (get (h, "marker"), "x"); - -## test set with multiple handles and cell array arguments -%!test -%! set (gcf, "visible", "off"); -%! h = plot (1:10, 10:-1:1, 1:10, 1:10); -%! set (h, {"linewidth", "marker"}, {10, "x"; 5, "o"}); -%! assert (get (h, "linewidth"), {10; 5}); -%! assert (get (h, "marker"), {"x"; "o"}); -%! set (h, {"linewidth", "marker"}, {10, "x"}); -%! assert (get (h, "linewidth"), {10; 10}); -%! assert (get (h, "marker"), {"x"; "x"}); - -%!error -%! set (gcf, "visible", "off"); -%! h = plot (1:10, 10:-1:1, 1:10, 1:10); -%! set (h, {"linewidth", "marker"}, {10, "x"; 5, "o"; 7, "."}); - -%!error -%! set (gcf, "visible", "off"); -%! h = plot (1:10, 10:-1:1, 1:10, 1:10); -%! set (h, {"linewidth"}, {10, "x"; 5, "o"}); -*/ - -// Set properties given in a struct array -void -graphics_object::set (const octave_map& m) -{ - for (octave_idx_type p = 0; p < m.nfields (); p++) - { - caseless_str name = m.keys ()[p]; - - octave_value val = octave_value (m.contents (name).elem (m.numel () - 1)); - - set_value_or_default (name, val); - - if (error_state) - break; - } -} - -/* -## test set ticklabels for compatibility -%!test -%! set (gcf (), "visible", "off"); -%! set (gca (), "xticklabel", [0, 0.2, 0.4, 0.6, 0.8, 1]); -%! xticklabel = get (gca (), "xticklabel"); -%! assert (class (xticklabel), "char"); -%! assert (size (xticklabel), [6, 3]); -%!test -%! set (gcf (), "visible", "off"); -%! set (gca (), "xticklabel", "0|0.2|0.4|0.6|0.8|1"); -%! xticklabel = get (gca (), "xticklabel"); -%! assert (class (xticklabel), "char"); -%! assert (size (xticklabel), [6, 3]); -%!test -%! set (gcf (), "visible", "off"); -%! set (gca (), "xticklabel", ["0 "; "0.2"; "0.4"; "0.6"; "0.8"; "1 "]); -%! xticklabel = get (gca (), "xticklabel"); -%! assert (class (xticklabel), "char"); -%! assert (size (xticklabel), [6, 3]); -%!test -%! set (gcf (), "visible", "off"); -%! set (gca (), "xticklabel", {"0", "0.2", "0.4", "0.6", "0.8", "1"}); -%! xticklabel = get (gca (), "xticklabel"); -%! assert (class (xticklabel), "cell"); -%! assert (size (xticklabel), [6, 1]); -*/ - -/* -## test set with struct arguments -%!test -%! set (gcf, "visible", "off"); -%! h = plot (1:10, 10:-1:1); -%! set (h, struct ("linewidth", 10, "marker", "x")); -%! assert (get (h, "linewidth"), 10); -%! assert (get (h, "marker"), "x"); -%! h = plot (1:10, 10:-1:1, 1:10, 1:10); -%! set (h, struct ("linewidth", {5, 10})); -%! assert (get (h, "linewidth"), {10; 10}); -## test ordering -%!test -%! markchanged = @(h, foobar, name) set (h, "userdata", [get(h,"userdata"); {name}]); -%! figure (1, "visible", "off") -%! clf (); -%! h = line (); -%! set (h, "userdata", {}); -%! addlistener (h, "color", {markchanged, "color"}); -%! addlistener (h, "linewidth", {markchanged, "linewidth"}); -%! # "linewidth" first -%! props.linewidth = 2; -%! props.color = "r"; -%! set (h, props); -%! assert (get (h, "userdata"), fieldnames (props)); -%! clear props -%! clf (); -%! h = line (); -%! set (h, "userdata", {}); -%! addlistener (h, "color", {markchanged, "color"}); -%! addlistener (h, "linewidth", {markchanged, "linewidth"}); -%! # "color" first -%! props.color = "r"; -%! props.linewidth = 2; -%! set (h, props); -%! assert (get (h, "userdata"), fieldnames (props)); -%! close (1); -*/ - -// Set a property to a value or to its (factory) default value. - -void -graphics_object::set_value_or_default (const caseless_str& name, - const octave_value& val) -{ - if (val.is_string ()) - { - std::string tval = val.string_value (); - - octave_value default_val; - - if (tval.compare ("default") == 0) - { - default_val = get_default (name); - - if (error_state) - return; - - rep->set (name, default_val); - } - else if (tval.compare ("factory") == 0) - { - default_val = get_factory_default (name); - - if (error_state) - return; - - rep->set (name, default_val); - } - else - { - // Matlab specifically uses "\default" to escape string setting - if (tval.compare ("\\default") == 0) - rep->set (name, "default"); - else if (tval.compare ("\\factory") == 0) - rep->set (name, "factory"); - else - rep->set (name, val); - } - } - else - rep->set (name, val); -} - -/* -## test setting of default values -%!test -%! set (gcf, "visible", "off"); -%! h = plot (1:10, 10:-1:1); -%! set (0, "defaultlinelinewidth", 20); -%! set (h, "linewidth", "default"); -%! assert (get (h, "linewidth"), 20); -%! set (h, "linewidth", "factory"); -%! assert (get (h, "linewidth"), 0.5); -*/ - -static double -make_handle_fraction (void) -{ - static double maxrand = RAND_MAX + 2.0; - - return (rand () + 1.0) / maxrand; -} - -graphics_handle -gh_manager::do_get_handle (bool integer_figure_handle) -{ - graphics_handle retval; - - if (integer_figure_handle) - { - // Figure handles are positive integers corresponding to the - // figure number. - - // We always want the lowest unused figure number. - - retval = 1; - - while (handle_map.find (retval) != handle_map.end ()) - retval++; - } - else - { - // Other graphics handles are negative integers plus some random - // fractional part. To avoid running out of integers, we - // recycle the integer part but tack on a new random part each - // time. - - free_list_iterator p = handle_free_list.begin (); - - if (p != handle_free_list.end ()) - { - retval = *p; - handle_free_list.erase (p); - } - else - { - retval = graphics_handle (next_handle); - - next_handle = std::ceil (next_handle) - 1.0 - make_handle_fraction (); - } - } - - return retval; -} - -void -gh_manager::do_free (const graphics_handle& h) -{ - if (h.ok ()) - { - if (h.value () != 0) - { - iterator p = handle_map.find (h); - - if (p != handle_map.end ()) - { - base_properties& bp = p->second.get_properties (); - - bp.set_beingdeleted (true); - - bp.delete_children (); - - octave_value val = bp.get_deletefcn (); - - bp.execute_deletefcn (); - - // Notify graphics toolkit. - p->second.finalize (); - - // Note: this will be valid only for first explicitly - // deleted object. All its children will then have an - // unknown graphics toolkit. - - // Graphics handles for non-figure objects are negative - // integers plus some random fractional part. To avoid - // running out of integers, we recycle the integer part - // but tack on a new random part each time. - - handle_map.erase (p); - - if (h.value () < 0) - handle_free_list.insert (std::ceil (h.value ()) - make_handle_fraction ()); - } - else - error ("graphics_handle::free: invalid object %g", h.value ()); - } - else - error ("graphics_handle::free: can't delete root figure"); - } -} - -void -gh_manager::do_renumber_figure (const graphics_handle& old_gh, - const graphics_handle& new_gh) -{ - iterator p = handle_map.find (old_gh); - - if (p != handle_map.end ()) - { - graphics_object go = p->second; - - handle_map.erase (p); - - handle_map[new_gh] = go; - - if (old_gh.value () < 0) - handle_free_list.insert (std::ceil (old_gh.value ()) - - make_handle_fraction ()); - } - else - error ("graphics_handle::free: invalid object %g", old_gh.value ()); - - for (figure_list_iterator q = figure_list.begin (); - q != figure_list.end (); q++) - { - if (*q == old_gh) - { - *q = new_gh; - break; - } - } -} - -gh_manager *gh_manager::instance = 0; - -static void -xset (const graphics_handle& h, const caseless_str& name, - const octave_value& val) -{ - graphics_object obj = gh_manager::get_object (h); - obj.set (name, val); -} - -static void -xset (const graphics_handle& h, const octave_value_list& args) -{ - if (args.length () > 0) - { - graphics_object obj = gh_manager::get_object (h); - obj.set (args); - } -} - -static octave_value -xget (const graphics_handle& h, const caseless_str& name) -{ - graphics_object obj = gh_manager::get_object (h); - return obj.get (name); -} - -static graphics_handle -reparent (const octave_value& ov, const std::string& who, - const std::string& property, const graphics_handle& new_parent, - bool adopt = true) -{ - graphics_handle h = octave_NaN; - - double val = ov.double_value (); - - if (! error_state) - { - h = gh_manager::lookup (val); - - if (h.ok ()) - { - graphics_object obj = gh_manager::get_object (h); - - graphics_handle parent_h = obj.get_parent (); - - graphics_object parent_obj = gh_manager::get_object (parent_h); - - parent_obj.remove_child (h); - - if (adopt) - obj.set ("parent", new_parent.value ()); - else - obj.reparent (new_parent); - } - else - error ("%s: invalid graphics handle (= %g) for %s", - who.c_str (), val, property.c_str ()); - } - else - error ("%s: expecting %s to be a graphics handle", - who.c_str (), property.c_str ()); - - return h; -} - -// This function is NOT equivalent to the scripting language function gcf. -graphics_handle -gcf (void) -{ - octave_value val = xget (0, "currentfigure"); - - return val.is_empty () ? octave_NaN : val.double_value (); -} - -// This function is NOT equivalent to the scripting language function gca. -graphics_handle -gca (void) -{ - octave_value val = xget (gcf (), "currentaxes"); - - return val.is_empty () ? octave_NaN : val.double_value (); -} - -static void -delete_graphics_object (const graphics_handle& h) -{ - if (h.ok ()) - { - graphics_object obj = gh_manager::get_object (h); - - // Don't do recursive deleting, due to callbacks - if (! obj.get_properties ().is_beingdeleted ()) - { - graphics_handle parent_h = obj.get_parent (); - - graphics_object parent_obj = - gh_manager::get_object (parent_h); - - // NOTE: free the handle before removing it from its - // parent's children, such that the object's - // state is correct when the deletefcn callback - // is executed - - gh_manager::free (h); - - // A callback function might have already deleted - // the parent - if (parent_obj.valid_object ()) - parent_obj.remove_child (h); - - Vdrawnow_requested = true; - } - } -} - -static void -delete_graphics_object (double val) -{ - delete_graphics_object (gh_manager::lookup (val)); -} - -static void -delete_graphics_objects (const NDArray vals) -{ - for (octave_idx_type i = 0; i < vals.numel (); i++) - delete_graphics_object (vals.elem (i)); -} - -static void -close_figure (const graphics_handle& handle) -{ - octave_value closerequestfcn = xget (handle, "closerequestfcn"); - - OCTAVE_SAFE_CALL (gh_manager::execute_callback, (handle, closerequestfcn)); -} - -static void -force_close_figure (const graphics_handle& handle) -{ - // Remove the deletefcn and closerequestfcn callbacks and delete the - // object directly. - - xset (handle, "deletefcn", Matrix ()); - xset (handle, "closerequestfcn", Matrix ()); - - delete_graphics_object (handle); -} - -void -gh_manager::do_close_all_figures (void) -{ - // FIXME -- should we process or discard pending events? - - event_queue.clear (); - - // Don't use figure_list_iterator because we'll be removing elements - // from the list elsewhere. - - Matrix hlist = do_figure_handle_list (true); - - for (octave_idx_type i = 0; i < hlist.numel (); i++) - { - graphics_handle h = gh_manager::lookup (hlist(i)); - - if (h.ok ()) - close_figure (h); - } - - // They should all be closed now. If not, force them to close. - - hlist = do_figure_handle_list (true); - - for (octave_idx_type i = 0; i < hlist.numel (); i++) - { - graphics_handle h = gh_manager::lookup (hlist(i)); - - if (h.ok ()) - force_close_figure (h); - } - - // None left now, right? - - hlist = do_figure_handle_list (true); - - assert (hlist.numel () == 0); - - // Clear all callback objects from our list. - - callback_objects.clear (); -} - -static void -adopt (const graphics_handle& p, const graphics_handle& h) -{ - graphics_object parent_obj = gh_manager::get_object (p); - parent_obj.adopt (h); -} - -static bool -is_handle (const graphics_handle& h) -{ - return h.ok (); -} - -static bool -is_handle (double val) -{ - graphics_handle h = gh_manager::lookup (val); - - return h.ok (); -} - -static octave_value -is_handle (const octave_value& val) -{ - octave_value retval = false; - - if (val.is_real_scalar () && is_handle (val.double_value ())) - retval = true; - else if (val.is_numeric_type () && val.is_real_type ()) - { - const NDArray handles = val.array_value (); - - if (! error_state) - { - boolNDArray result (handles.dims ()); - - for (octave_idx_type i = 0; i < handles.numel (); i++) - result.xelem (i) = is_handle (handles (i)); - - retval = result; - } - } - - return retval; -} - -static bool -is_figure (double val) -{ - graphics_object obj = gh_manager::get_object (val); - - return obj && obj.isa ("figure"); -} - -static void -xcreatefcn (const graphics_handle& h) -{ - graphics_object obj = gh_manager::get_object (h); - obj.get_properties ().execute_createfcn (); -} - -static void -xinitialize (const graphics_handle& h) -{ - graphics_object go = gh_manager::get_object (h); - - if (go) - go.initialize (); -} - -// --------------------------------------------------------------------- - -void -base_graphics_toolkit::update (const graphics_handle& h, int id) -{ - graphics_object go = gh_manager::get_object (h); - - update (go, id); -} - -bool -base_graphics_toolkit::initialize (const graphics_handle& h) -{ - graphics_object go = gh_manager::get_object (h); - - return initialize (go); -} - -void -base_graphics_toolkit::finalize (const graphics_handle& h) -{ - graphics_object go = gh_manager::get_object (h); - - finalize (go); -} - -// --------------------------------------------------------------------- - -void -base_properties::set_from_list (base_graphics_object& obj, - property_list& defaults) -{ - std::string go_name = graphics_object_name (); - - property_list::plist_map_const_iterator p = defaults.find (go_name); - - if (p != defaults.end ()) - { - const property_list::pval_map_type pval_map = p->second; - - for (property_list::pval_map_const_iterator q = pval_map.begin (); - q != pval_map.end (); - q++) - { - std::string pname = q->first; - - obj.set (pname, q->second); - - if (error_state) - { - error ("error setting default property %s", pname.c_str ()); - break; - } - } - } -} - -octave_value -base_properties::get_dynamic (const caseless_str& name) const -{ - octave_value retval; - - std::map::const_iterator it = all_props.find (name); - - if (it != all_props.end ()) - retval = it->second.get (); - else - error ("get: unknown property \"%s\"", name.c_str ()); - - return retval; -} - -octave_value -base_properties::get_dynamic (bool all) const -{ - octave_scalar_map m; - - for (std::map::const_iterator it = all_props.begin (); - it != all_props.end (); ++it) - if (all || ! it->second.is_hidden ()) - m.assign (it->second.get_name (), it->second.get ()); - - return m; -} - -std::set -base_properties::dynamic_property_names (void) const -{ - return dynamic_properties; -} - -bool -base_properties::has_dynamic_property (const std::string& pname) -{ - const std::set& dynprops = dynamic_property_names (); - - if (dynprops.find (pname) != dynprops.end ()) - return true; - else - return all_props.find (pname) != all_props.end (); -} - -void -base_properties::set_dynamic (const caseless_str& pname, - const octave_value& val) -{ - std::map::iterator it = all_props.find (pname); - - if (it != all_props.end ()) - it->second.set (val); - else - error ("set: unknown property \"%s\"", pname.c_str ()); - - if (! error_state) - { - dynamic_properties.insert (pname); - - mark_modified (); - } -} - -property -base_properties::get_property_dynamic (const caseless_str& name) -{ - std::map::const_iterator it = all_props.find (name); - - if (it == all_props.end ()) - { - error ("get_property: unknown property \"%s\"", name.c_str ()); - return property (); - } - else - return it->second; -} - -void -base_properties::set_parent (const octave_value& val) -{ - double tmp = val.double_value (); - - graphics_handle new_parent = octave_NaN; - - if (! error_state) - { - new_parent = gh_manager::lookup (tmp); - - if (new_parent.ok ()) - { - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - - parent_obj.remove_child (__myhandle__); - - parent = new_parent.as_octave_value (); - - ::adopt (parent.handle_value (), __myhandle__); - } - else - error ("set: invalid graphics handle (= %g) for parent", tmp); - } - else - error ("set: expecting parent to be a graphics handle"); -} - -void -base_properties::mark_modified (void) -{ - __modified__ = "on"; - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - if (parent_obj) - parent_obj.mark_modified (); -} - -void -base_properties::override_defaults (base_graphics_object& obj) -{ - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - - if (parent_obj) - parent_obj.override_defaults (obj); -} - -void -base_properties::update_axis_limits (const std::string& axis_type) const -{ - graphics_object obj = gh_manager::get_object (__myhandle__); - - if (obj) - obj.update_axis_limits (axis_type); -} - -void -base_properties::update_axis_limits (const std::string& axis_type, - const graphics_handle& h) const -{ - graphics_object obj = gh_manager::get_object (__myhandle__); - - if (obj) - obj.update_axis_limits (axis_type, h); -} - -bool -base_properties::is_handle_visible (void) const -{ - return (handlevisibility.is ("on") - || (executing_callback && ! handlevisibility.is ("off"))); -} - -graphics_toolkit -base_properties::get_toolkit (void) const -{ - graphics_object go = gh_manager::get_object (get_parent ()); - - if (go) - return go.get_toolkit (); - else - return graphics_toolkit (); -} - -void -base_properties::update_boundingbox (void) -{ - Matrix kids = get_children (); - - for (int i = 0; i < kids.numel (); i++) - { - graphics_object go = gh_manager::get_object (kids(i)); - - if (go.valid_object ()) - go.get_properties ().update_boundingbox (); - } -} - -void -base_properties::update_autopos (const std::string& elem_type) -{ - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - - if (parent_obj.valid_object ()) - parent_obj.get_properties ().update_autopos (elem_type); -} - -void -base_properties::add_listener (const caseless_str& nm, const octave_value& v, - listener_mode mode) -{ - property p = get_property (nm); - - if (! error_state && p.ok ()) - p.add_listener (v, mode); -} - -void -base_properties::delete_listener (const caseless_str& nm, - const octave_value& v, listener_mode mode) -{ - property p = get_property (nm); - - if (! error_state && p.ok ()) - p.delete_listener (v, mode); -} - -// --------------------------------------------------------------------- - -void -base_graphics_object::update_axis_limits (const std::string& axis_type) -{ - if (valid_object ()) - { - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - - if (parent_obj) - parent_obj.update_axis_limits (axis_type); - } - else - error ("base_graphics_object::update_axis_limits: invalid graphics object"); -} - -void -base_graphics_object::update_axis_limits (const std::string& axis_type, - const graphics_handle& h) -{ - if (valid_object ()) - { - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - - if (parent_obj) - parent_obj.update_axis_limits (axis_type, h); - } - else - error ("base_graphics_object::update_axis_limits: invalid graphics object"); -} - -void -base_graphics_object::remove_all_listeners (void) -{ - octave_map m = get (true).map_value (); - - for (octave_map::const_iterator pa = m.begin (); pa != m.end (); pa++) - { - // FIXME -- there has to be a better way. I think we want to - // ask whether it is OK to delete the listener for the given - // property. How can we know in advance that it will be OK? - - unwind_protect frame; - - frame.protect_var (error_state); - frame.protect_var (discard_error_messages); - frame.protect_var (Vdebug_on_error); - frame.protect_var (Vdebug_on_warning); - - discard_error_messages = true; - Vdebug_on_error = false; - Vdebug_on_warning = false; - - property p = get_properties ().get_property (pa->first); - - if (! error_state && p.ok ()) - p.delete_listener (); - } -} - -std::string -base_graphics_object::values_as_string (void) -{ - std::string retval; - - if (valid_object ()) - { - octave_map m = get ().map_value (); - - for (octave_map::const_iterator pa = m.begin (); pa != m.end (); pa++) - { - if (pa->first != "children") - { - property p = get_properties ().get_property (pa->first); - - if (p.ok () && ! p.is_hidden ()) - { - retval += "\n\t" + std::string (pa->first) + ": "; - if (p.is_radio ()) - retval += p.values_as_string (); - } - } - } - if (retval != "") - retval += "\n"; - } - else - error ("base_graphics_object::values_as_string: invalid graphics object"); - - return retval; -} - -octave_scalar_map -base_graphics_object::values_as_struct (void) -{ - octave_scalar_map retval; - - if (valid_object ()) - { - octave_scalar_map m = get ().scalar_map_value (); - - for (octave_scalar_map::const_iterator pa = m.begin (); - pa != m.end (); pa++) - { - if (pa->first != "children") - { - property p = get_properties ().get_property (pa->first); - - if (p.ok () && ! p.is_hidden ()) - { - if (p.is_radio ()) - retval.assign (p.get_name (), p.values_as_cell ()); - else - retval.assign (p.get_name (), Cell ()); - } - } - } - } - else - error ("base_graphics_object::values_as_struct: invalid graphics object"); - - return retval; -} - -graphics_object -graphics_object::get_ancestor (const std::string& obj_type) const -{ - if (valid_object ()) - { - if (isa (obj_type)) - return *this; - else - return gh_manager::get_object (get_parent ()).get_ancestor (obj_type); - } - else - return graphics_object (); -} - -// --------------------------------------------------------------------- - -#include "graphics-props.cc" - -// --------------------------------------------------------------------- - -void -root_figure::properties::set_currentfigure (const octave_value& v) -{ - graphics_handle val (v); - - if (error_state) - return; - - if (xisnan (val.value ()) || is_handle (val)) - { - currentfigure = val; - - if (val.ok ()) - gh_manager::push_figure (val); - } - else - gripe_set_invalid ("currentfigure"); -} - -void -root_figure::properties::set_callbackobject (const octave_value& v) -{ - graphics_handle val (v); - - if (error_state) - return; - - if (xisnan (val.value ())) - { - if (! cbo_stack.empty ()) - { - val = cbo_stack.front (); - - cbo_stack.pop_front (); - } - - callbackobject = val; - } - else if (is_handle (val)) - { - if (get_callbackobject ().ok ()) - cbo_stack.push_front (get_callbackobject ()); - - callbackobject = val; - } - else - gripe_set_invalid ("callbackobject"); -} - -void -figure::properties::set_integerhandle (const octave_value& val) -{ - if (! error_state) - { - if (integerhandle.set (val, true)) - { - bool int_fig_handle = integerhandle.is_on (); - - graphics_object this_go = gh_manager::get_object (__myhandle__); - - graphics_handle old_myhandle = __myhandle__; - - __myhandle__ = gh_manager::get_handle (int_fig_handle); - - gh_manager::renumber_figure (old_myhandle, __myhandle__); - - graphics_object parent_go = gh_manager::get_object (get_parent ()); - - base_properties& props = parent_go.get_properties (); - - props.renumber_child (old_myhandle, __myhandle__); - - Matrix kids = get_children (); - - for (octave_idx_type i = 0; i < kids.numel (); i++) - { - graphics_object kid = gh_manager::get_object (kids(i)); - - kid.get_properties ().renumber_parent (__myhandle__); - } - - graphics_handle cf = gh_manager::current_figure (); - - if (__myhandle__ == cf) - xset (0, "currentfigure", __myhandle__.value ()); - - this_go.update (integerhandle.get_id ()); - - mark_modified (); - } - } -} - -// FIXME This should update monitorpositions and pointerlocation, but -// as these properties are yet used, and so it doesn't matter that they -// aren't set yet. -void -root_figure::properties::update_units (void) -{ - caseless_str xunits = get_units (); - - Matrix ss = default_screensize (); - - double dpi = get_screenpixelsperinch (); - - if (xunits.compare ("inches")) - { - ss(0) = 0; - ss(1) = 0; - ss(2) /= dpi; - ss(3) /= dpi; - } - else if (xunits.compare ("centimeters")) - { - ss(0) = 0; - ss(1) = 0; - ss(2) *= 2.54 / dpi; - ss(3) *= 2.54 / dpi; - } - else if (xunits.compare ("normalized")) - { - ss = Matrix (1, 4, 1.0); - ss(0) = 0; - ss(1) = 0; - } - else if (xunits.compare ("points")) - { - ss(0) = 0; - ss(1) = 0; - ss(2) *= 72 / dpi; - ss(3) *= 72 / dpi; - } - - set_screensize (ss); -} - -Matrix -root_figure::properties::get_boundingbox (bool, const Matrix&) const -{ - Matrix screen_size = screen_size_pixels (); - Matrix pos = Matrix (1, 4, 0); - pos(2) = screen_size(0); - pos(3) = screen_size(1); - return pos; -} - -/* -%!test -%! set (0, "units", "pixels"); -%! sz = get (0, "screensize") - [1, 1, 0, 0]; -%! dpi = get (0, "screenpixelsperinch"); -%! set (0, "units", "inches"); -%! assert (get (0, "screensize"), sz / dpi, 0.5 / dpi); -%! set (0, "units", "centimeters"); -%! assert (get (0, "screensize"), sz / dpi * 2.54, 0.5 / dpi * 2.54); -%! set (0, "units", "points"); -%! assert (get (0, "screensize"), sz / dpi * 72, 0.5 / dpi * 72); -%! set (0, "units", "normalized"); -%! assert (get (0, "screensize"), [0.0, 0.0, 1.0, 1.0]); -%! set (0, "units", "pixels"); -%! assert (get (0, "screensize"), sz + [1, 1, 0, 0]); -*/ - -void -root_figure::properties::remove_child (const graphics_handle& gh) -{ - gh_manager::pop_figure (gh); - - graphics_handle cf = gh_manager::current_figure (); - - xset (0, "currentfigure", cf.value ()); - - base_properties::remove_child (gh); -} - -property_list -root_figure::factory_properties = root_figure::init_factory_properties (); - -static void -reset_default_properties (property_list& default_properties) -{ - property_list new_defaults; - - for (property_list::plist_map_const_iterator p = default_properties.begin (); - p != default_properties.end (); p++) - { - const property_list::pval_map_type pval_map = p->second; - std::string prefix = p->first; - - for (property_list::pval_map_const_iterator q = pval_map.begin (); - q != pval_map.end (); - q++) - { - std::string s = q->first; - - if (prefix == "axes" && (s == "position" || s == "units")) - new_defaults.set (prefix + s, q->second); - else if (prefix == "figure" && (s == "position" || s == "units" - || s == "windowstyle" - || s == "paperunits")) - new_defaults.set (prefix + s, q->second); - } - } - - default_properties = new_defaults; -} - -void -root_figure::reset_default_properties (void) -{ - ::reset_default_properties (default_properties); -} - -// --------------------------------------------------------------------- - -void -figure::properties::set_currentaxes (const octave_value& v) -{ - graphics_handle val (v); - - if (error_state) - return; - - if (xisnan (val.value ()) || is_handle (val)) - currentaxes = val; - else - gripe_set_invalid ("currentaxes"); -} - -void -figure::properties::remove_child (const graphics_handle& gh) -{ - base_properties::remove_child (gh); - - if (gh == currentaxes.handle_value ()) - { - graphics_handle new_currentaxes; - - Matrix kids = get_children (); - - for (octave_idx_type i = 0; i < kids.numel (); i++) - { - graphics_handle kid = kids(i); - - graphics_object go = gh_manager::get_object (kid); - - if (go.isa ("axes")) - { - new_currentaxes = kid; - break; - } - } - - currentaxes = new_currentaxes; - } -} - -void -figure::properties::set_visible (const octave_value& val) -{ - std::string s = val.string_value (); - - if (! error_state) - { - if (s == "on") - xset (0, "currentfigure", __myhandle__.value ()); - - visible = val; - } -} - -Matrix -figure::properties::get_boundingbox (bool internal, const Matrix&) const -{ - Matrix screen_size = screen_size_pixels (); - Matrix pos = (internal ? - get_position ().matrix_value () : - get_outerposition ().matrix_value ()); - - pos = convert_position (pos, get_units (), "pixels", screen_size); - - pos(0)--; - pos(1)--; - pos(1) = screen_size(1) - pos(1) - pos(3); - - return pos; -} - -void -figure::properties::set_boundingbox (const Matrix& bb, bool internal, - bool do_notify_toolkit) -{ - Matrix screen_size = screen_size_pixels (); - Matrix pos = bb; - - pos(1) = screen_size(1) - pos(1) - pos(3); - pos(1)++; - pos(0)++; - pos = convert_position (pos, "pixels", get_units (), screen_size); - - if (internal) - set_position (pos, do_notify_toolkit); - else - set_outerposition (pos, do_notify_toolkit); -} - -Matrix -figure::properties::map_from_boundingbox (double x, double y) const -{ - Matrix bb = get_boundingbox (true); - Matrix pos (1, 2, 0); - - pos(0) = x; - pos(1) = y; - - pos(1) = bb(3) - pos(1); - pos(0)++; - pos = convert_position (pos, "pixels", get_units (), - bb.extract_n (0, 2, 1, 2)); - - return pos; -} - -Matrix -figure::properties::map_to_boundingbox (double x, double y) const -{ - Matrix bb = get_boundingbox (true); - Matrix pos (1, 2, 0); - - pos(0) = x; - pos(1) = y; - - pos = convert_position (pos, get_units (), "pixels", - bb.extract_n (0, 2, 1, 2)); - pos(0)--; - pos(1) = bb(3) - pos(1); - - return pos; -} - -void -figure::properties::set_position (const octave_value& v, - bool do_notify_toolkit) -{ - if (! error_state) - { - Matrix old_bb, new_bb; - bool modified = false; - - old_bb = get_boundingbox (true); - modified = position.set (v, false, do_notify_toolkit); - new_bb = get_boundingbox (true); - - if (old_bb != new_bb) - { - if (old_bb(2) != new_bb(2) || old_bb(3) != new_bb(3)) - { - execute_resizefcn (); - update_boundingbox (); - } - } - - if (modified) - { - position.run_listeners (POSTSET); - mark_modified (); - } - } -} - -void -figure::properties::set_outerposition (const octave_value& v, - bool do_notify_toolkit) -{ - if (! error_state) - { - if (outerposition.set (v, true, do_notify_toolkit)) - { - mark_modified (); - } - } -} - -void -figure::properties::set_paperunits (const octave_value& v) -{ - if (! error_state) - { - caseless_str typ = get_papertype (); - caseless_str punits = v.string_value (); - if (! error_state) - { - if (punits.compare ("normalized") && typ.compare ("")) - error ("set: can't set the paperunits to normalized when the papertype is custom"); - else - { - caseless_str old_paperunits = get_paperunits (); - if (paperunits.set (v, true)) - { - update_paperunits (old_paperunits); - mark_modified (); - } - } - } - } -} - -void -figure::properties::set_papertype (const octave_value& v) -{ - if (! error_state) - { - caseless_str typ = v.string_value (); - caseless_str punits = get_paperunits (); - if (! error_state) - { - if (punits.compare ("normalized") && typ.compare ("")) - error ("set: can't set the paperunits to normalized when the papertype is custom"); - else - { - if (papertype.set (v, true)) - { - update_papertype (); - mark_modified (); - } - } - } - } -} - -static Matrix -papersize_from_type (const caseless_str punits, const caseless_str typ) -{ - Matrix ret (1, 2, 1.0); - - if (! punits.compare ("normalized")) - { - double in2units; - double mm2units; - - if (punits.compare ("inches")) - { - in2units = 1.0; - mm2units = 1 / 25.4 ; - } - else if (punits.compare ("centimeters")) - { - in2units = 2.54; - mm2units = 1 / 10.0; - } - else // points - { - in2units = 72.0; - mm2units = 72.0 / 25.4; - } - - if (typ.compare ("usletter")) - { - ret (0) = 8.5 * in2units; - ret (1) = 11.0 * in2units; - } - else if (typ.compare ("uslegal")) - { - ret (0) = 8.5 * in2units; - ret (1) = 14.0 * in2units; - } - else if (typ.compare ("tabloid")) - { - ret (0) = 11.0 * in2units; - ret (1) = 17.0 * in2units; - } - else if (typ.compare ("a0")) - { - ret (0) = 841.0 * mm2units; - ret (1) = 1189.0 * mm2units; - } - else if (typ.compare ("a1")) - { - ret (0) = 594.0 * mm2units; - ret (1) = 841.0 * mm2units; - } - else if (typ.compare ("a2")) - { - ret (0) = 420.0 * mm2units; - ret (1) = 594.0 * mm2units; - } - else if (typ.compare ("a3")) - { - ret (0) = 297.0 * mm2units; - ret (1) = 420.0 * mm2units; - } - else if (typ.compare ("a4")) - { - ret (0) = 210.0 * mm2units; - ret (1) = 297.0 * mm2units; - } - else if (typ.compare ("a5")) - { - ret (0) = 148.0 * mm2units; - ret (1) = 210.0 * mm2units; - } - else if (typ.compare ("b0")) - { - ret (0) = 1029.0 * mm2units; - ret (1) = 1456.0 * mm2units; - } - else if (typ.compare ("b1")) - { - ret (0) = 728.0 * mm2units; - ret (1) = 1028.0 * mm2units; - } - else if (typ.compare ("b2")) - { - ret (0) = 514.0 * mm2units; - ret (1) = 728.0 * mm2units; - } - else if (typ.compare ("b3")) - { - ret (0) = 364.0 * mm2units; - ret (1) = 514.0 * mm2units; - } - else if (typ.compare ("b4")) - { - ret (0) = 257.0 * mm2units; - ret (1) = 364.0 * mm2units; - } - else if (typ.compare ("b5")) - { - ret (0) = 182.0 * mm2units; - ret (1) = 257.0 * mm2units; - } - else if (typ.compare ("arch-a")) - { - ret (0) = 9.0 * in2units; - ret (1) = 12.0 * in2units; - } - else if (typ.compare ("arch-b")) - { - ret (0) = 12.0 * in2units; - ret (1) = 18.0 * in2units; - } - else if (typ.compare ("arch-c")) - { - ret (0) = 18.0 * in2units; - ret (1) = 24.0 * in2units; - } - else if (typ.compare ("arch-d")) - { - ret (0) = 24.0 * in2units; - ret (1) = 36.0 * in2units; - } - else if (typ.compare ("arch-e")) - { - ret (0) = 36.0 * in2units; - ret (1) = 48.0 * in2units; - } - else if (typ.compare ("a")) - { - ret (0) = 8.5 * in2units; - ret (1) = 11.0 * in2units; - } - else if (typ.compare ("b")) - { - ret (0) = 11.0 * in2units; - ret (1) = 17.0 * in2units; - } - else if (typ.compare ("c")) - { - ret (0) = 17.0 * in2units; - ret (1) = 22.0 * in2units; - } - else if (typ.compare ("d")) - { - ret (0) = 22.0 * in2units; - ret (1) = 34.0 * in2units; - } - else if (typ.compare ("e")) - { - ret (0) = 34.0 * in2units; - ret (1) = 43.0 * in2units; - } - } - - return ret; -} - -void -figure::properties::update_paperunits (const caseless_str& old_paperunits) -{ - Matrix pos = get_paperposition ().matrix_value (); - Matrix sz = get_papersize ().matrix_value (); - - pos(0) /= sz(0); - pos(1) /= sz(1); - pos(2) /= sz(0); - pos(3) /= sz(1); - - std::string porient = get_paperorientation (); - caseless_str punits = get_paperunits (); - caseless_str typ = get_papertype (); - - if (typ.compare ("")) - { - if (old_paperunits.compare ("centimeters")) - { - sz(0) /= 2.54; - sz(1) /= 2.54; - } - else if (old_paperunits.compare ("points")) - { - sz(0) /= 72.0; - sz(1) /= 72.0; - } - - if (punits.compare ("centimeters")) - { - sz(0) *= 2.54; - sz(1) *= 2.54; - } - else if (punits.compare ("points")) - { - sz(0) *= 72.0; - sz(1) *= 72.0; - } - } - else - { - sz = papersize_from_type (punits, typ); - if (porient == "landscape") - std::swap (sz(0), sz(1)); - } - - pos(0) *= sz(0); - pos(1) *= sz(1); - pos(2) *= sz(0); - pos(3) *= sz(1); - - papersize.set (octave_value (sz)); - paperposition.set (octave_value (pos)); -} - -void -figure::properties::update_papertype (void) -{ - caseless_str typ = get_papertype (); - if (! typ.compare ("")) - { - Matrix sz = papersize_from_type (get_paperunits (), typ); - if (get_paperorientation () == "landscape") - std::swap (sz(0), sz(1)); - // Call papersize.set rather than set_papersize to avoid loops - // between update_papersize and update_papertype - papersize.set (octave_value (sz)); - } -} - -void -figure::properties::update_papersize (void) -{ - Matrix sz = get_papersize ().matrix_value (); - if (sz(0) > sz(1)) - { - std::swap (sz(0), sz(1)); - papersize.set (octave_value (sz)); - paperorientation.set (octave_value ("landscape")); - } - else - { - paperorientation.set ("portrait"); - } - std::string punits = get_paperunits (); - if (punits == "centimeters") - { - sz(0) /= 2.54; - sz(1) /= 2.54; - } - else if (punits == "points") - { - sz(0) /= 72.0; - sz(1) /= 72.0; - } - if (punits == "normalized") - { - caseless_str typ = get_papertype (); - if (get_papertype () == "") - error ("set: can't set the papertype to when the paperunits is normalized"); - } - else - { - // TODO - the papersizes info is also in papersize_from_type(). - // Both should be rewritten to avoid the duplication. - std::string typ = ""; - const double mm2in = 1.0 / 25.4; - const double tol = 0.01; - - if (std::abs (sz(0) - 8.5) + std::abs (sz(1) - 11.0) < tol) - typ = "usletter"; - else if (std::abs (sz(0) - 8.5) + std::abs (sz(1) - 14.0) < tol) - typ = "uslegal"; - else if (std::abs (sz(0) - 11.0) + std::abs (sz(1) - 17.0) < tol) - typ = "tabloid"; - else if (std::abs (sz(0) - 841.0 * mm2in) + std::abs (sz(1) - 1198.0 * mm2in) < tol) - typ = "a0"; - else if (std::abs (sz(0) - 594.0 * mm2in) + std::abs (sz(1) - 841.0 * mm2in) < tol) - typ = "a1"; - else if (std::abs (sz(0) - 420.0 * mm2in) + std::abs (sz(1) - 594.0 * mm2in) < tol) - typ = "a2"; - else if (std::abs (sz(0) - 297.0 * mm2in) + std::abs (sz(1) - 420.0 * mm2in) < tol) - typ = "a3"; - else if (std::abs (sz(0) - 210.0 * mm2in) + std::abs (sz(1) - 297.0 * mm2in) < tol) - typ = "a4"; - else if (std::abs (sz(0) - 148.0 * mm2in) + std::abs (sz(1) - 210.0 * mm2in) < tol) - typ = "a5"; - else if (std::abs (sz(0) - 1029.0 * mm2in) + std::abs (sz(1) - 1456.0 * mm2in) < tol) - typ = "b0"; - else if (std::abs (sz(0) - 728.0 * mm2in) + std::abs (sz(1) - 1028.0 * mm2in) < tol) - typ = "b1"; - else if (std::abs (sz(0) - 514.0 * mm2in) + std::abs (sz(1) - 728.0 * mm2in) < tol) - typ = "b2"; - else if (std::abs (sz(0) - 364.0 * mm2in) + std::abs (sz(1) - 514.0 * mm2in) < tol) - typ = "b3"; - else if (std::abs (sz(0) - 257.0 * mm2in) + std::abs (sz(1) - 364.0 * mm2in) < tol) - typ = "b4"; - else if (std::abs (sz(0) - 182.0 * mm2in) + std::abs (sz(1) - 257.0 * mm2in) < tol) - typ = "b5"; - else if (std::abs (sz(0) - 9.0) + std::abs (sz(1) - 12.0) < tol) - typ = "arch-a"; - else if (std::abs (sz(0) - 12.0) + std::abs (sz(1) - 18.0) < tol) - typ = "arch-b"; - else if (std::abs (sz(0) - 18.0) + std::abs (sz(1) - 24.0) < tol) - typ = "arch-c"; - else if (std::abs (sz(0) - 24.0) + std::abs (sz(1) - 36.0) < tol) - typ = "arch-d"; - else if (std::abs (sz(0) - 36.0) + std::abs (sz(1) - 48.0) < tol) - typ = "arch-e"; - else if (std::abs (sz(0) - 8.5) + std::abs (sz(1) - 11.0) < tol) - typ = "a"; - else if (std::abs (sz(0) - 11.0) + std::abs (sz(1) - 17.0) < tol) - typ = "b"; - else if (std::abs (sz(0) - 17.0) + std::abs (sz(1) - 22.0) < tol) - typ = "c"; - else if (std::abs (sz(0) - 22.0) + std::abs (sz(1) - 34.0) < tol) - typ = "d"; - else if (std::abs (sz(0) - 34.0) + std::abs (sz(1) - 43.0) < tol) - typ = "e"; - // Call papertype.set rather than set_papertype to avoid loops between - // update_papersize and update_papertype - papertype.set (typ); - } - if (punits == "centimeters") - { - sz(0) *= 2.54; - sz(1) *= 2.54; - } - else if (punits == "points") - { - sz(0) *= 72.0; - sz(1) *= 72.0; - } - if (get_paperorientation () == "landscape") - { - std::swap (sz(0), sz(1)); - papersize.set (octave_value (sz)); - } -} - -/* -%!test -%! figure (1, "visible", "off"); -%! set (1, "paperunits", "inches"); -%! set (1, "papersize", [5, 4]); -%! set (1, "paperunits", "points"); -%! assert (get (1, "papersize"), [5, 4] * 72, 1); -%! papersize = get (gcf, "papersize"); -%! set (1, "papersize", papersize + 1); -%! set (1, "papersize", papersize); -%! assert (get (1, "papersize"), [5, 4] * 72, 1); -%! close (1); -%!test -%! figure (1, "visible", "off"); -%! set (1, "paperunits", "inches"); -%! set (1, "papersize", [5, 4]); -%! set (1, "paperunits", "centimeters"); -%! assert (get (1, "papersize"), [5, 4] * 2.54, 2.54/72); -%! papersize = get (gcf, "papersize"); -%! set (1, "papersize", papersize + 1); -%! set (1, "papersize", papersize); -%! assert (get (1, "papersize"), [5, 4] * 2.54, 2.54/72); -%! close (1); -*/ - -void -figure::properties::update_paperorientation (void) -{ - std::string porient = get_paperorientation (); - Matrix sz = get_papersize ().matrix_value (); - Matrix pos = get_paperposition ().matrix_value (); - if ((sz(0) > sz(1) && porient == "portrait") - || (sz(0) < sz(1) && porient == "landscape")) - { - std::swap (sz(0), sz(1)); - std::swap (pos(0), pos(1)); - std::swap (pos(2), pos(3)); - // Call papertype.set rather than set_papertype to avoid loops - // between update_papersize and update_papertype - papersize.set (octave_value (sz)); - paperposition.set (octave_value (pos)); - } -} - -/* -%!test -%! figure (1, "visible", false); -%! tol = 100 * eps (); -%! ## UPPER case and MiXed case is part of test and should not be changed. -%! set (gcf (), "paperorientation", "PORTRAIT"); -%! set (gcf (), "paperunits", "inches"); -%! set (gcf (), "papertype", "USletter"); -%! assert (get (gcf (), "papersize"), [8.5, 11.0], tol); -%! set (gcf (), "paperorientation", "Landscape"); -%! assert (get (gcf (), "papersize"), [11.0, 8.5], tol); -%! set (gcf (), "paperunits", "centimeters"); -%! assert (get (gcf (), "papersize"), [11.0, 8.5] * 2.54, tol); -%! set (gcf (), "papertype", "a4"); -%! assert (get (gcf (), "papersize"), [29.7, 21.0], tol); -%! set (gcf (), "paperunits", "inches", "papersize", [8.5, 11.0]); -%! assert (get (gcf (), "papertype"), "usletter"); -%! assert (get (gcf (), "paperorientation"), "portrait"); -%! set (gcf (), "papersize", [11.0, 8.5]); -%! assert (get (gcf (), "papertype"), "usletter"); -%! assert (get (gcf (), "paperorientation"), "landscape"); -*/ - -void -figure::properties::set_units (const octave_value& v) -{ - if (! error_state) - { - caseless_str old_units = get_units (); - if (units.set (v, true)) - { - update_units (old_units); - mark_modified (); - } - } -} - -void -figure::properties::update_units (const caseless_str& old_units) -{ - position.set (convert_position (get_position ().matrix_value (), old_units, - get_units (), screen_size_pixels ()), false); -} - -/* -%!test -%! figure (1, "visible", false); -%! set (0, "units", "pixels"); -%! rsz = get (0, "screensize"); -%! set (gcf (), "units", "pixels"); -%! fsz = get (gcf (), "position"); -%! set (gcf (), "units", "normalized"); -%! assert (get (gcf (), "position"), (fsz - [1, 1, 0, 0]) ./ rsz([3, 4, 3, 4])); -*/ - -std::string -figure::properties::get_title (void) const -{ - if (is_numbertitle ()) - { - std::ostringstream os; - std::string nm = get_name (); - - os << "Figure " << __myhandle__.value (); - if (! nm.empty ()) - os << ": " << get_name (); - - return os.str (); - } - else - return get_name (); -} - -octave_value -figure::get_default (const caseless_str& name) const -{ - octave_value retval = default_properties.lookup (name); - - if (retval.is_undefined ()) - { - graphics_handle parent = get_parent (); - graphics_object parent_obj = gh_manager::get_object (parent); - - retval = parent_obj.get_default (name); - } - - return retval; -} - -void -figure::reset_default_properties (void) -{ - ::reset_default_properties (default_properties); -} - -// --------------------------------------------------------------------- - -void -axes::properties::init (void) -{ - position.add_constraint (dim_vector (1, 4)); - position.add_constraint (dim_vector (0, 0)); - outerposition.add_constraint (dim_vector (1, 4)); - colororder.add_constraint (dim_vector (-1, 3)); - dataaspectratio.add_constraint (dim_vector (1, 3)); - plotboxaspectratio.add_constraint (dim_vector (1, 3)); - xlim.add_constraint (2); - ylim.add_constraint (2); - zlim.add_constraint (2); - clim.add_constraint (2); - alim.add_constraint (2); - xtick.add_constraint (dim_vector (1, -1)); - ytick.add_constraint (dim_vector (1, -1)); - ztick.add_constraint (dim_vector (1, -1)); - Matrix vw (1, 2, 0); - vw(1) = 90; - view = vw; - view.add_constraint (dim_vector (1, 2)); - cameraposition.add_constraint (dim_vector (1, 3)); - Matrix upv (1, 3, 0.0); - upv(2) = 1.0; - cameraupvector = upv; - cameraupvector.add_constraint (dim_vector (1, 3)); - currentpoint.add_constraint (dim_vector (2, 3)); - ticklength.add_constraint (dim_vector (1, 2)); - tightinset.add_constraint (dim_vector (1, 4)); - looseinset.add_constraint (dim_vector (1, 4)); - update_font (); - - x_zlim.resize (1, 2); - - sx = "linear"; - sy = "linear"; - sz = "linear"; - - calc_ticklabels (xtick, xticklabel, xscale.is ("log")); - calc_ticklabels (ytick, yticklabel, yscale.is ("log")); - calc_ticklabels (ztick, zticklabel, zscale.is ("log")); - - xset (xlabel.handle_value (), "handlevisibility", "off"); - xset (ylabel.handle_value (), "handlevisibility", "off"); - xset (zlabel.handle_value (), "handlevisibility", "off"); - xset (title.handle_value (), "handlevisibility", "off"); - - xset (xlabel.handle_value (), "horizontalalignment", "center"); - xset (xlabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (ylabel.handle_value (), "horizontalalignment", "center"); - xset (ylabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (zlabel.handle_value (), "horizontalalignment", "right"); - xset (zlabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (title.handle_value (), "horizontalalignment", "center"); - xset (title.handle_value (), "horizontalalignmentmode", "auto"); - - xset (xlabel.handle_value (), "verticalalignment", "top"); - xset (xlabel.handle_value (), "verticalalignmentmode", "auto"); - xset (ylabel.handle_value (), "verticalalignment", "bottom"); - xset (ylabel.handle_value (), "verticalalignmentmode", "auto"); - xset (title.handle_value (), "verticalalignment", "bottom"); - xset (title.handle_value (), "verticalalignmentmode", "auto"); - - xset (ylabel.handle_value (), "rotation", 90.0); - xset (ylabel.handle_value (), "rotationmode", "auto"); - - xset (zlabel.handle_value (), "visible", "off"); - - xset (xlabel.handle_value (), "clipping", "off"); - xset (ylabel.handle_value (), "clipping", "off"); - xset (zlabel.handle_value (), "clipping", "off"); - xset (title.handle_value (), "clipping", "off"); - - xset (xlabel.handle_value (), "autopos_tag", "xlabel"); - xset (ylabel.handle_value (), "autopos_tag", "ylabel"); - xset (zlabel.handle_value (), "autopos_tag", "zlabel"); - xset (title.handle_value (), "autopos_tag", "title"); - - adopt (xlabel.handle_value ()); - adopt (ylabel.handle_value ()); - adopt (zlabel.handle_value ()); - adopt (title.handle_value ()); - - Matrix tlooseinset = default_axes_position (); - tlooseinset(2) = 1-tlooseinset(0)-tlooseinset(2); - tlooseinset(3) = 1-tlooseinset(1)-tlooseinset(3); - looseinset = tlooseinset; -} - -Matrix -axes::properties::calc_tightbox (const Matrix& init_pos) -{ - Matrix pos = init_pos; - graphics_object obj = gh_manager::get_object (get_parent ()); - Matrix parent_bb = obj.get_properties ().get_boundingbox (true); - Matrix ext = get_extent (true, true); - ext(1) = parent_bb(3) - ext(1) - ext(3); - ext(0)++; - ext(1)++; - ext = convert_position (ext, "pixels", get_units (), - parent_bb.extract_n (0, 2, 1, 2)); - if (ext(0) < pos(0)) - { - pos(2) += pos(0)-ext(0); - pos(0) = ext(0); - } - if (ext(0)+ext(2) > pos(0)+pos(2)) - pos(2) = ext(0)+ext(2)-pos(0); - - if (ext(1) < pos(1)) - { - pos(3) += pos(1)-ext(1); - pos(1) = ext(1); - } - if (ext(1)+ext(3) > pos(1)+pos(3)) - pos(3) = ext(1)+ext(3)-pos(1); - return pos; -} - -void -axes::properties::sync_positions (void) -{ - Matrix ref_linset = looseinset.get ().matrix_value (); - if (autopos_tag_is ("subplot")) - { - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - if (parent_obj.isa ("figure")) - { - // FIXME: temporarily changed units should be protected - // from interrupts - std::string fig_units = parent_obj.get ("units").string_value (); - parent_obj.set ("units", "pixels"); - - Matrix ref_outbox = outerposition.get ().matrix_value (); - ref_outbox(2) += ref_outbox(0); - ref_outbox(3) += ref_outbox(1); - - // Find those subplots that are left, right, bottom and top aligned - // with the current subplot - Matrix kids = parent_obj.get_properties ().get_children (); - std::vector aligned; - std::vector l_aligned, b_aligned, r_aligned, t_aligned; - for (octave_idx_type i = 0; i < kids.numel (); i++) - { - graphics_object go = gh_manager::get_object (kids(i)); - if (go.isa ("axes")) - { - axes::properties& props = - dynamic_cast (go.get_properties ()); - if (props.autopos_tag_is ("subplot")) - { - Matrix outpos = go.get ("outerposition").matrix_value (); - bool l_align = (std::abs (outpos(0)-ref_outbox(0)) < 1e-15); - bool b_align = (std::abs (outpos(1)-ref_outbox(1)) < 1e-15); - bool r_align = (std::abs (outpos(0)+outpos(2)-ref_outbox(2)) < 1e-15); - bool t_align = (std::abs (outpos(1)+outpos(3)-ref_outbox(3)) < 1e-15); - if (l_align || b_align || r_align || t_align) - { - aligned.push_back (kids(i)); - l_aligned.push_back (l_align); - b_aligned.push_back (b_align); - r_aligned.push_back (r_align); - t_aligned.push_back (t_align); - // FIXME: the temporarily deleted tags should be - // protected from interrupts - props.set_autopos_tag ("none"); - } - } - } - } - // Determine a minimum box which aligns the subplots - Matrix ref_box (1, 4, 0.); - ref_box(2) = 1.; - ref_box(3) = 1.; - for (size_t i = 0; i < aligned.size (); i++) - { - graphics_object go = gh_manager::get_object (aligned[i]); - axes::properties& props = - dynamic_cast (go.get_properties ()); - Matrix linset = props.get_looseinset ().matrix_value (); - if (l_aligned[i]) - linset(0) = std::min (0., linset(0)-0.01); - if (b_aligned[i]) - linset(1) = std::min (0., linset(1)-0.01); - if (r_aligned[i]) - linset(2) = std::min (0., linset(2)-0.01); - if (t_aligned[i]) - linset(3) = std::min (0., linset(3)-0.01); - props.set_looseinset (linset); - Matrix pos = props.get_position ().matrix_value (); - if (l_aligned[i]) - ref_box(0) = std::max (ref_box(0), pos(0)); - if (b_aligned[i]) - ref_box(1) = std::max (ref_box(1), pos(1)); - if (r_aligned[i]) - ref_box(2) = std::min (ref_box(2), pos(0)+pos(2)); - if (t_aligned[i]) - ref_box(3) = std::min (ref_box(3), pos(1)+pos(3)); - } - // Set common looseinset values for all aligned subplots and - // revert their tag values - for (size_t i = 0; i < aligned.size (); i++) - { - graphics_object go = gh_manager::get_object (aligned[i]); - axes::properties& props = - dynamic_cast (go.get_properties ()); - Matrix outpos = props.get_outerposition ().matrix_value (); - Matrix linset = props.get_looseinset ().matrix_value (); - if (l_aligned[i]) - linset(0) = (ref_box(0)-outpos(0))/outpos(2); - if (b_aligned[i]) - linset(1) = (ref_box(1)-outpos(1))/outpos(3); - if (r_aligned[i]) - linset(2) = (outpos(0)+outpos(2)-ref_box(2))/outpos(2); - if (t_aligned[i]) - linset(3) = (outpos(1)+outpos(3)-ref_box(3))/outpos(3); - props.set_looseinset (linset); - props.set_autopos_tag ("subplot"); - } - parent_obj.set ("units", fig_units); - } - } - else - sync_positions (ref_linset); -} - -void -axes::properties::sync_positions (const Matrix& linset) -{ - Matrix pos = position.get ().matrix_value (); - Matrix outpos = outerposition.get ().matrix_value (); - double lratio = linset(0); - double bratio = linset(1); - double wratio = 1-linset(0)-linset(2); - double hratio = 1-linset(1)-linset(3); - if (activepositionproperty.is ("outerposition")) - { - pos = outpos; - pos(0) = outpos(0)+lratio*outpos(2); - pos(1) = outpos(1)+bratio*outpos(3); - pos(2) = wratio*outpos(2); - pos(3) = hratio*outpos(3); - - position = pos; - update_transform (); - Matrix tightpos = calc_tightbox (pos); - - double thrshldx = 0.005*outpos(2); - double thrshldy = 0.005*outpos(3); - double minsizex = 0.2*outpos(2); - double minsizey = 0.2*outpos(3); - bool updatex = true, updatey = true; - for (int i = 0; i < 10; i++) - { - double dt; - bool modified = false; - dt = outpos(0)+outpos(2)-tightpos(0)-tightpos(2); - if (dt < -thrshldx && updatex) - { - pos(2) += dt; - modified = true; - } - dt = outpos(1)+outpos(3)-tightpos(1)-tightpos(3); - if (dt < -thrshldy && updatey) - { - pos(3) += dt; - modified = true; - } - dt = outpos(0)-tightpos(0); - if (dt > thrshldx && updatex) - { - pos(0) += dt; - pos(2) -= dt; - modified = true; - } - dt = outpos(1)-tightpos(1); - if (dt > thrshldy && updatey) - { - pos(1) += dt; - pos(3) -= dt; - modified = true; - } - - // Note: checking limit for minimum axes size - if (pos(2) < minsizex) - { - pos(0) -= 0.5*(minsizex-pos(2)); - pos(2) = minsizex; - updatex = false; - } - if (pos(3) < minsizey) - { - pos(1) -= 0.5*(minsizey-pos(3)); - pos(3) = minsizey; - updatey = false; - } - - if (modified) - { - position = pos; - update_transform (); - tightpos = calc_tightbox (pos); - } - else - break; - } - } - else - { - update_transform (); - - outpos(0) = pos(0)-pos(2)*lratio/wratio; - outpos(1) = pos(1)-pos(3)*bratio/hratio; - outpos(2) = pos(2)/wratio; - outpos(3) = pos(3)/hratio; - - outerposition = calc_tightbox (outpos); - } - - update_insets (); -} - -void -axes::properties::update_insets (void) -{ - Matrix pos = position.get ().matrix_value (); - Matrix outpos = outerposition.get ().matrix_value (); - Matrix tightpos = calc_tightbox (pos); - // Determine the tightinset = axes_bbox - position - Matrix inset (1, 4, 1.0); - inset(0) = pos(0)-tightpos(0); - inset(1) = pos(1)-tightpos(1); - inset(2) = tightpos(0)+tightpos(2)-pos(0)-pos(2); - inset(3) = tightpos(1)+tightpos(3)-pos(1)-pos(3); - tightinset = inset; - - // Determine the looseinset = outerposition - position - inset(0) = pos(0)-outpos(0); - inset(1) = pos(1)-outpos(1); - inset(2) = outpos(0)+outpos(2)-pos(0)-pos(2); - inset(3) = outpos(1)+outpos(3)-pos(1)-pos(3); - looseinset = inset; -} - - -void -axes::properties::set_text_child (handle_property& hp, - const std::string& who, - const octave_value& v) -{ - graphics_handle val; - - if (v.is_string ()) - { - val = gh_manager::make_graphics_handle ("text", __myhandle__, - false, false); - - xset (val, "string", v); - } - else - { - graphics_object go = gh_manager::get_object (gh_manager::lookup (v)); - - if (go.isa ("text")) - val = ::reparent (v, "set", who, __myhandle__, false); - else - { - std::string cname = v.class_name (); - - error ("set: expecting text graphics object or character string for %s property, found %s", - who.c_str (), cname.c_str ()); - } - } - - if (! error_state) - { - xset (val, "handlevisibility", "off"); - - gh_manager::free (hp.handle_value ()); - - base_properties::remove_child (hp.handle_value ()); - - hp = val; - - adopt (hp.handle_value ()); - } -} - -void -axes::properties::set_xlabel (const octave_value& v) -{ - set_text_child (xlabel, "xlabel", v); - xset (xlabel.handle_value (), "positionmode", "auto"); - xset (xlabel.handle_value (), "rotationmode", "auto"); - xset (xlabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (xlabel.handle_value (), "verticalalignmentmode", "auto"); - xset (xlabel.handle_value (), "clipping", "off"); - xset (xlabel.handle_value (), "color", get_xcolor ()); - xset (xlabel.handle_value (), "autopos_tag", "xlabel"); - update_xlabel_position (); -} - -void -axes::properties::set_ylabel (const octave_value& v) -{ - set_text_child (ylabel, "ylabel", v); - xset (ylabel.handle_value (), "positionmode", "auto"); - xset (ylabel.handle_value (), "rotationmode", "auto"); - xset (ylabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (ylabel.handle_value (), "verticalalignmentmode", "auto"); - xset (ylabel.handle_value (), "clipping", "off"); - xset (ylabel.handle_value (), "color", get_ycolor ()); - xset (ylabel.handle_value (), "autopos_tag", "ylabel"); - update_ylabel_position (); -} - -void -axes::properties::set_zlabel (const octave_value& v) -{ - set_text_child (zlabel, "zlabel", v); - xset (zlabel.handle_value (), "positionmode", "auto"); - xset (zlabel.handle_value (), "rotationmode", "auto"); - xset (zlabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (zlabel.handle_value (), "verticalalignmentmode", "auto"); - xset (zlabel.handle_value (), "clipping", "off"); - xset (zlabel.handle_value (), "color", get_zcolor ()); - xset (zlabel.handle_value (), "autopos_tag", "zlabel"); - update_zlabel_position (); -} - -void -axes::properties::set_title (const octave_value& v) -{ - set_text_child (title, "title", v); - xset (title.handle_value (), "positionmode", "auto"); - xset (title.handle_value (), "horizontalalignment", "center"); - xset (title.handle_value (), "horizontalalignmentmode", "auto"); - xset (title.handle_value (), "verticalalignment", "bottom"); - xset (title.handle_value (), "verticalalignmentmode", "auto"); - xset (title.handle_value (), "clipping", "off"); - xset (title.handle_value (), "autopos_tag", "title"); - update_title_position (); -} - -void -axes::properties::set_defaults (base_graphics_object& obj, - const std::string& mode) -{ - box = "on"; - colororder = default_colororder (); - dataaspectratio = Matrix (1, 3, 1.0); - dataaspectratiomode = "auto"; - layer = "bottom"; - - Matrix tlim (1, 2, 0.0); - tlim(1) = 1; - xlim = tlim; - ylim = tlim; - zlim = tlim; - - Matrix cl (1, 2, 0); - cl(1) = 1; - clim = cl; - - xlimmode = "auto"; - ylimmode = "auto"; - zlimmode = "auto"; - climmode = "auto"; - - xgrid = "off"; - ygrid = "off"; - zgrid = "off"; - xminorgrid = "off"; - yminorgrid = "off"; - zminorgrid = "off"; - xtick = Matrix (); - ytick = Matrix (); - ztick = Matrix (); - xtickmode = "auto"; - ytickmode = "auto"; - ztickmode = "auto"; - xticklabel = ""; - yticklabel = ""; - zticklabel = ""; - xticklabelmode = "auto"; - yticklabelmode = "auto"; - zticklabelmode = "auto"; - color = color_values ("white"); - xcolor = color_values ("black"); - ycolor = color_values ("black"); - zcolor = color_values ("black"); - xscale = "linear"; - yscale = "linear"; - zscale = "linear"; - xdir = "normal"; - ydir = "normal"; - zdir = "normal"; - yaxislocation = "left"; - xaxislocation = "bottom"; - - // Note: camera properties will be set through update_transform - camerapositionmode = "auto"; - cameratargetmode = "auto"; - cameraupvectormode = "auto"; - cameraviewanglemode = "auto"; - plotboxaspectratio = Matrix (1, 3, 1.0); - drawmode = "normal"; - gridlinestyle = ":"; - linestyleorder = "-"; - linewidth = 0.5; - minorgridlinestyle = ":"; - // Note: plotboxaspectratio will be set through update_aspectratiors - plotboxaspectratiomode = "auto"; - projection = "orthographic"; - tickdir = "in"; - tickdirmode = "auto"; - ticklength = default_axes_ticklength (); - tightinset = Matrix (1, 4, 0.0); - - sx = "linear"; - sy = "linear"; - sz = "linear"; - - Matrix tview (1, 2, 0.0); - tview(1) = 90; - view = tview; - - visible = "on"; - nextplot = "replace"; - - if (mode != "replace") - { - fontangle = "normal"; - fontname = OCTAVE_DEFAULT_FONTNAME; - fontsize = 10; - fontunits = "points"; - fontweight = "normal"; - - outerposition = default_axes_outerposition (); - position = default_axes_position (); - activepositionproperty = "outerposition"; - } - - delete_children (true); - - xlabel = gh_manager::make_graphics_handle ("text", __myhandle__, - false, false); - - ylabel = gh_manager::make_graphics_handle ("text", __myhandle__, - false, false); - - zlabel = gh_manager::make_graphics_handle ("text", __myhandle__, - false, false); - - title = gh_manager::make_graphics_handle ("text", __myhandle__, - false, false); - - xset (xlabel.handle_value (), "handlevisibility", "off"); - xset (ylabel.handle_value (), "handlevisibility", "off"); - xset (zlabel.handle_value (), "handlevisibility", "off"); - xset (title.handle_value (), "handlevisibility", "off"); - - xset (xlabel.handle_value (), "horizontalalignment", "center"); - xset (xlabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (ylabel.handle_value (), "horizontalalignment", "center"); - xset (ylabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (zlabel.handle_value (), "horizontalalignment", "right"); - xset (zlabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (title.handle_value (), "horizontalalignment", "center"); - xset (title.handle_value (), "horizontalalignmentmode", "auto"); - - xset (xlabel.handle_value (), "verticalalignment", "top"); - xset (xlabel.handle_value (), "verticalalignmentmode", "auto"); - xset (ylabel.handle_value (), "verticalalignment", "bottom"); - xset (ylabel.handle_value (), "verticalalignmentmode", "auto"); - xset (title.handle_value (), "verticalalignment", "bottom"); - xset (title.handle_value (), "verticalalignmentmode", "auto"); - - xset (ylabel.handle_value (), "rotation", 90.0); - xset (ylabel.handle_value (), "rotationmode", "auto"); - - xset (zlabel.handle_value (), "visible", "off"); - - xset (xlabel.handle_value (), "clipping", "off"); - xset (ylabel.handle_value (), "clipping", "off"); - xset (zlabel.handle_value (), "clipping", "off"); - xset (title.handle_value (), "clipping", "off"); - - xset (xlabel.handle_value (), "autopos_tag", "xlabel"); - xset (ylabel.handle_value (), "autopos_tag", "ylabel"); - xset (zlabel.handle_value (), "autopos_tag", "zlabel"); - xset (title.handle_value (), "autopos_tag", "title"); - - adopt (xlabel.handle_value ()); - adopt (ylabel.handle_value ()); - adopt (zlabel.handle_value ()); - adopt (title.handle_value ()); - - update_transform (); - update_insets (); - override_defaults (obj); -} - -void -axes::properties::delete_text_child (handle_property& hp) -{ - graphics_handle h = hp.handle_value (); - - if (h.ok ()) - { - graphics_object go = gh_manager::get_object (h); - - if (go.valid_object ()) - gh_manager::free (h); - - base_properties::remove_child (h); - } - - // FIXME -- is it necessary to check whether the axes object is - // being deleted now? I think this function is only called when an - // individual child object is delete and not when the parent axes - // object is deleted. - - if (! is_beingdeleted ()) - { - hp = gh_manager::make_graphics_handle ("text", __myhandle__, - false, false); - - xset (hp.handle_value (), "handlevisibility", "off"); - - adopt (hp.handle_value ()); - } -} - -void -axes::properties::remove_child (const graphics_handle& h) -{ - if (xlabel.handle_value ().ok () && h == xlabel.handle_value ()) - delete_text_child (xlabel); - else if (ylabel.handle_value ().ok () && h == ylabel.handle_value ()) - delete_text_child (ylabel); - else if (zlabel.handle_value ().ok () && h == zlabel.handle_value ()) - delete_text_child (zlabel); - else if (title.handle_value ().ok () && h == title.handle_value ()) - delete_text_child (title); - else - base_properties::remove_child (h); -} - -inline Matrix -xform_matrix (void) -{ - Matrix m (4, 4, 0.0); - for (int i = 0; i < 4; i++) - m(i,i) = 1; - return m; -} - -inline ColumnVector -xform_vector (void) -{ - ColumnVector v (4, 0.0); - v(3) = 1; - return v; -} - -inline ColumnVector -xform_vector (double x, double y, double z) -{ - ColumnVector v (4, 1.0); - v(0) = x; v(1) = y; v(2) = z; - return v; -} - -inline ColumnVector -transform (const Matrix& m, double x, double y, double z) -{ - return (m * xform_vector (x, y, z)); -} - -inline Matrix -xform_scale (double x, double y, double z) -{ - Matrix m (4, 4, 0.0); - m(0,0) = x; m(1,1) = y; m(2,2) = z; m(3,3) = 1; - return m; -} - -inline Matrix -xform_translate (double x, double y, double z) -{ - Matrix m = xform_matrix (); - m(0,3) = x; m(1,3) = y; m(2,3) = z; m(3,3) = 1; - return m; -} - -inline void -scale (Matrix& m, double x, double y, double z) -{ - m = m * xform_scale (x, y, z); -} - -inline void -translate (Matrix& m, double x, double y, double z) -{ - m = m * xform_translate (x, y, z); -} - -inline void -xform (ColumnVector& v, const Matrix& m) -{ - v = m*v; -} - -inline void -scale (ColumnVector& v, double x, double y, double z) -{ - v(0) *= x; - v(1) *= y; - v(2) *= z; -} - -inline void -translate (ColumnVector& v, double x, double y, double z) -{ - v(0) += x; - v(1) += y; - v(2) += z; -} - -inline void -normalize (ColumnVector& v) -{ - double fact = 1.0 / sqrt (v(0)*v(0)+v(1)*v(1)+v(2)*v(2)); - scale (v, fact, fact, fact); -} - -inline double -dot (const ColumnVector& v1, const ColumnVector& v2) -{ - return (v1(0)*v2(0)+v1(1)*v2(1)+v1(2)*v2(2)); -} - -inline double -norm (const ColumnVector& v) -{ - return sqrt (dot (v, v)); -} - -inline ColumnVector -cross (const ColumnVector& v1, const ColumnVector& v2) -{ - ColumnVector r = xform_vector (); - r(0) = v1(1)*v2(2)-v1(2)*v2(1); - r(1) = v1(2)*v2(0)-v1(0)*v2(2); - r(2) = v1(0)*v2(1)-v1(1)*v2(0); - return r; -} - -inline Matrix -unit_cube (void) -{ - static double data[32] = { - 0,0,0,1, - 1,0,0,1, - 0,1,0,1, - 0,0,1,1, - 1,1,0,1, - 1,0,1,1, - 0,1,1,1, - 1,1,1,1}; - Matrix m (4, 8); - memcpy (m.fortran_vec (), data, sizeof (double)*32); - return m; -} - -inline ColumnVector -cam2xform (const Array& m) -{ - ColumnVector retval (4, 1.0); - memcpy (retval.fortran_vec (), m.fortran_vec (), sizeof (double)*3); - return retval; -} - -inline RowVector -xform2cam (const ColumnVector& v) -{ - return v.extract_n (0, 3).transpose (); -} - -void -axes::properties::update_camera (void) -{ - double xd = (xdir_is ("normal") ? 1 : -1); - double yd = (ydir_is ("normal") ? 1 : -1); - double zd = (zdir_is ("normal") ? 1 : -1); - - Matrix xlimits = sx.scale (get_xlim ().matrix_value ()); - Matrix ylimits = sy.scale (get_ylim ().matrix_value ()); - Matrix zlimits = sz.scale (get_zlim ().matrix_value ()); - - double xo = xlimits(xd > 0 ? 0 : 1); - double yo = ylimits(yd > 0 ? 0 : 1); - double zo = zlimits(zd > 0 ? 0 : 1); - - Matrix pb = get_plotboxaspectratio ().matrix_value (); - - bool autocam = (camerapositionmode_is ("auto") - && cameratargetmode_is ("auto") - && cameraupvectormode_is ("auto") - && cameraviewanglemode_is ("auto")); - bool dowarp = (autocam && dataaspectratiomode_is ("auto") - && plotboxaspectratiomode_is ("auto")); - - ColumnVector c_eye (xform_vector ()); - ColumnVector c_center (xform_vector ()); - ColumnVector c_upv (xform_vector ()); - - if (cameratargetmode_is ("auto")) - { - c_center(0) = (xlimits(0)+xlimits(1))/2; - c_center(1) = (ylimits(0)+ylimits(1))/2; - c_center(2) = (zlimits(0)+zlimits(1))/2; - - cameratarget = xform2cam (c_center); - } - else - c_center = cam2xform (get_cameratarget ().matrix_value ()); - - if (camerapositionmode_is ("auto")) - { - Matrix tview = get_view ().matrix_value (); - double az = tview(0), el = tview(1); - double d = 5 * sqrt (pb(0)*pb(0)+pb(1)*pb(1)+pb(2)*pb(2)); - - if (el == 90 || el == -90) - c_eye(2) = d*signum (el); - else - { - az *= M_PI/180.0; - el *= M_PI/180.0; - c_eye(0) = d * cos (el) * sin (az); - c_eye(1) = -d* cos (el) * cos (az); - c_eye(2) = d * sin (el); - } - c_eye(0) = c_eye(0)*(xlimits(1)-xlimits(0))/(xd*pb(0))+c_center(0); - c_eye(1) = c_eye(1)*(ylimits(1)-ylimits(0))/(yd*pb(1))+c_center(1); - c_eye(2) = c_eye(2)*(zlimits(1)-zlimits(0))/(zd*pb(2))+c_center(2); - - cameraposition = xform2cam (c_eye); - } - else - c_eye = cam2xform (get_cameraposition ().matrix_value ()); - - if (cameraupvectormode_is ("auto")) - { - Matrix tview = get_view ().matrix_value (); - double az = tview(0), el = tview(1); - - if (el == 90 || el == -90) - { - c_upv(0) = - -signum (el) *sin (az*M_PI/180.0)*(xlimits(1)-xlimits(0))/pb(0); - c_upv(1) = - signum (el) * cos (az*M_PI/180.0)*(ylimits(1)-ylimits(0))/pb(1); - } - else - c_upv(2) = 1; - - cameraupvector = xform2cam (c_upv); - } - else - c_upv = cam2xform (get_cameraupvector ().matrix_value ()); - - Matrix x_view = xform_matrix (); - Matrix x_projection = xform_matrix (); - Matrix x_viewport = xform_matrix (); - Matrix x_normrender = xform_matrix (); - Matrix x_pre = xform_matrix (); - - x_render = xform_matrix (); - x_render_inv = xform_matrix (); - - scale (x_pre, pb(0), pb(1), pb(2)); - translate (x_pre, -0.5, -0.5, -0.5); - scale (x_pre, xd/(xlimits(1)-xlimits(0)), yd/(ylimits(1)-ylimits(0)), - zd/(zlimits(1)-zlimits(0))); - translate (x_pre, -xo, -yo, -zo); - - xform (c_eye, x_pre); - xform (c_center, x_pre); - scale (c_upv, pb(0)/(xlimits(1)-xlimits(0)), pb(1)/(ylimits(1)-ylimits(0)), - pb(2)/(zlimits(1)-zlimits(0))); - translate (c_center, -c_eye(0), -c_eye(1), -c_eye(2)); - - ColumnVector F (c_center), f (F), UP (c_upv); - normalize (f); - normalize (UP); - - if (std::abs (dot (f, UP)) > 1e-15) - { - double fa = 1 / sqrt(1-f(2)*f(2)); - scale (UP, fa, fa, fa); - } - - ColumnVector s = cross (f, UP); - ColumnVector u = cross (s, f); - - scale (x_view, 1, 1, -1); - Matrix l = xform_matrix (); - l(0,0) = s(0); l(0,1) = s(1); l(0,2) = s(2); - l(1,0) = u(0); l(1,1) = u(1); l(1,2) = u(2); - l(2,0) = -f(0); l(2,1) = -f(1); l(2,2) = -f(2); - x_view = x_view * l; - translate (x_view, -c_eye(0), -c_eye(1), -c_eye(2)); - scale (x_view, pb(0), pb(1), pb(2)); - translate (x_view, -0.5, -0.5, -0.5); - - Matrix x_cube = x_view * unit_cube (); - ColumnVector cmin = x_cube.row_min (), cmax = x_cube.row_max (); - double xM = cmax(0)-cmin(0); - double yM = cmax(1)-cmin(1); - - Matrix bb = get_boundingbox (true); - - double v_angle; - - if (cameraviewanglemode_is ("auto")) - { - double af; - - // FIXME -- was this really needed? When compared to Matlab, it - // does not seem to be required. Need investigation with concrete - // graphics toolkit to see results visually. - if (false && dowarp) - af = 1.0 / (xM > yM ? xM : yM); - else - { - if ((bb(2)/bb(3)) > (xM/yM)) - af = 1.0 / yM; - else - af = 1.0 / xM; - } - v_angle = 2 * (180.0 / M_PI) * atan (1 / (2 * af * norm (F))); - - cameraviewangle = v_angle; - } - else - v_angle = get_cameraviewangle (); - - double pf = 1 / (2 * tan ((v_angle / 2) * M_PI / 180.0) * norm (F)); - scale (x_projection, pf, pf, 1); - - if (dowarp) - { - xM *= pf; - yM *= pf; - translate (x_viewport, bb(0)+bb(2)/2, bb(1)+bb(3)/2, 0); - scale (x_viewport, bb(2)/xM, -bb(3)/yM, 1); - } - else - { - double pix = 1; - if (autocam) - { - if ((bb(2)/bb(3)) > (xM/yM)) - pix = bb(3); - else - pix = bb(2); - } - else - pix = (bb(2) < bb(3) ? bb(2) : bb(3)); - translate (x_viewport, bb(0)+bb(2)/2, bb(1)+bb(3)/2, 0); - scale (x_viewport, pix, -pix, 1); - } - - x_normrender = x_viewport * x_projection * x_view; - - x_cube = x_normrender * unit_cube (); - cmin = x_cube.row_min (); - cmax = x_cube.row_max (); - x_zlim.resize (1, 2); - x_zlim(0) = cmin(2); - x_zlim(1) = cmax(2); - - x_render = x_normrender; - scale (x_render, xd/(xlimits(1)-xlimits(0)), yd/(ylimits(1)-ylimits(0)), - zd/(zlimits(1)-zlimits(0))); - translate (x_render, -xo, -yo, -zo); - - x_viewtransform = x_view; - x_projectiontransform = x_projection; - x_viewporttransform = x_viewport; - x_normrendertransform = x_normrender; - x_rendertransform = x_render; - - x_render_inv = x_render.inverse (); - - // Note: these matrices are a slight modified version of the regular - // matrices, more suited for OpenGL rendering (x_gl_mat1 => light - // => x_gl_mat2) - x_gl_mat1 = x_view; - scale (x_gl_mat1, xd/(xlimits(1)-xlimits(0)), yd/(ylimits(1)-ylimits(0)), - zd/(zlimits(1)-zlimits(0))); - translate (x_gl_mat1, -xo, -yo, -zo); - x_gl_mat2 = x_viewport * x_projection; -} - -static bool updating_axes_layout = false; - -void -axes::properties::update_axes_layout (void) -{ - if (updating_axes_layout) - return; - - graphics_xform xform = get_transform (); - - double xd = (xdir_is ("normal") ? 1 : -1); - double yd = (ydir_is ("normal") ? 1 : -1); - double zd = (zdir_is ("normal") ? 1 : -1); - - const Matrix xlims = xform.xscale (get_xlim ().matrix_value ()); - const Matrix ylims = xform.yscale (get_ylim ().matrix_value ()); - const Matrix zlims = xform.zscale (get_zlim ().matrix_value ()); - double x_min = xlims(0), x_max = xlims(1); - double y_min = ylims(0), y_max = ylims(1); - double z_min = zlims(0), z_max = zlims(1); - - ColumnVector p1, p2, dir (3); - - xstate = ystate = zstate = AXE_ANY_DIR; - - p1 = xform.transform (x_min, (y_min+y_max)/2, (z_min+z_max)/2, false); - p2 = xform.transform (x_max, (y_min+y_max)/2, (z_min+z_max)/2, false); - dir(0) = xround (p2(0)-p1(0)); - dir(1) = xround (p2(1)-p1(1)); - dir(2) = (p2(2)-p1(2)); - if (dir(0) == 0 && dir(1) == 0) - xstate = AXE_DEPTH_DIR; - else if (dir(2) == 0) - { - if (dir(0) == 0) - xstate = AXE_VERT_DIR; - else if (dir(1) == 0) - xstate = AXE_HORZ_DIR; - } - - if (dir(2) == 0) - { - if (dir(1) == 0) - xPlane = (dir(0) > 0 ? x_max : x_min); - else - xPlane = (dir(1) < 0 ? x_max : x_min); - } - else - xPlane = (dir(2) < 0 ? x_min : x_max); - - xPlaneN = (xPlane == x_min ? x_max : x_min); - fx = (x_max-x_min) / sqrt (dir(0)*dir(0)+dir(1)*dir(1)); - - p1 = xform.transform ((x_min+x_max)/2, y_min, (z_min+z_max)/2, false); - p2 = xform.transform ((x_min+x_max)/2, y_max, (z_min+z_max)/2, false); - dir(0) = xround (p2(0)-p1(0)); - dir(1) = xround (p2(1)-p1(1)); - dir(2) = (p2(2)-p1(2)); - if (dir(0) == 0 && dir(1) == 0) - ystate = AXE_DEPTH_DIR; - else if (dir(2) == 0) - { - if (dir(0) == 0) - ystate = AXE_VERT_DIR; - else if (dir(1) == 0) - ystate = AXE_HORZ_DIR; - } - - if (dir(2) == 0) - { - if (dir(1) == 0) - yPlane = (dir(0) > 0 ? y_max : y_min); - else - yPlane = (dir(1) < 0 ? y_max : y_min); - } - else - yPlane = (dir(2) < 0 ? y_min : y_max); - - yPlaneN = (yPlane == y_min ? y_max : y_min); - fy = (y_max-y_min) / sqrt (dir(0)*dir(0)+dir(1)*dir(1)); - - p1 = xform.transform ((x_min+x_max)/2, (y_min+y_max)/2, z_min, false); - p2 = xform.transform ((x_min+x_max)/2, (y_min+y_max)/2, z_max, false); - dir(0) = xround (p2(0)-p1(0)); - dir(1) = xround (p2(1)-p1(1)); - dir(2) = (p2(2)-p1(2)); - if (dir(0) == 0 && dir(1) == 0) - zstate = AXE_DEPTH_DIR; - else if (dir(2) == 0) - { - if (dir(0) == 0) - zstate = AXE_VERT_DIR; - else if (dir(1) == 0) - zstate = AXE_HORZ_DIR; - } - - if (dir(2) == 0) - { - if (dir(1) == 0) - zPlane = (dir(0) > 0 ? z_min : z_max); - else - zPlane = (dir(1) < 0 ? z_min : z_max); - } - else - zPlane = (dir(2) < 0 ? z_min : z_max); - - zPlaneN = (zPlane == z_min ? z_max : z_min); - fz = (z_max-z_min) / sqrt (dir(0)*dir(0)+dir(1)*dir(1)); - - unwind_protect frame; - frame.protect_var (updating_axes_layout); - updating_axes_layout = true; - - xySym = (xd*yd*(xPlane-xPlaneN)*(yPlane-yPlaneN) > 0); - zSign = (zd*(zPlane-zPlaneN) <= 0); - xyzSym = zSign ? xySym : !xySym; - xpTick = (zSign ? xPlaneN : xPlane); - ypTick = (zSign ? yPlaneN : yPlane); - zpTick = (zSign ? zPlane : zPlaneN); - xpTickN = (zSign ? xPlane : xPlaneN); - ypTickN = (zSign ? yPlane : yPlaneN); - zpTickN = (zSign ? zPlaneN : zPlane); - - /* 2D mode */ - x2Dtop = false; - y2Dright = false; - layer2Dtop = false; - if (xstate == AXE_HORZ_DIR && ystate == AXE_VERT_DIR) - { - if (xaxislocation_is ("top")) - { - double tmp = yPlane; - yPlane = yPlaneN; - yPlaneN = tmp; - x2Dtop = true; - } - ypTick = yPlaneN; - ypTickN = yPlane; - if (yaxislocation_is ("right")) - { - double tmp = xPlane; - xPlane = xPlaneN; - xPlaneN = tmp; - y2Dright = true; - } - xpTick = xPlaneN; - xpTickN = xPlane; - if (layer_is ("top")) - { - zpTick = zPlaneN; - layer2Dtop = true; - } - else - zpTick = zPlane; - } - - Matrix viewmat = get_view ().matrix_value (); - nearhoriz = std::abs (viewmat(1)) <= 5; - - update_ticklength (); -} - -void -axes::properties::update_ticklength (void) -{ - bool mode2d = (((xstate > AXE_DEPTH_DIR ? 1 : 0) + - (ystate > AXE_DEPTH_DIR ? 1 : 0) + - (zstate > AXE_DEPTH_DIR ? 1 : 0)) == 2); - - if (tickdirmode_is ("auto")) - tickdir.set (mode2d ? "in" : "out", true); - - double ticksign = (tickdir_is ("in") ? -1 : 1); - - Matrix bbox = get_boundingbox (true); - Matrix ticklen = get_ticklength ().matrix_value (); - ticklen(0) = ticklen(0) * std::max (bbox(2), bbox(3)); - ticklen(1) = ticklen(1) * std::max (bbox(2), bbox(3)); - - xticklen = ticksign * (mode2d ? ticklen(0) : ticklen(1)); - yticklen = ticksign * (mode2d ? ticklen(0) : ticklen(1)); - zticklen = ticksign * (mode2d ? ticklen(0) : ticklen(1)); - - xtickoffset = (mode2d ? std::max (0., xticklen) : std::abs (xticklen)) + 5; - ytickoffset = (mode2d ? std::max (0., yticklen) : std::abs (yticklen)) + 5; - ztickoffset = (mode2d ? std::max (0., zticklen) : std::abs (zticklen)) + 5; - - update_xlabel_position (); - update_ylabel_position (); - update_zlabel_position (); - update_title_position (); -} - -/* -## FIXME: A demo can't be called in a C++ file. This should be made a test -## or moved to a .m file where it can be called. -%!demo -%! clf; -%! subplot (2,1,1); -%! plot (rand (3)); -%! xlabel xlabel; -%! ylabel ylabel; -%! title title; -%! subplot (2,1,2); -%! plot (rand (3)); -%! set (gca, "ticklength", get (gca, "ticklength") * 2, "tickdir", "out"); -%! xlabel xlabel; -%! ylabel ylabel; -%! title title; -*/ - -static bool updating_xlabel_position = false; - -void -axes::properties::update_xlabel_position (void) -{ - if (updating_xlabel_position) - return; - - text::properties& xlabel_props = reinterpret_cast - (gh_manager::get_object (get_xlabel ()).get_properties ()); - - bool is_empty = xlabel_props.get_string ().is_empty (); - - unwind_protect frame; - frame.protect_var (updating_xlabel_position); - updating_xlabel_position = true; - - if (! is_empty) - { - if (xlabel_props.horizontalalignmentmode_is ("auto")) - { - xlabel_props.set_horizontalalignment - (xstate > AXE_DEPTH_DIR - ? "center" : (xyzSym ? "left" : "right")); - - xlabel_props.set_horizontalalignmentmode ("auto"); - } - - if (xlabel_props.verticalalignmentmode_is ("auto")) - { - xlabel_props.set_verticalalignment - (xstate == AXE_VERT_DIR || x2Dtop ? "bottom" : "top"); - - xlabel_props.set_verticalalignmentmode ("auto"); - } - } - - if (xlabel_props.positionmode_is ("auto") - || xlabel_props.rotationmode_is ("auto")) - { - graphics_xform xform = get_transform (); - - Matrix ext (1, 2, 0.0); - ext = get_ticklabel_extents (get_xtick ().matrix_value (), - get_xticklabel ().all_strings (), - get_xlim ().matrix_value ()); - - double wmax = ext(0), hmax = ext(1), angle = 0; - ColumnVector p = - graphics_xform::xform_vector ((xpTickN+xpTick)/2, ypTick, zpTick); - - bool tick_along_z = nearhoriz || xisinf (fy); - if (tick_along_z) - p(2) += (signum (zpTick-zpTickN)*fz*xtickoffset); - else - p(1) += (signum (ypTick-ypTickN)*fy*xtickoffset); - - p = xform.transform (p(0), p(1), p(2), false); - - switch (xstate) - { - case AXE_ANY_DIR: - p(0) += (xyzSym ? wmax : -wmax); - p(1) += hmax; - break; - - case AXE_VERT_DIR: - p(0) -= wmax; - angle = 90; - break; - - case AXE_HORZ_DIR: - p(1) += (x2Dtop ? -hmax : hmax); - break; - } - - if (xlabel_props.positionmode_is ("auto")) - { - p = xform.untransform (p(0), p(1), p(2), true); - xlabel_props.set_position (p.extract_n (0, 3).transpose ()); - xlabel_props.set_positionmode ("auto"); - } - - if (! is_empty && xlabel_props.rotationmode_is ("auto")) - { - xlabel_props.set_rotation (angle); - xlabel_props.set_rotationmode ("auto"); - } - } -} - -static bool updating_ylabel_position = false; - -void -axes::properties::update_ylabel_position (void) -{ - if (updating_ylabel_position) - return; - - text::properties& ylabel_props = reinterpret_cast - (gh_manager::get_object (get_ylabel ()).get_properties ()); - - bool is_empty = ylabel_props.get_string ().is_empty (); - - unwind_protect frame; - frame.protect_var (updating_ylabel_position); - updating_ylabel_position = true; - - if (! is_empty) - { - if (ylabel_props.horizontalalignmentmode_is ("auto")) - { - ylabel_props.set_horizontalalignment - (ystate > AXE_DEPTH_DIR - ? "center" : (!xyzSym ? "left" : "right")); - - ylabel_props.set_horizontalalignmentmode ("auto"); - } - - if (ylabel_props.verticalalignmentmode_is ("auto")) - { - ylabel_props.set_verticalalignment - (ystate == AXE_VERT_DIR && !y2Dright ? "bottom" : "top"); - - ylabel_props.set_verticalalignmentmode ("auto"); - } - } - - if (ylabel_props.positionmode_is ("auto") - || ylabel_props.rotationmode_is ("auto")) - { - graphics_xform xform = get_transform (); - - Matrix ext (1, 2, 0.0); - - // The underlying get_extents() from FreeType produces mismatched values. - // x-extent accurately measures the width of the glyphs. - // y-extent instead measures from baseline-to-baseline. - // Pad x-extent (+4) so that it approximately matches y-extent. - // This keeps ylabels about the same distance from y-axis as - // xlabels are from x-axis. - // ALWAYS use an even number for padding or horizontal alignment - // will be off. - ext = get_ticklabel_extents (get_ytick ().matrix_value (), - get_yticklabel ().all_strings (), - get_ylim ().matrix_value ()); - - double wmax = ext(0)+4, hmax = ext(1), angle = 0; - ColumnVector p = - graphics_xform::xform_vector (xpTick, (ypTickN+ypTick)/2, zpTick); - - bool tick_along_z = nearhoriz || xisinf (fx); - if (tick_along_z) - p(2) += (signum (zpTick-zpTickN)*fz*ytickoffset); - else - p(0) += (signum (xpTick-xpTickN)*fx*ytickoffset); - - p = xform.transform (p(0), p(1), p(2), false); - - switch (ystate) - { - case AXE_ANY_DIR: - p(0) += (!xyzSym ? wmax : -wmax); - p(1) += hmax; - break; - - case AXE_VERT_DIR: - p(0) += (y2Dright ? wmax : -wmax); - angle = 90; - break; - - case AXE_HORZ_DIR: - p(1) += hmax; - break; - } - - if (ylabel_props.positionmode_is ("auto")) - { - p = xform.untransform (p(0), p(1), p(2), true); - ylabel_props.set_position (p.extract_n (0, 3).transpose ()); - ylabel_props.set_positionmode ("auto"); - } - - if (! is_empty && ylabel_props.rotationmode_is ("auto")) - { - ylabel_props.set_rotation (angle); - ylabel_props.set_rotationmode ("auto"); - } - } -} - -static bool updating_zlabel_position = false; - -void -axes::properties::update_zlabel_position (void) -{ - if (updating_zlabel_position) - return; - - text::properties& zlabel_props = reinterpret_cast - (gh_manager::get_object (get_zlabel ()).get_properties ()); - - bool camAuto = cameraupvectormode_is ("auto"); - bool is_empty = zlabel_props.get_string ().is_empty (); - - unwind_protect frame; - frame.protect_var (updating_zlabel_position); - updating_zlabel_position = true; - - if (! is_empty) - { - if (zlabel_props.horizontalalignmentmode_is ("auto")) - { - zlabel_props.set_horizontalalignment - ((zstate > AXE_DEPTH_DIR || camAuto) ? "center" : "right"); - - zlabel_props.set_horizontalalignmentmode ("auto"); - } - - if (zlabel_props.verticalalignmentmode_is ("auto")) - { - zlabel_props.set_verticalalignment - (zstate == AXE_VERT_DIR - ? "bottom" : ((zSign || camAuto) ? "bottom" : "top")); - - zlabel_props.set_verticalalignmentmode ("auto"); - } - } - - if (zlabel_props.positionmode_is ("auto") - || zlabel_props.rotationmode_is ("auto")) - { - graphics_xform xform = get_transform (); - - Matrix ext (1, 2, 0.0); - ext = get_ticklabel_extents (get_ztick ().matrix_value (), - get_zticklabel ().all_strings (), - get_zlim ().matrix_value ()); - - double wmax = ext(0), hmax = ext(1), angle = 0; - ColumnVector p; - - if (xySym) - { - p = graphics_xform::xform_vector (xPlaneN, yPlane, - (zpTickN+zpTick)/2); - if (xisinf (fy)) - p(0) += (signum (xPlaneN-xPlane)*fx*ztickoffset); - else - p(1) += (signum (yPlane-yPlaneN)*fy*ztickoffset); - } - else - { - p = graphics_xform::xform_vector (xPlane, yPlaneN, - (zpTickN+zpTick)/2); - if (xisinf (fx)) - p(1) += (signum (yPlaneN-yPlane)*fy*ztickoffset); - else - p(0) += (signum (xPlane-xPlaneN)*fx*ztickoffset); - } - - p = xform.transform (p(0), p(1), p(2), false); - - switch (zstate) - { - case AXE_ANY_DIR: - if (camAuto) - { - p(0) -= wmax; - angle = 90; - } - - // FIXME -- what's the correct offset? - // - // p[0] += (!xySym ? wmax : -wmax); - // p[1] += (zSign ? hmax : -hmax); - - break; - - case AXE_VERT_DIR: - p(0) -= wmax; - angle = 90; - break; - - case AXE_HORZ_DIR: - p(1) += hmax; - break; - } - - if (zlabel_props.positionmode_is ("auto")) - { - p = xform.untransform (p(0), p(1), p(2), true); - zlabel_props.set_position (p.extract_n (0, 3).transpose ()); - zlabel_props.set_positionmode ("auto"); - } - - if (! is_empty && zlabel_props.rotationmode_is ("auto")) - { - zlabel_props.set_rotation (angle); - zlabel_props.set_rotationmode ("auto"); - } - } -} - -static bool updating_title_position = false; - -void -axes::properties::update_title_position (void) -{ - if (updating_title_position) - return; - - text::properties& title_props = reinterpret_cast - (gh_manager::get_object (get_title ()).get_properties ()); - - unwind_protect frame; - frame.protect_var (updating_title_position); - updating_title_position = true; - - if (title_props.positionmode_is ("auto")) - { - graphics_xform xform = get_transform (); - - // FIXME: bbox should be stored in axes::properties - Matrix bbox = get_extent (false); - - ColumnVector p = - graphics_xform::xform_vector (bbox(0)+bbox(2)/2, - bbox(1)-10, - (x_zlim(0)+x_zlim(1))/2); - - if (x2Dtop) - { - Matrix ext (1, 2, 0.0); - ext = get_ticklabel_extents (get_xtick ().matrix_value (), - get_xticklabel ().all_strings (), - get_xlim ().matrix_value ()); - p(1) -= ext(1); - } - - p = xform.untransform (p(0), p(1), p(2), true); - - title_props.set_position (p.extract_n (0, 3).transpose ()); - title_props.set_positionmode ("auto"); - } -} - -void -axes::properties::update_autopos (const std::string& elem_type) -{ - if (elem_type == "xlabel") - update_xlabel_position (); - else if (elem_type == "ylabel") - update_ylabel_position (); - else if (elem_type == "zlabel") - update_zlabel_position (); - else if (elem_type == "title") - update_title_position (); - else if (elem_type == "sync") - sync_positions (); -} - -static void -normalized_aspectratios (Matrix& aspectratios, const Matrix& scalefactors, - double xlength, double ylength, double zlength) -{ - double xval = xlength/scalefactors(0); - double yval = ylength/scalefactors(1); - double zval = zlength/scalefactors(2); - - double minval = xmin (xmin (xval, yval), zval); - - aspectratios(0) = xval/minval; - aspectratios(1) = yval/minval; - aspectratios(2) = zval/minval; -} - -static void -max_axes_scale (double& s, Matrix& limits, const Matrix& kids, - double pbfactor, double dafactor, char limit_type, bool tight) -{ - if (tight) - { - double minval = octave_Inf; - double maxval = -octave_Inf; - double min_pos = octave_Inf; - double max_neg = -octave_Inf; - get_children_limits (minval, maxval, min_pos, max_neg, kids, limit_type); - if (!xisinf (minval) && !xisnan (minval) - && !xisinf (maxval) && !xisnan (maxval)) - { - limits(0) = minval; - limits(1) = maxval; - s = xmax(s, (maxval - minval) / (pbfactor * dafactor)); - } - } - else - s = xmax(s, (limits(1) - limits(0)) / (pbfactor * dafactor)); -} - -static bool updating_aspectratios = false; - -void -axes::properties::update_aspectratios (void) -{ - if (updating_aspectratios) - return; - - Matrix xlimits = get_xlim ().matrix_value (); - Matrix ylimits = get_ylim ().matrix_value (); - Matrix zlimits = get_zlim ().matrix_value (); - - double dx = (xlimits(1)-xlimits(0)); - double dy = (ylimits(1)-ylimits(0)); - double dz = (zlimits(1)-zlimits(0)); - - Matrix da = get_dataaspectratio ().matrix_value (); - Matrix pba = get_plotboxaspectratio ().matrix_value (); - - if (dataaspectratiomode_is ("auto")) - { - if (plotboxaspectratiomode_is ("auto")) - { - pba = Matrix (1, 3, 1.0); - plotboxaspectratio.set (pba, false); - } - - normalized_aspectratios (da, pba, dx, dy, dz); - dataaspectratio.set (da, false); - } - else if (plotboxaspectratiomode_is ("auto")) - { - normalized_aspectratios (pba, da, dx, dy, dz); - plotboxaspectratio.set (pba, false); - } - else - { - double s = -octave_Inf; - bool modified_limits = false; - Matrix kids; - - if (xlimmode_is ("auto") && ylimmode_is ("auto") && zlimmode_is ("auto")) - { - modified_limits = true; - kids = get_children (); - max_axes_scale (s, xlimits, kids, pba(0), da(0), 'x', true); - max_axes_scale (s, ylimits, kids, pba(1), da(1), 'y', true); - max_axes_scale (s, zlimits, kids, pba(2), da(2), 'z', true); - } - else if (xlimmode_is ("auto") && ylimmode_is ("auto")) - { - modified_limits = true; - max_axes_scale (s, zlimits, kids, pba(2), da(2), 'z', false); - } - else if (ylimmode_is ("auto") && zlimmode_is ("auto")) - { - modified_limits = true; - max_axes_scale (s, xlimits, kids, pba(0), da(0), 'x', false); - } - else if (zlimmode_is ("auto") && xlimmode_is ("auto")) - { - modified_limits = true; - max_axes_scale (s, ylimits, kids, pba(1), da(1), 'y', false); - } - - if (modified_limits) - { - - unwind_protect frame; - frame.protect_var (updating_aspectratios); - - updating_aspectratios = true; - - dx = pba(0) *da(0); - dy = pba(1) *da(1); - dz = pba(2) *da(2); - if (xisinf (s)) - s = 1 / xmin (xmin (dx, dy), dz); - - if (xlimmode_is ("auto")) - { - dx = s * dx; - xlimits(0) = 0.5 * (xlimits(0) + xlimits(1) - dx); - xlimits(1) = xlimits(0) + dx; - set_xlim (xlimits); - set_xlimmode ("auto"); - } - - if (ylimmode_is ("auto")) - { - dy = s * dy; - ylimits(0) = 0.5 * (ylimits(0) + ylimits(1) - dy); - ylimits(1) = ylimits(0) + dy; - set_ylim (ylimits); - set_ylimmode ("auto"); - } - - if (zlimmode_is ("auto")) - { - dz = s * dz; - zlimits(0) = 0.5 * (zlimits(0) + zlimits(1) - dz); - zlimits(1) = zlimits(0) + dz; - set_zlim (zlimits); - set_zlimmode ("auto"); - } - } - else - { - normalized_aspectratios (pba, da, dx, dy, dz); - plotboxaspectratio.set (pba, false); - } - } -} - -void -axes::properties::update_font (void) -{ -#ifdef HAVE_FREETYPE -#ifdef HAVE_FONTCONFIG - text_renderer.set_font (get ("fontname").string_value (), - get ("fontweight").string_value (), - get ("fontangle").string_value (), - get ("fontsize").double_value ()); -#endif -#endif -} - -// The INTERNAL flag defines whether position or outerposition is used. - -Matrix -axes::properties::get_boundingbox (bool internal, - const Matrix& parent_pix_size) const -{ - Matrix pos = (internal ? - get_position ().matrix_value () - : get_outerposition ().matrix_value ()); - Matrix parent_size (parent_pix_size); - - if (parent_size.numel () == 0) - { - graphics_object obj = gh_manager::get_object (get_parent ()); - - parent_size = - obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); - } - - pos = convert_position (pos, get_units (), "pixels", parent_size); - - pos(0)--; - pos(1)--; - pos(1) = parent_size(1) - pos(1) - pos(3); - - return pos; -} - -Matrix -axes::properties::get_extent (bool with_text, bool only_text_height) const -{ - graphics_xform xform = get_transform (); - - Matrix ext (1, 4, 0.0); - ext(0) = octave_Inf; - ext(1) = octave_Inf; - ext(2) = -octave_Inf; - ext(3) = -octave_Inf; - for (int i = 0; i <= 1; i++) - for (int j = 0; j <= 1; j++) - for (int k = 0; k <= 1; k++) - { - ColumnVector p = xform.transform (i ? xPlaneN : xPlane, - j ? yPlaneN : yPlane, - k ? zPlaneN : zPlane, false); - ext(0) = std::min (ext(0), p(0)); - ext(1) = std::min (ext(1), p(1)); - ext(2) = std::max (ext(2), p(0)); - ext(3) = std::max (ext(3), p(1)); - } - - if (with_text) - { - for (int i = 0; i < 4; i++) - { - graphics_handle text_handle; - if (i == 0) - text_handle = get_title (); - else if (i == 1) - text_handle = get_xlabel (); - else if (i == 2) - text_handle = get_ylabel (); - else if (i == 3) - text_handle = get_zlabel (); - - text::properties& text_props = reinterpret_cast - (gh_manager::get_object (text_handle).get_properties ()); - - Matrix text_pos = text_props.get_data_position (); - text_pos = xform.transform (text_pos(0), text_pos(1), text_pos(2)); - if (text_props.get_string ().is_empty ()) - { - ext(0) = std::min (ext(0), text_pos(0)); - ext(1) = std::min (ext(1), text_pos(1)); - ext(2) = std::max (ext(2), text_pos(0)); - ext(3) = std::max (ext(3), text_pos(1)); - } - else - { - Matrix text_ext = text_props.get_extent_matrix (); - - bool ignore_horizontal = false; - bool ignore_vertical = false; - if (only_text_height) - { - double text_rotation = text_props.get_rotation (); - if (text_rotation == 0. || text_rotation == 180.) - ignore_horizontal = true; - else if (text_rotation == 90. || text_rotation == 270.) - ignore_vertical = true; - } - - if (! ignore_horizontal) - { - ext(0) = std::min (ext(0), text_pos(0)+text_ext(0)); - ext(2) = std::max (ext(2), text_pos(0)+text_ext(0)+text_ext(2)); - } - - if (! ignore_vertical) - { - ext(1) = std::min (ext(1), text_pos(1)-text_ext(1)-text_ext(3)); - ext(3) = std::max (ext(3), text_pos(1)-text_ext(1)); - } - } - } - } - - ext(2) = ext(2)-ext(0); - ext(3) = ext(3)-ext(1); - - return ext; -} - -static octave_value -convert_ticklabel_string (const octave_value& val) -{ - octave_value retval = val; - - if (val.is_cellstr ()) - { - // Always return a column vector for Matlab Compatibility - if (val.columns () > 1) - retval = val.reshape (dim_vector (val.numel (), 1)); - } - else - { - string_vector sv; - if (val.is_numeric_type ()) - { - NDArray data = val.array_value (); - std::ostringstream oss; - oss.precision (5); - for (octave_idx_type i = 0; i < val.numel (); i++) - { - oss.str (""); - oss << data(i); - sv.append (oss.str ()); - } - } - else if (val.is_string () && val.rows () == 1) - { - std::string valstr = val.string_value (); - std::istringstream iss (valstr); - std::string tmpstr; - - // Split string with delimiter '|' - while (std::getline (iss, tmpstr, '|')) - sv.append (tmpstr); - - // If string ends with '|' Matlab appends a null string - if (*valstr.rbegin () == '|') - sv.append (std::string ("")); - } - else - return retval; - - charMatrix chmat (sv, ' '); - - retval = octave_value (chmat); - } - - return retval; -} - -void -axes::properties::set_xticklabel (const octave_value& v) -{ - if (!error_state) - { - if (xticklabel.set (convert_ticklabel_string (v), false)) - { - set_xticklabelmode ("manual"); - xticklabel.run_listeners (POSTSET); - mark_modified (); - } - else - set_xticklabelmode ("manual"); - } -} - -void -axes::properties::set_yticklabel (const octave_value& v) -{ - if (!error_state) - { - if (yticklabel.set (convert_ticklabel_string (v), false)) - { - set_yticklabelmode ("manual"); - yticklabel.run_listeners (POSTSET); - mark_modified (); - } - else - set_yticklabelmode ("manual"); - } -} - -void -axes::properties::set_zticklabel (const octave_value& v) -{ - if (!error_state) - { - if (zticklabel.set (convert_ticklabel_string (v), false)) - { - set_zticklabelmode ("manual"); - zticklabel.run_listeners (POSTSET); - mark_modified (); - } - else - set_zticklabelmode ("manual"); - } -} - -void -axes::properties::set_units (const octave_value& v) -{ - if (! error_state) - { - caseless_str old_units = get_units (); - if (units.set (v, true)) - { - update_units (old_units); - mark_modified (); - } - } -} - -void -axes::properties::update_units (const caseless_str& old_units) -{ - graphics_object obj = gh_manager::get_object (get_parent ()); - Matrix parent_bb = obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); - caseless_str new_units = get_units (); - position.set (octave_value (convert_position (get_position ().matrix_value (), old_units, new_units, parent_bb)), false); - outerposition.set (octave_value (convert_position (get_outerposition ().matrix_value (), old_units, new_units, parent_bb)), false); - tightinset.set (octave_value (convert_position (get_tightinset ().matrix_value (), old_units, new_units, parent_bb)), false); - looseinset.set (octave_value (convert_position (get_looseinset ().matrix_value (), old_units, new_units, parent_bb)), false); -} - -void -axes::properties::set_fontunits (const octave_value& v) -{ - if (! error_state) - { - caseless_str old_fontunits = get_fontunits (); - if (fontunits.set (v, true)) - { - update_fontunits (old_fontunits); - mark_modified (); - } - } -} - -void -axes::properties::update_fontunits (const caseless_str& old_units) -{ - caseless_str new_units = get_fontunits (); - double parent_height = get_boundingbox (true).elem (3); - double fsz = get_fontsize (); - - fsz = convert_font_size (fsz, old_units, new_units, parent_height); - - set_fontsize (octave_value (fsz)); -} - -double -axes::properties::get_fontsize_points (double box_pix_height) const -{ - double fs = get_fontsize (); - double parent_height = box_pix_height; - - if (fontunits_is ("normalized") && parent_height <= 0) - parent_height = get_boundingbox (true).elem (3); - - return convert_font_size (fs, get_fontunits (), "points", parent_height); -} - -ColumnVector -graphics_xform::xform_vector (double x, double y, double z) -{ - return ::xform_vector (x, y, z); -} - -Matrix -graphics_xform::xform_eye (void) -{ - return ::xform_matrix (); -} - -ColumnVector -graphics_xform::transform (double x, double y, double z, - bool use_scale) const -{ - if (use_scale) - { - x = sx.scale (x); - y = sy.scale (y); - z = sz.scale (z); - } - - return ::transform (xform, x, y, z); -} - -ColumnVector -graphics_xform::untransform (double x, double y, double z, - bool use_scale) const -{ - ColumnVector v = ::transform (xform_inv, x, y, z); - - if (use_scale) - { - v(0) = sx.unscale (v(0)); - v(1) = sy.unscale (v(1)); - v(2) = sz.unscale (v(2)); - } - - return v; -} - -octave_value -axes::get_default (const caseless_str& name) const -{ - octave_value retval = default_properties.lookup (name); - - if (retval.is_undefined ()) - { - graphics_handle parent = get_parent (); - graphics_object parent_obj = gh_manager::get_object (parent); - - retval = parent_obj.get_default (name); - } - - return retval; -} - -// FIXME -- remove. -// FIXME -- maybe this should go into array_property class? -/* -static void -check_limit_vals (double& min_val, double& max_val, - double& min_pos, double& max_neg, - const array_property& data) -{ - double val = data.min_val (); - if (! (xisinf (val) || xisnan (val)) && val < min_val) - min_val = val; - val = data.max_val (); - if (! (xisinf (val) || xisnan (val)) && val > max_val) - max_val = val; - val = data.min_pos (); - if (! (xisinf (val) || xisnan (val)) && val > 0 && val < min_pos) - min_pos = val; - val = data.max_neg (); - if (! (xisinf (val) || xisnan (val)) && val < 0 && val > max_neg) - max_neg = val; -} -*/ - -static void -check_limit_vals (double& min_val, double& max_val, - double& min_pos, double& max_neg, - const octave_value& data) -{ - if (data.is_matrix_type ()) - { - Matrix m = data.matrix_value (); - - if (! error_state && m.numel () == 4) - { - double val; - - val = m(0); - if (! (xisinf (val) || xisnan (val)) && val < min_val) - min_val = val; - - val = m(1); - if (! (xisinf (val) || xisnan (val)) && val > max_val) - max_val = val; - - val = m(2); - if (! (xisinf (val) || xisnan (val)) && val > 0 && val < min_pos) - min_pos = val; - - val = m(3); - if (! (xisinf (val) || xisnan (val)) && val < 0 && val > max_neg) - max_neg = val; - } - } -} - -// magform(x) Returns (a, b), where x = a * 10^b, abs (a) >= 1., and b is -// integer. - -static void -magform (double x, double& a, int& b) -{ - if (x == 0) - { - a = 0; - b = 0; - } - else - { - b = static_cast (gnulib::floor (std::log10 (std::abs (x)))); - a = x / std::pow (10.0, b); - } -} - -// A translation from Tom Holoryd's python code at -// http://kurage.nimh.nih.gov/tomh/tics.py -// FIXME -- add log ticks - -double -axes::properties::calc_tick_sep (double lo, double hi) -{ - int ticint = 5; - - // Reference: Lewart, C. R., "Algorithms SCALE1, SCALE2, and - // SCALE3 for Determination of Scales on Computer Generated - // Plots", Communications of the ACM, 10 (1973), 639-640. - // Also cited as ACM Algorithm 463. - - double a; - int b, x; - - magform ((hi-lo)/ticint, a, b); - - static const double sqrt_2 = sqrt (2.0); - static const double sqrt_10 = sqrt (10.0); - static const double sqrt_50 = sqrt (50.0); - - if (a < sqrt_2) - x = 1; - else if (a < sqrt_10) - x = 2; - else if (a < sqrt_50) - x = 5; - else - x = 10; - - return x * std::pow (10., b); - -} - -// Attempt to make "nice" limits from the actual max and min of the -// data. For log plots, we will also use the smallest strictly positive -// value. - -Matrix -axes::properties::get_axis_limits (double xmin, double xmax, - double min_pos, double max_neg, - bool logscale) -{ - Matrix retval; - - double min_val = xmin; - double max_val = xmax; - - if (xisinf (min_val) && min_val > 0 && xisinf (max_val) && max_val < 0) - { - retval = default_lim (logscale); - return retval; - } - else if (! (xisinf (min_val) || xisinf (max_val))) - { - if (logscale) - { - if (xisinf (min_pos) && xisinf (max_neg)) - { - // TODO -- max_neg is needed for "loglog ([0 -Inf])" - // This is the only place where max_neg is needed. - // Is there another way? - retval = default_lim (); - retval(0) = pow (10., retval(0)); - retval(1) = pow (10., retval(1)); - return retval; - } - if ((min_val <= 0 && max_val > 0)) - { - warning ("axis: omitting non-positive data in log plot"); - min_val = min_pos; - } - // FIXME -- maybe this test should also be relative? - if (std::abs (min_val - max_val) < sqrt (std::numeric_limits::epsilon ())) - { - // Widen range when too small - if (min_val >= 0) - { - min_val *= 0.9; - max_val *= 1.1; - } - else - { - min_val *= 1.1; - max_val *= 0.9; - } - } - if (min_val > 0) - { - // Log plots with all positive data - min_val = pow (10, gnulib::floor (log10 (min_val))); - max_val = pow (10, std::ceil (log10 (max_val))); - } - else - { - // Log plots with all negative data - min_val = -pow (10, std::ceil (log10 (-min_val))); - max_val = -pow (10, gnulib::floor (log10 (-max_val))); - } - } - else - { - if (min_val == 0 && max_val == 0) - { - min_val = -1; - max_val = 1; - } - // FIXME -- maybe this test should also be relative? - else if (std::abs (min_val - max_val) < sqrt (std::numeric_limits::epsilon ())) - { - min_val -= 0.1 * std::abs (min_val); - max_val += 0.1 * std::abs (max_val); - } - - double tick_sep = calc_tick_sep (min_val , max_val); - double min_tick = gnulib::floor (min_val / tick_sep); - double max_tick = std::ceil (max_val / tick_sep); - // Prevent round-off from cropping ticks - min_val = std::min (min_val, tick_sep * min_tick); - max_val = std::max (max_val, tick_sep * max_tick); - } - } - - retval.resize (1, 2); - - retval(1) = max_val; - retval(0) = min_val; - - return retval; -} - -void -axes::properties::calc_ticks_and_lims (array_property& lims, - array_property& ticks, - array_property& mticks, - bool limmode_is_auto, bool is_logscale) -{ - // FIXME -- add log ticks and lims - - if (lims.get ().is_empty ()) - return; - - double lo = (lims.get ().matrix_value ()) (0); - double hi = (lims.get ().matrix_value ()) (1); - bool is_negative = lo < 0 && hi < 0; - double tmp; - // FIXME should this be checked for somewhere else? (i.e. set{x,y,z}lim) - if (hi < lo) - { - tmp = hi; - hi = lo; - lo = tmp; - } - - if (is_logscale) - { - if (is_negative) - { - tmp = hi; - hi = std::log10 (-lo); - lo = std::log10 (-tmp); - } - else - { - hi = std::log10 (hi); - lo = std::log10 (lo); - } - } - - double tick_sep = calc_tick_sep (lo , hi); - - if (is_logscale && ! (xisinf (hi) || xisinf (lo))) - { - // FIXME - what if (hi-lo) < tick_sep? - // ex: loglog ([1 1.1]) - tick_sep = std::max (tick_sep, 1.); - tick_sep = std::ceil (tick_sep); - } - - int i1 = static_cast (gnulib::floor (lo / tick_sep)); - int i2 = static_cast (std::ceil (hi / tick_sep)); - - if (limmode_is_auto) - { - // adjust limits to include min and max tics - Matrix tmp_lims (1,2); - tmp_lims(0) = std::min (tick_sep * i1, lo); - tmp_lims(1) = std::max (tick_sep * i2, hi); - - if (is_logscale) - { - tmp_lims(0) = std::pow (10.,tmp_lims(0)); - tmp_lims(1) = std::pow (10.,tmp_lims(1)); - if (tmp_lims(0) <= 0) - tmp_lims(0) = std::pow (10., lo); - if (is_negative) - { - tmp = tmp_lims(0); - tmp_lims(0) = -tmp_lims(1); - tmp_lims(1) = -tmp; - } - } - lims = tmp_lims; - } - - Matrix tmp_ticks (1, i2-i1+1); - for (int i = 0; i <= i2-i1; i++) - { - tmp_ticks (i) = tick_sep * (i+i1); - if (is_logscale) - tmp_ticks (i) = std::pow (10., tmp_ticks (i)); - } - if (is_logscale && is_negative) - { - Matrix rev_ticks (1, i2-i1+1); - rev_ticks = -tmp_ticks; - for (int i = 0; i <= i2-i1; i++) - tmp_ticks (i) = rev_ticks (i2-i1-i); - } - - ticks = tmp_ticks; - - int n = is_logscale ? 8 : 4; - Matrix tmp_mticks (1, n * (tmp_ticks.numel () - 1)); - - for (int i = 0; i < tmp_ticks.numel ()-1; i++) - { - double d = (tmp_ticks (i+1) - tmp_ticks (i)) / (n+1); - for (int j = 0; j < n; j++) - { - tmp_mticks (n*i+j) = tmp_ticks (i) + d * (j+1); - } - } - mticks = tmp_mticks; -} - -void -axes::properties::calc_ticklabels (const array_property& ticks, - any_property& labels, bool logscale) -{ - Matrix values = ticks.get ().matrix_value (); - Cell c (values.dims ()); - std::ostringstream os; - - if (logscale) - { - double significand; - double exponent; - double exp_max = 0.; - double exp_min = 0.; - - for (int i = 0; i < values.numel (); i++) - { - exp_max = std::max (exp_max, std::log10 (values(i))); - exp_min = std::max (exp_min, std::log10 (values(i))); - } - - for (int i = 0; i < values.numel (); i++) - { - if (values(i) < 0.) - exponent = gnulib::floor (std::log10 (-values(i))); - else - exponent = gnulib::floor (std::log10 (values(i))); - significand = values(i) * std::pow (10., -exponent); - os.str (std::string ()); - os << significand; - if (exponent < 0.) - { - os << "e-"; - exponent = -exponent; - } - else - os << "e+"; - if (exponent < 10. && (exp_max > 9 || exp_min < -9)) - os << "0"; - os << exponent; - c(i) = os.str (); - } - } - else - { - for (int i = 0; i < values.numel (); i++) - { - os.str (std::string ()); - os << values(i); - c(i) = os.str (); - } - } - - labels = c; -} - -Matrix -axes::properties::get_ticklabel_extents (const Matrix& ticks, - const string_vector& ticklabels, - const Matrix& limits) -{ -#ifndef HAVE_FREETYPE - double fontsize = get ("fontsize").double_value (); -#endif - - Matrix ext (1, 2, 0.0); - double wmax = 0., hmax = 0.; - int n = std::min (ticklabels.numel (), ticks.numel ()); - for (int i = 0; i < n; i++) - { - double val = ticks(i); - if (limits(0) <= val && val <= limits(1)) - { - std::string label (ticklabels(i)); - label.erase (0, label.find_first_not_of (" ")); - label = label.substr (0, label.find_last_not_of (" ")+1); -#ifdef HAVE_FREETYPE - ext = text_renderer.get_extent (label); - wmax = std::max (wmax, ext(0)); - hmax = std::max (hmax, ext(1)); -#else - // FIXME: find a better approximation - int len = label.length (); - wmax = std::max (wmax, 0.5*fontsize*len); - hmax = fontsize; -#endif - } - } - - ext(0) = wmax; - ext(1) = hmax; - return ext; -} - -void -get_children_limits (double& min_val, double& max_val, - double& min_pos, double& max_neg, - const Matrix& kids, char limit_type) -{ - octave_idx_type n = kids.numel (); - - switch (limit_type) - { - case 'x': - for (octave_idx_type i = 0; i < n; i++) - { - graphics_object obj = gh_manager::get_object (kids(i)); - - if (obj.is_xliminclude ()) - { - octave_value lim = obj.get_xlim (); - - check_limit_vals (min_val, max_val, min_pos, max_neg, lim); - } - } - break; - - case 'y': - for (octave_idx_type i = 0; i < n; i++) - { - graphics_object obj = gh_manager::get_object (kids(i)); - - if (obj.is_yliminclude ()) - { - octave_value lim = obj.get_ylim (); - - check_limit_vals (min_val, max_val, min_pos, max_neg, lim); - } - } - break; - - case 'z': - for (octave_idx_type i = 0; i < n; i++) - { - graphics_object obj = gh_manager::get_object (kids(i)); - - if (obj.is_zliminclude ()) - { - octave_value lim = obj.get_zlim (); - - check_limit_vals (min_val, max_val, min_pos, max_neg, lim); - } - } - break; - - case 'c': - for (octave_idx_type i = 0; i < n; i++) - { - graphics_object obj = gh_manager::get_object (kids(i)); - - if (obj.is_climinclude ()) - { - octave_value lim = obj.get_clim (); - - check_limit_vals (min_val, max_val, min_pos, max_neg, lim); - } - } - break; - - case 'a': - for (octave_idx_type i = 0; i < n; i++) - { - graphics_object obj = gh_manager::get_object (kids(i)); - - if (obj.is_aliminclude ()) - { - octave_value lim = obj.get_alim (); - - check_limit_vals (min_val, max_val, min_pos, max_neg, lim); - } - } - break; - - default: - break; - } -} - -static bool updating_axis_limits = false; - -void -axes::update_axis_limits (const std::string& axis_type, - const graphics_handle& h) -{ - if (updating_axis_limits) - return; - - Matrix kids = Matrix (1, 1, h.value ()); - - double min_val = octave_Inf; - double max_val = -octave_Inf; - double min_pos = octave_Inf; - double max_neg = -octave_Inf; - - char update_type = 0; - - Matrix limits; - double val; - -#define FIX_LIMITS \ - if (limits.numel () == 4) \ - { \ - val = limits(0); \ - if (! (xisinf (val) || xisnan (val))) \ - min_val = val; \ - val = limits(1); \ - if (! (xisinf (val) || xisnan (val))) \ - max_val = val; \ - val = limits(2); \ - if (! (xisinf (val) || xisnan (val))) \ - min_pos = val; \ - val = limits(3); \ - if (! (xisinf (val) || xisnan (val))) \ - max_neg = val; \ - } \ - else \ - { \ - limits.resize (4, 1); \ - limits(0) = min_val; \ - limits(1) = max_val; \ - limits(2) = min_pos; \ - limits(3) = max_neg; \ - } - - if (axis_type == "xdata" || axis_type == "xscale" - || axis_type == "xlimmode" || axis_type == "xliminclude" - || axis_type == "xlim") - { - if (xproperties.xlimmode_is ("auto")) - { - limits = xproperties.get_xlim ().matrix_value (); - FIX_LIMITS ; - - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'x'); - - limits = xproperties.get_axis_limits (min_val, max_val, - min_pos, max_neg, - xproperties.xscale_is ("log")); - - update_type = 'x'; - } - } - else if (axis_type == "ydata" || axis_type == "yscale" - || axis_type == "ylimmode" || axis_type == "yliminclude" - || axis_type == "ylim") - { - if (xproperties.ylimmode_is ("auto")) - { - limits = xproperties.get_ylim ().matrix_value (); - FIX_LIMITS ; - - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'y'); - - limits = xproperties.get_axis_limits (min_val, max_val, - min_pos, max_neg, - xproperties.yscale_is ("log")); - - update_type = 'y'; - } - } - else if (axis_type == "zdata" || axis_type == "zscale" - || axis_type == "zlimmode" || axis_type == "zliminclude" - || axis_type == "zlim") - { - if (xproperties.zlimmode_is ("auto")) - { - limits = xproperties.get_zlim ().matrix_value (); - FIX_LIMITS ; - - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'z'); - - limits = xproperties.get_axis_limits (min_val, max_val, - min_pos, max_neg, - xproperties.zscale_is ("log")); - - update_type = 'z'; - } - } - else if (axis_type == "cdata" || axis_type == "climmode" - || axis_type == "cdatamapping" || axis_type == "climinclude" - || axis_type == "clim") - { - if (xproperties.climmode_is ("auto")) - { - limits = xproperties.get_clim ().matrix_value (); - FIX_LIMITS ; - - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'c'); - - if (min_val > max_val) - { - min_val = min_pos = 0; - max_val = 1; - } - else if (min_val == max_val) - { - max_val = min_val + 1; - min_val -= 1; - } - - limits.resize (1, 2); - - limits(0) = min_val; - limits(1) = max_val; - - update_type = 'c'; - } - - } - else if (axis_type == "alphadata" || axis_type == "alimmode" - || axis_type == "alphadatamapping" || axis_type == "aliminclude" - || axis_type == "alim") - { - if (xproperties.alimmode_is ("auto")) - { - limits = xproperties.get_alim ().matrix_value (); - FIX_LIMITS ; - - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'a'); - - if (min_val > max_val) - { - min_val = min_pos = 0; - max_val = 1; - } - else if (min_val == max_val) - max_val = min_val + 1; - - limits.resize (1, 2); - - limits(0) = min_val; - limits(1) = max_val; - - update_type = 'a'; - } - - } - -#undef FIX_LIMITS - - unwind_protect frame; - frame.protect_var (updating_axis_limits); - - updating_axis_limits = true; - - switch (update_type) - { - case 'x': - xproperties.set_xlim (limits); - xproperties.set_xlimmode ("auto"); - xproperties.update_xlim (); - break; - - case 'y': - xproperties.set_ylim (limits); - xproperties.set_ylimmode ("auto"); - xproperties.update_ylim (); - break; - - case 'z': - xproperties.set_zlim (limits); - xproperties.set_zlimmode ("auto"); - xproperties.update_zlim (); - break; - - case 'c': - xproperties.set_clim (limits); - xproperties.set_climmode ("auto"); - break; - - case 'a': - xproperties.set_alim (limits); - xproperties.set_alimmode ("auto"); - break; - - default: - break; - } - - xproperties.update_transform (); - -} - -void -axes::update_axis_limits (const std::string& axis_type) -{ - if (updating_axis_limits || updating_aspectratios) - return; - - Matrix kids = xproperties.get_children (); - - double min_val = octave_Inf; - double max_val = -octave_Inf; - double min_pos = octave_Inf; - double max_neg = -octave_Inf; - - char update_type = 0; - - Matrix limits; - - if (axis_type == "xdata" || axis_type == "xscale" - || axis_type == "xlimmode" || axis_type == "xliminclude" - || axis_type == "xlim") - { - if (xproperties.xlimmode_is ("auto")) - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'x'); - - limits = xproperties.get_axis_limits (min_val, max_val, - min_pos, max_neg, - xproperties.xscale_is ("log")); - - update_type = 'x'; - } - } - else if (axis_type == "ydata" || axis_type == "yscale" - || axis_type == "ylimmode" || axis_type == "yliminclude" - || axis_type == "ylim") - { - if (xproperties.ylimmode_is ("auto")) - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'y'); - - limits = xproperties.get_axis_limits (min_val, max_val, - min_pos, max_neg, - xproperties.yscale_is ("log")); - - update_type = 'y'; - } - } - else if (axis_type == "zdata" || axis_type == "zscale" - || axis_type == "zlimmode" || axis_type == "zliminclude" - || axis_type == "zlim") - { - if (xproperties.zlimmode_is ("auto")) - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'z'); - - limits = xproperties.get_axis_limits (min_val, max_val, - min_pos, max_neg, - xproperties.zscale_is ("log")); - - update_type = 'z'; - } - } - else if (axis_type == "cdata" || axis_type == "climmode" - || axis_type == "cdatamapping" || axis_type == "climinclude" - || axis_type == "clim") - { - if (xproperties.climmode_is ("auto")) - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'c'); - - if (min_val > max_val) - { - min_val = min_pos = 0; - max_val = 1; - } - else if (min_val == max_val) - { - max_val = min_val + 1; - min_val -= 1; - } - - limits.resize (1, 2); - - limits(0) = min_val; - limits(1) = max_val; - - update_type = 'c'; - } - - } - else if (axis_type == "alphadata" || axis_type == "alimmode" - || axis_type == "alphadatamapping" || axis_type == "aliminclude" - || axis_type == "alim") - { - if (xproperties.alimmode_is ("auto")) - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'a'); - - if (min_val > max_val) - { - min_val = min_pos = 0; - max_val = 1; - } - else if (min_val == max_val) - max_val = min_val + 1; - - limits.resize (1, 2); - - limits(0) = min_val; - limits(1) = max_val; - - update_type = 'a'; - } - - } - - unwind_protect frame; - frame.protect_var (updating_axis_limits); - - updating_axis_limits = true; - - switch (update_type) - { - case 'x': - xproperties.set_xlim (limits); - xproperties.set_xlimmode ("auto"); - xproperties.update_xlim (); - break; - - case 'y': - xproperties.set_ylim (limits); - xproperties.set_ylimmode ("auto"); - xproperties.update_ylim (); - break; - - case 'z': - xproperties.set_zlim (limits); - xproperties.set_zlimmode ("auto"); - xproperties.update_zlim (); - break; - - case 'c': - xproperties.set_clim (limits); - xproperties.set_climmode ("auto"); - break; - - case 'a': - xproperties.set_alim (limits); - xproperties.set_alimmode ("auto"); - break; - - default: - break; - } - - xproperties.update_transform (); -} - -inline -double force_in_range (const double x, const double lower, const double upper) -{ - if (x < lower) - { return lower; } - else if (x > upper) - { return upper; } - else - { return x; } -} - -static Matrix -do_zoom (double val, double factor, const Matrix& lims, bool is_logscale) -{ - Matrix new_lims = lims; - - double lo = lims(0); - double hi = lims(1); - - bool is_negative = lo < 0 && hi < 0; - - if (is_logscale) - { - if (is_negative) - { - double tmp = hi; - hi = std::log10 (-lo); - lo = std::log10 (-tmp); - val = std::log10 (-val); - } - else - { - hi = std::log10 (hi); - lo = std::log10 (lo); - val = std::log10 (val); - } - } - - // Perform the zooming - lo = val + factor * (lo - val); - hi = val + factor * (hi - val); - - if (is_logscale) - { - if (is_negative) - { - double tmp = -std::pow (10.0, hi); - hi = -std::pow (10.0, lo); - lo = tmp; - } - else - { - lo = std::pow (10.0, lo); - hi = std::pow (10.0, hi); - } - } - - new_lims(0) = lo; - new_lims(1) = hi; - - return new_lims; -} - -void -axes::properties::zoom_about_point (double x, double y, double factor, - bool push_to_zoom_stack) -{ - // FIXME: Do we need error checking here? - Matrix xlims = get_xlim ().matrix_value (); - Matrix ylims = get_ylim ().matrix_value (); - - // Get children axes limits - Matrix kids = get_children (); - double minx = octave_Inf; - double maxx = -octave_Inf; - double min_pos_x = octave_Inf; - double max_neg_x = -octave_Inf; - get_children_limits (minx, maxx, min_pos_x, max_neg_x, kids, 'x'); - - double miny = octave_Inf; - double maxy = -octave_Inf; - double min_pos_y = octave_Inf; - double max_neg_y = -octave_Inf; - get_children_limits (miny, maxy, min_pos_y, max_neg_y, kids, 'y'); - - xlims = do_zoom (x, factor, xlims, xscale_is ("log")); - ylims = do_zoom (y, factor, ylims, yscale_is ("log")); - - zoom (xlims, ylims, push_to_zoom_stack); -} - -void -axes::properties::zoom (const Matrix& xl, const Matrix& yl, bool push_to_zoom_stack) -{ - if (push_to_zoom_stack) - { - zoom_stack.push_front (xlimmode.get ()); - zoom_stack.push_front (xlim.get ()); - zoom_stack.push_front (ylimmode.get ()); - zoom_stack.push_front (ylim.get ()); - } - - xlim = xl; - xlimmode = "manual"; - ylim = yl; - ylimmode = "manual"; - - update_transform (); - update_xlim (false); - update_ylim (false); -} - -static Matrix -do_translate (double x0, double x1, const Matrix& lims, bool is_logscale) -{ - Matrix new_lims = lims; - - double lo = lims(0); - double hi = lims(1); - - bool is_negative = lo < 0 && hi < 0; - - double delta; - - if (is_logscale) - { - if (is_negative) - { - double tmp = hi; - hi = std::log10 (-lo); - lo = std::log10 (-tmp); - x0 = -x0; - x1 = -x1; - } - else - { - hi = std::log10 (hi); - lo = std::log10 (lo); - } - - delta = std::log10 (x0) - std::log10 (x1); - } - else - { - delta = x0 - x1; - } - - // Perform the translation - lo += delta; - hi += delta; - - if (is_logscale) - { - if (is_negative) - { - double tmp = -std::pow (10.0, hi); - hi = -std::pow (10.0, lo); - lo = tmp; - } - else - { - lo = std::pow (10.0, lo); - hi = std::pow (10.0, hi); - } - } - - new_lims(0) = lo; - new_lims(1) = hi; - - return new_lims; -} - -void -axes::properties::translate_view (double x0, double x1, double y0, double y1) -{ - // FIXME: Do we need error checking here? - Matrix xlims = get_xlim ().matrix_value (); - Matrix ylims = get_ylim ().matrix_value (); - - // Get children axes limits - Matrix kids = get_children (); - double minx = octave_Inf; - double maxx = -octave_Inf; - double min_pos_x = octave_Inf; - double max_neg_x = -octave_Inf; - get_children_limits (minx, maxx, min_pos_x, max_neg_x, kids, 'x'); - - double miny = octave_Inf; - double maxy = -octave_Inf; - double min_pos_y = octave_Inf; - double max_neg_y = -octave_Inf; - get_children_limits (miny, maxy, min_pos_y, max_neg_y, kids, 'y'); - - xlims = do_translate (x0, x1, xlims, xscale_is ("log")); - ylims = do_translate (y0, y1, ylims, yscale_is ("log")); - - zoom (xlims, ylims, false); -} - -void -axes::properties::rotate_view (double delta_el, double delta_az) -{ - Matrix v = get_view ().matrix_value (); - - v(1) += delta_el; - - if (v(1) > 90) - v(1) = 90; - if (v(1) < -90) - v(1) = -90; - - v(0) = fmod (v(0) - delta_az + 720,360); - - set_view (v); - update_transform (); -} - -void -axes::properties::unzoom (void) -{ - if (zoom_stack.size () >= 4) - { - ylim = zoom_stack.front (); - zoom_stack.pop_front (); - ylimmode = zoom_stack.front (); - zoom_stack.pop_front (); - xlim = zoom_stack.front (); - zoom_stack.pop_front (); - xlimmode = zoom_stack.front (); - zoom_stack.pop_front (); - - update_transform (); - update_xlim (false); - update_ylim (false); - } -} - -void -axes::properties::clear_zoom_stack (void) -{ - while (zoom_stack.size () > 4) - zoom_stack.pop_front (); - - unzoom (); -} - -void -axes::reset_default_properties (void) -{ - ::reset_default_properties (default_properties); -} - -void -axes::initialize (const graphics_object& go) -{ - base_graphics_object::initialize (go); - - xinitialize (xproperties.get_title ()); - xinitialize (xproperties.get_xlabel ()); - xinitialize (xproperties.get_ylabel ()); - xinitialize (xproperties.get_zlabel ()); -} - -// --------------------------------------------------------------------- - -Matrix -line::properties::compute_xlim (void) const -{ - Matrix m (1, 4); - - m(0) = xdata.min_val (); - m(1) = xdata.max_val (); - m(2) = xdata.min_pos (); - m(3) = xdata.max_neg (); - - return m; -} - -Matrix -line::properties::compute_ylim (void) const -{ - Matrix m (1, 4); - - m(0) = ydata.min_val (); - m(1) = ydata.max_val (); - m(2) = ydata.min_pos (); - m(3) = ydata.max_neg (); - - return m; -} - -// --------------------------------------------------------------------- - -Matrix -text::properties::get_data_position (void) const -{ - Matrix pos = get_position ().matrix_value (); - - if (! units_is ("data")) - pos = convert_text_position (pos, *this, get_units (), "data"); - - return pos; -} - -Matrix -text::properties::get_extent_matrix (void) const -{ - // FIXME: Should this function also add the (x,y) base position? - return extent.get ().matrix_value (); -} - -octave_value -text::properties::get_extent (void) const -{ - // FIXME: This doesn't work right for 3D plots. - // (It doesn't in Matlab either, at least not in version 6.5.) - Matrix m = extent.get ().matrix_value (); - Matrix pos = get_position ().matrix_value (); - Matrix p = convert_text_position (pos, *this, get_units (), "pixels"); - - m(0) += p(0); - m(1) += p(1); - - return convert_text_position (m, *this, "pixels", get_units ()); -} - -void -text::properties::update_font (void) -{ -#ifdef HAVE_FREETYPE -#ifdef HAVE_FONTCONFIG - renderer.set_font (get ("fontname").string_value (), - get ("fontweight").string_value (), - get ("fontangle").string_value (), - get ("fontsize").double_value ()); -#endif - renderer.set_color (get_color_rgb ()); -#endif -} - -void -text::properties::update_text_extent (void) -{ -#ifdef HAVE_FREETYPE - - int halign = 0, valign = 0; - - if (horizontalalignment_is ("center")) - halign = 1; - else if (horizontalalignment_is ("right")) - halign = 2; - - if (verticalalignment_is ("middle")) - valign = 1; - else if (verticalalignment_is ("top")) - valign = 2; - else if (verticalalignment_is ("baseline")) - valign = 3; - else if (verticalalignment_is ("cap")) - valign = 4; - - Matrix bbox; - - // FIXME: string should be parsed only when modified, for efficiency - - octave_value string_prop = get_string (); - - string_vector sv = string_prop.all_strings (); - - renderer.text_to_pixels (sv.join ("\n"), pixels, bbox, - halign, valign, get_rotation ()); - /* The bbox is relative to the text's position. - We'll leave it that way, because get_position () does not return - valid results when the text is first constructed. - Conversion to proper coordinates is performed in get_extent. */ - set_extent (bbox); - -#endif - - if (autopos_tag_is ("xlabel") || autopos_tag_is ("ylabel") || - autopos_tag_is ("zlabel") || autopos_tag_is ("title")) - update_autopos ("sync"); -} - -void -text::properties::request_autopos (void) -{ - if (autopos_tag_is ("xlabel") || autopos_tag_is ("ylabel") || - autopos_tag_is ("zlabel") || autopos_tag_is ("title")) - update_autopos (get_autopos_tag ()); -} - -void -text::properties::update_units (void) -{ - if (! units_is ("data")) - { - set_xliminclude ("off"); - set_yliminclude ("off"); - set_zliminclude ("off"); - } - - Matrix pos = get_position ().matrix_value (); - - pos = convert_text_position (pos, *this, cached_units, get_units ()); - // FIXME: if the current axes view is 2D, then one should - // probably drop the z-component of "pos" and leave "zliminclude" - // to "off". - set_position (pos); - - if (units_is ("data")) - { - set_xliminclude ("on"); - set_yliminclude ("on"); - // FIXME: see above - set_zliminclude ("off"); - } - - cached_units = get_units (); -} - -double -text::properties::get_fontsize_points (double box_pix_height) const -{ - double fs = get_fontsize (); - double parent_height = box_pix_height; - - if (fontunits_is ("normalized") && parent_height <= 0) - { - graphics_object go (gh_manager::get_object (get___myhandle__ ())); - graphics_object ax (go.get_ancestor ("axes")); - - parent_height = ax.get_properties ().get_boundingbox (true).elem (3); - } - - return convert_font_size (fs, get_fontunits (), "points", parent_height); -} - -// --------------------------------------------------------------------- - -octave_value -image::properties::get_color_data (void) const -{ - return convert_cdata (*this, get_cdata (), - cdatamapping_is ("scaled"), 3); -} - -// --------------------------------------------------------------------- - -octave_value -patch::properties::get_color_data (void) const -{ - octave_value fvc = get_facevertexcdata (); - if (fvc.is_undefined () || fvc.is_empty ()) - return Matrix (); - else - return convert_cdata (*this, fvc,cdatamapping_is ("scaled"), 2); -} - -// --------------------------------------------------------------------- - -octave_value -surface::properties::get_color_data (void) const -{ - return convert_cdata (*this, get_cdata (), cdatamapping_is ("scaled"), 3); -} - -inline void -cross_product (double x1, double y1, double z1, - double x2, double y2, double z2, - double& x, double& y, double& z) -{ - x += (y1 * z2 - z1 * y2); - y += (z1 * x2 - x1 * z2); - z += (x1 * y2 - y1 * x2); -} - -void -surface::properties::update_normals (void) -{ - if (normalmode_is ("auto")) - { - Matrix x = get_xdata ().matrix_value (); - Matrix y = get_ydata ().matrix_value (); - Matrix z = get_zdata ().matrix_value (); - - - int p = z.columns (), q = z.rows (); - int i1 = 0, i2 = 0, i3 = 0; - int j1 = 0, j2 = 0, j3 = 0; - - bool x_mat = (x.rows () == q); - bool y_mat = (y.columns () == p); - - NDArray n (dim_vector (q, p, 3), 0.0); - - for (int i = 0; i < p; i++) - { - if (y_mat) - { - i1 = i - 1; - i2 = i; - i3 = i + 1; - } - - for (int j = 0; j < q; j++) - { - if (x_mat) - { - j1 = j - 1; - j2 = j; - j3 = j + 1; - } - - double& nx = n(j, i, 0); - double& ny = n(j, i, 1); - double& nz = n(j, i, 2); - - if ((j > 0) && (i > 0)) - // upper left quadrangle - cross_product (x(j1,i-1)-x(j2,i), y(j-1,i1)-y(j,i2), z(j-1,i-1)-z(j,i), - x(j2,i-1)-x(j1,i), y(j,i1)-y(j-1,i2), z(j,i-1)-z(j-1,i), - nx, ny, nz); - - if ((j > 0) && (i < (p -1))) - // upper right quadrangle - cross_product (x(j1,i+1)-x(j2,i), y(j-1,i3)-y(j,i2), z(j-1,i+1)-z(j,i), - x(j1,i)-x(j2,i+1), y(j-1,i2)-y(j,i3), z(j-1,i)-z(j,i+1), - nx, ny, nz); - - if ((j < (q - 1)) && (i > 0)) - // lower left quadrangle - cross_product (x(j2,i-1)-x(j3,i), y(j,i1)-y(j+1,i2), z(j,i-1)-z(j+1,i), - x(j3,i-1)-x(j2,i), y(j+1,i1)-y(j,i2), z(j+1,i-1)-z(j,i), - nx, ny, nz); - - if ((j < (q - 1)) && (i < (p -1))) - // lower right quadrangle - cross_product (x(j3,i)-x(j2,i+1), y(j+1,i2)-y(j,i3), z(j+1,i)-z(j,i+1), - x(j3,i+1)-x(j2,i), y(j+1,i3)-y(j,i2), z(j+1,i+1)-z(j,i), - nx, ny, nz); - - double d = -std::max (std::max (fabs (nx), fabs (ny)), fabs (nz)); - - nx /= d; - ny /= d; - nz /= d; - } - } - vertexnormals = n; - } -} - -// --------------------------------------------------------------------- - -void -hggroup::properties::update_limits (void) const -{ - graphics_object obj = gh_manager::get_object (__myhandle__); - - if (obj) - { - obj.update_axis_limits ("xlim"); - obj.update_axis_limits ("ylim"); - obj.update_axis_limits ("zlim"); - obj.update_axis_limits ("clim"); - obj.update_axis_limits ("alim"); - } -} - -void -hggroup::properties::update_limits (const graphics_handle& h) const -{ - graphics_object obj = gh_manager::get_object (__myhandle__); - - if (obj) - { - obj.update_axis_limits ("xlim", h); - obj.update_axis_limits ("ylim", h); - obj.update_axis_limits ("zlim", h); - obj.update_axis_limits ("clim", h); - obj.update_axis_limits ("alim", h); - } -} - -static bool updating_hggroup_limits = false; - -void -hggroup::update_axis_limits (const std::string& axis_type, - const graphics_handle& h) -{ - if (updating_hggroup_limits) - return; - - Matrix kids = Matrix (1, 1, h.value ()); - - double min_val = octave_Inf; - double max_val = -octave_Inf; - double min_pos = octave_Inf; - double max_neg = -octave_Inf; - - Matrix limits; - double val; - - char update_type = 0; - - if (axis_type == "xlim" || axis_type == "xliminclude") - { - limits = xproperties.get_xlim ().matrix_value (); - update_type = 'x'; - } - else if (axis_type == "ylim" || axis_type == "yliminclude") - { - limits = xproperties.get_ylim ().matrix_value (); - update_type = 'y'; - } - else if (axis_type == "zlim" || axis_type == "zliminclude") - { - limits = xproperties.get_zlim ().matrix_value (); - update_type = 'z'; - } - else if (axis_type == "clim" || axis_type == "climinclude") - { - limits = xproperties.get_clim ().matrix_value (); - update_type = 'c'; - } - else if (axis_type == "alim" || axis_type == "aliminclude") - { - limits = xproperties.get_alim ().matrix_value (); - update_type = 'a'; - } - - if (limits.numel () == 4) - { - val = limits(0); - if (! (xisinf (val) || xisnan (val))) - min_val = val; - val = limits(1); - if (! (xisinf (val) || xisnan (val))) - max_val = val; - val = limits(2); - if (! (xisinf (val) || xisnan (val))) - min_pos = val; - val = limits(3); - if (! (xisinf (val) || xisnan (val))) - max_neg = val; - } - else - { - limits.resize (4,1); - limits(0) = min_val; - limits(1) = max_val; - limits(2) = min_pos; - limits(3) = max_neg; - } - - get_children_limits (min_val, max_val, min_pos, max_neg, kids, update_type); - - unwind_protect frame; - frame.protect_var (updating_hggroup_limits); - - updating_hggroup_limits = true; - - if (limits(0) != min_val || limits(1) != max_val - || limits(2) != min_pos || limits(3) != max_neg) - { - limits(0) = min_val; - limits(1) = max_val; - limits(2) = min_pos; - limits(3) = max_neg; - - switch (update_type) - { - case 'x': - xproperties.set_xlim (limits); - break; - - case 'y': - xproperties.set_ylim (limits); - break; - - case 'z': - xproperties.set_zlim (limits); - break; - - case 'c': - xproperties.set_clim (limits); - break; - - case 'a': - xproperties.set_alim (limits); - break; - - default: - break; - } - - base_graphics_object::update_axis_limits (axis_type, h); - } -} - -void -hggroup::update_axis_limits (const std::string& axis_type) -{ - if (updating_hggroup_limits) - return; - - Matrix kids = xproperties.get_children (); - - double min_val = octave_Inf; - double max_val = -octave_Inf; - double min_pos = octave_Inf; - double max_neg = -octave_Inf; - - char update_type = 0; - - if (axis_type == "xlim" || axis_type == "xliminclude") - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'x'); - - update_type = 'x'; - } - else if (axis_type == "ylim" || axis_type == "yliminclude") - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'y'); - - update_type = 'y'; - } - else if (axis_type == "zlim" || axis_type == "zliminclude") - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'z'); - - update_type = 'z'; - } - else if (axis_type == "clim" || axis_type == "climinclude") - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'c'); - - update_type = 'c'; - } - else if (axis_type == "alim" || axis_type == "aliminclude") - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'a'); - - update_type = 'a'; - } - - unwind_protect frame; - frame.protect_var (updating_hggroup_limits); - - updating_hggroup_limits = true; - - Matrix limits (1, 4, 0.0); - - limits(0) = min_val; - limits(1) = max_val; - limits(2) = min_pos; - limits(3) = max_neg; - - switch (update_type) - { - case 'x': - xproperties.set_xlim (limits); - break; - - case 'y': - xproperties.set_ylim (limits); - break; - - case 'z': - xproperties.set_zlim (limits); - break; - - case 'c': - xproperties.set_clim (limits); - break; - - case 'a': - xproperties.set_alim (limits); - break; - - default: - break; - } - - base_graphics_object::update_axis_limits (axis_type); -} - -// --------------------------------------------------------------------- - -octave_value -uicontrol::properties::get_extent (void) const -{ - Matrix m = extent.get ().matrix_value (); - - graphics_object parent_obj = - gh_manager::get_object (get_parent ()); - Matrix parent_bbox = parent_obj.get_properties ().get_boundingbox (true), - parent_size = parent_bbox.extract_n (0, 2, 1, 2); - - return convert_position (m, "pixels", get_units (), parent_size); -} - -void -uicontrol::properties::update_text_extent (void) -{ -#ifdef HAVE_FREETYPE - - text_element *elt; - ft_render text_renderer; - Matrix box; - - // FIXME: parsed content should be cached for efficiency - // FIXME: support multiline text - - elt = text_parser_none ().parse (get_string_string ()); -#ifdef HAVE_FONTCONFIG - text_renderer.set_font (get_fontname (), - get_fontweight (), - get_fontangle (), - get_fontsize ()); -#endif - box = text_renderer.get_extent (elt, 0); - - Matrix ext (1, 4, 0.0); - - // FIXME: also handle left and bottom components - - ext(0) = ext(1) = 1; - ext(2) = box(0); - ext(3) = box(1); - - set_extent (ext); - -#endif -} - -void -uicontrol::properties::update_units (void) -{ - Matrix pos = get_position ().matrix_value (); - - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - Matrix parent_bbox = parent_obj.get_properties ().get_boundingbox (true), - parent_size = parent_bbox.extract_n (0, 2, 1, 2); - - pos = convert_position (pos, cached_units, get_units (), parent_size); - set_position (pos); - - cached_units = get_units (); -} - -void -uicontrol::properties::set_style (const octave_value& st) -{ - if (get___object__ ().is_empty ()) - style = st; - else - error ("set: cannot change the style of a uicontrol object after creation."); -} - -Matrix -uicontrol::properties::get_boundingbox (bool, - const Matrix& parent_pix_size) const -{ - Matrix pos = get_position ().matrix_value (); - Matrix parent_size (parent_pix_size); - - if (parent_size.numel () == 0) - { - graphics_object obj = gh_manager::get_object (get_parent ()); - - parent_size = - obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); - } - - pos = convert_position (pos, get_units (), "pixels", parent_size); - - pos(0)--; - pos(1)--; - pos(1) = parent_size(1) - pos(1) - pos(3); - - return pos; -} - -void -uicontrol::properties::set_fontunits (const octave_value& v) -{ - if (! error_state) - { - caseless_str old_fontunits = get_fontunits (); - if (fontunits.set (v, true)) - { - update_fontunits (old_fontunits); - mark_modified (); - } - } -} - -void -uicontrol::properties::update_fontunits (const caseless_str& old_units) -{ - caseless_str new_units = get_fontunits (); - double parent_height = get_boundingbox (false).elem (3); - double fsz = get_fontsize (); - - fsz = convert_font_size (fsz, old_units, new_units, parent_height); - - fontsize.set (octave_value (fsz), true); -} - -double -uicontrol::properties::get_fontsize_points (double box_pix_height) const -{ - double fs = get_fontsize (); - double parent_height = box_pix_height; - - if (fontunits_is ("normalized") && parent_height <= 0) - parent_height = get_boundingbox (false).elem (3); - - return convert_font_size (fs, get_fontunits (), "points", parent_height); -} - -// --------------------------------------------------------------------- - -Matrix -uipanel::properties::get_boundingbox (bool internal, - const Matrix& parent_pix_size) const -{ - Matrix pos = get_position ().matrix_value (); - Matrix parent_size (parent_pix_size); - - if (parent_size.numel () == 0) - { - graphics_object obj = gh_manager::get_object (get_parent ()); - - parent_size = - obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); - } - - pos = convert_position (pos, get_units (), "pixels", parent_size); - - pos(0)--; - pos(1)--; - pos(1) = parent_size(1) - pos(1) - pos(3); - - if (internal) - { - double outer_height = pos(3); - - pos(0) = pos(1) = 0; - - if (! bordertype_is ("none")) - { - double bw = get_borderwidth (); - double mul = 1.0; - - if (bordertype_is ("etchedin") || bordertype_is ("etchedout")) - mul = 2.0; - - pos(0) += mul * bw; - pos(1) += mul * bw; - pos(2) -= 2 * mul * bw; - pos(3) -= 2 * mul * bw; - } - - if (! get_title ().empty ()) - { - double fs = get_fontsize (); - - if (! fontunits_is ("pixels")) - { - double res = xget (0, "screenpixelsperinch").double_value (); - - if (fontunits_is ("points")) - fs *= (res / 72.0); - else if (fontunits_is ("inches")) - fs *= res; - else if (fontunits_is ("centimeters")) - fs *= (res / 2.54); - else if (fontunits_is ("normalized")) - fs *= outer_height; - } - - if (titleposition_is ("lefttop") || titleposition_is ("centertop") - || titleposition_is ("righttop")) - pos(1) += (fs / 2); - pos(3) -= (fs / 2); - } - } - - return pos; -} - -void -uipanel::properties::set_units (const octave_value& v) -{ - if (! error_state) - { - caseless_str old_units = get_units (); - if (units.set (v, true)) - { - update_units (old_units); - mark_modified (); - } - } -} - -void -uipanel::properties::update_units (const caseless_str& old_units) -{ - Matrix pos = get_position ().matrix_value (); - - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - Matrix parent_bbox = parent_obj.get_properties ().get_boundingbox (true), - parent_size = parent_bbox.extract_n (0, 2, 1, 2); - - pos = convert_position (pos, old_units, get_units (), parent_size); - set_position (pos); -} - -void -uipanel::properties::set_fontunits (const octave_value& v) -{ - if (! error_state) - { - caseless_str old_fontunits = get_fontunits (); - if (fontunits.set (v, true)) - { - update_fontunits (old_fontunits); - mark_modified (); - } - } -} - -void -uipanel::properties::update_fontunits (const caseless_str& old_units) -{ - caseless_str new_units = get_fontunits (); - double parent_height = get_boundingbox (false).elem (3); - double fsz = get_fontsize (); - - fsz = convert_font_size (fsz, old_units, new_units, parent_height); - - set_fontsize (octave_value (fsz)); -} - -double -uipanel::properties::get_fontsize_points (double box_pix_height) const -{ - double fs = get_fontsize (); - double parent_height = box_pix_height; - - if (fontunits_is ("normalized") && parent_height <= 0) - parent_height = get_boundingbox (false).elem (3); - - return convert_font_size (fs, get_fontunits (), "points", parent_height); -} - -// --------------------------------------------------------------------- - -octave_value -uitoolbar::get_default (const caseless_str& name) const -{ - octave_value retval = default_properties.lookup (name); - - if (retval.is_undefined ()) - { - graphics_handle parent = get_parent (); - graphics_object parent_obj = gh_manager::get_object (parent); - - retval = parent_obj.get_default (name); - } - - return retval; -} - -void -uitoolbar::reset_default_properties (void) -{ - ::reset_default_properties (default_properties); -} - -// --------------------------------------------------------------------- - -octave_value -base_graphics_object::get_default (const caseless_str& name) const -{ - graphics_handle parent = get_parent (); - graphics_object parent_obj = gh_manager::get_object (parent); - - return parent_obj.get_default (type () + name); -} - -octave_value -base_graphics_object::get_factory_default (const caseless_str& name) const -{ - graphics_object parent_obj = gh_manager::get_object (0); - - return parent_obj.get_factory_default (type () + name); -} - -// We use a random value for the handle to avoid issues with plots and -// scalar values for the first argument. -gh_manager::gh_manager (void) - : handle_map (), handle_free_list (), - next_handle (-1.0 - (rand () + 1.0) / (RAND_MAX + 2.0)), - figure_list (), graphics_lock (), event_queue (), - callback_objects (), event_processing (0) -{ - handle_map[0] = graphics_object (new root_figure ()); - - // Make sure the default graphics toolkit is registered. - gtk_manager::default_toolkit (); -} - -void -gh_manager::create_instance (void) -{ - instance = new gh_manager (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); -} - -graphics_handle -gh_manager::do_make_graphics_handle (const std::string& go_name, - const graphics_handle& p, - bool integer_figure_handle, - bool do_createfcn, - bool do_notify_toolkit) -{ - graphics_handle h = get_handle (integer_figure_handle); - - base_graphics_object *go = 0; - - go = make_graphics_object_from_type (go_name, h, p); - - if (go) - { - graphics_object obj (go); - - handle_map[h] = obj; - if (do_createfcn) - go->get_properties ().execute_createfcn (); - - // Notify graphics toolkit. - if (do_notify_toolkit) - obj.initialize (); - } - else - error ("gh_manager::do_make_graphics_handle: invalid object type '%s'", - go_name.c_str ()); - - return h; -} - -graphics_handle -gh_manager::do_make_figure_handle (double val, bool do_notify_toolkit) -{ - graphics_handle h = val; - - base_graphics_object* go = new figure (h, 0); - graphics_object obj (go); - - handle_map[h] = obj; - - // Notify graphics toolkit. - if (do_notify_toolkit) - obj.initialize (); - - return h; -} - -void -gh_manager::do_push_figure (const graphics_handle& h) -{ - do_pop_figure (h); - - figure_list.push_front (h); -} - -void -gh_manager::do_pop_figure (const graphics_handle& h) -{ - for (figure_list_iterator p = figure_list.begin (); - p != figure_list.end (); - p++) - { - if (*p == h) - { - figure_list.erase (p); - break; - } - } -} - -class -callback_event : public base_graphics_event -{ -public: - callback_event (const graphics_handle& h, const std::string& name, - const octave_value& data = Matrix ()) - : base_graphics_event (), handle (h), callback_name (name), - callback (), callback_data (data) { } - - callback_event (const graphics_handle& h, const octave_value& cb, - const octave_value& data = Matrix ()) - : base_graphics_event (), handle (h), callback_name (), - callback (cb), callback_data (data) { } - - void execute (void) - { - if (callback.is_defined ()) - gh_manager::execute_callback (handle, callback, callback_data); - else - gh_manager::execute_callback (handle, callback_name, callback_data); - } - -private: - callback_event (void) - : base_graphics_event (), handle (), - callback_name (), callback_data () - { } - -private: - graphics_handle handle; - std::string callback_name; - octave_value callback; - octave_value callback_data; -}; - -class -function_event : public base_graphics_event -{ -public: - function_event (graphics_event::event_fcn fcn, void* data = 0) - : base_graphics_event (), function (fcn), - function_data (data) { } - - void execute (void) - { - function (function_data); - } - -private: - - graphics_event::event_fcn function; - - void* function_data; - - // function_event objects must be created with at least a function. - function_event (void); - - // No copying! - - function_event (const function_event &); - - function_event & operator = (const function_event &); -}; - -class -set_event : public base_graphics_event -{ -public: - set_event (const graphics_handle& h, const std::string& name, - const octave_value& value, bool do_notify_toolkit = true) - : base_graphics_event (), handle (h), property_name (name), - property_value (value), notify_toolkit (do_notify_toolkit) { } - - void execute (void) - { - gh_manager::auto_lock guard; - - graphics_object go = gh_manager::get_object (handle); - - if (go) - { - property p = go.get_properties ().get_property (property_name); - - if (p.ok ()) - p.set (property_value, true, notify_toolkit); - } - } - -private: - set_event (void) - : base_graphics_event (), handle (), property_name (), property_value () - { } - -private: - graphics_handle handle; - std::string property_name; - octave_value property_value; - bool notify_toolkit; -}; - -graphics_event -graphics_event::create_callback_event (const graphics_handle& h, - const std::string& name, - const octave_value& data) -{ - graphics_event e; - - e.rep = new callback_event (h, name, data); - - return e; -} - -graphics_event -graphics_event::create_callback_event (const graphics_handle& h, - const octave_value& cb, - const octave_value& data) -{ - graphics_event e; - - e.rep = new callback_event (h, cb, data); - - return e; -} - -graphics_event -graphics_event::create_function_event (graphics_event::event_fcn fcn, - void *data) -{ - graphics_event e; - - e.rep = new function_event (fcn, data); - - return e; -} - -graphics_event -graphics_event::create_set_event (const graphics_handle& h, - const std::string& name, - const octave_value& data, - bool notify_toolkit) -{ - graphics_event e; - - e.rep = new set_event (h, name, data, notify_toolkit); - - return e; -} - -static void -xset_gcbo (const graphics_handle& h) -{ - graphics_object go = gh_manager::get_object (0); - root_figure::properties& props = - dynamic_cast (go.get_properties ()); - - props.set_callbackobject (h.as_octave_value ()); -} - -void -gh_manager::do_restore_gcbo (void) -{ - gh_manager::auto_lock guard; - - callback_objects.pop_front (); - - xset_gcbo (callback_objects.empty () - ? graphics_handle () - : callback_objects.front ().get_handle ()); -} - -void -gh_manager::do_execute_listener (const graphics_handle& h, - const octave_value& l) -{ - if (octave_thread::is_octave_thread ()) - gh_manager::execute_callback (h, l, octave_value ()); - else - { - gh_manager::auto_lock guard; - - do_post_event (graphics_event::create_callback_event (h, l)); - } -} - -void -gh_manager::do_execute_callback (const graphics_handle& h, - const octave_value& cb_arg, - const octave_value& data) -{ - if (cb_arg.is_defined () && ! cb_arg.is_empty ()) - { - octave_value_list args; - octave_function *fcn = 0; - - args(0) = h.as_octave_value (); - if (data.is_defined ()) - args(1) = data; - else - args(1) = Matrix (); - - unwind_protect_safe frame; - frame.add_fcn (gh_manager::restore_gcbo); - - if (true) - { - gh_manager::auto_lock guard; - - callback_objects.push_front (get_object (h)); - xset_gcbo (h); - } - - BEGIN_INTERRUPT_WITH_EXCEPTIONS; - - // Copy CB because "function_value" method is non-const. - - octave_value cb = cb_arg; - - if (cb.is_function () || cb.is_function_handle ()) - fcn = cb.function_value (); - else if (cb.is_string ()) - { - int status; - std::string s = cb.string_value (); - - eval_string (s, false, status, 0); - } - else if (cb.is_cell () && cb.length () > 0 - && (cb.rows () == 1 || cb.columns () == 1) - && (cb.cell_value ()(0).is_function () - || cb.cell_value ()(0).is_function_handle ())) - { - Cell c = cb.cell_value (); - - fcn = c(0).function_value (); - if (! error_state) - { - for (int i = 1; i < c.length () ; i++) - args(1+i) = c(i); - } - } - else - { - std::string nm = cb.class_name (); - error ("trying to execute non-executable object (class = %s)", - nm.c_str ()); - } - - if (fcn && ! error_state) - feval (fcn, args); - - END_INTERRUPT_WITH_EXCEPTIONS; - } -} - -void -gh_manager::do_post_event (const graphics_event& e) -{ - event_queue.push_back (e); - - command_editor::add_event_hook (gh_manager::process_events); -} - -void -gh_manager::do_post_callback (const graphics_handle& h, const std::string name, - const octave_value& data) -{ - gh_manager::auto_lock guard; - - graphics_object go = get_object (h); - - if (go.valid_object ()) - { - if (callback_objects.empty ()) - do_post_event (graphics_event::create_callback_event (h, name, data)); - else - { - const graphics_object& current = callback_objects.front (); - - if (current.get_properties ().is_interruptible ()) - do_post_event (graphics_event::create_callback_event (h, name, data)); - else - { - caseless_str busy_action (go.get_properties ().get_busyaction ()); - - if (busy_action.compare ("queue")) - do_post_event (graphics_event::create_callback_event (h, name, data)); - else - { - caseless_str cname (name); - - if (cname.compare ("deletefcn") - || cname.compare ("createfcn") - || (go.isa ("figure") - && (cname.compare ("closerequestfcn") - || cname.compare ("resizefcn")))) - do_post_event (graphics_event::create_callback_event (h, name, data)); - } - } - } - } -} - -void -gh_manager::do_post_function (graphics_event::event_fcn fcn, void* fcn_data) -{ - gh_manager::auto_lock guard; - - do_post_event (graphics_event::create_function_event (fcn, fcn_data)); -} - -void -gh_manager::do_post_set (const graphics_handle& h, const std::string name, - const octave_value& value, bool notify_toolkit) -{ - gh_manager::auto_lock guard; - - do_post_event (graphics_event::create_set_event (h, name, value, - notify_toolkit)); -} - -int -gh_manager::do_process_events (bool force) -{ - graphics_event e; - bool old_Vdrawnow_requested = Vdrawnow_requested; - bool events_executed = false; - - do - { - e = graphics_event (); - - gh_manager::lock (); - - if (! event_queue.empty ()) - { - if (callback_objects.empty () || force) - { - e = event_queue.front (); - - event_queue.pop_front (); - } - else - { - const graphics_object& go = callback_objects.front (); - - if (go.get_properties ().is_interruptible ()) - { - e = event_queue.front (); - - event_queue.pop_front (); - } - } - } - - gh_manager::unlock (); - - if (e.ok ()) - { - e.execute (); - events_executed = true; - } - } - while (e.ok ()); - - gh_manager::lock (); - - if (event_queue.empty () && event_processing == 0) - command_editor::remove_event_hook (gh_manager::process_events); - - gh_manager::unlock (); - - if (events_executed) - flush_octave_stdout (); - - if (Vdrawnow_requested && ! old_Vdrawnow_requested) - { - Fdrawnow (); - - Vdrawnow_requested = false; - } - - return 0; -} - -void -gh_manager::do_enable_event_processing (bool enable) -{ - gh_manager::auto_lock guard; - - if (enable) - { - event_processing++; - - command_editor::add_event_hook (gh_manager::process_events); - } - else - { - event_processing--; - - if (event_queue.empty () && event_processing == 0) - command_editor::remove_event_hook (gh_manager::process_events); - } -} - -property_list::plist_map_type -root_figure::init_factory_properties (void) -{ - property_list::plist_map_type plist_map; - - plist_map["figure"] = figure::properties::factory_defaults (); - plist_map["axes"] = axes::properties::factory_defaults (); - plist_map["line"] = line::properties::factory_defaults (); - plist_map["text"] = text::properties::factory_defaults (); - plist_map["image"] = image::properties::factory_defaults (); - plist_map["patch"] = patch::properties::factory_defaults (); - plist_map["surface"] = surface::properties::factory_defaults (); - plist_map["hggroup"] = hggroup::properties::factory_defaults (); - plist_map["uimenu"] = uimenu::properties::factory_defaults (); - plist_map["uicontrol"] = uicontrol::properties::factory_defaults (); - plist_map["uipanel"] = uipanel::properties::factory_defaults (); - plist_map["uicontextmenu"] = uicontextmenu::properties::factory_defaults (); - plist_map["uitoolbar"] = uitoolbar::properties::factory_defaults (); - plist_map["uipushtool"] = uipushtool::properties::factory_defaults (); - plist_map["uitoggletool"] = uitoggletool::properties::factory_defaults (); - - return plist_map; -} - -// --------------------------------------------------------------------- - -DEFUN (ishandle, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ishandle (@var{h})\n\ -Return true if @var{h} is a graphics handle and false otherwise.\n\ -@var{h} may also be a matrix of handles in which case a logical\n\ -array is returned that is true where the elements of @var{h} are\n\ -graphics handles and false where they are not.\n\ -@seealso{isfigure}\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - if (args.length () == 1) - retval = is_handle (args(0)); - else - print_usage (); - - return retval; -} - -static bool -is_handle_visible (const graphics_handle& h) -{ - return h.ok () && gh_manager::is_handle_visible (h); -} - -static bool -is_handle_visible (double val) -{ - return is_handle_visible (gh_manager::lookup (val)); -} - -static octave_value -is_handle_visible (const octave_value& val) -{ - octave_value retval = false; - - if (val.is_real_scalar () && is_handle_visible (val.double_value ())) - retval = true; - else if (val.is_numeric_type () && val.is_real_type ()) - { - const NDArray handles = val.array_value (); - - if (! error_state) - { - boolNDArray result (handles.dims ()); - - for (octave_idx_type i = 0; i < handles.numel (); i++) - result.xelem (i) = is_handle_visible (handles (i)); - - retval = result; - } - } - - return retval; -} - -DEFUN (__is_handle_visible__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} __is_handle_visible__ (@var{h})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = is_handle_visible (args(0)); - else - print_usage (); - - return retval; -} - -DEFUN (reset, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} reset (@var{h}, @var{property})\n\ -Remove any defaults set for the handle @var{h}. The default figure\n\ -properties of \"position\", \"units\", \"windowstyle\" and\n\ -\"paperunits\" and the default axes properties of \"position\" and \"units\"\n\ -are not reset.\n\ -@end deftypefn") -{ - int nargin = args.length (); - - if (nargin != 1) - print_usage (); - else - { - // get vector of graphics handles - ColumnVector hcv (args(0).vector_value ()); - - if (! error_state) - { - // loop over graphics objects - for (octave_idx_type n = 0; n < hcv.length (); n++) - gh_manager::get_object (hcv(n)).reset_default_properties (); - } - } - - return octave_value (); -} - -DEFUN (set, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} set (@var{h}, @var{property}, @var{value}, @dots{})\n\ -@deftypefnx {Built-in Function} {} set (@var{h}, @var{properties}, @var{values})\n\ -@deftypefnx {Built-in Function} {} set (@var{h}, @var{pv})\n\ -Set named property values for the graphics handle (or vector of graphics\n\ -handles) @var{h}.\n\ -There are three ways how to give the property names and values:\n\ -\n\ -@itemize\n\ -@item as a comma separated list of @var{property}, @var{value} pairs\n\ -\n\ -Here, each @var{property} is a string containing the property name, each\n\ -@var{value} is a value of the appropriate type for the property.\n\ -\n\ -@item as a cell array of strings @var{properties} containing property names\n\ -and a cell array @var{values} containing property values.\n\ -\n\ -In this case, the number of columns of @var{values} must match the number of\n\ -elements in @var{properties}. The first column of @var{values} contains\n\ -values for the first entry in @var{properties}, etc. The number of rows of\n\ -@var{values} must be 1 or match the number of elements of @var{h}. In the\n\ -first case, each handle in @var{h} will be assigned the same values. In the\n\ -latter case, the first handle in @var{h} will be assigned the values from\n\ -the first row of @var{values} and so on.\n\ -\n\ -@item as a structure array @var{pv}\n\ -\n\ -Here, the field names of @var{pv} represent the property names, and the field\n\ -values give the property values. In contrast to the previous case, all\n\ -elements of @var{pv} will be set in all handles in @var{h} independent of\n\ -the dimensions of @var{pv}.\n\ -@end itemize\n\ -@seealso{get}\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - int nargin = args.length (); - - if (nargin > 0) - { - // get vector of graphics handles - ColumnVector hcv (args(0).vector_value ()); - - if (! error_state) - { - bool request_drawnow = false; - - // loop over graphics objects - for (octave_idx_type n = 0; n < hcv.length (); n++) - { - graphics_object obj = gh_manager::get_object (hcv(n)); - - if (obj) - { - if (nargin == 3 && args(1).is_cellstr () - && args(2).is_cell ()) - { - if (args(2).cell_value ().rows () == 1) - { - obj.set (args(1).cellstr_value (), - args(2).cell_value (), 0); - } - else if (hcv.length () == args(2).cell_value ().rows ()) - { - obj.set (args(1).cellstr_value (), - args(2).cell_value (), n); - } - else - { - error ("set: number of graphics handles must match number of value rows (%d != %d)", - hcv.length (), args(2).cell_value ().rows ()); - break; - - } - } - else if (nargin == 2 && args(1).is_map ()) - { - obj.set (args(1).map_value ()); - } - else if (nargin == 1) - { - if (nargout != 0) - retval = obj.values_as_struct (); - else - { - std::string s = obj.values_as_string (); - if (! error_state) - octave_stdout << s; - } - } - else - { - obj.set (args.splice (0, 1)); - request_drawnow = true; - } - } - else - { - error ("set: invalid handle (= %g)", hcv(n)); - break; - } - - if (error_state) - break; - - request_drawnow = true; - } - - if (! error_state && request_drawnow) - Vdrawnow_requested = true; - } - else - error ("set: expecting graphics handle as first argument"); - } - else - print_usage (); - - return retval; -} - -static std::string -get_graphics_object_type (const double val) -{ - std::string retval; - - graphics_object obj = gh_manager::get_object (val); - - if (obj) - retval = obj.type (); - else - error ("get: invalid handle (= %g)", val); - - return retval; -} - -DEFUN (get, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} get (@var{h})\n\ -@deftypefnx {Built-in Function} {@var{val} =} get (@var{h}, @var{p})\n\ -Return the value of the named property @var{p} from the graphics handle\n\ -@var{h}. If @var{p} is omitted, return the complete property list for\n\ -@var{h}. If @var{h} is a vector, return a cell array including the property\n\ -values or lists respectively.\n\ -@seealso{set}\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - Cell vals; - - int nargin = args.length (); - - bool use_cell_format = false; - - if (nargin == 1 || nargin == 2) - { - if (args(0).is_empty ()) - { - retval = Matrix (); - return retval; - } - - ColumnVector hcv (args(0).vector_value ()); - - if (! error_state) - { - octave_idx_type len = hcv.length (); - - if (nargin == 1 && len > 1) - { - std::string t0 = get_graphics_object_type (hcv(0)); - - if (! error_state) - { - for (octave_idx_type n = 1; n < len; n++) - { - std::string t = get_graphics_object_type (hcv(n)); - - if (error_state) - break; - - if (t != t0) - { - error ("get: vector of handles must all have same type"); - break; - } - } - - } - } - - if (! error_state) - { - if (nargin > 1 && args(1).is_cellstr ()) - { - Array plist = args(1).cellstr_value (); - - if (! error_state) - { - octave_idx_type plen = plist.numel (); - - use_cell_format = true; - - vals.resize (dim_vector (len, plen)); - - for (octave_idx_type n = 0; ! error_state && n < len; n++) - { - graphics_object obj = gh_manager::get_object (hcv(n)); - - if (obj) - { - for (octave_idx_type m = 0; ! error_state && m < plen; m++) - { - caseless_str property = plist(m); - - vals(n, m) = obj.get (property); - } - } - else - { - error ("get: invalid handle (= %g)", hcv(n)); - break; - } - } - } - else - error ("get: expecting property name or cell array of property names as second argument"); - } - else - { - caseless_str property; - - if (nargin > 1) - { - property = args(1).string_value (); - - if (error_state) - error ("get: expecting property name or cell array of property names as second argument"); - } - - vals.resize (dim_vector (len, 1)); - - if (! error_state) - { - for (octave_idx_type n = 0; ! error_state && n < len; n++) - { - graphics_object obj = gh_manager::get_object (hcv(n)); - - if (obj) - { - if (nargin == 1) - vals(n) = obj.get (); - else - vals(n) = obj.get (property); - } - else - { - error ("get: invalid handle (= %g)", hcv(n)); - break; - } - } - } - } - } - } - else - error ("get: expecting graphics handle as first argument"); - } - else - print_usage (); - - if (! error_state) - { - if (use_cell_format) - retval = vals; - else - { - octave_idx_type len = vals.numel (); - - if (len == 0) - retval = Matrix (); - else if (len == 1) - retval = vals(0); - else if (len > 1 && nargin == 1) - { - OCTAVE_LOCAL_BUFFER (octave_scalar_map, tmp, len); - - for (octave_idx_type n = 0; n < len; n++) - tmp[n] = vals(n).scalar_map_value (); - - retval = octave_map::cat (0, len, tmp); - } - else - retval = vals; - } - } - - return retval; -} - -/* -%!assert (get (findobj (0, "Tag", "nonexistenttag"), "nonexistentproperty"), []) -*/ - -// Return all properties from the graphics handle @var{h}. -// If @var{h} is a vector, return a cell array including the -// property values or lists respectively. - -DEFUN (__get__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __get__ (@var{h})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - Cell vals; - - int nargin = args.length (); - - if (nargin == 1) - { - ColumnVector hcv (args(0).vector_value ()); - - if (! error_state) - { - octave_idx_type len = hcv.length (); - - vals.resize (dim_vector (len, 1)); - - for (octave_idx_type n = 0; n < len; n++) - { - graphics_object obj = gh_manager::get_object (hcv(n)); - - if (obj) - vals(n) = obj.get (true); - else - { - error ("get: invalid handle (= %g)", hcv(n)); - break; - } - } - } - else - error ("get: expecting graphics handle as first argument"); - } - else - print_usage (); - - if (! error_state) - { - octave_idx_type len = vals.numel (); - - if (len > 1) - retval = vals; - else if (len == 1) - retval = vals(0); - } - - return retval; -} - -static octave_value -make_graphics_object (const std::string& go_name, - bool integer_figure_handle, - const octave_value_list& args) -{ - octave_value retval; - - double val = octave_NaN; - - octave_value_list xargs = args.splice (0, 1); - - caseless_str p ("parent"); - - for (int i = 0; i < xargs.length (); i++) - if (xargs(i).is_string () - && p.compare (xargs(i).string_value ())) - { - if (i < (xargs.length () - 1)) - { - val = xargs(i+1).double_value (); - - if (! error_state) - { - xargs = xargs.splice (i, 2); - break; - } - } - else - error ("__go_%s__: missing value for parent property", - go_name.c_str ()); - } - - if (! error_state && xisnan (val)) - val = args(0).double_value (); - - if (! error_state) - { - graphics_handle parent = gh_manager::lookup (val); - - if (parent.ok ()) - { - graphics_handle h - = gh_manager::make_graphics_handle (go_name, parent, - integer_figure_handle, - false, false); - - if (! error_state) - { - adopt (parent, h); - - xset (h, xargs); - xcreatefcn (h); - xinitialize (h); - - retval = h.value (); - - if (! error_state) - Vdrawnow_requested = true; - } - else - error ("__go%s__: unable to create graphics handle", - go_name.c_str ()); - } - else - error ("__go_%s__: invalid parent", go_name.c_str ()); - } - else - error ("__go_%s__: invalid parent", go_name.c_str ()); - - return retval; -} - -DEFUN (__go_figure__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_figure__ (@var{fignum})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - if (args.length () > 0) - { - double val = args(0).double_value (); - - if (! error_state) - { - if (is_figure (val)) - { - graphics_handle h = gh_manager::lookup (val); - - xset (h, args.splice (0, 1)); - - retval = h.value (); - } - else - { - bool int_fig_handle = true; - - octave_value_list xargs = args.splice (0, 1); - - graphics_handle h = octave_NaN; - - if (xisnan (val)) - { - caseless_str p ("integerhandle"); - - for (int i = 0; i < xargs.length (); i++) - { - if (xargs(i).is_string () - && p.compare (xargs(i).string_value ())) - { - if (i < (xargs.length () - 1)) - { - std::string pval = xargs(i+1).string_value (); - - if (! error_state) - { - caseless_str on ("on"); - int_fig_handle = on.compare (pval); - xargs = xargs.splice (i, 2); - break; - } - } - } - } - - h = gh_manager::make_graphics_handle ("figure", 0, - int_fig_handle, - false, false); - - if (! int_fig_handle) - { - // We need to intiailize the integerhandle - // property without calling the set_integerhandle - // method, because doing that will generate a new - // handle value... - - graphics_object go = gh_manager::get_object (h); - go.get_properties ().init_integerhandle ("off"); - } - } - else if (val > 0 && D_NINT (val) == val) - h = gh_manager::make_figure_handle (val, false); - - if (! error_state && h.ok ()) - { - adopt (0, h); - - gh_manager::push_figure (h); - - xset (h, xargs); - xcreatefcn (h); - xinitialize (h); - - retval = h.value (); - } - else - error ("__go_figure__: failed to create figure handle"); - } - } - else - error ("__go_figure__: expecting figure number to be double value"); - } - else - print_usage (); - - return retval; -} - -#define GO_BODY(TYPE) \ - gh_manager::auto_lock guard; \ - \ - octave_value retval; \ - \ - if (args.length () > 0) \ - retval = make_graphics_object (#TYPE, false, args); \ - else \ - print_usage (); \ - \ - return retval - -int -calc_dimensions (const graphics_object& go) -{ - - int nd = 2; - - if (go.isa ("surface")) - nd = 3; - - if ((go.isa ("line") || go.isa ("patch")) && ! go.get("zdata").is_empty ()) - nd = 3; - - Matrix kids = go.get_properties ().get_children (); - - for (octave_idx_type i = 0; i < kids.length (); i++) - { - graphics_handle hnd = gh_manager::lookup (kids(i)); - - if (hnd.ok ()) - { - const graphics_object& kid = gh_manager::get_object (hnd); - - if (kid.valid_object ()) - nd = calc_dimensions (kid); - - if (nd == 3) - break; - } - } - - return nd; -} - -DEFUN (__calc_dimensions__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __calc_dimensions__ (@var{axes})\n\ -Internal function. Determine the number of dimensions in a graphics\n\ -object, whether 2 or 3.\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - double h = args(0).double_value (); - - if (! error_state) - retval = calc_dimensions (gh_manager::get_object (h)); - else - error ("__calc_dimensions__: expecting graphics handle as only argument"); - } - else - print_usage (); - - return retval; -} - -DEFUN (__go_axes__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_axes__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (axes); -} - -DEFUN (__go_line__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_line__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (line); -} - -DEFUN (__go_text__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_text__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (text); -} - -DEFUN (__go_image__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_image__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (image); -} - -DEFUN (__go_surface__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_surface__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (surface); -} - -DEFUN (__go_patch__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_patch__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (patch); -} - -DEFUN (__go_hggroup__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_hggroup__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (hggroup); -} - -DEFUN (__go_uimenu__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_uimenu__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (uimenu); -} - -DEFUN (__go_uicontrol__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_uicontrol__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (uicontrol); -} - -DEFUN (__go_uipanel__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_uipanel__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (uipanel); -} - -DEFUN (__go_uicontextmenu__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_uicontextmenu__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (uicontextmenu); -} - -DEFUN (__go_uitoolbar__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_uitoolbar__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (uitoolbar); -} - -DEFUN (__go_uipushtool__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_uipushtool__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (uipushtool); -} - -DEFUN (__go_uitoggletool__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_uitoggletool__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (uitoggletool); -} - -DEFUN (__go_delete__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_delete__ (@var{h})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value_list retval; - - if (args.length () == 1) - { - graphics_handle h = octave_NaN; - - const NDArray vals = args (0).array_value (); - - if (! error_state) - { - // Check is all the handles to delete are valid first - // as callbacks might delete one of the handles we - // later want to delete - for (octave_idx_type i = 0; i < vals.numel (); i++) - { - h = gh_manager::lookup (vals.elem (i)); - - if (! h.ok ()) - { - error ("delete: invalid graphics object (= %g)", - vals.elem (i)); - break; - } - } - - if (! error_state) - delete_graphics_objects (vals); - } - else - error ("delete: invalid graphics object"); - } - else - print_usage (); - - return retval; -} - -DEFUN (__go_axes_init__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_axes_init__ (@var{h}, @var{mode})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - int nargin = args.length (); - - std::string mode = ""; - - if (nargin == 2) - { - mode = args(1).string_value (); - - if (error_state) - return retval; - } - - if (nargin == 1 || nargin == 2) - { - graphics_handle h = octave_NaN; - - double val = args(0).double_value (); - - if (! error_state) - { - h = gh_manager::lookup (val); - - if (h.ok ()) - { - graphics_object obj = gh_manager::get_object (h); - - obj.set_defaults (mode); - - h = gh_manager::lookup (val); - if (! h.ok ()) - error ("__go_axes_init__: axis deleted during initialization (= %g)", val); - } - else - error ("__go_axes_init__: invalid graphics object (= %g)", val); - } - else - error ("__go_axes_init__: invalid graphics object"); - } - else - print_usage (); - - return retval; -} - -DEFUN (__go_handles__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_handles__ (@var{show_hidden})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - bool show_hidden = false; - - if (args.length () > 0) - show_hidden = args(0).bool_value (); - - return octave_value (gh_manager::handle_list (show_hidden)); -} - -DEFUN (__go_figure_handles__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_figure_handles__ (@var{show_hidden})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - bool show_hidden = false; - - if (args.length () > 0) - show_hidden = args(0).bool_value (); - - return octave_value (gh_manager::figure_handle_list (show_hidden)); -} - -DEFUN (__go_execute_callback__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_execute_callback__ (@var{h}, @var{name})\n\ -@deftypefnx {Built-in Function} {} __go_execute_callback__ (@var{h}, @var{name}, @var{param})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2 || nargin == 3) - { - double val = args(0).double_value (); - - if (! error_state) - { - graphics_handle h = gh_manager::lookup (val); - - if (h.ok ()) - { - std::string name = args(1).string_value (); - - if (! error_state) - { - if (nargin == 2) - gh_manager::execute_callback (h, name); - else - gh_manager::execute_callback (h, name, args(2)); - } - else - error ("__go_execute_callback__: invalid callback name"); - } - else - error ("__go_execute_callback__: invalid graphics object (= %g)", - val); - } - else - error ("__go_execute_callback__: invalid graphics object"); - } - else - print_usage (); - - return retval; -} - -DEFUN (__image_pixel_size__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{px}, @var{py}} __image_pixel_size__ (@var{h})\n\ -Internal function: returns the pixel size of the image in normalized units.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - double h = args(0).double_value (); - - if (! error_state) - { - graphics_object fobj = gh_manager::get_object (h); - if (fobj && fobj.isa ("image")) - { - image::properties& ip = - dynamic_cast (fobj.get_properties ()); - - Matrix dp = Matrix (1, 2, 0); - dp(0, 0) = ip.pixel_xsize (); - dp(0, 1) = ip.pixel_ysize (); - retval = dp; - } - else - error ("__image_pixel_size__: object is not an image"); - } - else - error ("__image_pixel_size__: argument is not a handle"); - } - else - print_usage (); - - return retval; -} - -gtk_manager *gtk_manager::instance = 0; - -void -gtk_manager::create_instance (void) -{ - instance = new gtk_manager (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); -} - -graphics_toolkit -gtk_manager::do_get_toolkit (void) const -{ - graphics_toolkit retval; - - const_loaded_toolkits_iterator pl = loaded_toolkits.find (dtk); - - if (pl == loaded_toolkits.end ()) - { - const_available_toolkits_iterator pa = available_toolkits.find (dtk); - - if (pa != available_toolkits.end ()) - { - octave_value_list args; - args(0) = dtk; - feval ("graphics_toolkit", args); - - if (! error_state) - pl = loaded_toolkits.find (dtk); - - if (error_state || pl == loaded_toolkits.end ()) - error ("failed to load %s graphics toolkit", dtk.c_str ()); - else - retval = pl->second; - } - else - error ("default graphics toolkit '%s' is not available!", - dtk.c_str ()); - } - else - retval = pl->second; - - return retval; -} - -DEFUN (available_graphics_toolkits, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} available_graphics_toolkits ()\n\ -Return a cell array of registered graphics toolkits.\n\ -@seealso{graphics_toolkit, register_graphics_toolkit}\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - return octave_value (gtk_manager::available_toolkits_list ()); -} - -DEFUN (register_graphics_toolkit, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} register_graphics_toolkit (@var{toolkit})\n\ -List @var{toolkit} as an available graphics toolkit.\n\ -@seealso{available_graphics_toolkits}\n\ -@end deftypefn") -{ - octave_value retval; - - gh_manager::auto_lock guard; - - if (args.length () == 1) - { - std::string name = args(0).string_value (); - - if (! error_state) - gtk_manager::register_toolkit (name); - else - error ("register_graphics_toolkit: expecting character string"); - } - else - print_usage (); - - return retval; -} - -DEFUN (loaded_graphics_toolkits, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} loaded_graphics_toolkits ()\n\ -Return a cell array of the currently loaded graphics toolkits.\n\ -@seealso{available_graphics_toolkits}\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - return octave_value (gtk_manager::loaded_toolkits_list ()); -} - -DEFUN (drawnow, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} drawnow ()\n\ -@deftypefnx {Built-in Function} {} drawnow (\"expose\")\n\ -@deftypefnx {Built-in Function} {} drawnow (@var{term}, @var{file}, @var{mono}, @var{debug_file})\n\ -Update figure windows and their children. The event queue is flushed and\n\ -any callbacks generated are executed. With the optional argument\n\ -@code{\"expose\"}, only graphic objects are updated and no other events or\n\ -callbacks are processed.\n\ -The third calling form of @code{drawnow} is for debugging and is\n\ -undocumented.\n\ -@end deftypefn") -{ - static int drawnow_executing = 0; - - octave_value retval; - - gh_manager::lock (); - - unwind_protect frame; - frame.protect_var (Vdrawnow_requested, false); - - frame.protect_var (drawnow_executing); - - if (++drawnow_executing <= 1) - { - if (args.length () == 0 || args.length () == 1) - { - Matrix hlist = gh_manager::figure_handle_list (true); - - for (int i = 0; ! error_state && i < hlist.length (); i++) - { - graphics_handle h = gh_manager::lookup (hlist(i)); - - if (h.ok () && h != 0) - { - graphics_object go = gh_manager::get_object (h); - figure::properties& fprops = dynamic_cast (go.get_properties ()); - - if (fprops.is_modified ()) - { - if (fprops.is_visible ()) - { - gh_manager::unlock (); - - fprops.get_toolkit ().redraw_figure (go); - - gh_manager::lock (); - } - - fprops.set_modified (false); - } - } - } - - bool do_events = true; - - if (args.length () == 1) - { - caseless_str val (args(0).string_value ()); - - if (! error_state && val.compare ("expose")) - do_events = false; - else - { - error ("drawnow: invalid argument, expected 'expose' as argument"); - return retval; - } - } - - if (do_events) - { - gh_manager::unlock (); - - gh_manager::process_events (); - - gh_manager::lock (); - } - } - else if (args.length () >= 2 && args.length () <= 4) - { - std::string term, file, debug_file; - bool mono; - - term = args(0).string_value (); - - if (! error_state) - { - file = args(1).string_value (); - - if (! error_state) - { - size_t pos = file.find_first_not_of ("|"); - if (pos > 0) - file = file.substr (pos); - else - { - pos = file.find_last_of (file_ops::dir_sep_chars ()); - - if (pos != std::string::npos) - { - std::string dirname = file.substr (0, pos+1); - - file_stat fs (dirname); - - if (! (fs && fs.is_dir ())) - { - error ("drawnow: nonexistent directory '%s'", - dirname.c_str ()); - - return retval; - } - } - } - - mono = (args.length () >= 3 ? args(2).bool_value () : false); - - if (! error_state) - { - debug_file = (args.length () > 3 ? args(3).string_value () - : ""); - - if (! error_state) - { - graphics_handle h = gcf (); - - if (h.ok ()) - { - graphics_object go = gh_manager::get_object (h); - - gh_manager::unlock (); - - go.get_toolkit () - .print_figure (go, term, file, mono, debug_file); - - gh_manager::lock (); - } - else - error ("drawnow: nothing to draw"); - } - else - error ("drawnow: invalid DEBUG_FILE, expected a string value"); - } - else - error ("drawnow: invalid colormode MONO, expected a boolean value"); - } - else - error ("drawnow: invalid FILE, expected a string value"); - } - else - error ("drawnow: invalid terminal TERM, expected a string value"); - } - else - print_usage (); - } - - gh_manager::unlock (); - - return retval; -} - -DEFUN (addlistener, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} addlistener (@var{h}, @var{prop}, @var{fcn})\n\ -Register @var{fcn} as listener for the property @var{prop} of the graphics\n\ -object @var{h}. Property listeners are executed (in order of registration)\n\ -when the property is set. The new value is already available when the\n\ -listeners are executed.\n\ -\n\ -@var{prop} must be a string naming a valid property in @var{h}.\n\ -\n\ -@var{fcn} can be a function handle, a string or a cell array whose first\n\ -element is a function handle. If @var{fcn} is a function handle, the\n\ -corresponding function should accept at least 2 arguments, that will be\n\ -set to the object handle and the empty matrix respectively. If @var{fcn}\n\ -is a string, it must be any valid octave expression. If @var{fcn} is a cell\n\ -array, the first element must be a function handle with the same signature\n\ -as described above. The next elements of the cell array are passed\n\ -as additional arguments to the function.\n\ -\n\ -Example:\n\ -\n\ -@example\n\ -@group\n\ -function my_listener (h, dummy, p1)\n\ - fprintf (\"my_listener called with p1=%s\\n\", p1);\n\ -endfunction\n\ -\n\ -addlistener (gcf, \"position\", @{@@my_listener, \"my string\"@})\n\ -@end group\n\ -@end example\n\ -\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - if (args.length () >= 3 && args.length () <= 4) - { - double h = args(0).double_value (); - - if (! error_state) - { - std::string pname = args(1).string_value (); - - if (! error_state) - { - graphics_handle gh = gh_manager::lookup (h); - - if (gh.ok ()) - { - graphics_object go = gh_manager::get_object (gh); - - go.add_property_listener (pname, args(2), POSTSET); - - if (args.length () == 4) - { - caseless_str persistent = args(3).string_value (); - if (persistent.compare ("persistent")) - go.add_property_listener (pname, args(2), PERSISTENT); - } - } - else - error ("addlistener: invalid graphics object (= %g)", - h); - } - else - error ("addlistener: invalid property name, expected a string value"); - } - else - error ("addlistener: invalid handle"); - } - else - print_usage (); - - return retval; -} - -DEFUN (dellistener, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} dellistener (@var{h}, @var{prop}, @var{fcn})\n\ -Remove the registration of @var{fcn} as a listener for the property\n\ -@var{prop} of the graphics object @var{h}. The function @var{fcn} must\n\ -be the same variable (not just the same value), as was passed to the\n\ -original call to @code{addlistener}.\n\ -\n\ -If @var{fcn} is not defined then all listener functions of @var{prop}\n\ -are removed.\n\ -\n\ -Example:\n\ -\n\ -@example\n\ -@group\n\ -function my_listener (h, dummy, p1)\n\ - fprintf (\"my_listener called with p1=%s\\n\", p1);\n\ -endfunction\n\ -\n\ -c = @{@@my_listener, \"my string\"@};\n\ -addlistener (gcf, \"position\", c);\n\ -dellistener (gcf, \"position\", c);\n\ -@end group\n\ -@end example\n\ -\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - if (args.length () == 3 || args.length () == 2) - { - double h = args(0).double_value (); - - if (! error_state) - { - std::string pname = args(1).string_value (); - - if (! error_state) - { - graphics_handle gh = gh_manager::lookup (h); - - if (gh.ok ()) - { - graphics_object go = gh_manager::get_object (gh); - - if (args.length () == 2) - go.delete_property_listener (pname, octave_value (), POSTSET); - else - { - caseless_str persistent = args(2).string_value (); - if (persistent.compare ("persistent")) - { - go.delete_property_listener (pname, octave_value (), PERSISTENT); - go.delete_property_listener (pname, octave_value (), POSTSET); - } - else - go.delete_property_listener (pname, args(2), POSTSET); - } - } - else - error ("dellistener: invalid graphics object (= %g)", - h); - } - else - error ("dellistener: invalid property name, expected a string value"); - } - else - error ("dellistener: invalid handle"); - } - else - print_usage (); - - return retval; -} - -DEFUN (addproperty, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} addproperty (@var{name}, @var{h}, @var{type})\n\ -@deftypefnx {Built-in Function} {} addproperty (@var{name}, @var{h}, @var{type}, @var{arg}, @dots{})\n\ -Create a new property named @var{name} in graphics object @var{h}.\n\ -@var{type} determines the type of the property to create. @var{args}\n\ -usually contains the default value of the property, but additional\n\ -arguments might be given, depending on the type of the property.\n\ -\n\ -The supported property types are:\n\ -\n\ -@table @code\n\ -@item string\n\ -A string property. @var{arg} contains the default string value.\n\ -\n\ -@item any\n\ -An @nospell{un-typed} property. This kind of property can hold any octave\n\ -value. @var{args} contains the default value.\n\ -\n\ -@item radio\n\ -A string property with a limited set of accepted values. The first\n\ -argument must be a string with all accepted values separated by\n\ -a vertical bar ('|'). The default value can be marked by enclosing\n\ -it with a '@{' '@}' pair. The default value may also be given as\n\ -an optional second string argument.\n\ -\n\ -@item boolean\n\ -A boolean property. This property type is equivalent to a radio\n\ -property with \"on|off\" as accepted values. @var{arg} contains\n\ -the default property value.\n\ -\n\ -@item double\n\ -A scalar double property. @var{arg} contains the default value.\n\ -\n\ -@item handle\n\ -A handle property. This kind of property holds the handle of a\n\ -graphics object. @var{arg} contains the default handle value.\n\ -When no default value is given, the property is initialized to\n\ -the empty matrix.\n\ -\n\ -@item data\n\ -A data (matrix) property. @var{arg} contains the default data\n\ -value. When no default value is given, the data is initialized to\n\ -the empty matrix.\n\ -\n\ -@item color\n\ -A color property. @var{arg} contains the default color value.\n\ -When no default color is given, the property is set to black.\n\ -An optional second string argument may be given to specify an\n\ -additional set of accepted string values (like a radio property).\n\ -@end table\n\ -\n\ -@var{type} may also be the concatenation of a core object type and\n\ -a valid property name for that object type. The property created\n\ -then has the same characteristics as the referenced property (type,\n\ -possible values, hidden state@dots{}). This allows to clone an existing\n\ -property into the graphics object @var{h}.\n\ -\n\ -Examples:\n\ -\n\ -@example\n\ -@group\n\ -addproperty (\"my_property\", gcf, \"string\", \"a string value\");\n\ -addproperty (\"my_radio\", gcf, \"radio\", \"val_1|val_2|@{val_3@}\");\n\ -addproperty (\"my_style\", gcf, \"linelinestyle\", \"--\");\n\ -@end group\n\ -@end example\n\ -\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - if (args.length () >= 3) - { - std::string name = args(0).string_value (); - - if (! error_state) - { - double h = args(1).double_value (); - - if (! error_state) - { - graphics_handle gh = gh_manager::lookup (h); - - if (gh.ok ()) - { - graphics_object go = gh_manager::get_object (gh); - - std::string type = args(2).string_value (); - - if (! error_state) - { - if (! go.get_properties ().has_property (name)) - { - property p = property::create (name, gh, type, - args.splice (0, 3)); - - if (! error_state) - go.get_properties ().insert_property (name, p); - } - else - error ("addproperty: a '%s' property already exists in the graphics object", - name.c_str ()); - } - else - error ("addproperty: invalid property TYPE, expected a string value"); - } - else - error ("addproperty: invalid graphics object (= %g)", h); - } - else - error ("addproperty: invalid handle value"); - } - else - error ("addproperty: invalid property NAME, expected a string value"); - } - else - print_usage (); - - return retval; -} - -octave_value -get_property_from_handle (double handle, const std::string& property, - const std::string& func) -{ - gh_manager::auto_lock guard; - - graphics_object obj = gh_manager::get_object (handle); - octave_value retval; - - if (obj) - retval = obj.get (caseless_str (property)); - else - error ("%s: invalid handle (= %g)", func.c_str (), handle); - - return retval; -} - -bool -set_property_in_handle (double handle, const std::string& property, - const octave_value& arg, const std::string& func) -{ - gh_manager::auto_lock guard; - - graphics_object obj = gh_manager::get_object (handle); - int ret = false; - - if (obj) - { - obj.set (caseless_str (property), arg); - - if (! error_state) - ret = true; - } - else - error ("%s: invalid handle (= %g)", func.c_str (), handle); - - return ret; -} - -static bool -compare_property_values (const octave_value& o1, const octave_value& o2) -{ - octave_value_list args (2); - - args(0) = o1; - args(1) = o2; - - octave_value_list result = feval ("isequal", args, 1); - - if (! error_state && result.length () > 0) - return result(0).bool_value (); - - return false; -} - -static std::map waitfor_results; - -static void -cleanup_waitfor_id (uint32_t id) -{ - waitfor_results.erase (id); -} - -static void -do_cleanup_waitfor_listener (const octave_value& listener, - listener_mode mode = POSTSET) -{ - Cell c = listener.cell_value (); - - if (c.numel () >= 4) - { - double h = c(2).double_value (); - - if (! error_state) - { - caseless_str pname = c(3).string_value (); - - if (! error_state) - { - gh_manager::auto_lock guard; - - graphics_handle handle = gh_manager::lookup (h); - - if (handle.ok ()) - { - graphics_object go = gh_manager::get_object (handle); - - if (go.get_properties ().has_property (pname)) - { - go.get_properties () - .delete_listener (pname, listener, mode); - if (mode == POSTSET) - go.get_properties () - .delete_listener (pname, listener, PERSISTENT); - } - } - } - } - } -} - -static void -cleanup_waitfor_postset_listener (const octave_value& listener) -{ do_cleanup_waitfor_listener (listener, POSTSET); } - -static void -cleanup_waitfor_predelete_listener (const octave_value& listener) -{ do_cleanup_waitfor_listener (listener, PREDELETE); } - -static octave_value_list -waitfor_listener (const octave_value_list& args, int) -{ - if (args.length () > 3) - { - uint32_t id = args(2).uint32_scalar_value ().value (); - - if (! error_state) - { - if (args.length () > 5) - { - double h = args(0).double_value (); - - if (! error_state) - { - caseless_str pname = args(4).string_value (); - - if (! error_state) - { - gh_manager::auto_lock guard; - - graphics_handle handle = gh_manager::lookup (h); - - if (handle.ok ()) - { - graphics_object go = gh_manager::get_object (handle); - octave_value pvalue = go.get (pname); - - if (compare_property_values (pvalue, args(5))) - waitfor_results[id] = true; - } - } - } - } - else - waitfor_results[id] = true; - } - } - - return octave_value_list (); -} - -static octave_value_list -waitfor_del_listener (const octave_value_list& args, int) -{ - if (args.length () > 2) - { - uint32_t id = args(2).uint32_scalar_value ().value (); - - if (! error_state) - waitfor_results[id] = true; - } - - return octave_value_list (); -} - -DEFUN (waitfor, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} waitfor (@var{h})\n\ -@deftypefnx {Built-in Function} {} waitfor (@var{h}, @var{prop})\n\ -@deftypefnx {Built-in Function} {} waitfor (@var{h}, @var{prop}, @var{value})\n\ -@deftypefnx {Built-in Function} {} waitfor (@dots{}, \"timeout\", @var{timeout})\n\ -Suspend the execution of the current program until a condition is\n\ -satisfied on the graphics handle @var{h}. While the program is suspended\n\ -graphics events are still being processed normally, allowing callbacks to\n\ -modify the state of graphics objects. This function is reentrant and can be\n\ -called from a callback, while another @code{waitfor} call is pending at\n\ -top-level.\n\ -\n\ -In the first form, program execution is suspended until the graphics object\n\ -@var{h} is destroyed. If the graphics handle is invalid, the function\n\ -returns immediately.\n\ -\n\ -In the second form, execution is suspended until the graphics object is\n\ -destroyed or the property named @var{prop} is modified. If the graphics\n\ -handle is invalid or the property does not exist, the function returns\n\ -immediately.\n\ -\n\ -In the third form, execution is suspended until the graphics object is\n\ -destroyed or the property named @var{prop} is set to @var{value}. The\n\ -function @code{isequal} is used to compare property values. If the graphics\n\ -handle is invalid, the property does not exist or the property is already\n\ -set to @var{value}, the function returns immediately.\n\ -\n\ -An optional timeout can be specified using the property @code{timeout}.\n\ -This timeout value is the number of seconds to wait for the condition to be\n\ -true. @var{timeout} must be at least 1. If a smaller value is specified, a\n\ -warning is issued and a value of 1 is used instead. If the timeout value is\n\ -not an integer, it is truncated towards 0.\n\ -\n\ -To define a condition on a property named @code{timeout}, use the string\n\ -@code{\\timeout} instead.\n\ -\n\ -In all cases, typing CTRL-C stops program execution immediately.\n\ -@seealso{isequal}\n\ -@end deftypefn") -{ - if (args.length () > 0) - { - double h = args(0).double_value (); - - if (! error_state) - { - caseless_str pname; - - unwind_protect frame; - - static uint32_t id_counter = 0; - uint32_t id = 0; - - int max_arg_index = 0; - int timeout_index = -1; - - int timeout = 0; - - if (args.length () > 1) - { - pname = args(1).string_value (); - if (! error_state - && ! pname.empty () - && ! pname.compare ("timeout")) - { - if (pname.compare ("\\timeout")) - pname = "timeout"; - - static octave_value wf_listener; - - if (! wf_listener.is_defined ()) - wf_listener = - octave_value (new octave_builtin (waitfor_listener, - "waitfor_listener")); - - max_arg_index++; - if (args.length () > 2) - { - if (args(2).is_string ()) - { - caseless_str s = args(2).string_value (); - - if (! error_state) - { - if (s.compare ("timeout")) - timeout_index = 2; - else - max_arg_index++; - } - } - else - max_arg_index++; - } - - Cell listener (1, max_arg_index >= 2 ? 5 : 4); - - id = id_counter++; - frame.add_fcn (cleanup_waitfor_id, id); - waitfor_results[id] = false; - - listener(0) = wf_listener; - listener(1) = octave_uint32 (id); - listener(2) = h; - listener(3) = pname; - - if (max_arg_index >= 2) - listener(4) = args(2); - - octave_value ov_listener (listener); - - gh_manager::auto_lock guard; - - graphics_handle handle = gh_manager::lookup (h); - - if (handle.ok ()) - { - graphics_object go = gh_manager::get_object (handle); - - if (max_arg_index >= 2 - && compare_property_values (go.get (pname), - args(2))) - waitfor_results[id] = true; - else - { - - frame.add_fcn (cleanup_waitfor_postset_listener, - ov_listener); - go.add_property_listener (pname, ov_listener, - POSTSET); - go.add_property_listener (pname, ov_listener, - PERSISTENT); - - if (go.get_properties () - .has_dynamic_property (pname)) - { - static octave_value wf_del_listener; - - if (! wf_del_listener.is_defined ()) - wf_del_listener = - octave_value (new octave_builtin - (waitfor_del_listener, - "waitfor_del_listener")); - - Cell del_listener (1, 4); - - del_listener(0) = wf_del_listener; - del_listener(1) = octave_uint32 (id); - del_listener(2) = h; - del_listener(3) = pname; - - octave_value ov_del_listener (del_listener); - - frame.add_fcn (cleanup_waitfor_predelete_listener, - ov_del_listener); - go.add_property_listener (pname, ov_del_listener, - PREDELETE); - } - } - } - } - else if (error_state || pname.empty ()) - error ("waitfor: invalid property name, expected a non-empty string value"); - } - - if (! error_state - && timeout_index < 0 - && args.length () > (max_arg_index + 1)) - { - caseless_str s = args(max_arg_index + 1).string_value (); - - if (! error_state) - { - if (s.compare ("timeout")) - timeout_index = max_arg_index + 1; - else - error ("waitfor: invalid parameter '%s'", s.c_str ()); - } - else - error ("waitfor: invalid parameter, expected 'timeout'"); - } - - if (! error_state && timeout_index >= 0) - { - if (args.length () > (timeout_index + 1)) - { - timeout = static_cast - (args(timeout_index + 1).scalar_value ()); - - if (! error_state) - { - if (timeout < 1) - { - warning ("waitfor: the timeout value must be >= 1, using 1 instead"); - timeout = 1; - } - } - else - error ("waitfor: invalid timeout value, expected a value >= 1"); - } - else - error ("waitfor: missing timeout value"); - } - - // FIXME: There is still a "hole" in the following loop. The code - // assumes that an object handle is unique, which is a fair - // assumptions, except for figures. If a figure is destroyed - // then recreated with the same figure ID, within the same - // run of event hooks, then the figure destruction won't be - // caught and the loop will not stop. This is an unlikely - // possibility in practice, though. - // - // Using deletefcn callback is also unreliable as it could be - // modified during a callback execution and the waitfor loop - // would not stop. - // - // The only "good" implementation would require object - // listeners, similar to property listeners. - - time_t start = 0; - - if (timeout > 0) - start = time (0); - - while (! error_state) - { - if (true) - { - gh_manager::auto_lock guard; - - graphics_handle handle = gh_manager::lookup (h); - - if (handle.ok ()) - { - if (! pname.empty () && waitfor_results[id]) - break; - } - else - break; - } - - octave_usleep (100000); - - OCTAVE_QUIT; - - command_editor::run_event_hooks (); - - if (timeout > 0) - { - if (start + timeout < time (0)) - break; - } - } - } - else - error ("waitfor: invalid handle value."); - } - else - print_usage (); - - return octave_value (); -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/graphics.in.h --- a/libinterp/interpfcn/graphics.in.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5862 +0,0 @@ -/* - -Copyright (C) 2007-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (graphics_h) -#define graphics_h 1 - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include -#include -#include -#include -#include -#include - -#include "caseless-str.h" -#include "lo-ieee.h" - -#include "gripes.h" -#include "oct-map.h" -#include "oct-mutex.h" -#include "oct-refcount.h" -#include "ov.h" -#include "txt-eng-ft.h" - -// FIXME -- maybe this should be a configure option? -// Matlab defaults to "Helvetica", but that causes problems for many -// gnuplot users. -#if !defined (OCTAVE_DEFAULT_FONTNAME) -#define OCTAVE_DEFAULT_FONTNAME "*" -#endif - -// --------------------------------------------------------------------- - -class graphics_handle -{ -public: - graphics_handle (void) : val (octave_NaN) { } - - graphics_handle (const octave_value& a); - - graphics_handle (int a) : val (a) { } - - graphics_handle (double a) : val (a) { } - - graphics_handle (const graphics_handle& a) : val (a.val) { } - - graphics_handle& operator = (const graphics_handle& a) - { - if (&a != this) - val = a.val; - - return *this; - } - - ~graphics_handle (void) { } - - double value (void) const { return val; } - - octave_value as_octave_value (void) const - { - return ok () ? octave_value (val) : octave_value (Matrix ()); - } - - // Prefix increment/decrement operators. - graphics_handle& operator ++ (void) - { - ++val; - return *this; - } - - graphics_handle& operator -- (void) - { - --val; - return *this; - } - - // Postfix increment/decrement operators. - const graphics_handle operator ++ (int) - { - graphics_handle old_value = *this; - ++(*this); - return old_value; - } - - const graphics_handle operator -- (int) - { - graphics_handle old_value = *this; - --(*this); - return old_value; - } - - bool ok (void) const { return ! xisnan (val); } - -private: - double val; -}; - -inline bool -operator == (const graphics_handle& a, const graphics_handle& b) -{ - return a.value () == b.value (); -} - -inline bool -operator != (const graphics_handle& a, const graphics_handle& b) -{ - return a.value () != b.value (); -} - -inline bool -operator < (const graphics_handle& a, const graphics_handle& b) -{ - return a.value () < b.value (); -} - -inline bool -operator <= (const graphics_handle& a, const graphics_handle& b) -{ - return a.value () <= b.value (); -} - -inline bool -operator >= (const graphics_handle& a, const graphics_handle& b) -{ - return a.value () >= b.value (); -} - -inline bool -operator > (const graphics_handle& a, const graphics_handle& b) -{ - return a.value () > b.value (); -} - -// --------------------------------------------------------------------- - -class base_scaler -{ -public: - base_scaler (void) { } - - virtual ~base_scaler (void) { } - - virtual Matrix scale (const Matrix& m) const - { - error ("invalid axis scale"); - return m; - } - - virtual NDArray scale (const NDArray& m) const - { - error ("invalid axis scale"); - return m; - } - - virtual double scale (double d) const - { - error ("invalid axis scale"); - return d; - } - - virtual double unscale (double d) const - { - error ("invalid axis scale"); - return d; - } - - virtual base_scaler* clone () const - { return new base_scaler (); } - - virtual bool is_linear (void) const - { return false; } -}; - -class lin_scaler : public base_scaler -{ -public: - lin_scaler (void) { } - - Matrix scale (const Matrix& m) const { return m; } - - NDArray scale (const NDArray& m) const { return m; } - - double scale (double d) const { return d; } - - double unscale (double d) const { return d; } - - base_scaler* clone (void) const { return new lin_scaler (); } - - bool is_linear (void) const { return true; } -}; - -class log_scaler : public base_scaler -{ -public: - log_scaler (void) { } - - Matrix scale (const Matrix& m) const - { - Matrix retval (m.rows (), m.cols ()); - - do_scale (m.data (), retval.fortran_vec (), m.numel ()); - - return retval; - } - - NDArray scale (const NDArray& m) const - { - NDArray retval (m.dims ()); - - do_scale (m.data (), retval.fortran_vec (), m.numel ()); - - return retval; - } - - double scale (double d) const - { return log10 (d); } - - double unscale (double d) const - { return pow (10.0, d); } - - base_scaler* clone (void) const - { return new log_scaler (); } - -private: - void do_scale (const double *src, double *dest, int n) const - { - for (int i = 0; i < n; i++) - dest[i] = log10 (src[i]); - } -}; - -class neg_log_scaler : public base_scaler -{ -public: - neg_log_scaler (void) { } - - Matrix scale (const Matrix& m) const - { - Matrix retval (m.rows (), m.cols ()); - - do_scale (m.data (), retval.fortran_vec (), m.numel ()); - - return retval; - } - - NDArray scale (const NDArray& m) const - { - NDArray retval (m.dims ()); - - do_scale (m.data (), retval.fortran_vec (), m.numel ()); - - return retval; - } - - double scale (double d) const - { return -log10 (-d); } - - double unscale (double d) const - { return -pow (10.0, -d); } - - base_scaler* clone (void) const - { return new neg_log_scaler (); } - -private: - void do_scale (const double *src, double *dest, int n) const - { - for (int i = 0; i < n; i++) - dest[i] = -log10 (-src[i]); - } -}; - -class scaler -{ -public: - scaler (void) : rep (new base_scaler ()) { } - - scaler (const scaler& s) : rep (s.rep->clone ()) { } - - scaler (const std::string& s) - : rep (s == "log" - ? new log_scaler () - : (s == "neglog" ? new neg_log_scaler () - : (s == "linear" ? new lin_scaler () : new base_scaler ()))) - { } - - ~scaler (void) { delete rep; } - - Matrix scale (const Matrix& m) const - { return rep->scale (m); } - - NDArray scale (const NDArray& m) const - { return rep->scale (m); } - - double scale (double d) const - { return rep->scale (d); } - - double unscale (double d) const - { return rep->unscale (d); } - - bool is_linear (void) const - { return rep->is_linear (); } - - scaler& operator = (const scaler& s) - { - if (rep) - { - delete rep; - rep = 0; - } - - rep = s.rep->clone (); - - return *this; - } - - scaler& operator = (const std::string& s) - { - if (rep) - { - delete rep; - rep = 0; - } - - if (s == "log") - rep = new log_scaler (); - else if (s == "neglog") - rep = new neg_log_scaler (); - else if (s == "linear") - rep = new lin_scaler (); - else - rep = new base_scaler (); - - return *this; - } - -private: - base_scaler *rep; -}; - -// --------------------------------------------------------------------- - -class property; - -enum listener_mode { POSTSET, PERSISTENT, PREDELETE }; - -class base_property -{ -public: - friend class property; - -public: - base_property (void) - : id (-1), count (1), name (), parent (), hidden (), listeners () - { } - - base_property (const std::string& s, const graphics_handle& h) - : id (-1), count (1), name (s), parent (h), hidden (false), listeners () - { } - - base_property (const base_property& p) - : id (-1), count (1), name (p.name), parent (p.parent), - hidden (p.hidden), listeners () - { } - - virtual ~base_property (void) { } - - bool ok (void) const { return parent.ok (); } - - std::string get_name (void) const { return name; } - - void set_name (const std::string& s) { name = s; } - - graphics_handle get_parent (void) const { return parent; } - - void set_parent (const graphics_handle &h) { parent = h; } - - bool is_hidden (void) const { return hidden; } - - void set_hidden (bool flag) { hidden = flag; } - - virtual bool is_radio (void) const { return false; } - - int get_id (void) const { return id; } - - void set_id (int d) { id = d; } - - // Sets property value, notifies graphics toolkit. - // If do_run is true, runs associated listeners. - OCTINTERP_API bool set (const octave_value& v, bool do_run = true, - bool do_notify_toolkit = true); - - virtual octave_value get (void) const - { - error ("get: invalid property \"%s\"", name.c_str ()); - return octave_value (); - } - - - virtual std::string values_as_string (void) const - { - error ("values_as_string: invalid property \"%s\"", name.c_str ()); - return std::string (); - } - - virtual Cell values_as_cell (void) const - { - error ("values_as_cell: invalid property \"%s\"", name.c_str ()); - return Cell (); - } - - base_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - void add_listener (const octave_value& v, listener_mode mode = POSTSET) - { - octave_value_list& l = listeners[mode]; - l.resize (l.length () + 1, v); - } - - void delete_listener (const octave_value& v = octave_value (), - listener_mode mode = POSTSET) - { - octave_value_list& l = listeners[mode]; - - if (v.is_defined ()) - { - bool found = false; - int i; - - for (i = 0; i < l.length (); i++) - { - if (v.internal_rep () == l(i).internal_rep ()) - { - found = true; - break; - } - } - if (found) - { - for (int j = i; j < l.length () - 1; j++) - l(j) = l(j + 1); - - l.resize (l.length () - 1); - } - } - else - { - if (mode == PERSISTENT) - l.resize (0); - else - { - octave_value_list lnew (0); - octave_value_list& lp = listeners[PERSISTENT]; - for (int i = l.length () - 1; i >= 0 ; i--) - { - for (int j = 0; j < lp.length (); j++) - { - if (l(i).internal_rep () == lp(j).internal_rep ()) - { - lnew.resize (lnew.length () + 1, l(i)); - break; - } - } - } - l = lnew; - } - } - - } - - OCTINTERP_API void run_listeners (listener_mode mode = POSTSET); - - virtual base_property* clone (void) const - { return new base_property (*this); } - -protected: - virtual bool do_set (const octave_value&) - { - error ("set: invalid property \"%s\"", name.c_str ()); - return false; - } - -private: - typedef std::map listener_map; - typedef std::map::iterator listener_map_iterator; - typedef std::map::const_iterator listener_map_const_iterator; - -private: - int id; - octave_refcount count; - std::string name; - graphics_handle parent; - bool hidden; - listener_map listeners; -}; - -// --------------------------------------------------------------------- - -class string_property : public base_property -{ -public: - string_property (const std::string& s, const graphics_handle& h, - const std::string& val = "") - : base_property (s, h), str (val) { } - - string_property (const string_property& p) - : base_property (p), str (p.str) { } - - octave_value get (void) const - { return octave_value (str); } - - std::string string_value (void) const { return str; } - - string_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new string_property (*this); } - -protected: - bool do_set (const octave_value& val) - { - if (val.is_string ()) - { - std::string new_str = val.string_value (); - - if (new_str != str) - { - str = new_str; - return true; - } - } - else - error ("set: invalid string property value for \"%s\"", - get_name ().c_str ()); - return false; - } - -private: - std::string str; -}; - -// --------------------------------------------------------------------- - -class string_array_property : public base_property -{ -public: - enum desired_enum { string_t, cell_t }; - - string_array_property (const std::string& s, const graphics_handle& h, - const std::string& val = "", const char& sep = '|', - const desired_enum& typ = string_t) - : base_property (s, h), desired_type (typ), separator (sep), str () - { - size_t pos = 0; - - while (true) - { - size_t new_pos = val.find_first_of (separator, pos); - - if (new_pos == std::string::npos) - { - str.append (val.substr (pos)); - break; - } - else - str.append (val.substr (pos, new_pos - pos)); - - pos = new_pos + 1; - } - } - - string_array_property (const std::string& s, const graphics_handle& h, - const Cell& c, const char& sep = '|', - const desired_enum& typ = string_t) - : base_property (s, h), desired_type (typ), separator (sep), str () - { - if (c.is_cellstr ()) - { - string_vector strings (c.numel ()); - - for (octave_idx_type i = 0; i < c.numel (); i++) - strings[i] = c(i).string_value (); - - str = strings; - } - else - error ("set: invalid order property value for \"%s\"", - get_name ().c_str ()); - } - - string_array_property (const string_array_property& p) - : base_property (p), desired_type (p.desired_type), - separator (p.separator), str (p.str) { } - - octave_value get (void) const - { - if (desired_type == string_t) - return octave_value (string_value ()); - else - return octave_value (cell_value ()); - } - - std::string string_value (void) const - { - std::string s; - - for (octave_idx_type i = 0; i < str.length (); i++) - { - s += str[i]; - if (i != str.length () - 1) - s += separator; - } - - return s; - } - - Cell cell_value (void) const {return Cell (str);} - - string_vector string_vector_value (void) const { return str; } - - string_array_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new string_array_property (*this); } - -protected: - bool do_set (const octave_value& val) - { - if (val.is_string () && val.rows () == 1) - { - bool replace = false; - std::string new_str = val.string_value (); - string_vector strings; - size_t pos = 0; - - // Split single string on delimiter (usually '|') - while (pos != std::string::npos) - { - size_t new_pos = new_str.find_first_of (separator, pos); - - if (new_pos == std::string::npos) - { - strings.append (new_str.substr (pos)); - break; - } - else - strings.append (new_str.substr (pos, new_pos - pos)); - - pos = new_pos + 1; - } - - if (str.numel () == strings.numel ()) - { - for (octave_idx_type i = 0; i < str.numel (); i++) - if (strings[i] != str[i]) - { - replace = true; - break; - } - } - else - replace = true; - - desired_type = string_t; - - if (replace) - { - str = strings; - return true; - } - } - else if (val.is_string ()) // multi-row character matrix - { - bool replace = false; - charMatrix chm = val.char_matrix_value (); - octave_idx_type nel = chm.rows (); - string_vector strings (nel); - - if (nel != str.numel ()) - replace = true; - for (octave_idx_type i = 0; i < nel; i++) - { - strings[i] = chm.row_as_string (i); - if (!replace && strings[i] != str[i]) - replace = true; - } - - desired_type = string_t; - - if (replace) - { - str = strings; - return true; - } - } - else if (val.is_cellstr ()) - { - bool replace = false; - Cell new_cell = val.cell_value (); - - string_vector strings = new_cell.cellstr_value (); - - octave_idx_type nel = strings.length (); - - if (nel != str.length ()) - replace = true; - else - { - for (octave_idx_type i = 0; i < nel; i++) - { - if (strings[i] != str[i]) - { - replace = true; - break; - } - } - } - - desired_type = cell_t; - - if (replace) - { - str = strings; - return true; - } - } - else - error ("set: invalid string property value for \"%s\"", - get_name ().c_str ()); - return false; - } - -private: - desired_enum desired_type; - char separator; - string_vector str; -}; - -// --------------------------------------------------------------------- - -class text_label_property : public base_property -{ -public: - enum type { char_t, cellstr_t }; - - text_label_property (const std::string& s, const graphics_handle& h, - const std::string& val = "") - : base_property (s, h), value (val), stored_type (char_t) - { } - - text_label_property (const std::string& s, const graphics_handle& h, - const NDArray& nda) - : base_property (s, h), stored_type (char_t) - { - octave_idx_type nel = nda.numel (); - - value.resize (nel); - - for (octave_idx_type i = 0; i < nel; i++) - { - std::ostringstream buf; - buf << nda(i); - value[i] = buf.str (); - } - } - - text_label_property (const std::string& s, const graphics_handle& h, - const Cell& c) - : base_property (s, h), stored_type (cellstr_t) - { - octave_idx_type nel = c.numel (); - - value.resize (nel); - - for (octave_idx_type i = 0; i < nel; i++) - { - octave_value tmp = c(i); - - if (tmp.is_string ()) - value[i] = c(i).string_value (); - else - { - double d = c(i).double_value (); - - if (! error_state) - { - std::ostringstream buf; - buf << d; - value[i] = buf.str (); - } - else - break; - } - } - } - - text_label_property (const text_label_property& p) - : base_property (p), value (p.value), stored_type (p.stored_type) - { } - - bool empty (void) const - { - octave_value tmp = get (); - return tmp.is_empty (); - } - - octave_value get (void) const - { - if (stored_type == char_t) - return octave_value (char_value ()); - else - return octave_value (cell_value ()); - } - - std::string string_value (void) const - { - return value.empty () ? std::string () : value[0]; - } - - string_vector string_vector_value (void) const { return value; } - - charMatrix char_value (void) const { return charMatrix (value, ' '); } - - Cell cell_value (void) const {return Cell (value); } - - text_label_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new text_label_property (*this); } - -protected: - - bool do_set (const octave_value& val) - { - if (val.is_string ()) - { - value = val.all_strings (); - - stored_type = char_t; - } - else if (val.is_cell ()) - { - Cell c = val.cell_value (); - - octave_idx_type nel = c.numel (); - - value.resize (nel); - - for (octave_idx_type i = 0; i < nel; i++) - { - octave_value tmp = c(i); - - if (tmp.is_string ()) - value[i] = c(i).string_value (); - else - { - double d = c(i).double_value (); - - if (! error_state) - { - std::ostringstream buf; - buf << d; - value[i] = buf.str (); - } - else - return false; - } - } - - stored_type = cellstr_t; - } - else - { - NDArray nda = val.array_value (); - - if (! error_state) - { - octave_idx_type nel = nda.numel (); - - value.resize (nel); - - for (octave_idx_type i = 0; i < nel; i++) - { - std::ostringstream buf; - buf << nda(i); - value[i] = buf.str (); - } - - stored_type = char_t; - } - else - { - error ("set: invalid string property value for \"%s\"", - get_name ().c_str ()); - - return false; - } - } - - return true; - } - -private: - string_vector value; - type stored_type; -}; - -// --------------------------------------------------------------------- - -class radio_values -{ -public: - OCTINTERP_API radio_values (const std::string& opt_string = std::string ()); - - radio_values (const radio_values& a) - : default_val (a.default_val), possible_vals (a.possible_vals) { } - - radio_values& operator = (const radio_values& a) - { - if (&a != this) - { - default_val = a.default_val; - possible_vals = a.possible_vals; - } - - return *this; - } - - std::string default_value (void) const { return default_val; } - - bool validate (const std::string& val, std::string& match) - { - bool retval = true; - - if (! contains (val, match)) - { - error ("invalid value = %s", val.c_str ()); - retval = false; - } - - return retval; - } - - bool contains (const std::string& val, std::string& match) - { - size_t k = 0; - - size_t len = val.length (); - - std::string first_match; - - for (std::set::const_iterator p = possible_vals.begin (); - p != possible_vals.end (); p++) - { - if (p->compare (val, len)) - { - if (len == p->length ()) - { - // We found a full match (consider the case of val == - // "replace" with possible values "replace" and - // "replacechildren"). Any other matches are - // irrelevant, so set match and return now. - - match = *p; - return true; - } - else - { - if (k == 0) - first_match = *p; - - k++; - } - } - } - - if (k == 1) - { - match = first_match; - return true; - } - else - return false; - } - - std::string values_as_string (void) const; - - Cell values_as_cell (void) const; - - octave_idx_type nelem (void) const { return possible_vals.size (); } - -private: - // Might also want to cache - std::string default_val; - std::set possible_vals; -}; - -class radio_property : public base_property -{ -public: - radio_property (const std::string& nm, const graphics_handle& h, - const radio_values& v = radio_values ()) - : base_property (nm, h), - vals (v), current_val (v.default_value ()) { } - - radio_property (const std::string& nm, const graphics_handle& h, - const std::string& v) - : base_property (nm, h), - vals (v), current_val (vals.default_value ()) { } - - radio_property (const std::string& nm, const graphics_handle& h, - const radio_values& v, const std::string& def) - : base_property (nm, h), - vals (v), current_val (def) { } - - radio_property (const radio_property& p) - : base_property (p), vals (p.vals), current_val (p.current_val) { } - - octave_value get (void) const { return octave_value (current_val); } - - const std::string& current_value (void) const { return current_val; } - - std::string values_as_string (void) const { return vals.values_as_string (); } - - Cell values_as_cell (void) const { return vals.values_as_cell (); } - - bool is (const caseless_str& v) const - { return v.compare (current_val); } - - bool is_radio (void) const { return true; } - - radio_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new radio_property (*this); } - -protected: - bool do_set (const octave_value& newval) - { - if (newval.is_string ()) - { - std::string s = newval.string_value (); - - std::string match; - - if (vals.validate (s, match)) - { - if (match != current_val) - { - if (s.length () != match.length ()) - warning_with_id ("Octave:abbreviated-property-match", - "%s: allowing %s to match %s value %s", - "set", s.c_str (), get_name ().c_str (), - match.c_str ()); - current_val = match; - return true; - } - } - else - error ("set: invalid value for radio property \"%s\" (value = %s)", - get_name ().c_str (), s.c_str ()); - } - else - error ("set: invalid value for radio property \"%s\"", - get_name ().c_str ()); - return false; - } - -private: - radio_values vals; - std::string current_val; -}; - -// --------------------------------------------------------------------- - -class color_values -{ -public: - color_values (double r = 0, double g = 0, double b = 1) - : xrgb (1, 3) - { - xrgb(0) = r; - xrgb(1) = g; - xrgb(2) = b; - - validate (); - } - - color_values (std::string str) - : xrgb (1, 3) - { - if (! str2rgb (str)) - error ("invalid color specification: %s", str.c_str ()); - } - - color_values (const color_values& c) - : xrgb (c.xrgb) - { } - - color_values& operator = (const color_values& c) - { - if (&c != this) - xrgb = c.xrgb; - - return *this; - } - - bool operator == (const color_values& c) const - { - return (xrgb(0) == c.xrgb(0) - && xrgb(1) == c.xrgb(1) - && xrgb(2) == c.xrgb(2)); - } - - bool operator != (const color_values& c) const - { return ! (*this == c); } - - Matrix rgb (void) const { return xrgb; } - - operator octave_value (void) const { return xrgb; } - - void validate (void) const - { - for (int i = 0; i < 3; i++) - { - if (xrgb(i) < 0 || xrgb(i) > 1) - { - error ("invalid RGB color specification"); - break; - } - } - } - -private: - Matrix xrgb; - - OCTINTERP_API bool str2rgb (std::string str); -}; - -class color_property : public base_property -{ -public: - color_property (const color_values& c, const radio_values& v) - : base_property ("", graphics_handle ()), - current_type (color_t), color_val (c), radio_val (v), - current_val (v.default_value ()) - { } - - color_property (const std::string& nm, const graphics_handle& h, - const color_values& c = color_values (), - const radio_values& v = radio_values ()) - : base_property (nm, h), - current_type (color_t), color_val (c), radio_val (v), - current_val (v.default_value ()) - { } - - color_property (const std::string& nm, const graphics_handle& h, - const radio_values& v) - : base_property (nm, h), - current_type (radio_t), color_val (color_values ()), radio_val (v), - current_val (v.default_value ()) - { } - - color_property (const std::string& nm, const graphics_handle& h, - const std::string& v) - : base_property (nm, h), - current_type (radio_t), color_val (color_values ()), radio_val (v), - current_val (radio_val.default_value ()) - { } - - color_property (const std::string& nm, const graphics_handle& h, - const color_property& v) - : base_property (nm, h), - current_type (v.current_type), color_val (v.color_val), - radio_val (v.radio_val), current_val (v.current_val) - { } - - color_property (const color_property& p) - : base_property (p), current_type (p.current_type), - color_val (p.color_val), radio_val (p.radio_val), - current_val (p.current_val) { } - - octave_value get (void) const - { - if (current_type == color_t) - return color_val.rgb (); - - return current_val; - } - - bool is_rgb (void) const { return (current_type == color_t); } - - bool is_radio (void) const { return (current_type == radio_t); } - - bool is (const std::string& v) const - { return (is_radio () && current_val == v); } - - Matrix rgb (void) const - { - if (current_type != color_t) - error ("color has no rgb value"); - - return color_val.rgb (); - } - - const std::string& current_value (void) const - { - if (current_type != radio_t) - error ("color has no radio value"); - - return current_val; - } - - color_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - operator octave_value (void) const { return get (); } - - base_property* clone (void) const { return new color_property (*this); } - - std::string values_as_string (void) const { return radio_val.values_as_string (); } - - Cell values_as_cell (void) const { return radio_val.values_as_cell (); } - -protected: - OCTINTERP_API bool do_set (const octave_value& newval); - -private: - enum current_enum { color_t, radio_t } current_type; - color_values color_val; - radio_values radio_val; - std::string current_val; -}; - -// --------------------------------------------------------------------- - -class double_property : public base_property -{ -public: - double_property (const std::string& nm, const graphics_handle& h, - double d = 0) - : base_property (nm, h), - current_val (d) { } - - double_property (const double_property& p) - : base_property (p), current_val (p.current_val) { } - - octave_value get (void) const { return octave_value (current_val); } - - double double_value (void) const { return current_val; } - - double_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new double_property (*this); } - -protected: - bool do_set (const octave_value& v) - { - if (v.is_scalar_type () && v.is_real_type ()) - { - double new_val = v.double_value (); - - if (new_val != current_val) - { - current_val = new_val; - return true; - } - } - else - error ("set: invalid value for double property \"%s\"", - get_name ().c_str ()); - return false; - } - -private: - double current_val; -}; - -// --------------------------------------------------------------------- - -class double_radio_property : public base_property -{ -public: - double_radio_property (double d, const radio_values& v) - : base_property ("", graphics_handle ()), - current_type (double_t), dval (d), radio_val (v), - current_val (v.default_value ()) - { } - - double_radio_property (const std::string& nm, const graphics_handle& h, - const std::string& v) - : base_property (nm, h), - current_type (radio_t), dval (0), radio_val (v), - current_val (radio_val.default_value ()) - { } - - double_radio_property (const std::string& nm, const graphics_handle& h, - const double_radio_property& v) - : base_property (nm, h), - current_type (v.current_type), dval (v.dval), - radio_val (v.radio_val), current_val (v.current_val) - { } - - double_radio_property (const double_radio_property& p) - : base_property (p), current_type (p.current_type), - dval (p.dval), radio_val (p.radio_val), - current_val (p.current_val) { } - - octave_value get (void) const - { - if (current_type == double_t) - return dval; - - return current_val; - } - - bool is_double (void) const { return (current_type == double_t); } - - bool is_radio (void) const { return (current_type == radio_t); } - - bool is (const std::string& v) const - { return (is_radio () && current_val == v); } - - double double_value (void) const - { - if (current_type != double_t) - error ("%s: property has no double", get_name ().c_str ()); - - return dval; - } - - const std::string& current_value (void) const - { - if (current_type != radio_t) - error ("%s: property has no radio value"); - - return current_val; - } - - double_radio_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - operator octave_value (void) const { return get (); } - - base_property* clone (void) const - { return new double_radio_property (*this); } - -protected: - OCTINTERP_API bool do_set (const octave_value& v); - -private: - enum current_enum { double_t, radio_t } current_type; - double dval; - radio_values radio_val; - std::string current_val; -}; - -// --------------------------------------------------------------------- - -class array_property : public base_property -{ -public: - array_property (void) - : base_property ("", graphics_handle ()), data (Matrix ()), - xmin (), xmax (), xminp (), xmaxp (), - type_constraints (), size_constraints () - { - get_data_limits (); - } - - array_property (const std::string& nm, const graphics_handle& h, - const octave_value& m) - : base_property (nm, h), data (m.is_sparse_type () ? m.full_value () : m), - xmin (), xmax (), xminp (), xmaxp (), - type_constraints (), size_constraints () - { - get_data_limits (); - } - - // This copy constructor is only intended to be used - // internally to access min/max values; no need to - // copy constraints. - array_property (const array_property& p) - : base_property (p), data (p.data), - xmin (p.xmin), xmax (p.xmax), xminp (p.xminp), xmaxp (p.xmaxp), - type_constraints (), size_constraints () - { } - - octave_value get (void) const { return data; } - - void add_constraint (const std::string& type) - { type_constraints.insert (type); } - - void add_constraint (const dim_vector& dims) - { size_constraints.push_back (dims); } - - double min_val (void) const { return xmin; } - double max_val (void) const { return xmax; } - double min_pos (void) const { return xminp; } - double max_neg (void) const { return xmaxp; } - - Matrix get_limits (void) const - { - Matrix m (1, 4); - - m(0) = min_val (); - m(1) = max_val (); - m(2) = min_pos (); - m(3) = max_neg (); - - return m; - } - - array_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const - { - array_property *p = new array_property (*this); - - p->type_constraints = type_constraints; - p->size_constraints = size_constraints; - - return p; - } - -protected: - bool do_set (const octave_value& v) - { - octave_value tmp = v.is_sparse_type () ? v.full_value () : v; - - if (validate (tmp)) - { - // FIXME -- should we check for actual data change? - if (! is_equal (tmp)) - { - data = tmp; - - get_data_limits (); - - return true; - } - } - else - error ("invalid value for array property \"%s\"", - get_name ().c_str ()); - - return false; - } - -private: - OCTINTERP_API bool validate (const octave_value& v); - - OCTINTERP_API bool is_equal (const octave_value& v) const; - - OCTINTERP_API void get_data_limits (void); - -protected: - octave_value data; - double xmin; - double xmax; - double xminp; - double xmaxp; - std::set type_constraints; - std::list size_constraints; -}; - -class row_vector_property : public array_property -{ -public: - row_vector_property (const std::string& nm, const graphics_handle& h, - const octave_value& m) - : array_property (nm, h, m) - { - add_constraint (dim_vector (-1, 1)); - add_constraint (dim_vector (1, -1)); - } - - row_vector_property (const row_vector_property& p) - : array_property (p) - { - add_constraint (dim_vector (-1, 1)); - add_constraint (dim_vector (1, -1)); - } - - void add_constraint (const std::string& type) - { - array_property::add_constraint (type); - } - - void add_constraint (const dim_vector& dims) - { - array_property::add_constraint (dims); - } - - void add_constraint (octave_idx_type len) - { - size_constraints.remove (dim_vector (1, -1)); - size_constraints.remove (dim_vector (-1, 1)); - - add_constraint (dim_vector (1, len)); - add_constraint (dim_vector (len, 1)); - } - - row_vector_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const - { - row_vector_property *p = new row_vector_property (*this); - - p->type_constraints = type_constraints; - p->size_constraints = size_constraints; - - return p; - } - -protected: - bool do_set (const octave_value& v) - { - bool retval = array_property::do_set (v); - - if (! error_state) - { - dim_vector dv = data.dims (); - - if (dv(0) > 1 && dv(1) == 1) - { - int tmp = dv(0); - dv(0) = dv(1); - dv(1) = tmp; - - data = data.reshape (dv); - } - - return retval; - } - - return false; - } - -private: - OCTINTERP_API bool validate (const octave_value& v); -}; - -// --------------------------------------------------------------------- - -class bool_property : public radio_property -{ -public: - bool_property (const std::string& nm, const graphics_handle& h, - bool val) - : radio_property (nm, h, radio_values (val ? "{on}|off" : "on|{off}")) - { } - - bool_property (const std::string& nm, const graphics_handle& h, - const char* val) - : radio_property (nm, h, radio_values ("on|off"), val) - { } - - bool_property (const bool_property& p) - : radio_property (p) { } - - bool is_on (void) const { return is ("on"); } - - bool_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new bool_property (*this); } - -protected: - bool do_set (const octave_value& val) - { - if (val.is_bool_scalar ()) - return radio_property::do_set (val.bool_value () ? "on" : "off"); - else - return radio_property::do_set (val); - } -}; - -// --------------------------------------------------------------------- - -class handle_property : public base_property -{ -public: - handle_property (const std::string& nm, const graphics_handle& h, - const graphics_handle& val = graphics_handle ()) - : base_property (nm, h), - current_val (val) { } - - handle_property (const handle_property& p) - : base_property (p), current_val (p.current_val) { } - - octave_value get (void) const { return current_val.as_octave_value (); } - - graphics_handle handle_value (void) const { return current_val; } - - handle_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - handle_property& operator = (const graphics_handle& h) - { - set (octave_value (h.value ())); - return *this; - } - - base_property* clone (void) const { return new handle_property (*this); } - -protected: - OCTINTERP_API bool do_set (const octave_value& v); - -private: - graphics_handle current_val; -}; - -// --------------------------------------------------------------------- - -class any_property : public base_property -{ -public: - any_property (const std::string& nm, const graphics_handle& h, - const octave_value& m = Matrix ()) - : base_property (nm, h), data (m) { } - - any_property (const any_property& p) - : base_property (p), data (p.data) { } - - octave_value get (void) const { return data; } - - any_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new any_property (*this); } - -protected: - bool do_set (const octave_value& v) - { - data = v; - return true; - } - -private: - octave_value data; -}; - -// --------------------------------------------------------------------- - -class children_property : public base_property -{ -public: - children_property (void) - : base_property ("", graphics_handle ()), children_list () - { - do_init_children (Matrix ()); - } - - children_property (const std::string& nm, const graphics_handle& h, - const Matrix &val) - : base_property (nm, h), children_list () - { - do_init_children (val); - } - - children_property (const children_property& p) - : base_property (p), children_list () - { - do_init_children (p.children_list); - } - - children_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new children_property (*this); } - - bool remove_child (const double &val) - { - return do_remove_child (val); - } - - void adopt (const double &val) - { - do_adopt_child (val); - } - - Matrix get_children (void) const - { - return do_get_children (false); - } - - Matrix get_hidden (void) const - { - return do_get_children (true); - } - - Matrix get_all (void) const - { - return do_get_all_children (); - } - - octave_value get (void) const - { - return octave_value (get_children ()); - } - - void delete_children (bool clear = false) - { - do_delete_children (clear); - } - - void renumber (graphics_handle old_gh, graphics_handle new_gh) - { - for (children_list_iterator p = children_list.begin (); - p != children_list.end (); p++) - { - if (*p == old_gh) - { - *p = new_gh.value (); - return; - } - } - - error ("children_list::renumber: child not found!"); - } - -private: - typedef std::list::iterator children_list_iterator; - typedef std::list::const_iterator const_children_list_iterator; - std::list children_list; - -protected: - bool do_set (const octave_value& val) - { - const Matrix new_kids = val.matrix_value (); - - octave_idx_type nel = new_kids.numel (); - - const Matrix new_kids_column = new_kids.reshape (dim_vector (nel, 1)); - - bool is_ok = true; - - if (! error_state) - { - const Matrix visible_kids = do_get_children (false); - - if (visible_kids.numel () == new_kids.numel ()) - { - Matrix t1 = visible_kids.sort (); - Matrix t2 = new_kids_column.sort (); - - if (t1 != t2) - is_ok = false; - } - else - is_ok = false; - - if (! is_ok) - error ("set: new children must be a permutation of existing children"); - } - else - { - is_ok = false; - error ("set: expecting children to be array of graphics handles"); - } - - if (is_ok) - { - Matrix tmp = new_kids_column.stack (get_hidden ()); - - children_list.clear (); - - // Don't use do_init_children here, as that reverses the - // order of the list, and we don't want to do that if setting - // the child list directly. - - for (octave_idx_type i = 0; i < tmp.numel (); i++) - children_list.push_back (tmp.xelem (i)); - } - - return is_ok; - } - -private: - void do_init_children (const Matrix &val) - { - children_list.clear (); - for (octave_idx_type i = 0; i < val.numel (); i++) - children_list.push_front (val.xelem (i)); - } - - void do_init_children (const std::list &val) - { - children_list.clear (); - for (const_children_list_iterator p = val.begin (); p != val.end (); p++) - children_list.push_front (*p); - } - - Matrix do_get_children (bool return_hidden) const; - - Matrix do_get_all_children (void) const - { - Matrix retval (children_list.size (), 1); - octave_idx_type i = 0; - - for (const_children_list_iterator p = children_list.begin (); - p != children_list.end (); p++) - retval(i++) = *p; - return retval; - } - - bool do_remove_child (double child) - { - for (children_list_iterator p = children_list.begin (); - p != children_list.end (); p++) - { - if (*p == child) - { - children_list.erase (p); - return true; - } - } - return false; - } - - void do_adopt_child (const double &val) - { - children_list.push_front (val); - } - - void do_delete_children (bool clear); -}; - - - -// --------------------------------------------------------------------- - -class callback_property : public base_property -{ -public: - callback_property (const std::string& nm, const graphics_handle& h, - const octave_value& m) - : base_property (nm, h), callback (m), executing (false) { } - - callback_property (const callback_property& p) - : base_property (p), callback (p.callback), executing (false) { } - - octave_value get (void) const { return callback; } - - OCTINTERP_API void execute (const octave_value& data = octave_value ()) const; - - bool is_defined (void) const - { - return (callback.is_defined () && ! callback.is_empty ()); - } - - callback_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new callback_property (*this); } - -protected: - bool do_set (const octave_value& v) - { - if (validate (v)) - { - callback = v; - return true; - } - else - error ("invalid value for callback property \"%s\"", - get_name ().c_str ()); - return false; - } - -private: - OCTINTERP_API bool validate (const octave_value& v) const; - -private: - octave_value callback; - - // If TRUE, we are executing this callback. - mutable bool executing; -}; - -// --------------------------------------------------------------------- - -class property -{ -public: - property (void) : rep (new base_property ("", graphics_handle ())) - { } - - property (base_property *bp, bool persist = false) : rep (bp) - { if (persist) rep->count++; } - - property (const property& p) : rep (p.rep) - { - rep->count++; - } - - ~property (void) - { - if (--rep->count == 0) - delete rep; - } - - bool ok (void) const - { return rep->ok (); } - - std::string get_name (void) const - { return rep->get_name (); } - - void set_name (const std::string& name) - { rep->set_name (name); } - - graphics_handle get_parent (void) const - { return rep->get_parent (); } - - void set_parent (const graphics_handle& h) - { rep->set_parent (h); } - - bool is_hidden (void) const - { return rep->is_hidden (); } - - void set_hidden (bool flag) - { rep->set_hidden (flag); } - - bool is_radio (void) const - { return rep->is_radio (); } - - int get_id (void) const - { return rep->get_id (); } - - void set_id (int d) - { rep->set_id (d); } - - octave_value get (void) const - { return rep->get (); } - - bool set (const octave_value& val, bool do_run = true, - bool do_notify_toolkit = true) - { return rep->set (val, do_run, do_notify_toolkit); } - - std::string values_as_string (void) const - { return rep->values_as_string (); } - - Cell values_as_cell (void) const - { return rep->values_as_cell (); } - - property& operator = (const octave_value& val) - { - *rep = val; - return *this; - } - - property& operator = (const property& p) - { - if (rep && --rep->count == 0) - delete rep; - - rep = p.rep; - rep->count++; - - return *this; - } - - void add_listener (const octave_value& v, listener_mode mode = POSTSET) - { rep->add_listener (v, mode); } - - void delete_listener (const octave_value& v = octave_value (), - listener_mode mode = POSTSET) - { rep->delete_listener (v, mode); } - - void run_listeners (listener_mode mode = POSTSET) - { rep->run_listeners (mode); } - - OCTINTERP_API static - property create (const std::string& name, const graphics_handle& parent, - const caseless_str& type, - const octave_value_list& args); - - property clone (void) const - { return property (rep->clone ()); } - - /* - const string_property& as_string_property (void) const - { return *(dynamic_cast (rep)); } - - const radio_property& as_radio_property (void) const - { return *(dynamic_cast (rep)); } - - const color_property& as_color_property (void) const - { return *(dynamic_cast (rep)); } - - const double_property& as_double_property (void) const - { return *(dynamic_cast (rep)); } - - const bool_property& as_bool_property (void) const - { return *(dynamic_cast (rep)); } - - const handle_property& as_handle_property (void) const - { return *(dynamic_cast (rep)); } - */ - -private: - base_property *rep; -}; - -// --------------------------------------------------------------------- - -class property_list -{ -public: - typedef std::map pval_map_type; - typedef std::map plist_map_type; - - typedef pval_map_type::iterator pval_map_iterator; - typedef pval_map_type::const_iterator pval_map_const_iterator; - - typedef plist_map_type::iterator plist_map_iterator; - typedef plist_map_type::const_iterator plist_map_const_iterator; - - property_list (const plist_map_type& m = plist_map_type ()) - : plist_map (m) { } - - ~property_list (void) { } - - void set (const caseless_str& name, const octave_value& val); - - octave_value lookup (const caseless_str& name) const; - - plist_map_iterator begin (void) { return plist_map.begin (); } - plist_map_const_iterator begin (void) const { return plist_map.begin (); } - - plist_map_iterator end (void) { return plist_map.end (); } - plist_map_const_iterator end (void) const { return plist_map.end (); } - - plist_map_iterator find (const std::string& go_name) - { - return plist_map.find (go_name); - } - - plist_map_const_iterator find (const std::string& go_name) const - { - return plist_map.find (go_name); - } - - octave_scalar_map as_struct (const std::string& prefix_arg) const; - -private: - plist_map_type plist_map; -}; - -// --------------------------------------------------------------------- - -class graphics_toolkit; -class graphics_object; - -class base_graphics_toolkit -{ -public: - friend class graphics_toolkit; - -public: - base_graphics_toolkit (const std::string& nm) - : name (nm), count (0) { } - - virtual ~base_graphics_toolkit (void) { } - - std::string get_name (void) const { return name; } - - virtual bool is_valid (void) const { return false; } - - virtual void redraw_figure (const graphics_object&) const - { gripe_invalid ("redraw_figure"); } - - virtual void print_figure (const graphics_object&, const std::string&, - const std::string&, bool, - const std::string& = "") const - { gripe_invalid ("print_figure"); } - - virtual Matrix get_canvas_size (const graphics_handle&) const - { - gripe_invalid ("get_canvas_size"); - return Matrix (1, 2, 0.0); - } - - virtual double get_screen_resolution (void) const - { - gripe_invalid ("get_screen_resolution"); - return 72.0; - } - - virtual Matrix get_screen_size (void) const - { - gripe_invalid ("get_screen_size"); - return Matrix (1, 2, 0.0); - } - - // Callback function executed when the given graphics object - // changes. This allows the graphics toolkit to act on property - // changes if needed. - virtual void update (const graphics_object&, int) - { gripe_invalid ("base_graphics_toolkit::update"); } - - void update (const graphics_handle&, int); - - // Callback function executed when the given graphics object is - // created. This allows the graphics toolkit to do toolkit-specific - // initializations for a newly created object. - virtual bool initialize (const graphics_object&) - { gripe_invalid ("base_graphics_toolkit::initialize"); return false; } - - bool initialize (const graphics_handle&); - - // Callback function executed just prior to deleting the given - // graphics object. This allows the graphics toolkit to perform - // toolkit-specific cleanup operations before an object is deleted. - virtual void finalize (const graphics_object&) - { gripe_invalid ("base_graphics_toolkit::finalize"); } - - void finalize (const graphics_handle&); - - // Close the graphics toolkit. - virtual void close (void) - { gripe_invalid ("base_graphics_toolkit::close"); } - -private: - std::string name; - octave_refcount count; - -private: - void gripe_invalid (const std::string& fname) const - { - if (! is_valid ()) - error ("%s: invalid graphics toolkit", fname.c_str ()); - } -}; - -class graphics_toolkit -{ -public: - graphics_toolkit (void) - : rep (new base_graphics_toolkit ("unknown")) - { - rep->count++; - } - - graphics_toolkit (base_graphics_toolkit* b) - : rep (b) - { - rep->count++; - } - - graphics_toolkit (const graphics_toolkit& b) - : rep (b.rep) - { - rep->count++; - } - - ~graphics_toolkit (void) - { - if (--rep->count == 0) - delete rep; - } - - graphics_toolkit& operator = (const graphics_toolkit& b) - { - if (rep != b.rep) - { - if (--rep->count == 0) - delete rep; - - rep = b.rep; - rep->count++; - } - - return *this; - } - - operator bool (void) const { return rep->is_valid (); } - - std::string get_name (void) const { return rep->get_name (); } - - void redraw_figure (const graphics_object& go) const - { rep->redraw_figure (go); } - - void print_figure (const graphics_object& go, const std::string& term, - const std::string& file, bool mono, - const std::string& debug_file = "") const - { rep->print_figure (go, term, file, mono, debug_file); } - - Matrix get_canvas_size (const graphics_handle& fh) const - { return rep->get_canvas_size (fh); } - - double get_screen_resolution (void) const - { return rep->get_screen_resolution (); } - - Matrix get_screen_size (void) const - { return rep->get_screen_size (); } - - // Notifies graphics toolkit that object't property has changed. - void update (const graphics_object& go, int id) - { rep->update (go, id); } - - void update (const graphics_handle& h, int id) - { rep->update (h, id); } - - // Notifies graphics toolkit that new object was created. - bool initialize (const graphics_object& go) - { return rep->initialize (go); } - - bool initialize (const graphics_handle& h) - { return rep->initialize (h); } - - // Notifies graphics toolkit that object was destroyed. - // This is called only for explicitly deleted object. Children are - // deleted implicitly and graphics toolkit isn't notified. - void finalize (const graphics_object& go) - { rep->finalize (go); } - - void finalize (const graphics_handle& h) - { rep->finalize (h); } - - // Close the graphics toolkit. - void close (void) { rep->close (); } - -private: - - base_graphics_toolkit *rep; -}; - -class gtk_manager -{ -public: - - static graphics_toolkit get_toolkit (void) - { - return instance_ok () ? instance->do_get_toolkit () : graphics_toolkit (); - } - - static void register_toolkit (const std::string& name) - { - if (instance_ok ()) - instance->do_register_toolkit (name); - } - - static void unregister_toolkit (const std::string& name) - { - if (instance_ok ()) - instance->do_unregister_toolkit (name); - } - - static void load_toolkit (const graphics_toolkit& tk) - { - if (instance_ok ()) - instance->do_load_toolkit (tk); - } - - static void unload_toolkit (const std::string& name) - { - if (instance_ok ()) - instance->do_unload_toolkit (name); - } - - static graphics_toolkit find_toolkit (const std::string& name) - { - return instance_ok () - ? instance->do_find_toolkit (name) : graphics_toolkit (); - } - - static Cell available_toolkits_list (void) - { - return instance_ok () ? instance->do_available_toolkits_list () : Cell (); - } - - static Cell loaded_toolkits_list (void) - { - return instance_ok () ? instance->do_loaded_toolkits_list () : Cell (); - } - - static void unload_all_toolkits (void) - { - if (instance_ok ()) - instance->do_unload_all_toolkits (); - } - - static std::string default_toolkit (void) - { - return instance_ok () ? instance->do_default_toolkit () : std::string (); - } - -private: - - // FIXME -- default toolkit should be configurable. - - gtk_manager (void) - : dtk ("gnuplot"), available_toolkits (), loaded_toolkits () { } - - ~gtk_manager (void) { } - - OCTINTERP_API static void create_instance (void); - - static bool instance_ok (void) - { - bool retval = true; - - if (! instance) - create_instance (); - - if (! instance) - { - ::error ("unable to create gh_manager!"); - - retval = false; - } - - return retval; - } - - static void cleanup_instance (void) { delete instance; instance = 0; } - - OCTINTERP_API static gtk_manager *instance; - - // The name of the default toolkit. - std::string dtk; - - // The list of toolkits that we know about. - std::set available_toolkits; - - // The list of toolkits we have actually loaded. - std::map loaded_toolkits; - - typedef std::set::iterator available_toolkits_iterator; - - typedef std::set::const_iterator - const_available_toolkits_iterator; - - typedef std::map::iterator - loaded_toolkits_iterator; - - typedef std::map::const_iterator - const_loaded_toolkits_iterator; - - graphics_toolkit do_get_toolkit (void) const; - - void do_register_toolkit (const std::string& name) - { - available_toolkits.insert (name); - } - - void do_unregister_toolkit (const std::string& name) - { - available_toolkits.erase (name); - } - - void do_load_toolkit (const graphics_toolkit& tk) - { - loaded_toolkits[tk.get_name ()] = tk; - } - - void do_unload_toolkit (const std::string& name) - { - loaded_toolkits.erase (name); - } - - graphics_toolkit do_find_toolkit (const std::string& name) const - { - const_loaded_toolkits_iterator p = loaded_toolkits.find (name); - - if (p != loaded_toolkits.end ()) - return p->second; - else - return graphics_toolkit (); - } - - Cell do_available_toolkits_list (void) const - { - Cell m (1 , available_toolkits.size ()); - - octave_idx_type i = 0; - for (const_available_toolkits_iterator p = available_toolkits.begin (); - p != available_toolkits.end (); p++) - m(i++) = *p; - - return m; - } - - Cell do_loaded_toolkits_list (void) const - { - Cell m (1 , loaded_toolkits.size ()); - - octave_idx_type i = 0; - for (const_loaded_toolkits_iterator p = loaded_toolkits.begin (); - p != loaded_toolkits.end (); p++) - m(i++) = p->first; - - return m; - } - - void do_unload_all_toolkits (void) - { - while (! loaded_toolkits.empty ()) - { - loaded_toolkits_iterator p = loaded_toolkits.begin (); - - std::string name = p->first; - - p->second.close (); - - // The toolkit may have unloaded itself. If not, we'll do - // it here. - if (loaded_toolkits.find (name) != loaded_toolkits.end ()) - unload_toolkit (name); - } - } - - std::string do_default_toolkit (void) { return dtk; } -}; - -// --------------------------------------------------------------------- - -class base_graphics_object; -class graphics_object; - -class OCTINTERP_API base_properties -{ -public: - base_properties (const std::string& ty = "unknown", - const graphics_handle& mh = graphics_handle (), - const graphics_handle& p = graphics_handle ()); - - virtual ~base_properties (void) { } - - virtual std::string graphics_object_name (void) const { return "unknonwn"; } - - void mark_modified (void); - - void override_defaults (base_graphics_object& obj); - - virtual void init_integerhandle (const octave_value&) - { - panic_impossible (); - } - - // Look through DEFAULTS for properties with given CLASS_NAME, and - // apply them to the current object with set (virtual method). - - void set_from_list (base_graphics_object& obj, property_list& defaults); - - void insert_property (const std::string& name, property p) - { - p.set_name (name); - p.set_parent (__myhandle__); - all_props[name] = p; - } - - virtual void set (const caseless_str&, const octave_value&); - - virtual octave_value get (const caseless_str& pname) const; - - virtual octave_value get (const std::string& pname) const - { - return get (caseless_str (pname)); - } - - virtual octave_value get (const char *pname) const - { - return get (caseless_str (pname)); - } - - virtual octave_value get (bool all = false) const; - - virtual property get_property (const caseless_str& pname); - - virtual bool has_property (const caseless_str&) const - { - panic_impossible (); - return false; - } - - bool is_modified (void) const { return is___modified__ (); } - - virtual void remove_child (const graphics_handle& h) - { - if (children.remove_child (h.value ())) - mark_modified (); - } - - virtual void adopt (const graphics_handle& h) - { - children.adopt (h.value ()); - mark_modified (); - } - - virtual graphics_toolkit get_toolkit (void) const; - - virtual Matrix get_boundingbox (bool /*internal*/ = false, - const Matrix& /*parent_pix_size*/ = Matrix ()) const - { return Matrix (1, 4, 0.0); } - - virtual void update_boundingbox (void); - - virtual void update_autopos (const std::string& elem_type); - - virtual void add_listener (const caseless_str&, const octave_value&, - listener_mode = POSTSET); - - virtual void delete_listener (const caseless_str&, const octave_value&, - listener_mode = POSTSET); - - void set_tag (const octave_value& val) { tag = val; } - - void set_parent (const octave_value& val); - - Matrix get_children (void) const - { - return children.get_children (); - } - - Matrix get_all_children (void) const - { - return children.get_all (); - } - - Matrix get_hidden_children (void) const - { - return children.get_hidden (); - } - - void set_modified (const octave_value& val) { set___modified__ (val); } - - void set___modified__ (const octave_value& val) { __modified__ = val; } - - void reparent (const graphics_handle& new_parent) { parent = new_parent; } - - // Update data limits for AXIS_TYPE (xdata, ydata, etc.) in the parent - // axes object. - - virtual void update_axis_limits (const std::string& axis_type) const; - - virtual void update_axis_limits (const std::string& axis_type, - const graphics_handle& h) const; - - virtual void delete_children (bool clear = false) - { - children.delete_children (clear); - } - - void renumber_child (graphics_handle old_gh, graphics_handle new_gh) - { - children.renumber (old_gh, new_gh); - } - - void renumber_parent (graphics_handle new_gh) - { - parent = new_gh; - } - - static property_list::pval_map_type factory_defaults (void); - - // FIXME -- these functions should be generated automatically by the - // genprops.awk script. - // - // EMIT_BASE_PROPERTIES_GET_FUNCTIONS - - virtual octave_value get_xlim (void) const { return octave_value (); } - virtual octave_value get_ylim (void) const { return octave_value (); } - virtual octave_value get_zlim (void) const { return octave_value (); } - virtual octave_value get_clim (void) const { return octave_value (); } - virtual octave_value get_alim (void) const { return octave_value (); } - - virtual bool is_xliminclude (void) const { return false; } - virtual bool is_yliminclude (void) const { return false; } - virtual bool is_zliminclude (void) const { return false; } - virtual bool is_climinclude (void) const { return false; } - virtual bool is_aliminclude (void) const { return false; } - - bool is_handle_visible (void) const; - - std::set dynamic_property_names (void) const; - - bool has_dynamic_property (const std::string& pname); - -protected: - std::set dynamic_properties; - - void set_dynamic (const caseless_str& pname, const octave_value& val); - - octave_value get_dynamic (const caseless_str& pname) const; - - octave_value get_dynamic (bool all = false) const; - - property get_property_dynamic (const caseless_str& pname); - - BEGIN_BASE_PROPERTIES - // properties common to all objects - bool_property beingdeleted , "off" - radio_property busyaction , "{queue}|cancel" - callback_property buttondownfcn , Matrix () - children_property children gf , Matrix () - bool_property clipping , "on" - callback_property createfcn , Matrix () - callback_property deletefcn , Matrix () - radio_property handlevisibility , "{on}|callback|off" - bool_property hittest , "on" - bool_property interruptible , "on" - handle_property parent fs , p - bool_property selected , "off" - bool_property selectionhighlight , "on" - string_property tag s , "" - string_property type frs , ty - any_property userdata , Matrix () - bool_property visible , "on" - // additional (octave-specific) properties - bool_property __modified__ s , "on" - graphics_handle __myhandle__ fhrs , mh - // FIXME -- should this really be here? - handle_property uicontextmenu , graphics_handle () - END_PROPERTIES - -protected: - struct cmp_caseless_str - { - bool operator () (const caseless_str &a, const caseless_str &b) const - { - std::string a1 = a; - std::transform (a1.begin (), a1.end (), a1.begin (), tolower); - std::string b1 = b; - std::transform (b1.begin (), b1.end (), b1.begin (), tolower); - - return a1 < b1; - } - }; - - std::map all_props; - -protected: - void insert_static_property (const std::string& name, base_property& p) - { insert_property (name, property (&p, true)); } - - virtual void init (void) { } -}; - -class OCTINTERP_API base_graphics_object -{ -public: - friend class graphics_object; - - base_graphics_object (void) : count (1), toolkit_flag (false) { } - - virtual ~base_graphics_object (void) { } - - virtual void mark_modified (void) - { - if (valid_object ()) - get_properties ().mark_modified (); - else - error ("base_graphics_object::mark_modified: invalid graphics object"); - } - - virtual void override_defaults (base_graphics_object& obj) - { - if (valid_object ()) - get_properties ().override_defaults (obj); - else - error ("base_graphics_object::override_defaults: invalid graphics object"); - } - - virtual void set_from_list (property_list& plist) - { - if (valid_object ()) - get_properties ().set_from_list (*this, plist); - else - error ("base_graphics_object::set_from_list: invalid graphics object"); - } - - virtual void set (const caseless_str& pname, const octave_value& pval) - { - if (valid_object ()) - get_properties ().set (pname, pval); - else - error ("base_graphics_object::set: invalid graphics object"); - } - - virtual void set_defaults (const std::string&) - { - error ("base_graphics_object::set_defaults: invalid graphics object"); - } - - virtual octave_value get (bool all = false) const - { - if (valid_object ()) - return get_properties ().get (all); - else - { - error ("base_graphics_object::get: invalid graphics object"); - return octave_value (); - } - } - - virtual octave_value get (const caseless_str& pname) const - { - if (valid_object ()) - return get_properties ().get (pname); - else - { - error ("base_graphics_object::get: invalid graphics object"); - return octave_value (); - } - } - - virtual octave_value get_default (const caseless_str&) const; - - virtual octave_value get_factory_default (const caseless_str&) const; - - virtual octave_value get_defaults (void) const - { - error ("base_graphics_object::get_defaults: invalid graphics object"); - return octave_value (); - } - - virtual octave_value get_factory_defaults (void) const - { - error ("base_graphics_object::get_factory_defaults: invalid graphics object"); - return octave_value (); - } - - virtual std::string values_as_string (void); - - virtual octave_scalar_map values_as_struct (void); - - virtual graphics_handle get_parent (void) const - { - if (valid_object ()) - return get_properties ().get_parent (); - else - { - error ("base_graphics_object::get_parent: invalid graphics object"); - return graphics_handle (); - } - } - - graphics_handle get_handle (void) const - { - if (valid_object ()) - return get_properties ().get___myhandle__ (); - else - { - error ("base_graphics_object::get_handle: invalid graphics object"); - return graphics_handle (); - } - } - - virtual void remove_child (const graphics_handle& h) - { - if (valid_object ()) - get_properties ().remove_child (h); - else - error ("base_graphics_object::remove_child: invalid graphics object"); - } - - virtual void adopt (const graphics_handle& h) - { - if (valid_object ()) - get_properties ().adopt (h); - else - error ("base_graphics_object::adopt: invalid graphics object"); - } - - virtual void reparent (const graphics_handle& np) - { - if (valid_object ()) - get_properties ().reparent (np); - else - error ("base_graphics_object::reparent: invalid graphics object"); - } - - virtual void defaults (void) const - { - if (valid_object ()) - { - std::string msg = (type () + "::defaults"); - gripe_not_implemented (msg.c_str ()); - } - else - error ("base_graphics_object::default: invalid graphics object"); - } - - virtual base_properties& get_properties (void) - { - static base_properties properties; - error ("base_graphics_object::get_properties: invalid graphics object"); - return properties; - } - - virtual const base_properties& get_properties (void) const - { - static base_properties properties; - error ("base_graphics_object::get_properties: invalid graphics object"); - return properties; - } - - virtual void update_axis_limits (const std::string& axis_type); - - virtual void update_axis_limits (const std::string& axis_type, - const graphics_handle& h); - - virtual bool valid_object (void) const { return false; } - - bool valid_toolkit_object (void) const { return toolkit_flag; } - - virtual std::string type (void) const - { - return (valid_object () ? get_properties ().graphics_object_name () - : "unknown"); - } - - bool isa (const std::string& go_name) const - { - return type () == go_name; - } - - virtual graphics_toolkit get_toolkit (void) const - { - if (valid_object ()) - return get_properties ().get_toolkit (); - else - { - error ("base_graphics_object::get_toolkit: invalid graphics object"); - return graphics_toolkit (); - } - } - - virtual void add_property_listener (const std::string& nm, - const octave_value& v, - listener_mode mode = POSTSET) - { - if (valid_object ()) - get_properties ().add_listener (nm, v, mode); - } - - virtual void delete_property_listener (const std::string& nm, - const octave_value& v, - listener_mode mode = POSTSET) - { - if (valid_object ()) - get_properties ().delete_listener (nm, v, mode); - } - - virtual void remove_all_listeners (void); - - virtual void reset_default_properties (void) - { - if (valid_object ()) - { - std::string msg = (type () + "::reset_default_properties"); - gripe_not_implemented (msg.c_str ()); - } - else - error ("base_graphics_object::default: invalid graphics object"); - } - -protected: - virtual void initialize (const graphics_object& go) - { - if (! toolkit_flag) - toolkit_flag = get_toolkit ().initialize (go); - } - - virtual void finalize (const graphics_object& go) - { - if (toolkit_flag) - { - get_toolkit ().finalize (go); - toolkit_flag = false; - } - } - - virtual void update (const graphics_object& go, int id) - { - if (toolkit_flag) - get_toolkit ().update (go, id); - } - -protected: - // A reference count. - octave_refcount count; - - // A flag telling whether this object is a valid object - // in the backend context. - bool toolkit_flag; - - // No copying! - - base_graphics_object (const base_graphics_object&) : count (0) { } - - base_graphics_object& operator = (const base_graphics_object&) - { - return *this; - } -}; - -class OCTINTERP_API graphics_object -{ -public: - graphics_object (void) : rep (new base_graphics_object ()) { } - - graphics_object (base_graphics_object *new_rep) - : rep (new_rep) { } - - graphics_object (const graphics_object& obj) : rep (obj.rep) - { - rep->count++; - } - - graphics_object& operator = (const graphics_object& obj) - { - if (rep != obj.rep) - { - if (--rep->count == 0) - delete rep; - - rep = obj.rep; - rep->count++; - } - - return *this; - } - - ~graphics_object (void) - { - if (--rep->count == 0) - delete rep; - } - - void mark_modified (void) { rep->mark_modified (); } - - void override_defaults (base_graphics_object& obj) - { - rep->override_defaults (obj); - } - - void set_from_list (property_list& plist) { rep->set_from_list (plist); } - - void set (const caseless_str& name, const octave_value& val) - { - rep->set (name, val); - } - - void set (const octave_value_list& args); - - void set (const Array& names, const Cell& values, - octave_idx_type row); - - void set (const octave_map& m); - - void set_value_or_default (const caseless_str& name, - const octave_value& val); - - void set_defaults (const std::string& mode) { rep->set_defaults (mode); } - - octave_value get (bool all = false) const { return rep->get (all); } - - octave_value get (const caseless_str& name) const - { - return name.compare ("default") - ? get_defaults () - : (name.compare ("factory") - ? get_factory_defaults () : rep->get (name)); - } - - octave_value get (const std::string& name) const - { - return get (caseless_str (name)); - } - - octave_value get (const char *name) const - { - return get (caseless_str (name)); - } - - octave_value get_default (const caseless_str& name) const - { - return rep->get_default (name); - } - - octave_value get_factory_default (const caseless_str& name) const - { - return rep->get_factory_default (name); - } - - octave_value get_defaults (void) const { return rep->get_defaults (); } - - octave_value get_factory_defaults (void) const - { - return rep->get_factory_defaults (); - } - - std::string values_as_string (void) { return rep->values_as_string (); } - - octave_map values_as_struct (void) { return rep->values_as_struct (); } - - graphics_handle get_parent (void) const { return rep->get_parent (); } - - graphics_handle get_handle (void) const { return rep->get_handle (); } - - graphics_object get_ancestor (const std::string& type) const; - - void remove_child (const graphics_handle& h) { rep->remove_child (h); } - - void adopt (const graphics_handle& h) { rep->adopt (h); } - - void reparent (const graphics_handle& h) { rep->reparent (h); } - - void defaults (void) const { rep->defaults (); } - - bool isa (const std::string& go_name) const { return rep->isa (go_name); } - - base_properties& get_properties (void) { return rep->get_properties (); } - - const base_properties& get_properties (void) const - { - return rep->get_properties (); - } - - void update_axis_limits (const std::string& axis_type) - { - rep->update_axis_limits (axis_type); - } - - void update_axis_limits (const std::string& axis_type, - const graphics_handle& h) - { - rep->update_axis_limits (axis_type, h); - } - - bool valid_object (void) const { return rep->valid_object (); } - - std::string type (void) const { return rep->type (); } - - operator bool (void) const { return rep->valid_object (); } - - // FIXME -- these functions should be generated automatically by the - // genprops.awk script. - // - // EMIT_GRAPHICS_OBJECT_GET_FUNCTIONS - - octave_value get_xlim (void) const - { return get_properties ().get_xlim (); } - - octave_value get_ylim (void) const - { return get_properties ().get_ylim (); } - - octave_value get_zlim (void) const - { return get_properties ().get_zlim (); } - - octave_value get_clim (void) const - { return get_properties ().get_clim (); } - - octave_value get_alim (void) const - { return get_properties ().get_alim (); } - - bool is_xliminclude (void) const - { return get_properties ().is_xliminclude (); } - - bool is_yliminclude (void) const - { return get_properties ().is_yliminclude (); } - - bool is_zliminclude (void) const - { return get_properties ().is_zliminclude (); } - - bool is_climinclude (void) const - { return get_properties ().is_climinclude (); } - - bool is_aliminclude (void) const - { return get_properties ().is_aliminclude (); } - - bool is_handle_visible (void) const - { return get_properties ().is_handle_visible (); } - - graphics_toolkit get_toolkit (void) const { return rep->get_toolkit (); } - - void add_property_listener (const std::string& nm, const octave_value& v, - listener_mode mode = POSTSET) - { rep->add_property_listener (nm, v, mode); } - - void delete_property_listener (const std::string& nm, const octave_value& v, - listener_mode mode = POSTSET) - { rep->delete_property_listener (nm, v, mode); } - - void initialize (void) { rep->initialize (*this); } - - void finalize (void) { rep->finalize (*this); } - - void update (int id) { rep->update (*this, id); } - - void reset_default_properties (void) - { rep->reset_default_properties (); } - -private: - base_graphics_object *rep; -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API root_figure : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - void remove_child (const graphics_handle& h); - - Matrix get_boundingbox (bool internal = false, - const Matrix& parent_pix_size = Matrix ()) const; - - // See the genprops.awk script for an explanation of the - // properties declarations. - - // FIXME -- it seems strange to me that the diary, diaryfile, - // echo, format, formatspacing, language, and recursionlimit - // properties are here. WTF do they have to do with graphics? - // Also note that these properties (and the monitorpositions, - // pointerlocation, and pointerwindow properties) are not yet used - // by Octave, so setting them will have no effect, and changes - // made elswhere (say, the diary or format functions) will not - // cause these properties to be updated. - - BEGIN_PROPERTIES (root_figure, root) - handle_property callbackobject Sr , graphics_handle () - array_property commandwindowsize r , Matrix (1, 2, 0) - handle_property currentfigure S , graphics_handle () - bool_property diary , "off" - string_property diaryfile , "diary" - bool_property echo , "off" - radio_property format , "+|bank|bit|debug|hex|long|longe|longeng|longg|native-bit|native-hex|rational|{short}|shorte|shorteng|shortg" - radio_property formatspacing , "{loose}|compact" - string_property language , "ascii" - array_property monitorpositions , Matrix (1, 4, 0) - array_property pointerlocation , Matrix (1, 2, 0) - double_property pointerwindow , 0.0 - double_property recursionlimit , 256.0 - double_property screendepth r , default_screendepth () - double_property screenpixelsperinch r , default_screenpixelsperinch () - array_property screensize r , default_screensize () - bool_property showhiddenhandles , "off" - radio_property units U , "inches|centimeters|normalized|points|{pixels}" - END_PROPERTIES - - private: - std::list cbo_stack; - }; - -private: - properties xproperties; - -public: - - root_figure (void) : xproperties (0, graphics_handle ()), default_properties () { } - - ~root_figure (void) { } - - void mark_modified (void) { } - - void override_defaults (base_graphics_object& obj) - { - // Now override with our defaults. If the default_properties - // list includes the properties for all defaults (line, - // surface, etc.) then we don't have to know the type of OBJ - // here, we just call its set function and let it decide which - // properties from the list to use. - obj.set_from_list (default_properties); - } - - void set (const caseless_str& name, const octave_value& value) - { - if (name.compare ("default", 7)) - // strip "default", pass rest to function that will - // parse the remainder and add the element to the - // default_properties map. - default_properties.set (name.substr (7), value); - else - xproperties.set (name, value); - } - - octave_value get (const caseless_str& name) const - { - octave_value retval; - - if (name.compare ("default", 7)) - return get_default (name.substr (7)); - else if (name.compare ("factory", 7)) - return get_factory_default (name.substr (7)); - else - retval = xproperties.get (name); - - return retval; - } - - octave_value get_default (const caseless_str& name) const - { - octave_value retval = default_properties.lookup (name); - - if (retval.is_undefined ()) - { - // no default property found, use factory default - retval = factory_properties.lookup (name); - - if (retval.is_undefined ()) - error ("get: invalid default property '%s'", name.c_str ()); - } - - return retval; - } - - octave_value get_factory_default (const caseless_str& name) const - { - octave_value retval = factory_properties.lookup (name); - - if (retval.is_undefined ()) - error ("get: invalid factory default property '%s'", name.c_str ()); - - return retval; - } - - octave_value get_defaults (void) const - { - return default_properties.as_struct ("default"); - } - - octave_value get_factory_defaults (void) const - { - return factory_properties.as_struct ("factory"); - } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } - - void reset_default_properties (void); - -private: - property_list default_properties; - - static property_list factory_properties; - - static property_list::plist_map_type init_factory_properties (void); -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API figure : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - void init_integerhandle (const octave_value& val) - { - integerhandle = val; - } - - void remove_child (const graphics_handle& h); - - void set_visible (const octave_value& val); - - graphics_toolkit get_toolkit (void) const - { - if (! toolkit) - toolkit = gtk_manager::get_toolkit (); - - return toolkit; - } - - void set_toolkit (const graphics_toolkit& b); - - void set___graphics_toolkit__ (const octave_value& val) - { - if (! error_state) - { - if (val.is_string ()) - { - std::string nm = val.string_value (); - graphics_toolkit b = gtk_manager::find_toolkit (nm); - if (b.get_name () != nm) - { - error ("set___graphics_toolkit__: invalid graphics toolkit"); - } - else - { - set_toolkit (b); - mark_modified (); - } - } - else - error ("set___graphics_toolkit__ must be a string"); - } - } - - void set_position (const octave_value& val, - bool do_notify_toolkit = true); - - void set_outerposition (const octave_value& val, - bool do_notify_toolkit = true); - - Matrix get_boundingbox (bool internal = false, - const Matrix& parent_pix_size = Matrix ()) const; - - void set_boundingbox (const Matrix& bb, bool internal = false, - bool do_notify_toolkit = true); - - Matrix map_from_boundingbox (double x, double y) const; - - Matrix map_to_boundingbox (double x, double y) const; - - void update_units (const caseless_str& old_units); - - void update_paperunits (const caseless_str& old_paperunits); - - std::string get_title (void) const; - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (figure) - any_property __plot_stream__ h , Matrix () - bool_property __enhanced__ h , "on" - radio_property nextplot , "new|{add}|replacechildren|replace" - callback_property closerequestfcn , "closereq" - handle_property currentaxes S , graphics_handle () - array_property colormap , jet_colormap () - radio_property paperorientation U , "{portrait}|landscape|rotated" - color_property color , color_property (color_values (1, 1, 1), radio_values ("none")) - array_property alphamap , Matrix (64, 1, 1) - string_property currentcharacter r , "" - handle_property currentobject r , graphics_handle () - array_property currentpoint r , Matrix (2, 1, 0) - bool_property dockcontrols , "off" - bool_property doublebuffer , "on" - string_property filename , "" - bool_property integerhandle S , "on" - bool_property inverthardcopy , "off" - callback_property keypressfcn , Matrix () - callback_property keyreleasefcn , Matrix () - radio_property menubar , "none|{figure}" - double_property mincolormap , 64 - string_property name , "" - bool_property numbertitle , "on" - array_property outerposition s , Matrix (1, 4, -1.0) - radio_property paperunits Su , "{inches}|centimeters|normalized|points" - array_property paperposition , default_figure_paperposition () - radio_property paperpositionmode , "auto|{manual}" - array_property papersize U , default_figure_papersize () - radio_property papertype SU , "{usletter}|uslegal|a0|a1|a2|a3|a4|a5|b0|b1|b2|b3|b4|b5|arch-a|arch-b|arch-c|arch-d|arch-e|a|b|c|d|e|tabloid|" - radio_property pointer , "crosshair|fullcrosshair|{arrow}|ibeam|watch|topl|topr|botl|botr|left|top|right|bottom|circle|cross|fleur|custom|hand" - array_property pointershapecdata , Matrix (16, 16, 0) - array_property pointershapehotspot , Matrix (1, 2, 0) - array_property position s , default_figure_position () - radio_property renderer , "{painters}|zbuffer|opengl|none" - radio_property renderermode , "{auto}|manual" - bool_property resize , "on" - callback_property resizefcn , Matrix () - radio_property selectiontype , "{normal}|open|alt|extend" - radio_property toolbar , "none|{auto}|figure" - radio_property units Su , "inches|centimeters|normalized|points|{pixels}|characters" - callback_property windowbuttondownfcn , Matrix () - callback_property windowbuttonmotionfcn , Matrix () - callback_property windowbuttonupfcn , Matrix () - callback_property windowbuttonwheelfcn , Matrix () - radio_property windowstyle , "{normal}|modal|docked" - string_property wvisual , "" - radio_property wvisualmode , "{auto}|manual" - string_property xdisplay , "" - string_property xvisual , "" - radio_property xvisualmode , "{auto}|manual" - callback_property buttondownfcn , Matrix () - string_property __graphics_toolkit__ s , "gnuplot" - any_property __guidata__ h , Matrix () - END_PROPERTIES - - protected: - void init (void) - { - colormap.add_constraint (dim_vector (-1, 3)); - alphamap.add_constraint (dim_vector (-1, 1)); - paperposition.add_constraint (dim_vector (1, 4)); - pointershapecdata.add_constraint (dim_vector (16, 16)); - pointershapehotspot.add_constraint (dim_vector (1, 2)); - position.add_constraint (dim_vector (1, 4)); - outerposition.add_constraint (dim_vector (1, 4)); - } - - private: - mutable graphics_toolkit toolkit; - }; - -private: - properties xproperties; - -public: - figure (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p), default_properties () - { - xproperties.override_defaults (*this); - } - - ~figure (void) { } - - void override_defaults (base_graphics_object& obj) - { - // Allow parent (root figure) to override first (properties knows how - // to find the parent object). - xproperties.override_defaults (obj); - - // Now override with our defaults. If the default_properties - // list includes the properties for all defaults (line, - // surface, etc.) then we don't have to know the type of OBJ - // here, we just call its set function and let it decide which - // properties from the list to use. - obj.set_from_list (default_properties); - } - - void set (const caseless_str& name, const octave_value& value) - { - if (name.compare ("default", 7)) - // strip "default", pass rest to function that will - // parse the remainder and add the element to the - // default_properties map. - default_properties.set (name.substr (7), value); - else - xproperties.set (name, value); - } - - octave_value get (const caseless_str& name) const - { - octave_value retval; - - if (name.compare ("default", 7)) - retval = get_default (name.substr (7)); - else - retval = xproperties.get (name); - - return retval; - } - - octave_value get_default (const caseless_str& name) const; - - octave_value get_defaults (void) const - { - return default_properties.as_struct ("default"); - } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } - - void reset_default_properties (void); - -private: - property_list default_properties; -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API graphics_xform -{ -public: - graphics_xform (void) - : xform (xform_eye ()), xform_inv (xform_eye ()), - sx ("linear"), sy ("linear"), sz ("linear"), zlim (1, 2, 0.0) - { - zlim(1) = 1.0; - } - - graphics_xform (const Matrix& xm, const Matrix& xim, - const scaler& x, const scaler& y, const scaler& z, - const Matrix& zl) - : xform (xm), xform_inv (xim), sx (x), sy (y), sz (z), zlim (zl) { } - - graphics_xform (const graphics_xform& g) - : xform (g.xform), xform_inv (g.xform_inv), sx (g.sx), - sy (g.sy), sz (g.sz), zlim (g.zlim) { } - - ~graphics_xform (void) { } - - graphics_xform& operator = (const graphics_xform& g) - { - xform = g.xform; - xform_inv = g.xform_inv; - sx = g.sx; - sy = g.sy; - sz = g.sz; - zlim = g.zlim; - - return *this; - } - - static ColumnVector xform_vector (double x, double y, double z); - - static Matrix xform_eye (void); - - ColumnVector transform (double x, double y, double z, - bool use_scale = true) const; - - ColumnVector untransform (double x, double y, double z, - bool use_scale = true) const; - - ColumnVector untransform (double x, double y, bool use_scale = true) const - { return untransform (x, y, (zlim(0)+zlim(1))/2, use_scale); } - - Matrix xscale (const Matrix& m) const { return sx.scale (m); } - Matrix yscale (const Matrix& m) const { return sy.scale (m); } - Matrix zscale (const Matrix& m) const { return sz.scale (m); } - - Matrix scale (const Matrix& m) const - { - bool has_z = (m.columns () > 2); - - if (sx.is_linear () && sy.is_linear () - && (! has_z || sz.is_linear ())) - return m; - - Matrix retval (m.dims ()); - - int r = m.rows (); - - for (int i = 0; i < r; i++) - { - retval(i,0) = sx.scale (m(i,0)); - retval(i,1) = sy.scale (m(i,1)); - if (has_z) - retval(i,2) = sz.scale (m(i,2)); - } - - return retval; - } - -private: - Matrix xform; - Matrix xform_inv; - scaler sx, sy, sz; - Matrix zlim; -}; - -enum { - AXE_ANY_DIR = 0, - AXE_DEPTH_DIR = 1, - AXE_HORZ_DIR = 2, - AXE_VERT_DIR = 3 -}; - -class OCTINTERP_API axes : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - void set_defaults (base_graphics_object& obj, const std::string& mode); - - void remove_child (const graphics_handle& h); - - const scaler& get_x_scaler (void) const { return sx; } - const scaler& get_y_scaler (void) const { return sy; } - const scaler& get_z_scaler (void) const { return sz; } - - Matrix get_boundingbox (bool internal = false, - const Matrix& parent_pix_size = Matrix ()) const; - Matrix get_extent (bool with_text = false, bool only_text_height=false) const; - - double get_fontsize_points (double box_pix_height = 0) const; - - void update_boundingbox (void) - { - if (units_is ("normalized")) - { - sync_positions (); - base_properties::update_boundingbox (); - } - } - - void update_camera (void); - void update_axes_layout (void); - void update_aspectratios (void); - void update_transform (void) - { - update_aspectratios (); - update_camera (); - update_axes_layout (); - } - - void update_autopos (const std::string& elem_type); - void update_xlabel_position (void); - void update_ylabel_position (void); - void update_zlabel_position (void); - void update_title_position (void); - - graphics_xform get_transform (void) const - { return graphics_xform (x_render, x_render_inv, sx, sy, sz, x_zlim); } - - Matrix get_transform_matrix (void) const { return x_render; } - Matrix get_inverse_transform_matrix (void) const { return x_render_inv; } - Matrix get_opengl_matrix_1 (void) const { return x_gl_mat1; } - Matrix get_opengl_matrix_2 (void) const { return x_gl_mat2; } - Matrix get_transform_zlim (void) const { return x_zlim; } - - int get_xstate (void) const { return xstate; } - int get_ystate (void) const { return ystate; } - int get_zstate (void) const { return zstate; } - double get_xPlane (void) const { return xPlane; } - double get_xPlaneN (void) const { return xPlaneN; } - double get_yPlane (void) const { return yPlane; } - double get_yPlaneN (void) const { return yPlaneN; } - double get_zPlane (void) const { return zPlane; } - double get_zPlaneN (void) const { return zPlaneN; } - double get_xpTick (void) const { return xpTick; } - double get_xpTickN (void) const { return xpTickN; } - double get_ypTick (void) const { return ypTick; } - double get_ypTickN (void) const { return ypTickN; } - double get_zpTick (void) const { return zpTick; } - double get_zpTickN (void) const { return zpTickN; } - double get_x_min (void) const { return std::min (xPlane, xPlaneN); } - double get_x_max (void) const { return std::max (xPlane, xPlaneN); } - double get_y_min (void) const { return std::min (yPlane, yPlaneN); } - double get_y_max (void) const { return std::max (yPlane, yPlaneN); } - double get_z_min (void) const { return std::min (zPlane, zPlaneN); } - double get_z_max (void) const { return std::max (zPlane, zPlaneN); } - double get_fx (void) const { return fx; } - double get_fy (void) const { return fy; } - double get_fz (void) const { return fz; } - double get_xticklen (void) const { return xticklen; } - double get_yticklen (void) const { return yticklen; } - double get_zticklen (void) const { return zticklen; } - double get_xtickoffset (void) const { return xtickoffset; } - double get_ytickoffset (void) const { return ytickoffset; } - double get_ztickoffset (void) const { return ztickoffset; } - bool get_x2Dtop (void) const { return x2Dtop; } - bool get_y2Dright (void) const { return y2Dright; } - bool get_layer2Dtop (void) const { return layer2Dtop; } - bool get_xySym (void) const { return xySym; } - bool get_xyzSym (void) const { return xyzSym; } - bool get_zSign (void) const { return zSign; } - bool get_nearhoriz (void) const { return nearhoriz; } - - ColumnVector pixel2coord (double px, double py) const - { return get_transform ().untransform (px, py, (x_zlim(0)+x_zlim(1))/2); } - - ColumnVector coord2pixel (double x, double y, double z) const - { return get_transform ().transform (x, y, z); } - - void zoom_about_point (double x, double y, double factor, - bool push_to_zoom_stack = true); - void zoom (const Matrix& xl, const Matrix& yl, bool push_to_zoom_stack = true); - void translate_view (double x0, double x1, double y0, double y1); - void rotate_view (double delta_az, double delta_el); - void unzoom (void); - void clear_zoom_stack (void); - - void update_units (const caseless_str& old_units); - - void update_fontunits (const caseless_str& old_fontunits); - - private: - scaler sx, sy, sz; - Matrix x_render, x_render_inv; - Matrix x_gl_mat1, x_gl_mat2; - Matrix x_zlim; - std::list zoom_stack; - - // Axes layout data - int xstate, ystate, zstate; - double xPlane, xPlaneN, yPlane, yPlaneN, zPlane, zPlaneN; - double xpTick, xpTickN, ypTick, ypTickN, zpTick, zpTickN; - double fx, fy, fz; - double xticklen, yticklen, zticklen; - double xtickoffset, ytickoffset, ztickoffset; - bool x2Dtop, y2Dright, layer2Dtop; - bool xySym, xyzSym, zSign, nearhoriz; - -#if HAVE_FREETYPE - // freetype renderer, used for calculation of text (tick labels) size - ft_render text_renderer; -#endif - - void set_text_child (handle_property& h, const std::string& who, - const octave_value& v); - - void delete_text_child (handle_property& h); - - // See the genprops.awk script for an explanation of the - // properties declarations. - - // properties which are not in matlab: interpreter - - BEGIN_PROPERTIES (axes) - array_property position u , default_axes_position () - bool_property box , "on" - array_property colororder , default_colororder () - array_property dataaspectratio mu , Matrix (1, 3, 1.0) - radio_property dataaspectratiomode u , "{auto}|manual" - radio_property layer u , "{bottom}|top" - row_vector_property xlim mu , default_lim () - row_vector_property ylim mu , default_lim () - row_vector_property zlim mu , default_lim () - row_vector_property clim m , default_lim () - row_vector_property alim m , default_lim () - radio_property xlimmode al , "{auto}|manual" - radio_property ylimmode al , "{auto}|manual" - radio_property zlimmode al , "{auto}|manual" - radio_property climmode al , "{auto}|manual" - radio_property alimmode , "{auto}|manual" - handle_property xlabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) - handle_property ylabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) - handle_property zlabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) - handle_property title SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) - bool_property xgrid , "off" - bool_property ygrid , "off" - bool_property zgrid , "off" - bool_property xminorgrid , "off" - bool_property yminorgrid , "off" - bool_property zminorgrid , "off" - row_vector_property xtick mu , default_axes_tick () - row_vector_property ytick mu , default_axes_tick () - row_vector_property ztick mu , default_axes_tick () - radio_property xtickmode u , "{auto}|manual" - radio_property ytickmode u , "{auto}|manual" - radio_property ztickmode u , "{auto}|manual" - bool_property xminortick , "off" - bool_property yminortick , "off" - bool_property zminortick , "off" - // FIXME -- should be kind of string array. - any_property xticklabel S , "" - any_property yticklabel S , "" - any_property zticklabel S , "" - radio_property xticklabelmode u , "{auto}|manual" - radio_property yticklabelmode u , "{auto}|manual" - radio_property zticklabelmode u , "{auto}|manual" - radio_property interpreter , "tex|{none}|latex" - color_property color , color_property (color_values (1, 1, 1), radio_values ("none")) - color_property xcolor , color_values (0, 0, 0) - color_property ycolor , color_values (0, 0, 0) - color_property zcolor , color_values (0, 0, 0) - radio_property xscale alu , "{linear}|log" - radio_property yscale alu , "{linear}|log" - radio_property zscale alu , "{linear}|log" - radio_property xdir u , "{normal}|reverse" - radio_property ydir u , "{normal}|reverse" - radio_property zdir u , "{normal}|reverse" - radio_property yaxislocation u , "{left}|right|zero" - radio_property xaxislocation u , "{bottom}|top|zero" - array_property view u , Matrix () - bool_property __hold_all__ h , "off" - radio_property nextplot , "new|add|replacechildren|{replace}" - array_property outerposition u , default_axes_outerposition () - radio_property activepositionproperty , "{outerposition}|position" - color_property ambientlightcolor , color_values (1, 1, 1) - array_property cameraposition m , Matrix (1, 3, 0.0) - array_property cameratarget m , Matrix (1, 3, 0.0) - array_property cameraupvector m , Matrix () - double_property cameraviewangle m , 10.0 - radio_property camerapositionmode , "{auto}|manual" - radio_property cameratargetmode , "{auto}|manual" - radio_property cameraupvectormode , "{auto}|manual" - radio_property cameraviewanglemode , "{auto}|manual" - array_property currentpoint , Matrix (2, 3, 0.0) - radio_property drawmode , "{normal}|fast" - radio_property fontangle u , "{normal}|italic|oblique" - string_property fontname u , OCTAVE_DEFAULT_FONTNAME - double_property fontsize u , 10 - radio_property fontunits SU , "{points}|normalized|inches|centimeters|pixels" - radio_property fontweight u , "{normal}|light|demi|bold" - radio_property gridlinestyle , "-|--|{:}|-.|none" - string_array_property linestyleorder , "-" - double_property linewidth , 0.5 - radio_property minorgridlinestyle , "-|--|{:}|-.|none" - array_property plotboxaspectratio mu , Matrix (1, 3, 1.0) - radio_property plotboxaspectratiomode u , "{auto}|manual" - radio_property projection , "{orthographic}|perpective" - radio_property tickdir mu , "{in}|out" - radio_property tickdirmode u , "{auto}|manual" - array_property ticklength u , default_axes_ticklength () - array_property tightinset r , Matrix (1, 4, 0.0) - // FIXME -- uicontextmenu should be moved here. - radio_property units SU , "{normalized}|inches|centimeters|points|pixels|characters" - // hidden properties for transformation computation - array_property x_viewtransform h , Matrix (4, 4, 0.0) - array_property x_projectiontransform h , Matrix (4, 4, 0.0) - array_property x_viewporttransform h , Matrix (4, 4, 0.0) - array_property x_normrendertransform h , Matrix (4, 4, 0.0) - array_property x_rendertransform h , Matrix (4, 4, 0.0) - // hidden properties for minor ticks - row_vector_property xmtick h , Matrix () - row_vector_property ymtick h , Matrix () - row_vector_property zmtick h , Matrix () - // hidden properties for inset - array_property looseinset hu , Matrix (1, 4, 0.0) - // hidden properties for alignment of subplots - radio_property autopos_tag h , "{none}|subplot" - END_PROPERTIES - - protected: - void init (void); - - private: - - std::string - get_scale (const std::string& scale, const Matrix& lims) - { - std::string retval = scale; - - if (scale == "log" && lims.numel () > 1 && lims(0) < 0 && lims(1) < 0) - retval = "neglog"; - - return retval; - } - - void update_xscale (void) - { - sx = get_scale (get_xscale (), xlim.get ().matrix_value ()); - } - - void update_yscale (void) - { - sy = get_scale (get_yscale (), ylim.get ().matrix_value ()); - } - - void update_zscale (void) - { - sz = get_scale (get_zscale (), zlim.get ().matrix_value ()); - } - - void update_view (void) { sync_positions (); } - void update_dataaspectratio (void) { sync_positions (); } - void update_dataaspectratiomode (void) { sync_positions (); } - void update_plotboxaspectratio (void) { sync_positions (); } - void update_plotboxaspectratiomode (void) { sync_positions (); } - - void update_layer (void) { update_axes_layout (); } - void update_yaxislocation (void) - { - update_axes_layout (); - update_ylabel_position (); - } - void update_xaxislocation (void) - { - update_axes_layout (); - update_xlabel_position (); - } - - void update_xdir (void) { update_camera (); update_axes_layout (); } - void update_ydir (void) { update_camera (); update_axes_layout (); } - void update_zdir (void) { update_camera (); update_axes_layout (); } - - void update_ticklength (void); - void update_tickdir (void) { update_ticklength (); } - void update_tickdirmode (void) { update_ticklength (); } - - void update_xtick (void) - { - if (xticklabelmode.is ("auto")) - calc_ticklabels (xtick, xticklabel, xscale.is ("log")); - } - void update_ytick (void) - { - if (yticklabelmode.is ("auto")) - calc_ticklabels (ytick, yticklabel, yscale.is ("log")); - } - void update_ztick (void) - { - if (zticklabelmode.is ("auto")) - calc_ticklabels (ztick, zticklabel, zscale.is ("log")); - } - - void update_xtickmode (void) - { - if (xtickmode.is ("auto")) - { - calc_ticks_and_lims (xlim, xtick, xmtick, xlimmode.is ("auto"), xscale.is ("log")); - update_xtick (); - } - } - void update_ytickmode (void) - { - if (ytickmode.is ("auto")) - { - calc_ticks_and_lims (ylim, ytick, ymtick, ylimmode.is ("auto"), yscale.is ("log")); - update_ytick (); - } - } - void update_ztickmode (void) - { - if (ztickmode.is ("auto")) - { - calc_ticks_and_lims (zlim, ztick, zmtick, zlimmode.is ("auto"), zscale.is ("log")); - update_ztick (); - } - } - - void update_xticklabelmode (void) - { - if (xticklabelmode.is ("auto")) - calc_ticklabels (xtick, xticklabel, xscale.is ("log")); - } - void update_yticklabelmode (void) - { - if (yticklabelmode.is ("auto")) - calc_ticklabels (ytick, yticklabel, yscale.is ("log")); - } - void update_zticklabelmode (void) - { - if (zticklabelmode.is ("auto")) - calc_ticklabels (ztick, zticklabel, zscale.is ("log")); - } - - void update_font (void); - void update_fontname (void) { update_font (); } - void update_fontsize (void) { update_font (); } - void update_fontangle (void) { update_font (); } - void update_fontweight (void) { update_font (); } - - void sync_positions (const Matrix& linset); - void sync_positions (void); - - void update_insets (void); - - void update_outerposition (void) - { - set_activepositionproperty ("outerposition"); - sync_positions (); - } - - void update_position (void) - { - set_activepositionproperty ("position"); - sync_positions (); - } - - void update_looseinset (void) { sync_positions (); } - - double calc_tick_sep (double minval, double maxval); - void calc_ticks_and_lims (array_property& lims, array_property& ticks, array_property& mticks, - bool limmode_is_auto, bool is_logscale); - void calc_ticklabels (const array_property& ticks, any_property& labels, bool is_logscale); - Matrix get_ticklabel_extents (const Matrix& ticks, - const string_vector& ticklabels, - const Matrix& limits); - - void fix_limits (array_property& lims) - { - if (lims.get ().is_empty ()) - return; - - Matrix l = lims.get ().matrix_value (); - if (l(0) > l(1)) - { - l(0) = 0; - l(1) = 1; - lims = l; - } - else if (l(0) == l(1)) - { - l(0) -= 0.5; - l(1) += 0.5; - lims = l; - } - } - - Matrix calc_tightbox (const Matrix& init_pos); - - public: - Matrix get_axis_limits (double xmin, double xmax, - double min_pos, double max_neg, - bool logscale); - - void update_xlim (bool do_clr_zoom = true) - { - if (xtickmode.is ("auto")) - calc_ticks_and_lims (xlim, xtick, xmtick, xlimmode.is ("auto"), xscale.is ("log")); - if (xticklabelmode.is ("auto")) - calc_ticklabels (xtick, xticklabel, xscale.is ("log")); - - fix_limits (xlim); - - update_xscale (); - - if (do_clr_zoom) - zoom_stack.clear (); - - update_axes_layout (); - } - - void update_ylim (bool do_clr_zoom = true) - { - if (ytickmode.is ("auto")) - calc_ticks_and_lims (ylim, ytick, ymtick, ylimmode.is ("auto"), yscale.is ("log")); - if (yticklabelmode.is ("auto")) - calc_ticklabels (ytick, yticklabel, yscale.is ("log")); - - fix_limits (ylim); - - update_yscale (); - - if (do_clr_zoom) - zoom_stack.clear (); - - update_axes_layout (); - } - - void update_zlim (void) - { - if (ztickmode.is ("auto")) - calc_ticks_and_lims (zlim, ztick, zmtick, zlimmode.is ("auto"), zscale.is ("log")); - if (zticklabelmode.is ("auto")) - calc_ticklabels (ztick, zticklabel, zscale.is ("log")); - - fix_limits (zlim); - - update_zscale (); - - zoom_stack.clear (); - - update_axes_layout (); - } - - }; - -private: - properties xproperties; - -public: - axes (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p), default_properties () - { - xproperties.override_defaults (*this); - xproperties.update_transform (); - } - - ~axes (void) { } - - void override_defaults (base_graphics_object& obj) - { - // Allow parent (figure) to override first (properties knows how - // to find the parent object). - xproperties.override_defaults (obj); - - // Now override with our defaults. If the default_properties - // list includes the properties for all defaults (line, - // surface, etc.) then we don't have to know the type of OBJ - // here, we just call its set function and let it decide which - // properties from the list to use. - obj.set_from_list (default_properties); - } - - void set (const caseless_str& name, const octave_value& value) - { - if (name.compare ("default", 7)) - // strip "default", pass rest to function that will - // parse the remainder and add the element to the - // default_properties map. - default_properties.set (name.substr (7), value); - else - xproperties.set (name, value); - } - - void set_defaults (const std::string& mode) - { - remove_all_listeners (); - xproperties.set_defaults (*this, mode); - } - - octave_value get (const caseless_str& name) const - { - octave_value retval; - - // FIXME -- finish this. - if (name.compare ("default", 7)) - retval = get_default (name.substr (7)); - else - retval = xproperties.get (name); - - return retval; - } - - octave_value get_default (const caseless_str& name) const; - - octave_value get_defaults (void) const - { - return default_properties.as_struct ("default"); - } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - void update_axis_limits (const std::string& axis_type); - - void update_axis_limits (const std::string& axis_type, - const graphics_handle& h); - - bool valid_object (void) const { return true; } - - void reset_default_properties (void); - -protected: - void initialize (const graphics_object& go); - -private: - property_list default_properties; -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API line : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - // See the genprops.awk script for an explanation of the - // properties declarations. - - // properties which are not in matlab: interpreter - - BEGIN_PROPERTIES (line) - row_vector_property xdata u , default_data () - row_vector_property ydata u , default_data () - row_vector_property zdata u , Matrix () - string_property xdatasource , "" - string_property ydatasource , "" - string_property zdatasource , "" - color_property color , color_values (0, 0, 0) - radio_property linestyle , "{-}|--|:|-.|none" - double_property linewidth , 0.5 - radio_property marker , "{none}|s|o|x|+|.|*|<|>|v|^|d|p|h|@" - color_property markeredgecolor , "{auto}|none" - color_property markerfacecolor , "auto|{none}" - double_property markersize , 6 - radio_property interpreter , "{tex}|none|latex" - string_property displayname , "" - radio_property erasemode , "{normal}|none|xor|background" - // hidden properties for limit computation - row_vector_property xlim hlr , Matrix () - row_vector_property ylim hlr , Matrix () - row_vector_property zlim hlr , Matrix () - bool_property xliminclude hl , "on" - bool_property yliminclude hl , "on" - bool_property zliminclude hl , "off" - END_PROPERTIES - - private: - Matrix compute_xlim (void) const; - Matrix compute_ylim (void) const; - - void update_xdata (void) { set_xlim (compute_xlim ()); } - - void update_ydata (void) { set_ylim (compute_ylim ()); } - - void update_zdata (void) - { - set_zlim (zdata.get_limits ()); - set_zliminclude (get_zdata ().numel () > 0); - } - }; - -private: - properties xproperties; - -public: - line (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~line (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API text : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - double get_fontsize_points (double box_pix_height = 0) const; - - void set_position (const octave_value& val) - { - if (! error_state) - { - octave_value new_val (val); - - if (new_val.numel () == 2) - { - dim_vector dv (1, 3); - - new_val = new_val.resize (dv, true); - } - - if (position.set (new_val, false)) - { - set_positionmode ("manual"); - update_position (); - position.run_listeners (POSTSET); - mark_modified (); - } - else - set_positionmode ("manual"); - } - } - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (text) - text_label_property string u , "" - radio_property units u , "{data}|pixels|normalized|inches|centimeters|points" - array_property position smu , Matrix (1, 3, 0.0) - double_property rotation mu , 0 - radio_property horizontalalignment mu , "{left}|center|right" - color_property color u , color_values (0, 0, 0) - string_property fontname u , OCTAVE_DEFAULT_FONTNAME - double_property fontsize u , 10 - radio_property fontangle u , "{normal}|italic|oblique" - radio_property fontweight u , "light|{normal}|demi|bold" - radio_property interpreter u , "{tex}|none|latex" - color_property backgroundcolor , "{none}" - string_property displayname , "" - color_property edgecolor , "{none}" - radio_property erasemode , "{normal}|none|xor|background" - bool_property editing , "off" - radio_property fontunits , "inches|centimeters|normalized|{points}|pixels" - radio_property linestyle , "{-}|--|:|-.|none" - double_property linewidth , 0.5 - double_property margin , 1 - radio_property verticalalignment mu , "top|cap|{middle}|baseline|bottom" - array_property extent rG , Matrix (1, 4, 0.0) - // hidden properties for limit computation - row_vector_property xlim hlr , Matrix () - row_vector_property ylim hlr , Matrix () - row_vector_property zlim hlr , Matrix () - bool_property xliminclude hl , "off" - bool_property yliminclude hl , "off" - bool_property zliminclude hl , "off" - // hidden properties for auto-positioning - radio_property positionmode hu , "{auto}|manual" - radio_property rotationmode hu , "{auto}|manual" - radio_property horizontalalignmentmode hu , "{auto}|manual" - radio_property verticalalignmentmode hu , "{auto}|manual" - radio_property autopos_tag h , "{none}|xlabel|ylabel|zlabel|title" - END_PROPERTIES - - Matrix get_data_position (void) const; - Matrix get_extent_matrix (void) const; - const uint8NDArray& get_pixels (void) const { return pixels; } -#if HAVE_FREETYPE - // freetype renderer, used for calculation of text size - ft_render renderer; -#endif - - protected: - void init (void) - { - position.add_constraint (dim_vector (1, 3)); - cached_units = get_units (); - update_font (); - } - - private: - void update_position (void) - { - Matrix pos = get_data_position (); - Matrix lim; - - lim = Matrix (1, 3, pos(0)); - lim(2) = (lim(2) <= 0 ? octave_Inf : lim(2)); - set_xlim (lim); - - lim = Matrix (1, 3, pos(1)); - lim(2) = (lim(2) <= 0 ? octave_Inf : lim(2)); - set_ylim (lim); - - if (pos.numel () == 3) - { - lim = Matrix (1, 3, pos(2)); - lim(2) = (lim(2) <= 0 ? octave_Inf : lim(2)); - set_zliminclude ("on"); - set_zlim (lim); - } - else - set_zliminclude ("off"); - } - - void update_text_extent (void); - - void request_autopos (void); - void update_positionmode (void) { request_autopos (); } - void update_rotationmode (void) { request_autopos (); } - void update_horizontalalignmentmode (void) { request_autopos (); } - void update_verticalalignmentmode (void) { request_autopos (); } - - void update_font (void); - void update_string (void) { request_autopos (); update_text_extent (); } - void update_rotation (void) { update_text_extent (); } - void update_color (void) { update_font (); update_text_extent (); } - void update_fontname (void) { update_font (); update_text_extent (); } - void update_fontsize (void) { update_font (); update_text_extent (); } - void update_fontangle (void) { update_font (); update_text_extent (); } - void update_fontweight (void) { update_font (); update_text_extent (); } - void update_interpreter (void) { update_text_extent (); } - void update_horizontalalignment (void) { update_text_extent (); } - void update_verticalalignment (void) { update_text_extent (); } - - void update_units (void); - - private: - std::string cached_units; - uint8NDArray pixels; - }; - -private: - properties xproperties; - -public: - text (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.set_clipping ("off"); - xproperties.override_defaults (*this); - } - - ~text (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API image : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - bool is_climinclude (void) const - { return (climinclude.is_on () && cdatamapping.is ("scaled")); } - std::string get_climinclude (void) const - { return climinclude.current_value (); } - - octave_value get_color_data (void) const; - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (image) - row_vector_property xdata u , Matrix () - row_vector_property ydata u , Matrix () - array_property cdata u , Matrix () - radio_property cdatamapping al , "{scaled}|direct" - // hidden properties for limit computation - row_vector_property xlim hlr , Matrix () - row_vector_property ylim hlr , Matrix () - row_vector_property clim hlr , Matrix () - bool_property xliminclude hl , "on" - bool_property yliminclude hl , "on" - bool_property climinclude hlg , "on" - END_PROPERTIES - - protected: - void init (void) - { - xdata.add_constraint (2); - ydata.add_constraint (2); - cdata.add_constraint ("double"); - cdata.add_constraint ("single"); - cdata.add_constraint ("logical"); - cdata.add_constraint ("uint8"); - cdata.add_constraint ("uint16"); - cdata.add_constraint ("int16"); - cdata.add_constraint ("real"); - cdata.add_constraint (dim_vector (-1, -1)); - cdata.add_constraint (dim_vector (-1, -1, 3)); - } - - private: - void update_xdata (void) - { - Matrix limits = xdata.get_limits (); - float dp = pixel_xsize (); - - limits(0) = limits(0) - dp; - limits(1) = limits(1) + dp; - set_xlim (limits); - } - - void update_ydata (void) - { - Matrix limits = ydata.get_limits (); - float dp = pixel_ysize (); - - limits(0) = limits(0) - dp; - limits(1) = limits(1) + dp; - set_ylim (limits); - } - - void update_cdata (void) - { - if (cdatamapping_is ("scaled")) - set_clim (cdata.get_limits ()); - else - clim = cdata.get_limits (); - } - - float pixel_size (octave_idx_type dim, const Matrix limits) - { - octave_idx_type l = dim - 1; - float dp; - - if (l > 0 && limits(0) != limits(1)) - dp = (limits(1) - limits(0))/(2*l); - else - { - if (limits(1) == limits(2)) - dp = 0.5; - else - dp = (limits(1) - limits(0))/2; - } - return dp; - } - - public: - float pixel_xsize (void) - { - return pixel_size ((get_cdata ().dims ())(1), xdata.get_limits ()); - } - - float pixel_ysize (void) - { - return pixel_size ((get_cdata ().dims ())(0), ydata.get_limits ()); - } - }; - -private: - properties xproperties; - -public: - image (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~image (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API patch : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - octave_value get_color_data (void) const; - - bool is_climinclude (void) const - { return (climinclude.is_on () && cdatamapping.is ("scaled")); } - std::string get_climinclude (void) const - { return climinclude.current_value (); } - - bool is_aliminclude (void) const - { return (aliminclude.is_on () && alphadatamapping.is ("scaled")); } - std::string get_aliminclude (void) const - { return aliminclude.current_value (); } - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (patch) - array_property xdata u , Matrix () - array_property ydata u , Matrix () - array_property zdata u , Matrix () - array_property cdata u , Matrix () - radio_property cdatamapping l , "{scaled}|direct" - array_property faces , Matrix () - array_property facevertexalphadata , Matrix () - array_property facevertexcdata , Matrix () - array_property vertices , Matrix () - array_property vertexnormals , Matrix () - radio_property normalmode , "{auto}|manual" - color_property facecolor , color_property (color_values (0, 0, 0), radio_values ("flat|none|interp")) - double_radio_property facealpha , double_radio_property (1.0, radio_values ("flat|interp")) - radio_property facelighting , "flat|{none}|gouraud|phong" - color_property edgecolor , color_property (color_values (0, 0, 0), radio_values ("flat|none|interp")) - double_radio_property edgealpha , double_radio_property (1.0, radio_values ("flat|interp")) - radio_property edgelighting , "{none}|flat|gouraud|phong" - radio_property backfacelighting , "{reverselit}|unlit|lit" - double_property ambientstrength , 0.3 - double_property diffusestrength , 0.6 - double_property specularstrength , 0.6 - double_property specularexponent , 10.0 - double_property specularcolorreflectance , 1.0 - radio_property erasemode , "{normal}|background|xor|none" - radio_property linestyle , "{-}|--|:|-.|none" - double_property linewidth , 0.5 - radio_property marker , "{none}|s|o|x|+|.|*|<|>|v|^|d|p|h|@" - color_property markeredgecolor , "{auto}|none|flat" - color_property markerfacecolor , "auto|{none}|flat" - double_property markersize , 6 - radio_property interpreter , "{tex}|none|latex" - string_property displayname , "" - radio_property alphadatamapping l , "none|{scaled}|direct" - // hidden properties for limit computation - row_vector_property xlim hlr , Matrix () - row_vector_property ylim hlr , Matrix () - row_vector_property zlim hlr , Matrix () - row_vector_property clim hlr , Matrix () - row_vector_property alim hlr , Matrix () - bool_property xliminclude hl , "on" - bool_property yliminclude hl , "on" - bool_property zliminclude hl , "on" - bool_property climinclude hlg , "on" - bool_property aliminclude hlg , "on" - END_PROPERTIES - - protected: - void init (void) - { - xdata.add_constraint (dim_vector (-1, -1)); - ydata.add_constraint (dim_vector (-1, -1)); - zdata.add_constraint (dim_vector (-1, -1)); - vertices.add_constraint (dim_vector (-1, 2)); - vertices.add_constraint (dim_vector (-1, 3)); - cdata.add_constraint (dim_vector (-1, -1)); - cdata.add_constraint (dim_vector (-1, -1, 3)); - facevertexcdata.add_constraint (dim_vector (-1, 1)); - facevertexcdata.add_constraint (dim_vector (-1, 3)); - facevertexalphadata.add_constraint (dim_vector (-1, 1)); - } - - private: - void update_xdata (void) { set_xlim (xdata.get_limits ()); } - void update_ydata (void) { set_ylim (ydata.get_limits ()); } - void update_zdata (void) { set_zlim (zdata.get_limits ()); } - - void update_cdata (void) - { - if (cdatamapping_is ("scaled")) - set_clim (cdata.get_limits ()); - else - clim = cdata.get_limits (); - } - }; - -private: - properties xproperties; - -public: - patch (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~patch (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API surface : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - octave_value get_color_data (void) const; - - bool is_climinclude (void) const - { return (climinclude.is_on () && cdatamapping.is ("scaled")); } - std::string get_climinclude (void) const - { return climinclude.current_value (); } - - bool is_aliminclude (void) const - { return (aliminclude.is_on () && alphadatamapping.is ("scaled")); } - std::string get_aliminclude (void) const - { return aliminclude.current_value (); } - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (surface) - array_property xdata u , Matrix () - array_property ydata u , Matrix () - array_property zdata u , Matrix () - array_property cdata u , Matrix () - radio_property cdatamapping al , "{scaled}|direct" - string_property xdatasource , "" - string_property ydatasource , "" - string_property zdatasource , "" - string_property cdatasource , "" - color_property facecolor , "{flat}|none|interp|texturemap" - double_radio_property facealpha , double_radio_property (1.0, radio_values ("flat|interp")) - color_property edgecolor , color_property (color_values (0, 0, 0), radio_values ("flat|none|interp")) - radio_property linestyle , "{-}|--|:|-.|none" - double_property linewidth , 0.5 - radio_property marker , "{none}|s|o|x|+|.|*|<|>|v|^|d|p|h|@" - color_property markeredgecolor , "{auto}|none" - color_property markerfacecolor , "auto|{none}" - double_property markersize , 6 - radio_property interpreter , "{tex}|none|latex" - string_property displayname , "" - array_property alphadata u , Matrix () - radio_property alphadatamapping l , "none|direct|{scaled}" - double_property ambientstrength , 0.3 - radio_property backfacelighting , "unlit|lit|{reverselit}" - double_property diffusestrength , 0.6 - double_radio_property edgealpha , double_radio_property (1.0, radio_values ("flat|interp")) - radio_property edgelighting , "{none}|flat|gouraud|phong" - radio_property erasemode , "{normal}|none|xor|background" - radio_property facelighting , "{none}|flat|gouraud|phong" - radio_property meshstyle , "{both}|row|column" - radio_property normalmode u , "{auto}|manual" - double_property specularcolorreflectance , 1 - double_property specularexponent , 10 - double_property specularstrength , 0.9 - array_property vertexnormals u , Matrix () - // hidden properties for limit computation - row_vector_property xlim hlr , Matrix () - row_vector_property ylim hlr , Matrix () - row_vector_property zlim hlr , Matrix () - row_vector_property clim hlr , Matrix () - row_vector_property alim hlr , Matrix () - bool_property xliminclude hl , "on" - bool_property yliminclude hl , "on" - bool_property zliminclude hl , "on" - bool_property climinclude hlg , "on" - bool_property aliminclude hlg , "on" - END_PROPERTIES - - protected: - void init (void) - { - xdata.add_constraint (dim_vector (-1, -1)); - ydata.add_constraint (dim_vector (-1, -1)); - zdata.add_constraint (dim_vector (-1, -1)); - alphadata.add_constraint ("single"); - alphadata.add_constraint ("double"); - alphadata.add_constraint ("uint8"); - alphadata.add_constraint (dim_vector (-1, -1)); - vertexnormals.add_constraint (dim_vector (-1, -1, 3)); - cdata.add_constraint ("single"); - cdata.add_constraint ("double"); - cdata.add_constraint ("uint8"); - cdata.add_constraint (dim_vector (-1, -1)); - cdata.add_constraint (dim_vector (-1, -1, 3)); - } - - private: - void update_normals (void); - - void update_xdata (void) - { - update_normals (); - set_xlim (xdata.get_limits ()); - } - - void update_ydata (void) - { - update_normals (); - set_ylim (ydata.get_limits ()); - } - - void update_zdata (void) - { - update_normals (); - set_zlim (zdata.get_limits ()); - } - - void update_cdata (void) - { - if (cdatamapping_is ("scaled")) - set_clim (cdata.get_limits ()); - else - clim = cdata.get_limits (); - } - - void update_alphadata (void) - { - if (alphadatamapping_is ("scaled")) - set_alim (alphadata.get_limits ()); - else - alim = alphadata.get_limits (); - } - - void update_normalmode (void) - { update_normals (); } - - void update_vertexnormals (void) - { set_normalmode ("manual"); } - }; - -private: - properties xproperties; - -public: - surface (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~surface (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API hggroup : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - void remove_child (const graphics_handle& h) - { - base_properties::remove_child (h); - update_limits (); - } - - void adopt (const graphics_handle& h) - { - - base_properties::adopt (h); - update_limits (h); - } - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (hggroup) - string_property displayname , "" - radio_property erasemode , "{normal}|none|xor|background" - // hidden properties for limit computation - row_vector_property xlim hr , Matrix () - row_vector_property ylim hr , Matrix () - row_vector_property zlim hr , Matrix () - row_vector_property clim hr , Matrix () - row_vector_property alim hr , Matrix () - bool_property xliminclude h , "on" - bool_property yliminclude h , "on" - bool_property zliminclude h , "on" - bool_property climinclude h , "on" - bool_property aliminclude h , "on" - END_PROPERTIES - - private: - void update_limits (void) const; - - void update_limits (const graphics_handle& h) const; - - protected: - void init (void) - { } - - }; - -private: - properties xproperties; - -public: - hggroup (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~hggroup (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } - - void update_axis_limits (const std::string& axis_type); - - void update_axis_limits (const std::string& axis_type, - const graphics_handle& h); - -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API uimenu : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - void remove_child (const graphics_handle& h) - { - base_properties::remove_child (h); - } - - void adopt (const graphics_handle& h) - { - base_properties::adopt (h); - } - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (uimenu) - any_property __object__ , Matrix () - string_property accelerator , "" - callback_property callback , Matrix () - bool_property checked , "off" - bool_property enable , "on" - color_property foregroundcolor , color_values (0, 0, 0) - string_property label , "" - double_property position , 9 - bool_property separator , "off" - string_property fltk_label h , "" - END_PROPERTIES - - protected: - void init (void) - { } - }; - -private: - properties xproperties; - -public: - uimenu (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~uimenu (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } - -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API uicontextmenu : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (uicontextmenu) - any_property __object__ , Matrix () - callback_property callback , Matrix () - array_property position , Matrix (1, 2, 0.0) - END_PROPERTIES - - protected: - void init (void) - { - position.add_constraint (dim_vector (1, 2)); - position.add_constraint (dim_vector (2, 1)); - visible.set (octave_value (true)); - } - }; - -private: - properties xproperties; - -public: - uicontextmenu (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~uicontextmenu (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } - -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API uicontrol : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - Matrix get_boundingbox (bool internal = false, - const Matrix& parent_pix_size = Matrix ()) const; - - double get_fontsize_points (double box_pix_height = 0) const; - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (uicontrol) - any_property __object__ , Matrix () - color_property backgroundcolor , color_values (1, 1, 1) - callback_property callback , Matrix () - array_property cdata , Matrix () - bool_property clipping , "on" - radio_property enable , "{on}|inactive|off" - array_property extent rG , Matrix (1, 4, 0.0) - radio_property fontangle u , "{normal}|italic|oblique" - string_property fontname u , OCTAVE_DEFAULT_FONTNAME - double_property fontsize u , 10 - radio_property fontunits S , "inches|centimeters|normalized|{points}|pixels" - radio_property fontweight u , "light|{normal}|demi|bold" - color_property foregroundcolor , color_values (0, 0, 0) - radio_property horizontalalignment , "{left}|center|right" - callback_property keypressfcn , Matrix () - double_property listboxtop , 1 - double_property max , 1 - double_property min , 0 - array_property position , default_control_position () - array_property sliderstep , default_control_sliderstep () - string_array_property string u , "" - radio_property style S , "{pushbutton}|togglebutton|radiobutton|checkbox|edit|text|slider|frame|listbox|popupmenu" - string_property tooltipstring , "" - radio_property units u , "normalized|inches|centimeters|points|{pixels}|characters" - row_vector_property value , Matrix (1, 1, 1.0) - radio_property verticalalignment , "top|{middle}|bottom" - END_PROPERTIES - - private: - std::string cached_units; - - protected: - void init (void) - { - cdata.add_constraint ("double"); - cdata.add_constraint ("single"); - cdata.add_constraint ("uint8"); - cdata.add_constraint (dim_vector (-1, -1, 3)); - position.add_constraint (dim_vector (1, 4)); - sliderstep.add_constraint (dim_vector (1, 2)); - cached_units = get_units (); - } - - void update_text_extent (void); - - void update_string (void) { update_text_extent (); } - void update_fontname (void) { update_text_extent (); } - void update_fontsize (void) { update_text_extent (); } - void update_fontangle (void) { update_text_extent (); } - void update_fontweight (void) { update_text_extent (); } - void update_fontunits (const caseless_str& old_units); - - void update_units (void); - - }; - -private: - properties xproperties; - -public: - uicontrol (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~uicontrol (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API uipanel : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - Matrix get_boundingbox (bool internal = false, - const Matrix& parent_pix_size = Matrix ()) const; - - double get_fontsize_points (double box_pix_height = 0) const; - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (uipanel) - any_property __object__ , Matrix () - color_property backgroundcolor , color_values (1, 1, 1) - radio_property bordertype , "none|{etchedin}|etchedout|beveledin|beveledout|line" - double_property borderwidth , 1 - radio_property fontangle , "{normal}|italic|oblique" - string_property fontname , OCTAVE_DEFAULT_FONTNAME - double_property fontsize , 10 - radio_property fontunits S , "inches|centimeters|normalized|{points}|pixels" - radio_property fontweight , "light|{normal}|demi|bold" - color_property foregroundcolor , color_values (0, 0, 0) - color_property highlightcolor , color_values (1, 1, 1) - array_property position , default_panel_position () - callback_property resizefcn , Matrix () - color_property shadowcolor , color_values (0, 0, 0) - string_property title , "" - radio_property titleposition , "{lefttop}|centertop|righttop|leftbottom|centerbottom|rightbottom" - radio_property units S , "{normalized}|inches|centimeters|points|pixels|characters" - END_PROPERTIES - - protected: - void init (void) - { - position.add_constraint (dim_vector (1, 4)); - } - - void update_units (const caseless_str& old_units); - void update_fontunits (const caseless_str& old_units); - - }; - -private: - properties xproperties; - -public: - uipanel (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~uipanel (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API uitoolbar : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (uitoolbar) - any_property __object__ , Matrix () - END_PROPERTIES - - protected: - void init (void) - { } - }; - -private: - properties xproperties; - -public: - uitoolbar (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p), default_properties () - { - xproperties.override_defaults (*this); - } - - ~uitoolbar (void) { } - - void override_defaults (base_graphics_object& obj) - { - // Allow parent (figure) to override first (properties knows how - // to find the parent object). - xproperties.override_defaults (obj); - - // Now override with our defaults. If the default_properties - // list includes the properties for all defaults (line, - // surface, etc.) then we don't have to know the type of OBJ - // here, we just call its set function and let it decide which - // properties from the list to use. - obj.set_from_list (default_properties); - } - - void set (const caseless_str& name, const octave_value& value) - { - if (name.compare ("default", 7)) - // strip "default", pass rest to function that will - // parse the remainder and add the element to the - // default_properties map. - default_properties.set (name.substr (7), value); - else - xproperties.set (name, value); - } - - octave_value get (const caseless_str& name) const - { - octave_value retval; - - if (name.compare ("default", 7)) - retval = get_default (name.substr (7)); - else - retval = xproperties.get (name); - - return retval; - } - - octave_value get_default (const caseless_str& name) const; - - octave_value get_defaults (void) const - { - return default_properties.as_struct ("default"); - } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } - - void reset_default_properties (void); - -private: - property_list default_properties; -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API uipushtool : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (uipushtool) - any_property __object__ , Matrix () - array_property cdata , Matrix () - callback_property clickedcallback , Matrix () - bool_property enable , "on" - bool_property separator , "off" - string_property tooltipstring , "" - END_PROPERTIES - - protected: - void init (void) - { - cdata.add_constraint ("double"); - cdata.add_constraint ("single"); - cdata.add_constraint ("uint8"); - cdata.add_constraint (dim_vector (-1, -1, 3)); - } - }; - -private: - properties xproperties; - -public: - uipushtool (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~uipushtool (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } - -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API uitoggletool : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (uitoggletool) - any_property __object__ , Matrix () - array_property cdata , Matrix () - callback_property clickedcallback , Matrix () - bool_property enable , "on" - callback_property offcallback , Matrix () - callback_property oncallback , Matrix () - bool_property separator , "off" - bool_property state , "off" - string_property tooltipstring , "" - END_PROPERTIES - - protected: - void init (void) - { - cdata.add_constraint ("double"); - cdata.add_constraint ("single"); - cdata.add_constraint ("uint8"); - cdata.add_constraint (dim_vector (-1, -1, 3)); - } - }; - -private: - properties xproperties; - -public: - uitoggletool (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~uitoggletool (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } - -}; - -// --------------------------------------------------------------------- - -octave_value -get_property_from_handle (double handle, const std::string &property, - const std::string &func); -bool -set_property_in_handle (double handle, const std::string &property, - const octave_value &arg, const std::string &func); - -// --------------------------------------------------------------------- - -class graphics_event; - -class -base_graphics_event -{ -public: - friend class graphics_event; - - base_graphics_event (void) : count (1) { } - - virtual ~base_graphics_event (void) { } - - virtual void execute (void) = 0; - -private: - octave_refcount count; -}; - -class -graphics_event -{ -public: - typedef void (*event_fcn) (void*); - - graphics_event (void) : rep (0) { } - - graphics_event (const graphics_event& e) : rep (e.rep) - { - rep->count++; - } - - ~graphics_event (void) - { - if (rep && --rep->count == 0) - delete rep; - } - - graphics_event& operator = (const graphics_event& e) - { - if (rep != e.rep) - { - if (rep && --rep->count == 0) - delete rep; - - rep = e.rep; - if (rep) - rep->count++; - } - - return *this; - } - - void execute (void) - { if (rep) rep->execute (); } - - bool ok (void) const - { return (rep != 0); } - - static graphics_event - create_callback_event (const graphics_handle& h, - const std::string& name, - const octave_value& data = Matrix ()); - - static graphics_event - create_callback_event (const graphics_handle& h, - const octave_value& cb, - const octave_value& data = Matrix ()); - - static graphics_event - create_function_event (event_fcn fcn, void *data = 0); - - static graphics_event - create_set_event (const graphics_handle& h, const std::string& name, - const octave_value& value, - bool notify_toolkit = true); -private: - base_graphics_event *rep; -}; - -class OCTINTERP_API gh_manager -{ -protected: - - gh_manager (void); - -public: - - static void create_instance (void); - - static bool instance_ok (void) - { - bool retval = true; - - if (! instance) - create_instance (); - - if (! instance) - { - ::error ("unable to create gh_manager!"); - - retval = false; - } - - return retval; - } - - static void cleanup_instance (void) { delete instance; instance = 0; } - - static graphics_handle get_handle (bool integer_figure_handle) - { - return instance_ok () - ? instance->do_get_handle (integer_figure_handle) : graphics_handle (); - } - - static void free (const graphics_handle& h) - { - if (instance_ok ()) - instance->do_free (h); - } - - static void renumber_figure (const graphics_handle& old_gh, - const graphics_handle& new_gh) - { - if (instance_ok ()) - instance->do_renumber_figure (old_gh, new_gh); - } - - static graphics_handle lookup (double val) - { - return instance_ok () ? instance->do_lookup (val) : graphics_handle (); - } - - static graphics_handle lookup (const octave_value& val) - { - return val.is_real_scalar () - ? lookup (val.double_value ()) : graphics_handle (); - } - - static graphics_object get_object (double val) - { - return get_object (lookup (val)); - } - - static graphics_object get_object (const graphics_handle& h) - { - return instance_ok () ? instance->do_get_object (h) : graphics_object (); - } - - static graphics_handle - make_graphics_handle (const std::string& go_name, - const graphics_handle& parent, - bool integer_figure_handle = false, - bool do_createfcn = true, - bool do_notify_toolkit = true) - { - return instance_ok () - ? instance->do_make_graphics_handle (go_name, parent, - integer_figure_handle, - do_createfcn, do_notify_toolkit) - : graphics_handle (); - } - - static graphics_handle make_figure_handle (double val, - bool do_notify_toolkit = true) - { - return instance_ok () - ? instance->do_make_figure_handle (val, do_notify_toolkit) - : graphics_handle (); - } - - static void push_figure (const graphics_handle& h) - { - if (instance_ok ()) - instance->do_push_figure (h); - } - - static void pop_figure (const graphics_handle& h) - { - if (instance_ok ()) - instance->do_pop_figure (h); - } - - static graphics_handle current_figure (void) - { - return instance_ok () - ? instance->do_current_figure () : graphics_handle (); - } - - static Matrix handle_list (bool show_hidden = false) - { - return instance_ok () - ? instance->do_handle_list (show_hidden) : Matrix (); - } - - static void lock (void) - { - if (instance_ok ()) - instance->do_lock (); - } - - static bool try_lock (void) - { - if (instance_ok ()) - return instance->do_try_lock (); - else - return false; - } - - static void unlock (void) - { - if (instance_ok ()) - instance->do_unlock (); - } - - static Matrix figure_handle_list (bool show_hidden = false) - { - return instance_ok () - ? instance->do_figure_handle_list (show_hidden) : Matrix (); - } - - static void execute_listener (const graphics_handle& h, - const octave_value& l) - { - if (instance_ok ()) - instance->do_execute_listener (h, l); - } - - static void execute_callback (const graphics_handle& h, - const std::string& name, - const octave_value& data = Matrix ()) - { - octave_value cb; - - if (true) - { - gh_manager::auto_lock lock; - - graphics_object go = get_object (h); - - if (go.valid_object ()) - cb = go.get (name); - } - - if (! error_state) - execute_callback (h, cb, data); - } - - static void execute_callback (const graphics_handle& h, - const octave_value& cb, - const octave_value& data = Matrix ()) - { - if (instance_ok ()) - instance->do_execute_callback (h, cb, data); - } - - static void post_callback (const graphics_handle& h, - const std::string& name, - const octave_value& data = Matrix ()) - { - if (instance_ok ()) - instance->do_post_callback (h, name, data); - } - - static void post_function (graphics_event::event_fcn fcn, void* data = 0) - { - if (instance_ok ()) - instance->do_post_function (fcn, data); - } - - static void post_set (const graphics_handle& h, const std::string& name, - const octave_value& value, bool notify_toolkit = true) - { - if (instance_ok ()) - instance->do_post_set (h, name, value, notify_toolkit); - } - - static int process_events (void) - { - return (instance_ok () ? instance->do_process_events () : 0); - } - - static int flush_events (void) - { - return (instance_ok () ? instance->do_process_events (true) : 0); - } - - static void enable_event_processing (bool enable = true) - { - if (instance_ok ()) - instance->do_enable_event_processing (enable); - } - - static bool is_handle_visible (const graphics_handle& h) - { - bool retval = false; - - graphics_object go = get_object (h); - - if (go.valid_object ()) - retval = go.is_handle_visible (); - - return retval; - } - - static void close_all_figures (void) - { - if (instance_ok ()) - instance->do_close_all_figures (); - } - -public: - class auto_lock : public octave_autolock - { - public: - auto_lock (bool wait = true) - : octave_autolock (instance_ok () - ? instance->graphics_lock - : octave_mutex (), - wait) - { } - - private: - - // No copying! - auto_lock (const auto_lock&); - auto_lock& operator = (const auto_lock&); - }; - -private: - - static gh_manager *instance; - - typedef std::map::iterator iterator; - typedef std::map::const_iterator const_iterator; - - typedef std::set::iterator free_list_iterator; - typedef std::set::const_iterator const_free_list_iterator; - - typedef std::list::iterator figure_list_iterator; - typedef std::list::const_iterator const_figure_list_iterator; - - // A map of handles to graphics objects. - std::map handle_map; - - // The available graphics handles. - std::set handle_free_list; - - // The next handle available if handle_free_list is empty. - double next_handle; - - // The allocated figure handles. Top of the stack is most recently - // created. - std::list figure_list; - - // The lock for accessing the graphics sytsem. - octave_mutex graphics_lock; - - // The list of events queued by graphics toolkits. - std::list event_queue; - - // The stack of callback objects. - std::list callback_objects; - - // A flag telling whether event processing must be constantly on. - int event_processing; - - graphics_handle do_get_handle (bool integer_figure_handle); - - void do_free (const graphics_handle& h); - - void do_renumber_figure (const graphics_handle& old_gh, - const graphics_handle& new_gh); - - graphics_handle do_lookup (double val) - { - iterator p = (xisnan (val) ? handle_map.end () : handle_map.find (val)); - - return (p != handle_map.end ()) ? p->first : graphics_handle (); - } - - graphics_object do_get_object (const graphics_handle& h) - { - iterator p = (h.ok () ? handle_map.find (h) : handle_map.end ()); - - return (p != handle_map.end ()) ? p->second : graphics_object (); - } - - graphics_handle do_make_graphics_handle (const std::string& go_name, - const graphics_handle& p, - bool integer_figure_handle, - bool do_createfcn, - bool do_notify_toolkit); - - graphics_handle do_make_figure_handle (double val, bool do_notify_toolkit); - - Matrix do_handle_list (bool show_hidden) - { - Matrix retval (1, handle_map.size ()); - - octave_idx_type i = 0; - for (const_iterator p = handle_map.begin (); p != handle_map.end (); p++) - { - graphics_handle h = p->first; - - if (show_hidden || is_handle_visible (h)) - retval(i++) = h.value (); - } - - retval.resize (1, i); - - return retval; - } - - Matrix do_figure_handle_list (bool show_hidden) - { - Matrix retval (1, figure_list.size ()); - - octave_idx_type i = 0; - for (const_figure_list_iterator p = figure_list.begin (); - p != figure_list.end (); - p++) - { - graphics_handle h = *p; - - if (show_hidden || is_handle_visible (h)) - retval(i++) = h.value (); - } - - retval.resize (1, i); - - return retval; - } - - void do_push_figure (const graphics_handle& h); - - void do_pop_figure (const graphics_handle& h); - - graphics_handle do_current_figure (void) const - { - graphics_handle retval; - - for (const_figure_list_iterator p = figure_list.begin (); - p != figure_list.end (); - p++) - { - graphics_handle h = *p; - - if (is_handle_visible (h)) - retval = h; - } - - return retval; - } - - void do_lock (void) { graphics_lock.lock (); } - - bool do_try_lock (void) { return graphics_lock.try_lock (); } - - void do_unlock (void) { graphics_lock.unlock (); } - - void do_execute_listener (const graphics_handle& h, const octave_value& l); - - void do_execute_callback (const graphics_handle& h, const octave_value& cb, - const octave_value& data); - - void do_post_callback (const graphics_handle& h, const std::string name, - const octave_value& data); - - void do_post_function (graphics_event::event_fcn fcn, void* fcn_data); - - void do_post_set (const graphics_handle& h, const std::string name, - const octave_value& value, bool notify_toolkit = true); - - int do_process_events (bool force = false); - - void do_close_all_figures (void); - - static void restore_gcbo (void) - { - if (instance_ok ()) - instance->do_restore_gcbo (); - } - - void do_restore_gcbo (void); - - void do_post_event (const graphics_event& e); - - void do_enable_event_processing (bool enable = true); -}; - -void get_children_limits (double& min_val, double& max_val, - double& min_pos, double& max_neg, - const Matrix& kids, char limit_type); - -OCTINTERP_API int calc_dimensions (const graphics_object& gh); - -// This function is NOT equivalent to the scripting language function gcf. -OCTINTERP_API graphics_handle gcf (void); - -// This function is NOT equivalent to the scripting language function gca. -OCTINTERP_API graphics_handle gca (void); - -OCTINTERP_API void close_all_figures (void); - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/help.cc --- a/libinterp/interpfcn/help.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1513 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include -#include -#include -#include -#include - -#include -#include - -#include "cmd-edit.h" -#include "file-ops.h" -#include "file-stat.h" -#include "oct-env.h" -#include "str-vec.h" - -#include -#include "defun.h" -#include "dirfns.h" -#include "error.h" -#include "gripes.h" -#include "help.h" -#include "input.h" -#include "load-path.h" -#include "oct-obj.h" -#include "ov-usr-fcn.h" -#include "pager.h" -#include "parse.h" -#include "pathsearch.h" -#include "procstream.h" -#include "pt-pr-code.h" -#include "sighandlers.h" -#include "symtab.h" -#include "syswait.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" -#include "version.h" -#include "quit.h" - -// Name of the doc cache file specified on the command line. -// (--doc-cache-file file) -std::string Vdoc_cache_file; - -// Name of the file containing local Texinfo macros that are prepended -// to doc strings before processing. -// (--texi-macros-file) -std::string Vtexi_macros_file; - -// Name of the info file specified on command line. -// (--info-file file) -std::string Vinfo_file; - -// Name of the info reader we'd like to use. -// (--info-program program) -std::string Vinfo_program; - -// Name of the makeinfo program to run. -static std::string Vmakeinfo_program = "makeinfo"; - -// If TRUE, don't print additional help message in help and usage -// functions. -static bool Vsuppress_verbose_help_message = false; - -#include - -typedef std::map map_type; -typedef map_type::value_type pair_type; -typedef map_type::const_iterator map_iter; - -template -std::size_t -size (T const (&)[z]) -{ - return z; -} - -const static pair_type operators[] = -{ - pair_type ("!", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} !\n\ -Logical 'not' operator.\n\ -@seealso{~, not}\n\ -@end deftypefn"), - - pair_type ("~", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ~\n\ -Logical 'not' operator.\n\ -@seealso{!, not}\n\ -@end deftypefn"), - - pair_type ("!=", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} !=\n\ -Logical 'not equals' operator.\n\ -@seealso{~=, ne}\n\ -@end deftypefn"), - - pair_type ("~=", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ~=\n\ -Logical 'not equals' operator.\n\ -@seealso{!=, ne}\n\ -@end deftypefn"), - - pair_type ("\"", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} \"\n\ -String delimiter.\n\ -@end deftypefn"), - - pair_type ("#", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} #\n\ -Begin comment character.\n\ -@seealso{%, #@\\{}\n\ -@end deftypefn"), - - pair_type ("%", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} %\n\ -Begin comment character.\n\ -@seealso{#, %@\\{}\n\ -@end deftypefn"), - - pair_type ("#{", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} #@{\n\ -Begin block comment. There must be nothing else, other than\n\ -whitespace, in the line both before and after @code{#@{}.\n\ -It is possible to nest block comments.\n\ -@seealso{%@\\{, #@\\}, #}\n\ -@end deftypefn"), - - pair_type ("%{", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} %@{\n\ -Begin block comment. There must be nothing else, other than\n\ -whitespace, in the line both before and after @code{%@{}.\n\ -It is possible to nest block comments.\n\ -@seealso{#@\\{, %@\\}, %}\n\ -@end deftypefn"), - - pair_type ("#}", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} #@}\n\ -Close block comment. There must be nothing else, other than\n\ -whitespace, in the line both before and after @code{#@}}.\n\ -It is possible to nest block comments.\n\ -@seealso{%@\\}, #@\\{, #}\n\ -@end deftypefn"), - - pair_type ("%}", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} %@}\n\ -Close block comment. There must be nothing else, other than\n\ -whitespace, in the line both before and after @code{%@}}.\n\ -It is possible to nest block comments.\n\ -@seealso{#@\\}, %@\\{, %}\n\ -@end deftypefn"), - - pair_type ("...", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ...\n\ -Continuation marker. Joins current line with following line.\n\ -@end deftypefn"), - - pair_type ("&", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} &\n\ -Element by element logical 'and' operator.\n\ -@seealso{&&, and}\n\ -@end deftypefn"), - - pair_type ("&&", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} &&\n\ -Logical 'and' operator (with short-circuit evaluation).\n\ -@seealso{&, and}\n\ -@end deftypefn"), - - pair_type ("'", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} '\n\ -Matrix transpose operator. For complex matrices, computes the\n\ -complex conjugate (Hermitian) transpose.\n\ -\n\ -The single quote character may also be used to delimit strings, but\n\ -it is better to use the double quote character, since that is never\n\ -ambiguous.\n\ -@seealso{.', transpose}\n\ -@end deftypefn"), - - pair_type ("(", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} (\n\ -Array index or function argument delimiter.\n\ -@end deftypefn"), - - pair_type (")", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} )\n\ -Array index or function argument delimiter.\n\ -@end deftypefn"), - - pair_type ("*", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} *\n\ -Multiplication operator.\n\ -@seealso{.*, times}\n\ -@end deftypefn"), - - pair_type ("**", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} **\n\ -Power operator. This may return complex results for real inputs. Use\n\ -@code{realsqrt}, @code{cbrt}, @code{nthroot}, or @code{realroot} to obtain\n\ -real results when possible.\n\ -@seealso{power, ^, .**, .^, realpow, realsqrt, cbrt, nthroot}\n\ -@end deftypefn"), - - pair_type ("^", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ^\n\ -Power operator. This may return complex results for real inputs. Use\n\ -@code{realsqrt}, @code{cbrt}, @code{nthroot}, or @code{realroot} to obtain\n\ -real results when possible.\n\ -@seealso{power, **, .^, .**, realpow, realsqrt, cbrt, nthroot}\n\ -@end deftypefn"), - - pair_type ("+", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} +\n\ -Addition operator.\n\ -@seealso{plus}\n\ -@end deftypefn"), - - pair_type ("++", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ++\n\ -Increment operator. As in C, may be applied as a prefix or postfix\n\ -operator.\n\ -@seealso{--}\n\ -@end deftypefn"), - - pair_type (",", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ,\n\ -Array index, function argument, or command separator.\n\ -@end deftypefn"), - - pair_type ("-", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} -\n\ -Subtraction or unary negation operator.\n\ -@seealso{minus}\n\ -@end deftypefn"), - - pair_type ("--", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} --\n\ -Decrement operator. As in C, may be applied as a prefix or postfix\n\ -operator.\n\ -@seealso{++}\n\ -@end deftypefn"), - - pair_type (".'", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} .'\n\ -Matrix transpose operator. For complex matrices, computes the\n\ -transpose, @emph{not} the complex conjugate transpose.\n\ -@seealso{', transpose}\n\ -@end deftypefn"), - - pair_type (".*", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} .*\n\ -Element by element multiplication operator.\n\ -@seealso{*, times}\n\ -@end deftypefn"), - - pair_type (".**", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} .*\n\ -Element by element power operator. If several complex results are possible,\n\ -returns the one with smallest non-negative argument (angle). Use\n\ -@code{realpow}, @code{realsqrt}, @code{cbrt}, or @code{nthroot} if a\n\ -real result is preferred.\n\ -@seealso{**, ^, .^, power, realpow, realsqrt, cbrt, nthroot}\n\ -@end deftypefn"), - - pair_type (".^", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} .^\n\ -Element by element power operator. If several complex results are possible,\n\ -returns the one with smallest non-negative argument (angle). Use\n\ -@code{realpow}, @code{realsqrt}, @code{cbrt}, or @code{nthroot} if a\n\ -real result is preferred.\n\ -@seealso{.**, ^, **, power, realpow, realsqrt, cbrt, nthroot}\n\ -@end deftypefn"), - - pair_type ("./", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ./\n\ -Element by element right division operator.\n\ -@seealso{/, .\\, rdivide, mrdivide}\n\ -@end deftypefn"), - - pair_type ("/", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} /\n\ -Right division operator.\n\ -@seealso{./, \\, rdivide, mrdivide}\n\ -@end deftypefn"), - - pair_type (".\\", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} .\\\n\ -Element by element left division operator.\n\ -@seealso{\\, ./, rdivide, mrdivide}\n\ -@end deftypefn"), - - pair_type ("\\", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} \\\n\ -Left division operator.\n\ -@seealso{.\\, /, ldivide, mldivide}\n\ -@end deftypefn"), - - pair_type (":", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} :\n\ -Select entire rows or columns of matrices.\n\ -@end deftypefn"), - - pair_type (";", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ;\n\ -Array row or command separator.\n\ -@seealso{,}\n\ -@end deftypefn"), - - pair_type ("<", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} <\n\ -'Less than' operator.\n\ -@seealso{lt}\n\ -@end deftypefn"), - - pair_type ("<=", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} <=\n\ -'Less than' or 'equals' operator.\n\ -@seealso{le}\n\ -@end deftypefn"), - - pair_type ("=", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} =\n\ -Assignment operator.\n\ -@end deftypefn"), - - pair_type ("==", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ==\n\ -Equality test operator.\n\ -@seealso{eq}\n\ -@end deftypefn"), - - pair_type (">", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} >\n\ -'Greater than' operator.\n\ -@seealso{gt}\n\ -@end deftypefn"), - - pair_type (">=", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} >=\n\ -'Greater than' or 'equals' operator.\n\ -@seealso{ge}\n\ -@end deftypefn"), - - pair_type ("[", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} [\n\ -Return list delimiter.\n\ -@seealso{]}\n\ -@end deftypefn"), - - pair_type ("]", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ]\n\ -Return list delimiter.\n\ -@seealso{[}\n\ -@end deftypefn"), - - pair_type ("|", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} |\n\ -Element by element logical 'or' operator.\n\ -@seealso{||, or}\n\ -@end deftypefn"), - - pair_type ("||", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ||\n\ -Logical 'or' (with short-circuit evaluation) operator.\n\ -@seealso{|, or}\n\ -@end deftypefn"), -}; - -const static pair_type keywords[] = -{ - pair_type ("break", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} break\n\ -Exit the innermost enclosing do, while or for loop.\n\ -@seealso{do, while, for, parfor, continue}\n\ -@end deftypefn"), - - pair_type ("case", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} case @{@var{value}@}\n\ -A case statement in an switch. Octave cases are exclusive and do not\n\ -fall-through as do C-language cases. A switch statement must have at least\n\ -one case. See @code{switch} for an example.\n\ -@seealso{switch}\n\ -@end deftypefn"), - - pair_type ("catch", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} catch\n\ -Begin the cleanup part of a try-catch block.\n\ -@seealso{try}\n\ -@end deftypefn"), - - pair_type ("continue", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} continue\n\ -Jump to the end of the innermost enclosing do, while or for loop.\n\ -@seealso{do, while, for, parfor, break}\n\ -@end deftypefn"), - - pair_type ("do", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} do\n\ -Begin a do-until loop. This differs from a do-while loop in that the\n\ -body of the loop is executed at least once.\n\ -\n\ -@example\n\ -@group\n\ -i = 0;\n\ -do\n\ - i++\n\ -until (i == 10)\n\ -@end group\n\ -@end example\n\ -@seealso{for, until, while}\n\ -@end deftypefn"), - - pair_type ("else", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} else\n\ -Alternate action for an if block. See @code{if} for an example.\n\ -@seealso{if}\n\ -@end deftypefn"), - - pair_type ("elseif", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} elseif (@var{condition})\n\ -Alternate conditional test for an if block. See @code{if} for an example.\n\ -@seealso{if}\n\ -@end deftypefn"), - - pair_type ("end", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} end\n\ -Mark the end of any @code{for}, @code{if}, @code{do}, @code{while}, or\n\ -@code{function} block.\n\ -@seealso{for, parfor, if, do, while, function}\n\ -@end deftypefn"), - - pair_type ("end_try_catch", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} end_try_catch\n\ -Mark the end of an @code{try-catch} block.\n\ -@seealso{try, catch}\n\ -@end deftypefn"), - - pair_type ("end_unwind_protect", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} end_unwind_protect\n\ -Mark the end of an unwind_protect block.\n\ -@seealso{unwind_protect}\n\ -@end deftypefn"), - - pair_type ("endfor", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} endfor\n\ -Mark the end of a for loop. See @code{for} for an example.\n\ -@seealso{for}\n\ -@end deftypefn"), - - pair_type ("endfunction", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} endfunction\n\ -Mark the end of a function.\n\ -@seealso{function}\n\ -@end deftypefn"), - - pair_type ("endif", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} endif\n\ -Mark the end of an if block. See @code{if} for an example.\n\ -@seealso{if}\n\ -@end deftypefn"), - - pair_type ("endparfor", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} endparfor\n\ -Mark the end of a parfor loop. See @code{parfor} for an example.\n\ -@seealso{parfor}\n\ -@end deftypefn"), - - pair_type ("endswitch", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} endswitch\n\ -Mark the end of a switch block. See @code{switch} for an example.\n\ -@seealso{switch}\n\ -@end deftypefn"), - - pair_type ("endwhile", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} endwhile\n\ -Mark the end of a while loop. See @code{while} for an example.\n\ -@seealso{do, while}\n\ -@end deftypefn"), - - pair_type ("for", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} for @var{i} = @var{range}\n\ -Begin a for loop.\n\ -\n\ -@example\n\ -@group\n\ -for i = 1:10\n\ - i\n\ -endfor\n\ -@end group\n\ -@end example\n\ -@seealso{do, parfor, while}\n\ -@end deftypefn"), - - pair_type ("function", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} function @var{outputs} = function (@var{input}, @dots{})\n\ -@deftypefnx {Keyword} {} function {} function (@var{input}, @dots{})\n\ -@deftypefnx {Keyword} {} function @var{outputs} = function\n\ -Begin a function body with @var{outputs} as results and @var{inputs} as\n\ -parameters.\n\ -@seealso{return}\n\ -@end deftypefn"), - - pair_type ("global", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} global\n\ -Declare variables to have global scope.\n\ -\n\ -@example\n\ -@group\n\ -global @var{x};\n\ -if (isempty (@var{x}))\n\ - x = 1;\n\ -endif\n\ -@end group\n\ -@end example\n\ -@seealso{persistent}\n\ -@end deftypefn"), - - pair_type ("if", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} if (@var{cond}) @dots{} endif\n\ -@deftypefnx {Keyword} {} if (@var{cond}) @dots{} else @dots{} endif\n\ -@deftypefnx {Keyword} {} if (@var{cond}) @dots{} elseif (@var{cond}) @dots{} endif\n\ -@deftypefnx {Keyword} {} if (@var{cond}) @dots{} elseif (@var{cond}) @dots{} else @dots{} endif\n\ -Begin an if block.\n\ -\n\ -@example\n\ -@group\n\ -x = 1;\n\ -if (x == 1)\n\ - disp (\"one\");\n\ -elseif (x == 2)\n\ - disp (\"two\");\n\ -else\n\ - disp (\"not one or two\");\n\ -endif\n\ -@end group\n\ -@end example\n\ -@seealso{switch}\n\ -@end deftypefn"), - - pair_type ("otherwise", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} otherwise\n\ -The default statement in a switch block (similar to else in an if block).\n\ -@seealso{switch}\n\ -@end deftypefn"), - - pair_type ("parfor", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} for @var{i} = @var{range}\n\ -@deftypefnx {Keyword} {} for (@var{i} = @var{range}, @var{maxproc})\n\ -Begin a for loop that may execute in parallel.\n\ -\n\ -@example\n\ -@group\n\ -parfor i = 1:10\n\ - i\n\ -endparfor\n\ -@end group\n\ -@end example\n\ -@seealso{for, do, while}\n\ -@end deftypefn"), - - pair_type ("persistent", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} persistent @var{var}\n\ -Declare variables as persistent. A variable that has been declared\n\ -persistent within a function will retain its contents in memory between\n\ -subsequent calls to the same function. The difference between persistent\n\ -variables and global variables is that persistent variables are local in \n\ -scope to a particular function and are not visible elsewhere.\n\ -@seealso{global}\n\ -@end deftypefn"), - - pair_type ("return", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} return\n\ -Return from a function.\n\ -@seealso{function}\n\ -@end deftypefn"), - - pair_type ("static", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} static\n\ -This function has been deprecated in favor of persistent.\n\ -@seealso{persistent}\n\ -@end deftypefn"), - - pair_type ("switch", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} switch @var{statement}\n\ -Begin a switch block.\n\ -\n\ -@example\n\ -@group\n\ -yesno = \"yes\"\n\ -\n\ -switch yesno\n\ - case @{\"Yes\" \"yes\" \"YES\" \"y\" \"Y\"@}\n\ - value = 1;\n\ - case @{\"No\" \"no\" \"NO\" \"n\" \"N\"@}\n\ - value = 0;\n\ - otherwise\n\ - error (\"invalid value\");\n\ -endswitch\n\ -@end group\n\ -@end example\n\ -@seealso{if, case, otherwise}\n\ -@end deftypefn"), - - pair_type ("try", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} try\n\ -Begin a try-catch block.\n\ -\n\ -If an error occurs within a try block, then the catch code will be run and\n\ -execution will proceed after the catch block (though it is often\n\ -recommended to use the lasterr function to re-throw the error after cleanup\n\ -is completed).\n\ -@seealso{catch, unwind_protect}\n\ -@end deftypefn"), - - pair_type ("until", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} until\n\ -End a do-until loop. See @code{do} for an example.\n\ -@seealso{do}\n\ -@end deftypefn"), - - pair_type ("unwind_protect", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} unwind_protect\n\ -Begin an unwind_protect block.\n\ -\n\ -If an error occurs within the first part of an unwind_protect block\n\ -the commands within the unwind_protect_cleanup block are executed before\n\ -the error is thrown. If an error is not thrown, then the\n\ -unwind_protect_cleanup block is still executed (in other words, the\n\ -unwind_protect_cleanup will be run with or without an error in the\n\ -unwind_protect block).\n\ -@seealso{unwind_protect_cleanup, try}\n\ -@end deftypefn"), - - pair_type ("unwind_protect_cleanup", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} unwind_protect_cleanup\n\ -Begin the cleanup section of an unwind_protect block.\n\ -@seealso{unwind_protect}\n\ -@end deftypefn"), - - pair_type ("varargin", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} varargin\n\ -Pass an arbitrary number of arguments into a function.\n\ -@seealso{varargout, nargin, isargout, nargout, nthargout}\n\ -@end deftypefn"), - - pair_type ("varargout", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} varargout\n\ -Pass an arbitrary number of arguments out of a function.\n\ -@seealso{varargin, nargin, isargout, nargout, nthargout}\n\ -@end deftypefn"), - - pair_type ("while", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} while\n\ -Begin a while loop.\n\ -\n\ -@example\n\ -@group\n\ -i = 0;\n\ -while (i < 10)\n\ - i++\n\ -endwhile\n\ -@end group\n\ -@end example\n\ -@seealso{do, endwhile, for, until}\n\ -@end deftypefn"), -}; - -// Return a copy of the operator or keyword names. -static string_vector -names (const map_type& lst) -{ - string_vector retval (lst.size ()); - int j = 0; - for (map_iter iter = lst.begin (); iter != lst.end (); iter ++) - retval[j++] = iter->first; - return retval; -} - -const static map_type operators_map (operators, operators + size (operators)); -const static map_type keywords_map (keywords, keywords + size (keywords)); -const static string_vector keyword_names = names (keywords_map); - -// FIXME -- It's not likely that this does the right thing now. - -string_vector -make_name_list (void) -{ - const int key_len = keyword_names.length (); - - const string_vector bif = symbol_table::built_in_function_names (); - const int bif_len = bif.length (); - - const string_vector cfl = symbol_table::cmdline_function_names (); - const int cfl_len = cfl.length (); - - const string_vector lcl = symbol_table::variable_names (); - const int lcl_len = lcl.length (); - - const string_vector ffl = load_path::fcn_names (); - const int ffl_len = ffl.length (); - - const string_vector afl = autoloaded_functions (); - const int afl_len = afl.length (); - - const int total_len - = key_len + bif_len + cfl_len + lcl_len + ffl_len + afl_len; - - string_vector list (total_len); - - // Put all the symbols in one big list. - - int j = 0; - int i = 0; - for (i = 0; i < key_len; i++) - list[j++] = keyword_names[i]; - - for (i = 0; i < bif_len; i++) - list[j++] = bif[i]; - - for (i = 0; i < cfl_len; i++) - list[j++] = cfl[i]; - - for (i = 0; i < lcl_len; i++) - list[j++] = lcl[i]; - - for (i = 0; i < ffl_len; i++) - list[j++] = ffl[i]; - - for (i = 0; i < afl_len; i++) - list[j++] = afl[i]; - - return list; -} - -static bool -looks_like_html (const std::string& msg) -{ - const size_t p1 = msg.find ('\n'); - std::string t = msg.substr (0, p1); - const size_t p2 = t.find ("doc_string (); - - retval = true; - - w = fcn->fcn_file_name (); - - if (w.empty ()) - w = fcn->is_user_function () - ? "command-line function" : "built-in function"; - } - } - - return retval; -} - -static bool -raw_help_from_file (const std::string& nm, std::string& h, - std::string& file, bool& symbol_found) -{ - bool retval = false; - - h = get_help_from_file (nm, symbol_found, file); - - if (h.length () > 0) - retval = true; - - return retval; -} - -static bool -raw_help_from_map (const std::string& nm, std::string& h, - const map_type& map, bool& symbol_found) -{ - map_iter idx = map.find (nm); - symbol_found = (idx != map.end ()); - h = (symbol_found) ? idx->second : ""; - return symbol_found; -} - -std::string -raw_help (const std::string& nm, bool& symbol_found) -{ - std::string h; - std::string w; - std::string f; - - (raw_help_from_symbol_table (nm, h, w, symbol_found) - || raw_help_from_file (nm, h, f, symbol_found) - || raw_help_from_map (nm, h, operators_map, symbol_found) - || raw_help_from_map (nm, h, keywords_map, symbol_found)); - - return h; -} - -DEFUN (built_in_docstrings_file, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} built_in_docstrings_file ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} built_in_docstrings_file (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} built_in_docstrings_file (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the name of the\n\ -file containing docstrings for built-in Octave functions.\n\ -The default value is\n\ -@file{@var{octave-home}/share/octave/@var{version}/etc/built-in-docstrings},\n\ -in which @var{octave-home} is the root directory of the Octave installation,\n\ -and @var{version} is the Octave version number.\n\ -The default value may be overridden by the environment variable\n\ -@w{@env{OCTAVE_BUILT_IN_DOCSTRINGS_FILE}}, or the command line argument\n\ -@samp{--built-in-docstrings-file FNAME}.\n\ -\n\ -Note: This variable is only used when Octave is initializing itself.\n\ -Modifying it during a running session of Octave will have no effect.\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (built_in_docstrings_file); -} - -void -install_built_in_docstrings (void) -{ - std::string fname = Vbuilt_in_docstrings_file; - - std::ifstream file (fname.c_str (), std::ios::in | std::ios::binary); - - if (file) - { - // Ignore header; - file.ignore (1000, 0x1f); - - if (file.gcount () == 1000) - { - // We use std::cerr here instead of calling Octave's warning - // function because install_built_in_docstrings is called - // before the interpreter is initialized, so warning messages - // won't work properly. - - std::cerr << "warning: is builtin-docstrings file corrupted?" - << std::endl; - return; - } - - // FIXME -- eliminate fixed buffer size. - size_t bufsize = 100000; - - OCTAVE_LOCAL_BUFFER (char, buf, bufsize); - - while (! file.eof ()) - { - file.getline (buf, bufsize, 0x1f); - - std::string tmp (buf); - - size_t pos = tmp.find ('\n'); - - std::string fcn = tmp.substr (0, pos); - - octave_value ov = symbol_table::find_built_in_function (fcn); - - if (ov.is_defined ()) - { - octave_function *fp = ov.function_value (); - - if (fp) - { - tmp = tmp.substr (pos+1); - - // Strip @c FILENAME which is part of current DOCSTRINGS - // syntax. This may disappear if a specific format for - // docstring files is developed. - while (tmp.length () > 2 && tmp[0] == '@' && tmp[1] == 'c') - { - pos = tmp.find ('\n'); - tmp = tmp.substr (pos+1); - } - - fp->document (tmp); - } - } - } - } - else - { - // See note above about using std::cerr instead of warning. - - std::cerr << "warning: docstring file '" << fname << "' not found" - << std::endl; - } - -} - -static void -do_get_help_text (const std::string& name, std::string& text, - std::string& format) -{ - bool symbol_found = false; - text = raw_help (name, symbol_found); - - format = "Not found"; - if (symbol_found) - { - size_t idx = -1; - if (text.empty ()) - { - format = "Not documented"; - } - else if (looks_like_texinfo (text, idx)) - { - format = "texinfo"; - text.erase (0, idx); - } - else if (looks_like_html (text)) - { - format = "html"; - } - else - { - format = "plain text"; - } - } -} - -DEFUN (get_help_text, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{text}, @var{format}] =} get_help_text (@var{name})\n\ -Return the raw help text of function @var{name}.\n\ -\n\ -The raw help text is returned in @var{text} and the format in @var{format}\n\ -The format is a string which is one of @t{\"texinfo\"}, @t{\"html\"}, or\n\ -@t{\"plain text\"}.\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - const std::string name = args (0).string_value (); - - if (! error_state) - { - std::string text; - std::string format; - - do_get_help_text (name, text, format); - - retval(1) = format; - retval(0) = text; - } - else - error ("get_help_text: invalid input"); - } - else - print_usage (); - - return retval; -} - -static void -do_get_help_text_from_file (const std::string& fname, std::string& text, - std::string& format) -{ - bool symbol_found = false; - - std::string f; - - raw_help_from_file (fname, text, f, symbol_found); - - format = "Not found"; - if (symbol_found) - { - size_t idx = -1; - if (text.empty ()) - { - format = "Not documented"; - } - else if (looks_like_texinfo (text, idx)) - { - format = "texinfo"; - text.erase (0, idx); - } - else if (looks_like_html (text)) - { - format = "html"; - } - else - { - format = "plain text"; - } - } -} - -DEFUN (get_help_text_from_file, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{text}, @var{format}] =} get_help_text_from_file (@var{fname})\n\ -Return the raw help text from the file @var{fname}.\n\ -\n\ -The raw help text is returned in @var{text} and the format in @var{format}\n\ -The format is a string which is one of @t{\"texinfo\"}, @t{\"html\"}, or\n\ -@t{\"plain text\"}.\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - const std::string fname = args(0).string_value (); - - if (! error_state) - { - std::string text; - std::string format; - - do_get_help_text_from_file (fname, text, format); - - retval(1) = format; - retval(0) = text; - } - else - error ("get_help_text_from_file: invalid input"); - } - else - print_usage (); - - return retval; -} - -// Return a cell array of strings containing the names of all -// operators. - -DEFUN (__operators__, , , - "-*- texinfo -*-\n\ -@deftypefn {Function File} __operators__ ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - return octave_value (Cell (names (operators_map))); -} - -// Return a cell array of strings containing the names of all -// keywords. - -DEFUN (__keywords__, , , - "-*- texinfo -*-\n\ -@deftypefn {Function File} __keywords__ ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - return octave_value (Cell (names (keywords_map))); -} - -// Return a cell array of strings containing the names of all builtin -// functions. - -DEFUN (__builtins__, , , - "-*- texinfo -*-\n\ -@deftypefn {Function File} __builtins__ ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - const string_vector bif = symbol_table::built_in_function_names (); - - return octave_value (Cell (bif)); -} - -static std::string -do_which (const std::string& name, std::string& type) -{ - std::string file; - - type = std::string (); - - octave_value val = symbol_table::find_function (name); - - if (name.find_first_of ('.') == std::string::npos) - { - if (val.is_defined ()) - { - octave_function *fcn = val.function_value (); - - if (fcn) - { - file = fcn->fcn_file_name (); - - if (file.empty ()) - { - if (fcn->is_user_function ()) - type = "command-line function"; - else - { - file = fcn->src_file_name (); - type = "built-in function"; - } - } - else - type = val.is_user_script () - ? std::string ("script") : std::string ("function"); - } - } - else - { - // We might find a file that contains only a doc string. - - file = load_path::find_fcn_file (name); - } - } - else - { - // File query. - - // For compatibility: "file." queries "file". - if (name.size () > 1 && name[name.size () - 1] == '.') - file = load_path::find_file (name.substr (0, name.size () - 1)); - else - file = load_path::find_file (name); - } - - - return file; -} - -std::string -do_which (const std::string& name) -{ - std::string retval; - - std::string type; - - retval = do_which (name, type); - - return retval; -} - -DEFUN (__which__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __which__ (@var{name}, @dots{})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - string_vector argv = args.make_argv ("which"); - - if (! error_state) - { - int argc = argv.length (); - - if (argc > 1) - { - octave_map m (dim_vector (1, argc-1)); - - Cell names (1, argc-1); - Cell files (1, argc-1); - Cell types (1, argc-1); - - for (int i = 1; i < argc; i++) - { - std::string name = argv[i]; - - std::string type; - - std::string file = do_which (name, type); - - names(i-1) = name; - files(i-1) = file; - types(i-1) = type; - } - - m.assign ("name", names); - m.assign ("file", files); - m.assign ("type", types); - - retval = m; - } - else - print_usage (); - } - - return retval; -} - -// FIXME -- Are we sure this function always does the right thing? -inline bool -file_is_in_dir (const std::string filename, const std::string dir) -{ - if (filename.find (dir) == 0) - { - const int dir_len = dir.size (); - const int filename_len = filename.size (); - const int max_allowed_seps = file_ops::is_dir_sep (dir[dir_len-1]) ? 0 : 1; - - int num_seps = 0; - for (int i = dir_len; i < filename_len; i++) - if (file_ops::is_dir_sep (filename[i])) - num_seps ++; - - return (num_seps <= max_allowed_seps); - } - else - return false; -} - -// Return a cell array of strings containing the names of all -// functions available in DIRECTORY. If no directory is given, search -// the current path. - -DEFUN (__list_functions__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Function File} {@var{retval} =} __list_functions__ ()\n\ -@deftypefnx {Function File} {@var{retval} =} __list_functions__ (@var{directory})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - // Get list of functions - string_vector ffl = load_path::fcn_names (); - string_vector afl = autoloaded_functions (); - - if (args.length () == 0) - retval = Cell (ffl.append (afl)); - else - { - std::string dir = args (0).string_value (); - - if (! error_state) - { - string_vector fl = load_path::files (dir, true); - - if (! error_state) - { - // Return a sorted list with unique entries (in case of - // .m and .oct versions of the same function in a given - // directory, for example). - fl.sort (true); - - retval = Cell (fl); - } - } - else - error ("__list_functions__: DIRECTORY argument must be a string"); - } - - return retval; -} - -DEFUN (doc_cache_file, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} doc_cache_file ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} doc_cache_file (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} doc_cache_file (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the name of the\n\ -Octave documentation cache file. A cache file significantly improves\n\ -the performance of the @code{lookfor} command. The default value is \n\ -@file{@var{octave-home}/share/octave/@var{version}/etc/doc-cache},\n\ -in which @var{octave-home} is the root directory of the Octave installation,\n\ -and @var{version} is the Octave version number.\n\ -The default value may be overridden by the environment variable\n\ -@w{@env{OCTAVE_DOC_CACHE_FILE}}, or the command line argument\n\ -@samp{--doc-cache-file FNAME}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{doc_cache_create, lookfor, info_program, doc, help, makeinfo_program}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (doc_cache_file); -} - -DEFUN (texi_macros_file, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} texi_macros_file ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} texi_macros_file (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} texi_macros_file (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the name of the\n\ -file containing Texinfo macros that are prepended to documentation strings\n\ -before they are passed to makeinfo. The default value is \n\ -@file{@var{octave-home}/share/octave/@var{version}/etc/macros.texi},\n\ -in which @var{octave-home} is the root directory of the Octave installation,\n\ -and @var{version} is the Octave version number.\n\ -The default value may be overridden by the environment variable\n\ -@w{@env{OCTAVE_TEXI_MACROS_FILE}}, or the command line argument\n\ -@samp{--texi-macros-file FNAME}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{makeinfo_program}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (texi_macros_file); -} - -DEFUN (info_file, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} info_file ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} info_file (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} info_file (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the name of the\n\ -Octave info file. The default value is\n\ -@file{@var{octave-home}/info/octave.info}, in\n\ -which @var{octave-home} is the root directory of the Octave installation.\n\ -The default value may be overridden by the environment variable\n\ -@w{@env{OCTAVE_INFO_FILE}}, or the command line argument\n\ -@samp{--info-file FNAME}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{info_program, doc, help, makeinfo_program}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (info_file); -} - -DEFUN (info_program, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} info_program ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} info_program (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} info_program (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the name of the\n\ -info program to run. The default value is\n\ -@file{@var{octave-home}/libexec/octave/@var{version}/exec/@var{arch}/info}\n\ -in which @var{octave-home} is the root directory of the Octave installation,\n\ -@var{version} is the Octave version number, and @var{arch}\n\ -is the system type (for example, @code{i686-pc-linux-gnu}). The\n\ -default value may be overridden by the environment variable\n\ -@w{@env{OCTAVE_INFO_PROGRAM}}, or the command line argument\n\ -@samp{--info-program NAME}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{info_file, doc, help, makeinfo_program}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (info_program); -} - -DEFUN (makeinfo_program, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} makeinfo_program ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} makeinfo_program (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} makeinfo_program (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the name of the\n\ -program that Octave runs to format help text containing\n\ -Texinfo markup commands. The default value is @code{makeinfo}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{texi_macros_file, info_file, info_program, doc, help}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (makeinfo_program); -} - -DEFUN (suppress_verbose_help_message, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} suppress_verbose_help_message ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} suppress_verbose_help_message (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} suppress_verbose_help_message (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave\n\ -will add additional help information to the end of the output from\n\ -the @code{help} command and usage messages for built-in commands.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (suppress_verbose_help_message); -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/help.h --- a/libinterp/interpfcn/help.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,56 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_help_h) -#define octave_help_h 1 - -#include -#include - -class string_vector; - -extern string_vector make_name_list (void); - -extern OCTINTERP_API std::string raw_help (const std::string&, bool&); - -extern OCTINTERP_API void install_built_in_docstrings (void); - -// Name of the doc cache file specified on the command line. -// (--doc-cache-file file) -extern OCTINTERP_API std::string Vdoc_cache_file; - -// Name of the file containing local Texinfo macros that are prepended -// to doc strings before processing. -// (--texi-macros-file) -extern OCTINTERP_API std::string Vtexi_macros_file; - -// Name of the info file specified on command line. -// (--info-file file) -extern OCTINTERP_API std::string Vinfo_file; - -// Name of the info reader we'd like to use. -// (--info-program program) -extern OCTINTERP_API std::string Vinfo_program; - -extern OCTINTERP_API std::string do_which (const std::string& name); - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/hook-fcn.cc --- a/libinterp/interpfcn/hook-fcn.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,41 +0,0 @@ -/* - -Copyright (C) 2013 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#include - -#include "hook-fcn.h" - -hook_function::hook_function (const octave_value& f, const octave_value& d) -{ - if (f.is_string ()) - { - std::string name = f.string_value (); - - rep = new named_hook_function (name, d); - } - else if (f.is_function_handle ()) - { - rep = new fcn_handle_hook_function (f, d); - } - else - error ("invalid hook function"); -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/hook-fcn.h --- a/libinterp/interpfcn/hook-fcn.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,262 +0,0 @@ -/* - -Copyright (C) 2013 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_hook_fcn_h) -#define octave_hook_fcn_h 1 - -#include - -#include "oct-obj.h" -#include "ov.h" -#include "ov-fcn-handle.h" -#include "parse.h" -#include "variables.h" - -class -base_hook_function -{ -public: - - friend class hook_function; - - base_hook_function (void) : count (1) { } - - base_hook_function (const base_hook_function&) : count (1) { } - - virtual ~base_hook_function (void) { } - - virtual std::string id (void) { return std::string (); } - - virtual bool is_valid (void) { return false; } - - virtual void eval (const octave_value_list&) { } - -protected: - - size_t count; -}; - -class -hook_function -{ -public: - - hook_function (void) - { - static base_hook_function nil_rep; - rep = &nil_rep; - rep->count++; - } - - hook_function (const octave_value& f, - const octave_value& d = octave_value ()); - - ~hook_function (void) - { - if (--rep->count == 0) - delete rep; - } - - hook_function (const hook_function& hf) - : rep (hf.rep) - { - rep->count++; - } - - hook_function& operator = (const hook_function& hf) - { - if (rep != hf.rep) - { - if (--rep->count == 0) - delete rep; - - rep = hf.rep; - rep->count++; - } - - return *this; - } - - std::string id (void) { return rep->id (); } - - bool is_valid (void) { return rep->is_valid (); } - - void eval (const octave_value_list& initial_args) - { - rep->eval (initial_args); - } - -private: - - base_hook_function *rep; -}; - -class -named_hook_function : public base_hook_function -{ -public: - - named_hook_function (const std::string& n, const octave_value& d) - : name (n), data (d) - { } - - void eval (const octave_value_list& initial_args) - { - octave_value_list args = initial_args; - - if (data.is_defined ()) - args.append (data); - - feval (name, args, 0); - } - - std::string id (void) { return name; } - - bool is_valid (void) { return is_valid_function (name); } - -private: - - std::string name; - - octave_value data; -}; - -class -fcn_handle_hook_function : public base_hook_function -{ -public: - - fcn_handle_hook_function (const octave_value& fh_arg, const octave_value& d) - : ident (), valid (false), fcn_handle (fh_arg), data (d) - { - octave_fcn_handle *fh = fcn_handle.fcn_handle_value (true); - - if (fh) - { - valid = true; - - std::ostringstream buf; - buf << fh; - ident = fh->fcn_name () + ":" + buf.str (); - } - } - - void eval (const octave_value_list& initial_args) - { - octave_value_list args = initial_args; - - if (data.is_defined ()) - args.append (data); - - fcn_handle.do_multi_index_op (0, args); - } - - std::string id (void) { return ident; } - - bool is_valid (void) { return valid; } - -private: - - std::string ident; - - bool valid; - - octave_value fcn_handle; - - octave_value data; -}; - -class -hook_function_list -{ -public: - - typedef std::map map_type; - - typedef map_type::iterator iterator; - typedef map_type::const_iterator const_iterator; - - hook_function_list (void) : fcn_map () { } - - ~hook_function_list (void) { } - - hook_function_list (const hook_function_list& lst) - : fcn_map (lst.fcn_map) - { } - - hook_function_list& operator = (const hook_function_list& lst) - { - if (&lst != this) - fcn_map = lst.fcn_map; - - return *this; - } - - bool empty (void) const { return fcn_map.empty (); } - - void clear (void) { fcn_map.clear (); } - - void insert (const std::string& id, const hook_function& f) - { - fcn_map[id] = f; - } - - iterator find (const std::string& id) - { - return fcn_map.find (id); - } - - const_iterator find (const std::string& id) const - { - return fcn_map.find (id); - } - - iterator end (void) { return fcn_map.end (); } - - const_iterator end (void) const { return fcn_map.end (); } - - void erase (iterator p) { fcn_map.erase (p); } - - void run (const octave_value_list& initial_args = octave_value_list ()) - { - iterator p = fcn_map.begin (); - - while (p != fcn_map.end ()) - { - std::string hook_fcn_id = p->first; - hook_function hook_fcn = p->second; - - iterator q = p++; - - if (hook_fcn.is_valid ()) - hook_fcn.eval (initial_args); - else - fcn_map.erase (q); - } - } - -private: - - map_type fcn_map; -}; - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/input.cc --- a/libinterp/interpfcn/input.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1436 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Get command input interactively or from files. - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include -#include - -#include -#include -#include - -#include -#include - -#include "cmd-edit.h" -#include "file-ops.h" -#include "quit.h" -#include "str-vec.h" - -#include "debug.h" -#include "defun.h" -#include "dirfns.h" -#include "error.h" -#include "gripes.h" -#include "help.h" -#include "hook-fcn.h" -#include "input.h" -#include "lex.h" -#include "load-path.h" -#include "octave-link.h" -#include "oct-map.h" -#include "oct-hist.h" -#include "toplev.h" -#include "octave-link.h" -#include "oct-obj.h" -#include "ov-fcn-handle.h" -#include "pager.h" -#include "parse.h" -#include "pathlen.h" -#include "pt.h" -#include "pt-const.h" -#include "pt-eval.h" -#include "pt-stmt.h" -#include "sighandlers.h" -#include "symtab.h" -#include "sysdep.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" - -// Primary prompt string. -static std::string VPS1; - -// Secondary prompt string. -static std::string VPS2; - -// String printed before echoed input (enabled by --echo-input). -std::string VPS4 = "+ "; - -// Echo commands as they are executed? -// -// 1 ==> echo commands read from script files -// 2 ==> echo commands from functions -// 4 ==> echo commands read from command line -// -// more than one state can be active at once. -int Vecho_executing_commands = ECHO_OFF; - -// The time we last printed a prompt. -octave_time Vlast_prompt_time = 0.0; - -// Character to append after successful command-line completion attempts. -static char Vcompletion_append_char = ' '; - -// TRUE means this is an interactive shell. -bool interactive = false; - -// TRUE means the user forced this shell to be interactive (-i). -bool forced_interactive = false; - -// TRUE after a call to completion_matches. -bool octave_completion_matches_called = false; - -// TRUE if the plotting system has requested a call to drawnow at -// the next user prompt. -bool Vdrawnow_requested = false; - -// TRUE if we are in debugging mode. -bool Vdebugging = false; - -// If we are in debugging mode, this is the last command entered, so -// that we can repeat the previous command if the user just types RET. -static std::string last_debugging_command = "\n"; - -// TRUE if we are running in the Emacs GUD mode. -static bool Vgud_mode = false; - -// The filemarker used to separate filenames from subfunction names -char Vfilemarker = '>'; - -static hook_function_list input_event_hook_functions; - -// For octave_quit. -void -remove_input_event_hook_functions (void) -{ - input_event_hook_functions.clear (); -} - -void -set_default_prompts (void) -{ - VPS1 = "\\s:\\#> "; - VPS2 = "> "; - VPS4 = "+ "; - - octave_link::set_default_prompts (VPS1, VPS2, VPS4); -} - -void -octave_base_reader::do_input_echo (const std::string& input_string) const -{ - int do_echo = LEXER->reading_script_file ? - (Vecho_executing_commands & ECHO_SCRIPTS) - : (Vecho_executing_commands & ECHO_CMD_LINE) && ! forced_interactive; - - if (do_echo) - { - if (forced_interactive) - { - if (pflag > 0) - octave_stdout << command_editor::decode_prompt_string (VPS1); - else - octave_stdout << command_editor::decode_prompt_string (VPS2); - } - else - octave_stdout << command_editor::decode_prompt_string (VPS4); - - if (! input_string.empty ()) - { - octave_stdout << input_string; - - if (input_string[input_string.length () - 1] != '\n') - octave_stdout << "\n"; - } - } -} - -static std::string -gnu_readline (const std::string& s, bool& eof) -{ - octave_quit (); - - eof = false; - - std::string retval = command_editor::readline (s, eof); - - if (! eof && retval.empty ()) - retval = "\n"; - - return retval; -} - -static inline std::string -interactive_input (const std::string& s, bool& eof) -{ - Vlast_prompt_time.stamp (); - - if (Vdrawnow_requested && (interactive || forced_interactive)) - { - feval ("drawnow"); - - flush_octave_stdout (); - - // We set Vdrawnow_requested to false even if there is an error - // in drawnow so that the error doesn't reappear at every prompt. - - Vdrawnow_requested = false; - - if (error_state) - return "\n"; - } - - return gnu_readline (s, eof); -} - -std::string -octave_base_reader::octave_gets (bool& eof) -{ - octave_quit (); - - eof = false; - - std::string retval; - - // Process pre input event hook function prior to flushing output and - // printing the prompt. - - if (interactive || forced_interactive) - { - if (! Vdebugging) - octave_link::exit_debugger_event (); - - octave_link::pre_input_event (); - - octave_link::set_workspace (); - } - - bool history_skip_auto_repeated_debugging_command = false; - - std::string ps = (pflag > 0) ? VPS1 : VPS2; - - std::string prompt = command_editor::decode_prompt_string (ps); - - pipe_handler_error_count = 0; - - flush_octave_stdout (); - - octave_pager_stream::reset (); - octave_diary_stream::reset (); - - octave_diary << prompt; - - retval = interactive_input (prompt, eof); - - // There is no need to update the load_path cache if there is no - // user input. - if (retval != "\n" - && retval.find_first_not_of (" \t\n\r") != std::string::npos) - { - load_path::update (); - - if (Vdebugging) - last_debugging_command = retval; - else - last_debugging_command = "\n"; - } - else if (Vdebugging) - { - retval = last_debugging_command; - history_skip_auto_repeated_debugging_command = true; - } - - if (retval != "\n") - { - if (! history_skip_auto_repeated_debugging_command) - { - command_history::add (retval); - - if (! command_history::ignoring_entries ()) - octave_link::append_history (retval); - } - - octave_diary << retval; - - if (retval[retval.length () - 1] != '\n') - octave_diary << "\n"; - - do_input_echo (retval); - } - else - octave_diary << "\n"; - - // Process post input event hook function after the internal history - // list has been updated. - - if (interactive || forced_interactive) - octave_link::post_input_event (); - - return retval; -} - -// Fix things up so that input can come from the standard input. This -// may need to become much more complicated, which is why it's in a -// separate function. - -FILE * -get_input_from_stdin (void) -{ - command_editor::set_input_stream (stdin); - return command_editor::get_input_stream (); -} - -// FIXME -- make this generate file names when appropriate. - -static string_vector -generate_possible_completions (const std::string& text, std::string& prefix, - std::string& hint) -{ - string_vector names; - - prefix = ""; - - if (looks_like_struct (text)) - names = generate_struct_completions (text, prefix, hint); - else - names = make_name_list (); - - // Sort and remove duplicates. - - names.sort (true); - - return names; -} - -static bool -is_completing_dirfns (void) -{ - static std::string dirfns_commands[] = {"cd", "ls"}; - static const size_t dirfns_commands_length = 2; - - bool retval = false; - - std::string line = command_editor::get_line_buffer (); - - for (size_t i = 0; i < dirfns_commands_length; i++) - { - int index = line.find (dirfns_commands[i] + " "); - - if (index == 0) - { - retval = true; - break; - } - } - - return retval; -} - -static std::string -generate_completion (const std::string& text, int state) -{ - std::string retval; - - static std::string prefix; - static std::string hint; - - static size_t hint_len = 0; - - static int list_index = 0; - static int name_list_len = 0; - static int name_list_total_len = 0; - static string_vector name_list; - static string_vector file_name_list; - - static int matches = 0; - - if (state == 0) - { - list_index = 0; - - prefix = ""; - - hint = text; - - // No reason to display symbols while completing a - // file/directory operation. - - if (is_completing_dirfns ()) - name_list = string_vector (); - else - name_list = generate_possible_completions (text, prefix, hint); - - name_list_len = name_list.length (); - - file_name_list = command_editor::generate_filename_completions (text); - - name_list.append (file_name_list); - - name_list_total_len = name_list.length (); - - hint_len = hint.length (); - - matches = 0; - - for (int i = 0; i < name_list_len; i++) - if (hint == name_list[i].substr (0, hint_len)) - matches++; - } - - if (name_list_total_len > 0 && matches > 0) - { - while (list_index < name_list_total_len) - { - std::string name = name_list[list_index]; - - list_index++; - - if (hint == name.substr (0, hint_len)) - { - if (list_index <= name_list_len && ! prefix.empty ()) - retval = prefix + "." + name; - else - retval = name; - - // FIXME -- looks_like_struct is broken for now, - // so it always returns false. - - if (matches == 1 && looks_like_struct (retval)) - { - // Don't append anything, since we don't know - // whether it should be '(' or '.'. - - command_editor::set_completion_append_character ('\0'); - } - else - command_editor::set_completion_append_character - (Vcompletion_append_char); - - break; - } - } - } - - return retval; -} - -static std::string -quoting_filename (const std::string &text, int, char quote) -{ - if (quote) - return text; - else - return (std::string ("'") + text); -} - -void -initialize_command_input (void) -{ - // If we are using readline, this allows conditional parsing of the - // .inputrc file. - - command_editor::set_name ("Octave"); - - // FIXME -- this needs to include a comma too, but that - // causes trouble for the new struct element completion code. - - static const char *s = "\t\n !\"\'*+-/:;<=>(){}[\\]^`~"; - - command_editor::set_basic_word_break_characters (s); - - command_editor::set_completer_word_break_characters (s); - - command_editor::set_basic_quote_characters ("\""); - - command_editor::set_filename_quote_characters (" \t\n\\\"'@<>=;|&()#$`?*[!:{"); - command_editor::set_completer_quote_characters ("'\""); - - command_editor::set_completion_function (generate_completion); - - command_editor::set_quoting_function (quoting_filename); -} - -static void -execute_in_debugger_handler (const std::pair& arg) -{ - octave_link::execute_in_debugger_event (arg.first, arg.second); -} - -static void -get_debug_input (const std::string& prompt) -{ - unwind_protect frame; - - octave_user_code *caller = octave_call_stack::caller_user_code (); - std::string nm; - - int curr_debug_line = octave_call_stack::current_line (); - - bool have_file = false; - - if (caller) - { - nm = caller->fcn_file_name (); - - if (nm.empty ()) - nm = caller->name (); - else - have_file = true; - } - else - curr_debug_line = -1; - - std::ostringstream buf; - - if (! nm.empty ()) - { - if (Vgud_mode) - { - static char ctrl_z = 'Z' & 0x1f; - - buf << ctrl_z << ctrl_z << nm << ":" << curr_debug_line; - } - else - { - // FIXME -- we should come up with a clean way to detect - // that we are stopped on the no-op command that marks the - // end of a function or script. - - buf << "stopped in " << nm; - - if (curr_debug_line > 0) - buf << " at line " << curr_debug_line; - - if (have_file) - { - octave_link::enter_debugger_event (nm, curr_debug_line); - - octave_link::set_workspace (); - - frame.add_fcn (execute_in_debugger_handler, - std::pair (nm, curr_debug_line)); - - std::string line_buf - = get_file_line (nm, curr_debug_line); - - if (! line_buf.empty ()) - buf << "\n" << curr_debug_line << ": " << line_buf; - } - } - } - - std::string msg = buf.str (); - - if (! msg.empty ()) - std::cerr << msg << std::endl; - - frame.protect_var (VPS1); - VPS1 = prompt; - - if (! (interactive || forced_interactive) - || LEXER->reading_fcn_file - || LEXER->reading_classdef_file - || LEXER->reading_script_file - || LEXER->input_from_eval_string ()) - { - frame.protect_var (forced_interactive); - forced_interactive = true; - } - - // octave_parser constructor sets this for us. - frame.protect_var (LEXER); - - octave_parser curr_parser; - - while (Vdebugging) - { - unwind_protect middle_frame; - - reset_error_handler (); - - curr_parser.reset (); - - int retval = curr_parser.run (); - - if (command_editor::interrupt (false)) - break; - else - { - if (retval == 0 && curr_parser.stmt_list) - { - curr_parser.stmt_list->accept (*current_evaluator); - - if (octave_completion_matches_called) - octave_completion_matches_called = false; - } - - octave_quit (); - } - } -} - -const std::string octave_base_reader::in_src ("invalid"); - -const std::string octave_terminal_reader::in_src ("terminal"); - -std::string -octave_terminal_reader::get_input (bool& eof) -{ - octave_quit (); - - eof = false; - - return octave_gets (eof); -} - -const std::string octave_file_reader::in_src ("file"); - -std::string -octave_file_reader::get_input (bool& eof) -{ - octave_quit (); - - eof = false; - - return octave_fgets (file, eof); -} - -const std::string octave_eval_string_reader::in_src ("eval_string"); - -std::string -octave_eval_string_reader::get_input (bool& eof) -{ - octave_quit (); - - eof = false; - - std::string retval; - - retval = eval_string; - - // Clear the eval string so that the next call will return - // an empty character string with EOF = true. - eval_string = ""; - - if (retval.empty ()) - eof = true; - - return retval; -} - -// If the user simply hits return, this will produce an empty matrix. - -static octave_value_list -get_user_input (const octave_value_list& args, int nargout) -{ - octave_value_list retval; - - int nargin = args.length (); - - int read_as_string = 0; - - if (nargin == 2) - read_as_string++; - - std::string prompt = args(0).string_value (); - - if (error_state) - { - error ("input: unrecognized argument"); - return retval; - } - - flush_octave_stdout (); - - octave_pager_stream::reset (); - octave_diary_stream::reset (); - - octave_diary << prompt; - - bool eof = false; - - std::string input_buf = interactive_input (prompt.c_str (), eof); - - if (! (error_state || input_buf.empty ())) - { - size_t len = input_buf.length (); - - octave_diary << input_buf; - - if (input_buf[len - 1] != '\n') - octave_diary << "\n"; - - if (len < 1) - return read_as_string ? octave_value ("") : octave_value (Matrix ()); - - if (read_as_string) - { - // FIXME -- fix gnu_readline and octave_gets instead! - if (input_buf.length () == 1 && input_buf[0] == '\n') - retval(0) = ""; - else - retval(0) = input_buf; - } - else - { - int parse_status = 0; - - retval = eval_string (input_buf, true, parse_status, nargout); - - if (! Vdebugging && retval.length () == 0) - retval(0) = Matrix (); - } - } - else - error ("input: reading user-input failed!"); - - return retval; -} - -DEFUN (input, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{ans} =} input (@var{prompt})\n\ -@deftypefnx {Built-in Function} {@var{ans} =} input (@var{prompt}, \"s\")\n\ -Print a prompt and wait for user input. For example,\n\ -\n\ -@example\n\ -input (\"Pick a number, any number! \")\n\ -@end example\n\ -\n\ -@noindent\n\ -prints the prompt\n\ -\n\ -@example\n\ -Pick a number, any number!\n\ -@end example\n\ -\n\ -@noindent\n\ -and waits for the user to enter a value. The string entered by the user\n\ -is evaluated as an expression, so it may be a literal constant, a\n\ -variable name, or any other valid expression.\n\ -\n\ -Currently, @code{input} only returns one value, regardless of the number\n\ -of values produced by the evaluation of the expression.\n\ -\n\ -If you are only interested in getting a literal string value, you can\n\ -call @code{input} with the character string @code{\"s\"} as the second\n\ -argument. This tells Octave to return the string entered by the user\n\ -directly, without evaluating it first.\n\ -\n\ -Because there may be output waiting to be displayed by the pager, it is\n\ -a good idea to always call @code{fflush (stdout)} before calling\n\ -@code{input}. This will ensure that all pending output is written to\n\ -the screen before your prompt.\n\ -@seealso{yes_or_no, kbhit}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - retval = get_user_input (args, nargout); - else - print_usage (); - - return retval; -} - -bool -octave_yes_or_no (const std::string& prompt) -{ - std::string prompt_string = prompt + "(yes or no) "; - - while (1) - { - bool eof = false; - - std::string input_buf = interactive_input (prompt_string, eof); - - if (input_buf == "yes") - return true; - else if (input_buf == "no") - return false; - else - message (0, "Please answer yes or no."); - } -} - -DEFUN (yes_or_no, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{ans} =} yes_or_no (\"@var{prompt}\")\n\ -Ask the user a yes-or-no question. Return logical true if the answer is yes\n\ -or false if the answer is no. Takes one argument, @var{prompt}, which is\n\ -the string to display when asking the question. @var{prompt} should end in\n\ -a space; @code{yes-or-no} adds the string @samp{(yes or no) } to it. The\n\ -user must confirm the answer with @key{RET} and can edit it until it has\n\ -been confirmed.\n\ -@seealso{input}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0 || nargin == 1) - { - std::string prompt; - - if (nargin == 1) - { - prompt = args(0).string_value (); - - if (error_state) - { - error ("yes_or_no: PROMPT must be a character string"); - return retval; - } - } - - retval = octave_yes_or_no (prompt); - } - else - print_usage (); - - return retval; -} - -octave_value -do_keyboard (const octave_value_list& args) -{ - octave_value retval; - - int nargin = args.length (); - - assert (nargin == 0 || nargin == 1); - - unwind_protect frame; - - frame.add_fcn (command_history::ignore_entries, - command_history::ignoring_entries ()); - - command_history::ignore_entries (false); - - frame.protect_var (Vdebugging); - - frame.add_fcn (octave_call_stack::restore_frame, - octave_call_stack::current_frame ()); - - // FIXME -- probably we just want to print one line, not the - // entire statement, which might span many lines... - // - // tree_print_code tpc (octave_stdout); - // stmt.accept (tpc); - - Vdebugging = true; - - std::string prompt = "debug> "; - if (nargin > 0) - prompt = args(0).string_value (); - - if (! error_state) - get_debug_input (prompt); - - return retval; -} - -DEFUN (keyboard, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} keyboard ()\n\ -@deftypefnx {Built-in Function} {} keyboard (\"@var{prompt}\")\n\ -This function is normally used for simple debugging. When the\n\ -@code{keyboard} function is executed, Octave prints a prompt and waits\n\ -for user input. The input strings are then evaluated and the results\n\ -are printed. This makes it possible to examine the values of variables\n\ -within a function, and to assign new values if necessary. To leave the\n\ -prompt and return to normal execution type @samp{return} or @samp{dbcont}.\n\ -The @code{keyboard} function does not return an exit status.\n\ -\n\ -If @code{keyboard} is invoked without arguments, a default prompt of\n\ -@samp{debug> } is used.\n\ -@seealso{dbcont, dbquit}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 0 || nargin == 1) - { - unwind_protect frame; - - frame.add_fcn (octave_call_stack::restore_frame, - octave_call_stack::current_frame ()); - - // Skip the frame assigned to the keyboard function. - octave_call_stack::goto_frame_relative (0); - - tree_evaluator::debug_mode = true; - - tree_evaluator::current_frame = octave_call_stack::current_frame (); - - do_keyboard (args); - } - else - print_usage (); - - return retval; -} - -DEFUN (echo, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} echo options\n\ -Control whether commands are displayed as they are executed. Valid\n\ -options are:\n\ -\n\ -@table @code\n\ -@item on\n\ -Enable echoing of commands as they are executed in script files.\n\ -\n\ -@item off\n\ -Disable echoing of commands as they are executed in script files.\n\ -\n\ -@item on all\n\ -Enable echoing of commands as they are executed in script files and\n\ -functions.\n\ -\n\ -@item off all\n\ -Disable echoing of commands as they are executed in script files and\n\ -functions.\n\ -@end table\n\ -\n\ -@noindent\n\ -With no arguments, @code{echo} toggles the current echo state.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("echo"); - - if (error_state) - return retval; - - switch (argc) - { - case 1: - { - if ((Vecho_executing_commands & ECHO_SCRIPTS) - || (Vecho_executing_commands & ECHO_FUNCTIONS)) - Vecho_executing_commands = ECHO_OFF; - else - Vecho_executing_commands = ECHO_SCRIPTS; - } - break; - - case 2: - { - std::string arg = argv[1]; - - if (arg == "on") - Vecho_executing_commands = ECHO_SCRIPTS; - else if (arg == "off") - Vecho_executing_commands = ECHO_OFF; - else - print_usage (); - } - break; - - case 3: - { - std::string arg = argv[1]; - - if (arg == "on" && argv[2] == "all") - { - int tmp = (ECHO_SCRIPTS | ECHO_FUNCTIONS); - Vecho_executing_commands = tmp; - } - else if (arg == "off" && argv[2] == "all") - Vecho_executing_commands = ECHO_OFF; - else - print_usage (); - } - break; - - default: - print_usage (); - break; - } - - return retval; -} - -DEFUN (completion_matches, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} completion_matches (@var{hint})\n\ -Generate possible completions given @var{hint}.\n\ -\n\ -This function is provided for the benefit of programs like Emacs which\n\ -might be controlling Octave and handling user input. The current\n\ -command number is not incremented when this function is called. This is\n\ -a feature, not a bug.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - std::string hint = args(0).string_value (); - - if (! error_state) - { - int n = 32; - - string_vector list (n); - - int k = 0; - - for (;;) - { - std::string cmd = generate_completion (hint, k); - - if (! cmd.empty ()) - { - if (k == n) - { - n *= 2; - list.resize (n); - } - - list[k++] = cmd; - } - else - { - list.resize (k); - break; - } - } - - if (nargout > 0) - { - if (! list.empty ()) - retval = list; - else - retval = ""; - } - else - { - // We don't use string_vector::list_in_columns here - // because it will be easier for Emacs if the names - // appear in a single column. - - int len = list.length (); - - for (int i = 0; i < len; i++) - octave_stdout << list[i] << "\n"; - } - - octave_completion_matches_called = true; - } - } - else - print_usage (); - - return retval; -} - -DEFUN (readline_read_init_file, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} readline_read_init_file (@var{file})\n\ -Read the readline library initialization file @var{file}. If\n\ -@var{file} is omitted, read the default initialization file (normally\n\ -@file{~/.inputrc}).\n\ -\n\ -@xref{Readline Init File, , , readline, GNU Readline Library},\n\ -for details.\n\ -@seealso{readline_re_read_init_file}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 0) - command_editor::read_init_file (); - else if (nargin == 1) - { - std::string file = args(0).string_value (); - - if (! error_state) - command_editor::read_init_file (file); - } - else - print_usage (); - - return retval; -} - -DEFUN (readline_re_read_init_file, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} readline_re_read_init_file ()\n\ -Re-read the last readline library initialization file that was read.\n\ -@xref{Readline Init File, , , readline, GNU Readline Library},\n\ -for details.\n\ -@seealso{readline_read_init_file}\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 0) - command_editor::re_read_init_file (); - else - print_usage (); - - return retval; -} - -static int -internal_input_event_hook_fcn (void) -{ - input_event_hook_functions.run (); - - if (input_event_hook_functions.empty ()) - command_editor::remove_event_hook (internal_input_event_hook_fcn); - - return 0; -} - -DEFUN (add_input_event_hook, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{id} =} add_input_event_hook (@var{fcn})\n\ -@deftypefnx {Built-in Function} {@var{id} =} add_input_event_hook (@var{fcn}, @var{data})\n\ -Add the named function or function handle @var{fcn} to the list of functions\n\ -to call periodically when Octave is waiting for input. The function should\n\ -have the form\n\ -\n\ -@example\n\ -@var{fcn} (@var{data})\n\ -@end example\n\ -\n\ -If @var{data} is omitted, Octave calls the function without any\n\ -arguments.\n\ -\n\ -The returned identifier may be used to remove the function handle from\n\ -the list of input hook functions.\n\ -@seealso{remove_input_event_hook}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - octave_value user_data; - - if (nargin == 2) - user_data = args(1); - - hook_function hook_fcn (args(0), user_data); - - if (! error_state) - { - if (input_event_hook_functions.empty ()) - command_editor::add_event_hook (internal_input_event_hook_fcn); - - input_event_hook_functions.insert (hook_fcn.id (), hook_fcn); - - retval = hook_fcn.id (); - } - else - error ("add_input_event_hook: expecting function handle or character string as first argument"); - } - else - print_usage (); - - return retval; -} - -DEFUN (remove_input_event_hook, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} remove_input_event_hook (@var{name})\n\ -@deftypefnx {Built-in Function} {} remove_input_event_hook (@var{fcn_id})\n\ -Remove the named function or function handle with the given identifier\n\ -from the list of functions to call periodically when Octave is waiting\n\ -for input.\n\ -@seealso{add_input_event_hook}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - std::string hook_fcn_id = args(0).string_value (); - - bool warn = (nargin < 2); - - if (! error_state) - { - hook_function_list::iterator p - = input_event_hook_functions.find (hook_fcn_id); - - if (p != input_event_hook_functions.end ()) - input_event_hook_functions.erase (p); - else if (warn) - warning ("remove_input_event_hook: %s not found in list", - hook_fcn_id.c_str ()); - - if (input_event_hook_functions.empty ()) - command_editor::remove_event_hook (internal_input_event_hook_fcn); - } - else - error ("remove_input_event_hook: argument not valid as a hook function name or id"); - } - else - print_usage (); - - return retval; -} - -DEFUN (PS1, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} PS1 ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} PS1 (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} PS1 (@var{new_val}, \"local\")\n\ -Query or set the primary prompt string. When executing interactively,\n\ -Octave displays the primary prompt when it is ready to read a command.\n\ -\n\ -The default value of the primary prompt string is @code{\"\\s:\\#> \"}.\n\ -To change it, use a command like\n\ -\n\ -@example\n\ -PS1 (\"\\\\u@@\\\\H> \")\n\ -@end example\n\ -\n\ -@noindent\n\ -which will result in the prompt @samp{boris@@kremvax> } for the user\n\ -@samp{boris} logged in on the host @samp{kremvax.kgb.su}. Note that two\n\ -backslashes are required to enter a backslash into a double-quoted\n\ -character string. @xref{Strings}.\n\ -\n\ -You can also use ANSI escape sequences if your terminal supports them.\n\ -This can be useful for coloring the prompt. For example,\n\ -\n\ -@example\n\ -PS1 (\"\\\\[\\\\033[01;31m\\\\]\\\\s:\\\\#> \\\\[\\\\033[0m\\\\]\")\n\ -@end example\n\ -\n\ -@noindent\n\ -will give the default Octave prompt a red coloring.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{PS2, PS4}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (PS1); -} - -DEFUN (PS2, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} PS2 ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} PS2 (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} PS2 (@var{new_val}, \"local\")\n\ -Query or set the secondary prompt string. The secondary prompt is\n\ -printed when Octave is expecting additional input to complete a\n\ -command. For example, if you are typing a @code{for} loop that spans several\n\ -lines, Octave will print the secondary prompt at the beginning of\n\ -each line after the first. The default value of the secondary prompt\n\ -string is @code{\"> \"}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{PS1, PS4}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (PS2); -} - -DEFUN (PS4, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} PS4 ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} PS4 (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} PS4 (@var{new_val}, \"local\")\n\ -Query or set the character string used to prefix output produced\n\ -when echoing commands is enabled.\n\ -The default value is @code{\"+ \"}.\n\ -@xref{Diary and Echo Commands}, for a description of echoing commands.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{echo, echo_executing_commands, PS1, PS2}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (PS4); -} - -DEFUN (completion_append_char, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} completion_append_char ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} completion_append_char (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} completion_append_char (@var{new_val}, \"local\")\n\ -Query or set the internal character variable that is appended to\n\ -successful command-line completion attempts. The default\n\ -value is @code{\" \"} (a single space).\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (completion_append_char); -} - -DEFUN (echo_executing_commands, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} echo_executing_commands ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} echo_executing_commands (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} echo_executing_commands (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls the echo state.\n\ -It may be the sum of the following values:\n\ -\n\ -@table @asis\n\ -@item 1\n\ -Echo commands read from script files.\n\ -\n\ -@item 2\n\ -Echo commands from functions.\n\ -\n\ -@item 4\n\ -Echo commands read from command line.\n\ -@end table\n\ -\n\ -More than one state can be active at once. For example, a value of 3 is\n\ -equivalent to the command @kbd{echo on all}.\n\ -\n\ -The value of @code{echo_executing_commands} may be set by the @kbd{echo}\n\ -command or the command line option @option{--echo-commands}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (echo_executing_commands); -} - -DEFUN (__request_drawnow__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __request_drawnow__ ()\n\ -@deftypefnx {Built-in Function} {} __request_drawnow__ (@var{flag})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - Vdrawnow_requested = true; - else if (nargin == 1) - Vdrawnow_requested = args(0).bool_value (); - else - print_usage (); - - return retval; -} - -DEFUN (__gud_mode__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __gud_mode__ ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - retval = Vgud_mode; - else if (nargin == 1) - Vgud_mode = args(0).bool_value (); - else - print_usage (); - - return retval; -} - -DEFUN (filemarker, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} filemarker ()\n\ -@deftypefnx {Built-in Function} {} filemarker (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} filemarker (@var{new_val}, \"local\")\n\ -Query or set the character used to separate filename from the\n\ -the subfunction names contained within the file. This can be used in\n\ -a generic manner to interact with subfunctions. For example,\n\ -\n\ -@example\n\ -help ([\"myfunc\", filemarker, \"mysubfunc\"])\n\ -@end example\n\ -\n\ -@noindent\n\ -returns the help string associated with the subfunction @code{mysubfunc}\n\ -of the function @code{myfunc}. Another use of @code{filemarker} is when\n\ -debugging it allows easier placement of breakpoints within subfunctions.\n\ -For example,\n\ -\n\ -@example\n\ -dbstop ([\"myfunc\", filemarker, \"mysubfunc\"])\n\ -@end example\n\ -\n\ -@noindent\n\ -will set a breakpoint at the first line of the subfunction @code{mysubfunc}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - char tmp = Vfilemarker; - octave_value retval = SET_INTERNAL_VARIABLE (filemarker); - - // The character passed must not be a legal character for a function name - if (! error_state && (::isalnum (Vfilemarker) || Vfilemarker == '_')) - { - Vfilemarker = tmp; - error ("filemarker: character can not be a valid character for a function name"); - } - - return retval; -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/input.h --- a/libinterp/interpfcn/input.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,246 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Use the GNU readline library for command line editing and hisory. - -#if !defined (octave_input_h) -#define octave_input_h 1 - -#include - -#include - -#include "oct-time.h" -#include "oct-obj.h" -#include "pager.h" - -class octave_value; - -extern OCTINTERP_API FILE *get_input_from_stdin (void); - -// TRUE means this is an interactive shell. -extern bool interactive; - -// TRUE means the user forced this shell to be interactive (-i). -extern bool forced_interactive; - -// TRUE after a call to completion_matches. -extern bool octave_completion_matches_called; - -// TRUE if the plotting system has requested a call to drawnow at -// the next user prompt. -extern OCTINTERP_API bool Vdrawnow_requested; - -// TRUE if we are in debugging mode. -extern OCTINTERP_API bool Vdebugging; - -extern void initialize_command_input (void); - -extern bool octave_yes_or_no (const std::string& prompt); - -extern octave_value do_keyboard (const octave_value_list& args = octave_value_list ()); - -extern void remove_input_event_hook_functions (void); - -extern void set_default_prompts (void); - -extern std::string VPS4; - -extern char Vfilemarker; - -enum echo_state -{ - ECHO_OFF = 0, - ECHO_SCRIPTS = 1, - ECHO_FUNCTIONS = 2, - ECHO_CMD_LINE = 4 -}; - -extern int Vecho_executing_commands; - -extern octave_time Vlast_prompt_time; - -class -octave_base_reader -{ -public: - - friend class octave_input_reader; - - octave_base_reader (void) : count (1), pflag (0) { } - - octave_base_reader (const octave_base_reader&) : count (1) { } - - virtual ~octave_base_reader (void) { } - - virtual std::string get_input (bool& eof) = 0; - - virtual std::string input_source (void) const { return in_src; } - - void reset (void) { promptflag (1); } - - void increment_promptflag (void) { pflag++; } - - void decrement_promptflag (void) { pflag--; } - - int promptflag (void) const { return pflag; } - - int promptflag (int n) - { - int retval = pflag; - pflag = n; - return retval; - } - - std::string octave_gets (bool& eof); - -private: - - int count; - - int pflag; - - void do_input_echo (const std::string&) const; - - static const std::string in_src; -}; - -class -octave_terminal_reader : public octave_base_reader -{ -public: - - octave_terminal_reader (void) : octave_base_reader () { } - - std::string get_input (bool& eof); - - std::string input_source (void) const { return in_src; } - -private: - - static const std::string in_src; -}; - -class -octave_file_reader : public octave_base_reader -{ -public: - - octave_file_reader (FILE *f_arg) - : octave_base_reader (), file (f_arg) { } - - std::string get_input (bool& eof); - - std::string input_source (void) const { return in_src; } - -private: - - FILE *file; - - static const std::string in_src; -}; - -class -octave_eval_string_reader : public octave_base_reader -{ -public: - - octave_eval_string_reader (const std::string& str) - : octave_base_reader (), eval_string (str) - { } - - std::string get_input (bool& eof); - - std::string input_source (void) const { return in_src; } - -private: - - std::string eval_string; - - static const std::string in_src; -}; - -class -octave_input_reader -{ -public: - octave_input_reader (void) - : rep (new octave_terminal_reader ()) - { } - - octave_input_reader (FILE *file) - : rep (new octave_file_reader (file)) - { } - - octave_input_reader (const std::string& str) - : rep (new octave_eval_string_reader (str)) - { } - - octave_input_reader (const octave_input_reader& ir) - { - rep = ir.rep; - rep->count++; - } - - octave_input_reader& operator = (const octave_input_reader& ir) - { - if (&ir != this) - { - rep = ir.rep; - rep->count++; - } - - return *this; - } - - ~octave_input_reader (void) - { - if (--rep->count == 0) - delete rep; - } - - void reset (void) { return rep->reset (); } - - void increment_promptflag (void) { rep->increment_promptflag (); } - - void decrement_promptflag (void) { rep->decrement_promptflag (); } - - int promptflag (void) const { return rep->promptflag (); } - - int promptflag (int n) { return rep->promptflag (n); } - - std::string get_input (bool& eof) - { - return rep->get_input (eof); - } - - std::string input_source (void) const - { - return rep->input_source (); - } - -private: - - octave_base_reader *rep; -}; - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/load-path.cc --- a/libinterp/interpfcn/load-path.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2342 +0,0 @@ -/* - -Copyright (C) 2006-2012 John W. Eaton -Copyright (C) 2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "dir-ops.h" -#include "file-ops.h" -#include "file-stat.h" -#include "oct-env.h" -#include "pathsearch.h" -#include "singleton-cleanup.h" - -#include "defaults.h" -#include "defun.h" -#include "input.h" -#include "load-path.h" -#include "pager.h" -#include "parse.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" - -load_path *load_path::instance = 0; -load_path::hook_fcn_ptr load_path::add_hook = execute_pkg_add; -load_path::hook_fcn_ptr load_path::remove_hook = execute_pkg_del; -std::string load_path::command_line_path; -std::string load_path::sys_path; -load_path::abs_dir_cache_type load_path::abs_dir_cache; - -void -load_path::dir_info::update (void) -{ - file_stat fs (dir_name); - - if (fs) - { - if (is_relative) - { - try - { - std::string abs_name = octave_env::make_absolute (dir_name); - - abs_dir_cache_iterator p = abs_dir_cache.find (abs_name); - - if (p != abs_dir_cache.end ()) - { - // The directory is in the cache of all directories - // we have visited (indexed by its absolute name). - // If it is out of date, initialize it. Otherwise, - // copy the info from the cache. By doing that, we - // avoid unnecessary calls to stat that can slow - // things down tremendously for large directories. - - const dir_info& di = p->second; - - if (fs.mtime () + fs.time_resolution () > di.dir_time_last_checked) - initialize (); - else - *this = di; - } - else - { - // We haven't seen this directory before. - - initialize (); - } - } - catch (octave_execution_exception) - { - // Skip updating if we don't know where we are, but - // don't treat it as an error. - - error_state = 0; - } - } - else if (fs.mtime () + fs.time_resolution () > dir_time_last_checked) - initialize (); - } - else - { - std::string msg = fs.error (); - warning ("load_path: %s: %s", dir_name.c_str (), msg.c_str ()); - } -} - -void -load_path::dir_info::initialize (void) -{ - is_relative = ! octave_env::absolute_pathname (dir_name); - - dir_time_last_checked = octave_time (static_cast (0)); - - file_stat fs (dir_name); - - if (fs) - { - method_file_map.clear (); - - dir_mtime = fs.mtime (); - dir_time_last_checked = octave_time (); - - get_file_list (dir_name); - - try - { - std::string abs_name = octave_env::make_absolute (dir_name); - - // FIXME -- nothing is ever removed from this cache of - // directory information, so there could be some resource - // problems. Perhaps it should be pruned from time to time. - - abs_dir_cache[abs_name] = *this; - } - catch (octave_execution_exception) - { - // Skip updating if we don't know where we are. - } - } - else - { - std::string msg = fs.error (); - warning ("load_path: %s: %s", dir_name.c_str (), msg.c_str ()); - } -} - -void -load_path::dir_info::get_file_list (const std::string& d) -{ - dir_entry dir (d); - - if (dir) - { - string_vector flist = dir.read (); - - octave_idx_type len = flist.length (); - - all_files.resize (len); - fcn_files.resize (len); - - octave_idx_type all_files_count = 0; - octave_idx_type fcn_files_count = 0; - - for (octave_idx_type i = 0; i < len; i++) - { - std::string fname = flist[i]; - - std::string full_name = file_ops::concat (d, fname); - - file_stat fs (full_name); - - if (fs) - { - if (fs.is_dir ()) - { - if (fname == "private") - get_private_file_map (full_name); - else if (fname[0] == '@') - get_method_file_map (full_name, fname.substr (1)); - } - else - { - all_files[all_files_count++] = fname; - - size_t pos = fname.rfind ('.'); - - if (pos != std::string::npos) - { - std::string ext = fname.substr (pos); - - if (ext == ".m" || ext == ".oct" || ext == ".mex") - { - std::string base = fname.substr (0, pos); - - if (valid_identifier (base)) - fcn_files[fcn_files_count++] = fname; - } - } - } - } - } - - all_files.resize (all_files_count); - fcn_files.resize (fcn_files_count); - } - else - { - std::string msg = dir.error (); - warning ("load_path: %s: %s", d.c_str (), msg.c_str ()); - } -} - -load_path::dir_info::fcn_file_map_type -get_fcn_files (const std::string& d) -{ - load_path::dir_info::fcn_file_map_type retval; - - dir_entry dir (d); - - if (dir) - { - string_vector flist = dir.read (); - - octave_idx_type len = flist.length (); - - for (octave_idx_type i = 0; i < len; i++) - { - std::string fname = flist[i]; - - std::string ext; - std::string base = fname; - - size_t pos = fname.rfind ('.'); - - if (pos != std::string::npos) - { - base = fname.substr (0, pos); - ext = fname.substr (pos); - - if (valid_identifier (base)) - { - int t = 0; - - if (ext == ".m") - t = load_path::M_FILE; - else if (ext == ".oct") - t = load_path::OCT_FILE; - else if (ext == ".mex") - t = load_path::MEX_FILE; - - retval[base] |= t; - } - } - } - } - else - { - std::string msg = dir.error (); - warning ("load_path: %s: %s", d.c_str (), msg.c_str ()); - } - - return retval; -} - -void -load_path::dir_info::get_private_file_map (const std::string& d) -{ - private_file_map = get_fcn_files (d); -} - -void -load_path::dir_info::get_method_file_map (const std::string& d, - const std::string& class_name) -{ - method_file_map[class_name].method_file_map = get_fcn_files (d); - - std::string pd = file_ops::concat (d, "private"); - - file_stat fs (pd); - - if (fs && fs.is_dir ()) - method_file_map[class_name].private_file_map = get_fcn_files (pd); -} - -bool -load_path::instance_ok (void) -{ - bool retval = true; - - if (! instance) - { - instance = new load_path (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); - } - - if (! instance) - { - ::error ("unable to create load path object!"); - - retval = false; - } - - return retval; -} - -// FIXME -- maybe we should also maintain a map to speed up this -// method of access. - -load_path::const_dir_info_list_iterator -load_path::find_dir_info (const std::string& dir_arg) const -{ - std::string dir = file_ops::tilde_expand (dir_arg); - - const_dir_info_list_iterator retval = dir_info_list.begin (); - - while (retval != dir_info_list.end ()) - { - if (retval->dir_name == dir) - break; - - retval++; - } - - return retval; -} - -load_path::dir_info_list_iterator -load_path::find_dir_info (const std::string& dir_arg) -{ - std::string dir = file_ops::tilde_expand (dir_arg); - - dir_info_list_iterator retval = dir_info_list.begin (); - - while (retval != dir_info_list.end ()) - { - if (retval->dir_name == dir) - break; - - retval++; - } - - return retval; -} - -bool -load_path::contains (const std::string& dir) const -{ - return find_dir_info (dir) != dir_info_list.end (); -} - -bool -load_path::do_contains_canonical (const std::string& dir) const -{ - bool retval = false; - - for (const_dir_info_list_iterator i = dir_info_list.begin (); - i != dir_info_list.end (); - i++) - { - if (same_file (dir, i->dir_name)) - { - retval = true; - break; - } - } - - return retval; -} - -void -load_path::move_fcn_map (const std::string& dir_name, - const string_vector& fcn_files, bool at_end) -{ - octave_idx_type len = fcn_files.length (); - - for (octave_idx_type k = 0; k < len; k++) - { - std::string fname = fcn_files[k]; - - std::string ext; - std::string base = fname; - - size_t pos = fname.rfind ('.'); - - if (pos != std::string::npos) - { - base = fname.substr (0, pos); - ext = fname.substr (pos); - } - - file_info_list_type& file_info_list = fcn_map[base]; - - if (file_info_list.size () == 1) - continue; - else - { - for (file_info_list_iterator p = file_info_list.begin (); - p != file_info_list.end (); - p++) - { - if (p->dir_name == dir_name) - { - file_info fi = *p; - - file_info_list.erase (p); - - if (at_end) - file_info_list.push_back (fi); - else - file_info_list.push_front (fi); - - break; - } - } - } - } -} - -void -load_path::move_method_map (const std::string& dir_name, bool at_end) -{ - for (method_map_iterator i = method_map.begin (); - i != method_map.end (); - i++) - { - std::string class_name = i->first; - - fcn_map_type& fm = i->second; - - std::string full_dir_name - = file_ops::concat (dir_name, "@" + class_name); - - for (fcn_map_iterator q = fm.begin (); q != fm.end (); q++) - { - file_info_list_type& file_info_list = q->second; - - if (file_info_list.size () == 1) - continue; - else - { - for (file_info_list_iterator p = file_info_list.begin (); - p != file_info_list.end (); - p++) - { - if (p->dir_name == full_dir_name) - { - file_info fi = *p; - - file_info_list.erase (p); - - if (at_end) - file_info_list.push_back (fi); - else - file_info_list.push_front (fi); - - break; - } - } - } - } - } -} - -void -load_path::move (dir_info_list_iterator i, bool at_end) -{ - if (dir_info_list.size () > 1) - { - dir_info di = *i; - - dir_info_list.erase (i); - - if (at_end) - dir_info_list.push_back (di); - else - dir_info_list.push_front (di); - - std::string dir_name = di.dir_name; - - move_fcn_map (dir_name, di.fcn_files, at_end); - - // No need to move elements of private function map. - - move_method_map (dir_name, at_end); - } -} - -static void -maybe_add_path_elts (std::string& path, const std::string& dir) -{ - std::string tpath = genpath (dir); - - if (! tpath.empty ()) - { - if (path.empty ()) - path = tpath; - else - path += dir_path::path_sep_str () + tpath; - } -} - -void -load_path::do_initialize (bool set_initial_path) -{ - sys_path = ""; - - if (set_initial_path) - { - maybe_add_path_elts (sys_path, Vlocal_ver_oct_file_dir); - maybe_add_path_elts (sys_path, Vlocal_api_oct_file_dir); - maybe_add_path_elts (sys_path, Vlocal_oct_file_dir); - maybe_add_path_elts (sys_path, Vlocal_ver_fcn_file_dir); - maybe_add_path_elts (sys_path, Vlocal_api_fcn_file_dir); - maybe_add_path_elts (sys_path, Vlocal_fcn_file_dir); - maybe_add_path_elts (sys_path, Voct_file_dir); - maybe_add_path_elts (sys_path, Vfcn_file_dir); - } - - std::string tpath = load_path::command_line_path; - - if (tpath.empty ()) - tpath = octave_env::getenv ("OCTAVE_PATH"); - - std::string xpath; - - if (! tpath.empty ()) - { - xpath = tpath; - - if (! sys_path.empty ()) - xpath += dir_path::path_sep_str () + sys_path; - } - else - xpath = sys_path; - - do_set (xpath, false, true); -} - -void -load_path::do_clear (void) -{ - dir_info_list.clear (); - fcn_map.clear (); - private_fcn_map.clear (); - method_map.clear (); -} - -static std::list -split_path (const std::string& p) -{ - std::list retval; - - size_t beg = 0; - size_t end = p.find (dir_path::path_sep_char ()); - - size_t len = p.length (); - - while (end != std::string::npos) - { - std::string elt = p.substr (beg, end-beg); - - if (! elt.empty ()) - retval.push_back (elt); - - beg = end + 1; - - if (beg == len) - break; - - end = p.find (dir_path::path_sep_char (), beg); - } - - std::string elt = p.substr (beg); - - if (! elt.empty ()) - retval.push_back (elt); - - return retval; -} - -void -load_path::do_set (const std::string& p, bool warn, bool is_init) -{ - // Use a list when we need to preserve order. - std::list elts = split_path (p); - - // Use a set when we need to search and order is not important. - std::set elts_set (elts.begin (), elts.end ()); - - if (is_init) - init_dirs = elts_set; - else - { - for (std::set::const_iterator it = init_dirs.begin (); - it != init_dirs.end (); it++) - { - if (elts_set.find (*it) == elts_set.end ()) - { - warning_with_id ("Octave:remove-init-dir", - "default load path altered. Some built-in functions may not be found. Try restoredefaultpath() to recover it."); - break; - } - } - } - - // Temporarily disable add hook. - - unwind_protect frame; - frame.protect_var (add_hook); - - add_hook = 0; - - do_clear (); - - for (std::list::const_iterator i = elts.begin (); - i != elts.end (); i++) - do_append (*i, warn); - - // Restore add hook and execute for all newly added directories. - frame.run_first (); - - for (dir_info_list_iterator i = dir_info_list.begin (); - i != dir_info_list.end (); - i++) - { - if (add_hook) - add_hook (i->dir_name); - } - - // Always prepend current directory. - do_prepend (".", warn); -} - -void -load_path::do_append (const std::string& dir, bool warn) -{ - if (! dir.empty ()) - do_add (dir, true, warn); -} - -void -load_path::do_prepend (const std::string& dir, bool warn) -{ - if (! dir.empty ()) - do_add (dir, false, warn); -} - -// Strip trailing directory separators. - -static std::string -strip_trailing_separators (const std::string& dir_arg) -{ - std::string dir = dir_arg; - - size_t k = dir.length (); - - while (k > 1 && file_ops::is_dir_sep (dir[k-1])) - k--; - - if (k < dir.length ()) - dir.resize (k); - - return dir; -} - -void -load_path::do_add (const std::string& dir_arg, bool at_end, bool warn) -{ - size_t len = dir_arg.length (); - - if (len > 1 && dir_arg.substr (len-2) == "//") - warning_with_id ("Octave:recursive-path-search", - "trailing '//' is no longer special in search path elements"); - - std::string dir = file_ops::tilde_expand (dir_arg); - - dir = strip_trailing_separators (dir); - - dir_info_list_iterator i = find_dir_info (dir); - - if (i != dir_info_list.end ()) - move (i, at_end); - else - { - file_stat fs (dir); - - if (fs) - { - if (fs.is_dir ()) - { - dir_info di (dir); - - if (! error_state) - { - if (at_end) - dir_info_list.push_back (di); - else - dir_info_list.push_front (di); - - add_to_fcn_map (di, at_end); - - add_to_private_fcn_map (di); - - add_to_method_map (di, at_end); - - if (add_hook) - add_hook (dir); - } - } - else if (warn) - warning ("addpath: %s: not a directory", dir_arg.c_str ()); - } - else if (warn) - { - std::string msg = fs.error (); - warning ("addpath: %s: %s", dir_arg.c_str (), msg.c_str ()); - } - } - - // FIXME -- is there a better way to do this? - - i = find_dir_info ("."); - - if (i != dir_info_list.end ()) - move (i, false); -} - -void -load_path::remove_fcn_map (const std::string& dir, - const string_vector& fcn_files) -{ - octave_idx_type len = fcn_files.length (); - - for (octave_idx_type k = 0; k < len; k++) - { - std::string fname = fcn_files[k]; - - std::string ext; - std::string base = fname; - - size_t pos = fname.rfind ('.'); - - if (pos != std::string::npos) - { - base = fname.substr (0, pos); - ext = fname.substr (pos); - } - - file_info_list_type& file_info_list = fcn_map[base]; - - for (file_info_list_iterator p = file_info_list.begin (); - p != file_info_list.end (); - p++) - { - if (p->dir_name == dir) - { - file_info_list.erase (p); - - if (file_info_list.empty ()) - fcn_map.erase (fname); - - break; - } - } - } -} - -void -load_path::remove_private_fcn_map (const std::string& dir) -{ - private_fcn_map_iterator p = private_fcn_map.find (dir); - - if (p != private_fcn_map.end ()) - private_fcn_map.erase (p); -} - -void -load_path::remove_method_map (const std::string& dir) -{ - for (method_map_iterator i = method_map.begin (); - i != method_map.end (); - i++) - { - std::string class_name = i->first; - - fcn_map_type& fm = i->second; - - std::string full_dir_name = file_ops::concat (dir, "@" + class_name); - - for (fcn_map_iterator q = fm.begin (); q != fm.end (); q++) - { - file_info_list_type& file_info_list = q->second; - - if (file_info_list.size () == 1) - continue; - else - { - for (file_info_list_iterator p = file_info_list.begin (); - p != file_info_list.end (); - p++) - { - if (p->dir_name == full_dir_name) - { - file_info_list.erase (p); - - // FIXME -- if there are no other elements, we - // should remove this element of fm but calling - // erase here would invalidate the iterator q. - - break; - } - } - } - } - } -} - -bool -load_path::do_remove (const std::string& dir_arg) -{ - bool retval = false; - - if (! dir_arg.empty ()) - { - if (dir_arg == ".") - { - warning ("rmpath: can't remove \".\" from path"); - - // Avoid additional warnings. - retval = true; - } - else - { - std::string dir = file_ops::tilde_expand (dir_arg); - - dir = strip_trailing_separators (dir); - - dir_info_list_iterator i = find_dir_info (dir); - - if (i != dir_info_list.end ()) - { - retval = true; - - if (remove_hook) - remove_hook (dir); - - string_vector fcn_files = i->fcn_files; - - dir_info_list.erase (i); - - remove_fcn_map (dir, fcn_files); - - remove_private_fcn_map (dir); - - remove_method_map (dir); - } - } - } - - return retval; -} - -void -load_path::do_update (void) const -{ - // I don't see a better way to do this because we need to - // preserve the correct directory ordering for new files that - // have appeared. - - fcn_map.clear (); - - private_fcn_map.clear (); - - method_map.clear (); - - for (dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - dir_info& di = *p; - - di.update (); - - add_to_fcn_map (di, true); - - add_to_private_fcn_map (di); - - add_to_method_map (di, true); - } -} - -bool -load_path::check_file_type (std::string& fname, int type, int possible_types, - const std::string& fcn, const char *who) -{ - bool retval = false; - - if (type == load_path::OCT_FILE) - { - if ((type & possible_types) == load_path::OCT_FILE) - { - fname += ".oct"; - retval = true; - } - } - else if (type == load_path::M_FILE) - { - if ((type & possible_types) == load_path::M_FILE) - { - fname += ".m"; - retval = true; - } - } - else if (type == load_path::MEX_FILE) - { - if ((type & possible_types) == load_path::MEX_FILE) - { - fname += ".mex"; - retval = true; - } - } - else if (type == (load_path::M_FILE | load_path::OCT_FILE)) - { - if (possible_types & load_path::OCT_FILE) - { - fname += ".oct"; - retval = true; - } - else if (possible_types & load_path::M_FILE) - { - fname += ".m"; - retval = true; - } - } - else if (type == (load_path::M_FILE | load_path::MEX_FILE)) - { - if (possible_types & load_path::MEX_FILE) - { - fname += ".mex"; - retval = true; - } - else if (possible_types & load_path::M_FILE) - { - fname += ".m"; - retval = true; - } - } - else if (type == (load_path::OCT_FILE | load_path::MEX_FILE)) - { - if (possible_types & load_path::OCT_FILE) - { - fname += ".oct"; - retval = true; - } - else if (possible_types & load_path::MEX_FILE) - { - fname += ".mex"; - retval = true; - } - } - else if (type == (load_path::M_FILE | load_path::OCT_FILE - | load_path::MEX_FILE)) - { - if (possible_types & load_path::OCT_FILE) - { - fname += ".oct"; - retval = true; - } - else if (possible_types & load_path::MEX_FILE) - { - fname += ".mex"; - retval = true; - } - else if (possible_types & load_path::M_FILE) - { - fname += ".m"; - retval = true; - } - } - else - error ("%s: %s: invalid type code = %d", who, fcn.c_str (), type); - - return retval; -} - -std::string -load_path::do_find_fcn (const std::string& fcn, std::string& dir_name, - int type) const -{ - std::string retval; - - // update (); - - if (fcn.length () > 0 && fcn[0] == '@') - { - size_t pos = fcn.find ('/'); - - if (pos != std::string::npos) - { - std::string class_name = fcn.substr (1, pos-1); - std::string meth = fcn.substr (pos+1); - - retval = do_find_method (class_name, meth, dir_name); - } - else - retval = std::string (); - } - else - { - dir_name = std::string (); - - const_fcn_map_iterator p = fcn_map.find (fcn); - - if (p != fcn_map.end ()) - { - const file_info_list_type& file_info_list = p->second; - - for (const_file_info_list_iterator i = file_info_list.begin (); - i != file_info_list.end (); - i++) - { - const file_info& fi = *i; - - retval = file_ops::concat (fi.dir_name, fcn); - - if (check_file_type (retval, type, fi.types, - fcn, "load_path::do_find_fcn")) - { - dir_name = fi.dir_name; - break; - } - else - retval = std::string (); - } - } - } - - return retval; -} - -std::string -load_path::do_find_private_fcn (const std::string& dir, - const std::string& fcn, int type) const -{ - std::string retval; - - // update (); - - const_private_fcn_map_iterator q = private_fcn_map.find (dir); - - if (q != private_fcn_map.end ()) - { - const dir_info::fcn_file_map_type& m = q->second; - - dir_info::const_fcn_file_map_iterator p = m.find (fcn); - - if (p != m.end ()) - { - std::string fname - = file_ops::concat (file_ops::concat (dir, "private"), fcn); - - if (check_file_type (fname, type, p->second, fcn, - "load_path::find_private_fcn")) - retval = fname; - } - } - - return retval; -} - -std::string -load_path::do_find_method (const std::string& class_name, - const std::string& meth, - std::string& dir_name, int type) const -{ - std::string retval; - - // update (); - - dir_name = std::string (); - - const_method_map_iterator q = method_map.find (class_name); - - if (q != method_map.end ()) - { - const fcn_map_type& m = q->second; - - const_fcn_map_iterator p = m.find (meth); - - if (p != m.end ()) - { - const file_info_list_type& file_info_list = p->second; - - for (const_file_info_list_iterator i = file_info_list.begin (); - i != file_info_list.end (); - i++) - { - const file_info& fi = *i; - - retval = file_ops::concat (fi.dir_name, meth); - - bool found = check_file_type (retval, type, fi.types, - meth, "load_path::do_find_method"); - - if (found) - { - dir_name = fi.dir_name; - break; - } - else - retval = std::string (); - } - } - } - - return retval; -} - -std::list -load_path::do_methods (const std::string& class_name) const -{ - std::list retval; - - // update (); - - const_method_map_iterator q = method_map.find (class_name); - - if (q != method_map.end ()) - { - const fcn_map_type& m = q->second; - - for (const_fcn_map_iterator p = m.begin (); p != m.end (); p++) - retval.push_back (p->first); - } - - if (! retval.empty ()) - retval.sort (); - - return retval; -} - -std::list -load_path::do_overloads (const std::string& meth) const -{ - std::list retval; - - // update (); - - for (const_method_map_iterator q = method_map.begin (); - q != method_map.end (); q++) - { - const fcn_map_type& m = q->second; - - if (m.find (meth) != m.end ()) - retval.push_back (q->first); - } - - return retval; -} - -std::string -load_path::do_find_file (const std::string& file) const -{ - std::string retval; - - if (file.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos) - { - if (octave_env::absolute_pathname (file) - || octave_env::rooted_relative_pathname (file)) - { - file_stat fs (file); - - if (fs.exists ()) - return file; - } - else - { - for (const_dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - std::string tfile = file_ops::concat (p->dir_name, file); - - file_stat fs (tfile); - - if (fs.exists ()) - return tfile; - } - } - } - else - { - for (const_dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - string_vector all_files = p->all_files; - - octave_idx_type len = all_files.length (); - - for (octave_idx_type i = 0; i < len; i++) - { - if (all_files[i] == file) - return file_ops::concat (p->dir_name, file); - } - } - } - - return retval; -} - -std::string -load_path::do_find_dir (const std::string& dir) const -{ - std::string retval; - - if (dir.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos - && (octave_env::absolute_pathname (dir) - || octave_env::rooted_relative_pathname (dir))) - { - file_stat fs (dir); - - if (fs.exists () && fs.is_dir ()) - return dir; - } - else - { - for (const_dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - std::string dname = octave_env::make_absolute (p->dir_name); - - size_t dname_len = dname.length (); - - if (dname.substr (dname_len - 1) == file_ops::dir_sep_str ()) - { - dname = dname.substr (0, dname_len - 1); - dname_len--; - } - - size_t dir_len = dir.length (); - - if (dname_len >= dir_len - && file_ops::is_dir_sep (dname[dname_len - dir_len - 1]) - && dir.compare (dname.substr (dname_len - dir_len)) == 0) - { - file_stat fs (p->dir_name); - - if (fs.exists () && fs.is_dir ()) - return p->dir_name; - } - } - } - - return retval; -} - -string_vector -load_path::do_find_matching_dirs (const std::string& dir) const -{ - std::list retlist; - - if (dir.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos - && (octave_env::absolute_pathname (dir) - || octave_env::rooted_relative_pathname (dir))) - { - file_stat fs (dir); - - if (fs.exists () && fs.is_dir ()) - retlist.push_back (dir); - } - else - { - for (const_dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - std::string dname = octave_env::make_absolute (p->dir_name); - - size_t dname_len = dname.length (); - - if (dname.substr (dname_len - 1) == file_ops::dir_sep_str ()) - { - dname = dname.substr (0, dname_len - 1); - dname_len--; - } - - size_t dir_len = dir.length (); - - if (dname_len >= dir_len - && file_ops::is_dir_sep (dname[dname_len - dir_len - 1]) - && dir.compare (dname.substr (dname_len - dir_len)) == 0) - { - file_stat fs (p->dir_name); - - if (fs.exists () && fs.is_dir ()) - retlist.push_back (p->dir_name); - } - } - } - - return retlist; -} - -std::string -load_path::do_find_first_of (const string_vector& flist) const -{ - std::string retval; - - std::string dir_name; - std::string file_name; - - octave_idx_type flen = flist.length (); - octave_idx_type rel_flen = 0; - - string_vector rel_flist (flen); - - for (octave_idx_type i = 0; i < flen; i++) - { - std::string file = flist[i]; - - if (file.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos) - { - if (octave_env::absolute_pathname (file) - || octave_env::rooted_relative_pathname (file)) - { - file_stat fs (file); - - if (fs.exists ()) - return file; - } - else - { - for (const_dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - std::string tfile = file_ops::concat (p->dir_name, file); - - file_stat fs (tfile); - - if (fs.exists ()) - return tfile; - } - } - } - else - rel_flist[rel_flen++] = file; - } - - rel_flist.resize (rel_flen); - - for (const_dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - string_vector all_files = p->all_files; - - octave_idx_type len = all_files.length (); - - for (octave_idx_type i = 0; i < len; i++) - { - for (octave_idx_type j = 0; j < rel_flen; j++) - { - if (all_files[i] == rel_flist[j]) - { - dir_name = p->dir_name; - file_name = rel_flist[j]; - - goto done; - } - } - } - } - - done: - - if (! dir_name.empty ()) - retval = file_ops::concat (dir_name, file_name); - - return retval; -} - -string_vector -load_path::do_find_all_first_of (const string_vector& flist) const -{ - std::list retlist; - - std::string dir_name; - std::string file_name; - - octave_idx_type flen = flist.length (); - octave_idx_type rel_flen = 0; - - string_vector rel_flist (flen); - - for (octave_idx_type i = 0; i < flen; i++) - { - std::string file = flist[i]; - - if (file.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos) - { - if (octave_env::absolute_pathname (file) - || octave_env::rooted_relative_pathname (file)) - { - file_stat fs (file); - - if (fs.exists ()) - retlist.push_back (file); - } - else - { - for (const_dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - std::string tfile = file_ops::concat (p->dir_name, file); - - file_stat fs (tfile); - - if (fs.exists ()) - retlist.push_back (tfile); - } - } - } - else - rel_flist[rel_flen++] = file; - } - - rel_flist.resize (rel_flen); - - for (const_dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - string_vector all_files = p->all_files; - - octave_idx_type len = all_files.length (); - - for (octave_idx_type i = 0; i < len; i++) - { - for (octave_idx_type j = 0; j < rel_flen; j++) - { - if (all_files[i] == rel_flist[j]) - retlist.push_back - (file_ops::concat (p->dir_name, rel_flist[j])); - } - } - } - - return retlist; -} - -string_vector -load_path::do_dirs (void) const -{ - size_t len = dir_info_list.size (); - - string_vector retval (len); - - octave_idx_type k = 0; - - for (const_dir_info_list_iterator i = dir_info_list.begin (); - i != dir_info_list.end (); - i++) - retval[k++] = i->dir_name; - - return retval; -} - -std::list -load_path::do_dir_list (void) const -{ - std::list retval; - - for (const_dir_info_list_iterator i = dir_info_list.begin (); - i != dir_info_list.end (); - i++) - retval.push_back (i->dir_name); - - return retval; -} - -string_vector -load_path::do_files (const std::string& dir, bool omit_exts) const -{ - string_vector retval; - - const_dir_info_list_iterator p = find_dir_info (dir); - - if (p != dir_info_list.end ()) - retval = p->fcn_files; - - if (omit_exts) - { - octave_idx_type len = retval.length (); - - for (octave_idx_type i = 0; i < len; i++) - { - std::string fname = retval[i]; - - size_t pos = fname.rfind ('.'); - - if (pos != std::string::npos) - retval[i] = fname.substr (0, pos); - } - } - - return retval; -} - -string_vector -load_path::do_fcn_names (void) const -{ - size_t len = fcn_map.size (); - - string_vector retval (len); - - octave_idx_type count = 0; - - for (const_fcn_map_iterator p = fcn_map.begin (); - p != fcn_map.end (); - p++) - retval[count++] = p->first; - - return retval; -} - -std::string -load_path::do_path (void) const -{ - std::string xpath; - - string_vector xdirs = load_path::dirs (); - - octave_idx_type len = xdirs.length (); - - if (len > 0) - xpath = xdirs[0]; - - for (octave_idx_type i = 1; i < len; i++) - xpath += dir_path::path_sep_str () + xdirs[i]; - - return xpath; -} - -void -print_types (std::ostream& os, int types) -{ - bool printed_type = false; - - if (types & load_path::OCT_FILE) - { - os << "oct"; - printed_type = true; - } - - if (types & load_path::MEX_FILE) - { - if (printed_type) - os << "|"; - os << "mex"; - printed_type = true; - } - - if (types & load_path::M_FILE) - { - if (printed_type) - os << "|"; - os << "m"; - printed_type = true; - } -} - -void -print_fcn_list (std::ostream& os, - const load_path::dir_info::fcn_file_map_type& lst) -{ - for (load_path::dir_info::const_fcn_file_map_iterator p = lst.begin (); - p != lst.end (); - p++) - { - os << " " << p->first << " ("; - - print_types (os, p->second); - - os << ")\n"; - } -} - -string_vector -get_file_list (const load_path::dir_info::fcn_file_map_type& lst) -{ - octave_idx_type n = lst.size (); - - string_vector retval (n); - - octave_idx_type count = 0; - - for (load_path::dir_info::const_fcn_file_map_iterator p = lst.begin (); - p != lst.end (); - p++) - { - std::string nm = p->first; - - int types = p->second; - - if (types & load_path::OCT_FILE) - nm += ".oct"; - else if (types & load_path::MEX_FILE) - nm += ".mex"; - else - nm += ".m"; - - retval[count++] = nm; - } - - return retval; -} - -void -load_path::do_display (std::ostream& os) const -{ - for (const_dir_info_list_iterator i = dir_info_list.begin (); - i != dir_info_list.end (); - i++) - { - string_vector fcn_files = i->fcn_files; - - if (! fcn_files.empty ()) - { - os << "\n*** function files in " << i->dir_name << ":\n\n"; - - fcn_files.list_in_columns (os); - } - - const dir_info::method_file_map_type& method_file_map - = i->method_file_map; - - if (! method_file_map.empty ()) - { - for (dir_info::const_method_file_map_iterator p = method_file_map.begin (); - p != method_file_map.end (); - p++) - { - os << "\n*** methods in " << i->dir_name - << "/@" << p->first << ":\n\n"; - - const dir_info::class_info& ci = p->second; - - string_vector method_files = get_file_list (ci.method_file_map); - - method_files.list_in_columns (os); - } - } - } - - for (const_private_fcn_map_iterator i = private_fcn_map.begin (); - i != private_fcn_map.end (); i++) - { - os << "\n*** private functions in " - << file_ops::concat (i->first, "private") << ":\n\n"; - - print_fcn_list (os, i->second); - } - -#if defined (DEBUG_LOAD_PATH) - - for (const_fcn_map_iterator i = fcn_map.begin (); - i != fcn_map.end (); - i++) - { - os << i->first << ":\n"; - - const file_info_list_type& file_info_list = i->second; - - for (const_file_info_list_iterator p = file_info_list.begin (); - p != file_info_list.end (); - p++) - { - os << " " << p->dir_name << " ("; - - print_types (os, p->types); - - os << ")\n"; - } - } - - for (const_method_map_iterator i = method_map.begin (); - i != method_map.end (); - i++) - { - os << "CLASS " << i->first << ":\n"; - - const fcn_map_type& fm = i->second; - - for (const_fcn_map_iterator q = fm.begin (); - q != fm.end (); - q++) - { - os << " " << q->first << ":\n"; - - const file_info_list_type& file_info_list = q->second; - - for (const_file_info_list_iterator p = file_info_list.begin (); - p != file_info_list.end (); - p++) - { - os << " " << p->dir_name << " ("; - - print_types (os, p->types); - - os << ")\n"; - } - } - } - - os << "\n"; - -#endif -} - -// True if a path is contained in a path list separated by path_sep_char -static bool -in_path_list (const std::string& path_list, const std::string& path) -{ - size_t ps = path.size (), pls = path_list.size (), pos = path_list.find (path); - char psc = dir_path::path_sep_char (); - while (pos != std::string::npos) - { - if ((pos == 0 || path_list[pos-1] == psc) - && (pos + ps == pls || path_list[pos + ps] == psc)) - return true; - else - pos = path_list.find (path, pos + 1); - } - - return false; -} - -void -load_path::add_to_fcn_map (const dir_info& di, bool at_end) const -{ - std::string dir_name = di.dir_name; - - string_vector fcn_files = di.fcn_files; - - octave_idx_type len = fcn_files.length (); - - for (octave_idx_type i = 0; i < len; i++) - { - std::string fname = fcn_files[i]; - - std::string ext; - std::string base = fname; - - size_t pos = fname.rfind ('.'); - - if (pos != std::string::npos) - { - base = fname.substr (0, pos); - ext = fname.substr (pos); - } - - file_info_list_type& file_info_list = fcn_map[base]; - - file_info_list_iterator p = file_info_list.begin (); - - while (p != file_info_list.end ()) - { - if (p->dir_name == dir_name) - break; - - p++; - } - - int t = 0; - if (ext == ".m") - t = load_path::M_FILE; - else if (ext == ".oct") - t = load_path::OCT_FILE; - else if (ext == ".mex") - t = load_path::MEX_FILE; - - if (p == file_info_list.end ()) - { - file_info fi (dir_name, t); - - if (at_end) - file_info_list.push_back (fi); - else - { - // Warn if a built-in or library function is being shadowed. - - if (! file_info_list.empty ()) - { - file_info& old = file_info_list.front (); - - // FIXME -- do we need to be more careful about the - // way we look for old.dir_name in sys_path to avoid - // partial matches? - - // Don't warn about Contents.m files since we expect - // more than one to exist in the load path. - - if (fname != "Contents.m" - && sys_path.find (old.dir_name) != std::string::npos - && in_path_list (sys_path, old.dir_name)) - { - std::string fcn_path = file_ops::concat (dir_name, fname); - - warning_with_id ("Octave:shadowed-function", - "function %s shadows a core library function", - fcn_path.c_str ()); - } - } - else if (symbol_table::is_built_in_function_name (base)) - { - std::string fcn_path = file_ops::concat (dir_name, fname); - warning_with_id ("Octave:shadowed-function", - "function %s shadows a built-in function", - fcn_path.c_str ()); - } - - file_info_list.push_front (fi); - } - } - else - { - file_info& fi = *p; - - fi.types |= t; - } - } -} - -void -load_path::add_to_private_fcn_map (const dir_info& di) const -{ - dir_info::fcn_file_map_type private_file_map = di.private_file_map; - - if (! private_file_map.empty ()) - private_fcn_map[di.dir_name] = private_file_map; -} - -void -load_path::add_to_method_map (const dir_info& di, bool at_end) const -{ - std::string dir_name = di.dir_name; - - // - dir_info::method_file_map_type method_file_map = di.method_file_map; - - for (dir_info::const_method_file_map_iterator q = method_file_map.begin (); - q != method_file_map.end (); - q++) - { - std::string class_name = q->first; - - fcn_map_type& fm = method_map[class_name]; - - std::string full_dir_name - = file_ops::concat (dir_name, "@" + class_name); - - const dir_info::class_info& ci = q->second; - - // - const dir_info::fcn_file_map_type& m = ci.method_file_map; - - for (dir_info::const_fcn_file_map_iterator p = m.begin (); - p != m.end (); - p++) - { - std::string base = p->first; - - int types = p->second; - - file_info_list_type& file_info_list = fm[base]; - - file_info_list_iterator p2 = file_info_list.begin (); - - while (p2 != file_info_list.end ()) - { - if (p2->dir_name == full_dir_name) - break; - - p2++; - } - - if (p2 == file_info_list.end ()) - { - file_info fi (full_dir_name, types); - - if (at_end) - file_info_list.push_back (fi); - else - file_info_list.push_front (fi); - } - else - { - // FIXME -- is this possible? - - file_info& fi = *p2; - - fi.types = types; - } - } - - // - dir_info::fcn_file_map_type private_file_map = ci.private_file_map; - - if (! private_file_map.empty ()) - private_fcn_map[full_dir_name] = private_file_map; - } -} - -std::string -genpath (const std::string& dirname, const string_vector& skip) -{ - std::string retval; - - dir_entry dir (dirname); - - if (dir) - { - retval = dirname; - - string_vector dirlist = dir.read (); - - octave_idx_type len = dirlist.length (); - - for (octave_idx_type i = 0; i < len; i++) - { - std::string elt = dirlist[i]; - - bool skip_p = (elt == "." || elt == ".." || elt[0] == '@'); - - if (! skip_p) - { - for (octave_idx_type j = 0; j < skip.length (); j++) - { - skip_p = (elt == skip[j]); - if (skip_p) - break; - } - - if (! skip_p) - { - std::string nm = file_ops::concat (dirname, elt); - - file_stat fs (nm); - - if (fs && fs.is_dir ()) - retval += dir_path::path_sep_str () + genpath (nm, skip); - } - } - } - } - - return retval; -} - -static void -execute_pkg_add_or_del (const std::string& dir, - const std::string& script_file) -{ - if (! octave_interpreter_ready) - return; - - unwind_protect frame; - - std::string file = file_ops::concat (dir, script_file); - - file_stat fs (file); - - if (fs.exists ()) - source_file (file, "base"); -} - -void -execute_pkg_add (const std::string& dir) -{ - execute_pkg_add_or_del (dir, "PKG_ADD"); -} - -void -execute_pkg_del (const std::string& dir) -{ - execute_pkg_add_or_del (dir, "PKG_DEL"); -} - -DEFUN (genpath, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} genpath (@var{dir})\n\ -@deftypefnx {Built-in Function} {} genpath (@var{dir}, @var{skip}, @dots{})\n\ -Return a path constructed from @var{dir} and all its subdirectories.\n\ -If additional string parameters are given, the resulting path will\n\ -exclude directories with those names.\n\ -@end deftypefn") -{ - octave_value retval; - - octave_idx_type nargin = args.length (); - - if (nargin == 1) - { - std::string dirname = args(0).string_value (); - - if (! error_state) - retval = genpath (dirname); - else - error ("genpath: DIR must be a character string"); - } - else if (nargin > 1) - { - std::string dirname = args(0).string_value (); - - string_vector skip (nargin - 1); - - for (octave_idx_type i = 1; i < nargin; i++) - { - skip[i-1] = args(i).string_value (); - - if (error_state) - break; - } - - if (! error_state) - retval = genpath (dirname, skip); - else - error ("genpath: all arguments must be character strings"); - } - else - print_usage (); - - return retval; -} - -static void -rehash_internal (void) -{ - load_path::update (); - - // FIXME -- maybe we should rename this variable since it is being - // used for more than keeping track of the prompt time. - - // This will force updated functions to be found. - Vlast_prompt_time.stamp (); -} - -DEFUN (rehash, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} rehash ()\n\ -Reinitialize Octave's load path directory cache.\n\ -@end deftypefn") -{ - octave_value_list retval; - - rehash_internal (); - - return retval; -} - -DEFUN (command_line_path, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} command_line_path (@dots{})\n\ -Return the command line path variable.\n\ -\n\ -@seealso{path, addpath, rmpath, genpath, pathdef, savepath, pathsep}\n\ -@end deftypefn") -{ - return octave_value (load_path::get_command_line_path ()); -} - -DEFUN (restoredefaultpath, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} restoredefaultpath (@dots{})\n\ -Restore Octave's path to its initial state at startup.\n\ -\n\ -@seealso{path, addpath, rmpath, genpath, pathdef, savepath, pathsep}\n\ -@end deftypefn") -{ - load_path::initialize (true); - - return octave_value (load_path::system_path ()); -} - -// Return Octave's original default list of directories in which to -// search for function files. This corresponds to the path that -// exists prior to running the system's octaverc file or the user's -// ~/.octaverc file - -DEFUN (__pathorig__, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} __pathorig__ ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - return octave_value (load_path::system_path ()); -} - -DEFUN (path, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} path (@dots{})\n\ -Modify or display Octave's load path.\n\ -\n\ -If @var{nargin} and @var{nargout} are zero, display the elements of\n\ -Octave's load path in an easy to read format.\n\ -\n\ -If @var{nargin} is zero and nargout is greater than zero, return the\n\ -current load path.\n\ -\n\ -If @var{nargin} is greater than zero, concatenate the arguments,\n\ -separating them with @code{pathsep}. Set the internal search path\n\ -to the result and return it.\n\ -\n\ -No checks are made for duplicate elements.\n\ -@seealso{addpath, rmpath, genpath, pathdef, savepath, pathsep}\n\ -@end deftypefn") -{ - octave_value retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("path"); - - if (! error_state) - { - if (argc > 1) - { - std::string path = argv[1]; - - for (int i = 2; i < argc; i++) - path += dir_path::path_sep_str () + argv[i]; - - load_path::set (path, true); - - rehash_internal (); - } - - if (nargout > 0) - retval = load_path::path (); - else if (argc == 1 && nargout == 0) - { - octave_stdout << "\nOctave's search path contains the following directories:\n\n"; - - string_vector dirs = load_path::dirs (); - - dirs.list_in_columns (octave_stdout); - - octave_stdout << "\n"; - } - } - - return retval; -} - -DEFUN (addpath, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} addpath (@var{dir1}, @dots{})\n\ -@deftypefnx {Built-in Function} {} addpath (@var{dir1}, @dots{}, @var{option})\n\ -Add named directories to the function search path. If\n\ -@var{option} is \"-begin\" or 0 (the default), prepend the\n\ -directory name to the current path. If @var{option} is \"-end\"\n\ -or 1, append the directory name to the current path.\n\ -Directories added to the path must exist.\n\ -\n\ -In addition to accepting individual directory arguments, lists of\n\ -directory names separated by @code{pathsep} are also accepted. For example:\n\ -\n\ -@example\n\ -addpath (\"dir1:/dir2:~/dir3\")\n\ -@end example\n\ -@seealso{path, rmpath, genpath, pathdef, savepath, pathsep}\n\ -@end deftypefn") -{ - octave_value retval; - - // Originally written by Bill Denney and Etienne Grossman. Heavily - // modified and translated to C++ by jwe. - - if (nargout > 0) - retval = load_path::path (); - - int nargin = args.length (); - - if (nargin > 0) - { - bool append = false; - - octave_value option_arg = args(nargin-1); - - if (option_arg.is_string ()) - { - std::string option = option_arg.string_value (); - - if (option == "-end") - { - append = true; - nargin--; - } - else if (option == "-begin") - nargin--; - } - else if (option_arg.is_numeric_type ()) - { - int val = option_arg.int_value (); - - if (! error_state) - { - if (val == 0) - nargin--; - else if (val == 1) - { - append = true; - nargin--; - } - else - { - error ("addpath: expecting final argument to be 1 or 0"); - return retval; - } - } - else - { - error ("addpath: expecting final argument to be 1 or 0"); - return retval; - } - } - - bool need_to_update = false; - - for (int i = 0; i < nargin; i++) - { - std::string arg = args(i).string_value (); - - if (! error_state) - { - std::list dir_elts = split_path (arg); - - if (! append) - std::reverse (dir_elts.begin (), dir_elts.end ()); - - for (std::list::const_iterator p = dir_elts.begin (); - p != dir_elts.end (); - p++) - { - std::string dir = *p; - - //dir = regexprep (dir_elts{j}, '//+', "/"); - //dir = regexprep (dir, '/$', ""); - - if (append) - load_path::append (dir, true); - else - load_path::prepend (dir, true); - - need_to_update = true; - } - } - else - error ("addpath: all arguments must be character strings"); - } - - if (need_to_update) - rehash_internal (); - } - else - print_usage (); - - return retval; -} - -DEFUN (rmpath, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} rmpath (@var{dir1}, @dots{})\n\ -Remove @var{dir1}, @dots{} from the current function search path.\n\ -\n\ -In addition to accepting individual directory arguments, lists of\n\ -directory names separated by @code{pathsep} are also accepted. For example:\n\ -\n\ -@example\n\ -rmpath (\"dir1:/dir2:~/dir3\")\n\ -@end example\n\ -@seealso{path, addpath, genpath, pathdef, savepath, pathsep}\n\ -@end deftypefn") -{ - // Originally by Etienne Grossmann. Heavily modified and translated - // to C++ by jwe. - - octave_value retval; - - if (nargout > 0) - retval = load_path::path (); - - int nargin = args.length (); - - if (nargin > 0) - { - bool need_to_update = false; - - for (int i = 0; i < nargin; i++) - { - std::string arg = args(i).string_value (); - - if (! error_state) - { - std::list dir_elts = split_path (arg); - - for (std::list::const_iterator p = dir_elts.begin (); - p != dir_elts.end (); - p++) - { - std::string dir = *p; - - //dir = regexprep (dir_elts{j}, '//+', "/"); - //dir = regexprep (dir, '/$', ""); - - if (! load_path::remove (dir)) - warning ("rmpath: %s: not found", dir.c_str ()); - else - need_to_update = true; - } - } - else - error ("addpath: all arguments must be character strings"); - } - - if (need_to_update) - rehash_internal (); - } - else - print_usage (); - - return retval; -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/load-path.h --- a/libinterp/interpfcn/load-path.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,573 +0,0 @@ -/* - -Copyright (C) 2006-2012 John W. Eaton -Copyright (C) 2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_load_path_h) -#define octave_load_path_h 1 - -#include -#include -#include -#include - -#include "pathsearch.h" -#include "str-vec.h" - -class -OCTINTERP_API -load_path -{ -protected: - - load_path (void) - : dir_info_list (), fcn_map (), private_fcn_map (), method_map (), - init_dirs () { } - -public: - - typedef void (*hook_fcn_ptr) (const std::string& dir); - - ~load_path (void) { } - - static void initialize (bool set_initial_path = false) - { - if (instance_ok ()) - instance->do_initialize (set_initial_path); - } - - static void clear (void) - { - if (instance_ok ()) - instance->do_clear (); - } - - static void set (const std::string& p, bool warn = false) - { - if (instance_ok ()) - instance->do_set (p, warn); - } - - static void append (const std::string& dir, bool warn = false) - { - if (instance_ok ()) - instance->do_append (dir, warn); - } - - static void prepend (const std::string& dir, bool warn = false) - { - if (instance_ok ()) - instance->do_prepend (dir, warn); - } - - static bool remove (const std::string& dir) - { - return instance_ok () ? instance->do_remove (dir) : false; - } - - static void update (void) - { - if (instance_ok ()) - instance->do_update (); - } - - static bool contains_canonical (const std::string& dir_name) - { - return instance_ok () ? instance->do_contains_canonical (dir_name) : false; - } - - static std::string find_method (const std::string& class_name, - const std::string& meth, - std::string& dir_name) - { - return instance_ok () - ? instance->do_find_method (class_name, meth, dir_name) : std::string (); - } - - static std::string find_method (const std::string& class_name, - const std::string& meth) - { - std::string dir_name; - return find_method (class_name, meth, dir_name); - } - - static std::list methods (const std::string& class_name) - { - return instance_ok () - ? instance->do_methods (class_name) : std::list (); - } - - static std::list overloads (const std::string& meth) - { - return instance_ok () - ? instance->do_overloads (meth) : std::list (); - } - - static std::string find_fcn (const std::string& fcn, std::string& dir_name) - { - return instance_ok () - ? instance->do_find_fcn (fcn, dir_name) : std::string (); - } - - static std::string find_fcn (const std::string& fcn) - { - std::string dir_name; - return find_fcn (fcn, dir_name); - } - - static std::string find_private_fcn (const std::string& dir, - const std::string& fcn) - { - return instance_ok () - ? instance->do_find_private_fcn (dir, fcn) : std::string (); - } - - static std::string find_fcn_file (const std::string& fcn) - { - std::string dir_name; - - return instance_ok () ? - instance->do_find_fcn (fcn, dir_name, M_FILE) : std::string (); - } - - static std::string find_oct_file (const std::string& fcn) - { - std::string dir_name; - - return instance_ok () ? - instance->do_find_fcn (fcn, dir_name, OCT_FILE) : std::string (); - } - - static std::string find_mex_file (const std::string& fcn) - { - std::string dir_name; - - return instance_ok () ? - instance->do_find_fcn (fcn, dir_name, MEX_FILE) : std::string (); - } - - static std::string find_file (const std::string& file) - { - return instance_ok () - ? instance->do_find_file (file) : std::string (); - } - - static std::string find_dir (const std::string& dir) - { - return instance_ok () - ? instance->do_find_dir (dir) : std::string (); - } - - static string_vector find_matching_dirs (const std::string& dir) - { - return instance_ok () - ? instance->do_find_matching_dirs (dir) : string_vector (); - } - - static std::string find_first_of (const string_vector& files) - { - return instance_ok () ? - instance->do_find_first_of (files) : std::string (); - } - - static string_vector find_all_first_of (const string_vector& files) - { - return instance_ok () ? - instance->do_find_all_first_of (files) : string_vector (); - } - - static string_vector dirs (void) - { - return instance_ok () ? instance->do_dirs () : string_vector (); - } - - static std::list dir_list (void) - { - return instance_ok () - ? instance->do_dir_list () : std::list (); - } - - static string_vector files (const std::string& dir, bool omit_exts = false) - { - return instance_ok () - ? instance->do_files (dir, omit_exts) : string_vector (); - } - - static string_vector fcn_names (void) - { - return instance_ok () ? instance->do_fcn_names () : string_vector (); - } - - static std::string path (void) - { - return instance_ok () ? instance->do_path () : std::string (); - } - - static void display (std::ostream& os) - { - if (instance_ok ()) - instance->do_display (os); - } - - static void set_add_hook (hook_fcn_ptr f) { add_hook = f; } - - static void set_remove_hook (hook_fcn_ptr f) { remove_hook = f; } - - static void set_command_line_path (const std::string& p) - { - if (command_line_path.empty ()) - command_line_path = p; - else - command_line_path += dir_path::path_sep_str () + p; - } - - static std::string get_command_line_path (void) - { - return instance_ok () ? instance->do_get_command_line_path () : std::string (); - } - - static std::string system_path (void) - { - return instance_ok () ? instance->do_system_path () : std::string (); - } - -private: - - static const int M_FILE = 1; - static const int OCT_FILE = 2; - static const int MEX_FILE = 4; - - class dir_info - { - public: - - // - typedef std::map fcn_file_map_type; - - typedef fcn_file_map_type::const_iterator const_fcn_file_map_iterator; - typedef fcn_file_map_type::iterator fcn_file_map_iterator; - - struct class_info - { - class_info (void) : method_file_map (), private_file_map () { } - - class_info (const class_info& ci) - : method_file_map (ci.method_file_map), - private_file_map (ci.private_file_map) { } - - class_info& operator = (const class_info& ci) - { - if (this != &ci) - { - method_file_map = ci.method_file_map; - private_file_map = ci.private_file_map; - } - return *this; - } - - ~class_info (void) { } - - fcn_file_map_type method_file_map; - fcn_file_map_type private_file_map; - }; - - // - typedef std::map method_file_map_type; - - typedef method_file_map_type::const_iterator const_method_file_map_iterator; - typedef method_file_map_type::iterator method_file_map_iterator; - - // This default constructor is only provided so we can create a - // std::map of dir_info objects. You should not use this - // constructor for any other purpose. - dir_info (void) - : dir_name (), abs_dir_name (), is_relative (false), - dir_mtime (), dir_time_last_checked (), - all_files (), fcn_files (), private_file_map (), method_file_map () - { } - - dir_info (const std::string& d) - : dir_name (d), abs_dir_name (), is_relative (false), - dir_mtime (), dir_time_last_checked (), - all_files (), fcn_files (), private_file_map (), method_file_map () - { - initialize (); - } - - dir_info (const dir_info& di) - : dir_name (di.dir_name), abs_dir_name (di.abs_dir_name), - is_relative (di.is_relative), - dir_mtime (di.dir_mtime), - dir_time_last_checked (di.dir_time_last_checked), - all_files (di.all_files), fcn_files (di.fcn_files), - private_file_map (di.private_file_map), - method_file_map (di.method_file_map) { } - - ~dir_info (void) { } - - dir_info& operator = (const dir_info& di) - { - if (&di != this) - { - dir_name = di.dir_name; - abs_dir_name = di.abs_dir_name; - is_relative = di.is_relative; - dir_mtime = di.dir_mtime; - dir_time_last_checked = di.dir_time_last_checked; - all_files = di.all_files; - fcn_files = di.fcn_files; - private_file_map = di.private_file_map; - method_file_map = di.method_file_map; - } - - return *this; - } - - void update (void); - - std::string dir_name; - std::string abs_dir_name; - bool is_relative; - octave_time dir_mtime; - octave_time dir_time_last_checked; - string_vector all_files; - string_vector fcn_files; - fcn_file_map_type private_file_map; - method_file_map_type method_file_map; - - private: - - void initialize (void); - - void get_file_list (const std::string& d); - - void get_private_file_map (const std::string& d); - - void get_method_file_map (const std::string& d, - const std::string& class_name); - - friend fcn_file_map_type get_fcn_files (const std::string& d); - }; - - class file_info - { - public: - - file_info (const std::string& d, int t) : dir_name (d), types (t) { } - - file_info (const file_info& fi) - : dir_name (fi.dir_name), types (fi.types) { } - - ~file_info (void) { } - - file_info& operator = (const file_info& fi) - { - if (&fi != this) - { - dir_name = fi.dir_name; - types = fi.types; - } - - return *this; - } - - std::string dir_name; - int types; - }; - - // We maintain two ways of looking at the same information. - // - // First, a list of directories and the set of "public" files and - // private files (those found in the special "private" subdirectory) - // in each directory. - // - // Second, a map from file names (the union of all "public" files for all - // directories, but without filename extensions) to a list of - // corresponding information (directory name and file types). This - // way, we can quickly find shadowed file names and look up all - // overloaded functions (in the "@" directories used to implement - // classes). - - typedef std::list dir_info_list_type; - - typedef dir_info_list_type::const_iterator const_dir_info_list_iterator; - typedef dir_info_list_type::iterator dir_info_list_iterator; - - typedef std::map abs_dir_cache_type; - - typedef abs_dir_cache_type::const_iterator const_abs_dir_cache_iterator; - typedef abs_dir_cache_type::iterator abs_dir_cache_iterator; - - typedef std::list file_info_list_type; - - typedef file_info_list_type::const_iterator const_file_info_list_iterator; - typedef file_info_list_type::iterator file_info_list_iterator; - - // - typedef std::map fcn_map_type; - - typedef fcn_map_type::const_iterator const_fcn_map_iterator; - typedef fcn_map_type::iterator fcn_map_iterator; - - // > - typedef std::map private_fcn_map_type; - - typedef private_fcn_map_type::const_iterator const_private_fcn_map_iterator; - typedef private_fcn_map_type::iterator private_fcn_map_iterator; - - // > - typedef std::map method_map_type; - - typedef method_map_type::const_iterator const_method_map_iterator; - typedef method_map_type::iterator method_map_iterator; - - mutable dir_info_list_type dir_info_list; - - mutable fcn_map_type fcn_map; - - mutable private_fcn_map_type private_fcn_map; - - mutable method_map_type method_map; - - mutable std::set init_dirs; - - static load_path *instance; - - static void cleanup_instance (void) { delete instance; instance = 0; } - - static hook_fcn_ptr add_hook; - - static hook_fcn_ptr remove_hook; - - static std::string command_line_path; - - static std::string sys_path; - - static abs_dir_cache_type abs_dir_cache; - - static bool instance_ok (void); - - const_dir_info_list_iterator find_dir_info (const std::string& dir) const; - dir_info_list_iterator find_dir_info (const std::string& dir); - - bool contains (const std::string& dir) const; - - bool do_contains_canonical (const std::string& dir) const; - - void move_fcn_map (const std::string& dir, - const string_vector& fcn_files, bool at_end); - - void move_method_map (const std::string& dir, bool at_end); - - void move (std::list::iterator i, bool at_end); - - void do_initialize (bool set_initial_path); - - void do_clear (void); - - void do_set (const std::string& p, bool warn, bool is_init = false); - - void do_append (const std::string& dir, bool warn); - - void do_prepend (const std::string& dir, bool warn); - - void do_add (const std::string& dir, bool at_end, bool warn); - - void remove_fcn_map (const std::string& dir, const string_vector& fcn_files); - - void remove_private_fcn_map (const std::string& dir); - - void remove_method_map (const std::string& dir); - - bool do_remove (const std::string& dir); - - void do_update (void) const; - - static bool - check_file_type (std::string& fname, int type, int possible_types, - const std::string& fcn, const char *who); - - std::string do_find_fcn (const std::string& fcn, - std::string& dir_name, - int type = M_FILE | OCT_FILE | MEX_FILE) const; - - std::string do_find_private_fcn (const std::string& dir, - const std::string& fcn, - int type = M_FILE | OCT_FILE | MEX_FILE) const; - - std::string do_find_method (const std::string& class_name, - const std::string& meth, - std::string& dir_name, - int type = M_FILE | OCT_FILE | MEX_FILE) const; - - std::list do_methods (const std::string& class_name) const; - - std::list do_overloads (const std::string& meth) const; - - std::string do_find_file (const std::string& file) const; - - std::string do_find_dir (const std::string& dir) const; - - string_vector do_find_matching_dirs (const std::string& dir) const; - - std::string do_find_first_of (const string_vector& files) const; - - string_vector do_find_all_first_of (const string_vector& files) const; - - string_vector do_dirs (void) const; - - std::list do_dir_list (void) const; - - string_vector do_files (const std::string& dir, bool omit_exts) const; - - string_vector do_fcn_names (void) const; - - std::string do_path (void) const; - - friend void print_types (std::ostream& os, int types); - - friend string_vector get_file_list (const dir_info::fcn_file_map_type& lst); - - friend void - print_fcn_list (std::ostream& os, const dir_info::fcn_file_map_type& lst); - - void do_display (std::ostream& os) const; - - std::string do_system_path (void) const { return sys_path; } - - std::string do_get_command_line_path (void) const { return command_line_path; } - - void add_to_fcn_map (const dir_info& di, bool at_end) const; - - void add_to_private_fcn_map (const dir_info& di) const; - - void add_to_method_map (const dir_info& di, bool at_end) const; - - friend dir_info::fcn_file_map_type get_fcn_files (const std::string& d); -}; - -extern std::string -genpath (const std::string& dir, const string_vector& skip = "private"); - -extern void execute_pkg_add (const std::string& dir); -extern void execute_pkg_del (const std::string& dir); - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/load-save.cc --- a/libinterp/interpfcn/load-save.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1882 +0,0 @@ -/* - -Copyright (C) 1994-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Author: John W. Eaton. -// HDF5 support by Steven G. Johnson -// Matlab v5 support by James R. Van Zandt - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include -#include -#include -#include -#include - -#include "strftime.h" - -#include "byte-swap.h" -#include "data-conv.h" -#include "file-ops.h" -#include "file-stat.h" -#include "glob-match.h" -#include "lo-mappers.h" -#include "mach-info.h" -#include "oct-env.h" -#include "oct-time.h" -#include "quit.h" -#include "str-vec.h" -#include "oct-locbuf.h" - -#include "Cell.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "load-path.h" -#include "load-save.h" -#include "oct-obj.h" -#include "oct-map.h" -#include "ov-cell.h" -#include "pager.h" -#include "pt-exp.h" -#include "symtab.h" -#include "sysdep.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" -#include "version.h" -#include "dMatrix.h" - -#include "ls-hdf5.h" -#include "ls-mat-ascii.h" -#include "ls-mat4.h" -#include "ls-mat5.h" -#include "ls-oct-ascii.h" -#include "ls-oct-binary.h" - -// Remove gnulib definitions, if any. -#ifdef close -#undef close -#endif -#ifdef open -#undef open -#endif - -#ifdef HAVE_ZLIB -#include "zfstream.h" -#endif - -// Write octave-workspace file if Octave crashes or is killed by a signal. -static bool Vcrash_dumps_octave_core = true; - -// The maximum amount of memory (in kilobytes) that we will attempt to -// write to the Octave core file. -static double Voctave_core_file_limit = -1.0; - -// The name of the Octave core file. -static std::string Voctave_core_file_name = "octave-workspace"; - -// The default output format. May be one of "binary", "text", -// "mat-binary", or "hdf5". -static std::string Vsave_default_options = "-text"; - -// The output format for Octave core files. -static std::string Voctave_core_file_options = "-binary"; - -static std::string -default_save_header_format (void) -{ - return - std::string ("# Created by Octave " OCTAVE_VERSION - ", %a %b %d %H:%M:%S %Y %Z <") - + octave_env::get_user_name () - + std::string ("@") - + octave_env::get_host_name () - + std::string (">"); -} - -// The format string for the comment line at the top of text-format -// save files. Passed to strftime. Should begin with '#' and contain -// no newline characters. -static std::string Vsave_header_format_string = default_save_header_format (); - -static void -gripe_file_open (const std::string& fcn, const std::string& file) -{ - if (fcn == "load") - error ("%s: unable to open input file '%s'", fcn.c_str (), file.c_str ()); - else if (fcn == "save") - error ("%s: unable to open output file '%s'", fcn.c_str (), file.c_str ()); - else - error ("%s: unable to open file '%s'", fcn.c_str (), file.c_str ()); -} - -// Install a variable with name NAME and the value VAL in the -// symbol table. If GLOBAL is TRUE, make the variable global. - -static void -install_loaded_variable (const std::string& name, - const octave_value& val, - bool global, const std::string& /*doc*/) -{ - if (global) - { - symbol_table::clear (name); - symbol_table::mark_global (name); - symbol_table::global_assign (name, val); - } - else - symbol_table::assign (name, val); -} - -// Return TRUE if NAME matches one of the given globbing PATTERNS. - -static bool -matches_patterns (const string_vector& patterns, int pat_idx, - int num_pat, const std::string& name) -{ - for (int i = pat_idx; i < num_pat; i++) - { - glob_match pattern (patterns[i]); - - if (pattern.match (name)) - return true; - } - - return false; -} - -int -read_binary_file_header (std::istream& is, bool& swap, - oct_mach_info::float_format& flt_fmt, bool quiet) -{ - const int magic_len = 10; - char magic[magic_len+1]; - is.read (magic, magic_len); - magic[magic_len] = '\0'; - - if (strncmp (magic, "Octave-1-L", magic_len) == 0) - swap = oct_mach_info::words_big_endian (); - else if (strncmp (magic, "Octave-1-B", magic_len) == 0) - swap = ! oct_mach_info::words_big_endian (); - else - { - if (! quiet) - error ("load: unable to read read binary file"); - return -1; - } - - char tmp = 0; - is.read (&tmp, 1); - - flt_fmt = mopt_digit_to_float_format (tmp); - - if (flt_fmt == oct_mach_info::flt_fmt_unknown) - { - if (! quiet) - error ("load: unrecognized binary format!"); - - return -1; - } - - return 0; -} - -#ifdef HAVE_ZLIB -static bool -check_gzip_magic (const std::string& fname) -{ - bool retval = false; - std::ifstream file (fname.c_str ()); - OCTAVE_LOCAL_BUFFER (unsigned char, magic, 2); - - if (file.read (reinterpret_cast (magic), 2) && magic[0] == 0x1f && - magic[1] == 0x8b) - retval = true; - - file.close (); - return retval; -} -#endif - -static load_save_format -get_file_format (std::istream& file, const std::string& filename) -{ - load_save_format retval = LS_UNKNOWN; - - oct_mach_info::float_format flt_fmt = oct_mach_info::flt_fmt_unknown; - - bool swap = false; - - if (read_binary_file_header (file, swap, flt_fmt, true) == 0) - retval = LS_BINARY; - else - { - file.clear (); - file.seekg (0, std::ios::beg); - - int32_t mopt, nr, nc, imag, len; - - int err = read_mat_file_header (file, swap, mopt, nr, nc, imag, len, - true); - - if (! err) - retval = LS_MAT_BINARY; - else - { - file.clear (); - file.seekg (0, std::ios::beg); - - err = read_mat5_binary_file_header (file, swap, true, filename); - - if (! err) - { - file.clear (); - file.seekg (0, std::ios::beg); - retval = LS_MAT5_BINARY; - } - else - { - file.clear (); - file.seekg (0, std::ios::beg); - - std::string tmp = extract_keyword (file, "name"); - - if (! tmp.empty ()) - retval = LS_ASCII; - } - } - } - - return retval; -} - -static load_save_format -get_file_format (const std::string& fname, const std::string& orig_fname, - bool &use_zlib, bool quiet = false) -{ - load_save_format retval = LS_UNKNOWN; - -#ifdef HAVE_HDF5 - // check this before we open the file - if (H5Fis_hdf5 (fname.c_str ()) > 0) - return LS_HDF5; -#endif /* HAVE_HDF5 */ - - std::ifstream file (fname.c_str ()); - use_zlib = false; - - if (file) - { - retval = get_file_format (file, orig_fname); - file.close (); - -#ifdef HAVE_ZLIB - if (retval == LS_UNKNOWN && check_gzip_magic (fname)) - { - gzifstream gzfile (fname.c_str ()); - use_zlib = true; - - if (gzfile) - { - retval = get_file_format (gzfile, orig_fname); - gzfile.close (); - } - } -#endif - - // FIXME -- looks_like_mat_ascii_file does not check to see - // whether the file contains numbers. It just skips comments and - // checks for the same number of words on each line. We may need - // a better check here. The best way to do that might be just - // to try to read the file and see if it works. - - if (retval == LS_UNKNOWN && looks_like_mat_ascii_file (fname)) - retval = LS_MAT_ASCII; - } - else if (! quiet) - gripe_file_open ("load", orig_fname); - - return retval; -} - -octave_value -do_load (std::istream& stream, const std::string& orig_fname, - load_save_format format, oct_mach_info::float_format flt_fmt, - bool list_only, bool swap, bool verbose, - const string_vector& argv, int argv_idx, int argc, int nargout) -{ - octave_value retval; - - octave_scalar_map retstruct; - - std::ostringstream output_buf; - std::list symbol_names; - - octave_idx_type count = 0; - - for (;;) - { - bool global = false; - octave_value tc; - - std::string name; - std::string doc; - - switch (format.type) - { - case LS_ASCII: - name = read_ascii_data (stream, orig_fname, global, tc, count); - break; - - case LS_BINARY: - name = read_binary_data (stream, swap, flt_fmt, orig_fname, - global, tc, doc); - break; - - case LS_MAT_ASCII: - name = read_mat_ascii_data (stream, orig_fname, tc); - break; - - case LS_MAT_BINARY: - name = read_mat_binary_data (stream, orig_fname, tc); - break; - -#ifdef HAVE_HDF5 - case LS_HDF5: - name = read_hdf5_data (stream, orig_fname, global, tc, doc); - break; -#endif /* HAVE_HDF5 */ - - case LS_MAT5_BINARY: - case LS_MAT7_BINARY: - name = read_mat5_binary_element (stream, orig_fname, swap, - global, tc); - break; - - default: - gripe_unrecognized_data_fmt ("load"); - break; - } - - if (error_state || stream.eof () || name.empty ()) - break; - else if (! error_state && ! name.empty ()) - { - if (tc.is_defined ()) - { - if (format == LS_MAT_ASCII && argv_idx < argc) - warning ("load: loaded ASCII file '%s' -- ignoring extra args", - orig_fname.c_str ()); - - if (format == LS_MAT_ASCII - || argv_idx == argc - || matches_patterns (argv, argv_idx, argc, name)) - { - count++; - if (list_only) - { - if (verbose) - { - if (count == 1) - output_buf - << "type rows cols name\n" - << "==== ==== ==== ====\n"; - - output_buf - << std::setiosflags (std::ios::left) - << std::setw (16) << tc.type_name () . c_str () - << std::setiosflags (std::ios::right) - << std::setw (7) << tc.rows () - << std::setw (7) << tc.columns () - << " " << name << "\n"; - } - else - symbol_names.push_back (name); - } - else - { - if (nargout == 1) - { - if (format == LS_MAT_ASCII) - retval = tc; - else - retstruct.assign (name, tc); - } - else - install_loaded_variable (name, tc, global, doc); - } - } - - // Only attempt to read one item from a headless text file. - - if (format == LS_MAT_ASCII) - break; - } - else - error ("load: unable to load variable '%s'", name.c_str ()); - } - else - { - if (count == 0) - error ("load: are you sure '%s' is an Octave data file?", - orig_fname.c_str ()); - - break; - } - } - - if (list_only && count) - { - if (verbose) - { - std::string msg = output_buf.str (); - - if (nargout > 0) - retval = msg; - else - octave_stdout << msg; - } - else - { - if (nargout > 0) - retval = Cell (string_vector (symbol_names)); - else - { - string_vector names (symbol_names); - - names.list_in_columns (octave_stdout); - - octave_stdout << "\n"; - } - } - } - else if (retstruct.nfields () != 0) - retval = retstruct; - - return retval; -} - -std::string -find_file_to_load (const std::string& name, const std::string& orig_name) -{ - std::string fname = name; - - if (! (octave_env::absolute_pathname (fname) - || octave_env::rooted_relative_pathname (fname))) - { - file_stat fs (fname); - - if (! (fs.exists () && fs.is_reg ())) - { - std::string tmp - = octave_env::make_absolute (load_path::find_file (fname)); - - if (! tmp.empty ()) - { - warning_with_id ("Octave:load-file-in-path", - "load: file found in load path"); - fname = tmp; - } - } - } - - size_t dot_pos = fname.rfind ("."); - size_t sep_pos = fname.find_last_of (file_ops::dir_sep_chars ()); - - if (dot_pos == std::string::npos - || (sep_pos != std::string::npos && dot_pos < sep_pos)) - { - // Either no '.' in name or no '.' appears after last directory - // separator. - - file_stat fs (fname); - - if (! (fs.exists () && fs.is_reg ())) - fname = find_file_to_load (fname + ".mat", orig_name); - } - else - { - file_stat fs (fname); - - if (! (fs.exists () && fs.is_reg ())) - { - fname = ""; - - error ("load: unable to find file %s", orig_name.c_str ()); - } - } - - return fname; -} - -bool -is_octave_data_file (const std::string& fname) -{ - bool use_zlib = false; - return get_file_format (fname, fname, use_zlib, true) != LS_UNKNOWN; -} - -DEFUN (load, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Command} {} load file\n\ -@deftypefnx {Command} {} load options file\n\ -@deftypefnx {Command} {} load options file v1 v2 @dots{}\n\ -@deftypefnx {Command} {S =} load (\"options\", \"file\", \"v1\", \"v2\", @dots{})\n\ -@deftypefnx {Command} {} load file options\n\ -@deftypefnx {Command} {} load file options v1 v2 @dots{}\n\ -@deftypefnx {Command} {S =} load (\"file\", \"options\", \"v1\", \"v2\", @dots{})\n\ -Load the named variables @var{v1}, @var{v2}, @dots{}, from the file\n\ -@var{file}. If no variables are specified then all variables found in the\n\ -file will be loaded. As with @code{save}, the list of variables to extract\n\ -can be full names or use a pattern syntax. The format of the file is\n\ -automatically detected but may be overridden by supplying the appropriate\n\ -option.\n\ -\n\ -If load is invoked using the functional form\n\ -\n\ -@example\n\ -load (\"-option1\", @dots{}, \"file\", \"v1\", @dots{})\n\ -@end example\n\ -\n\ -@noindent\n\ -then the @var{options}, @var{file}, and variable name arguments\n\ -(@var{v1}, @dots{}) must be specified as character strings.\n\ -\n\ -If a variable that is not marked as global is loaded from a file when a\n\ -global symbol with the same name already exists, it is loaded in the\n\ -global symbol table. Also, if a variable is marked as global in a file\n\ -and a local symbol exists, the local symbol is moved to the global\n\ -symbol table and given the value from the file.\n\ -\n\ -If invoked with a single output argument, Octave returns data instead\n\ -of inserting variables in the symbol table. If the data file contains\n\ -only numbers (TAB- or space-delimited columns), a matrix of values is\n\ -returned. Otherwise, @code{load} returns a structure with members\n\ - corresponding to the names of the variables in the file.\n\ -\n\ -The @code{load} command can read data stored in Octave's text and\n\ -binary formats, and @sc{matlab}'s binary format. If compiled with zlib\n\ -support, it can also load gzip-compressed files. It will automatically\n\ -detect the type of file and do conversion from different floating point\n\ -formats (currently only IEEE big and little endian, though other formats\n\ -may be added in the future).\n\ -\n\ -Valid options for @code{load} are listed in the following table.\n\ -\n\ -@table @code\n\ -@item -force\n\ -This option is accepted for backward compatibility but is ignored.\n\ -Octave now overwrites variables currently in memory with\n\ -those of the same name found in the file.\n\ -\n\ -@item -ascii\n\ -Force Octave to assume the file contains columns of numbers in text format\n\ -without any header or other information. Data in the file will be loaded\n\ -as a single numeric matrix with the name of the variable derived from the\n\ -name of the file.\n\ -\n\ -@item -binary\n\ -Force Octave to assume the file is in Octave's binary format.\n\ -\n\ -@item -hdf5\n\ -Force Octave to assume the file is in @sc{hdf5} format.\n\ -(@sc{hdf5} is a free, portable binary format developed by the National\n\ -Center for Supercomputing Applications at the University of Illinois.)\n\ -Note that Octave can read @sc{hdf5} files not created by itself, but may\n\ -skip some datasets in formats that it cannot support. This format is\n\ -only available if Octave was built with a link to the @sc{hdf5} libraries.\n\ -\n\ -@item -import\n\ -This option is accepted for backward compatibility but is ignored.\n\ -Octave can now support multi-dimensional HDF data and automatically\n\ -modifies variable names if they are invalid Octave identifiers.\n\ -\n\ -@item -mat\n\ -@itemx -mat-binary\n\ -@itemx -6\n\ -@itemx -v6\n\ -@itemx -7\n\ -@itemx -v7\n\ -Force Octave to assume the file is in @sc{matlab}'s version 6 or 7 binary\n\ -format.\n\ -\n\ -@item -mat4-binary\n\ -@itemx -4\n\ -@itemx -v4\n\ -@itemx -V4\n\ -Force Octave to assume the file is in the binary format written by\n\ -@sc{matlab} version 4.\n\ -\n\ -@item -text\n\ -Force Octave to assume the file is in Octave's text format.\n\ -@end table\n\ -@seealso{save, dlmwrite, csvwrite, fwrite}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("load"); - - if (error_state) - return retval; - - int i = 1; - std::string orig_fname = ""; - - // Function called with Matlab-style ["filename", options] syntax - if (argc > 1 && ! argv[1].empty () && argv[1].at (0) != '-') - { - orig_fname = argv[1]; - i++; - } - - // It isn't necessary to have the default load format stored in a - // user preference variable since we can determine the type of file - // as we are reading. - - load_save_format format = LS_UNKNOWN; - - bool list_only = false; - bool verbose = false; - - //for (i; i < argc; i++) - for (; i < argc; i++) - { - if (argv[i] == "-force" || argv[i] == "-f") - { - // Silently ignore this - // warning ("load: -force ignored"); - } - else if (argv[i] == "-list" || argv[i] == "-l") - { - list_only = true; - } - else if (argv[i] == "-verbose" || argv[i] == "-v") - { - verbose = true; - } - else if (argv[i] == "-ascii" || argv[i] == "-a") - { - format = LS_MAT_ASCII; - } - else if (argv[i] == "-binary" || argv[i] == "-b") - { - format = LS_BINARY; - } - else if (argv[i] == "-mat-binary" || argv[i] == "-mat" || argv[i] == "-m" - || argv[i] == "-6" || argv[i] == "-v6") - { - format = LS_MAT5_BINARY; - } - else if (argv[i] == "-7" || argv[i] == "-v7") - { - format = LS_MAT7_BINARY; - } - else if (argv[i] == "-mat4-binary" || argv[i] == "-V4" - || argv[i] == "-v4" || argv[i] == "-4") - { - format = LS_MAT_BINARY; - } - else if (argv[i] == "-hdf5" || argv[i] == "-h") - { -#ifdef HAVE_HDF5 - format = LS_HDF5; -#else /* ! HAVE_HDF5 */ - error ("load: octave executable was not linked with HDF5 library"); - return retval; -#endif /* ! HAVE_HDF5 */ - } - else if (argv[i] == "-import" || argv[i] == "-i") - { - warning ("load: -import ignored"); - } - else if (argv[i] == "-text" || argv[i] == "-t") - { - format = LS_ASCII; - } - else - break; - } - - if (orig_fname == "") - { - if (i == argc) - { - print_usage (); - return retval; - } - else - orig_fname = argv[i]; - } - else - i--; - - oct_mach_info::float_format flt_fmt = oct_mach_info::flt_fmt_unknown; - - bool swap = false; - - if (orig_fname == "-") - { - i++; - -#ifdef HAVE_HDF5 - if (format == LS_HDF5) - error ("load: cannot read HDF5 format from stdin"); - else -#endif /* HAVE_HDF5 */ - if (format != LS_UNKNOWN) - { - // FIXME -- if we have already seen EOF on a - // previous call, how do we fix up the state of std::cin so - // that we can get additional input? I'm afraid that we - // can't fix this using std::cin only. - - retval = do_load (std::cin, orig_fname, format, flt_fmt, - list_only, swap, verbose, argv, i, argc, - nargout); - } - else - error ("load: must specify file format if reading from stdin"); - } - else - { - std::string fname = file_ops::tilde_expand (orig_fname); - - fname = find_file_to_load (fname, orig_fname); - - if (error_state) - return retval; - - bool use_zlib = false; - - if (format == LS_UNKNOWN) - format = get_file_format (fname, orig_fname, use_zlib); - -#ifdef HAVE_HDF5 - if (format == LS_HDF5) - { - i++; - - hdf5_ifstream hdf5_file (fname.c_str ()); - - if (hdf5_file.file_id >= 0) - { - retval = do_load (hdf5_file, orig_fname, format, - flt_fmt, list_only, swap, verbose, - argv, i, argc, nargout); - - hdf5_file.close (); - } - else - gripe_file_open ("load", orig_fname); - } - else -#endif /* HAVE_HDF5 */ - // don't insert any statements here; the "else" above has to - // go with the "if" below!!!!! - if (format != LS_UNKNOWN) - { - i++; - - // Always open in binary mode and handle various - // line-endings explicitly. - std::ios::openmode mode = std::ios::in | std::ios::binary; - -#ifdef HAVE_ZLIB - if (use_zlib) - { - gzifstream file (fname.c_str (), mode); - - if (file) - { - if (format == LS_BINARY) - { - if (read_binary_file_header (file, swap, flt_fmt) < 0) - { - if (file) file.close (); - return retval; - } - } - else if (format == LS_MAT5_BINARY - || format == LS_MAT7_BINARY) - { - if (read_mat5_binary_file_header (file, swap, false, orig_fname) < 0) - { - if (file) file.close (); - return retval; - } - } - - retval = do_load (file, orig_fname, format, - flt_fmt, list_only, swap, verbose, - argv, i, argc, nargout); - - file.close (); - } - else - gripe_file_open ("load", orig_fname); - } - else -#endif - { - std::ifstream file (fname.c_str (), mode); - - if (file) - { - if (format == LS_BINARY) - { - if (read_binary_file_header (file, swap, flt_fmt) < 0) - { - if (file) file.close (); - return retval; - } - } - else if (format == LS_MAT5_BINARY - || format == LS_MAT7_BINARY) - { - if (read_mat5_binary_file_header (file, swap, false, orig_fname) < 0) - { - if (file) file.close (); - return retval; - } - } - - retval = do_load (file, orig_fname, format, - flt_fmt, list_only, swap, verbose, - argv, i, argc, nargout); - - file.close (); - } - else - error ("load: unable to open input file '%s'", - orig_fname.c_str ()); - } - } - } - - return retval; -} - -// Return TRUE if PATTERN has any special globbing chars in it. - -static bool -glob_pattern_p (const std::string& pattern) -{ - int open = 0; - - int len = pattern.length (); - - for (int i = 0; i < len; i++) - { - char c = pattern[i]; - - switch (c) - { - case '?': - case '*': - return true; - - case '[': // Only accept an open brace if there is a close - open++; // brace to match it. Bracket expressions must be - continue; // complete, according to Posix.2 - - case ']': - if (open) - return true; - continue; - - case '\\': - if (i == len - 1) - return false; - - default: - continue; - } - } - - return false; -} - -static void -do_save (std::ostream& os, const octave_value& tc, - const std::string& name, const std::string& help, - bool global, load_save_format fmt, bool save_as_floats) -{ - switch (fmt.type) - { - case LS_ASCII: - save_ascii_data (os, tc, name, global, 0); - break; - - case LS_BINARY: - save_binary_data (os, tc, name, help, global, save_as_floats); - break; - - case LS_MAT_ASCII: - if (! save_mat_ascii_data (os, tc, fmt.opts & LS_MAT_ASCII_LONG ? 16 : 8, - fmt.opts & LS_MAT_ASCII_TABS)) - warning ("save: unable to save %s in ASCII format", name.c_str ()); - break; - - case LS_MAT_BINARY: - save_mat_binary_data (os, tc, name); - break; - -#ifdef HAVE_HDF5 - case LS_HDF5: - save_hdf5_data (os, tc, name, help, global, save_as_floats); - break; -#endif /* HAVE_HDF5 */ - - case LS_MAT5_BINARY: - save_mat5_binary_element (os, tc, name, global, false, save_as_floats); - break; - - case LS_MAT7_BINARY: - save_mat5_binary_element (os, tc, name, global, true, save_as_floats); - break; - - default: - gripe_unrecognized_data_fmt ("save"); - break; - } -} - -// Save the info from SR on stream OS in the format specified by FMT. - -void -do_save (std::ostream& os, const symbol_table::symbol_record& sr, - load_save_format fmt, bool save_as_floats) -{ - octave_value val = sr.varval (); - - if (val.is_defined ()) - { - std::string name = sr.name (); - std::string help; - bool global = sr.is_global (); - - do_save (os, val, name, help, global, fmt, save_as_floats); - } -} - -// save fields of a scalar structure STR matching PATTERN on stream OS -// in the format specified by FMT. - -static size_t -save_fields (std::ostream& os, const octave_scalar_map& m, - const std::string& pattern, - load_save_format fmt, bool save_as_floats) -{ - glob_match pat (pattern); - - size_t saved = 0; - - for (octave_scalar_map::const_iterator p = m.begin (); p != m.end (); p++) - { - std::string empty_str; - - if (pat.match (m.key (p))) - { - do_save (os, m.contents (p), m.key (p), empty_str, - 0, fmt, save_as_floats); - - saved++; - } - } - - return saved; -} - -// Save variables with names matching PATTERN on stream OS in the -// format specified by FMT. - -static size_t -save_vars (std::ostream& os, const std::string& pattern, - load_save_format fmt, bool save_as_floats) -{ - std::list vars = symbol_table::glob (pattern); - - size_t saved = 0; - - typedef std::list::const_iterator const_vars_iterator; - - for (const_vars_iterator p = vars.begin (); p != vars.end (); p++) - { - do_save (os, *p, fmt, save_as_floats); - - if (error_state) - break; - - saved++; - } - - return saved; -} - -static string_vector -parse_save_options (const string_vector &argv, - load_save_format &format, bool &append, - bool &save_as_floats, bool &use_zlib) -{ - string_vector retval; - int argc = argv.length (); - - bool do_double = false, do_tabs = false; - - for (int i = 0; i < argc; i++) - { - if (argv[i] == "-append") - { - append = true; - } - else if (argv[i] == "-ascii" || argv[i] == "-a") - { - format = LS_MAT_ASCII; - } - else if (argv[i] == "-double") - { - do_double = true; - } - else if (argv[i] == "-tabs") - { - do_tabs = true; - } - else if (argv[i] == "-text" || argv[i] == "-t") - { - format = LS_ASCII; - } - else if (argv[i] == "-binary" || argv[i] == "-b") - { - format = LS_BINARY; - } - else if (argv[i] == "-hdf5" || argv[i] == "-h") - { -#ifdef HAVE_HDF5 - format = LS_HDF5; -#else /* ! HAVE_HDF5 */ - error ("save: octave executable was not linked with HDF5 library"); -#endif /* ! HAVE_HDF5 */ - } - else if (argv[i] == "-mat-binary" || argv[i] == "-mat" - || argv[i] == "-m" || argv[i] == "-6" || argv[i] == "-v6" - || argv[i] == "-V6") - { - format = LS_MAT5_BINARY; - } -#ifdef HAVE_ZLIB - else if (argv[i] == "-mat7-binary" || argv[i] == "-7" - || argv[i] == "-v7" || argv[i] == "-V7") - { - format = LS_MAT7_BINARY; - } -#endif - else if (argv[i] == "-mat4-binary" || argv[i] == "-V4" - || argv[i] == "-v4" || argv[i] == "-4") - { - format = LS_MAT_BINARY; - } - else if (argv[i] == "-float-binary" || argv[i] == "-f") - { - format = LS_BINARY; - save_as_floats = true; - } - else if (argv[i] == "-float-hdf5") - { -#ifdef HAVE_HDF5 - format = LS_HDF5; - save_as_floats = true; -#else /* ! HAVE_HDF5 */ - error ("save: octave executable was not linked with HDF5 library"); -#endif /* ! HAVE_HDF5 */ - } -#ifdef HAVE_ZLIB - else if (argv[i] == "-zip" || argv[i] == "-z") - { - use_zlib = true; - } -#endif - else if (argv[i] == "-struct") - { - retval.append (argv[i]); - } - else if (argv[i][0] == '-') - { - error ("save: Unrecognized option '%s'", argv[i].c_str ()); - } - else - retval.append (argv[i]); - } - - if (do_double) - { - if (format == LS_MAT_ASCII) - format.opts |= LS_MAT_ASCII_LONG; - else - warning ("save: \"-double\" option only has an effect with \"-ascii\""); - } - - if (do_tabs) - { - if (format == LS_MAT_ASCII) - format.opts |= LS_MAT_ASCII_TABS; - else - warning ("save: \"-tabs\" option only has an effect with \"-ascii\""); - } - - return retval; -} - -static string_vector -parse_save_options (const std::string &arg, load_save_format &format, - bool &append, bool &save_as_floats, - bool &use_zlib) -{ - std::istringstream is (arg); - std::string str; - string_vector argv; - - while (! is.eof ()) - { - is >> str; - argv.append (str); - } - - return parse_save_options (argv, format, append, save_as_floats, - use_zlib); -} - -void -write_header (std::ostream& os, load_save_format format) -{ - switch (format.type) - { - case LS_BINARY: - { - os << (oct_mach_info::words_big_endian () - ? "Octave-1-B" : "Octave-1-L"); - - oct_mach_info::float_format flt_fmt = - oct_mach_info::native_float_format (); - - char tmp = static_cast (float_format_to_mopt_digit (flt_fmt)); - - os.write (&tmp, 1); - } - break; - - case LS_MAT5_BINARY: - case LS_MAT7_BINARY: - { - char const * versionmagic; - int16_t number = *(reinterpret_cast("\x00\x01")); - struct tm bdt; - time_t now; - char headertext[128]; - - time (&now); - bdt = *gmtime (&now); - memset (headertext, ' ', 124); - // ISO 8601 format date - nstrftime (headertext, 124, "MATLAB 5.0 MAT-file, written by Octave " - OCTAVE_VERSION ", %Y-%m-%d %T UTC", &bdt, 1, 0); - - // The first pair of bytes give the version of the MAT file - // format. The second pair of bytes form a magic number which - // signals a MAT file. MAT file data are always written in - // native byte order. The order of the bytes in the second - // pair indicates whether the file was written by a big- or - // little-endian machine. However, the version number is - // written in the *opposite* byte order from everything else! - if (number == 1) - versionmagic = "\x01\x00\x4d\x49"; // this machine is big endian - else - versionmagic = "\x00\x01\x49\x4d"; // this machine is little endian - - memcpy (headertext+124, versionmagic, 4); - os.write (headertext, 128); - } - - break; - -#ifdef HAVE_HDF5 - case LS_HDF5: -#endif /* HAVE_HDF5 */ - case LS_ASCII: - { - octave_localtime now; - - std::string comment_string = now.strftime (Vsave_header_format_string); - - if (! comment_string.empty ()) - { -#ifdef HAVE_HDF5 - if (format == LS_HDF5) - { - hdf5_ofstream& hs = dynamic_cast (os); - H5Gset_comment (hs.file_id, "/", comment_string.c_str ()); - } - else -#endif /* HAVE_HDF5 */ - os << comment_string << "\n"; - } - } - break; - - default: - break; - } -} - -static void -save_vars (const string_vector& argv, int argv_idx, int argc, - std::ostream& os, load_save_format fmt, - bool save_as_floats, bool write_header_info) -{ - if (write_header_info) - write_header (os, fmt); - - if (argv_idx == argc) - { - save_vars (os, "*", fmt, save_as_floats); - } - else if (argv[argv_idx] == "-struct") - { - if (++argv_idx >= argc) - { - error ("save: missing struct name"); - return; - } - - std::string struct_name = argv[argv_idx]; - - if (! symbol_table::is_variable (struct_name)) - { - error ("save: no such variable: '%s'", struct_name.c_str ()); - return; - } - - octave_value struct_var = symbol_table::varval (struct_name); - - if (! struct_var.is_map () || struct_var.numel () != 1) - { - error ("save: '%s' is not a scalar structure", - struct_name.c_str ()); - return; - } - octave_scalar_map struct_var_map = struct_var.scalar_map_value (); - - ++argv_idx; - - if (argv_idx < argc) - { - for (int i = argv_idx; i < argc; i++) - { - if (! save_fields (os, struct_var_map, argv[i], fmt, - save_as_floats)) - { - warning ("save: no such field '%s.%s'", - struct_name.c_str (), argv[i].c_str ()); - } - } - } - else - save_fields (os, struct_var_map, "*", fmt, save_as_floats); - } - else - { - for (int i = argv_idx; i < argc; i++) - { - if (! save_vars (os, argv[i], fmt, save_as_floats)) - warning ("save: no such variable '%s'", argv[i].c_str ()); - } - } -} - -static void -dump_octave_core (std::ostream& os, const char *fname, load_save_format fmt, - bool save_as_floats) -{ - write_header (os, fmt); - - std::list vars - = symbol_table::all_variables (symbol_table::top_scope (), 0); - - double save_mem_size = 0; - - typedef std::list::const_iterator const_vars_iterator; - - for (const_vars_iterator p = vars.begin (); p != vars.end (); p++) - { - octave_value val = p->varval (); - - if (val.is_defined ()) - { - std::string name = p->name (); - std::string help; - bool global = p->is_global (); - - double val_size = val.byte_size () / 1024; - - // FIXME -- maybe we should try to throw out the largest first... - - if (Voctave_core_file_limit < 0 - || save_mem_size + val_size < Voctave_core_file_limit) - { - save_mem_size += val_size; - - do_save (os, val, name, help, global, fmt, save_as_floats); - - if (error_state) - break; - } - } - } - - message (0, "save to '%s' complete", fname); -} - -void -dump_octave_core (void) -{ - if (Vcrash_dumps_octave_core) - { - // FIXME -- should choose better file name? - - const char *fname = Voctave_core_file_name.c_str (); - - message (0, "attempting to save variables to '%s'...", fname); - - load_save_format format = LS_BINARY; - - bool save_as_floats = false; - - bool append = false; - - bool use_zlib = false; - - parse_save_options (Voctave_core_file_options, format, append, - save_as_floats, use_zlib); - - std::ios::openmode mode = std::ios::out; - - // Matlab v7 files are always compressed - if (format == LS_MAT7_BINARY) - use_zlib = false; - - if (format == LS_BINARY -#ifdef HAVE_HDF5 - || format == LS_HDF5 -#endif - || format == LS_MAT_BINARY - || format == LS_MAT5_BINARY - || format == LS_MAT7_BINARY) - mode |= std::ios::binary; - - mode |= append ? std::ios::ate : std::ios::trunc; - -#ifdef HAVE_HDF5 - if (format == LS_HDF5) - { - hdf5_ofstream file (fname, mode); - - if (file.file_id >= 0) - { - dump_octave_core (file, fname, format, save_as_floats); - - file.close (); - } - else - warning ("unable to open '%s' for writing...", fname); - } - else -#endif /* HAVE_HDF5 */ - // don't insert any commands here! The open brace below must - // go with the else above! - { -#ifdef HAVE_ZLIB - if (use_zlib) - { - gzofstream file (fname, mode); - - if (file) - { - dump_octave_core (file, fname, format, save_as_floats); - - file.close (); - } - else - warning ("unable to open '%s' for writing...", fname); - } - else -#endif - { - std::ofstream file (fname, mode); - - if (file) - { - dump_octave_core (file, fname, format, save_as_floats); - - file.close (); - } - else - warning ("unable to open '%s' for writing...", fname); - } - } - } -} - -DEFUN (save, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} save file\n\ -@deftypefnx {Command} {} save options file\n\ -@deftypefnx {Command} {} save options file @var{v1} @var{v2} @dots{}\n\ -@deftypefnx {Command} {} save options file -struct @var{STRUCT} @var{f1} @var{f2} @dots{}\n\ -Save the named variables @var{v1}, @var{v2}, @dots{}, in the file\n\ -@var{file}. The special filename @samp{-} may be used to write\n\ -output to the terminal. If no variable names are listed, Octave saves\n\ -all the variables in the current scope. Otherwise, full variable names or\n\ -pattern syntax can be used to specify the variables to save.\n\ -If the @option{-struct} modifier is used, fields @var{f1} @var{f2} @dots{}\n\ -of the scalar structure @var{STRUCT} are saved as if they were variables\n\ -with corresponding names.\n\ -Valid options for the @code{save} command are listed in the following table.\n\ -Options that modify the output format override the format specified by\n\ -@code{save_default_options}.\n\ -\n\ -If save is invoked using the functional form\n\ -\n\ -@example\n\ -save (\"-option1\", @dots{}, \"file\", \"v1\", @dots{})\n\ -@end example\n\ -\n\ -@noindent\n\ -then the @var{options}, @var{file}, and variable name arguments\n\ -(@var{v1}, @dots{}) must be specified as character strings.\n\ -\n\ -@table @code\n\ -@item -append\n\ -Append to the destination instead of overwriting.\n\ -\n\ -@item -ascii\n\ -Save a single matrix in a text file without header or any other information.\n\ -\n\ -@item -binary\n\ -Save the data in Octave's binary data format.\n\ -\n\ -@item -float-binary\n\ -Save the data in Octave's binary data format but only using single\n\ -precision. Only use this format if you know that all the\n\ -values to be saved can be represented in single precision.\n\ -\n\ -@item -hdf5\n\ -Save the data in @sc{hdf5} format.\n\ -(HDF5 is a free, portable binary format developed by the National\n\ -Center for Supercomputing Applications at the University of Illinois.)\n\ -This format is only available if Octave was built with a link to the\n\ -@sc{hdf5} libraries.\n\ -\n\ -@item -float-hdf5\n\ -Save the data in @sc{hdf5} format but only using single precision.\n\ -Only use this format if you know that all the\n\ -values to be saved can be represented in single precision.\n\ -\n\ -@item -V7\n\ -@itemx -v7\n\ -@itemx -7\n\ -@itemx -mat7-binary\n\ -Save the data in @sc{matlab}'s v7 binary data format.\n\ -\n\ -@item -V6\n\ -@itemx -v6\n\ -@itemx -6\n\ -@itemx -mat\n\ -@itemx -mat-binary\n\ -Save the data in @sc{matlab}'s v6 binary data format.\n\ -\n\ -@item -V4\n\ -@itemx -v4\n\ -@itemx -4\n\ -@itemx -mat4-binary\n\ -Save the data in the binary format written by @sc{matlab} version 4.\n\ -\n\ -@item -text\n\ -Save the data in Octave's text data format. (default).\n\ -\n\ -@item -zip\n\ -@itemx -z\n\ -Use the gzip algorithm to compress the file. This works equally on files\n\ -that are compressed with gzip outside of octave, and gzip can equally be\n\ -used to convert the files for backward compatibility.\n\ -This option is only available if Octave was built with a link to the zlib\n\ -libraries.\n\ -@end table\n\ -\n\ -The list of variables to save may use wildcard patterns containing\n\ -the following special characters:\n\ -\n\ -@table @code\n\ -@item ?\n\ -Match any single character.\n\ -\n\ -@item *\n\ -Match zero or more characters.\n\ -\n\ -@item [ @var{list} ]\n\ -Match the list of characters specified by @var{list}. If the first\n\ -character is @code{!} or @code{^}, match all characters except those\n\ -specified by @var{list}. For example, the pattern @code{[a-zA-Z]} will\n\ -match all lower and uppercase alphabetic characters.\n\ -\n\ -Wildcards may also be used in the field name specifications when using\n\ -the @option{-struct} modifier (but not in the struct name itself).\n\ -\n\ -@end table\n\ -\n\ -Except when using the @sc{matlab} binary data file format or the\n\ -@samp{-ascii} format, saving global\n\ -variables also saves the global status of the variable. If the variable\n\ -is restored at a later time using @samp{load}, it will be restored as a\n\ -global variable.\n\ -\n\ -The command\n\ -\n\ -@example\n\ -save -binary data a b*\n\ -@end example\n\ -\n\ -@noindent\n\ -saves the variable @samp{a} and all variables beginning with @samp{b} to\n\ -the file @file{data} in Octave's binary format.\n\ -@seealso{load, save_default_options, save_header_format_string, dlmread, csvread, fread}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length (); - - string_vector argv = args.make_argv (); - - if (error_state) - return retval; - - // Here is where we would get the default save format if it were - // stored in a user preference variable. - - bool save_as_floats = false; - - load_save_format format = LS_ASCII; - - bool append = false; - - bool use_zlib = false; - - // get default options - parse_save_options (Vsave_default_options, format, append, save_as_floats, - use_zlib); - - // override from command line - argv = parse_save_options (argv, format, append, save_as_floats, - use_zlib); - argc = argv.length (); - int i = 0; - - if (error_state) - return retval; - - if (i == argc) - { - print_usage (); - return retval; - } - - if (save_as_floats && format == LS_ASCII) - { - error ("save: cannot specify both -ascii and -float-binary"); - return retval; - } - - if (argv[i] == "-") - { - i++; - -#ifdef HAVE_HDF5 - if (format == LS_HDF5) - error ("save: cannot write HDF5 format to stdout"); - else -#endif /* HAVE_HDF5 */ - // don't insert any commands here! the brace below must go - // with the "else" above! - { - if (append) - warning ("save: ignoring -append option for output to stdout"); - - // FIXME -- should things intended for the screen end up - // in a octave_value (string)? - - save_vars (argv, i, argc, octave_stdout, format, - save_as_floats, true); - } - } - - // Guard against things like 'save a*', which are probably mistakes... - - else if (i == argc - 1 && glob_pattern_p (argv[i])) - { - print_usage (); - return retval; - } - else - { - std::string fname = file_ops::tilde_expand (argv[i]); - - i++; - - // Matlab v7 files are always compressed - if (format == LS_MAT7_BINARY) - use_zlib = false; - - std::ios::openmode mode - = append ? (std::ios::app | std::ios::ate) : std::ios::out; - - if (format == LS_BINARY -#ifdef HAVE_HDF5 - || format == LS_HDF5 -#endif - || format == LS_MAT_BINARY - || format == LS_MAT5_BINARY - || format == LS_MAT7_BINARY) - mode |= std::ios::binary; - -#ifdef HAVE_HDF5 - if (format == LS_HDF5) - { - // FIXME. It should be possible to append to HDF5 files. - if (append) - { - error ("save: appending to HDF5 files is not implemented"); - return retval; - } - - bool write_header_info = ! (append && - H5Fis_hdf5 (fname.c_str ()) > 0); - - hdf5_ofstream hdf5_file (fname.c_str (), mode); - - if (hdf5_file.file_id != -1) - { - save_vars (argv, i, argc, hdf5_file, format, - save_as_floats, write_header_info); - - hdf5_file.close (); - } - else - { - gripe_file_open ("save", fname); - return retval; - } - } - else -#endif /* HAVE_HDF5 */ - // don't insert any statements here! The brace below must go - // with the "else" above! - { -#ifdef HAVE_ZLIB - if (use_zlib) - { - gzofstream file (fname.c_str (), mode); - - if (file) - { - bool write_header_info = ! file.tellp (); - - save_vars (argv, i, argc, file, format, - save_as_floats, write_header_info); - - file.close (); - } - else - { - gripe_file_open ("save", fname); - return retval; - } - } - else -#endif - { - std::ofstream file (fname.c_str (), mode); - - if (file) - { - bool write_header_info = ! file.tellp (); - - save_vars (argv, i, argc, file, format, - save_as_floats, write_header_info); - - file.close (); - } - else - { - gripe_file_open ("save", fname); - return retval; - } - } - } - } - - return retval; -} - -DEFUN (crash_dumps_octave_core, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} crash_dumps_octave_core ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} crash_dumps_octave_core (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} crash_dumps_octave_core (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave tries\n\ -to save all current variables to the file \"octave-workspace\" if it\n\ -crashes or receives a hangup, terminate or similar signal.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{octave_core_file_limit, octave_core_file_name, octave_core_file_options}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (crash_dumps_octave_core); -} - -DEFUN (save_default_options, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} save_default_options ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} save_default_options (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} save_default_options (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the default options\n\ -for the @code{save} command, and defines the default format.\n\ -Typical values include @code{\"-ascii\"}, @code{\"-text -zip\"}.\n\ -The default value is @option{-text}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{save}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (save_default_options); -} - -DEFUN (octave_core_file_limit, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} octave_core_file_limit ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} octave_core_file_limit (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} octave_core_file_limit (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the maximum amount\n\ -of memory (in kilobytes) of the top-level workspace that Octave will\n\ -attempt to save when writing data to the crash dump file (the name of\n\ -the file is specified by @var{octave_core_file_name}). If\n\ -@var{octave_core_file_options} flags specify a binary format,\n\ -then @var{octave_core_file_limit} will be approximately the maximum\n\ -size of the file. If a text file format is used, then the file could\n\ -be much larger than the limit. The default value is -1 (unlimited)\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{crash_dumps_octave_core, octave_core_file_name, octave_core_file_options}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (octave_core_file_limit); -} - -DEFUN (octave_core_file_name, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} octave_core_file_name ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} octave_core_file_name (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} octave_core_file_name (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the name of the file\n\ -used for saving data from the top-level workspace if Octave aborts.\n\ -The default value is @code{\"octave-workspace\"}\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{crash_dumps_octave_core, octave_core_file_name, octave_core_file_options}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (octave_core_file_name); -} - -DEFUN (octave_core_file_options, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} octave_core_file_options ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} octave_core_file_options (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} octave_core_file_options (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the options used for\n\ -saving the workspace data if Octave aborts. The value of\n\ -@code{octave_core_file_options} should follow the same format as the\n\ -options for the @code{save} function. The default value is Octave's binary\n\ -format.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{crash_dumps_octave_core, octave_core_file_name, octave_core_file_limit}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (octave_core_file_options); -} - -DEFUN (save_header_format_string, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} save_header_format_string ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} save_header_format_string (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} save_header_format_string (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the format\n\ -string used for the comment line written at the beginning of\n\ -text-format data files saved by Octave. The format string is\n\ -passed to @code{strftime} and should begin with the character\n\ -@samp{#} and contain no newline characters. If the value of\n\ -@code{save_header_format_string} is the empty string,\n\ -the header comment is omitted from text-format data files. The\n\ -default value is\n\ -@c Set example in small font to prevent overfull line\n\ -\n\ -@smallexample\n\ -\"# Created by Octave VERSION, %a %b %d %H:%M:%S %Y %Z \"\n\ -@end smallexample\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{strftime, save}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (save_header_format_string); -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/load-save.h --- a/libinterp/interpfcn/load-save.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,95 +0,0 @@ -/* - -Copyright (C) 1994-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_load_save_h) -#define octave_load_save_h 1 - -#include -#include - -#include "mach-info.h" -#include "symtab.h" - -class octave_value; - -// FIXME: maybe MAT5 and MAT7 should be options to MAT_BINARY. -// Similarly, save_as_floats may be an option for LS_BINARY, LS_HDF5 etc. -enum load_save_format_type - { - LS_ASCII, - LS_BINARY, - LS_MAT_ASCII, - LS_MAT_BINARY, - LS_MAT5_BINARY, - LS_MAT7_BINARY, -#ifdef HAVE_HDF5 - LS_HDF5, -#endif /* HAVE_HDF5 */ - LS_UNKNOWN - }; - -enum load_save_format_options -{ - // LS_MAT_ASCII options (not exclusive) - LS_MAT_ASCII_LONG = 1, - LS_MAT_ASCII_TABS = 2, - // LS_MAT_BINARY options - LS_MAT_BINARY_V5 = 1, - LS_MAT_BINARY_V7, - // zero means no option. - LS_NO_OPTION = 0 -}; - -class load_save_format -{ -public: - load_save_format (load_save_format_type t, - load_save_format_options o = LS_NO_OPTION) - : type (t), opts (o) { } - operator int (void) const - { return type; } - int type, opts; -}; - -extern void dump_octave_core (void); - -extern int -read_binary_file_header (std::istream& is, bool& swap, - oct_mach_info::float_format& flt_fmt, - bool quiet = false); - -extern octave_value -do_load (std::istream& stream, const std::string& orig_fname, - load_save_format format, oct_mach_info::float_format flt_fmt, - bool list_only, bool swap, bool verbose, - const string_vector& argv, int argv_idx, int argc, int nargout); - -extern OCTINTERP_API bool is_octave_data_file (const std::string& file); - -extern void -do_save (std::ostream& os, const symbol_table::symbol_record& sr, - load_save_format fmt, bool save_as_floats); - -extern void -write_header (std::ostream& os, load_save_format format); - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/ls-oct-ascii.cc --- a/libinterp/interpfcn/ls-oct-ascii.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,433 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Author: John W. Eaton. - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include -#include -#include -#include -#include - -#include "byte-swap.h" -#include "data-conv.h" -#include "file-ops.h" -#include "glob-match.h" -#include "lo-mappers.h" -#include "mach-info.h" -#include "oct-env.h" -#include "oct-time.h" -#include "quit.h" -#include "str-vec.h" - -#include "Cell.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "load-save.h" -#include "ls-ascii-helper.h" -#include "ls-oct-ascii.h" -#include "oct-obj.h" -#include "oct-map.h" -#include "ov-cell.h" -#include "pager.h" -#include "pt-exp.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" -#include "version.h" -#include "dMatrix.h" - -// The number of decimal digits to use when writing ascii data. -static int Vsave_precision = 16; - -// Functions for reading ascii data. - -// Extract a KEYWORD and its value from stream IS, returning the -// associated value in a new string. -// -// Input should look something like: -// -// [%#][ \t]*keyword[ \t]*:[ \t]*string-value[ \t]*\n - -std::string -extract_keyword (std::istream& is, const char *keyword, const bool next_only) -{ - std::string retval; - - int ch = is.peek (); - if (next_only && ch != '%' && ch != '#') - return retval; - - char c; - while (is.get (c)) - { - if (c == '%' || c == '#') - { - std::ostringstream buf; - - while (is.get (c) && (c == ' ' || c == '\t' || c == '%' || c == '#')) - ; // Skip whitespace and comment characters. - - if (isalpha (c)) - buf << c; - - while (is.get (c) && isalpha (c)) - buf << c; - - std::string tmp = buf.str (); - bool match = (tmp.compare (0, strlen (keyword), keyword) == 0); - - if (match) - { - std::ostringstream value; - while (is.get (c) && (c == ' ' || c == '\t' || c == ':')) - ; // Skip whitespace and the colon. - - is.putback (c); - retval = read_until_newline (is, false); - break; - } - else if (next_only) - break; - else - skip_until_newline (is, false); - } - } - - int len = retval.length (); - - if (len > 0) - { - while (len) - { - c = retval[len-1]; - - if (c == ' ' || c == '\t') - len--; - else - { - retval.resize (len); - break; - } - } - } - - return retval; -} - -// Extract one value (scalar, matrix, string, etc.) from stream IS and -// place it in TC, returning the name of the variable. If the value -// is tagged as global in the file, return TRUE in GLOBAL. -// -// Each type supplies its own function to load the data, and so this -// function is extensible. -// -// FILENAME is used for error messages. -// -// The data is expected to be in the following format: -// -// The input file must have a header followed by some data. -// -// All lines in the header must begin with a '#' character. -// -// The header must contain a list of keyword and value pairs with the -// keyword and value separated by a colon. -// -// Keywords must appear in the following order: -// -// # name: -// # type: -// # -// -// Where, for the built in types are: -// -// : a valid identifier -// -// : -// | global -// -// : scalar -// | complex scalar -// | matrix -// | complex matrix -// | bool -// | bool matrix -// | string -// | range -// -// : -// | -// -// : # rows: -// : # columns: -// -// : # elements: -// : # length: (once before each string) -// -// For backward compatibility the type "string array" is treated as a -// "string" type. Also "string" can have a single element with no elements -// line such that -// -// : # length: -// -// Formatted ASCII data follows the header. -// -// Example: -// -// # name: foo -// # type: matrix -// # rows: 2 -// # columns: 2 -// 2 4 -// 1 3 -// -// Example: -// -// # name: foo -// # type: string -// # elements: 5 -// # length: 4 -// this -// # length: 2 -// is -// # length: 1 -// a -// # length: 6 -// string -// # length: 5 -// array -// -// FIXME -- this format is fairly rigid, and doesn't allow for -// arbitrary comments. Someone should fix that. It does allow arbitrary -// types however. - -// Ugh. The signature of the compare method is not standard in older -// versions of the GNU libstdc++. Do this instead: - -#define SUBSTRING_COMPARE_EQ(s, pos, n, t) (s.substr (pos, n) == t) - -std::string -read_ascii_data (std::istream& is, const std::string& filename, bool& global, - octave_value& tc, octave_idx_type count) -{ - // Read name for this entry or break on EOF. - - std::string name = extract_keyword (is, "name"); - - if (name.empty ()) - { - if (count == 0) - error ("load: empty name keyword or no data found in file '%s'", - filename.c_str ()); - - return std::string (); - } - - if (! (name == ".nargin." || name == ".nargout." - || name == CELL_ELT_TAG || valid_identifier (name))) - { - error ("load: bogus identifier '%s' found in file '%s'", - name.c_str (), filename.c_str ()); - return std::string (); - } - - // Look for type keyword. - - std::string tag = extract_keyword (is, "type"); - - if (! tag.empty ()) - { - std::string typ; - size_t pos = tag.rfind (' '); - - if (pos != std::string::npos) - { - global = SUBSTRING_COMPARE_EQ (tag, 0, 6, "global"); - - typ = global ? tag.substr (7) : tag; - } - else - typ = tag; - - // Special case for backward compatiablity. A small bit of cruft - if (SUBSTRING_COMPARE_EQ (typ, 0, 12, "string array")) - tc = charMatrix (); - else - tc = octave_value_typeinfo::lookup_type (typ); - - if (! tc.load_ascii (is)) - error ("load: trouble reading ascii file '%s'", filename.c_str ()); - } - else - error ("load: failed to extract keyword specifying value type"); - - if (error_state) - { - error ("load: reading file %s", filename.c_str ()); - return std::string (); - } - - return name; -} - -// Save the data from TC along with the corresponding NAME, and global -// flag MARK_AS_GLOBAL on stream OS in the plain text format described -// above for load_ascii_data. If NAME is empty, the name: line is not -// generated. PRECISION specifies the number of decimal digits to print. -// -// Assumes ranges and strings cannot contain Inf or NaN values. -// -// Returns 1 for success and 0 for failure. - -// FIXME -- should probably write the help string here too. - -bool -save_ascii_data (std::ostream& os, const octave_value& val_arg, - const std::string& name, bool mark_as_global, - int precision) -{ - bool success = true; - - if (! name.empty ()) - os << "# name: " << name << "\n"; - - octave_value val = val_arg; - - if (mark_as_global) - os << "# type: global " << val.type_name () << "\n"; - else - os << "# type: " << val.type_name () << "\n"; - - if (! precision) - precision = Vsave_precision; - - long old_precision = os.precision (); - os.precision (precision); - - success = val.save_ascii (os); - - // Insert an extra pair of newline characters after the data so that - // multiple data elements may be handled separately by gnuplot (see - // the description of the index qualifier for the plot command in the - // gnuplot documentation). - os << "\n\n"; - - os.precision (old_precision); - - return (os && success); -} - -bool -save_ascii_data_for_plotting (std::ostream& os, const octave_value& t, - const std::string& name) -{ - return save_ascii_data (os, t, name, false, 6); -} - -// Maybe this should be a static function in tree-plot.cc? - -// If TC is matrix, save it on stream OS in a format useful for -// making a 3-dimensional plot with gnuplot. If PARAMETRIC is -// TRUE, assume a parametric 3-dimensional plot will be generated. - -bool -save_three_d (std::ostream& os, const octave_value& tc, bool parametric) -{ - bool fail = false; - - octave_idx_type nr = tc.rows (); - octave_idx_type nc = tc.columns (); - - if (tc.is_real_matrix ()) - { - os << "# 3D data...\n" - << "# type: matrix\n" - << "# total rows: " << nr << "\n" - << "# total columns: " << nc << "\n"; - - long old_precision = os.precision (); - os.precision (6); - - if (parametric) - { - octave_idx_type extras = nc % 3; - if (extras) - warning ("ignoring last %d columns", extras); - - Matrix tmp = tc.matrix_value (); - nr = tmp.rows (); - - for (octave_idx_type i = 0; i < nc-extras; i += 3) - { - os << tmp.extract (0, i, nr-1, i+2); - if (i+3 < nc-extras) - os << "\n"; - } - } - else - { - Matrix tmp = tc.matrix_value (); - nr = tmp.rows (); - - for (octave_idx_type i = 0; i < nc; i++) - { - os << tmp.extract (0, i, nr-1, i); - if (i+1 < nc) - os << "\n"; - } - } - - os.precision (old_precision); - } - else - { - ::error ("for now, I can only save real matrices in 3D format"); - fail = true; - } - - return (os && ! fail); -} - -DEFUN (save_precision, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} save_precision ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} save_precision (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} save_precision (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the number of\n\ -digits to keep when saving data in text format.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE_WITH_LIMITS (save_precision, -1, - std::numeric_limits::max ()); -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/ls-oct-ascii.h --- a/libinterp/interpfcn/ls-oct-ascii.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,189 +0,0 @@ -/* - -Copyright (C) 2003-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_ls_oct_ascii_h) -#define octave_ls_oct_ascii_h 1 - -#include - -#include -#include - -#include "str-vec.h" - -#include "ls-ascii-helper.h" - -// Flag for cell elements -#define CELL_ELT_TAG "" - -// Used when converting Inf to something that gnuplot can read. - -#ifndef OCT_RBV -#define OCT_RBV (std::numeric_limits::max () / 100.0) -#endif - -extern OCTINTERP_API std::string -extract_keyword (std::istream& is, const char *keyword, - const bool next_only = false); - -extern OCTINTERP_API std::string -read_ascii_data (std::istream& is, const std::string& filename, bool& global, - octave_value& tc, octave_idx_type count); - -extern OCTINTERP_API bool -save_ascii_data (std::ostream& os, const octave_value& val_arg, - const std::string& name, bool mark_as_global, int precision); - -extern OCTINTERP_API bool -save_ascii_data_for_plotting (std::ostream& os, const octave_value& t, - const std::string& name); - -extern OCTINTERP_API bool -save_three_d (std::ostream& os, const octave_value& t, - bool parametric = false); - -// Match KEYWORD on stream IS, placing the associated value in VALUE, -// returning TRUE if successful and FALSE otherwise. -// -// Input should look something like: -// -// [%#][ \t]*keyword[ \t]*int-value.*\n - -template -bool -extract_keyword (std::istream& is, const char *keyword, T& value, - const bool next_only = false) -{ - bool status = false; - value = T (); - - char c; - while (is.get (c)) - { - if (c == '%' || c == '#') - { - std::ostringstream buf; - - while (is.get (c) && (c == ' ' || c == '\t' || c == '%' || c == '#')) - ; // Skip whitespace and comment characters. - - if (isalpha (c)) - buf << c; - - while (is.get (c) && isalpha (c)) - buf << c; - - std::string tmp = buf.str (); - bool match = (tmp.compare (0, strlen (keyword), keyword) == 0); - - if (match) - { - while (is.get (c) && (c == ' ' || c == '\t' || c == ':')) - ; // Skip whitespace and the colon. - - is.putback (c); - if (c != '\n' && c != '\r') - is >> value; - if (is) - status = true; - skip_until_newline (is, false); - break; - } - else if (next_only) - break; - } - } - return status; -} - -template -bool -extract_keyword (std::istream& is, const std::string& kw, T& value, - const bool next_only = false) -{ - return extract_keyword (is, kw.c_str (), value, next_only); -} - -// Match one of the elements in KEYWORDS on stream IS, placing the -// matched keyword in KW and the associated value in VALUE, -// returning TRUE if successful and FALSE otherwise. -// -// Input should look something like: -// -// [%#][ \t]*keyword[ \t]*int-value.*\n - -template -bool -extract_keyword (std::istream& is, const string_vector& keywords, - std::string& kw, T& value, const bool next_only = false) -{ - bool status = false; - kw = ""; - value = 0; - - char c; - while (is.get (c)) - { - if (c == '%' || c == '#') - { - std::ostringstream buf; - - while (is.get (c) && (c == ' ' || c == '\t' || c == '%' || c == '#')) - ; // Skip whitespace and comment characters. - - if (isalpha (c)) - buf << c; - - while (is.get (c) && isalpha (c)) - buf << c; - - std::string tmp = buf.str (); - - for (int i = 0; i < keywords.length (); i++) - { - int match = (tmp == keywords[i]); - - if (match) - { - kw = keywords[i]; - - while (is.get (c) && (c == ' ' || c == '\t' || c == ':')) - ; // Skip whitespace and the colon. - - is.putback (c); - if (c != '\n' && c != '\r') - is >> value; - if (is) - status = true; - skip_until_newline (is, false); - return status; - } - } - - if (next_only) - break; - } - } - return status; -} - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/module.mk --- a/libinterp/interpfcn/module.mk Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,76 +0,0 @@ -EXTRA_DIST += \ - interpfcn/module.mk \ - interpfcn/defaults.in.h \ - interpfcn/graphics.in.h - -INTERPFCN_INC = \ - interpfcn/data.h \ - interpfcn/debug.h \ - interpfcn/defun.h \ - interpfcn/dirfns.h \ - interpfcn/error.h \ - interpfcn/file-io.h \ - interpfcn/help.h \ - interpfcn/hook-fcn.h \ - interpfcn/input.h \ - interpfcn/load-path.h \ - interpfcn/load-save.h \ - interpfcn/ls-oct-ascii.h \ - interpfcn/octave-link.h \ - interpfcn/oct-hist.h \ - interpfcn/pager.h \ - interpfcn/pr-output.h \ - interpfcn/profiler.h \ - interpfcn/sighandlers.h \ - interpfcn/symtab.h \ - interpfcn/sysdep.h \ - interpfcn/toplev.h \ - interpfcn/utils.h \ - interpfcn/variables.h \ - interpfcn/workspace-element.h - -INTERPFCN_SRC = \ - interpfcn/data.cc \ - interpfcn/debug.cc \ - interpfcn/defaults.cc \ - interpfcn/defun.cc \ - interpfcn/dirfns.cc \ - interpfcn/error.cc \ - interpfcn/file-io.cc \ - interpfcn/graphics.cc \ - interpfcn/help.cc \ - interpfcn/hook-fcn.cc \ - interpfcn/input.cc \ - interpfcn/load-path.cc \ - interpfcn/load-save.cc \ - interpfcn/ls-oct-ascii.cc \ - interpfcn/octave-link.cc \ - interpfcn/oct-hist.cc \ - interpfcn/pager.cc \ - interpfcn/pr-output.cc \ - interpfcn/profiler.cc \ - interpfcn/sighandlers.cc \ - interpfcn/symtab.cc \ - interpfcn/sysdep.cc \ - interpfcn/toplev.cc \ - interpfcn/utils.cc \ - interpfcn/variables.cc - -## defaults.h and graphics.h must depend on Makefile. Calling configure -## may change default/config values. However, calling configure will also -## regenerate the Makefiles from Makefile.am and trigger the rules below. -interpfcn/defaults.h: interpfcn/defaults.in.h Makefile - @$(do_subst_default_vals) - -interpfcn/graphics.h: interpfcn/graphics.in.h genprops.awk Makefile - $(AWK) -f $(srcdir)/genprops.awk $< > $@-t - mv $@-t $@ - -interpfcn/graphics-props.cc: interpfcn/graphics.in.h genprops.awk Makefile - $(AWK) -v emit_graphics_props=1 -f $(srcdir)/genprops.awk $< > $@-t - mv $@-t $@ - -noinst_LTLIBRARIES += interpfcn/libinterpfcn.la - -interpfcn_libinterpfcn_la_SOURCES = $(INTERPFCN_SRC) -interpfcn_libinterpfcn_la_CPPFLAGS = $(liboctinterp_la_CPPFLAGS) diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/oct-hist.cc --- a/libinterp/interpfcn/oct-hist.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,871 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -/* - -The functions listed below were adapted from similar functions from -GNU Bash, the Bourne Again SHell, copyright (C) 1987, 1989, 1991 Free -Software Foundation, Inc. - - do_history edit_history_readline - do_edit_history edit_history_add_hist - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include - -#include - -#include -#include - -#include "cmd-hist.h" -#include "file-ops.h" -#include "lo-mappers.h" -#include "octave-link.h" -#include "oct-env.h" -#include "oct-time.h" -#include "str-vec.h" - -#include -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "input.h" -#include "oct-hist.h" -#include "oct-obj.h" -#include "pager.h" -#include "parse.h" -#include "sighandlers.h" -#include "sysdep.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" - -// TRUE means input is coming from temporary history file. -bool input_from_tmp_history_file = false; - -static std::string -default_history_file (void) -{ - std::string file; - - std::string env_file = octave_env::getenv ("OCTAVE_HISTFILE"); - - if (! env_file.empty ()) - file = env_file; - - if (file.empty ()) - file = file_ops::concat (octave_env::get_home_directory (), - ".octave_hist"); - - return file; -} - -static int -default_history_size (void) -{ - int size = 1000; - - std::string env_size = octave_env::getenv ("OCTAVE_HISTSIZE"); - - if (! env_size.empty ()) - { - int val; - - if (sscanf (env_size.c_str (), "%d", &val) == 1) - size = val > 0 ? val : 0; - } - - return size; -} - -static std::string -default_history_timestamp_format (void) -{ - return - std::string ("# Octave " OCTAVE_VERSION ", %a %b %d %H:%M:%S %Y %Z <") - + octave_env::get_user_name () - + std::string ("@") - + octave_env::get_host_name () - + std::string (">"); -} - -// The format of the timestamp marker written to the history file when -// Octave exits. -static std::string Vhistory_timestamp_format_string - = default_history_timestamp_format (); - -// Display, save, or load history. Stolen and modified from bash. -// -// Arg of -w FILENAME means write file, arg of -r FILENAME -// means read file, arg of -q means don't number lines. Arg of N -// means only display that many items. - -static string_vector -do_history (const octave_value_list& args, int nargout) -{ - bool numbered_output = nargout == 0; - - unwind_protect frame; - - string_vector hlist; - - frame.add_fcn (command_history::set_file, command_history::file ()); - - int nargin = args.length (); - - // Number of history lines to show (-1 = all) - int limit = -1; - - for (octave_idx_type i = 0; i < nargin; i++) - { - octave_value arg = args(i); - - std::string option; - - if (arg.is_string ()) - option = arg.string_value (); - else if (arg.is_numeric_type ()) - { - limit = arg.int_value (); - if (limit < 0) - limit = -limit; - continue; - } - else - { - gripe_wrong_type_arg ("history", arg); - return hlist; - } - - if (option == "-r" || option == "-w" || option == "-a" - || option == "-n") - { - if (i < nargin - 1) - { - if (args(i+1).is_string ()) - command_history::set_file (args(++i).string_value ()); - else - { - error ("history: expecting file name for %s option", - option.c_str ()); - return hlist; - } - } - else - command_history::set_file (default_history_file ()); - - if (option == "-a") - // Append 'new' lines to file. - command_history::append (); - - else if (option == "-w") - // Write entire history. - command_history::write (); - - else if (option == "-r") - { - // Read entire file. - command_history::read (); - octave_link::set_history (command_history::list ()); - } - - else if (option == "-n") - { - // Read 'new' history from file. - command_history::read_range (); - octave_link::set_history (command_history::list ()); - } - - else - panic_impossible (); - - return hlist; - } - else if (option == "-c") - { - command_history::clear (); - octave_link::clear_history (); - } - else if (option == "-q") - numbered_output = false; - else if (option == "--") - { - i++; - break; - } - else - { - // The last argument found in the command list that looks like - // an integer will be used - int tmp; - - if (sscanf (option.c_str (), "%d", &tmp) == 1) - { - if (tmp > 0) - limit = tmp; - else - limit = -tmp; - } - - else - { - if (option.length () > 0 && option[0] == '-') - error ("history: unrecognized option '%s'", option.c_str ()); - else - error ("history: bad non-numeric arg '%s'", option.c_str ()); - - return hlist; - } - } - } - - hlist = command_history::list (limit, numbered_output); - - int len = hlist.length (); - - if (nargout == 0) - { - for (octave_idx_type i = 0; i < len; i++) - octave_stdout << hlist[i] << "\n"; - } - - return hlist; -} - -// Read the edited history lines from STREAM and return them -// one at a time. This can read unlimited length lines. The -// caller should free the storage. - -static char * -edit_history_readline (std::fstream& stream) -{ - char c; - int line_len = 128; - int lindex = 0; - char *line = new char [line_len]; - line[0] = '\0'; - - while (stream.get (c)) - { - if (lindex + 2 >= line_len) - { - char *tmp_line = new char [line_len += 128]; - strcpy (tmp_line, line); - delete [] line; - line = tmp_line; - } - - if (c == '\n') - { - line[lindex++] = '\n'; - line[lindex++] = '\0'; - return line; - } - else - line[lindex++] = c; - } - - if (! lindex) - { - delete [] line; - return 0; - } - - if (lindex + 2 >= line_len) - { - char *tmp_line = new char [lindex+3]; - strcpy (tmp_line, line); - delete [] line; - line = tmp_line; - } - - // Finish with newline if none in file. - - line[lindex++] = '\n'; - line[lindex++] = '\0'; - return line; -} - -static void -edit_history_add_hist (const std::string& line) -{ - if (! line.empty ()) - { - std::string tmp = line; - - int len = tmp.length (); - - if (len > 0 && tmp[len-1] == '\n') - tmp.resize (len - 1); - - if (! tmp.empty ()) - { - command_history::add (tmp); - octave_link::append_history (tmp); - } - } -} - -static bool -get_int_arg (const octave_value& arg, int& val) -{ - bool ok = true; - - if (arg.is_string ()) - { - std::string tmp = arg.string_value (); - - ok = sscanf (tmp.c_str (), "%d", &val) == 1; - } - else if (arg.is_numeric_type ()) - val = arg.int_value (); - else - ok = false; - - return ok; -} - -static std::string -mk_tmp_hist_file (const octave_value_list& args, - bool insert_curr, const char *warn_for) -{ - std::string retval; - - string_vector hlist = command_history::list (); - - int hist_count = hlist.length () - 1; // switch to zero-based indexing - - // The current command line is already part of the history list by - // the time we get to this point. Delete the cmd from the list when - // executing 'edit_history' so that it doesn't show up in the history - // but the actual commands performed will. - - if (! insert_curr) - command_history::remove (hist_count); - - hist_count--; // skip last entry in history list - - // If no numbers have been specified, the default is to edit the - // last command in the history list. - - int hist_beg = hist_count; - int hist_end = hist_count; - - bool reverse = false; - - // Process options. - - int nargin = args.length (); - - bool usage_error = false; - if (nargin == 2) - { - if (get_int_arg (args(0), hist_beg) - && get_int_arg (args(1), hist_end)) - { - if (hist_beg < 0) - hist_beg += (hist_count + 1); - else - hist_beg--; - if (hist_end < 0) - hist_end += (hist_count + 1); - else - hist_end--; - } - else - usage_error = true; - } - else if (nargin == 1) - { - if (get_int_arg (args(0), hist_beg)) - { - if (hist_beg < 0) - hist_beg += (hist_count + 1); - else - hist_beg--; - hist_end = hist_beg; - } - else - usage_error = true; - } - - if (usage_error) - { - usage ("%s [first] [last]", warn_for); - return retval; - } - - if (hist_beg > hist_count || hist_end > hist_count) - { - error ("%s: history specification out of range", warn_for); - return retval; - } - - if (hist_end < hist_beg) - { - std::swap (hist_end, hist_beg); - reverse = true; - } - - std::string name = octave_tempnam ("", "oct-"); - - std::fstream file (name.c_str (), std::ios::out); - - if (! file) - { - error ("%s: couldn't open temporary file '%s'", warn_for, - name.c_str ()); - return retval; - } - - if (reverse) - { - for (int i = hist_end; i >= hist_beg; i--) - file << hlist[i] << "\n"; - } - else - { - for (int i = hist_beg; i <= hist_end; i++) - file << hlist[i] << "\n"; - } - - file.close (); - - return name; -} - -static void -unlink_cleanup (const char *file) -{ - gnulib::unlink (file); -} - -static void -do_edit_history (const octave_value_list& args) -{ - std::string name = mk_tmp_hist_file (args, false, "edit_history"); - - if (name.empty ()) - return; - - // Call up our favorite editor on the file of commands. - - std::string cmd = VEDITOR; - cmd.append (" \"" + name + "\""); - - // Ignore interrupts while we are off editing commands. Should we - // maybe avoid using system()? - - volatile octave_interrupt_handler old_interrupt_handler - = octave_ignore_interrupts (); - - int status = system (cmd.c_str ()); - - octave_set_interrupt_handler (old_interrupt_handler); - - // Check if text edition was successfull. Abort the operation - // in case of failure. - if (status != EXIT_SUCCESS) - { - error ("edit_history: text editor command failed"); - return; - } - - // Write the commands to the history file since source_file - // disables command line history while it executes. - - std::fstream file (name.c_str (), std::ios::in); - - char *line; - //int first = 1; - while ((line = edit_history_readline (file)) != 0) - { - // Skip blank lines. - - if (line[0] == '\n') - { - delete [] line; - continue; - } - - edit_history_add_hist (line); - - delete [] line; - } - - file.close (); - - // Turn on command echo, so the output from this will make better - // sense. - - unwind_protect frame; - - frame.add_fcn (unlink_cleanup, name.c_str ()); - frame.protect_var (Vecho_executing_commands); - frame.protect_var (input_from_tmp_history_file); - - Vecho_executing_commands = ECHO_CMD_LINE; - input_from_tmp_history_file = true; - - source_file (name); -} - -static void -do_run_history (const octave_value_list& args) -{ - std::string name = mk_tmp_hist_file (args, false, "run_history"); - - if (name.empty ()) - return; - - // Turn on command echo so the output from this will make better sense. - - unwind_protect frame; - - frame.add_fcn (unlink_cleanup, name.c_str ()); - frame.protect_var (Vecho_executing_commands); - frame.protect_var (input_from_tmp_history_file); - - Vecho_executing_commands = ECHO_CMD_LINE; - input_from_tmp_history_file = true; - - source_file (name); -} - -void -initialize_history (bool read_history_file) -{ - command_history::initialize (read_history_file, - default_history_file (), - default_history_size (), - octave_env::getenv ("OCTAVE_HISTCONTROL")); - - octave_link::set_history (command_history::list ()); -} - -void -octave_history_write_timestamp (void) -{ - octave_localtime now; - - std::string timestamp = now.strftime (Vhistory_timestamp_format_string); - - if (! timestamp.empty ()) - { - command_history::add (timestamp); - octave_link::append_history (timestamp); - } -} - -DEFUN (edit_history, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} edit_history\n\ -@deftypefnx {Command} {} edit_history @var{cmd_number}\n\ -@deftypefnx {Command} {} edit_history @var{first} @var{last}\n\ -Edit the history list using the editor named by the variable\n\ -@w{@env{EDITOR}}.\n\ -\n\ -The commands to be edited are first copied to a temporary file. When you\n\ -exit the editor, Octave executes the commands that remain in the file. It\n\ -is often more convenient to use @code{edit_history} to define functions\n\ -rather than attempting to enter them directly on the command line.\n\ -The block of commands is executed as soon as you exit the editor.\n\ -To avoid executing any commands, simply delete all the lines from the buffer\n\ -before leaving the editor.\n\ -\n\ -When invoked with no arguments, edit the previously executed command;\n\ -With one argument, edit the specified command @var{cmd_number};\n\ -With two arguments, edit the list of commands between @var{first} and\n\ -@var{last}. Command number specifiers may also be negative where -1\n\ -refers to the most recently executed command.\n\ -The following are equivalent and edit the most recently executed command.\n\ -\n\ -@example\n\ -@group\n\ -edit_history\n\ -edit_history -1\n\ -@end group\n\ -@end example\n\ -\n\ -When using ranges, specifying a larger number for the first command than the\n\ -last command reverses the list of commands before they are placed in the\n\ -buffer to be edited.\n\ -@seealso{run_history}\n\ -@end deftypefn") -{ - octave_value_list retval; - - do_edit_history (args); - - return retval; -} - -DEFUN (history, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Command} {} history\n\ -@deftypefnx {Command} {} history @var{opt1} @dots{}\n\ -@deftypefnx {Built-in Function} {@var{h} =} history ()\n\ -@deftypefnx {Built-in Function} {@var{h} =} history (@var{opt1}, @dots{})\n\ -If invoked with no arguments, @code{history} displays a list of commands\n\ -that you have executed. Valid options are:\n\ -\n\ -@table @code\n\ -@item @var{n}\n\ -@itemx -@var{n}\n\ -Display only the most recent @var{n} lines of history.\n\ -\n\ -@item -c\n\ -Clear the history list.\n\ -\n\ -@item -q\n\ -Don't number the displayed lines of history. This is useful for cutting\n\ -and pasting commands using the X Window System.\n\ -\n\ -@item -r @var{file}\n\ -Read the file @var{file}, appending its contents to the current\n\ -history list. If the name is omitted, use the default history file\n\ -(normally @file{~/.octave_hist}).\n\ -\n\ -@item -w @var{file}\n\ -Write the current history to the file @var{file}. If the name is\n\ -omitted, use the default history file (normally @file{~/.octave_hist}).\n\ -@end table\n\ -\n\ -For example, to display the five most recent commands that you have\n\ -typed without displaying line numbers, use the command\n\ -@kbd{history -q 5}.\n\ -\n\ -If invoked with a single output argument, the history will be saved to that\n\ -argument as a cell string and will not be output to screen.\n\ -@end deftypefn") -{ - octave_value retval; - - string_vector hlist = do_history (args, nargout); - - if (nargout > 0) - retval = Cell (hlist); - - return retval; -} - -DEFUN (run_history, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} run_history\n\ -@deftypefnx {Command} {} run_history @var{cmd_number}\n\ -@deftypefnx {Command} {} run_history @var{first} @var{last}\n\ -Run commands from the history list.\n\ -\n\ -When invoked with no arguments, run the previously executed command;\n\ -With one argument, run the specified command @var{cmd_number};\n\ -With two arguments, run the list of commands between @var{first} and\n\ -@var{last}. Command number specifiers may also be negative where -1\n\ -refers to the most recently executed command.\n\ -For example, the command\n\ -\n\ -@example\n\ -@group\n\ -run_history\n\ - OR\n\ -run_history -1\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -executes the most recent command again.\n\ -The command\n\ -\n\ -@example\n\ -run_history 13 169\n\ -@end example\n\ -\n\ -@noindent\n\ -executes commands 13 through 169.\n\ -\n\ -Specifying a larger number for the first command than the last command\n\ -reverses the list of commands before executing them.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -disp (1)\n\ -disp (2)\n\ -run_history -1 -2\n\ -@result{}\n\ - 2\n\ - 1\n\ -@end group\n\ -@end example\n\ -\n\ -@seealso{edit_history}\n\ -@end deftypefn") -{ - octave_value_list retval; - - do_run_history (args); - - return retval; -} - -DEFUN (history_control, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} history_control ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} history_control (@var{new_val})\n\ -Query or set the internal variable that specifies how commands are saved\n\ -to the history list. The default value is an empty character string,\n\ -but may be overridden by the environment variable\n\ -@w{@env{OCTAVE_HISTCONTROL}}.\n\ -\n\ -The value of @code{history_control} is a colon-separated list of values\n\ -controlling how commands are saved on the history list. If the list\n\ -of values includes @code{ignorespace}, lines which begin with a space\n\ -character are not saved in the history list. A value of @code{ignoredups}\n\ -causes lines matching the previous history entry to not be saved.\n\ -A value of @code{ignoreboth} is shorthand for @code{ignorespace} and\n\ -@code{ignoredups}. A value of @code{erasedups} causes all previous lines\n\ -matching the current line to be removed from the history list before that\n\ -line is saved. Any value not in the above list is ignored. If\n\ -@code{history_control} is the empty string, all commands are saved on\n\ -the history list, subject to the value of @code{history_save}.\n\ -@seealso{history_file, history_size, history_timestamp_format_string, history_save}\n\ -@end deftypefn") -{ - std::string old_history_control = command_history::histcontrol (); - - std::string tmp = old_history_control; - - octave_value retval = set_internal_variable (tmp, args, nargout, - "history_control"); - - if (tmp != old_history_control) - command_history::process_histcontrol (tmp); - - return retval; -} - -DEFUN (history_size, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} history_size ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} history_size (@var{new_val})\n\ -Query or set the internal variable that specifies how many entries\n\ -to store in the history file. The default value is @code{1000},\n\ -but may be overridden by the environment variable @w{@env{OCTAVE_HISTSIZE}}.\n\ -@seealso{history_file, history_timestamp_format_string, history_save}\n\ -@end deftypefn") -{ - int old_history_size = command_history::size (); - - int tmp = old_history_size; - - octave_value retval = set_internal_variable (tmp, args, nargout, - "history_size", -1, - std::numeric_limits::max ()); - - if (tmp != old_history_size) - command_history::set_size (tmp); - - return retval; -} - -DEFUN (history_file, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} history_file ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} history_file (@var{new_val})\n\ -Query or set the internal variable that specifies the name of the\n\ -file used to store command history. The default value is\n\ -@file{~/.octave_hist}, but may be overridden by the environment\n\ -variable @w{@env{OCTAVE_HISTFILE}}.\n\ -@seealso{history_size, history_save, history_timestamp_format_string}\n\ -@end deftypefn") -{ - std::string old_history_file = command_history::file (); - - std::string tmp = old_history_file; - - octave_value retval = set_internal_variable (tmp, args, nargout, - "history_file"); - - if (tmp != old_history_file) - command_history::set_file (tmp); - - return retval; -} - -DEFUN (history_timestamp_format_string, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} history_timestamp_format_string ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} history_timestamp_format_string (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} history_timestamp_format_string (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the format string\n\ -for the comment line that is written to the history file when Octave\n\ -exits. The format string is passed to @code{strftime}. The default\n\ -value is\n\ -\n\ -@example\n\ -\"# Octave VERSION, %a %b %d %H:%M:%S %Y %Z \"\n\ -@end example\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{strftime, history_file, history_size, history_save}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (history_timestamp_format_string); -} - -DEFUN (history_save, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} history_save ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} history_save (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} history_save (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether commands entered\n\ -on the command line are saved in the history file.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{history_control, history_file, history_size, history_timestamp_format_string}\n\ -@end deftypefn") -{ - bool old_history_save = ! command_history::ignoring_entries (); - - bool tmp = old_history_save; - - octave_value retval = set_internal_variable (tmp, args, nargout, - "history_save"); - - if (tmp != old_history_save) - command_history::ignore_entries (! tmp); - - return retval; -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/oct-hist.h --- a/libinterp/interpfcn/oct-hist.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_octave_hist_h) -#define octave_octave_hist_h 1 - -#include - -#include "cmd-hist.h" - -extern void initialize_history (bool read_history_file = false); - -// Write timestamp to history file. -extern void octave_history_write_timestamp (void); - -// TRUE means input is coming from temporary history file. -extern bool input_from_tmp_history_file; - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/octave-link.cc --- a/libinterp/interpfcn/octave-link.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,404 +0,0 @@ -/* - -Copyright (C) 2013 John W. Eaton -Copyright (C) 2011-2012 Jacob Dawid -Copyright (C) 2011-2012 John P. Swensen - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "cmd-edit.h" -#include "defun.h" -#include "oct-env.h" -#include "oct-mutex.h" -#include "singleton-cleanup.h" -#include "toplev.h" - -#include "octave-link.h" - -static int -octave_readline_hook (void) -{ - octave_link::entered_readline_hook (); - octave_link::generate_events (); - octave_link::process_events (); - octave_link::finished_readline_hook (); - - return 0; -} - -octave_link *octave_link::instance = 0; - -octave_link::octave_link (void) - : event_queue_mutex (new octave_mutex ()), gui_event_queue (), - debugging (false), link_enabled (true) -{ - command_editor::add_event_hook (octave_readline_hook); -} - -void -octave_link::set_workspace (void) -{ - if (enabled ()) - instance->do_set_workspace ((symbol_table::current_scope () - == symbol_table::top_scope ()), - symbol_table::workspace_info ()); -} - -// OBJ should be an object of a class that is derived from the base -// class octave_link, or 0 to disconnect the link. It is the -// responsibility of the caller to delete obj. - -void -octave_link::connect_link (octave_link* obj) -{ - if (obj && instance) - ::error ("octave_link is already linked!"); - else - instance = obj; -} - -void -octave_link::do_generate_events (void) -{ -} - -void -octave_link::do_process_events (void) -{ - event_queue_mutex->lock (); - - gui_event_queue.run (); - - event_queue_mutex->unlock (); -} - -void -octave_link::do_discard_events (void) -{ - event_queue_mutex->lock (); - - gui_event_queue.discard (); - - event_queue_mutex->unlock (); -} - -DEFUN (__octave_link_enabled__, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __octave_link_enabled__ ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - return octave_value (octave_link::enabled ()); -} - -DEFUN (__octave_link_edit_file__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __octave_link_edit_file__ (@var{file})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - { - std::string file = args(0).string_value (); - - if (! error_state) - { - flush_octave_stdout (); - - retval = octave_link::edit_file (file); - } - else - error ("expecting file name as argument"); - } - - return retval; -} - -DEFUN (__octave_link_message_dialog__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __octave_link_message_dialog__ (@var{dlg}, @var{msg}, @var{title})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 3) - { - std::string dlg = args(0).string_value (); - std::string msg = args(1).string_value (); - std::string title = args(2).string_value (); - - if (! error_state) - { - flush_octave_stdout (); - - retval = octave_link::message_dialog (dlg, msg, title); - } - else - error ("invalid arguments"); - } - - return retval; -} - -DEFUN (__octave_link_question_dialog__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __octave_link_question_dialog__ (@var{msg}, @var{title}, @var{btn1}, @var{btn2}, @var{btn3}, @var{default})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 6) - { - std::string msg = args(0).string_value (); - std::string title = args(1).string_value (); - std::string btn1 = args(2).string_value (); - std::string btn2 = args(3).string_value (); - std::string btn3 = args(4).string_value (); - std::string btndef = args(5).string_value (); - - if (! error_state) - { - flush_octave_stdout (); - - retval = octave_link::question_dialog (msg, title, btn1, btn2, btn3, btndef); - } - else - error ("invalid arguments"); - } - - return retval; -} - -DEFUN (__octave_link_file_dialog__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __octave_link_file_dialog__ (@var{filterlist}, @var{title}, @var{filename}, @var{size} @var{multiselect}, @var{pathname})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 6) - { - - const Array flist = args(0).cellstr_value (); - std::string title = args(1).string_value (); - std::string filename = args(2).string_value (); - Matrix pos = args(3).matrix_value (); - std::string multi_on = args(4).string_value (); // on, off, create - std::string pathname = args(5).string_value (); - - octave_idx_type nel = flist.numel (); - octave_link::filter_list filter_lst; - - for (octave_idx_type i = 0; i < flist.rows (); i++) - filter_lst.push_back (std::make_pair (flist(i,0), - (flist.columns () > 1 - ? flist(i,1) : ""))); - - if (! error_state) - { - flush_octave_stdout (); - - std::list items_lst - = octave_link::file_dialog (filter_lst, title, filename, pathname, - multi_on); - - nel = items_lst.size (); - - retval.resize (3); - - // If 3, then is filename, directory and selected index. - if (nel <= 3) - { - int idx = 0; - for (std::list::iterator it = items_lst.begin (); - it != items_lst.end (); it++) - { - retval(idx++) = *it; - - if (idx == 1 && retval(0).string_value ().length () == 0) - retval(0) = 0; - - if (idx == 3) - retval(2) = atoi (retval(2).string_value ().c_str ()); - } - } - else - { - // Multiple files. - nel = items_lst.size (); - Cell items (dim_vector (1, nel)); - - std::list::iterator it = items_lst.begin (); - - for (int idx = 0; idx < items_lst.size ()-2; idx++) - { - items.xelem (idx) = *it; - it++; - } - - retval(0) = items; - retval(1) = *it++; - retval(2) = atoi (it->c_str ()); - } - } - else - error ("invalid arguments"); - } - - return retval; -} - -DEFUN (__octave_link_list_dialog__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __octave_link_list_dialog__ (@var{list}, @var{mode}, @var{size}, @var{intial}, @var{name}, @var{prompt}, @var{ok_string}, @var{cancel_string})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 8) - { - Cell list = args(0).cell_value (); - const Array tlist = list.cellstr_value (); - octave_idx_type nel = tlist.numel (); - std::list list_lst; - for (octave_idx_type i = 0; i < nel; i++) - list_lst.push_back (tlist(i)); - - std::string mode = args(1).string_value (); - - Matrix size_matrix = args(2).matrix_value (); - int width = size_matrix(0); - int height = size_matrix(1); - - Matrix initial_matrix = args(3).matrix_value (); - nel = initial_matrix.numel (); - std::list initial_lst; - for (octave_idx_type i = 0; i < nel; i++) - initial_lst.push_back (initial_matrix(i)); - - std::string name = args(4).string_value (); - list = args(5).cell_value (); - const Array plist = list.cellstr_value (); - nel = plist.numel (); - std::list prompt_lst; - for (octave_idx_type i = 0; i < nel; i++) - prompt_lst.push_back (plist(i)); - std::string ok_string = args(6).string_value (); - std::string cancel_string = args(7).string_value (); - - if (! error_state) - { - flush_octave_stdout (); - - std::pair, int> result - = octave_link::list_dialog (list_lst, mode, width, height, - initial_lst, name, prompt_lst, - ok_string, cancel_string); - - std::list items_lst = result.first; - nel = items_lst.size (); - Matrix items (dim_vector (1, nel)); - octave_idx_type i = 0; - for (std::list::iterator it = items_lst.begin (); - it != items_lst.end (); it++) - { - items.xelem(i++) = *it; - } - - retval(1) = result.second; - retval(0) = items; - } - else - error ("invalid arguments"); - } - - return retval; -} - -DEFUN (__octave_link_input_dialog__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __octave_link_input_dialog__ (@var{prompt}, @var{title}, @var{rowscols}, @var{defaults})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 4) - { - Cell prompt = args(0).cell_value (); - Array tmp = prompt.cellstr_value (); - octave_idx_type nel = tmp.numel (); - std::list prompt_lst; - for (octave_idx_type i = 0; i < nel; i++) - prompt_lst.push_back (tmp(i)); - - std::string title = args(1).string_value (); - - Matrix rc = args(2).matrix_value (); - nel = rc.rows (); - std::list nr; - std::list nc; - for (octave_idx_type i = 0; i < nel; i++) - { - nr.push_back (rc(i,0)); - nc.push_back (rc(i,1)); - } - - Cell defaults = args(3).cell_value (); - tmp = defaults.cellstr_value (); - nel = tmp.numel (); - std::list defaults_lst; - for (octave_idx_type i = 0; i < nel; i++) - defaults_lst.push_back (tmp(i)); - - if (! error_state) - { - flush_octave_stdout (); - - std::list items_lst - = octave_link::input_dialog (prompt_lst, title, nr, nc, - defaults_lst); - - nel = items_lst.size (); - Cell items (dim_vector (1, nel)); - octave_idx_type i = 0; - for (std::list::iterator it = items_lst.begin (); - it != items_lst.end (); it++) - { - items.xelem(i++) = *it; - } - - retval = items; - } - else - error ("invalid arguments"); - } - - return retval; -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/octave-link.h --- a/libinterp/interpfcn/octave-link.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,430 +0,0 @@ -/* - -Copyright (C) 2013 John W. Eaton -Copyright (C) 2011-2012 Jacob Dawid -Copyright (C) 2011-2012 John P. Swensen - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_link_h) -#define octave_link_h 1 - -#include - -#include "event-queue.h" - -class octave_mutex; -class string_vector; -class workspace_element; - -// \class OctaveLink -// \brief Provides threadsafe access to octave. -// \author Jacob Dawid -// -// This class is a wrapper around octave and provides thread safety by -// buffering access operations to octave and executing them in the -// readline event hook, which lives in the octave thread. - -class -OCTINTERP_API -octave_link -{ -protected: - - octave_link (void); - -public: - - virtual ~octave_link (void) { } - - static void generate_events (void) - { - if (enabled ()) - instance->do_generate_events (); - } - - // If disable is TRUE, then no additional events will be processed - // other than exit. - - static void process_events (bool disable = false) - { - if (enabled ()) - { - if (disable) - instance->link_enabled = false; - - instance->do_process_events (); - } - } - - static void discard_events (void) - { - if (enabled ()) - instance->do_discard_events (); - } - - static bool exit (int status) - { - bool retval = false; - - if (instance_ok ()) - retval = instance->do_exit (status); - - return retval; - } - - template - static void post_event (T *obj, void (T::*method) (void)) - { - if (enabled ()) - instance->do_post_event (obj, method); - } - - template - static void post_event (T *obj, void (T::*method) (A), A arg) - { - if (enabled ()) - instance->do_post_event (obj, method, arg); - } - - template - static void post_event (T *obj, void (T::*method) (const A&), const A& arg) - { - if (enabled ()) - instance->do_post_event (obj, method, arg); - } - - template - static void post_event (T *obj, void (T::*method) (const A&, const B&), - const A& arg_a, const B& arg_b) - { - if (enabled ()) - instance->do_post_event (obj, method, arg_a, arg_b); - } - - static void entered_readline_hook (void) - { - if (enabled ()) - instance->do_entered_readline_hook (); - } - - static void finished_readline_hook (void) - { - if (enabled ()) - instance->do_finished_readline_hook (); - } - - static bool - edit_file (const std::string& file) - { - return enabled () ? instance->do_edit_file (file) : false; - } - - static int - message_dialog (const std::string& dlg, const std::string& msg, - const std::string& title) - { - return enabled () ? instance->do_message_dialog (dlg, msg, title) : 0; - } - - static std::string - question_dialog (const std::string& msg, const std::string& title, - const std::string& btn1, const std::string& btn2, - const std::string& btn3, const std::string& btndef) - { - return enabled () ? instance->do_question_dialog (msg, title, btn1, - btn2, btn3, btndef) : 0; - } - - static std::pair, int> - list_dialog (const std::list& list, - const std::string& mode, - int width, int height, - const std::list& initial_value, - const std::string& name, - const std::list& prompt, - const std::string& ok_string, - const std::string& cancel_string) - { - return enabled () - ? instance->do_list_dialog (list, mode, width, height, - initial_value, name, prompt, - ok_string, cancel_string) - : std::pair, int> (); - } - - static std::list - input_dialog (const std::list& prompt, - const std::string& title, - const std::list& nr, - const std::list& nc, - const std::list& defaults) - { - return enabled () - ? instance->do_input_dialog (prompt, title, nr, nc, defaults) - : std::list (); - } - - typedef std::list > filter_list; - - static std::list - file_dialog (const filter_list& filter, const std::string& title, - const std::string& filename, const std::string& dirname, - const std::string& multimode) - { - return enabled () - ? instance->do_file_dialog (filter, title, filename, dirname, multimode) - : std::list (); - } - - - static int debug_cd_or_addpath_error (const std::string& file, - const std::string& dir, - bool addpath_option) - { - return enabled () - ? instance->do_debug_cd_or_addpath_error (file, dir, addpath_option) : 0; - } - - static void change_directory (const std::string& dir) - { - if (enabled ()) - instance->do_change_directory (dir); - } - - // Preserves pending input. - static void execute_command_in_terminal (const std::string& command) - { - if (enabled ()) - instance->do_execute_command_in_terminal (command); - } - - static void set_workspace (void); - - static void set_workspace (bool top_level, - const std::list& ws) - { - if (enabled ()) - instance->do_set_workspace (top_level, ws); - } - - static void clear_workspace (void) - { - if (enabled ()) - instance->do_clear_workspace (); - } - - static void set_history (const string_vector& hist) - { - if (enabled ()) - instance->do_set_history (hist); - } - - static void append_history (const std::string& hist_entry) - { - if (enabled ()) - instance->do_append_history (hist_entry); - } - - static void clear_history (void) - { - if (enabled ()) - instance->do_clear_history (); - } - - static void pre_input_event (void) - { - if (enabled ()) - instance->do_pre_input_event (); - } - - static void post_input_event (void) - { - if (enabled ()) - instance->do_post_input_event (); - } - - static void enter_debugger_event (const std::string& file, int line) - { - if (enabled ()) - { - instance->debugging = true; - - instance->do_enter_debugger_event (file, line); - } - } - - static void execute_in_debugger_event (const std::string& file, int line) - { - if (enabled ()) - instance->do_execute_in_debugger_event (file, line); - } - - static void exit_debugger_event (void) - { - if (enabled () && instance->debugging) - { - instance->debugging = false; - - instance->do_exit_debugger_event (); - } - } - - static void - update_breakpoint (bool insert, const std::string& file, int line) - { - if (enabled ()) - instance->do_update_breakpoint (insert, file, line); - } - - static void connect_link (octave_link *); - - static void set_default_prompts (std::string& ps1, std::string& ps2, - std::string& ps4) - { - if (enabled ()) - instance->do_set_default_prompts (ps1, ps2, ps4); - } - - static bool enabled (void) - { - return instance_ok () ? instance->link_enabled : false; - } - -private: - - static octave_link *instance; - - // No copying! - - octave_link (const octave_link&); - - octave_link& operator = (const octave_link&); - - static bool instance_ok (void) { return instance != 0; } - -protected: - - // Semaphore to lock access to the event queue. - octave_mutex *event_queue_mutex; - - // Event Queue. - event_queue gui_event_queue; - - bool debugging; - bool link_enabled; - - void do_generate_events (void); - void do_process_events (void); - void do_discard_events (void); - - template - void do_post_event (T *obj, void (T::*method) (void)) - { - gui_event_queue.add_method (obj, method); - } - - template - void do_post_event (T *obj, void (T::*method) (A), A arg) - { - gui_event_queue.add_method (obj, method, arg); - } - - template - void do_post_event (T *obj, void (T::*method) (const A&), const A& arg) - { - gui_event_queue.add_method (obj, method, arg); - } - - void do_entered_readline_hook (void) { } - void do_finished_readline_hook (void) { } - - virtual bool do_exit (int status) = 0; - - virtual bool do_edit_file (const std::string& file) = 0; - - virtual int - do_message_dialog (const std::string& dlg, const std::string& msg, - const std::string& title) = 0; - - virtual std::string - do_question_dialog (const std::string& msg, const std::string& title, - const std::string& btn1, const std::string& btn2, - const std::string& btn3, const std::string& btndef) = 0; - - virtual std::pair, int> - do_list_dialog (const std::list& list, - const std::string& mode, - int width, int height, - const std::list& initial_value, - const std::string& name, - const std::list& prompt, - const std::string& ok_string, - const std::string& cancel_string) = 0; - - virtual std::list - do_input_dialog (const std::list& prompt, - const std::string& title, - const std::list& nr, - const std::list& nc, - const std::list& defaults) = 0; - - virtual std::list - do_file_dialog (const filter_list& filter, const std::string& title, - const std::string& filename, const std::string& dirname, - const std::string& multimode) = 0; - - virtual int - do_debug_cd_or_addpath_error (const std::string& file, - const std::string& dir, - bool addpath_option) = 0; - - virtual void do_change_directory (const std::string& dir) = 0; - - virtual void do_execute_command_in_terminal (const std::string& command) = 0; - - virtual void - do_set_workspace (bool top_level, - const std::list& ws) = 0; - - virtual void do_clear_workspace (void) = 0; - - virtual void do_set_history (const string_vector& hist) = 0; - virtual void do_append_history (const std::string& hist_entry) = 0; - virtual void do_clear_history (void) = 0; - - virtual void do_pre_input_event (void) = 0; - virtual void do_post_input_event (void) = 0; - - virtual void - do_enter_debugger_event (const std::string& file, int line) = 0; - - virtual void - do_execute_in_debugger_event (const std::string& file, int line) = 0; - - virtual void do_exit_debugger_event (void) = 0; - - virtual void do_update_breakpoint (bool insert, - const std::string& file, int line) = 0; - - virtual void do_set_default_prompts (std::string& ps1, std::string& ps2, - std::string& ps4) = 0; -}; - -#endif // OCTAVELINK_H diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/pager.cc --- a/libinterp/interpfcn/pager.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,715 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include "cmd-edit.h" -#include "oct-env.h" -#include "singleton-cleanup.h" - -#include "defaults.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "input.h" -#include "oct-obj.h" -#include "pager.h" -#include "procstream.h" -#include "sighandlers.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" - -// Our actual connection to the external pager. -static oprocstream *external_pager = 0; - -// TRUE means we write to the diary file. -static bool write_to_diary_file = false; - -// The name of the current diary file. -static std::string diary_file; - -// The diary file. -static std::ofstream external_diary_file; - -static std::string -default_pager (void) -{ - std::string pager_binary = octave_env::getenv ("PAGER"); - -#ifdef OCTAVE_DEFAULT_PAGER - if (pager_binary.empty ()) - pager_binary = OCTAVE_DEFAULT_PAGER; -#endif - - return pager_binary; -} - -// The shell command to run as the pager. -static std::string VPAGER = default_pager (); - -// The options to pass to the pager. -static std::string VPAGER_FLAGS; - -// TRUE means that if output is going to the pager, it is sent as soon -// as it is available. Otherwise, it is buffered and only sent to the -// pager when it is time to print another prompt. -static bool Vpage_output_immediately = false; - -// TRUE means all output intended for the screen should be passed -// through the pager. -static bool Vpage_screen_output = true; - -static bool really_flush_to_pager = false; - -static bool flushing_output_to_pager = false; - -static void -clear_external_pager (void) -{ - if (external_pager) - { - octave_child_list::remove (external_pager->pid ()); - - delete external_pager; - external_pager = 0; - } -} - -static bool -pager_event_handler (pid_t pid, int status) -{ - bool retval = false; - - if (pid > 0) - { - if (octave_wait::ifexited (status) || octave_wait::ifsignaled (status)) - { - // Avoid warning() since that will put us back in the pager, - // which would be bad news. - - std::cerr << "warning: connection to external pager lost (pid = " - << pid << ")" << std::endl; - std::cerr << "warning: flushing pending output (please wait)" - << std::endl; - - // Request removal of this PID from the list of child - // processes. - - retval = true; - } - } - - return retval; -} - -static std::string -pager_command (void) -{ - std::string cmd = VPAGER; - - if (! (cmd.empty () || VPAGER_FLAGS.empty ())) - cmd += " " + VPAGER_FLAGS; - - return cmd; -} - -static void -do_sync (const char *msg, int len, bool bypass_pager) -{ - if (msg && len > 0) - { - if (bypass_pager) - { - std::cout.write (msg, len); - std::cout.flush (); - } - else - { - if (! external_pager) - { - std::string pgr = pager_command (); - - if (! pgr.empty ()) - { - external_pager = new oprocstream (pgr.c_str ()); - - if (external_pager) - octave_child_list::insert (external_pager->pid (), - pager_event_handler); - } - } - - if (external_pager) - { - if (external_pager->good ()) - { - external_pager->write (msg, len); - - external_pager->flush (); - -#if defined (EPIPE) - if (errno == EPIPE) - external_pager->setstate (std::ios::failbit); -#endif - } - else - { - // FIXME -- omething is not right with the - // pager. If it died then we should receive a - // signal for that. If there is some other problem, - // then what? - } - } - else - { - std::cout.write (msg, len); - std::cout.flush (); - } - } - } -} - -// Assume our terminal wraps long lines. - -static bool -more_than_a_screenful (const char *s, int len) -{ - if (s) - { - int available_rows = command_editor::terminal_rows () - 2; - - int cols = command_editor::terminal_cols (); - - int count = 0; - - int chars_this_line = 0; - - for (int i = 0; i < len; i++) - { - if (*s++ == '\n') - { - count += chars_this_line / cols + 1; - chars_this_line = 0; - } - else - chars_this_line++; - } - - if (count > available_rows) - return true; - } - - return false; -} - -int -octave_pager_buf::sync (void) -{ - if (! interactive - || really_flush_to_pager - || (Vpage_screen_output && Vpage_output_immediately) - || ! Vpage_screen_output) - { - char *buf = eback (); - - int len = pptr () - buf; - - bool bypass_pager = (! interactive - || ! Vpage_screen_output - || (really_flush_to_pager - && Vpage_screen_output - && ! Vpage_output_immediately - && ! more_than_a_screenful (buf, len))); - - if (len > 0) - { - do_sync (buf, len, bypass_pager); - - flush_current_contents_to_diary (); - - seekoff (0, std::ios::beg); - } - } - - return 0; -} - -void -octave_pager_buf::flush_current_contents_to_diary (void) -{ - char *buf = eback () + diary_skip; - - size_t len = pptr () - buf; - - octave_diary.write (buf, len); - - diary_skip = 0; -} - -void -octave_pager_buf::set_diary_skip (void) -{ - diary_skip = pptr () - eback (); -} - -int -octave_diary_buf::sync (void) -{ - if (write_to_diary_file && external_diary_file) - { - char *buf = eback (); - - int len = pptr () - buf; - - if (len > 0) - external_diary_file.write (buf, len); - } - - seekoff (0, std::ios::beg); - - return 0; -} - -octave_pager_stream *octave_pager_stream::instance = 0; - -octave_pager_stream::octave_pager_stream (void) : std::ostream (0), pb (0) -{ - pb = new octave_pager_buf (); - rdbuf (pb); - setf (unitbuf); -} - -octave_pager_stream::~octave_pager_stream (void) -{ - flush (); - delete pb; -} - -std::ostream& -octave_pager_stream::stream (void) -{ - return instance_ok () ? *instance : std::cout; -} - -void -octave_pager_stream::flush_current_contents_to_diary (void) -{ - if (instance_ok ()) - instance->do_flush_current_contents_to_diary (); -} - -void -octave_pager_stream::set_diary_skip (void) -{ - if (instance_ok ()) - instance->do_set_diary_skip (); -} - -// Reinitialize the pager buffer to avoid hanging on to large internal -// buffers when they might not be needed. This function should only be -// called when the pager is not in use. For example, just before -// getting command-line input. - -void -octave_pager_stream::reset (void) -{ - if (instance_ok ()) - instance->do_reset (); -} - -void -octave_pager_stream::do_flush_current_contents_to_diary (void) -{ - if (pb) - pb->flush_current_contents_to_diary (); -} - -void -octave_pager_stream::do_set_diary_skip (void) -{ - if (pb) - pb->set_diary_skip (); -} - -void -octave_pager_stream::do_reset (void) -{ - delete pb; - pb = new octave_pager_buf (); - rdbuf (pb); - setf (unitbuf); -} - -bool -octave_pager_stream::instance_ok (void) -{ - bool retval = true; - - if (! instance) - { - instance = new octave_pager_stream (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); - } - - if (! instance) - { - ::error ("unable to create pager_stream object!"); - - retval = false; - } - - return retval; -} - -octave_diary_stream *octave_diary_stream::instance = 0; - -octave_diary_stream::octave_diary_stream (void) : std::ostream (0), db (0) -{ - db = new octave_diary_buf (); - rdbuf (db); - setf (unitbuf); -} - -octave_diary_stream::~octave_diary_stream (void) -{ - flush (); - delete db; -} - -std::ostream& -octave_diary_stream::stream (void) -{ - return instance_ok () ? *instance : std::cout; -} - -// Reinitialize the diary buffer to avoid hanging on to large internal -// buffers when they might not be needed. This function should only be -// called when the pager is not in use. For example, just before -// getting command-line input. - -void -octave_diary_stream::reset (void) -{ - if (instance_ok ()) - instance->do_reset (); -} - -void -octave_diary_stream::do_reset (void) -{ - delete db; - db = new octave_diary_buf (); - rdbuf (db); - setf (unitbuf); -} - -bool -octave_diary_stream::instance_ok (void) -{ - bool retval = true; - - if (! instance) - { - instance = new octave_diary_stream (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); - } - - if (! instance) - { - ::error ("unable to create diary_stream object!"); - - retval = false; - } - - return retval; -} - -void -flush_octave_stdout (void) -{ - if (! flushing_output_to_pager) - { - unwind_protect frame; - - frame.protect_var (really_flush_to_pager); - frame.protect_var (flushing_output_to_pager); - - really_flush_to_pager = true; - flushing_output_to_pager = true; - - octave_stdout.flush (); - - clear_external_pager (); - } -} - -static void -close_diary_file (void) -{ - // Try to flush the current buffer to the diary now, so that things - // like - // - // function foo () - // diary on; - // ... - // diary off; - // endfunction - // - // will do the right thing. - - octave_pager_stream::flush_current_contents_to_diary (); - - if (external_diary_file.is_open ()) - { - octave_diary.flush (); - external_diary_file.close (); - } -} - -static void -open_diary_file (void) -{ - close_diary_file (); - - // If there is pending output in the pager buf, it should not go - // into the diary file. - - octave_pager_stream::set_diary_skip (); - - external_diary_file.open (diary_file.c_str (), std::ios::app); - - if (! external_diary_file) - error ("diary: can't open diary file '%s'", diary_file.c_str ()); -} - -DEFUN (diary, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} diary options\n\ -Record a list of all commands @emph{and} the output they produce, mixed\n\ -together just as you see them on your terminal. Valid options are:\n\ -\n\ -@table @code\n\ -@item on\n\ -Start recording your session in a file called @file{diary} in your\n\ -current working directory.\n\ -\n\ -@item off\n\ -Stop recording your session in the diary file.\n\ -\n\ -@item @var{file}\n\ -Record your session in the file named @var{file}.\n\ -@end table\n\ -\n\ -With no arguments, @code{diary} toggles the current diary state.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("diary"); - - if (error_state) - return retval; - - if (diary_file.empty ()) - diary_file = "diary"; - - switch (argc) - { - case 1: - write_to_diary_file = ! write_to_diary_file; - open_diary_file (); - break; - - case 2: - { - std::string arg = argv[1]; - - if (arg == "on") - { - write_to_diary_file = true; - open_diary_file (); - } - else if (arg == "off") - { - close_diary_file (); - write_to_diary_file = false; - } - else - { - diary_file = arg; - write_to_diary_file = true; - open_diary_file (); - } - } - break; - - default: - print_usage (); - break; - } - - return retval; -} - -DEFUN (more, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} more\n\ -@deftypefnx {Command} {} more on\n\ -@deftypefnx {Command} {} more off\n\ -Turn output pagination on or off. Without an argument, @code{more}\n\ -toggles the current state.\n\ -The current state can be determined via @code{page_screen_output}.\n\ -@seealso{page_screen_output, page_output_immediately, PAGER, PAGER_FLAGS}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("more"); - - if (error_state) - return retval; - - if (argc == 2) - { - std::string arg = argv[1]; - - if (arg == "on") - Vpage_screen_output = true; - else if (arg == "off") - Vpage_screen_output = false; - else - error ("more: unrecognized argument '%s'", arg.c_str ()); - } - else if (argc == 1) - Vpage_screen_output = ! Vpage_screen_output; - else - print_usage (); - - return retval; -} - -DEFUN (terminal_size, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} terminal_size ()\n\ -Return a two-element row vector containing the current size of the\n\ -terminal window in characters (rows and columns).\n\ -@seealso{list_in_columns}\n\ -@end deftypefn") -{ - RowVector size (2, 0.0); - - size(0) = command_editor::terminal_rows (); - size(1) = command_editor::terminal_cols (); - - return octave_value (size); -} - -DEFUN (page_output_immediately, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} page_output_immediately ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} page_output_immediately (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} page_output_immediately (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave sends\n\ -output to the pager as soon as it is available. Otherwise, Octave\n\ -buffers its output and waits until just before the prompt is printed to\n\ -flush it to the pager.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{page_screen_output, more, PAGER, PAGER_FLAGS}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (page_output_immediately); -} - -DEFUN (page_screen_output, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} page_screen_output ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} page_screen_output (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} page_screen_output (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether output intended\n\ -for the terminal window that is longer than one page is sent through a\n\ -pager. This allows you to view one screenful at a time. Some pagers\n\ -(such as @code{less}---see @ref{Installation}) are also capable of moving\n\ -backward on the output.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{more, page_output_immediately, PAGER, PAGER_FLAGS}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (page_screen_output); -} - -DEFUN (PAGER, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} PAGER ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} PAGER (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} PAGER (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the program to use\n\ -to display terminal output on your system. The default value is\n\ -normally @code{\"less\"}, @code{\"more\"}, or\n\ -@code{\"pg\"}, depending on what programs are installed on your system.\n\ -@xref{Installation}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{PAGER_FLAGS, page_output_immediately, more, page_screen_output}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (PAGER); -} - -DEFUN (PAGER_FLAGS, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} PAGER_FLAGS ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} PAGER_FLAGS (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} PAGER_FLAGS (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the options to pass\n\ -to the pager.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{PAGER, more, page_screen_output, page_output_immediately}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (PAGER_FLAGS); -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/pager.h --- a/libinterp/interpfcn/pager.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,150 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_pager_h) -#define octave_pager_h 1 - -#include -#include -#include - -#include - -class -OCTINTERP_API -octave_pager_buf : public std::stringbuf -{ -public: - - octave_pager_buf (void) : std::stringbuf (), diary_skip (0) { } - - void flush_current_contents_to_diary (void); - - void set_diary_skip (void); - -protected: - - int sync (void); - -private: - - size_t diary_skip; -}; - -class -OCTINTERP_API -octave_pager_stream : public std::ostream -{ -protected: - - octave_pager_stream (void); - -public: - - ~octave_pager_stream (void); - - static void flush_current_contents_to_diary (void); - - static void set_diary_skip (void); - - static std::ostream& stream (void); - - static void reset (void); - -private: - - void do_flush_current_contents_to_diary (void); - - void do_set_diary_skip (void); - - void do_reset (void); - - static octave_pager_stream *instance; - - static bool instance_ok (void); - - static void cleanup_instance (void) { delete instance; instance = 0; } - - octave_pager_buf *pb; - - // No copying! - - octave_pager_stream (const octave_pager_stream&); - - octave_pager_stream& operator = (const octave_pager_stream&); -}; - -class -OCTINTERP_API -octave_diary_buf : public std::stringbuf -{ -public: - - octave_diary_buf (void) : std::stringbuf () { } - -protected: - - int sync (void); -}; - -class -OCTINTERP_API -octave_diary_stream : public std::ostream -{ -protected: - - octave_diary_stream (void); - -public: - - ~octave_diary_stream (void); - - static std::ostream& stream (void); - - static void reset (void); - -private: - - void do_reset (void); - - static octave_diary_stream *instance; - - static bool instance_ok (void); - - static void cleanup_instance (void) { delete instance; instance = 0; } - - octave_diary_buf *db; - - // No copying! - - octave_diary_stream (const octave_diary_stream&); - - octave_diary_stream& operator = (const octave_diary_stream&); -}; - -#define octave_stdout (octave_pager_stream::stream ()) - -#define octave_diary (octave_diary_stream::stream ()) - -extern OCTINTERP_API void flush_octave_stdout (void); - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/pr-output.cc --- a/libinterp/interpfcn/pr-output.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,4097 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include -#include -#include -#include - -#include "Array-util.h" -#include "CMatrix.h" -#include "Range.h" -#include "cmd-edit.h" -#include "dMatrix.h" -#include "lo-mappers.h" -#include "lo-math.h" -#include "mach-info.h" -#include "oct-cmplx.h" -#include "quit.h" -#include "str-vec.h" - -#include "Cell.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "oct-obj.h" -#include "oct-stream.h" -#include "pager.h" -#include "pr-output.h" -#include "sysdep.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" - -// TRUE means use a scaled fixed point format for 'format long' and -// 'format short'. -static bool Vfixed_point_format = false; - -// The maximum field width for a number printed by the default output -// routines. -static int Voutput_max_field_width = 10; - -// The precision of the numbers printed by the default output -// routines. -static int Voutput_precision = 5; - -// TRUE means that the dimensions of empty objects should be printed -// like this: x = [](2x0). -bool Vprint_empty_dimensions = true; - -// TRUE means that the rows of big matrices should be split into -// smaller slices that fit on the screen. -static bool Vsplit_long_rows = true; - -// TRUE means don't do any fancy formatting. -static bool free_format = false; - -// TRUE means print plus sign for nonzero, blank for zero. -static bool plus_format = false; - -// First char for > 0, second for < 0, third for == 0. -static std::string plus_format_chars = "+ "; - -// TRUE means always print in a rational approximation -static bool rat_format = false; - -// Used to force the length of the rational approximation string for Frats -static int rat_string_len = -1; - -// TRUE means always print like dollars and cents. -static bool bank_format = false; - -// TRUE means print data in hexadecimal format. -static int hex_format = 0; - -// TRUE means print data in binary-bit-pattern format. -static int bit_format = 0; - -// TRUE means don't put newlines around the column number headers. -bool Vcompact_format = false; - -// TRUE means use an e format. -static bool print_e = false; - -// TRUE means use a g format. -static bool print_g = false; - -// TRUE means print E instead of e for exponent field. -static bool print_big_e = false; - -// TRUE means use an engineering format. -static bool print_eng = false; - -class pr_engineering_float; -class pr_formatted_float; -class pr_rational_float; - -static int -current_output_max_field_width (void) -{ - return Voutput_max_field_width; -} - -static int -current_output_precision (void) -{ - return Voutput_precision; -} - -class -float_format -{ -public: - - float_format (int w = current_output_max_field_width (), - int p = current_output_precision (), int f = 0) - : fw (w), ex (0), prec (p), fmt (f), up (0), sp (0) { } - - float_format (int w, int e, int p, int f) - : fw (w), ex (e), prec (p), fmt (f), up (0), sp (0) { } - - float_format (const float_format& ff) - : fw (ff.fw), ex (ff.ex), prec (ff.prec), fmt (ff.fmt), up (ff.up), sp (ff.sp) { } - - float_format& operator = (const float_format& ff) - { - if (&ff != this) - { - fw = ff.fw; - ex = ff.ex; - prec = ff.prec; - fmt = ff.fmt; - up = ff.up; - sp = ff.sp; - } - - return *this; - } - - ~float_format (void) { } - - float_format& scientific (void) { fmt = std::ios::scientific; return *this; } - float_format& fixed (void) { fmt = std::ios::fixed; return *this; } - float_format& general (void) { fmt = 0; return *this; } - - float_format& uppercase (void) { up = std::ios::uppercase; return *this; } - float_format& lowercase (void) { up = 0; return *this; } - - float_format& precision (int p) { prec = p; return *this; } - - float_format& width (int w) { fw = w; return *this; } - - float_format& trailing_zeros (bool tz = true) - { sp = tz ? std::ios::showpoint : 0; return *this; } - - friend std::ostream& operator << (std::ostream& os, - const pr_engineering_float& pef); - - friend std::ostream& operator << (std::ostream& os, - const pr_formatted_float& pff); - - friend std::ostream& operator << (std::ostream& os, - const pr_rational_float& prf); - -private: - - // Field width. Zero means as wide as necessary. - int fw; - - // Exponent Field width. Zero means as wide as necessary. - int ex; - - // Precision. - int prec; - - // Format. - int fmt; - - // E or e. - int up; - - // Show trailing zeros. - int sp; -}; - -static int -calc_scale_exp (const int& x) -{ - if (! print_eng) - return x; - else - return x - 3*static_cast (x/3); - /* The expression above is equivalent to x - (x % 3). - * According to the ISO specification for C++ the modulo operator is - * compiler dependent if any of the arguments are negative. Since this - * function will need to work on negative arguments, and we want to avoid - * portability issues, we re-implement the modulo function to the desired - * behavior (truncation). There may be a gnulib replacement. - * - * ISO/IEC 14882:2003 : Programming languages -- C++. 5.6.4: ISO, IEC. 2003 . - * "the binary % operator yields the remainder from the division of the first - * expression by the second. .... If both operands are nonnegative then the - * remainder is nonnegative; if not, the sign of the remainder is - * implementation-defined". */ -} - -static int -engineering_exponent (const double& x) -{ - int ex = 0; - if (x != 0) - { - double absval = (x < 0.0 ? -x : x); - int logabsval = static_cast (gnulib::floor (log10 (absval))); - /* Avoid using modulo function with negative arguments for portability. - * See extended comment at calc_scale_exp */ - if (logabsval < 0.0) - ex = logabsval - 2 + ((-logabsval + 2) % 3); - else - ex = logabsval - (logabsval % 3); - } - return ex; -} - -static int -num_digits (const double& x) -{ - return 1 + (print_eng - ? engineering_exponent (x) - : static_cast (gnulib::floor (log10 (x)))); -} - -class -pr_engineering_float -{ -public: - - const float_format& f; - - double val; - - int exponent (void) const - { - return engineering_exponent (val); - } - - double mantissa (void) const - { - return val / std::pow (10.0, exponent ()); - } - - pr_engineering_float (const float_format& f_arg, double val_arg) - : f (f_arg), val (val_arg) { } -}; - -std::ostream& -operator << (std::ostream& os, const pr_engineering_float& pef) -{ - if (pef.f.fw >= 0) - os << std::setw (pef.f.fw - pef.f.ex); - - if (pef.f.prec >= 0) - os << std::setprecision (pef.f.prec); - - std::ios::fmtflags oflags = - os.flags (static_cast - (pef.f.fmt | pef.f.up | pef.f.sp)); - - os << pef.mantissa (); - - int ex = pef.exponent (); - if (ex < 0) - { - os << std::setw (0) << "e-"; - ex = -ex; - } - else - os << std::setw (0) << "e+"; - - os << std::setw (pef.f.ex - 2) << std::setfill ('0') << ex - << std::setfill (' '); - - os.flags (oflags); - - return os; -} - -class -pr_formatted_float -{ -public: - - const float_format& f; - - double val; - - pr_formatted_float (const float_format& f_arg, double val_arg) - : f (f_arg), val (val_arg) { } -}; - -std::ostream& -operator << (std::ostream& os, const pr_formatted_float& pff) -{ - if (pff.f.fw >= 0) - os << std::setw (pff.f.fw); - - if (pff.f.prec >= 0) - os << std::setprecision (pff.f.prec); - - std::ios::fmtflags oflags = - os.flags (static_cast - (pff.f.fmt | pff.f.up | pff.f.sp)); - - os << pff.val; - - os.flags (oflags); - - return os; -} - -static inline std::string -rational_approx (double val, int len) -{ - std::string s; - - if (len <= 0) - len = 10; - - if (xisinf (val)) - s = "1/0"; - else if (xisnan (val)) - s = "0/0"; - else if (val < std::numeric_limits::min () - || val > std::numeric_limits::max () - || D_NINT (val) == val) - { - std::ostringstream buf; - buf.flags (std::ios::fixed); - buf << std::setprecision (0) << xround (val); - s = buf.str (); - } - else - { - double lastn = 1.; - double lastd = 0.; - double n = xround (val); - double d = 1.; - double frac = val - n; - int m = 0; - - std::ostringstream buf2; - buf2.flags (std::ios::fixed); - buf2 << std::setprecision (0) << static_cast(n); - s = buf2.str (); - - while (1) - { - double flip = 1. / frac; - double step = xround (flip); - double nextn = n; - double nextd = d; - - // Have we converged to 1/intmax ? - if (m > 100 || fabs (frac) < 1 / static_cast (std::numeric_limits::max ())) - { - lastn = n; - lastd = d; - break; - } - - frac = flip - step; - n = n * step + lastn; - d = d * step + lastd; - lastn = nextn; - lastd = nextd; - - std::ostringstream buf; - buf.flags (std::ios::fixed); - buf << std::setprecision (0) << static_cast(n) - << "/" << static_cast(d); - m++; - - if (n < 0 && d < 0) - { - // Double negative, string can be two characters longer.. - if (buf.str ().length () > static_cast(len + 2) && - m > 1) - break; - } - else if (buf.str ().length () > static_cast(len) && - m > 1) - break; - - s = buf.str (); - } - - if (lastd < 0.) - { - // Move sign to the top - lastd = - lastd; - lastn = - lastn; - std::ostringstream buf; - buf.flags (std::ios::fixed); - buf << std::setprecision (0) << static_cast(lastn) - << "/" << static_cast(lastd); - s = buf.str (); - } - } - - return s; -} - -class -pr_rational_float -{ -public: - - const float_format& f; - - double val; - - pr_rational_float (const float_format& f_arg, double val_arg) - : f (f_arg), val (val_arg) { } -}; - -std::ostream& -operator << (std::ostream& os, const pr_rational_float& prf) -{ - int fw = (rat_string_len > 0 ? rat_string_len : prf.f.fw); - std::string s = rational_approx (prf.val, fw); - - if (fw >= 0) - os << std::setw (fw); - - std::ios::fmtflags oflags = - os.flags (static_cast - (prf.f.fmt | prf.f.up | prf.f.sp)); - - if (fw > 0 && s.length () > static_cast(fw)) - os << "*"; - else - os << s; - - os.flags (oflags); - - return os; -} - -// Current format for real numbers and the real part of complex -// numbers. -static float_format *curr_real_fmt = 0; - -// Current format for the imaginary part of complex numbers. -static float_format *curr_imag_fmt = 0; - -static double -pr_max_internal (const Matrix& m) -{ - octave_idx_type nr = m.rows (); - octave_idx_type nc = m.columns (); - - double result = -std::numeric_limits::max (); - - bool all_inf_or_nan = true; - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - double val = m(i,j); - if (xisinf (val) || xisnan (val)) - continue; - - all_inf_or_nan = false; - - if (val > result) - result = val; - } - - if (all_inf_or_nan) - result = 0.0; - - return result; -} - -static double -pr_min_internal (const Matrix& m) -{ - octave_idx_type nr = m.rows (); - octave_idx_type nc = m.columns (); - - double result = std::numeric_limits::max (); - - bool all_inf_or_nan = true; - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - double val = m(i,j); - if (xisinf (val) || xisnan (val)) - continue; - - all_inf_or_nan = false; - - if (val < result) - result = val; - } - - if (all_inf_or_nan) - result = 0.0; - - return result; -} - -// FIXME -- it would be nice to share more code among these -// functions,.. - -static void -set_real_format (int digits, bool inf_or_nan, bool int_only, int &fw) -{ - static float_format fmt; - - int prec = Voutput_precision; - - int ld, rd; - - if (rat_format) - { - fw = 0; - rd = 0; - } - else if (bank_format) - { - fw = digits < 0 ? 4 : digits + 3; - if (inf_or_nan && fw < 4) - fw = 4; - rd = 2; - } - else if (hex_format) - { - fw = 2 * sizeof (double); - rd = 0; - } - else if (bit_format) - { - fw = 8 * sizeof (double); - rd = 0; - } - else if (inf_or_nan || int_only) - { - fw = 1 + digits; - if (inf_or_nan && fw < 4) - fw = 4; - rd = fw; - } - else - { - if (digits > 0) - { - ld = digits; - rd = prec > digits ? prec - digits : prec; - digits++; - } - else - { - ld = 1; - rd = prec > digits ? prec - digits : prec; - digits = -digits + 1; - } - - fw = 1 + ld + 1 + rd; - if (inf_or_nan && fw < 4) - fw = 4; - } - - if (! (rat_format || bank_format || hex_format || bit_format) - && (fw > Voutput_max_field_width || print_e || print_g || print_eng)) - { - if (print_g) - fmt = float_format (); - else - { - // e+ddd - int ex = 5; - - if (print_eng) - { - // -ddd. - fw = 5 + prec + ex; - if (inf_or_nan && fw < 6) - fw = 6; - fmt = float_format (fw, ex, prec - 1, std::ios::fixed); - } - else - { - // -d. - fw = 3 + prec + ex; - if (inf_or_nan && fw < 4) - fw = 4; - fmt = float_format (fw, ex, prec - 1, std::ios::scientific); - } - } - - if (print_big_e) - fmt.uppercase (); - } - else if (! bank_format && (inf_or_nan || int_only)) - fmt = float_format (fw, rd); - else - fmt = float_format (fw, rd, std::ios::fixed); - - curr_real_fmt = &fmt; -} - -static void -set_format (double d, int& fw) -{ - curr_real_fmt = 0; - curr_imag_fmt = 0; - - if (free_format) - return; - - bool inf_or_nan = (xisinf (d) || xisnan (d)); - - bool int_only = (! inf_or_nan && D_NINT (d) == d); - - double d_abs = d < 0.0 ? -d : d; - - int digits = (inf_or_nan || d_abs == 0.0) - ? 0 : num_digits (d_abs); - - set_real_format (digits, inf_or_nan, int_only, fw); -} - -static inline void -set_format (double d) -{ - int fw; - set_format (d, fw); -} - -static void -set_real_matrix_format (int x_max, int x_min, bool inf_or_nan, - int int_or_inf_or_nan, int& fw) -{ - static float_format fmt; - - int prec = Voutput_precision; - - int ld, rd; - - if (rat_format) - { - fw = 9; - rd = 0; - } - else if (bank_format) - { - int digits = x_max > x_min ? x_max : x_min; - fw = digits <= 0 ? 4 : digits + 3; - if (inf_or_nan && fw < 4) - fw = 4; - rd = 2; - } - else if (hex_format) - { - fw = 2 * sizeof (double); - rd = 0; - } - else if (bit_format) - { - fw = 8 * sizeof (double); - rd = 0; - } - else if (Vfixed_point_format && ! print_g) - { - rd = prec; - fw = rd + 2; - if (inf_or_nan && fw < 4) - fw = 4; - } - else if (int_or_inf_or_nan) - { - int digits = x_max > x_min ? x_max : x_min; - fw = digits <= 0 ? 2 : digits + 1; - if (inf_or_nan && fw < 4) - fw = 4; - rd = fw; - } - else - { - int ld_max, rd_max; - if (x_max > 0) - { - ld_max = x_max; - rd_max = prec > x_max ? prec - x_max : prec; - x_max++; - } - else - { - ld_max = 1; - rd_max = prec > x_max ? prec - x_max : prec; - x_max = -x_max + 1; - } - - int ld_min, rd_min; - if (x_min > 0) - { - ld_min = x_min; - rd_min = prec > x_min ? prec - x_min : prec; - x_min++; - } - else - { - ld_min = 1; - rd_min = prec > x_min ? prec - x_min : prec; - x_min = -x_min + 1; - } - - ld = ld_max > ld_min ? ld_max : ld_min; - rd = rd_max > rd_min ? rd_max : rd_min; - - fw = 1 + ld + 1 + rd; - if (inf_or_nan && fw < 4) - fw = 4; - } - - if (! (rat_format || bank_format || hex_format || bit_format) - && (print_e - || print_eng || print_g - || (! Vfixed_point_format && fw > Voutput_max_field_width))) - { - if (print_g) - fmt = float_format (); - else - { - int ex = 4; - if (x_max > 100 || x_min > 100) - ex++; - - if (print_eng) - { - fw = 4 + prec + ex; - if (inf_or_nan && fw < 6) - fw = 6; - fmt = float_format (fw, ex, prec - 1, std::ios::fixed); - } - else - { - fw = 2 + prec + ex; - if (inf_or_nan && fw < 4) - fw = 4; - fmt = float_format (fw, prec - 1, std::ios::scientific); - } - } - - if (print_big_e) - fmt.uppercase (); - } - else if (! bank_format && int_or_inf_or_nan) - fmt = float_format (fw, rd); - else - fmt = float_format (fw, rd, std::ios::fixed); - - curr_real_fmt = &fmt; -} - -static void -set_format (const Matrix& m, int& fw, double& scale) -{ - curr_real_fmt = 0; - curr_imag_fmt = 0; - - if (free_format) - return; - - bool inf_or_nan = m.any_element_is_inf_or_nan (); - - bool int_or_inf_or_nan = m.all_elements_are_int_or_inf_or_nan (); - - Matrix m_abs = m.abs (); - double max_abs = pr_max_internal (m_abs); - double min_abs = pr_min_internal (m_abs); - - int x_max = max_abs == 0.0 ? 0 : num_digits (max_abs); - - int x_min = min_abs == 0.0 ? 0 : num_digits (min_abs); - - scale = (x_max == 0 || int_or_inf_or_nan) ? 1.0 - : std::pow (10.0, calc_scale_exp (x_max - 1)); - - set_real_matrix_format (x_max, x_min, inf_or_nan, int_or_inf_or_nan, fw); -} - -static inline void -set_format (const Matrix& m) -{ - int fw; - double scale; - set_format (m, fw, scale); -} - -static void -set_complex_format (int x_max, int x_min, int r_x, bool inf_or_nan, - int int_only, int& r_fw, int& i_fw) -{ - static float_format r_fmt; - static float_format i_fmt; - - int prec = Voutput_precision; - - int ld, rd; - - if (rat_format) - { - i_fw = 0; - r_fw = 0; - rd = 0; - } - else if (bank_format) - { - int digits = r_x; - i_fw = 0; - r_fw = digits <= 0 ? 4 : digits + 3; - if (inf_or_nan && r_fw < 4) - r_fw = 4; - rd = 2; - } - else if (hex_format) - { - r_fw = 2 * sizeof (double); - i_fw = 2 * sizeof (double); - rd = 0; - } - else if (bit_format) - { - r_fw = 8 * sizeof (double); - i_fw = 8 * sizeof (double); - rd = 0; - } - else if (inf_or_nan || int_only) - { - int digits = x_max > x_min ? x_max : x_min; - i_fw = digits <= 0 ? 1 : digits; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 3) - { - i_fw = 3; - r_fw = 4; - } - rd = r_fw; - } - else - { - int ld_max, rd_max; - if (x_max > 0) - { - ld_max = x_max; - rd_max = prec > x_max ? prec - x_max : prec; - x_max++; - } - else - { - ld_max = 1; - rd_max = prec > x_max ? prec - x_max : prec; - x_max = -x_max + 1; - } - - int ld_min, rd_min; - if (x_min > 0) - { - ld_min = x_min; - rd_min = prec > x_min ? prec - x_min : prec; - x_min++; - } - else - { - ld_min = 1; - rd_min = prec > x_min ? prec - x_min : prec; - x_min = -x_min + 1; - } - - ld = ld_max > ld_min ? ld_max : ld_min; - rd = rd_max > rd_min ? rd_max : rd_min; - - i_fw = ld + 1 + rd; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 3) - { - i_fw = 3; - r_fw = 4; - } - } - - if (! (rat_format || bank_format || hex_format || bit_format) - && (r_fw > Voutput_max_field_width || print_e || print_eng || print_g)) - { - if (print_g) - { - r_fmt = float_format (); - i_fmt = float_format (); - } - else - { - int ex = 4; - if (x_max > 100 || x_min > 100) - ex++; - - if (print_eng) - { - i_fw = 3 + prec + ex; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 5) - { - i_fw = 5; - r_fw = 6; - } - r_fmt = float_format (r_fw, ex, prec - 1, std::ios::fixed); - i_fmt = float_format (i_fw, ex, prec - 1, std::ios::fixed); - } - else - { - i_fw = 1 + prec + ex; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 3) - { - i_fw = 3; - r_fw = 4; - } - r_fmt = float_format (r_fw, prec - 1, std::ios::scientific); - i_fmt = float_format (i_fw, prec - 1, std::ios::scientific); - } - } - - if (print_big_e) - { - r_fmt.uppercase (); - i_fmt.uppercase (); - } - } - else if (! bank_format && (inf_or_nan || int_only)) - { - r_fmt = float_format (r_fw, rd); - i_fmt = float_format (i_fw, rd); - } - else - { - r_fmt = float_format (r_fw, rd, std::ios::fixed); - i_fmt = float_format (i_fw, rd, std::ios::fixed); - } - - curr_real_fmt = &r_fmt; - curr_imag_fmt = &i_fmt; -} - -static void -set_format (const Complex& c, int& r_fw, int& i_fw) -{ - curr_real_fmt = 0; - curr_imag_fmt = 0; - - if (free_format) - return; - - double rp = c.real (); - double ip = c.imag (); - - bool inf_or_nan = (xisinf (c) || xisnan (c)); - - bool int_only = (D_NINT (rp) == rp && D_NINT (ip) == ip); - - double r_abs = rp < 0.0 ? -rp : rp; - double i_abs = ip < 0.0 ? -ip : ip; - - int r_x = (xisinf (rp) || xisnan (rp) || r_abs == 0.0) - ? 0 : num_digits (r_abs); - - int i_x = (xisinf (ip) || xisnan (ip) || i_abs == 0.0) - ? 0 : num_digits (i_abs); - - int x_max, x_min; - - if (r_x > i_x) - { - x_max = r_x; - x_min = i_x; - } - else - { - x_max = i_x; - x_min = r_x; - } - - set_complex_format (x_max, x_min, r_x, inf_or_nan, int_only, r_fw, i_fw); -} - -static inline void -set_format (const Complex& c) -{ - int r_fw, i_fw; - set_format (c, r_fw, i_fw); -} - -static void -set_complex_matrix_format (int x_max, int x_min, int r_x_max, - int r_x_min, bool inf_or_nan, - int int_or_inf_or_nan, int& r_fw, int& i_fw) -{ - static float_format r_fmt; - static float_format i_fmt; - - int prec = Voutput_precision; - - int ld, rd; - - if (rat_format) - { - i_fw = 9; - r_fw = 9; - rd = 0; - } - else if (bank_format) - { - int digits = r_x_max > r_x_min ? r_x_max : r_x_min; - i_fw = 0; - r_fw = digits <= 0 ? 4 : digits + 3; - if (inf_or_nan && r_fw < 4) - r_fw = 4; - rd = 2; - } - else if (hex_format) - { - r_fw = 2 * sizeof (double); - i_fw = 2 * sizeof (double); - rd = 0; - } - else if (bit_format) - { - r_fw = 8 * sizeof (double); - i_fw = 8 * sizeof (double); - rd = 0; - } - else if (Vfixed_point_format && ! print_g) - { - rd = prec; - i_fw = rd + 1; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 3) - { - i_fw = 3; - r_fw = 4; - } - } - else if (int_or_inf_or_nan) - { - int digits = x_max > x_min ? x_max : x_min; - i_fw = digits <= 0 ? 1 : digits; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 3) - { - i_fw = 3; - r_fw = 4; - } - rd = r_fw; - } - else - { - int ld_max, rd_max; - if (x_max > 0) - { - ld_max = x_max; - rd_max = prec > x_max ? prec - x_max : prec; - x_max++; - } - else - { - ld_max = 1; - rd_max = prec > x_max ? prec - x_max : prec; - x_max = -x_max + 1; - } - - int ld_min, rd_min; - if (x_min > 0) - { - ld_min = x_min; - rd_min = prec > x_min ? prec - x_min : prec; - x_min++; - } - else - { - ld_min = 1; - rd_min = prec > x_min ? prec - x_min : prec; - x_min = -x_min + 1; - } - - ld = ld_max > ld_min ? ld_max : ld_min; - rd = rd_max > rd_min ? rd_max : rd_min; - - i_fw = ld + 1 + rd; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 3) - { - i_fw = 3; - r_fw = 4; - } - } - - if (! (rat_format || bank_format || hex_format || bit_format) - && (print_e - || print_eng || print_g - || (! Vfixed_point_format && r_fw > Voutput_max_field_width))) - { - if (print_g) - { - r_fmt = float_format (); - i_fmt = float_format (); - } - else - { - int ex = 4; - if (x_max > 100 || x_min > 100) - ex++; - - if (print_eng) - { - i_fw = 3 + prec + ex; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 5) - { - i_fw = 5; - r_fw = 6; - } - r_fmt = float_format (r_fw, ex, prec - 1, std::ios::fixed); - i_fmt = float_format (i_fw, ex, prec - 1, std::ios::fixed); - } - else - { - i_fw = 1 + prec + ex; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 3) - { - i_fw = 3; - r_fw = 4; - } - r_fmt = float_format (r_fw, prec - 1, std::ios::scientific); - i_fmt = float_format (i_fw, prec - 1, std::ios::scientific); - } - } - - if (print_big_e) - { - r_fmt.uppercase (); - i_fmt.uppercase (); - } - } - else if (! bank_format && int_or_inf_or_nan) - { - r_fmt = float_format (r_fw, rd); - i_fmt = float_format (i_fw, rd); - } - else - { - r_fmt = float_format (r_fw, rd, std::ios::fixed); - i_fmt = float_format (i_fw, rd, std::ios::fixed); - } - - curr_real_fmt = &r_fmt; - curr_imag_fmt = &i_fmt; -} - -static void -set_format (const ComplexMatrix& cm, int& r_fw, int& i_fw, double& scale) -{ - curr_real_fmt = 0; - curr_imag_fmt = 0; - - if (free_format) - return; - - Matrix rp = real (cm); - Matrix ip = imag (cm); - - bool inf_or_nan = cm.any_element_is_inf_or_nan (); - - bool int_or_inf_or_nan = (rp.all_elements_are_int_or_inf_or_nan () - && ip.all_elements_are_int_or_inf_or_nan ()); - - Matrix r_m_abs = rp.abs (); - double r_max_abs = pr_max_internal (r_m_abs); - double r_min_abs = pr_min_internal (r_m_abs); - - Matrix i_m_abs = ip.abs (); - double i_max_abs = pr_max_internal (i_m_abs); - double i_min_abs = pr_min_internal (i_m_abs); - - int r_x_max = r_max_abs == 0.0 ? 0 : num_digits (r_max_abs); - - int r_x_min = r_min_abs == 0.0 ? 0 : num_digits (r_min_abs); - - int i_x_max = i_max_abs == 0.0 ? 0 : num_digits (i_max_abs); - - int i_x_min = i_min_abs == 0.0 ? 0 : num_digits (i_min_abs); - - int x_max = r_x_max > i_x_max ? r_x_max : i_x_max; - int x_min = r_x_min > i_x_min ? r_x_min : i_x_min; - - scale = (x_max == 0 || int_or_inf_or_nan) ? 1.0 - : std::pow (10.0, calc_scale_exp (x_max - 1)); - - set_complex_matrix_format (x_max, x_min, r_x_max, r_x_min, inf_or_nan, - int_or_inf_or_nan, r_fw, i_fw); -} - -static inline void -set_format (const ComplexMatrix& cm) -{ - int r_fw, i_fw; - double scale; - set_format (cm, r_fw, i_fw, scale); -} - -static void -set_range_format (int x_max, int x_min, int all_ints, int& fw) -{ - static float_format fmt; - - int prec = Voutput_precision; - - int ld, rd; - - if (rat_format) - { - fw = 9; - rd = 0; - } - else if (bank_format) - { - int digits = x_max > x_min ? x_max : x_min; - fw = digits < 0 ? 5 : digits + 4; - rd = 2; - } - else if (hex_format) - { - fw = 2 * sizeof (double); - rd = 0; - } - else if (bit_format) - { - fw = 8 * sizeof (double); - rd = 0; - } - else if (all_ints) - { - int digits = x_max > x_min ? x_max : x_min; - fw = digits + 1; - rd = fw; - } - else if (Vfixed_point_format && ! print_g) - { - rd = prec; - fw = rd + 3; - } - else - { - int ld_max, rd_max; - if (x_max > 0) - { - ld_max = x_max; - rd_max = prec > x_max ? prec - x_max : prec; - x_max++; - } - else - { - ld_max = 1; - rd_max = prec > x_max ? prec - x_max : prec; - x_max = -x_max + 1; - } - - int ld_min, rd_min; - if (x_min > 0) - { - ld_min = x_min; - rd_min = prec > x_min ? prec - x_min : prec; - x_min++; - } - else - { - ld_min = 1; - rd_min = prec > x_min ? prec - x_min : prec; - x_min = -x_min + 1; - } - - ld = ld_max > ld_min ? ld_max : ld_min; - rd = rd_max > rd_min ? rd_max : rd_min; - - fw = ld + rd + 3; - } - - if (! (rat_format || bank_format || hex_format || bit_format) - && (print_e - || print_eng || print_g - || (! Vfixed_point_format && fw > Voutput_max_field_width))) - { - if (print_g) - fmt = float_format (); - else - { - int ex = 4; - if (x_max > 100 || x_min > 100) - ex++; - - if (print_eng) - { - fw = 5 + prec + ex; - fmt = float_format (fw, ex, prec - 1, std::ios::fixed); - } - else - { - fw = 3 + prec + ex; - fmt = float_format (fw, prec - 1, std::ios::scientific); - } - } - - if (print_big_e) - fmt.uppercase (); - } - else if (! bank_format && all_ints) - fmt = float_format (fw, rd); - else - fmt = float_format (fw, rd, std::ios::fixed); - - curr_real_fmt = &fmt; -} - -static void -set_format (const Range& r, int& fw, double& scale) -{ - curr_real_fmt = 0; - curr_imag_fmt = 0; - - if (free_format) - return; - - double r_min = r.base (); - double r_max = r.limit (); - - if (r_max < r_min) - { - double tmp = r_max; - r_max = r_min; - r_min = tmp; - } - - bool all_ints = r.all_elements_are_ints (); - - double max_abs = r_max < 0.0 ? -r_max : r_max; - double min_abs = r_min < 0.0 ? -r_min : r_min; - - int x_max = max_abs == 0.0 ? 0 : num_digits (max_abs); - - int x_min = min_abs == 0.0 ? 0 : num_digits (min_abs); - - scale = (x_max == 0 || all_ints) ? 1.0 - : std::pow (10.0, calc_scale_exp (x_max - 1)); - - set_range_format (x_max, x_min, all_ints, fw); -} - -static inline void -set_format (const Range& r) -{ - int fw; - double scale; - set_format (r, fw, scale); -} - -union equiv -{ - double d; - unsigned char i[sizeof (double)]; -}; - -#define PRINT_CHAR_BITS(os, c) \ - do \ - { \ - unsigned char ctmp = c; \ - char stmp[9]; \ - stmp[0] = (ctmp & 0x80) ? '1' : '0'; \ - stmp[1] = (ctmp & 0x40) ? '1' : '0'; \ - stmp[2] = (ctmp & 0x20) ? '1' : '0'; \ - stmp[3] = (ctmp & 0x10) ? '1' : '0'; \ - stmp[4] = (ctmp & 0x08) ? '1' : '0'; \ - stmp[5] = (ctmp & 0x04) ? '1' : '0'; \ - stmp[6] = (ctmp & 0x02) ? '1' : '0'; \ - stmp[7] = (ctmp & 0x01) ? '1' : '0'; \ - stmp[8] = '\0'; \ - os << stmp; \ - } \ - while (0) - -#define PRINT_CHAR_BITS_SWAPPED(os, c) \ - do \ - { \ - unsigned char ctmp = c; \ - char stmp[9]; \ - stmp[0] = (ctmp & 0x01) ? '1' : '0'; \ - stmp[1] = (ctmp & 0x02) ? '1' : '0'; \ - stmp[2] = (ctmp & 0x04) ? '1' : '0'; \ - stmp[3] = (ctmp & 0x08) ? '1' : '0'; \ - stmp[4] = (ctmp & 0x10) ? '1' : '0'; \ - stmp[5] = (ctmp & 0x20) ? '1' : '0'; \ - stmp[6] = (ctmp & 0x40) ? '1' : '0'; \ - stmp[7] = (ctmp & 0x80) ? '1' : '0'; \ - stmp[8] = '\0'; \ - os << stmp; \ - } \ - while (0) - -static void -pr_any_float (const float_format *fmt, std::ostream& os, double d, int fw = 0) -{ - if (fmt) - { - // Unless explicitly asked for, always print in big-endian - // format for hex and bit formats. - // - // {bit,hex}_format == 1: print big-endian - // {bit,hex}_format == 2: print native - - if (hex_format) - { - equiv tmp; - tmp.d = d; - - // Unless explicitly asked for, always print in big-endian - // format. - - // FIXME -- is it correct to swap bytes for VAX - // formats and not for Cray? - - // FIXME -- will bad things happen if we are - // interrupted before resetting the format flags and fill - // character? - - oct_mach_info::float_format flt_fmt = - oct_mach_info::native_float_format (); - - char ofill = os.fill ('0'); - - std::ios::fmtflags oflags - = os.flags (std::ios::right | std::ios::hex); - - if (hex_format > 1 - || flt_fmt == oct_mach_info::flt_fmt_ieee_big_endian - || flt_fmt == oct_mach_info::flt_fmt_cray - || flt_fmt == oct_mach_info::flt_fmt_unknown) - { - for (size_t i = 0; i < sizeof (double); i++) - os << std::setw (2) << static_cast (tmp.i[i]); - } - else - { - for (int i = sizeof (double) - 1; i >= 0; i--) - os << std::setw (2) << static_cast (tmp.i[i]); - } - - os.fill (ofill); - os.setf (oflags); - } - else if (bit_format) - { - equiv tmp; - tmp.d = d; - - // FIXME -- is it correct to swap bytes for VAX - // formats and not for Cray? - - oct_mach_info::float_format flt_fmt = - oct_mach_info::native_float_format (); - - if (flt_fmt == oct_mach_info::flt_fmt_ieee_big_endian - || flt_fmt == oct_mach_info::flt_fmt_cray - || flt_fmt == oct_mach_info::flt_fmt_unknown) - { - for (size_t i = 0; i < sizeof (double); i++) - PRINT_CHAR_BITS (os, tmp.i[i]); - } - else - { - if (bit_format > 1) - { - for (size_t i = 0; i < sizeof (double); i++) - PRINT_CHAR_BITS_SWAPPED (os, tmp.i[i]); - } - else - { - for (int i = sizeof (double) - 1; i >= 0; i--) - PRINT_CHAR_BITS (os, tmp.i[i]); - } - } - } - else if (octave_is_NA (d)) - { - if (fw > 0) - os << std::setw (fw) << "NA"; - else - os << "NA"; - } - else if (rat_format) - os << pr_rational_float (*fmt, d); - else if (xisinf (d)) - { - const char *s; - if (d < 0.0) - s = "-Inf"; - else - s = "Inf"; - - if (fw > 0) - os << std::setw (fw) << s; - else - os << s; - } - else if (xisnan (d)) - { - if (fw > 0) - os << std::setw (fw) << "NaN"; - else - os << "NaN"; - } - else if (print_eng) - os << pr_engineering_float (*fmt, d); - else - os << pr_formatted_float (*fmt, d); - } - else - os << d; -} - -static inline void -pr_float (std::ostream& os, double d, int fw = 0, double scale = 1.0) -{ - if (Vfixed_point_format && ! print_g && scale != 1.0) - d /= scale; - - pr_any_float (curr_real_fmt, os, d, fw); -} - -static inline void -pr_imag_float (std::ostream& os, double d, int fw = 0) -{ - pr_any_float (curr_imag_fmt, os, d, fw); -} - -static void -pr_complex (std::ostream& os, const Complex& c, int r_fw = 0, - int i_fw = 0, double scale = 1.0) -{ - Complex tmp - = (Vfixed_point_format && ! print_g && scale != 1.0) ? c / scale : c; - - double r = tmp.real (); - - pr_float (os, r, r_fw); - - if (! bank_format) - { - double i = tmp.imag (); - if (! (hex_format || bit_format) && lo_ieee_signbit (i)) - { - os << " - "; - i = -i; - pr_imag_float (os, i, i_fw); - } - else - { - if (hex_format || bit_format) - os << " "; - else - os << " + "; - - pr_imag_float (os, i, i_fw); - } - os << "i"; - } -} - -static void -print_empty_matrix (std::ostream& os, octave_idx_type nr, octave_idx_type nc, bool pr_as_read_syntax) -{ - assert (nr == 0 || nc == 0); - - if (pr_as_read_syntax) - { - if (nr == 0 && nc == 0) - os << "[]"; - else - os << "zeros (" << nr << ", " << nc << ")"; - } - else - { - os << "[]"; - - if (Vprint_empty_dimensions) - os << "(" << nr << "x" << nc << ")"; - } -} - -static void -print_empty_nd_array (std::ostream& os, const dim_vector& dims, - bool pr_as_read_syntax) -{ - assert (dims.any_zero ()); - - if (pr_as_read_syntax) - os << "zeros (" << dims.str (',') << ")"; - else - { - os << "[]"; - - if (Vprint_empty_dimensions) - os << "(" << dims.str () << ")"; - } -} - -static void -pr_scale_header (std::ostream& os, double scale) -{ - if (Vfixed_point_format && ! print_g && scale != 1.0) - { - os << " " - << std::setw (8) << std::setprecision (1) - << std::setiosflags (std::ios::scientific|std::ios::left) - << scale - << std::resetiosflags (std::ios::scientific|std::ios::left) - << " *\n"; - - if (! Vcompact_format) - os << "\n"; - } -} - -static void -pr_col_num_header (std::ostream& os, octave_idx_type total_width, int max_width, - octave_idx_type lim, octave_idx_type col, int extra_indent) -{ - if (total_width > max_width && Vsplit_long_rows) - { - if (col != 0) - { - if (Vcompact_format) - os << "\n"; - else - os << "\n\n"; - } - - octave_idx_type num_cols = lim - col; - - os << std::setw (extra_indent) << ""; - - if (num_cols == 1) - os << " Column " << col + 1 << ":\n"; - else if (num_cols == 2) - os << " Columns " << col + 1 << " and " << lim << ":\n"; - else - os << " Columns " << col + 1 << " through " << lim << ":\n"; - - if (! Vcompact_format) - os << "\n"; - } -} - -template -/* static */ inline void -pr_plus_format (std::ostream& os, const T& val) -{ - if (val > T (0)) - os << plus_format_chars[0]; - else if (val < T (0)) - os << plus_format_chars[1]; - else - os << plus_format_chars[2]; -} - -void -octave_print_internal (std::ostream& os, double d, - bool /* pr_as_read_syntax */) -{ - if (plus_format) - { - pr_plus_format (os, d); - } - else - { - set_format (d); - if (free_format) - os << d; - else - pr_float (os, d); - } -} - -void -octave_print_internal (std::ostream& os, const Matrix& m, - bool pr_as_read_syntax, int extra_indent) -{ - octave_idx_type nr = m.rows (); - octave_idx_type nc = m.columns (); - - if (nr == 0 || nc == 0) - print_empty_matrix (os, nr, nc, pr_as_read_syntax); - else if (plus_format && ! pr_as_read_syntax) - { - for (octave_idx_type i = 0; i < nr; i++) - { - for (octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - - pr_plus_format (os, m(i,j)); - } - - if (i < nr - 1) - os << "\n"; - } - } - else - { - int fw; - double scale = 1.0; - set_format (m, fw, scale); - int column_width = fw + 2; - octave_idx_type total_width = nc * column_width; - octave_idx_type max_width = command_editor::terminal_cols (); - - if (pr_as_read_syntax) - max_width -= 4; - else - max_width -= extra_indent; - - if (max_width < 0) - max_width = 0; - - if (free_format) - { - if (pr_as_read_syntax) - os << "[\n"; - - os << m; - - if (pr_as_read_syntax) - os << "]"; - - return; - } - - octave_idx_type inc = nc; - if (total_width > max_width && Vsplit_long_rows) - { - inc = max_width / column_width; - if (inc == 0) - inc++; - } - - if (pr_as_read_syntax) - { - for (octave_idx_type i = 0; i < nr; i++) - { - octave_idx_type col = 0; - while (col < nc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - if (i == 0 && j == 0) - os << "[ "; - else - { - if (j > col && j < lim) - os << ", "; - else - os << " "; - } - - pr_float (os, m(i,j)); - } - - col += inc; - - if (col >= nc) - { - if (i == nr - 1) - os << " ]"; - else - os << ";\n"; - } - else - os << " ...\n"; - } - } - } - else - { - pr_scale_header (os, scale); - - for (octave_idx_type col = 0; col < nc; col += inc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - pr_col_num_header (os, total_width, max_width, lim, col, - extra_indent); - - for (octave_idx_type i = 0; i < nr; i++) - { - os << std::setw (extra_indent) << ""; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - os << " "; - - pr_float (os, m(i,j), fw, scale); - } - - if (i < nr - 1) - os << "\n"; - } - } - } - } -} - -void -octave_print_internal (std::ostream& os, const DiagMatrix& m, - bool pr_as_read_syntax, int extra_indent) -{ - octave_idx_type nr = m.rows (); - octave_idx_type nc = m.columns (); - - if (nr == 0 || nc == 0) - print_empty_matrix (os, nr, nc, pr_as_read_syntax); - else if (plus_format && ! pr_as_read_syntax) - { - for (octave_idx_type i = 0; i < nr; i++) - { - for (octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - - pr_plus_format (os, m(i,j)); - } - - if (i < nr - 1) - os << "\n"; - } - } - else - { - int fw; - double scale = 1.0; - set_format (Matrix (m.diag ()), fw, scale); - int column_width = fw + 2; - octave_idx_type total_width = nc * column_width; - octave_idx_type max_width = command_editor::terminal_cols (); - - if (pr_as_read_syntax) - max_width -= 4; - else - max_width -= extra_indent; - - if (max_width < 0) - max_width = 0; - - if (free_format) - { - if (pr_as_read_syntax) - os << "[\n"; - - os << Matrix (m); - - if (pr_as_read_syntax) - os << "]"; - - return; - } - - octave_idx_type inc = nc; - if (total_width > max_width && Vsplit_long_rows) - { - inc = max_width / column_width; - if (inc == 0) - inc++; - } - - if (pr_as_read_syntax) - { - os << "diag ("; - - octave_idx_type col = 0; - while (col < nc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - if (j == 0) - os << "[ "; - else - { - if (j > col && j < lim) - os << ", "; - else - os << " "; - } - - pr_float (os, m(j,j)); - } - - col += inc; - - if (col >= nc) - os << " ]"; - else - os << " ...\n"; - } - os << ")"; - } - else - { - os << "Diagonal Matrix\n"; - if (! Vcompact_format) - os << "\n"; - - pr_scale_header (os, scale); - - // kluge. Get the true width of a number. - int zero_fw; - - { - std::ostringstream tmp_oss; - pr_float (tmp_oss, 0.0, fw, scale); - zero_fw = tmp_oss.str ().length (); - } - - for (octave_idx_type col = 0; col < nc; col += inc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - pr_col_num_header (os, total_width, max_width, lim, col, - extra_indent); - - for (octave_idx_type i = 0; i < nr; i++) - { - os << std::setw (extra_indent) << ""; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - os << " "; - - if (i == j) - pr_float (os, m(i,j), fw, scale); - else - os << std::setw (zero_fw) << '0'; - - } - - if (i < nr - 1) - os << "\n"; - } - } - } - } -} - -template -void print_nd_array (std::ostream& os, const NDA_T& nda, - bool pr_as_read_syntax) -{ - - if (nda.is_empty ()) - print_empty_nd_array (os, nda.dims (), pr_as_read_syntax); - else - { - - int ndims = nda.ndims (); - - dim_vector dims = nda.dims (); - - Array ra_idx (dim_vector (ndims, 1), 0); - - octave_idx_type m = 1; - - for (int i = 2; i < ndims; i++) - m *= dims(i); - - octave_idx_type nr = dims(0); - octave_idx_type nc = dims(1); - - for (octave_idx_type i = 0; i < m; i++) - { - octave_quit (); - - std::string nm = "ans"; - - if (m > 1) - { - nm += "(:,:,"; - - std::ostringstream buf; - - for (int k = 2; k < ndims; k++) - { - buf << ra_idx(k) + 1; - - if (k < ndims - 1) - buf << ","; - else - buf << ")"; - } - - nm += buf.str (); - } - - Array idx (dim_vector (ndims, 1)); - - idx(0) = idx_vector (':'); - idx(1) = idx_vector (':'); - - for (int k = 2; k < ndims; k++) - idx(k) = idx_vector (ra_idx(k)); - - octave_value page - = MAT_T (Array (nda.index (idx), dim_vector (nr, nc))); - - if (i != m - 1) - { - page.print_with_name (os, nm); - } - else - { - page.print_name_tag (os, nm); - page.print_raw (os); - } - - if (i < m) - NDA_T::increment_index (ra_idx, dims, 2); - } - } -} - -void -octave_print_internal (std::ostream& os, const NDArray& nda, - bool pr_as_read_syntax, int extra_indent) -{ - switch (nda.ndims ()) - { - case 1: - case 2: - octave_print_internal (os, nda.matrix_value (), - pr_as_read_syntax, extra_indent); - break; - - default: - print_nd_array (os, nda, pr_as_read_syntax); - break; - } -} - -template <> -/* static */ inline void -pr_plus_format<> (std::ostream& os, const Complex& c) -{ - double rp = c.real (); - double ip = c.imag (); - - if (rp == 0.0) - { - if (ip == 0.0) - os << " "; - else - os << "i"; - } - else if (ip == 0.0) - pr_plus_format (os, rp); - else - os << "c"; -} - -void -octave_print_internal (std::ostream& os, const Complex& c, - bool /* pr_as_read_syntax */) -{ - if (plus_format) - { - pr_plus_format (os, c); - } - else - { - set_format (c); - if (free_format) - os << c; - else - pr_complex (os, c); - } -} - -void -octave_print_internal (std::ostream& os, const ComplexMatrix& cm, - bool pr_as_read_syntax, int extra_indent) -{ - octave_idx_type nr = cm.rows (); - octave_idx_type nc = cm.columns (); - - if (nr == 0 || nc == 0) - print_empty_matrix (os, nr, nc, pr_as_read_syntax); - else if (plus_format && ! pr_as_read_syntax) - { - for (octave_idx_type i = 0; i < nr; i++) - { - for (octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - - pr_plus_format (os, cm(i,j)); - } - - if (i < nr - 1) - os << "\n"; - } - } - else - { - int r_fw, i_fw; - double scale = 1.0; - set_format (cm, r_fw, i_fw, scale); - int column_width = i_fw + r_fw; - column_width += (rat_format || bank_format || hex_format - || bit_format) ? 2 : 7; - octave_idx_type total_width = nc * column_width; - octave_idx_type max_width = command_editor::terminal_cols (); - - if (pr_as_read_syntax) - max_width -= 4; - else - max_width -= extra_indent; - - if (max_width < 0) - max_width = 0; - - if (free_format) - { - if (pr_as_read_syntax) - os << "[\n"; - - os << cm; - - if (pr_as_read_syntax) - os << "]"; - - return; - } - - octave_idx_type inc = nc; - if (total_width > max_width && Vsplit_long_rows) - { - inc = max_width / column_width; - if (inc == 0) - inc++; - } - - if (pr_as_read_syntax) - { - for (octave_idx_type i = 0; i < nr; i++) - { - octave_idx_type col = 0; - while (col < nc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - if (i == 0 && j == 0) - os << "[ "; - else - { - if (j > col && j < lim) - os << ", "; - else - os << " "; - } - - pr_complex (os, cm(i,j)); - } - - col += inc; - - if (col >= nc) - { - if (i == nr - 1) - os << " ]"; - else - os << ";\n"; - } - else - os << " ...\n"; - } - } - } - else - { - pr_scale_header (os, scale); - - for (octave_idx_type col = 0; col < nc; col += inc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - pr_col_num_header (os, total_width, max_width, lim, col, - extra_indent); - - for (octave_idx_type i = 0; i < nr; i++) - { - os << std::setw (extra_indent) << ""; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - os << " "; - - pr_complex (os, cm(i,j), r_fw, i_fw, scale); - } - - if (i < nr - 1) - os << "\n"; - } - } - } - } -} - -void -octave_print_internal (std::ostream& os, const ComplexDiagMatrix& cm, - bool pr_as_read_syntax, int extra_indent) -{ - octave_idx_type nr = cm.rows (); - octave_idx_type nc = cm.columns (); - - if (nr == 0 || nc == 0) - print_empty_matrix (os, nr, nc, pr_as_read_syntax); - else if (plus_format && ! pr_as_read_syntax) - { - for (octave_idx_type i = 0; i < nr; i++) - { - for (octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - - pr_plus_format (os, cm(i,j)); - } - - if (i < nr - 1) - os << "\n"; - } - } - else - { - int r_fw, i_fw; - double scale = 1.0; - set_format (ComplexMatrix (cm.diag ()), r_fw, i_fw, scale); - int column_width = i_fw + r_fw; - column_width += (rat_format || bank_format || hex_format - || bit_format) ? 2 : 7; - octave_idx_type total_width = nc * column_width; - octave_idx_type max_width = command_editor::terminal_cols (); - - if (pr_as_read_syntax) - max_width -= 4; - else - max_width -= extra_indent; - - if (max_width < 0) - max_width = 0; - - if (free_format) - { - if (pr_as_read_syntax) - os << "[\n"; - - os << ComplexMatrix (cm); - - if (pr_as_read_syntax) - os << "]"; - - return; - } - - octave_idx_type inc = nc; - if (total_width > max_width && Vsplit_long_rows) - { - inc = max_width / column_width; - if (inc == 0) - inc++; - } - - if (pr_as_read_syntax) - { - os << "diag ("; - - octave_idx_type col = 0; - while (col < nc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - if (j == 0) - os << "[ "; - else - { - if (j > col && j < lim) - os << ", "; - else - os << " "; - } - - pr_complex (os, cm(j,j)); - } - - col += inc; - - if (col >= nc) - os << " ]"; - else - os << " ...\n"; - } - os << ")"; - } - else - { - os << "Diagonal Matrix\n"; - if (! Vcompact_format) - os << "\n"; - - pr_scale_header (os, scale); - - // kluge. Get the true width of a number. - int zero_fw; - - { - std::ostringstream tmp_oss; - pr_complex (tmp_oss, Complex (0.0), r_fw, i_fw, scale); - zero_fw = tmp_oss.str ().length (); - } - - for (octave_idx_type col = 0; col < nc; col += inc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - pr_col_num_header (os, total_width, max_width, lim, col, - extra_indent); - - for (octave_idx_type i = 0; i < nr; i++) - { - os << std::setw (extra_indent) << ""; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - os << " "; - - if (i == j) - pr_complex (os, cm(i,j), r_fw, i_fw, scale); - else - os << std::setw (zero_fw) << '0'; - } - - if (i < nr - 1) - os << "\n"; - } - } - } - } -} - -void -octave_print_internal (std::ostream& os, const PermMatrix& m, - bool pr_as_read_syntax, int extra_indent) -{ - octave_idx_type nr = m.rows (); - octave_idx_type nc = m.columns (); - - if (nr == 0 || nc == 0) - print_empty_matrix (os, nr, nc, pr_as_read_syntax); - else if (plus_format && ! pr_as_read_syntax) - { - for (octave_idx_type i = 0; i < nr; i++) - { - for (octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - - pr_plus_format (os, m(i,j)); - } - - if (i < nr - 1) - os << "\n"; - } - } - else - { - int fw = 2; - int column_width = fw + 2; - octave_idx_type total_width = nc * column_width; - octave_idx_type max_width = command_editor::terminal_cols (); - - if (pr_as_read_syntax) - max_width -= 4; - else - max_width -= extra_indent; - - if (max_width < 0) - max_width = 0; - - if (free_format) - { - if (pr_as_read_syntax) - os << "[\n"; - - os << Matrix (m); - - if (pr_as_read_syntax) - os << "]"; - - return; - } - - octave_idx_type inc = nc; - if (total_width > max_width && Vsplit_long_rows) - { - inc = max_width / column_width; - if (inc == 0) - inc++; - } - - if (pr_as_read_syntax) - { - Array pvec = m.pvec (); - bool colp = m.is_col_perm (); - - os << "eye ("; - if (colp) os << ":, "; - - octave_idx_type col = 0; - while (col < nc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - if (j == 0) - os << "[ "; - else - { - if (j > col && j < lim) - os << ", "; - else - os << " "; - } - - os << pvec (j); - } - - col += inc; - - if (col >= nc) - os << " ]"; - else - os << " ...\n"; - } - if (! colp) os << ", :"; - os << ")"; - } - else - { - os << "Permutation Matrix\n"; - if (! Vcompact_format) - os << "\n"; - - for (octave_idx_type col = 0; col < nc; col += inc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - pr_col_num_header (os, total_width, max_width, lim, col, - extra_indent); - - for (octave_idx_type i = 0; i < nr; i++) - { - os << std::setw (extra_indent) << ""; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - os << " "; - - os << std::setw (fw) << m(i,j); - } - - if (i < nr - 1) - os << "\n"; - } - } - } - } -} - -void -octave_print_internal (std::ostream& os, const ComplexNDArray& nda, - bool pr_as_read_syntax, int extra_indent) -{ - switch (nda.ndims ()) - { - case 1: - case 2: - octave_print_internal (os, nda.matrix_value (), - pr_as_read_syntax, extra_indent); - break; - - default: - print_nd_array (os, nda, pr_as_read_syntax); - break; - } -} - -void -octave_print_internal (std::ostream& os, bool d, bool pr_as_read_syntax) -{ - octave_print_internal (os, double (d), pr_as_read_syntax); -} - -// FIXME -- write single precision versions of the printing functions. - -void -octave_print_internal (std::ostream& os, float d, bool pr_as_read_syntax) -{ - octave_print_internal (os, double (d), pr_as_read_syntax); -} - -void -octave_print_internal (std::ostream& os, const FloatMatrix& m, - bool pr_as_read_syntax, int extra_indent) -{ - octave_print_internal (os, Matrix (m), pr_as_read_syntax, extra_indent); -} - -void -octave_print_internal (std::ostream& os, const FloatDiagMatrix& m, - bool pr_as_read_syntax, int extra_indent) -{ - octave_print_internal (os, DiagMatrix (m), pr_as_read_syntax, extra_indent); -} - -void -octave_print_internal (std::ostream& os, const FloatNDArray& nda, - bool pr_as_read_syntax, int extra_indent) -{ - octave_print_internal (os, NDArray (nda), pr_as_read_syntax, extra_indent); -} - -void -octave_print_internal (std::ostream& os, const FloatComplex& c, - bool pr_as_read_syntax) -{ - octave_print_internal (os, Complex (c), pr_as_read_syntax); -} - -void -octave_print_internal (std::ostream& os, const FloatComplexMatrix& cm, - bool pr_as_read_syntax, int extra_indent) -{ - octave_print_internal (os, ComplexMatrix (cm), pr_as_read_syntax, extra_indent); -} - -void -octave_print_internal (std::ostream& os, const FloatComplexDiagMatrix& cm, - bool pr_as_read_syntax, int extra_indent) -{ - octave_print_internal (os, ComplexDiagMatrix (cm), pr_as_read_syntax, extra_indent); -} - -void -octave_print_internal (std::ostream& os, const FloatComplexNDArray& nda, - bool pr_as_read_syntax, int extra_indent) -{ - octave_print_internal (os, ComplexNDArray (nda), pr_as_read_syntax, extra_indent); -} - -void -octave_print_internal (std::ostream& os, const Range& r, - bool pr_as_read_syntax, int extra_indent) -{ - double base = r.base (); - double increment = r.inc (); - double limit = r.limit (); - octave_idx_type num_elem = r.nelem (); - - if (plus_format && ! pr_as_read_syntax) - { - for (octave_idx_type i = 0; i < num_elem; i++) - { - octave_quit (); - - double val = base + i * increment; - - pr_plus_format (os, val); - } - } - else - { - int fw = 0; - double scale = 1.0; - set_format (r, fw, scale); - - if (pr_as_read_syntax) - { - if (free_format) - { - os << base << " : "; - if (increment != 1.0) - os << increment << " : "; - os << limit; - } - else - { - pr_float (os, base, fw); - os << " : "; - if (increment != 1.0) - { - pr_float (os, increment, fw); - os << " : "; - } - pr_float (os, limit, fw); - } - } - else - { - int column_width = fw + 2; - octave_idx_type total_width = num_elem * column_width; - octave_idx_type max_width = command_editor::terminal_cols (); - - if (free_format) - { - os << r; - return; - } - - octave_idx_type inc = num_elem; - if (total_width > max_width && Vsplit_long_rows) - { - inc = max_width / column_width; - if (inc == 0) - inc++; - } - - max_width -= extra_indent; - - if (max_width < 0) - max_width = 0; - - pr_scale_header (os, scale); - - octave_idx_type col = 0; - while (col < num_elem) - { - octave_idx_type lim = col + inc < num_elem ? col + inc : num_elem; - - pr_col_num_header (os, total_width, max_width, lim, col, - extra_indent); - - os << std::setw (extra_indent) << ""; - - for (octave_idx_type i = col; i < lim; i++) - { - octave_quit (); - - double val; - if (i == 0) - val = base; - else - val = base + i * increment; - - if (i == num_elem - 1) - { - // See the comments in Range::matrix_value. - if ((increment > 0 && val >= limit) - || (increment < 0 && val <= limit)) - val = limit; - } - - os << " "; - - pr_float (os, val, fw, scale); - } - - col += inc; - } - } - } -} - -void -octave_print_internal (std::ostream& os, const boolMatrix& bm, - bool pr_as_read_syntax, - int extra_indent) -{ - Matrix tmp (bm); - octave_print_internal (os, tmp, pr_as_read_syntax, extra_indent); -} - -void -octave_print_internal (std::ostream& os, const boolNDArray& nda, - bool pr_as_read_syntax, - int extra_indent) -{ - switch (nda.ndims ()) - { - case 1: - case 2: - octave_print_internal (os, nda.matrix_value (), - pr_as_read_syntax, extra_indent); - break; - - default: - print_nd_array (os, nda, pr_as_read_syntax); - break; - } -} - -void -octave_print_internal (std::ostream& os, const charMatrix& chm, - bool pr_as_read_syntax, - int /* extra_indent FIXME */, - bool pr_as_string) -{ - if (pr_as_string) - { - octave_idx_type nstr = chm.rows (); - - if (pr_as_read_syntax && nstr > 1) - os << "[ "; - - if (nstr != 0) - { - for (octave_idx_type i = 0; i < nstr; i++) - { - octave_quit (); - - std::string row = chm.row_as_string (i); - - if (pr_as_read_syntax) - { - os << "\"" << undo_string_escapes (row) << "\""; - - if (i < nstr - 1) - os << "; "; - } - else - { - os << row; - - if (i < nstr - 1) - os << "\n"; - } - } - } - - if (pr_as_read_syntax && nstr > 1) - os << " ]"; - } - else - { - os << "sorry, printing char matrices not implemented yet\n"; - } -} - -void -octave_print_internal (std::ostream& os, const charNDArray& nda, - bool pr_as_read_syntax, int extra_indent, - bool pr_as_string) -{ - switch (nda.ndims ()) - { - case 1: - case 2: - octave_print_internal (os, nda.matrix_value (), - pr_as_read_syntax, extra_indent, pr_as_string); - break; - - default: - print_nd_array (os, nda, pr_as_read_syntax); - break; - } -} - -void -octave_print_internal (std::ostream& os, const std::string& s, - bool pr_as_read_syntax, int extra_indent) -{ - Array nda (dim_vector (1, 1), s); - - octave_print_internal (os, nda, pr_as_read_syntax, extra_indent); -} - -void -octave_print_internal (std::ostream& os, const Array& nda, - bool pr_as_read_syntax, int /* extra_indent */) -{ - // FIXME -- this mostly duplicates the code in the print_nd_array<> - // function. Can fix this with std::is_same from C++11. - - if (nda.is_empty ()) - print_empty_nd_array (os, nda.dims (), pr_as_read_syntax); - else if (nda.length () == 1) - { - os << nda(0); - } - else - { - int ndims = nda.ndims (); - - dim_vector dims = nda.dims (); - - Array ra_idx (dim_vector (ndims, 1), 0); - - octave_idx_type m = 1; - - for (int i = 2; i < ndims; i++) - m *= dims(i); - - octave_idx_type nr = dims(0); - octave_idx_type nc = dims(1); - - for (octave_idx_type i = 0; i < m; i++) - { - std::string nm = "ans"; - - if (m > 1) - { - nm += "(:,:,"; - - std::ostringstream buf; - - for (int k = 2; k < ndims; k++) - { - buf << ra_idx(k) + 1; - - if (k < ndims - 1) - buf << ","; - else - buf << ")"; - } - - nm += buf.str (); - } - - Array idx (dim_vector (ndims, 1)); - - idx(0) = idx_vector (':'); - idx(1) = idx_vector (':'); - - for (int k = 2; k < ndims; k++) - idx(k) = idx_vector (ra_idx(k)); - - Array page (nda.index (idx), dim_vector (nr, nc)); - - // FIXME -- need to do some more work to put these - // in neatly aligned columns... - - octave_idx_type n_rows = page.rows (); - octave_idx_type n_cols = page.cols (); - - os << nm << " =\n"; - if (! Vcompact_format) - os << "\n"; - - for (octave_idx_type ii = 0; ii < n_rows; ii++) - { - for (octave_idx_type jj = 0; jj < n_cols; jj++) - os << " " << page(ii,jj); - - os << "\n"; - } - - if (i < m - 1) - os << "\n"; - - if (i < m) - increment_index (ra_idx, dims, 2); - } - } -} - -template -class -octave_print_conv -{ -public: - typedef T print_conv_type; -}; - -#define PRINT_CONV(T1, T2) \ - template <> \ - class \ - octave_print_conv \ - { \ - public: \ - typedef T2 print_conv_type; \ - } - -PRINT_CONV (octave_int8, octave_int16); -PRINT_CONV (octave_uint8, octave_uint16); - -#undef PRINT_CONV - -template -/* static */ inline void -pr_int (std::ostream& os, const T& d, int fw = 0) -{ - size_t sz = d.byte_size (); - const unsigned char * tmpi = d.iptr (); - - // Unless explicitly asked for, always print in big-endian - // format for hex and bit formats. - // - // {bit,hex}_format == 1: print big-endian - // {bit,hex}_format == 2: print native - - if (hex_format) - { - char ofill = os.fill ('0'); - - std::ios::fmtflags oflags - = os.flags (std::ios::right | std::ios::hex); - - if (hex_format > 1 || oct_mach_info::words_big_endian ()) - { - for (size_t i = 0; i < sz; i++) - os << std::setw (2) << static_cast (tmpi[i]); - } - else - { - for (int i = sz - 1; i >= 0; i--) - os << std::setw (2) << static_cast (tmpi[i]); - } - - os.fill (ofill); - os.setf (oflags); - } - else if (bit_format) - { - if (oct_mach_info::words_big_endian ()) - { - for (size_t i = 0; i < sz; i++) - PRINT_CHAR_BITS (os, tmpi[i]); - } - else - { - if (bit_format > 1) - { - for (size_t i = 0; i < sz; i++) - PRINT_CHAR_BITS_SWAPPED (os, tmpi[i]); - } - else - { - for (int i = sz - 1; i >= 0; i--) - PRINT_CHAR_BITS (os, tmpi[i]); - } - } - } - else - { - os << std::setw (fw) - << typename octave_print_conv::print_conv_type (d); - - if (bank_format) - os << ".00"; - } -} - -// FIXME -- all this mess with abs is an attempt to avoid seeing -// -// warning: comparison of unsigned expression < 0 is always false -// -// from GCC. Isn't there a better way - -template -/* static */ inline T -abs (T x) -{ - return x < 0 ? -x : x; -} - -#define INSTANTIATE_ABS(T) \ - template /* static */ T abs (T) - -INSTANTIATE_ABS(signed char); -INSTANTIATE_ABS(short); -INSTANTIATE_ABS(int); -INSTANTIATE_ABS(long); -INSTANTIATE_ABS(long long); - -#define SPECIALIZE_UABS(T) \ - template <> \ - /* static */ inline unsigned T \ - abs (unsigned T x) \ - { \ - return x; \ - } - -SPECIALIZE_UABS(char) -SPECIALIZE_UABS(short) -SPECIALIZE_UABS(int) -SPECIALIZE_UABS(long) -SPECIALIZE_UABS(long long) - -template void -pr_int (std::ostream&, const octave_int8&, int); - -template void -pr_int (std::ostream&, const octave_int16&, int); - -template void -pr_int (std::ostream&, const octave_int32&, int); - -template void -pr_int (std::ostream&, const octave_int64&, int); - -template void -pr_int (std::ostream&, const octave_uint8&, int); - -template void -pr_int (std::ostream&, const octave_uint16&, int); - -template void -pr_int (std::ostream&, const octave_uint32&, int); - -template void -pr_int (std::ostream&, const octave_uint64&, int); - -template -void -octave_print_internal_template (std::ostream& os, const octave_int& val, - bool) -{ - if (plus_format) - { - pr_plus_format (os, val); - } - else - { - if (free_format) - os << typename octave_print_conv >::print_conv_type (val); - else - pr_int (os, val); - } -} - -#define PRINT_INT_SCALAR_INTERNAL(TYPE) \ - OCTINTERP_API void \ - octave_print_internal (std::ostream& os, const octave_int& val, bool dummy) \ - { \ - octave_print_internal_template (os, val, dummy); \ - } - -PRINT_INT_SCALAR_INTERNAL (int8_t) -PRINT_INT_SCALAR_INTERNAL (uint8_t) -PRINT_INT_SCALAR_INTERNAL (int16_t) -PRINT_INT_SCALAR_INTERNAL (uint16_t) -PRINT_INT_SCALAR_INTERNAL (int32_t) -PRINT_INT_SCALAR_INTERNAL (uint32_t) -PRINT_INT_SCALAR_INTERNAL (int64_t) -PRINT_INT_SCALAR_INTERNAL (uint64_t) - -template -/* static */ inline void -octave_print_internal_template (std::ostream& os, const intNDArray& nda, - bool pr_as_read_syntax, int extra_indent) -{ - // FIXME -- this mostly duplicates the code in the print_nd_array<> - // function. Can fix this with std::is_same from C++11. - - if (nda.is_empty ()) - print_empty_nd_array (os, nda.dims (), pr_as_read_syntax); - else if (nda.length () == 1) - octave_print_internal_template (os, nda(0), pr_as_read_syntax); - else if (plus_format && ! pr_as_read_syntax) - { - int ndims = nda.ndims (); - - Array ra_idx (dim_vector (ndims, 1), 0); - - dim_vector dims = nda.dims (); - - octave_idx_type m = 1; - - for (int i = 2; i < ndims; i++) - m *= dims(i); - - octave_idx_type nr = dims(0); - octave_idx_type nc = dims(1); - - for (octave_idx_type i = 0; i < m; i++) - { - if (m > 1) - { - std::string nm = "ans(:,:,"; - - std::ostringstream buf; - - for (int k = 2; k < ndims; k++) - { - buf << ra_idx(k) + 1; - - if (k < ndims - 1) - buf << ","; - else - buf << ")"; - } - - nm += buf.str (); - - os << nm << " =\n"; - if (! Vcompact_format) - os << "\n"; - } - - Array idx (dim_vector (ndims, 1)); - - idx(0) = idx_vector (':'); - idx(1) = idx_vector (':'); - - for (int k = 2; k < ndims; k++) - idx(k) = idx_vector (ra_idx(k)); - - Array page (nda.index (idx), dim_vector (nr, nc)); - - for (octave_idx_type ii = 0; ii < nr; ii++) - { - for (octave_idx_type jj = 0; jj < nc; jj++) - { - octave_quit (); - - pr_plus_format (os, page(ii,jj)); - } - - if ((ii < nr - 1) || (i < m -1)) - os << "\n"; - } - - if (i < m - 1) - { - os << "\n"; - increment_index (ra_idx, dims, 2); - } - } - } - else - { - int ndims = nda.ndims (); - - dim_vector dims = nda.dims (); - - Array ra_idx (dim_vector (ndims, 1), 0); - - octave_idx_type m = 1; - - for (int i = 2; i < ndims; i++) - m *= dims(i); - - octave_idx_type nr = dims(0); - octave_idx_type nc = dims(1); - - int fw = 0; - if (hex_format) - fw = 2 * nda(0).byte_size (); - else if (bit_format) - fw = nda(0).nbits (); - else - { - bool isneg = false; - int digits = 0; - - for (octave_idx_type i = 0; i < dims.numel (); i++) - { - int new_digits = static_cast - (gnulib::floor (log10 (double (abs (nda(i).value ()))) + 1.0)); - - if (new_digits > digits) - digits = new_digits; - - if (! isneg) - isneg = (abs (nda(i).value ()) != nda(i).value ()); - } - - fw = digits + isneg; - } - - int column_width = fw + (rat_format ? 0 : (bank_format ? 5 : 2)); - octave_idx_type total_width = nc * column_width; - int max_width = command_editor::terminal_cols () - extra_indent; - octave_idx_type inc = nc; - if (total_width > max_width && Vsplit_long_rows) - { - inc = max_width / column_width; - if (inc == 0) - inc++; - } - - for (octave_idx_type i = 0; i < m; i++) - { - if (m > 1) - { - std::string nm = "ans(:,:,"; - - std::ostringstream buf; - - for (int k = 2; k < ndims; k++) - { - buf << ra_idx(k) + 1; - - if (k < ndims - 1) - buf << ","; - else - buf << ")"; - } - - nm += buf.str (); - - os << nm << " =\n"; - if (! Vcompact_format) - os << "\n"; - } - - Array idx (dim_vector (ndims, 1)); - - idx(0) = idx_vector (':'); - idx(1) = idx_vector (':'); - - for (int k = 2; k < ndims; k++) - idx(k) = idx_vector (ra_idx(k)); - - Array page (nda.index (idx), dim_vector (nr, nc)); - - if (free_format) - { - if (pr_as_read_syntax) - os << "[\n"; - - for (octave_idx_type ii = 0; ii < nr; ii++) - { - for (octave_idx_type jj = 0; jj < nc; jj++) - { - octave_quit (); - os << " "; - os << typename octave_print_conv::print_conv_type (page(ii,jj)); - } - os << "\n"; - } - - if (pr_as_read_syntax) - os << "]"; - } - else - { - octave_idx_type n_rows = page.rows (); - octave_idx_type n_cols = page.cols (); - - for (octave_idx_type col = 0; col < n_cols; col += inc) - { - octave_idx_type lim = col + inc < n_cols ? col + inc : n_cols; - - pr_col_num_header (os, total_width, max_width, lim, col, - extra_indent); - - for (octave_idx_type ii = 0; ii < n_rows; ii++) - { - os << std::setw (extra_indent) << ""; - - for (octave_idx_type jj = col; jj < lim; jj++) - { - octave_quit (); - os << " "; - pr_int (os, page(ii,jj), fw); - } - if ((ii < n_rows - 1) || (i < m -1)) - os << "\n"; - } - } - } - - if (i < m - 1) - { - os << "\n"; - increment_index (ra_idx, dims, 2); - } - } - } -} - -#define PRINT_INT_ARRAY_INTERNAL(TYPE) \ - OCTINTERP_API void \ - octave_print_internal (std::ostream& os, const intNDArray& nda, \ - bool pr_as_read_syntax, int extra_indent) \ - { \ - octave_print_internal_template (os, nda, pr_as_read_syntax, extra_indent); \ - } - -PRINT_INT_ARRAY_INTERNAL (octave_int8) -PRINT_INT_ARRAY_INTERNAL (octave_uint8) -PRINT_INT_ARRAY_INTERNAL (octave_int16) -PRINT_INT_ARRAY_INTERNAL (octave_uint16) -PRINT_INT_ARRAY_INTERNAL (octave_int32) -PRINT_INT_ARRAY_INTERNAL (octave_uint32) -PRINT_INT_ARRAY_INTERNAL (octave_int64) -PRINT_INT_ARRAY_INTERNAL (octave_uint64) - -void -octave_print_internal (std::ostream&, const Cell&, bool, int, bool) -{ - panic_impossible (); -} - -DEFUN (rats, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} rats (@var{x}, @var{len})\n\ -Convert @var{x} into a rational approximation represented as a string.\n\ -You can convert the string back into a matrix as follows:\n\ -\n\ -@example\n\ -@group\n\ -r = rats (hilb (4));\n\ -x = str2num (r)\n\ -@end group\n\ -@end example\n\ -\n\ -The optional second argument defines the maximum length of the string\n\ -representing the elements of @var{x}. By default @var{len} is 9.\n\ -@seealso{format, rat}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin < 1 || nargin > 2 || nargout > 1) - print_usage (); - else - { - unwind_protect frame; - - frame.protect_var (rat_string_len); - - rat_string_len = 9; - - if (nargin == 2) - rat_string_len = args(1).nint_value (); - - if (! error_state) - { - octave_value arg = args(0); - - if (arg.is_numeric_type ()) - { - frame.protect_var (rat_format); - - rat_format = true; - - std::ostringstream buf; - args(0).print (buf); - std::string s = buf.str (); - - std::list lst; - - size_t n = 0; - size_t s_len = s.length (); - - while (n < s_len) - { - size_t m = s.find ('\n', n); - - if (m == std::string::npos) - { - lst.push_back (s.substr (n)); - break; - } - else - { - lst.push_back (s.substr (n, m - n)); - n = m + 1; - } - } - - retval = string_vector (lst); - } - else - error ("rats: X must be numeric"); - } - } - - return retval; -} - -DEFUN (disp, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} disp (@var{x})\n\ -Display the value of @var{x}. For example:\n\ -\n\ -@example\n\ -@group\n\ -disp (\"The value of pi is:\"), disp (pi)\n\ -\n\ - @print{} the value of pi is:\n\ - @print{} 3.1416\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -Note that the output from @code{disp} always ends with a newline.\n\ -\n\ -If an output value is requested, @code{disp} prints nothing and\n\ -returns the formatted output in a string.\n\ -@seealso{fdisp}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 1 && nargout < 2) - { - if (nargout == 0) - args(0).print (octave_stdout); - else - { - octave_value arg = args(0); - std::ostringstream buf; - arg.print (buf); - retval = octave_value (buf.str (), arg.is_dq_string () ? '"' : '\''); - } - } - else - print_usage (); - - return retval; -} - -DEFUN (fdisp, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fdisp (@var{fid}, @var{x})\n\ -Display the value of @var{x} on the stream @var{fid}. For example:\n\ -\n\ -@example\n\ -@group\n\ -fdisp (stdout, \"The value of pi is:\"), fdisp (stdout, pi)\n\ -\n\ - @print{} the value of pi is:\n\ - @print{} 3.1416\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -Note that the output from @code{fdisp} always ends with a newline.\n\ -@seealso{disp}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 2) - { - int fid = octave_stream_list::get_file_number (args (0)); - - octave_stream os = octave_stream_list::lookup (fid, "fdisp"); - - if (! error_state) - { - std::ostream *osp = os.output_stream (); - - if (osp) - args(1).print (*osp); - else - error ("fdisp: stream FID not open for writing"); - } - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! format short -%! fd = tmpfile (); -%! for r = [0, Inf -Inf, NaN] -%! for i = [0, Inf -Inf, NaN] -%! fdisp (fd, complex (r, i)); -%! endfor -%! endfor -%! fclose (fd); - -%!test -%! foo.real = pi * ones (3,20,3); -%! foo.complex = pi * ones (3,20,3) + 1i; -%! foo.char = repmat ("- Hello World -", [3, 20]); -%! foo.cell = {foo.real, foo.complex, foo.char}; -%! fields = fieldnames (foo); -%! for f = 1:numel (fields) -%! format loose; -%! loose = disp (foo.(fields{f})); -%! format compact; -%! compact = disp (foo.(fields{f})); -%! expected = strrep (loose, "\n\n", "\n"); -%! assert (expected, compact); -%! endfor -*/ - -static void -init_format_state (void) -{ - free_format = false; - plus_format = false; - rat_format = false; - bank_format = false; - hex_format = 0; - bit_format = 0; - Vcompact_format = false; - print_e = false; - print_big_e = false; - print_g = false; - print_eng = false; -} - -static void -set_output_prec_and_fw (int prec, int fw) -{ - Voutput_precision = prec; - Voutput_max_field_width = fw; -} - -static void -set_format_style (int argc, const string_vector& argv) -{ - int idx = 1; - - if (--argc > 0) - { - std::string arg = argv[idx++]; - - if (arg == "short") - { - if (--argc > 0) - { - arg = argv[idx++]; - - if (arg == "e") - { - init_format_state (); - print_e = true; - } - else if (arg == "E") - { - init_format_state (); - print_e = true; - print_big_e = true; - } - else if (arg == "g") - { - init_format_state (); - print_g = true; - } - else if (arg == "G") - { - init_format_state (); - print_g = true; - print_big_e = true; - } - else if (arg == "eng") - { - init_format_state (); - print_eng = true; - } - else - { - error ("format: unrecognized option 'short %s'", - arg.c_str ()); - return; - } - } - else - init_format_state (); - - set_output_prec_and_fw (5, 10); - } - else if (arg == "long") - { - if (--argc > 0) - { - arg = argv[idx++]; - - if (arg == "e") - { - init_format_state (); - print_e = true; - } - else if (arg == "E") - { - init_format_state (); - print_e = true; - print_big_e = true; - } - else if (arg == "g") - { - init_format_state (); - print_g = true; - } - else if (arg == "G") - { - init_format_state (); - print_g = true; - print_big_e = true; - } - else if (arg == "eng") - { - init_format_state (); - print_eng = true; - } - else - { - error ("format: unrecognized option 'long %s'", - arg.c_str ()); - return; - } - } - else - init_format_state (); - - set_output_prec_and_fw (15, 20); - } - else if (arg == "hex") - { - init_format_state (); - hex_format = 1; - } - else if (arg == "native-hex") - { - init_format_state (); - hex_format = 2; - } - else if (arg == "bit") - { - init_format_state (); - bit_format = 1; - } - else if (arg == "native-bit") - { - init_format_state (); - bit_format = 2; - } - else if (arg == "+" || arg == "plus") - { - if (--argc > 0) - { - arg = argv[idx++]; - - if (arg.length () == 3) - plus_format_chars = arg; - else - { - error ("format: invalid option for plus format"); - return; - } - } - else - plus_format_chars = "+ "; - - init_format_state (); - plus_format = true; - } - else if (arg == "rat") - { - init_format_state (); - rat_format = true; - } - else if (arg == "bank") - { - init_format_state (); - bank_format = true; - } - else if (arg == "free") - { - init_format_state (); - free_format = true; - } - else if (arg == "none") - { - init_format_state (); - free_format = true; - } - else if (arg == "compact") - { - Vcompact_format = true; - } - else if (arg == "loose") - { - Vcompact_format = false; - } - else - error ("format: unrecognized format state '%s'", arg.c_str ()); - } - else - { - init_format_state (); - set_output_prec_and_fw (5, 10); - } -} - -DEFUN (format, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} format\n\ -@deftypefnx {Command} {} format options\n\ -Reset or specify the format of the output produced by @code{disp} and\n\ -Octave's normal echoing mechanism. This command only affects the display\n\ -of numbers but not how they are stored or computed. To change the internal\n\ -representation from the default double use one of the conversion functions\n\ -such as @code{single}, @code{uint8}, @code{int64}, etc.\n\ -\n\ -By default, Octave displays 5 significant digits in a human readable form\n\ -(option @samp{short} paired with @samp{loose} format for matrices).\n\ -If @code{format} is invoked without any options, this default format\n\ -is restored.\n\ -\n\ -Valid formats for floating point numbers are listed in the following\n\ -table.\n\ -\n\ -@table @code\n\ -@item short\n\ -Fixed point format with 5 significant figures in a field that is a maximum\n\ -of 10 characters wide. (default).\n\ -\n\ -If Octave is unable to format a matrix so that columns line up on the\n\ -decimal point and all numbers fit within the maximum field width then\n\ -it switches to an exponential @samp{e} format.\n\ -\n\ -@item long\n\ -Fixed point format with 15 significant figures in a field that is a maximum\n\ -of 20 characters wide.\n\ -\n\ -As with the @samp{short} format, Octave will switch to an exponential\n\ -@samp{e} format if it is unable to format a matrix properly using the\n\ -current format.\n\ -\n\ -@item short e\n\ -@itemx long e\n\ -Exponential format. The number to be represented is split between a mantissa\n\ -and an exponent (power of 10). The mantissa has 5 significant digits in the\n\ -short format and 15 digits in the long format.\n\ -For example, with the @samp{short e} format, @code{pi} is displayed as\n\ -@code{3.1416e+00}.\n\ -\n\ -@item short E\n\ -@itemx long E\n\ -Identical to @samp{short e} or @samp{long e} but displays an uppercase\n\ -@samp{E} to indicate the exponent.\n\ -For example, with the @samp{long E} format, @code{pi} is displayed as\n\ -@code{3.14159265358979E+00}.\n\ -\n\ -@item short g\n\ -@itemx long g\n\ -Optimally choose between fixed point and exponential format based on\n\ -the magnitude of the number.\n\ -For example, with the @samp{short g} format,\n\ -@code{pi .^ [2; 4; 8; 16; 32]} is displayed as\n\ -\n\ -@example\n\ -@group\n\ -ans =\n\ -\n\ - 9.8696\n\ - 97.409\n\ - 9488.5\n\ - 9.0032e+07\n\ - 8.1058e+15\n\ -@end group\n\ -@end example\n\ -\n\ -@item short eng\n\ -@itemx long eng\n\ -Identical to @samp{short e} or @samp{long e} but displays the value\n\ -using an engineering format, where the exponent is divisible by 3. For\n\ -example, with the @samp{short eng} format, @code{10 * pi} is displayed as\n\ -@code{31.4159e+00}.\n\ -\n\ -@item long G\n\ -@itemx short G\n\ -Identical to @samp{short g} or @samp{long g} but displays an uppercase\n\ -@samp{E} to indicate the exponent.\n\ -\n\ -@item free\n\ -@itemx none\n\ -Print output in free format, without trying to line up columns of\n\ -matrices on the decimal point. This also causes complex numbers to be\n\ -formatted as numeric pairs like this @samp{(0.60419, 0.60709)} instead\n\ -of like this @samp{0.60419 + 0.60709i}.\n\ -@end table\n\ -\n\ -The following formats affect all numeric output (floating point and\n\ -integer types).\n\ -\n\ -@table @code\n\ -@item +\n\ -@itemx + @var{chars}\n\ -@itemx plus\n\ -@itemx plus @var{chars}\n\ -Print a @samp{+} symbol for nonzero matrix elements and a space for zero\n\ -matrix elements. This format can be very useful for examining the\n\ -structure of a large sparse matrix.\n\ -\n\ -The optional argument @var{chars} specifies a list of 3 characters to use\n\ -for printing values greater than zero, less than zero and equal to zero.\n\ -For example, with the @samp{+ \"+-.\"} format, @code{[1, 0, -1; -1, 0, 1]}\n\ -is displayed as\n\ -\n\ -@example\n\ -@group\n\ -ans =\n\ -\n\ -+.-\n\ --.+\n\ -@end group\n\ -@end example\n\ -\n\ -@item bank\n\ -Print in a fixed format with two digits to the right of the decimal\n\ -point.\n\ -\n\ -@item native-hex\n\ -Print the hexadecimal representation of numbers as they are stored in\n\ -memory. For example, on a workstation which stores 8 byte real values\n\ -in IEEE format with the least significant byte first, the value of\n\ -@code{pi} when printed in @code{native-hex} format is\n\ -@code{400921fb54442d18}.\n\ -\n\ -@item hex\n\ -The same as @code{native-hex}, but always print the most significant\n\ -byte first.\n\ -\n\ -@item native-bit\n\ -Print the bit representation of numbers as stored in memory.\n\ -For example, the value of @code{pi} is\n\ -\n\ -@example\n\ -@group\n\ -01000000000010010010000111111011\n\ -01010100010001000010110100011000\n\ -@end group\n\ -@end example\n\ -\n\ -(shown here in two 32 bit sections for typesetting purposes) when\n\ -printed in native-bit format on a workstation which stores 8 byte real values\n\ -in IEEE format with the least significant byte first.\n\ -\n\ -@item bit\n\ -The same as @code{native-bit}, but always print the most significant\n\ -bits first.\n\ -\n\ -@item rat\n\ -Print a rational approximation, i.e., values are approximated\n\ -as the ratio of small integers.\n\ -For example, with the @samp{rat} format,\n\ -@code{pi} is displayed as @code{355/113}.\n\ -@end table\n\ -\n\ -The following two options affect the display of all matrices.\n\ -\n\ -@table @code\n\ -@item compact\n\ -Remove blank lines around column number labels and between\n\ -matrices producing more compact output with more data per page.\n\ -\n\ -@item loose\n\ -Insert blank lines above and below column number labels and between matrices\n\ -to produce a more readable output with less data per page. (default).\n\ -@end table\n\ -@seealso{fixed_point_format, output_max_field_width, output_precision, split_long_rows, rats}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("format"); - - if (error_state) - return retval; - - set_format_style (argc, argv); - - return retval; -} - -DEFUN (fixed_point_format, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} fixed_point_format ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} fixed_point_format (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} fixed_point_format (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave will\n\ -use a scaled format to print matrix values such that the largest\n\ -element may be written with a single leading digit with the scaling\n\ -factor is printed on the first line of output. For example:\n\ -\n\ -@example\n\ -@group\n\ -octave:1> logspace (1, 7, 5)'\n\ -ans =\n\ -\n\ - 1.0e+07 *\n\ -\n\ - 0.00000\n\ - 0.00003\n\ - 0.00100\n\ - 0.03162\n\ - 1.00000\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -Notice that first value appears to be zero when it is actually 1. For\n\ -this reason, you should be careful when setting\n\ -@code{fixed_point_format} to a nonzero value.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{format, output_max_field_width, output_precision}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (fixed_point_format); -} - -DEFUN (print_empty_dimensions, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} print_empty_dimensions ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} print_empty_dimensions (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} print_empty_dimensions (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether the\n\ -dimensions of empty matrices are printed along with the empty matrix\n\ -symbol, @samp{[]}. For example, the expression\n\ -\n\ -@example\n\ -zeros (3, 0)\n\ -@end example\n\ -\n\ -@noindent\n\ -will print\n\ -\n\ -@example\n\ -ans = [](3x0)\n\ -@end example\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{format}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (print_empty_dimensions); -} - -DEFUN (split_long_rows, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} split_long_rows ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} split_long_rows (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} split_long_rows (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether rows of a matrix\n\ -may be split when displayed to a terminal window. If the rows are split,\n\ -Octave will display the matrix in a series of smaller pieces, each of\n\ -which can fit within the limits of your terminal width and each set of\n\ -rows is labeled so that you can easily see which columns are currently\n\ -being displayed. For example:\n\ -\n\ -@example\n\ -@group\n\ -octave:13> rand (2,10)\n\ -ans =\n\ -\n\ - Columns 1 through 6:\n\ -\n\ - 0.75883 0.93290 0.40064 0.43818 0.94958 0.16467\n\ - 0.75697 0.51942 0.40031 0.61784 0.92309 0.40201\n\ -\n\ - Columns 7 through 10:\n\ -\n\ - 0.90174 0.11854 0.72313 0.73326\n\ - 0.44672 0.94303 0.56564 0.82150\n\ -@end group\n\ -@end example\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{format}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (split_long_rows); -} - -DEFUN (output_max_field_width, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} output_max_field_width ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} output_max_field_width (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} output_max_field_width (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the maximum width\n\ -of a numeric output field.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{format, fixed_point_format, output_precision}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE_WITH_LIMITS (output_max_field_width, 0, - std::numeric_limits::max ()); -} - -DEFUN (output_precision, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} output_precision ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} output_precision (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} output_precision (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the minimum number of\n\ -significant figures to display for numeric output.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{format, fixed_point_format, output_max_field_width}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE_WITH_LIMITS (output_precision, -1, - std::numeric_limits::max ()); -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/pr-output.h --- a/libinterp/interpfcn/pr-output.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,262 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_pr_output_h) -#define octave_pr_output_h 1 - -#include - -#include "oct-cmplx.h" - -template class Array; -class ComplexMatrix; -class FloatComplexMatrix; -class ComplexDiagMatrix; -class FloatComplexDiagMatrix; -class ComplexNDArray; -class FloatComplexNDArray; -class Matrix; -class FloatMatrix; -class DiagMatrix; -class FloatDiagMatrix; -class NDArray; -class FloatNDArray; -class Range; -class boolMatrix; -class boolNDArray; -class charMatrix; -class charNDArray; -class PermMatrix; -class Cell; - -#include "intNDArray.h" -#include "oct-inttypes.h" - - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, bool d, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, double d, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, float d, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const Matrix& m, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const DiagMatrix& m, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const FloatMatrix& m, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const FloatDiagMatrix& m, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const NDArray& nda, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const FloatNDArray& nda, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const Complex& c, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const FloatComplex& c, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const ComplexMatrix& cm, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const ComplexDiagMatrix& cm, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const FloatComplexMatrix& cm, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const FloatComplexDiagMatrix& cm, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const ComplexNDArray& nda, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const FloatComplexNDArray& nda, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const PermMatrix& m, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const Range& r, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const boolMatrix& m, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const boolNDArray& m, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const charMatrix& chm, - bool pr_as_read_syntax = false, - int extra_indent = 0, - bool pr_as_string = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const charNDArray& nda, - bool pr_as_read_syntax = false, - int extra_indent = 0, - bool pr_as_string = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const std::string& s, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const Array& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const intNDArray& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const intNDArray& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const intNDArray& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const intNDArray& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const intNDArray& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const intNDArray& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const intNDArray& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const intNDArray& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const octave_int& sa, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const octave_int& sa, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const octave_int& sa, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const octave_int& sa, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const octave_int& sa, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const octave_int& sa, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const octave_int& sa, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const octave_int& sa, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const Cell& cell, - bool pr_as_read_syntax = false, - int extra_indent = 0, - bool pr_as_string = false); - -// TRUE means that the dimensions of empty objects should be printed -// like this: x = [](2x0). -extern bool Vprint_empty_dimensions; - -// TRUE means don't put empty lines in output -extern bool Vcompact_format; - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/profiler.cc --- a/libinterp/interpfcn/profiler.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,470 +0,0 @@ -/* - -Copyright (C) 2012 Daniel Kraft - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "defun.h" -#include "oct-time.h" -#include "ov-struct.h" -#include "pager.h" -#include "profiler.h" - -profile_data_accumulator::enter::enter (profile_data_accumulator& a, - const std::string& f) - : acc (a) -{ - if (acc.is_active ()) - { - fcn = f; - acc.enter_function (fcn); - } - else - fcn = ""; -} - -profile_data_accumulator::enter::~enter () -{ - if (fcn != "") - acc.exit_function (fcn); -} - -profile_data_accumulator::stats::stats () - : time (0.0), calls (0), recursive (false), - parents (), children () -{} - -octave_value -profile_data_accumulator::stats::function_set_value (const function_set& list) -{ - const octave_idx_type n = list.size (); - - RowVector retval (n); - octave_idx_type i = 0; - for (function_set::const_iterator p = list.begin (); p != list.end (); ++p) - { - retval(i) = *p; - ++i; - } - assert (i == n); - - return retval; -} - -profile_data_accumulator::tree_node::tree_node (tree_node* p, octave_idx_type f) - : parent (p), fcn_id (f), children (), time (0.0), calls (0) -{} - -profile_data_accumulator::tree_node::~tree_node () -{ - for (child_map::iterator i = children.begin (); i != children.end (); ++i) - delete i->second; -} - -profile_data_accumulator::tree_node* -profile_data_accumulator::tree_node::enter (octave_idx_type fcn) -{ - tree_node* retval; - - child_map::iterator pos = children.find (fcn); - if (pos == children.end ()) - { - retval = new tree_node (this, fcn); - children[fcn] = retval; - } - else - retval = pos->second; - - ++retval->calls; - return retval; -} - -profile_data_accumulator::tree_node* -profile_data_accumulator::tree_node::exit (octave_idx_type fcn) -{ - assert (parent); - assert (fcn_id == fcn); - - return parent; -} - -void -profile_data_accumulator::tree_node::build_flat (flat_profile& data) const -{ - // If this is not the top-level node, update profile entry for this function. - if (fcn_id != 0) - { - stats& entry = data[fcn_id - 1]; - - entry.time += time; - entry.calls += calls; - - assert (parent); - if (parent->fcn_id != 0) - { - entry.parents.insert (parent->fcn_id); - data[parent->fcn_id - 1].children.insert (fcn_id); - } - - if (!entry.recursive) - for (const tree_node* i = parent; i; i = i->parent) - if (i->fcn_id == fcn_id) - { - entry.recursive = true; - break; - } - } - - // Recurse on children. - for (child_map::const_iterator i = children.begin (); - i != children.end (); ++i) - i->second->build_flat (data); -} - -octave_value -profile_data_accumulator::tree_node::get_hierarchical (double* total) const -{ - /* Note that we don't generate the entry just for this node, but rather - a struct-array with entries for all children. This way, the top-node - (for which we don't want a real entry) generates already the final - hierarchical profile data. */ - - const octave_idx_type n = children.size (); - - Cell rv_indices (n, 1); - Cell rv_times (n, 1); - Cell rv_totals (n, 1); - Cell rv_calls (n, 1); - Cell rv_children (n, 1); - - octave_idx_type i = 0; - for (child_map::const_iterator p = children.begin (); - p != children.end (); ++p) - { - const tree_node& entry = *p->second; - double child_total = entry.time; - - rv_indices(i) = octave_value (p->first); - rv_times(i) = octave_value (entry.time); - rv_calls(i) = octave_value (entry.calls); - rv_children(i) = entry.get_hierarchical (&child_total); - rv_totals(i) = octave_value (child_total); - - if (total) - *total += child_total; - - ++i; - } - assert (i == n); - - octave_map retval; - - retval.assign ("Index", rv_indices); - retval.assign ("SelfTime", rv_times); - retval.assign ("TotalTime", rv_totals); - retval.assign ("NumCalls", rv_calls); - retval.assign ("Children", rv_children); - - return retval; -} - -profile_data_accumulator::profile_data_accumulator () - : known_functions (), fcn_index (), - enabled (false), call_tree (NULL), last_time (-1.0) -{} - -profile_data_accumulator::~profile_data_accumulator () -{ - if (call_tree) - delete call_tree; -} - -void -profile_data_accumulator::set_active (bool value) -{ - if (value) - { - // Create a call-tree top-node if there isn't yet one. - if (!call_tree) - call_tree = new tree_node (NULL, 0); - - // Let the top-node be the active one. This ensures we have a clean - // fresh start collecting times. - active_fcn = call_tree; - } - else - { - // Make sure we start with fresh timing if we're re-enabled later. - last_time = -1.0; - } - - enabled = value; -} - -void -profile_data_accumulator::enter_function (const std::string& fcn) -{ - // The enter class will check and only call us if the profiler is active. - assert (is_active ()); - assert (call_tree); - - // If there is already an active function, add to its time before - // pushing the new one. - if (active_fcn != call_tree) - add_current_time (); - - // Map the function's name to its index. - octave_idx_type fcn_idx; - fcn_index_map::iterator pos = fcn_index.find (fcn); - if (pos == fcn_index.end ()) - { - known_functions.push_back (fcn); - fcn_idx = known_functions.size (); - fcn_index[fcn] = fcn_idx; - } - else - fcn_idx = pos->second; - - active_fcn = active_fcn->enter (fcn_idx); - last_time = query_time (); -} - -void -profile_data_accumulator::exit_function (const std::string& fcn) -{ - assert (call_tree); - assert (active_fcn != call_tree); - - // Usually, if we are disabled this function is not even called. But the - // call disabling the profiler is an exception. So also check here - // and only record the time if enabled. - if (is_active ()) - add_current_time (); - - fcn_index_map::iterator pos = fcn_index.find (fcn); - assert (pos != fcn_index.end ()); - active_fcn = active_fcn->exit (pos->second); - - // If this was an "inner call", we resume executing the parent function - // up the stack. So note the start-time for this! - last_time = query_time (); -} - -void -profile_data_accumulator::reset (void) -{ - if (is_active ()) - { - error ("Can't reset active profiler."); - return; - } - - known_functions.clear (); - fcn_index.clear (); - - if (call_tree) - { - delete call_tree; - call_tree = NULL; - } - - last_time = -1.0; -} - -octave_value -profile_data_accumulator::get_flat (void) const -{ - octave_value retval; - - const octave_idx_type n = known_functions.size (); - - flat_profile flat (n); - - if (call_tree) - { - call_tree->build_flat (flat); - - Cell rv_names (n, 1); - Cell rv_times (n, 1); - Cell rv_calls (n, 1); - Cell rv_recursive (n, 1); - Cell rv_parents (n, 1); - Cell rv_children (n, 1); - - for (octave_idx_type i = 0; i != n; ++i) - { - rv_names(i) = octave_value (known_functions[i]); - rv_times(i) = octave_value (flat[i].time); - rv_calls(i) = octave_value (flat[i].calls); - rv_recursive(i) = octave_value (flat[i].recursive); - rv_parents(i) = stats::function_set_value (flat[i].parents); - rv_children(i) = stats::function_set_value (flat[i].children); - } - - octave_map m; - - m.assign ("FunctionName", rv_names); - m.assign ("TotalTime", rv_times); - m.assign ("NumCalls", rv_calls); - m.assign ("IsRecursive", rv_recursive); - m.assign ("Parents", rv_parents); - m.assign ("Children", rv_children); - - retval = m; - } - else - { - static const char *fn[] = - { - "FunctionName", - "TotalTime", - "NumCalls", - "IsRecursive", - "Parents", - "Children", - 0 - }; - - static octave_map m (dim_vector (0, 1), string_vector (fn)); - - retval = m; - } - - return retval; -} - -octave_value -profile_data_accumulator::get_hierarchical (void) const -{ - octave_value retval; - - if (call_tree) - retval = call_tree->get_hierarchical (); - else - { - static const char *fn[] = - { - "Index", - "SelfTime", - "NumCalls", - "Children", - 0 - }; - - static octave_map m (dim_vector (0, 1), string_vector (fn)); - - retval = m; - } - - return retval; -} - -double -profile_data_accumulator::query_time (void) const -{ - octave_time now; - - // FIXME -- is this volatile declaration really needed? - // See bug #34210 for additional details. - volatile double dnow = now.double_value (); - - return dnow; -} - -void -profile_data_accumulator::add_current_time (void) -{ - const double t = query_time (); - assert (last_time >= 0.0 && last_time <= t); - - assert (call_tree && active_fcn != call_tree); - active_fcn->add_time (t - last_time); -} - -profile_data_accumulator profiler; - -// Enable or disable the profiler data collection. -DEFUN (__profiler_enable__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Function File} __profiler_enable ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value_list retval; - - const int nargin = args.length (); - if (nargin > 0) - { - if (nargin > 1) - { - print_usage (); - return retval; - } - - profiler.set_active (args(0).bool_value ()); - } - - retval(0) = profiler.is_active (); - - return retval; -} - -// Clear all collected profiling data. -DEFUN (__profiler_reset__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Function File} __profiler_reset ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value_list retval; - const int nargin = args.length (); - - if (nargin > 0) - warning ("profiler_reset: ignoring extra arguments"); - - profiler.reset (); - - return retval; -} - -// Query the timings collected by the profiler. -DEFUN (__profiler_data__, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Function File} __profiler_data ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value_list retval; - const int nargin = args.length (); - - if (nargin > 0) - warning ("profiler_data: ignoring extra arguments"); - - retval(0) = profiler.get_flat (); - if (nargout > 1) - retval(1) = profiler.get_hierarchical (); - - return retval; -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/profiler.h --- a/libinterp/interpfcn/profiler.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,190 +0,0 @@ -/* - -Copyright (C) 2012 Daniel Kraft - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_profiler_h) -#define octave_profiler_h 1 - -#include -#include -#include -#include -#include - -class octave_value; - -class -OCTINTERP_API -profile_data_accumulator -{ -public: - - // This is a utility class that can be used to call the enter/exit - // functions in a manner protected from stack unwinding. - class enter - { - private: - - profile_data_accumulator& acc; - std::string fcn; - - public: - - enter (profile_data_accumulator&, const std::string&); - virtual ~enter (void); - - private: - - // No copying! - enter (const enter&); - enter& operator = (const enter&); - }; - - profile_data_accumulator (void); - virtual ~profile_data_accumulator (); - - bool is_active (void) const { return enabled; } - void set_active (bool); - - void reset (void); - - octave_value get_flat (void) const; - octave_value get_hierarchical (void) const; - -private: - - // One entry in the flat profile (i.e., a collection of data for a single - // function). This is filled in when building the flat profile from the - // hierarchical call tree. - struct stats - { - stats (); - - double time; - unsigned calls; - - bool recursive; - - typedef std::set function_set; - function_set parents; - function_set children; - - // Convert a function_set list to an Octave array of indices. - static octave_value function_set_value (const function_set&); - }; - - typedef std::vector flat_profile; - - // Store data for one node in the call-tree of the hierarchical profiler - // data we collect. - class tree_node - { - public: - - tree_node (tree_node*, octave_idx_type); - virtual ~tree_node (); - - void add_time (double dt) { time += dt; } - - // Enter a child function. It is created in the list of children if it - // wasn't already there. The now-active child node is returned. - tree_node* enter (octave_idx_type); - - // Exit function. As a sanity-check, it is verified that the currently - // active function actually is the one handed in here. Returned is the - // then-active node, which is our parent. - tree_node* exit (octave_idx_type); - - void build_flat (flat_profile&) const; - - // Get the hierarchical profile for this node and its children. If total - // is set, accumulate total time of the subtree in that variable as - // additional return value. - octave_value get_hierarchical (double* total = NULL) const; - - private: - - tree_node* parent; - octave_idx_type fcn_id; - - typedef std::map child_map; - child_map children; - - // This is only time spent *directly* on this level, excluding children! - double time; - - unsigned calls; - - // No copying! - tree_node (const tree_node&); - tree_node& operator = (const tree_node&); - }; - - // Each function we see in the profiler is given a unique index (which - // simply counts starting from 1). We thus have to map profiler-names to - // those indices. For all other stuff, we identify functions by their index. - - typedef std::vector function_set; - typedef std::map fcn_index_map; - - function_set known_functions; - fcn_index_map fcn_index; - - bool enabled; - - tree_node* call_tree; - tree_node* active_fcn; - - // Store last timestamp we had, when the currently active function was called. - double last_time; - - // These are private as only the unwind-protecting inner class enter - // should be allowed to call them. - void enter_function (const std::string&); - void exit_function (const std::string&); - - // Query a timestamp, used for timing calls (obviously). - // This is not static because in the future, maybe we want a flag - // in the profiler or something to choose between cputime, wall-time, - // user-time, system-time, ... - double query_time () const; - - // Add the time elapsed since last_time to the function we're currently in. - // This is called from two different positions, thus it is useful to have - // it as a seperate function. - void add_current_time (void); - - // No copying! - profile_data_accumulator (const profile_data_accumulator&); - profile_data_accumulator& operator = (const profile_data_accumulator&); -}; - -// The instance used. -extern OCTINTERP_API profile_data_accumulator profiler; - -// Helper macro to profile a block of code. -#define BEGIN_PROFILER_BLOCK(name) \ - { \ - profile_data_accumulator::enter pe (profiler, (name)); -#define END_PROFILER_BLOCK \ - } - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/sighandlers.cc --- a/libinterp/interpfcn/sighandlers.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,988 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include -#include - -#include -#include - -#include "cmd-edit.h" -#include "oct-syscalls.h" -#include "quit.h" -#include "singleton-cleanup.h" - -#include "debug.h" -#include "defun.h" -#include "error.h" -#include "input.h" -#include "load-save.h" -#include "oct-map.h" -#include "pager.h" -#include "pt-bp.h" -#include "pt-eval.h" -#include "sighandlers.h" -#include "sysdep.h" -#include "syswait.h" -#include "toplev.h" -#include "utils.h" -#include "variables.h" - -// Nonzero means we have already printed a message for this series of -// SIGPIPES. We assume that the writer will eventually give up. -int pipe_handler_error_count = 0; - -// TRUE means we can be interrupted. -bool can_interrupt = false; - -// TRUE means we should try to enter the debugger on SIGINT. -bool Vdebug_on_interrupt = false; - -// Allow users to avoid writing octave-workspace for SIGHUP (sent by -// closing gnome-terminal, for example). Note that this variable has -// no effect if Vcrash_dumps_octave_core is FALSE. -static bool Vsighup_dumps_octave_core = true; - -// Similar to Vsighup_dumps_octave_core, but for SIGTERM signal. -static bool Vsigterm_dumps_octave_core = true; - -// List of signals we have caught since last call to octave_signal_handler. -static bool octave_signals_caught[NSIG]; - -// Signal handler return type. -#ifndef BADSIG -#define BADSIG (void (*)(int))-1 -#endif - -// The following is a workaround for an apparent bug in GCC 4.1.2 and -// possibly earlier versions. See Octave bug report #30685 for details. -#if defined (__GNUC__) -# if ! (__GNUC__ > 4 \ - || (__GNUC__ == 4 && (__GNUC_MINOR__ > 1 \ - || (__GNUC_MINOR__ == 1 && __GNUC_PATCHLEVEL__ > 2)))) -# undef GNULIB_NAMESPACE -# define GNULIB_NAMESPACE -# warning "disabling GNULIB_NAMESPACE for signal functions -- consider upgrading to a current version of GCC" -# endif -#endif - -#define BLOCK_SIGNAL(sig, nvar, ovar) \ - do \ - { \ - GNULIB_NAMESPACE::sigemptyset (&nvar); \ - GNULIB_NAMESPACE::sigaddset (&nvar, sig); \ - GNULIB_NAMESPACE::sigemptyset (&ovar); \ - GNULIB_NAMESPACE::sigprocmask (SIG_BLOCK, &nvar, &ovar); \ - } \ - while (0) - -#if !defined (SIGCHLD) && defined (SIGCLD) -#define SIGCHLD SIGCLD -#endif - -#define BLOCK_CHILD(nvar, ovar) BLOCK_SIGNAL (SIGCHLD, nvar, ovar) -#define UNBLOCK_CHILD(ovar) GNULIB_NAMESPACE::sigprocmask (SIG_SETMASK, &ovar, 0) - -// Called from octave_quit () to actually do something about the signals -// we have caught. - -void -octave_signal_handler (void) -{ - // The list of signals is relatively short, so we will just go - // linearly through the list. - - for (int i = 0; i < NSIG; i++) - { - if (octave_signals_caught[i]) - { - octave_signals_caught[i] = false; - - switch (i) - { -#ifdef SIGCHLD - case SIGCHLD: - { - volatile octave_interrupt_handler saved_interrupt_handler - = octave_ignore_interrupts (); - - sigset_t set, oset; - - BLOCK_CHILD (set, oset); - - octave_child_list::wait (); - - octave_set_interrupt_handler (saved_interrupt_handler); - - UNBLOCK_CHILD (oset); - - octave_child_list::reap (); - } - break; -#endif - - case SIGFPE: - std::cerr << "warning: floating point exception" << std::endl; - break; - -#ifdef SIGPIPE - case SIGPIPE: - std::cerr << "warning: broken pipe" << std::endl; - break; -#endif - } - } - } -} - -static void -my_friendly_exit (const char *sig_name, int sig_number, - bool save_vars = true) -{ - static bool been_there_done_that = false; - - if (been_there_done_that) - { -#if defined (SIGABRT) - octave_set_signal_handler (SIGABRT, SIG_DFL); -#endif - - std::cerr << "panic: attempted clean up apparently failed -- aborting...\n"; - - MINGW_SIGNAL_CLEANUP (); - - abort (); - } - else - { - been_there_done_that = true; - - std::cerr << "panic: " << sig_name << " -- stopping myself...\n"; - - if (save_vars) - dump_octave_core (); - - if (sig_number < 0) - { - MINGW_SIGNAL_CLEANUP (); - - exit (1); - } - else - { - octave_set_signal_handler (sig_number, SIG_DFL); - - GNULIB_NAMESPACE::raise (sig_number); - } - } -} - -sig_handler * -octave_set_signal_handler (int sig, sig_handler *handler, - bool restart_syscalls) -{ - struct sigaction act, oact; - - act.sa_handler = handler; - act.sa_flags = 0; - -#if defined (SIGALRM) - if (sig == SIGALRM) - { -#if defined (SA_INTERRUPT) - act.sa_flags |= SA_INTERRUPT; -#endif - } -#endif -#if defined (SA_RESTART) -#if defined (SIGALRM) - else -#endif - // FIXME -- Do we also need to explicitly disable SA_RESTART? - if (restart_syscalls) - act.sa_flags |= SA_RESTART; -#endif - - GNULIB_NAMESPACE::sigemptyset (&act.sa_mask); - GNULIB_NAMESPACE::sigemptyset (&oact.sa_mask); - - GNULIB_NAMESPACE::sigaction (sig, &act, &oact); - - return oact.sa_handler; -} - -static void -generic_sig_handler (int sig) -{ - my_friendly_exit (strsignal (sig), sig); -} - -// Handle SIGCHLD. - -#ifdef SIGCHLD -static void -sigchld_handler (int /* sig */) -{ - octave_signal_caught = 1; - - octave_signals_caught[SIGCHLD] = true; -} -#endif /* defined (SIGCHLD) */ - -#ifdef SIGFPE -#if defined (__alpha__) -static void -sigfpe_handler (int /* sig */) -{ - if (can_interrupt && octave_interrupt_state >= 0) - { - octave_signal_caught = 1; - - octave_signals_caught[SIGFPE] = true; - - octave_interrupt_state++; - } -} -#endif /* defined (__alpha__) */ -#endif /* defined (SIGFPE) */ - -#if defined (SIGHUP) || defined (SIGTERM) -static void -sig_hup_or_term_handler (int sig) -{ - switch (sig) - { -#if defined (SIGHUP) - case SIGHUP: - { - if (Vsighup_dumps_octave_core) - dump_octave_core (); - } - break; -#endif - -#if defined (SIGTERM) - case SIGTERM: - { - if (Vsigterm_dumps_octave_core) - dump_octave_core (); - } - break; -#endif - - default: - break; - } - - clean_up_and_exit (0); -} -#endif - -#if 0 -#if defined (SIGWINCH) -static void -sigwinch_handler (int /* sig */) -{ - command_editor::resize_terminal (); -} -#endif -#endif - -// Handle SIGINT by restarting the parser (see octave.cc). -// -// This also has to work for SIGBREAK (on systems that have it), so we -// use the value of sig, instead of just assuming that it is called -// for SIGINT only. - -static void -user_abort (const char *sig_name, int sig_number) -{ - if (! octave_initialized) - exit (1); - - if (can_interrupt) - { - if (Vdebug_on_interrupt) - { - if (! octave_debug_on_interrupt_state) - { - tree_evaluator::debug_mode = true; - octave_debug_on_interrupt_state = true; - - return; - } - else - { - // Clear the flag and do normal interrupt stuff. - - tree_evaluator::debug_mode - = bp_table::have_breakpoints () || Vdebugging; - octave_debug_on_interrupt_state = false; - } - } - - if (octave_interrupt_immediately) - { - if (octave_interrupt_state == 0) - octave_interrupt_state = 1; - - octave_jump_to_enclosing_context (); - } - else - { - // If we are already cleaning up from a previous interrupt, - // take note of the fact that another interrupt signal has - // arrived. - - if (octave_interrupt_state < 0) - octave_interrupt_state = 0; - - octave_signal_caught = 1; - octave_interrupt_state++; - - if (interactive && octave_interrupt_state == 2) - std::cerr << "Press Control-C again to abort." << std::endl; - - if (octave_interrupt_state >= 3) - my_friendly_exit (sig_name, sig_number, true); - } - } - -} - -static void -sigint_handler (int sig) -{ - user_abort (strsignal (sig), sig); -} - -#ifdef SIGPIPE -static void -sigpipe_handler (int /* sig */) -{ - octave_signal_caught = 1; - - octave_signals_caught[SIGPIPE] = true; - - // Don't loop forever on account of this. - - if (pipe_handler_error_count++ > 100 && octave_interrupt_state >= 0) - octave_interrupt_state++; -} -#endif /* defined (SIGPIPE) */ - -octave_interrupt_handler -octave_catch_interrupts (void) -{ - octave_interrupt_handler retval; - -#ifdef SIGINT - retval.int_handler = octave_set_signal_handler (SIGINT, sigint_handler); -#endif - -#ifdef SIGBREAK - retval.brk_handler = octave_set_signal_handler (SIGBREAK, sigint_handler); -#endif - - return retval; -} - -octave_interrupt_handler -octave_ignore_interrupts (void) -{ - octave_interrupt_handler retval; - -#ifdef SIGINT - retval.int_handler = octave_set_signal_handler (SIGINT, SIG_IGN); -#endif - -#ifdef SIGBREAK - retval.brk_handler = octave_set_signal_handler (SIGBREAK, SIG_IGN); -#endif - - return retval; -} - -octave_interrupt_handler -octave_set_interrupt_handler (const volatile octave_interrupt_handler& h, - bool restart_syscalls) -{ - octave_interrupt_handler retval; - -#ifdef SIGINT - retval.int_handler = octave_set_signal_handler (SIGINT, h.int_handler, - restart_syscalls); -#endif - -#ifdef SIGBREAK - retval.brk_handler = octave_set_signal_handler (SIGBREAK, h.brk_handler, - restart_syscalls); -#endif - - return retval; -} - -// Install all the handlers for the signals we might care about. - -void -install_signal_handlers (void) -{ - for (int i = 0; i < NSIG; i++) - octave_signals_caught[i] = false; - - octave_catch_interrupts (); - -#ifdef SIGABRT - octave_set_signal_handler (SIGABRT, generic_sig_handler); -#endif - -#ifdef SIGALRM - octave_set_signal_handler (SIGALRM, generic_sig_handler); -#endif - -#ifdef SIGBUS - octave_set_signal_handler (SIGBUS, generic_sig_handler); -#endif - -#ifdef SIGCHLD - octave_set_signal_handler (SIGCHLD, sigchld_handler); -#endif - - // SIGCLD - // SIGCONT - -#ifdef SIGEMT - octave_set_signal_handler (SIGEMT, generic_sig_handler); -#endif - -#ifdef SIGFPE -#if defined (__alpha__) - octave_set_signal_handler (SIGFPE, sigfpe_handler); -#else - octave_set_signal_handler (SIGFPE, generic_sig_handler); -#endif -#endif - -#ifdef SIGHUP - octave_set_signal_handler (SIGHUP, sig_hup_or_term_handler); -#endif - -#ifdef SIGILL - octave_set_signal_handler (SIGILL, generic_sig_handler); -#endif - - // SIGINFO - // SIGINT - -#ifdef SIGIOT - octave_set_signal_handler (SIGIOT, generic_sig_handler); -#endif - -#ifdef SIGLOST - octave_set_signal_handler (SIGLOST, generic_sig_handler); -#endif - -#ifdef SIGPIPE - octave_set_signal_handler (SIGPIPE, sigpipe_handler); -#endif - -#ifdef SIGPOLL - octave_set_signal_handler (SIGPOLL, SIG_IGN); -#endif - - // SIGPROF - // SIGPWR - -#ifdef SIGQUIT - octave_set_signal_handler (SIGQUIT, generic_sig_handler); -#endif - -#ifdef SIGSEGV - octave_set_signal_handler (SIGSEGV, generic_sig_handler); -#endif - - // SIGSTOP - -#ifdef SIGSYS - octave_set_signal_handler (SIGSYS, generic_sig_handler); -#endif - -#ifdef SIGTERM - octave_set_signal_handler (SIGTERM, sig_hup_or_term_handler); -#endif - -#ifdef SIGTRAP - octave_set_signal_handler (SIGTRAP, generic_sig_handler); -#endif - - // SIGTSTP - // SIGTTIN - // SIGTTOU - // SIGURG - -#ifdef SIGUSR1 - octave_set_signal_handler (SIGUSR1, generic_sig_handler); -#endif - -#ifdef SIGUSR2 - octave_set_signal_handler (SIGUSR2, generic_sig_handler); -#endif - -#ifdef SIGVTALRM - octave_set_signal_handler (SIGVTALRM, generic_sig_handler); -#endif - -#ifdef SIGIO - octave_set_signal_handler (SIGIO, SIG_IGN); -#endif - -#if 0 -#ifdef SIGWINCH - octave_set_signal_handler (SIGWINCH, sigwinch_handler); -#endif -#endif - -#ifdef SIGXCPU - octave_set_signal_handler (SIGXCPU, generic_sig_handler); -#endif - -#ifdef SIGXFSZ - octave_set_signal_handler (SIGXFSZ, generic_sig_handler); -#endif - -} - -static octave_scalar_map -make_sig_struct (void) -{ - octave_scalar_map m; - -#ifdef SIGABRT - m.assign ("ABRT", SIGABRT); -#endif - -#ifdef SIGALRM - m.assign ("ALRM", SIGALRM); -#endif - -#ifdef SIGBUS - m.assign ("BUS", SIGBUS); -#endif - -#ifdef SIGCHLD - m.assign ("CHLD", SIGCHLD); -#endif - -#ifdef SIGCLD - m.assign ("CLD", SIGCLD); -#endif - -#ifdef SIGCONT - m.assign ("CONT", SIGCONT); -#endif - -#ifdef SIGEMT - m.assign ("EMT", SIGEMT); -#endif - -#ifdef SIGFPE - m.assign ("FPE", SIGFPE); -#endif - -#ifdef SIGHUP - m.assign ("HUP", SIGHUP); -#endif - -#ifdef SIGILL - m.assign ("ILL", SIGILL); -#endif - -#ifdef SIGINFO - m.assign ("INFO", SIGINFO); -#endif - -#ifdef SIGINT - m.assign ("INT", SIGINT); -#endif - -#ifdef SIGIO - m.assign ("IO", SIGIO); -#endif - -#ifdef SIGIOT - m.assign ("IOT", SIGIOT); -#endif - -#ifdef SIGKILL - m.assign ("KILL", SIGKILL); -#endif - -#ifdef SIGLOST - m.assign ("LOST", SIGLOST); -#endif - -#ifdef SIGPIPE - m.assign ("PIPE", SIGPIPE); -#endif - -#ifdef SIGPOLL - m.assign ("POLL", SIGPOLL); -#endif - -#ifdef SIGPROF - m.assign ("PROF", SIGPROF); -#endif - -#ifdef SIGPWR - m.assign ("PWR", SIGPWR); -#endif - -#ifdef SIGQUIT - m.assign ("QUIT", SIGQUIT); -#endif - -#ifdef SIGSEGV - m.assign ("SEGV", SIGSEGV); -#endif - -#ifdef SIGSTKFLT - m.assign ("STKFLT", SIGSTKFLT); -#endif - -#ifdef SIGSTOP - m.assign ("STOP", SIGSTOP); -#endif - -#ifdef SIGSYS - m.assign ("SYS", SIGSYS); -#endif - -#ifdef SIGTERM - m.assign ("TERM", SIGTERM); -#endif - -#ifdef SIGTRAP - m.assign ("TRAP", SIGTRAP); -#endif - -#ifdef SIGTSTP - m.assign ("TSTP", SIGTSTP); -#endif - -#ifdef SIGTTIN - m.assign ("TTIN", SIGTTIN); -#endif - -#ifdef SIGTTOU - m.assign ("TTOU", SIGTTOU); -#endif - -#ifdef SIGUNUSED - m.assign ("UNUSED", SIGUNUSED); -#endif - -#ifdef SIGURG - m.assign ("URG", SIGURG); -#endif - -#ifdef SIGUSR1 - m.assign ("USR1", SIGUSR1); -#endif - -#ifdef SIGUSR2 - m.assign ("USR2", SIGUSR2); -#endif - -#ifdef SIGVTALRM - m.assign ("VTALRM", SIGVTALRM); -#endif - -#ifdef SIGWINCH - m.assign ("WINCH", SIGWINCH); -#endif - -#ifdef SIGXCPU - m.assign ("XCPU", SIGXCPU); -#endif - -#ifdef SIGXFSZ - m.assign ("XFSZ", SIGXFSZ); -#endif - - return m; -} - -octave_child_list::octave_child_list_rep *octave_child_list::instance = 0; - -bool -octave_child_list::instance_ok (void) -{ - bool retval = true; - - if (! instance) - { - instance = new octave_child_list_rep (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); - } - - if (! instance) - { - ::error ("unable to create child list object!"); - - retval = false; - } - - return retval; -} - -void -octave_child_list::insert (pid_t pid, octave_child::child_event_handler f) -{ - if (instance_ok ()) - instance->insert (pid, f); -} - -void -octave_child_list::reap (void) -{ - if (instance_ok ()) - instance->reap (); -} - -bool -octave_child_list::wait (void) -{ - return (instance_ok ()) ? instance->wait () : false; -} - -class pid_equal -{ -public: - - pid_equal (pid_t v) : val (v) { } - - bool operator () (const octave_child& oc) const { return oc.pid == val; } - -private: - - pid_t val; -}; - -void -octave_child_list::remove (pid_t pid) -{ - if (instance_ok ()) - instance->remove_if (pid_equal (pid)); -} - -#define OCL_REP octave_child_list::octave_child_list_rep - -void -OCL_REP::insert (pid_t pid, octave_child::child_event_handler f) -{ - append (octave_child (pid, f)); -} - -void -OCL_REP::reap (void) -{ - // Mark the record for PID invalid. - - for (iterator p = begin (); p != end (); p++) - { - // The call to the octave_child::child_event_handler might - // invalidate the iterator (for example, by calling - // octave_child_list::remove), so we increment the iterator - // here. - - octave_child& oc = *p; - - if (oc.have_status) - { - oc.have_status = 0; - - octave_child::child_event_handler f = oc.handler; - - if (f && f (oc.pid, oc.status)) - oc.pid = -1; - } - } - - remove_if (pid_equal (-1)); -} - -// Wait on our children and record any changes in their status. - -bool -OCL_REP::wait (void) -{ - bool retval = false; - - for (iterator p = begin (); p != end (); p++) - { - octave_child& oc = *p; - - pid_t pid = oc.pid; - - if (pid > 0) - { - int status; - - if (octave_syscalls::waitpid (pid, &status, WNOHANG) > 0) - { - oc.have_status = 1; - - oc.status = status; - - retval = true; - - break; - } - } - } - - return retval; -} - -DEFUN (SIG, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} SIG ()\n\ -Return a structure containing Unix signal names and their defined values.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 0) - { - static octave_scalar_map m = make_sig_struct (); - - retval = m; - } - else - print_usage (); - - return retval; -} - -/* -%!assert (isstruct (SIG ())) -%!assert (! isempty (SIG ())) - -%!error SIG (1) -*/ - -DEFUN (debug_on_interrupt, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} debug_on_interrupt ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} debug_on_interrupt (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} debug_on_interrupt (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave will try\n\ -to enter debugging mode when it receives an interrupt signal (typically\n\ -generated with @kbd{C-c}). If a second interrupt signal is received\n\ -before reaching the debugging mode, a normal interrupt will occur.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{debug_on_error, debug_on_warning}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (debug_on_interrupt); -} - -/* -%!test -%! orig_val = debug_on_interrupt (); -%! old_val = debug_on_interrupt (! orig_val); -%! assert (orig_val, old_val); -%! assert (debug_on_interrupt (), ! orig_val); -%! debug_on_interrupt (orig_val); -%! assert (debug_on_interrupt (), orig_val); - -%!error (debug_on_interrupt (1, 2)) -*/ - -DEFUN (sighup_dumps_octave_core, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} sighup_dumps_octave_core ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} sighup_dumps_octave_core (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} sighup_dumps_octave_core (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave tries\n\ -to save all current variables to the file \"octave-workspace\" if it receives\n\ -a hangup signal.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (sighup_dumps_octave_core); -} - -/* -%!test -%! orig_val = sighup_dumps_octave_core (); -%! old_val = sighup_dumps_octave_core (! orig_val); -%! assert (orig_val, old_val); -%! assert (sighup_dumps_octave_core (), ! orig_val); -%! sighup_dumps_octave_core (orig_val); -%! assert (sighup_dumps_octave_core (), orig_val); - -%!error (sighup_dumps_octave_core (1, 2)) -*/ - -DEFUN (sigterm_dumps_octave_core, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} sigterm_dumps_octave_core ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} sigterm_dumps_octave_core (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} sigterm_dumps_octave_core (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave tries\n\ -to save all current variables to the file \"octave-workspace\" if it receives\n\ -a terminate signal.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (sigterm_dumps_octave_core); -} - -/* -%!test -%! orig_val = sigterm_dumps_octave_core (); -%! old_val = sigterm_dumps_octave_core (! orig_val); -%! assert (orig_val, old_val); -%! assert (sigterm_dumps_octave_core (), ! orig_val); -%! sigterm_dumps_octave_core (orig_val); -%! assert (sigterm_dumps_octave_core (), orig_val); - -%!error (sigterm_dumps_octave_core (1, 2)) -*/ diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/sighandlers.h --- a/libinterp/interpfcn/sighandlers.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,180 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -/* - -The signal blocking macros defined below were adapted from similar -functions from GNU Bash, the Bourne Again SHell, copyright (C) 1994 -Free Software Foundation, Inc. - -*/ - -// This file should always be included after config.h! - -#if !defined (octave_sighandlers_h) -#define octave_sighandlers_h 1 - -// Include signal.h, not csignal since the latter might only define -// the ANSI standard C signal interface. - -#include - -#include "syswait.h" -#include "siglist.h" - -#include "base-list.h" - -typedef void sig_handler (int); - -// FIXME -- the data should probably be private... - -struct -octave_interrupt_handler -{ -#ifdef SIGINT - sig_handler *int_handler; -#endif - -#ifdef SIGBREAK - sig_handler *brk_handler; -#endif -}; - -// Nonzero means we have already printed a message for this series of -// SIGPIPES. We assume that the writer will eventually give up. -extern int pipe_handler_error_count; - -// TRUE means we can be interrupted. -extern OCTINTERP_API bool can_interrupt; - -extern OCTINTERP_API sig_handler *octave_set_signal_handler (int, sig_handler *, - bool restart_syscalls = true); - -extern OCTINTERP_API void install_signal_handlers (void); - -extern OCTINTERP_API void octave_signal_handler (void); - -extern OCTINTERP_API octave_interrupt_handler octave_catch_interrupts (void); - -extern OCTINTERP_API octave_interrupt_handler octave_ignore_interrupts (void); - -extern OCTINTERP_API octave_interrupt_handler -octave_set_interrupt_handler (const volatile octave_interrupt_handler&, - bool restart_syscalls = true); - -// extern void ignore_sigchld (void); - -// Maybe this should be in a separate file? - -class -OCTINTERP_API -octave_child -{ -public: - - // Do whatever to handle event for child with PID (might not - // actually be dead, could just be stopped). Return true if - // the list element corresponding to PID should be removed from - // list. This function should not call any functions that modify - // the octave_child_list. - - typedef bool (*child_event_handler) (pid_t, int); - - octave_child (pid_t id = -1, child_event_handler f = 0) - : pid (id), handler (f), have_status (0), status (0) { } - - octave_child (const octave_child& oc) - : pid (oc.pid), handler (oc.handler), - have_status (oc.have_status), status (oc.status) { } - - octave_child& operator = (const octave_child& oc) - { - if (&oc != this) - { - pid = oc.pid; - handler = oc.handler; - have_status = oc.have_status; - status = oc.status; - } - return *this; - } - - ~octave_child (void) { } - - // The process id of this child. - pid_t pid; - - // The function we call if an event happens for this child. - child_event_handler handler; - - // Nonzero if this child has stopped or terminated. - sig_atomic_t have_status; - - // The status of this child; 0 if running, otherwise a status value - // from waitpid. - int status; -}; - -class -OCTINTERP_API -octave_child_list -{ -protected: - - octave_child_list (void) { } - - class octave_child_list_rep : public octave_base_list - { - public: - - void insert (pid_t pid, octave_child::child_event_handler f); - - void reap (void); - - bool wait (void); - }; - -public: - - ~octave_child_list (void) { } - - static void insert (pid_t pid, octave_child::child_event_handler f); - - static void reap (void); - - static bool wait (void); - - static void remove (pid_t pid); - -private: - - static bool instance_ok (void); - - static octave_child_list_rep *instance; - - static void cleanup_instance (void) { delete instance; instance = 0; } -}; - -// TRUE means we should try to enter the debugger on SIGINT. -extern OCTINTERP_API bool Vdebug_on_interrupt; - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/symtab.cc --- a/libinterp/interpfcn/symtab.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1765 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton -Copyright (C) 2009 VZLU Prague, a.s. - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "file-ops.h" -#include "file-stat.h" -#include "oct-env.h" -#include "oct-time.h" -#include "singleton-cleanup.h" - -#include "debug.h" -#include "defun.h" -#include "dirfns.h" -#include "input.h" -#include "load-path.h" -#include "ov-fcn.h" -#include "ov-usr-fcn.h" -#include "pager.h" -#include "parse.h" -#include "pt-arg-list.h" -#include "symtab.h" -#include "unwind-prot.h" -#include "utils.h" - -symbol_table *symbol_table::instance = 0; - -symbol_table::scope_id_cache *symbol_table::scope_id_cache::instance = 0; - -std::map symbol_table::all_instances; - -std::map symbol_table::global_table; - -std::map symbol_table::fcn_table; - -std::map > symbol_table::class_precedence_table; - -std::map > symbol_table::parent_map; - -const symbol_table::scope_id symbol_table::xglobal_scope = 0; -const symbol_table::scope_id symbol_table::xtop_scope = 1; - -symbol_table::scope_id symbol_table::xcurrent_scope = 1; - -symbol_table::context_id symbol_table::xcurrent_context = 0; - -// Should Octave always check to see if function files have changed -// since they were last compiled? -static int Vignore_function_time_stamp = 1; - -void -symbol_table::scope_id_cache::create_instance (void) -{ - instance = new scope_id_cache (); - - singleton_cleanup_list::add (cleanup_instance); -} - -symbol_table::context_id -symbol_table::symbol_record::symbol_record_rep::active_context (void) const -{ - octave_user_function *fcn = curr_fcn; - - // FIXME -- If active_context () == -1, then it does not make much - // sense to use this symbol_record. This means an attempt at accessing - // a variable from a function that has not been called yet is - // happening. This should be cleared up when an implementing closures. - - return fcn && fcn->active_context () != static_cast (-1) - ? fcn->active_context () : xcurrent_context; -} - -void -symbol_table::symbol_record::symbol_record_rep::dump - (std::ostream& os, const std::string& prefix) const -{ - octave_value val = varval (); - - os << prefix << name; - - if (val.is_defined ()) - { - os << " [" - << (is_local () ? "l" : "") - << (is_automatic () ? "a" : "") - << (is_formal () ? "f" : "") - << (is_hidden () ? "h" : "") - << (is_inherited () ? "i" : "") - << (is_global () ? "g" : "") - << (is_persistent () ? "p" : "") - << "] "; - val.dump (os); - } - - os << "\n"; -} - -octave_value -symbol_table::symbol_record::find (const octave_value_list& args) const -{ - octave_value retval; - - if (is_global ()) - retval = symbol_table::global_varval (name ()); - else - { - retval = varval (); - - if (retval.is_undefined ()) - { - // Use cached fcn_info pointer if possible. - if (rep->finfo) - retval = rep->finfo->find (args); - else - { - retval = symbol_table::find_function (name (), args); - - if (retval.is_defined ()) - rep->finfo = get_fcn_info (name ()); - } - } - } - - return retval; -} - -// Check the load path to see if file that defined this is still -// visible. If the file is no longer visible, then erase the -// definition and move on. If the file is visible, then we also -// need to check to see whether the file has changed since the the -// function was loaded/parsed. However, this check should only -// happen once per prompt (for files found from relative path -// elements, we also check if the working directory has changed -// since the last time the function was loaded/parsed). -// -// FIXME -- perhaps this should be done for all loaded functions when -// the prompt is printed or the directory has changed, and then we -// would not check for it when finding symbol definitions. - -static inline bool -load_out_of_date_fcn (const std::string& ff, const std::string& dir_name, - octave_value& function, - const std::string& dispatch_type = std::string ()) -{ - bool retval = false; - - octave_function *fcn = load_fcn_from_file (ff, dir_name, dispatch_type); - - if (fcn) - { - retval = true; - - function = octave_value (fcn); - } - else - function = octave_value (); - - return retval; -} - -bool -out_of_date_check (octave_value& function, - const std::string& dispatch_type, - bool check_relative) -{ - bool retval = false; - - octave_function *fcn = function.function_value (true); - - if (fcn) - { - // FIXME -- we need to handle subfunctions properly here. - - if (! fcn->is_subfunction ()) - { - std::string ff = fcn->fcn_file_name (); - - if (! ff.empty ()) - { - octave_time tc = fcn->time_checked (); - - bool relative = check_relative && fcn->is_relative (); - - if (tc < Vlast_prompt_time - || (relative && tc < Vlast_chdir_time)) - { - bool clear_breakpoints = false; - std::string nm = fcn->name (); - - bool is_same_file = false; - - std::string file; - std::string dir_name; - - if (check_relative) - { - int nm_len = nm.length (); - - if (octave_env::absolute_pathname (nm) - && ((nm_len > 4 && (nm.substr (nm_len-4) == ".oct" - || nm.substr (nm_len-4) == ".mex")) - || (nm_len > 2 && nm.substr (nm_len-2) == ".m"))) - file = nm; - else - { - // We don't want to make this an absolute name, - // because load_fcn_file looks at the name to - // decide whether it came from a relative lookup. - - if (! dispatch_type.empty ()) - { - file = load_path::find_method (dispatch_type, nm, - dir_name); - - if (file.empty ()) - { - const std::list& plist - = symbol_table::parent_classes (dispatch_type); - std::list::const_iterator it - = plist.begin (); - - while (it != plist.end ()) - { - file = load_path::find_method (*it, nm, dir_name); - if (! file.empty ()) - break; - - it++; - } - } - } - - // Maybe it's an autoload? - if (file.empty ()) - file = lookup_autoload (nm); - - if (file.empty ()) - file = load_path::find_fcn (nm, dir_name); - } - - if (! file.empty ()) - is_same_file = same_file (file, ff); - } - else - { - is_same_file = true; - file = ff; - } - - if (file.empty ()) - { - // Can't see this function from current - // directory, so we should clear it. - - function = octave_value (); - - clear_breakpoints = true; - } - else if (is_same_file) - { - // Same file. If it is out of date, then reload it. - - octave_time ottp = fcn->time_parsed (); - time_t tp = ottp.unix_time (); - - fcn->mark_fcn_file_up_to_date (octave_time ()); - - if (! (Vignore_function_time_stamp == 2 - || (Vignore_function_time_stamp - && fcn->is_system_fcn_file ()))) - { - file_stat fs (ff); - - if (fs) - { - if (fs.is_newer (tp)) - { - retval = load_out_of_date_fcn (ff, dir_name, - function, - dispatch_type); - - clear_breakpoints = true; - } - } - else - { - function = octave_value (); - - clear_breakpoints = true; - } - } - } - else - { - // Not the same file, so load the new file in - // place of the old. - - retval = load_out_of_date_fcn (file, dir_name, function, - dispatch_type); - - clear_breakpoints = true; - } - - // If the function has been replaced then clear any - // breakpoints associated with it - if (clear_breakpoints) - bp_table::remove_all_breakpoints_in_file (nm, true); - } - } - } - } - - return retval; -} - -octave_value -symbol_table::fcn_info::fcn_info_rep::load_private_function - (const std::string& dir_name) -{ - octave_value retval; - - std::string file_name = load_path::find_private_fcn (dir_name, name); - - if (! file_name.empty ()) - { - octave_function *fcn = load_fcn_from_file (file_name, dir_name); - - if (fcn) - { - std::string class_name; - - size_t pos = dir_name.find_last_of (file_ops::dir_sep_chars ()); - - if (pos != std::string::npos) - { - std::string tmp = dir_name.substr (pos+1); - - if (tmp[0] == '@') - class_name = tmp.substr (1); - } - - fcn->mark_as_private_function (class_name); - - retval = octave_value (fcn); - - private_functions[dir_name] = retval; - } - } - - return retval; -} - -octave_value -symbol_table::fcn_info::fcn_info_rep::load_class_constructor (void) -{ - octave_value retval; - - std::string dir_name; - - std::string file_name = load_path::find_method (name, name, dir_name); - - if (! file_name.empty ()) - { - octave_function *fcn = load_fcn_from_file (file_name, dir_name, name); - - if (fcn) - { - retval = octave_value (fcn); - - class_constructors[name] = retval; - } - } - - return retval; -} - -octave_value -symbol_table::fcn_info::fcn_info_rep::load_class_method - (const std::string& dispatch_type) -{ - octave_value retval; - - if (name == dispatch_type) - retval = load_class_constructor (); - else - { - std::string dir_name; - - std::string file_name = load_path::find_method (dispatch_type, name, - dir_name); - - if (! file_name.empty ()) - { - octave_function *fcn = load_fcn_from_file (file_name, dir_name, - dispatch_type); - - if (fcn) - { - retval = octave_value (fcn); - - class_methods[dispatch_type] = retval; - } - } - - if (retval.is_undefined ()) - { - // Search parent classes - - const std::list& plist = parent_classes (dispatch_type); - - std::list::const_iterator it = plist.begin (); - - while (it != plist.end ()) - { - retval = find_method (*it); - - if (retval.is_defined ()) - { - class_methods[dispatch_type] = retval; - break; - } - - it++; - } - } - } - - return retval; -} - -void -symbol_table::fcn_info::fcn_info_rep:: mark_subfunction_in_scope_as_private - (scope_id scope, const std::string& class_name) -{ - scope_val_iterator p = subfunctions.find (scope); - - if (p != subfunctions.end ()) - { - octave_function *fcn = p->second.function_value (); - - if (fcn) - fcn->mark_as_private_function (class_name); - } -} - -void -symbol_table::fcn_info::fcn_info_rep::print_dispatch (std::ostream& os) const -{ - if (dispatch_map.empty ()) - os << "dispatch: " << name << " is not overloaded" << std::endl; - else - { - os << "Overloaded function " << name << ":\n\n"; - - for (dispatch_map_const_iterator p = dispatch_map.begin (); - p != dispatch_map.end (); p++) - os << " " << name << " (" << p->first << ", ...) -> " - << p->second << " (" << p->first << ", ...)\n"; - - os << std::endl; - } -} - -std::string -symbol_table::fcn_info::fcn_info_rep::help_for_dispatch (void) const -{ - std::string retval; - - if (! dispatch_map.empty ()) - { - retval = "Overloaded function:\n\n"; - - for (dispatch_map_const_iterator p = dispatch_map.begin (); - p != dispatch_map.end (); p++) - retval += " " + p->second + " (" + p->first + ", ...)\n\n"; - } - - return retval; -} - -// :-) JWE, can you parse this? Returns a 2D array with second dimension equal -// to btyp_num_types (static constant). Only the leftmost dimension can be -// variable in C/C++. Typedefs are boring. - -static builtin_type_t (*build_sup_table (void))[btyp_num_types] -{ - static builtin_type_t sup_table[btyp_num_types][btyp_num_types]; - for (int i = 0; i < btyp_num_types; i++) - for (int j = 0; j < btyp_num_types; j++) - { - builtin_type_t ityp = static_cast (i); - builtin_type_t jtyp = static_cast (j); - // FIXME: Is this really right? - bool use_j = - (jtyp == btyp_func_handle || ityp == btyp_bool - || (btyp_isarray (ityp) - && (! btyp_isarray (jtyp) - || (btyp_isinteger (jtyp) && ! btyp_isinteger (ityp)) - || ((ityp == btyp_double || ityp == btyp_complex || ityp == btyp_char) - && (jtyp == btyp_float || jtyp == btyp_float_complex))))); - - sup_table[i][j] = use_j ? jtyp : ityp; - } - - return sup_table; -} - -std::string -get_dispatch_type (const octave_value_list& args, - builtin_type_t& builtin_type) -{ - static builtin_type_t (*sup_table)[btyp_num_types] = build_sup_table (); - std::string dispatch_type; - - int n = args.length (); - - if (n > 0) - { - int i = 0; - builtin_type = args(0).builtin_type (); - if (builtin_type != btyp_unknown) - { - for (i = 1; i < n; i++) - { - builtin_type_t bti = args(i).builtin_type (); - if (bti != btyp_unknown) - builtin_type = sup_table[builtin_type][bti]; - else - { - builtin_type = btyp_unknown; - break; - } - } - } - - if (builtin_type == btyp_unknown) - { - // There's a non-builtin class in the argument list. - dispatch_type = args(i).class_name (); - - for (int j = i+1; j < n; j++) - { - octave_value arg = args(j); - - if (arg.builtin_type () == btyp_unknown) - { - std::string cname = arg.class_name (); - - // Only switch to type of ARG if it is marked superior - // to the current DISPATCH_TYPE. - if (! symbol_table::is_superiorto (dispatch_type, cname) - && symbol_table::is_superiorto (cname, dispatch_type)) - dispatch_type = cname; - } - } - } - else - dispatch_type = btyp_class_name[builtin_type]; - } - else - builtin_type = btyp_unknown; - - return dispatch_type; -} - -std::string -get_dispatch_type (const octave_value_list& args) -{ - builtin_type_t builtin_type; - return get_dispatch_type (args, builtin_type); -} - -// Find the definition of NAME according to the following precedence -// list: -// -// variable -// subfunction -// private function -// class method -// class constructor -// legacy dispatch -// command-line function -// autoload function -// function on the path -// built-in function -// -// Matlab documentation states that constructors have higher precedence -// than methods, but that does not seem to be the case. - -octave_value -symbol_table::fcn_info::fcn_info_rep::find (const octave_value_list& args, - bool local_funcs) -{ - octave_value retval = xfind (args, local_funcs); - - if (! (error_state || retval.is_defined ())) - { - // It is possible that the user created a file on the fly since - // the last prompt or chdir, so try updating the load path and - // searching again. - - load_path::update (); - - retval = xfind (args, local_funcs); - } - - return retval; -} - -octave_value -symbol_table::fcn_info::fcn_info_rep::xfind (const octave_value_list& args, - bool local_funcs) -{ - if (local_funcs) - { - // Subfunction. I think it only makes sense to check for - // subfunctions if we are currently executing a function defined - // from a .m file. - - octave_user_function *curr_fcn = symbol_table::get_curr_fcn (); - - for (scope_id scope = xcurrent_scope; scope >= 0;) - { - scope_val_iterator r = subfunctions.find (scope); - if (r != subfunctions.end ()) - { - // FIXME -- out-of-date check here. - - return r->second; - } - - octave_user_function *scope_curr_fcn = get_curr_fcn (scope); - if (scope_curr_fcn) - scope = scope_curr_fcn->parent_fcn_scope (); - else - scope = -1; - } - - // Private function. - - if (curr_fcn) - { - std::string dir_name = curr_fcn->dir_name (); - - if (! dir_name.empty ()) - { - str_val_iterator q = private_functions.find (dir_name); - - if (q == private_functions.end ()) - { - octave_value val = load_private_function (dir_name); - - if (val.is_defined ()) - return val; - } - else - { - octave_value& fval = q->second; - - if (fval.is_defined ()) - out_of_date_check (fval, "", false); - - if (fval.is_defined ()) - return fval; - else - { - octave_value val = load_private_function (dir_name); - - if (val.is_defined ()) - return val; - } - } - } - } - } - - // Class methods. - - if (! args.empty ()) - { - std::string dispatch_type = get_dispatch_type (args); - - octave_value fcn = find_method (dispatch_type); - - if (fcn.is_defined ()) - return fcn; - } - - // Class constructors. The class name and function name are the same. - - str_val_iterator q = class_constructors.find (name); - - if (q == class_constructors.end ()) - { - octave_value val = load_class_constructor (); - - if (val.is_defined ()) - return val; - } - else - { - octave_value& fval = q->second; - - if (fval.is_defined ()) - out_of_date_check (fval, name); - - if (fval.is_defined ()) - return fval; - else - { - octave_value val = load_class_constructor (); - - if (val.is_defined ()) - return val; - } - } - - // Legacy dispatch. - - if (! args.empty () && ! dispatch_map.empty ()) - { - std::string dispatch_type = args(0).type_name (); - - std::string fname; - - dispatch_map_iterator p = dispatch_map.find (dispatch_type); - - if (p == dispatch_map.end ()) - p = dispatch_map.find ("any"); - - if (p != dispatch_map.end ()) - { - fname = p->second; - - octave_value fcn - = symbol_table::find_function (fname, args); - - if (fcn.is_defined ()) - return fcn; - } - } - - // Command-line function. - - if (cmdline_function.is_defined ()) - return cmdline_function; - - // Autoload? - - octave_value fcn = find_autoload (); - - if (fcn.is_defined ()) - return fcn; - - // Function on the path. - - fcn = find_user_function (); - - if (fcn.is_defined ()) - return fcn; - - // Built-in function (might be undefined). - - return built_in_function; -} - -// Find the definition of NAME according to the following precedence -// list: -// -// built-in function -// function on the path -// autoload function -// command-line function -// private function -// subfunction - -// This function is used to implement the "builtin" function, which -// searches for "built-in" functions. In Matlab, "builtin" only -// returns functions that are actually built-in to the interpreter. -// But since the list of built-in functions is different in Octave and -// Matlab, we also search up the precedence list until we find -// something that matches. Note that we are only searching by name, -// so class methods, constructors, and legacy dispatch functions are -// skipped. - -octave_value -symbol_table::fcn_info::fcn_info_rep::builtin_find (void) -{ - octave_value retval = x_builtin_find (); - - if (! retval.is_defined ()) - { - // It is possible that the user created a file on the fly since - // the last prompt or chdir, so try updating the load path and - // searching again. - - load_path::update (); - - retval = x_builtin_find (); - } - - return retval; -} - -octave_value -symbol_table::fcn_info::fcn_info_rep::x_builtin_find (void) -{ - // Built-in function. - if (built_in_function.is_defined ()) - return built_in_function; - - // Function on the path. - - octave_value fcn = find_user_function (); - - if (fcn.is_defined ()) - return fcn; - - // Autoload? - - fcn = find_autoload (); - - if (fcn.is_defined ()) - return fcn; - - // Command-line function. - - if (cmdline_function.is_defined ()) - return cmdline_function; - - // Private function. - - octave_user_function *curr_fcn = symbol_table::get_curr_fcn (); - - if (curr_fcn) - { - std::string dir_name = curr_fcn->dir_name (); - - if (! dir_name.empty ()) - { - str_val_iterator q = private_functions.find (dir_name); - - if (q == private_functions.end ()) - { - octave_value val = load_private_function (dir_name); - - if (val.is_defined ()) - return val; - } - else - { - octave_value& fval = q->second; - - if (fval.is_defined ()) - out_of_date_check (fval); - - if (fval.is_defined ()) - return fval; - else - { - octave_value val = load_private_function (dir_name); - - if (val.is_defined ()) - return val; - } - } - } - } - - // Subfunction. I think it only makes sense to check for - // subfunctions if we are currently executing a function defined - // from a .m file. - - for (scope_id scope = xcurrent_scope; scope >= 0;) - { - scope_val_iterator r = subfunctions.find (scope); - if (r != subfunctions.end ()) - { - // FIXME -- out-of-date check here. - - return r->second; - } - - octave_user_function *scope_curr_fcn = get_curr_fcn (scope); - if (scope_curr_fcn) - scope = scope_curr_fcn->parent_fcn_scope (); - else - scope = -1; - } - - return octave_value (); -} - -octave_value -symbol_table::fcn_info::fcn_info_rep::find_method (const std::string& dispatch_type) -{ - octave_value retval; - - str_val_iterator q = class_methods.find (dispatch_type); - - if (q == class_methods.end ()) - { - octave_value val = load_class_method (dispatch_type); - - if (val.is_defined ()) - return val; - } - else - { - octave_value& fval = q->second; - - if (fval.is_defined ()) - out_of_date_check (fval, dispatch_type); - - if (fval.is_defined ()) - return fval; - else - { - octave_value val = load_class_method (dispatch_type); - - if (val.is_defined ()) - return val; - } - } - - return retval; -} - -octave_value -symbol_table::fcn_info::fcn_info_rep::find_autoload (void) -{ - octave_value retval; - - // Autoloaded function. - - if (autoload_function.is_defined ()) - out_of_date_check (autoload_function); - - if (! autoload_function.is_defined ()) - { - std::string file_name = lookup_autoload (name); - - if (! file_name.empty ()) - { - size_t pos = file_name.find_last_of (file_ops::dir_sep_chars ()); - - std::string dir_name = file_name.substr (0, pos); - - octave_function *fcn = load_fcn_from_file (file_name, dir_name, - "", name, true); - - if (fcn) - autoload_function = octave_value (fcn); - } - } - - return autoload_function; -} - -octave_value -symbol_table::fcn_info::fcn_info_rep::find_user_function (void) -{ - // Function on the path. - - if (function_on_path.is_defined ()) - out_of_date_check (function_on_path); - - if (! (error_state || function_on_path.is_defined ())) - { - std::string dir_name; - - std::string file_name = load_path::find_fcn (name, dir_name); - - if (! file_name.empty ()) - { - octave_function *fcn = load_fcn_from_file (file_name, dir_name); - - if (fcn) - function_on_path = octave_value (fcn); - } - } - - return function_on_path; -} - -// Insert INF_CLASS in the set of class names that are considered -// inferior to SUP_CLASS. Return FALSE if INF_CLASS is currently -// marked as superior to SUP_CLASS. - -bool -symbol_table::set_class_relationship (const std::string& sup_class, - const std::string& inf_class) -{ - if (is_superiorto (inf_class, sup_class)) - return false; - - // If sup_class doesn't have an entry in the precedence table, - // this will automatically create it, and associate to it a - // singleton set {inf_class} of inferior classes. - class_precedence_table[sup_class].insert (inf_class); - - return true; -} - -// Has class A been marked as superior to class B? Also returns -// TRUE if B has been marked as inferior to A, since we only keep -// one table, and convert inferiorto information to a superiorto -// relationship. Two calls are required to determine whether there -// is no relationship between two classes: -// -// if (symbol_table::is_superiorto (a, b)) -// // A is superior to B, or B has been marked inferior to A. -// else if (symbol_table::is_superiorto (b, a)) -// // B is superior to A, or A has been marked inferior to B. -// else -// // No relation. - -bool -symbol_table::is_superiorto (const std::string& a, const std::string& b) -{ - class_precedence_table_const_iterator p = class_precedence_table.find (a); - // If a has no entry in the precedence table, return false - if (p == class_precedence_table.end ()) - return false; - - const std::set& inferior_classes = p->second; - std::set::const_iterator q = inferior_classes.find (b); - return (q != inferior_classes.end ()); -} - -static std::string -fcn_file_name (const octave_value& fcn) -{ - const octave_function *f = fcn.function_value (); - - return f ? f->fcn_file_name () : std::string (); -} - -void -symbol_table::fcn_info::fcn_info_rep::dump - (std::ostream& os, const std::string& prefix) const -{ - os << prefix << name - << " [" - << (cmdline_function.is_defined () ? "c" : "") - << (built_in_function.is_defined () ? "b" : "") - << "]\n"; - - std::string tprefix = prefix + " "; - - if (autoload_function.is_defined ()) - os << tprefix << "autoload: " - << fcn_file_name (autoload_function) << "\n"; - - if (function_on_path.is_defined ()) - os << tprefix << "function from path: " - << fcn_file_name (function_on_path) << "\n"; - - if (! subfunctions.empty ()) - { - for (scope_val_const_iterator p = subfunctions.begin (); - p != subfunctions.end (); p++) - os << tprefix << "subfunction: " << fcn_file_name (p->second) - << " [" << p->first << "]\n"; - } - - if (! private_functions.empty ()) - { - for (str_val_const_iterator p = private_functions.begin (); - p != private_functions.end (); p++) - os << tprefix << "private: " << fcn_file_name (p->second) - << " [" << p->first << "]\n"; - } - - if (! class_constructors.empty ()) - { - for (str_val_const_iterator p = class_constructors.begin (); - p != class_constructors.end (); p++) - os << tprefix << "constructor: " << fcn_file_name (p->second) - << " [" << p->first << "]\n"; - } - - if (! class_methods.empty ()) - { - for (str_val_const_iterator p = class_methods.begin (); - p != class_methods.end (); p++) - os << tprefix << "method: " << fcn_file_name (p->second) - << " [" << p->first << "]\n"; - } - - if (! dispatch_map.empty ()) - { - for (dispatch_map_const_iterator p = dispatch_map.begin (); - p != dispatch_map.end (); p++) - os << tprefix << "dispatch: " << fcn_file_name (p->second) - << " [" << p->first << "]\n"; - } -} - -void -symbol_table::install_nestfunction (const std::string& name, - const octave_value& fcn, - scope_id parent_scope) -{ - install_subfunction (name, fcn, parent_scope); - - // Stash the nest_parent for resolving variables after parsing is done. - octave_function *fv = fcn.function_value (); - - symbol_table *fcn_table_loc = get_instance (fv->scope ()); - - symbol_table *parent_table = get_instance (parent_scope); - - parent_table->add_nest_child (*fcn_table_loc); -} - -octave_value -symbol_table::find (const std::string& name, - const octave_value_list& args, - bool skip_variables, - bool local_funcs) -{ - symbol_table *inst = get_instance (xcurrent_scope); - - return inst - ? inst->do_find (name, args, skip_variables, local_funcs) - : octave_value (); -} - -octave_value -symbol_table::builtin_find (const std::string& name) -{ - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_builtin_find (name) : octave_value (); -} - -octave_value -symbol_table::find_function (const std::string& name, - const octave_value_list& args, - bool local_funcs) -{ - octave_value retval; - - if (! name.empty () && name[0] == '@') - { - // Look for a class specific function. - std::string dispatch_type = - name.substr (1, name.find_first_of (file_ops::dir_sep_str ()) - 1); - - std::string method = - name.substr (name.find_last_of (file_ops::dir_sep_str ()) + 1, - std::string::npos); - - retval = find_method (method, dispatch_type); - } - else - { - size_t pos = name.find_first_of (Vfilemarker); - - if (pos == std::string::npos) - retval = find (name, args, true, local_funcs); - else - { - std::string fcn_scope = name.substr (0, pos); - scope_id stored_scope = xcurrent_scope; - xcurrent_scope = xtop_scope; - octave_value parent = find_function (name.substr (0, pos), - octave_value_list (), false); - - if (parent.is_defined ()) - { - octave_function *parent_fcn = parent.function_value (); - - if (parent_fcn) - { - xcurrent_scope = parent_fcn->scope (); - - if (xcurrent_scope > 1) - retval = find_function (name.substr (pos + 1), args); - } - } - - xcurrent_scope = stored_scope; - } - } - - return retval; -} - -void -symbol_table::dump (std::ostream& os, scope_id scope) -{ - if (scope == xglobal_scope) - dump_global (os); - else - { - symbol_table *inst = get_instance (scope, false); - - if (inst) - { - os << "*** dumping symbol table scope " << scope - << " (" << inst->table_name << ")\n\n"; - - std::map sfuns - = symbol_table::subfunctions_defined_in_scope (scope); - - if (! sfuns.empty ()) - { - os << " subfunctions defined in this scope:\n"; - - for (std::map::const_iterator p = sfuns.begin (); - p != sfuns.end (); p++) - os << " " << p->first << "\n"; - - os << "\n"; - } - - inst->do_dump (os); - } - } -} - -void -symbol_table::dump_global (std::ostream& os) -{ - if (! global_table.empty ()) - { - os << "*** dumping global symbol table\n\n"; - - for (global_table_const_iterator p = global_table.begin (); - p != global_table.end (); p++) - { - std::string nm = p->first; - octave_value val = p->second; - - os << " " << nm << " "; - val.dump (os); - os << "\n"; - } - } -} - -void -symbol_table::dump_functions (std::ostream& os) -{ - if (! fcn_table.empty ()) - { - os << "*** dumping globally visible functions from symbol table\n" - << " (c=commandline, b=built-in)\n\n"; - - for (fcn_table_const_iterator p = fcn_table.begin (); - p != fcn_table.end (); p++) - p->second.dump (os, " "); - - os << "\n"; - } -} - -void -symbol_table::stash_dir_name_for_subfunctions (scope_id scope, - const std::string& dir_name) -{ - // FIXME -- is this the best way to do this? Maybe it would be - // better if we had a map from scope to list of subfunctions - // stored with the function. Do we? - - for (fcn_table_const_iterator p = fcn_table.begin (); - p != fcn_table.end (); p++) - { - std::pair tmp - = p->second.subfunction_defined_in_scope (scope); - - std::string nm = tmp.first; - - if (! nm.empty ()) - { - octave_value& fcn = tmp.second; - - octave_user_function *f = fcn.user_function_value (); - - if (f) - f->stash_dir_name (dir_name); - } - } -} - -octave_value -symbol_table::do_find (const std::string& name, - const octave_value_list& args, - bool skip_variables, - bool local_funcs) -{ - octave_value retval; - - // Variable. - - if (! skip_variables) - { - table_iterator p = table.find (name); - - if (p != table.end ()) - { - symbol_record sr = p->second; - - if (sr.is_global ()) - return symbol_table::global_varval (name); - else - { - octave_value val = sr.varval (); - - if (val.is_defined ()) - return val; - } - } - } - - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - return p->second.find (args, local_funcs); - else - { - fcn_info finfo (name); - - octave_value fcn = finfo.find (args, local_funcs); - - if (fcn.is_defined ()) - fcn_table[name] = finfo; - - return fcn; - } - - return retval; -} - -octave_value -symbol_table::do_builtin_find (const std::string& name) -{ - octave_value retval; - - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - return p->second.builtin_find (); - else - { - fcn_info finfo (name); - - octave_value fcn = finfo.builtin_find (); - - if (fcn.is_defined ()) - fcn_table[name] = finfo; - - return fcn; - } - - return retval; -} - -std::list -symbol_table::do_workspace_info (void) const -{ - std::list retval; - - for (table_const_iterator p = table.begin (); p != table.end (); p++) - { - std::string nm = p->first; - symbol_record sr = p->second; - - if (! sr.is_hidden ()) - { - octave_value val = sr.varval (); - - if (val.is_defined ()) - { - dim_vector dv = val.dims (); - - char storage = ' '; - if (sr.is_global ()) - storage = 'g'; - else if (sr.is_persistent ()) - storage = 'p'; - else if (sr.is_automatic ()) - storage = 'a'; - else if (sr.is_formal ()) - storage = 'f'; - else if (sr.is_hidden ()) - storage = 'h'; - else if (sr.is_inherited ()) - storage = 'i'; - - workspace_element elt (storage, nm, val.class_name (), - val.short_disp (), dv.str ()); - - retval.push_back (elt); - } - } - } - - return retval; -} - -void -symbol_table::do_dump (std::ostream& os) -{ - if (! persistent_table.empty ()) - { - os << " persistent variables in this scope:\n\n"; - - for (persistent_table_const_iterator p = persistent_table.begin (); - p != persistent_table.end (); p++) - { - std::string nm = p->first; - octave_value val = p->second; - - os << " " << nm << " "; - val.dump (os); - os << "\n"; - } - - os << "\n"; - } - - if (! table.empty ()) - { - os << " other symbols in this scope (l=local; a=auto; f=formal\n" - << " h=hidden; i=inherited; g=global; p=persistent)\n\n"; - - for (table_const_iterator p = table.begin (); p != table.end (); p++) - p->second.dump (os, " "); - - os << "\n"; - } -} - -void symbol_table::cleanup (void) -{ - clear_all (true); - - // Delete all possibly remaining scopes. - for (all_instances_iterator iter = all_instances.begin (); - iter != all_instances.end (); iter++) - { - // First zero the table entry to avoid possible duplicate delete. - symbol_table *inst = iter->second; - iter->second = 0; - - // Now delete the scope. Note that there may be side effects, such as - // deleting other scopes. - delete inst; - } - - global_table.clear (); - fcn_table.clear (); - class_precedence_table.clear (); - parent_map.clear (); - all_instances.clear (); -} - -void -symbol_table::do_update_nest (void) -{ - if (nest_parent || nest_children.size ()) - curr_fcn->mark_as_nested_function (); - - if (nest_parent) - { - // fix bad symbol_records - for (table_iterator ti = table.begin (); ti != table.end (); ++ti) - { - symbol_record &ours = ti->second; - symbol_record parents; - if (! ours.is_formal () - && nest_parent->look_nonlocal (ti->first, parents)) - { - if (ours.is_global () || ours.is_persistent ()) - ::error ("global and persistent may only be used in the topmost level in which a nested variable is used"); - - if (! ours.is_formal ()) - { - ours.invalidate (); - ti->second = parents; - } - } - else - ours.set_curr_fcn (curr_fcn); - } - } - else if (nest_children.size ()) - { - static_workspace = true; - for (table_iterator ti = table.begin (); ti != table.end (); ++ti) - ti->second.set_curr_fcn (curr_fcn); - } - - for (std::vector::iterator iter = nest_children.begin (); - iter != nest_children.end (); ++iter) - (*iter)->do_update_nest (); -} - -DEFUN (ignore_function_time_stamp, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} ignore_function_time_stamp ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} ignore_function_time_stamp (@var{new_val})\n\ -Query or set the internal variable that controls whether Octave checks\n\ -the time stamp on files each time it looks up functions defined in\n\ -function files. If the internal variable is set to @code{\"system\"},\n\ -Octave will not automatically recompile function files in subdirectories of\n\ -@file{@var{octave-home}/lib/@var{version}} if they have changed since\n\ -they were last compiled, but will recompile other function files in the\n\ -search path if they change. If set to @code{\"all\"}, Octave will not\n\ -recompile any function files unless their definitions are removed with\n\ -@code{clear}. If set to \"none\", Octave will always check time stamps\n\ -on files to determine whether functions defined in function files\n\ -need to recompiled.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargout > 0 || nargin == 0) - { - switch (Vignore_function_time_stamp) - { - case 1: - retval = "system"; - break; - - case 2: - retval = "all"; - break; - - default: - retval = "none"; - break; - } - } - - if (nargin == 1) - { - std::string sval = args(0).string_value (); - - if (! error_state) - { - if (sval == "all") - Vignore_function_time_stamp = 2; - else if (sval == "system") - Vignore_function_time_stamp = 1; - else if (sval == "none") - Vignore_function_time_stamp = 0; - else - error ("ignore_function_time_stamp: expecting argument to be \"all\", \"system\", or \"none\""); - } - else - error ("ignore_function_time_stamp: expecting argument to be character string"); - } - else if (nargin > 1) - print_usage (); - - return retval; -} - -/* -%!shared old_state -%! old_state = ignore_function_time_stamp (); -%!test -%! state = ignore_function_time_stamp ("all"); -%! assert (state, old_state); -%! assert (ignore_function_time_stamp (), "all"); -%! state = ignore_function_time_stamp ("system"); -%! assert (state, "all"); -%! assert (ignore_function_time_stamp (), "system"); -%! ignore_function_time_stamp (old_state); - -## Test input validation -%!error (ignore_function_time_stamp ("all", "all")) -%!error (ignore_function_time_stamp ("UNKNOWN_VALUE")) -%!error (ignore_function_time_stamp (42)) -*/ - -DEFUN (__current_scope__, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{scope}, @var{context}]} __dump_symtab_info__ ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = symbol_table::current_context (); - retval(0) = symbol_table::current_scope (); - - return retval; -} - -DEFUN (__dump_symtab_info__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __dump_symtab_info__ ()\n\ -@deftypefnx {Built-in Function} {} __dump_symtab_info__ (@var{scope})\n\ -@deftypefnx {Built-in Function} {} __dump_symtab_info__ (\"scopes\")\n\ -@deftypefnx {Built-in Function} {} __dump_symtab_info__ (\"functions\")\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - { - symbol_table::dump_functions (octave_stdout); - - symbol_table::dump_global (octave_stdout); - - std::list lst = symbol_table::scopes (); - - for (std::list::const_iterator p = lst.begin (); - p != lst.end (); p++) - symbol_table::dump (octave_stdout, *p); - } - else if (nargin == 1) - { - octave_value arg = args(0); - - if (arg.is_string ()) - { - std::string s_arg = arg.string_value (); - - if (s_arg == "scopes") - { - std::list lst = symbol_table::scopes (); - - RowVector v (lst.size ()); - - octave_idx_type k = 0; - - for (std::list::const_iterator p = lst.begin (); - p != lst.end (); p++) - v.xelem (k++) = *p; - - retval = v; - } - else if (s_arg == "functions") - { - symbol_table::dump_functions (octave_stdout); - } - else - error ("__dump_symtab_info__: expecting \"functions\" or \"scopes\""); - } - else - { - int s = arg.int_value (); - - if (! error_state) - symbol_table::dump (octave_stdout, s); - else - error ("__dump_symtab_info__: expecting string or scope id"); - } - } - else - print_usage (); - - return retval; -} - -#if 0 - -// FIXME -- should we have functions like this in Octave? - -DEFUN (set_variable, args, , "set_variable (NAME, VALUE)") -{ - octave_value retval; - - if (args.length () == 2) - { - std::string name = args(0).string_value (); - - if (! error_state) - symbol_table::assign (name, args(1)); - else - error ("set_variable: expecting variable name as first argument"); - } - else - print_usage (); - - return retval; -} - -DEFUN (variable_value, args, , "VALUE = variable_value (NAME)") -{ - octave_value retval; - - if (args.length () == 1) - { - std::string name = args(0).string_value (); - - if (! error_state) - { - retval = symbol_table::varval (name); - - if (retval.is_undefined ()) - error ("variable_value: '%s' is not a variable in the current scope", - name.c_str ()); - } - else - error ("variable_value: expecting variable name as first argument"); - } - else - print_usage (); - - return retval; -} -#endif - - -/* -bug #34497: 'clear -f' does not work for command line functions - -This test relies on bar being a core function that is implemented in an m-file. -If the first assert fails, this is no longer the case and the tests need to be -updated to use some other function. - -%!assert (! strcmp (which ("bar"), "")); - -%!function x = bar () -%! x = 5; -%!endfunction -%!test -%! assert (bar == 5); -%! assert (strcmp (which ("bar"), "")); -%! clear -f bar; -%! assert (! strcmp (which ("bar"), "")); - -%!function x = bar () -%! x = 5; -%!endfunction -%!test -%! assert (bar == 5); -%! assert (strcmp (which ("bar"), "")); -%! clear bar; -%! assert (! strcmp (which ("bar"), "")); - */ diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/symtab.h --- a/libinterp/interpfcn/symtab.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2879 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton -Copyright (C) 2009 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_symtab_h) -#define octave_symtab_h 1 - -#include -#include -#include -#include -#include - -#include "glob-match.h" -#include "regexp.h" - -class tree_argument_list; -class octave_user_function; - -#include "oct-obj.h" -#include "workspace-element.h" -#include "oct-refcount.h" -#include "ov.h" - -class -OCTINTERP_API -symbol_table -{ -public: - - typedef int scope_id; - typedef size_t context_id; - - class - scope_id_cache - { - protected: - - typedef std::set::iterator set_iterator; - typedef std::set::const_iterator set_const_iterator; - - // We start with 2 because we allocate 0 for the global symbols - // and 1 for the top-level workspace. - - scope_id_cache (void) : next_available (2), in_use (), free_list () { } - - public: - - ~scope_id_cache (void) { } - - static scope_id alloc (void) - { - return instance_ok () ? instance->do_alloc () : -1; - } - - static void free (scope_id scope) - { - if (instance_ok ()) - return instance->do_free (scope); - } - - static std::list scopes (void) - { - return instance_ok () ? instance->do_scopes () : std::list (); - } - - static void create_instance (void); - - static bool instance_ok (void) - { - bool retval = true; - - if (! instance) - create_instance (); - - if (! instance) - { - ::error ("unable to create scope_id_cache object!"); - - retval = false; - } - - return retval; - } - - private: - - // No copying! - - scope_id_cache (const scope_id_cache&); - - scope_id_cache& operator = (const scope_id_cache&); - - static scope_id_cache *instance; - - static void cleanup_instance (void) { delete instance; instance = 0; } - - // The next available scope not in the free list. - scope_id next_available; - - // The set of scope IDs that are currently allocated. - std::set in_use; - - // The set of scope IDs that are currently available. - std::set free_list; - - scope_id do_alloc (void) - { - scope_id retval; - - set_iterator p = free_list.begin (); - - if (p != free_list.end ()) - { - retval = *p; - free_list.erase (p); - } - else - retval = next_available++; - - in_use.insert (retval); - - return retval; - } - - void do_free (scope_id scope) - { - set_iterator p = in_use.find (scope); - - if (p != in_use.end ()) - { - in_use.erase (p); - free_list.insert (scope); - } - else - error ("free_scope: scope %d not found!", scope); - } - - std::list do_scopes (void) const - { - std::list retval; - - for (set_const_iterator p = in_use.begin (); p != in_use.end (); p++) - retval.push_back (*p); - - retval.sort (); - - return retval; - } - }; - - class fcn_info; - - class - symbol_record - { - public: - - // generic variable - static const unsigned int local = 1; - - // varargin, argn, .nargin., .nargout. - // (FIXME -- is this really used now?) - static const unsigned int automatic = 2; - - // formal parameter - static const unsigned int formal = 4; - - // not listed or cleared (.nargin., .nargout.) - static const unsigned int hidden = 8; - - // inherited from parent scope; not cleared at function exit - static const unsigned int inherited = 16; - - // global (redirects to global scope) - static const unsigned int global = 32; - - // not cleared at function exit - static const unsigned int persistent = 64; - - // this symbol may NOT become a variable. - // (symbol added to a static workspace) - static const unsigned int added_static = 128; - - private: - - class - symbol_record_rep - { - public: - - symbol_record_rep (scope_id s, const std::string& nm, - const octave_value& v, unsigned int sc) - : decl_scope (s), curr_fcn (0), name (nm), value_stack (), - storage_class (sc), finfo (), valid (true), count (1) - { - value_stack.push_back (v); - } - - void assign (const octave_value& value, - context_id context = xdefault_context) - { - varref (context) = value; - } - - void assign (octave_value::assign_op op, - const std::string& type, - const std::list& idx, - const octave_value& value, - context_id context = xdefault_context) - { - varref(context).assign (op, type, idx, value); - } - - void assign (octave_value::assign_op op, const octave_value& value, - context_id context = xdefault_context) - { - varref(context).assign (op, value); - } - - void do_non_const_unary_op (octave_value::unary_op op, - context_id context = xdefault_context) - { - varref(context).do_non_const_unary_op (op); - } - - void do_non_const_unary_op (octave_value::unary_op op, - const std::string& type, - const std::list& idx, - context_id context = xdefault_context) - { - varref(context).do_non_const_unary_op (op, type, idx); - } - - octave_value& varref (context_id context = xdefault_context) - { - // We duplicate global_varref and persistent_varref here to - // avoid calling deprecated functions. - - if (is_global ()) - { - symbol_table::global_table_iterator p - = symbol_table::global_table.find (name); - - return (p == symbol_table::global_table.end ()) - ? symbol_table::global_table[name] : p->second; - } - else if (is_persistent ()) - { - static octave_value foobar; - - symbol_table *inst - = symbol_table::get_instance (symbol_table::current_scope ()); - - return inst ? inst->do_persistent_varref (name) : foobar; - } - else - { - if (context == xdefault_context) - context = active_context (); - - context_id n = value_stack.size (); - while (n++ <= context) - value_stack.push_back (octave_value ()); - - return value_stack[context]; - } - } - - octave_value varval (context_id context = xdefault_context) const - { - if (is_global ()) - return symbol_table::global_varval (name); - else if (is_persistent ()) - return symbol_table::persistent_varval (name); - else - { - if (context == xdefault_context) - context = active_context (); - - if (context < value_stack.size ()) - return value_stack[context]; - else - return octave_value (); - } - } - - void push_context (scope_id s) - { - if (! (is_persistent () || is_global ()) - && s == scope ()) - value_stack.push_back (octave_value ()); - } - - // If pop_context returns 0, we are out of values and this element - // of the symbol table should be deleted. This can happen for - // functions like - // - // function foo (n) - // if (n > 0) - // foo (n-1); - // else - // eval ("x = 1"); - // endif - // endfunction - // - // Here, X should only exist in the final stack frame. - - size_t pop_context (scope_id s) - { - size_t retval = 1; - - if (! (is_persistent () || is_global ()) - && s == scope ()) - { - value_stack.pop_back (); - retval = value_stack.size (); - } - - return retval; - } - - void clear (void) { clear (scope ()); } - - void clear (scope_id s) - { - if (! (is_hidden () || is_inherited ()) - && s == scope ()) - { - if (is_global ()) - unmark_global (); - - if (is_persistent ()) - { - symbol_table::persistent_assign (name, varval ()); - - unmark_persistent (); - } - - assign (octave_value ()); - } - } - - bool is_defined (context_id context = xdefault_context) const - { - if (context == xdefault_context) - context = active_context (); - - return varval (context).is_defined (); - } - - bool is_valid (void) const - { - return valid; - } - - bool is_variable (context_id context) const - { - if (context == xdefault_context) - context = active_context (); - - return (! is_local () || is_defined (context)); - } - - bool is_local (void) const { return storage_class & local; } - bool is_automatic (void) const { return storage_class & automatic; } - bool is_formal (void) const { return storage_class & formal; } - bool is_hidden (void) const { return storage_class & hidden; } - bool is_inherited (void) const { return storage_class & inherited; } - bool is_global (void) const { return storage_class & global; } - bool is_persistent (void) const { return storage_class & persistent; } - bool is_added_static (void) const {return storage_class & added_static; } - - void mark_local (void) { storage_class |= local; } - void mark_automatic (void) { storage_class |= automatic; } - void mark_formal (void) { storage_class |= formal; } - void mark_hidden (void) { storage_class |= hidden; } - void mark_inherited (void) { storage_class |= inherited; } - void mark_global (void) - { - if (is_persistent ()) - error ("can't make persistent variable %s global", name.c_str ()); - else - storage_class |= global; - } - void mark_persistent (void) - { - if (is_global ()) - error ("can't make global variable %s persistent", name.c_str ()); - else - storage_class |= persistent; - } - void mark_added_static (void) { storage_class |= added_static; } - - void unmark_local (void) { storage_class &= ~local; } - void unmark_automatic (void) { storage_class &= ~automatic; } - void unmark_formal (void) { storage_class &= ~formal; } - void unmark_hidden (void) { storage_class &= ~hidden; } - void unmark_inherited (void) { storage_class &= ~inherited; } - void unmark_global (void) { storage_class &= ~global; } - void unmark_persistent (void) { storage_class &= ~persistent; } - void unmark_added_static (void) { storage_class &= ~added_static; } - - void init_persistent (void) - { - if (! is_defined ()) - { - mark_persistent (); - - assign (symbol_table::persistent_varval (name)); - } - // FIXME -- this causes trouble with recursive calls. - // else - // error ("unable to declare existing variable persistent"); - } - - void invalidate (void) - { - valid = false; - } - - void erase_persistent (void) - { - unmark_persistent (); - symbol_table::erase_persistent (name); - } - - OCTINTERP_API context_id active_context (void) const; - - scope_id scope (void) const { return decl_scope; } - - void set_curr_fcn (octave_user_function *fcn) - { - curr_fcn = fcn; - } - - symbol_record_rep *dup (scope_id new_scope) const - { - return new symbol_record_rep (new_scope, name, varval (), - storage_class); - } - - void dump (std::ostream& os, const std::string& prefix) const; - - scope_id decl_scope; - - octave_user_function* curr_fcn; - - std::string name; - - std::deque value_stack; - - unsigned int storage_class; - - fcn_info *finfo; - - bool valid; - - octave_refcount count; - - private: - - // No copying! - - symbol_record_rep (const symbol_record_rep& ov); - - symbol_record_rep& operator = (const symbol_record_rep&); - }; - - public: - - symbol_record (scope_id s = xcurrent_scope, - const std::string& nm = std::string (), - const octave_value& v = octave_value (), - unsigned int sc = local) - : rep (new symbol_record_rep (s, nm, v, sc)) { } - - symbol_record (const symbol_record& sr) - : rep (sr.rep) - { - rep->count++; - } - - symbol_record& operator = (const symbol_record& sr) - { - if (this != &sr) - { - if (--rep->count == 0) - delete rep; - - rep = sr.rep; - rep->count++; - } - - return *this; - } - - ~symbol_record (void) - { - if (--rep->count == 0) - delete rep; - } - - symbol_record dup (scope_id new_scope) const - { - return symbol_record (rep->dup (new_scope)); - } - - const std::string& name (void) const { return rep->name; } - - void rename (const std::string& new_name) { rep->name = new_name; } - - octave_value - find (const octave_value_list& args = octave_value_list ()) const; - - void assign (const octave_value& value, - context_id context = xdefault_context) - { - rep->assign (value, context); - } - - void assign (octave_value::assign_op op, - const std::string& type, - const std::list& idx, - const octave_value& value, - context_id context = xdefault_context) - { - rep->assign (op, type, idx, value, context); - } - - void assign (octave_value::assign_op op, const octave_value& value, - context_id context = xdefault_context) - { - rep->assign (op, value, context); - } - - void do_non_const_unary_op (octave_value::unary_op op) - { - rep->do_non_const_unary_op (op); - } - - void do_non_const_unary_op (octave_value::unary_op op, - const std::string& type, - const std::list& idx) - { - rep->do_non_const_unary_op (op, type, idx); - } - - // Delete when deprecated varref functions are removed. - octave_value& varref (context_id context = xdefault_context) - { - return rep->varref (context); - } - - octave_value varval (context_id context = xdefault_context) const - { - return rep->varval (context); - } - - void push_context (scope_id s) { rep->push_context (s); } - - size_t pop_context (scope_id s) { return rep->pop_context (s); } - - void clear (void) { rep->clear (); } - - void clear (scope_id s) { rep->clear (s); } - - bool is_defined (context_id context = xdefault_context) const - { - return rep->is_defined (context); - } - - bool is_undefined (context_id context = xdefault_context) const - { - return ! rep->is_defined (context); - } - - bool is_valid (void) const - { - return rep->is_valid (); - } - - bool is_variable (context_id context = xdefault_context) const - { - return rep->is_variable (context); - } - - bool is_local (void) const { return rep->is_local (); } - bool is_automatic (void) const { return rep->is_automatic (); } - bool is_formal (void) const { return rep->is_formal (); } - bool is_global (void) const { return rep->is_global (); } - bool is_hidden (void) const { return rep->is_hidden (); } - bool is_inherited (void) const { return rep->is_inherited (); } - bool is_persistent (void) const { return rep->is_persistent (); } - bool is_added_static (void) const { return rep->is_added_static (); } - - void mark_local (void) { rep->mark_local (); } - void mark_automatic (void) { rep->mark_automatic (); } - void mark_formal (void) { rep->mark_formal (); } - void mark_hidden (void) { rep->mark_hidden (); } - void mark_inherited (void) { rep->mark_inherited (); } - void mark_global (void) { rep->mark_global (); } - void mark_persistent (void) { rep->mark_persistent (); } - void mark_added_static (void) { rep->mark_added_static (); } - - void unmark_local (void) { rep->unmark_local (); } - void unmark_automatic (void) { rep->unmark_automatic (); } - void unmark_formal (void) { rep->unmark_formal (); } - void unmark_hidden (void) { rep->unmark_hidden (); } - void unmark_inherited (void) { rep->unmark_inherited (); } - void unmark_global (void) { rep->unmark_global (); } - void unmark_persistent (void) { rep->unmark_persistent (); } - void unmark_added_static (void) { rep->unmark_added_static (); } - - void init_persistent (void) { rep->init_persistent (); } - - void erase_persistent (void) { rep->erase_persistent (); } - - void invalidate (void) { rep->invalidate (); } - - context_id active_context (void) const { return rep->active_context (); } - - scope_id scope (void) const { return rep->scope (); } - - unsigned int xstorage_class (void) const { return rep->storage_class; } - - void set_curr_fcn (octave_user_function *fcn) { rep->set_curr_fcn (fcn); } - - void - dump (std::ostream& os, const std::string& prefix = std::string ()) const - { - rep->dump (os, prefix); - } - - private: - - symbol_record_rep *rep; - - symbol_record (symbol_record_rep *new_rep) : rep (new_rep) { } - }; - - // Always access a symbol from the current scope. - // Useful for scripts, as they may be executed in more than one scope. - class - symbol_reference - { - public: - - symbol_reference (void) : scope (-1) { } - - symbol_reference (const symbol_record& record, - scope_id curr_scope = symbol_table::current_scope ()) - : scope (curr_scope), sym (record) - { } - - symbol_reference (const symbol_reference& ref) - : scope (ref.scope), sym (ref.sym) - { } - - symbol_reference& operator = (const symbol_reference& ref) - { - if (this != &ref) - { - scope = ref.scope; - sym = ref.sym; - } - return *this; - } - - bool is_black_hole (void) const { return scope < 0; } - - // The name is the same regardless of scope. - const std::string& name (void) const { return sym.name (); } - - symbol_record *operator-> (void) - { - update (); - return &sym; - } - - symbol_record *operator-> (void) const - { - update (); - return &sym; - } - - // can be used to place symbol_reference in maps, we don't overload < as - // it doesn't make any sense for symbol_reference - struct comparator - { - bool operator ()(const symbol_reference& lhs, - const symbol_reference& rhs) const - { - return lhs.name () < rhs.name (); - } - }; - private: - - void update (void) const - { - scope_id curr_scope = symbol_table::current_scope (); - - if (scope != curr_scope || ! sym.is_valid ()) - { - scope = curr_scope; - sym = symbol_table::insert (sym.name ()); - } - } - - mutable scope_id scope; - mutable symbol_record sym; - }; - - class - fcn_info - { - public: - - typedef std::map dispatch_map_type; - - typedef std::map::const_iterator scope_val_const_iterator; - typedef std::map::iterator scope_val_iterator; - - typedef std::map::const_iterator str_val_const_iterator; - typedef std::map::iterator str_val_iterator; - - typedef dispatch_map_type::const_iterator dispatch_map_const_iterator; - typedef dispatch_map_type::iterator dispatch_map_iterator; - - private: - - class - fcn_info_rep - { - public: - - fcn_info_rep (const std::string& nm) - : name (nm), subfunctions (), private_functions (), - class_constructors (), class_methods (), dispatch_map (), - cmdline_function (), autoload_function (), function_on_path (), - built_in_function (), count (1) { } - - octave_value load_private_function (const std::string& dir_name); - - octave_value load_class_constructor (void); - - octave_value load_class_method (const std::string& dispatch_type); - - octave_value find (const octave_value_list& args, bool local_funcs); - - octave_value builtin_find (void); - - octave_value find_method (const std::string& dispatch_type); - - octave_value find_autoload (void); - - octave_value find_user_function (void); - - bool is_user_function_defined (void) const - { - return function_on_path.is_defined (); - } - - octave_value find_function (const octave_value_list& args, bool local_funcs) - { - return find (args, local_funcs); - } - - void lock_subfunction (scope_id scope) - { - scope_val_iterator p = subfunctions.find (scope); - - if (p != subfunctions.end ()) - p->second.lock (); - } - - void unlock_subfunction (scope_id scope) - { - scope_val_iterator p = subfunctions.find (scope); - - if (p != subfunctions.end ()) - p->second.unlock (); - } - - std::pair - subfunction_defined_in_scope (scope_id scope) const - { - scope_val_const_iterator p = subfunctions.find (scope); - - return p == subfunctions.end () - ? std::pair () - : std::pair (name, p->second); - } - - void erase_subfunction (scope_id scope) - { - scope_val_iterator p = subfunctions.find (scope); - - if (p != subfunctions.end ()) - subfunctions.erase (p); - } - - void mark_subfunction_in_scope_as_private (scope_id scope, - const std::string& class_name); - - void install_cmdline_function (const octave_value& f) - { - cmdline_function = f; - } - - void install_subfunction (const octave_value& f, scope_id scope) - { - subfunctions[scope] = f; - } - - void install_user_function (const octave_value& f) - { - function_on_path = f; - } - - void install_built_in_function (const octave_value& f) - { - built_in_function = f; - } - - template - void - clear_map (std::map& map, bool force = false) - { - typename std::map::iterator p = map.begin (); - - while (p != map.end ()) - { - if (force || ! p->second.islocked ()) - map.erase (p++); - else - p++; - } - } - - void clear_autoload_function (bool force = false) - { - if (force || ! autoload_function.islocked ()) - autoload_function = octave_value (); - } - - // We also clear command line functions here, as these are both - // "user defined" - void clear_user_function (bool force = false) - { - if (force || ! function_on_path.islocked ()) - function_on_path = octave_value (); - - if (force || ! cmdline_function.islocked ()) - cmdline_function = octave_value (); - } - - void clear_mex_function (void) - { - if (function_on_path.is_mex_function ()) - clear_user_function (); - } - - void clear (bool force = false) - { - clear_map (subfunctions, force); - clear_map (private_functions, force); - clear_map (class_constructors, force); - clear_map (class_methods, force); - - clear_autoload_function (force); - clear_user_function (force); - } - - void add_dispatch (const std::string& type, const std::string& fname) - { - dispatch_map[type] = fname; - } - - void clear_dispatch (const std::string& type) - { - dispatch_map_iterator p = dispatch_map.find (type); - - if (p != dispatch_map.end ()) - dispatch_map.erase (p); - } - - void print_dispatch (std::ostream& os) const; - - std::string help_for_dispatch (void) const; - - dispatch_map_type get_dispatch (void) const { return dispatch_map; } - - void dump (std::ostream& os, const std::string& prefix) const; - - std::string name; - - // Scope id to function object. - std::map subfunctions; - - // Directory name to function object. - std::map private_functions; - - // Class name to function object. - std::map class_constructors; - - // Dispatch type to function object. - std::map class_methods; - - // Legacy dispatch map (dispatch type name to function name). - dispatch_map_type dispatch_map; - - octave_value cmdline_function; - - octave_value autoload_function; - - octave_value function_on_path; - - octave_value built_in_function; - - octave_refcount count; - - private: - - octave_value xfind (const octave_value_list& args, bool local_funcs); - - octave_value x_builtin_find (void); - - // No copying! - - fcn_info_rep (const fcn_info_rep&); - - fcn_info_rep& operator = (const fcn_info_rep&); - }; - - public: - - fcn_info (const std::string& nm = std::string ()) - : rep (new fcn_info_rep (nm)) { } - - fcn_info (const fcn_info& fi) : rep (fi.rep) - { - rep->count++; - } - - fcn_info& operator = (const fcn_info& fi) - { - if (this != &fi) - { - if (--rep->count == 0) - delete rep; - - rep = fi.rep; - rep->count++; - } - - return *this; - } - - ~fcn_info (void) - { - if (--rep->count == 0) - delete rep; - } - - octave_value find (const octave_value_list& args = octave_value_list (), - bool local_funcs = true) - { - return rep->find (args, local_funcs); - } - - octave_value builtin_find (void) - { - return rep->builtin_find (); - } - - octave_value find_method (const std::string& dispatch_type) const - { - return rep->find_method (dispatch_type); - } - - octave_value find_built_in_function (void) const - { - return rep->built_in_function; - } - - octave_value find_cmdline_function (void) const - { - return rep->cmdline_function; - } - - octave_value find_autoload (void) - { - return rep->find_autoload (); - } - - octave_value find_user_function (void) - { - return rep->find_user_function (); - } - - bool is_user_function_defined (void) const - { - return rep->is_user_function_defined (); - } - - octave_value find_function (const octave_value_list& args = octave_value_list (), - bool local_funcs = true) - { - return rep->find_function (args, local_funcs); - } - - void lock_subfunction (scope_id scope) - { - rep->lock_subfunction (scope); - } - - void unlock_subfunction (scope_id scope) - { - rep->unlock_subfunction (scope); - } - - std::pair - subfunction_defined_in_scope (scope_id scope = xcurrent_scope) const - { - return rep->subfunction_defined_in_scope (scope); - } - - void erase_subfunction (scope_id scope) - { - rep->erase_subfunction (scope); - } - - void mark_subfunction_in_scope_as_private (scope_id scope, - const std::string& class_name) - { - rep->mark_subfunction_in_scope_as_private (scope, class_name); - } - - void install_cmdline_function (const octave_value& f) - { - rep->install_cmdline_function (f); - } - - void install_subfunction (const octave_value& f, scope_id scope) - { - rep->install_subfunction (f, scope); - } - - void install_user_function (const octave_value& f) - { - rep->install_user_function (f); - } - - void install_built_in_function (const octave_value& f) - { - rep->install_built_in_function (f); - } - - void clear (bool force = false) { rep->clear (force); } - - void clear_user_function (bool force = false) - { - rep->clear_user_function (force); - } - - void clear_autoload_function (bool force = false) - { - rep->clear_autoload_function (force); - } - - void clear_mex_function (void) { rep->clear_mex_function (); } - - void add_dispatch (const std::string& type, const std::string& fname) - { - rep->add_dispatch (type, fname); - } - - void clear_dispatch (const std::string& type) - { - rep->clear_dispatch (type); - } - - void print_dispatch (std::ostream& os) const - { - rep->print_dispatch (os); - } - - std::string help_for_dispatch (void) const { return rep->help_for_dispatch (); } - - dispatch_map_type get_dispatch (void) const - { - return rep->get_dispatch (); - } - - void - dump (std::ostream& os, const std::string& prefix = std::string ()) const - { - rep->dump (os, prefix); - } - - private: - - fcn_info_rep *rep; - }; - - static scope_id global_scope (void) { return xglobal_scope; } - static scope_id top_scope (void) { return xtop_scope; } - - static scope_id current_scope (void) { return xcurrent_scope; } - - static context_id current_context (void) { return xcurrent_context; } - - static scope_id alloc_scope (void) { return scope_id_cache::alloc (); } - - static void set_scope (scope_id scope) - { - if (scope == xglobal_scope) - error ("can't set scope to global"); - else if (scope != xcurrent_scope) - { - all_instances_iterator p = all_instances.find (scope); - - if (p == all_instances.end ()) - { - symbol_table *inst = new symbol_table (scope); - - if (inst) - all_instances[scope] = instance = inst; - } - else - instance = p->second; - - xcurrent_scope = scope; - xcurrent_context = 0; - } - } - - static void set_scope_and_context (scope_id scope, context_id context) - { - if (scope == xglobal_scope) - error ("can't set scope to global"); - else - { - if (scope != xcurrent_scope) - { - all_instances_iterator p = all_instances.find (scope); - - if (p == all_instances.end ()) - error ("scope not found!"); - else - { - instance = p->second; - - xcurrent_scope = scope; - - xcurrent_context = context; - } - } - else - xcurrent_context = context; - } - } - - static void erase_scope (scope_id scope) - { - assert (scope != xglobal_scope); - - erase_subfunctions_in_scope (scope); - - all_instances_iterator p = all_instances.find (scope); - - if (p != all_instances.end ()) - { - delete p->second; - - all_instances.erase (p); - - free_scope (scope); - } - } - - static void erase_subfunctions_in_scope (scope_id scope) - { - for (fcn_table_iterator q = fcn_table.begin (); - q != fcn_table.end (); q++) - q->second.erase_subfunction (scope); - } - - static void - mark_subfunctions_in_scope_as_private (scope_id scope, - const std::string& class_name) - { - for (fcn_table_iterator q = fcn_table.begin (); - q != fcn_table.end (); q++) - q->second.mark_subfunction_in_scope_as_private (scope, class_name); - } - - static scope_id dup_scope (scope_id scope) - { - scope_id retval = -1; - - symbol_table *inst = get_instance (scope); - - if (inst) - { - scope_id new_scope = alloc_scope (); - - symbol_table *new_symbol_table = new symbol_table (scope); - - if (new_symbol_table) - { - all_instances[new_scope] = new_symbol_table; - - inst->do_dup_scope (*new_symbol_table); - - retval = new_scope; - } - } - - return retval; - } - - static std::list scopes (void) - { - return scope_id_cache::scopes (); - } - - static symbol_record - find_symbol (const std::string& name, scope_id scope = xcurrent_scope) - { - symbol_table *inst = get_instance (scope); - - return inst ? inst->do_find_symbol (name) : - symbol_record (scope); - } - - static void - inherit (scope_id scope, scope_id donor_scope, context_id donor_context) - { - symbol_table *inst = get_instance (scope); - - if (inst) - { - symbol_table *donor_symbol_table = get_instance (donor_scope); - - if (donor_symbol_table) - inst->do_inherit (*donor_symbol_table, donor_context); - } - } - - static bool at_top_level (void) { return xcurrent_scope == xtop_scope; } - - // Find a value corresponding to the given name in the table. - static octave_value - find (const std::string& name, - const octave_value_list& args = octave_value_list (), - bool skip_variables = false, - bool local_funcs = true); - - static octave_value builtin_find (const std::string& name); - - // Insert a new name in the table. - static symbol_record& insert (const std::string& name, - scope_id scope = xcurrent_scope) - { - static symbol_record foobar; - - symbol_table *inst = get_instance (scope); - - return inst ? inst->do_insert (name) : foobar; - } - - static void rename (const std::string& old_name, - const std::string& new_name, - scope_id scope = xcurrent_scope) - { - symbol_table *inst = get_instance (scope); - - if (inst) - inst->do_rename (old_name, new_name); - } - - static void assign (const std::string& name, - const octave_value& value = octave_value (), - scope_id scope = xcurrent_scope, - context_id context = xdefault_context, - bool force_add = false) - { - static octave_value foobar; - - symbol_table *inst = get_instance (scope); - - if (inst) - inst->do_assign (name, value, context, force_add); - } - - // Use assign (name, value, scope, context, force_add) instead. - static octave_value& - varref (const std::string& name, scope_id scope = xcurrent_scope, - context_id context = xdefault_context, bool force_add = false) - GCC_ATTR_DEPRECATED - { - static octave_value foobar; - - symbol_table *inst = get_instance (scope); - - return inst ? inst->do_varref (name, context, force_add) : foobar; - } - - // Convenience function to simplify - // octave_user_function::bind_automatic_vars - - static void force_assign (const std::string& name, - const octave_value& value = octave_value (), - scope_id scope = xcurrent_scope, - context_id context = xdefault_context) - { - assign (name, value, scope, context, true); - } - - // Use force_assign (name, value, scope, context) instead. - static octave_value& - force_varref (const std::string& name, scope_id scope = xcurrent_scope, - context_id context = xdefault_context) GCC_ATTR_DEPRECATED - { - static octave_value foobar; - - symbol_table *inst = get_instance (scope); - - return inst ? inst->do_varref (name, context, true) : foobar; - } - - static octave_value varval (const std::string& name, - scope_id scope = xcurrent_scope, - context_id context = xdefault_context) - { - symbol_table *inst = get_instance (scope); - - return inst ? inst->do_varval (name, context) : octave_value (); - } - - static void - global_assign (const std::string& name, - const octave_value& value = octave_value ()) - - { - global_table_iterator p = global_table.find (name); - - if (p == global_table.end ()) - global_table[name] = value; - else - p->second = value; - } - - // Use global_assign (name, value) instead. - static octave_value& - global_varref (const std::string& name) GCC_ATTR_DEPRECATED - - { - global_table_iterator p = global_table.find (name); - - return (p == global_table.end ()) ? global_table[name] : p->second; - } - - static octave_value - global_varval (const std::string& name) - { - global_table_const_iterator p = global_table.find (name); - - return (p != global_table.end ()) ? p->second : octave_value (); - } - - static void - top_level_assign (const std::string& name, - const octave_value& value = octave_value ()) - { - assign (name, value, top_scope (), 0); - } - - // Use top_level_assign (name, value) instead. - static octave_value& - top_level_varref (const std::string& name) GCC_ATTR_DEPRECATED - { - static octave_value foobar; - - symbol_table *inst = get_instance (top_scope ()); - - return inst ? inst->do_varref (name, 0, true) : foobar; - } - - static octave_value - top_level_varval (const std::string& name) - { - return varval (name, top_scope (), 0); - } - - static void - persistent_assign (const std::string& name, - const octave_value& value = octave_value ()) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_persistent_assign (name, value); - } - - // Use persistent_assign (name, value) instead. - static octave_value& persistent_varref (const std::string& name) - GCC_ATTR_DEPRECATED - { - static octave_value foobar; - - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_persistent_varref (name) : foobar; - } - - static octave_value persistent_varval (const std::string& name) - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_persistent_varval (name) : octave_value (); - } - - static void erase_persistent (const std::string& name) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_erase_persistent (name); - } - - static bool is_variable (const std::string& name) - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_is_variable (name) : false; - } - - static bool - is_built_in_function_name (const std::string& name) - { - octave_value val = find_built_in_function (name); - - return val.is_defined (); - } - - static octave_value - find_method (const std::string& name, const std::string& dispatch_type) - { - fcn_table_const_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - return p->second.find_method (dispatch_type); - else - { - fcn_info finfo (name); - - octave_value fcn = finfo.find_method (dispatch_type); - - if (fcn.is_defined ()) - fcn_table[name] = finfo; - - return fcn; - } - } - - static octave_value - find_built_in_function (const std::string& name) - { - fcn_table_const_iterator p = fcn_table.find (name); - - return (p != fcn_table.end ()) - ? p->second.find_built_in_function () : octave_value (); - } - - static octave_value - find_autoload (const std::string& name) - { - fcn_table_iterator p = fcn_table.find (name); - - return (p != fcn_table.end ()) - ? p->second.find_autoload () : octave_value (); - } - - static octave_value - find_function (const std::string& name, - const octave_value_list& args = octave_value_list (), - bool local_funcs = true); - - static octave_value find_user_function (const std::string& name) - { - fcn_table_iterator p = fcn_table.find (name); - - return (p != fcn_table.end ()) - ? p->second.find_user_function () : octave_value (); - } - - static void install_cmdline_function (const std::string& name, - const octave_value& fcn) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.install_cmdline_function (fcn); - } - else - { - fcn_info finfo (name); - - finfo.install_cmdline_function (fcn); - - fcn_table[name] = finfo; - } - } - - // Install subfunction FCN named NAME. SCOPE is the scope of the - // primary function corresponding to this subfunction. - - static void install_subfunction (const std::string& name, - const octave_value& fcn, - scope_id scope) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.install_subfunction (fcn, scope); - } - else - { - fcn_info finfo (name); - - finfo.install_subfunction (fcn, scope); - - fcn_table[name] = finfo; - } - } - - static void install_nestfunction (const std::string& name, - const octave_value& fcn, - scope_id parent_scope); - - static void update_nest (scope_id scope) - { - symbol_table *inst = get_instance (scope); - if (inst) - inst->do_update_nest (); - } - - static void install_user_function (const std::string& name, - const octave_value& fcn) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.install_user_function (fcn); - } - else - { - fcn_info finfo (name); - - finfo.install_user_function (fcn); - - fcn_table[name] = finfo; - } - } - - static void install_built_in_function (const std::string& name, - const octave_value& fcn) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.install_built_in_function (fcn); - } - else - { - fcn_info finfo (name); - - finfo.install_built_in_function (fcn); - - fcn_table[name] = finfo; - } - } - - static void clear (const std::string& name) - { - clear_variable (name); - } - - static void clear_all (bool force = false) - { - clear_variables (); - - clear_global_pattern ("*"); - - clear_functions (force); - } - - static void clear_variables (scope_id scope) - { - symbol_table *inst = get_instance (scope); - - if (inst) - inst->do_clear_variables (); - } - - // This is split for unwind_protect. - static void clear_variables (void) - { - clear_variables (xcurrent_scope); - } - - static void clear_objects (scope_id scope = xcurrent_scope) - { - symbol_table *inst = get_instance (scope); - - if (inst) - inst->do_clear_objects (); - } - - static void clear_functions (bool force = false) - { - for (fcn_table_iterator p = fcn_table.begin (); p != fcn_table.end (); p++) - p->second.clear (force); - } - - static void clear_function (const std::string& name) - { - clear_user_function (name); - } - - static void clear_global (const std::string& name) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_clear_global (name); - } - - static void clear_variable (const std::string& name) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_clear_variable (name); - } - - static void clear_symbol (const std::string& name) - { - // FIXME -- are we supposed to do both here? - - clear_variable (name); - clear_function (name); - } - - static void clear_function_pattern (const std::string& pat) - { - glob_match pattern (pat); - - for (fcn_table_iterator p = fcn_table.begin (); p != fcn_table.end (); p++) - { - if (pattern.match (p->first)) - p->second.clear_user_function (); - } - } - - static void clear_global_pattern (const std::string& pat) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_clear_global_pattern (pat); - } - - static void clear_variable_pattern (const std::string& pat) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_clear_variable_pattern (pat); - } - - static void clear_variable_regexp (const std::string& pat) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_clear_variable_regexp (pat); - } - - static void clear_symbol_pattern (const std::string& pat) - { - // FIXME -- are we supposed to do both here? - - clear_variable_pattern (pat); - clear_function_pattern (pat); - } - - static void clear_user_function (const std::string& name) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.clear_user_function (); - } - // FIXME -- is this necessary, or even useful? - // else - // error ("clear: no such function '%s'", name.c_str ()); - } - - // This clears oct and mex files, incl. autoloads. - static void clear_dld_function (const std::string& name) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.clear_autoload_function (); - finfo.clear_user_function (); - } - } - - static void clear_mex_functions (void) - { - for (fcn_table_iterator p = fcn_table.begin (); p != fcn_table.end (); p++) - { - fcn_info& finfo = p->second; - - finfo.clear_mex_function (); - } - } - - static bool set_class_relationship (const std::string& sup_class, - const std::string& inf_class); - - static bool is_superiorto (const std::string& a, const std::string& b); - - static void alias_built_in_function (const std::string& alias, - const std::string& name) - { - octave_value fcn = find_built_in_function (name); - - if (fcn.is_defined ()) - { - fcn_info finfo (alias); - - finfo.install_built_in_function (fcn); - - fcn_table[alias] = finfo; - } - else - panic ("alias: '%s' is undefined", name.c_str ()); - } - - static void add_dispatch (const std::string& name, const std::string& type, - const std::string& fname) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.add_dispatch (type, fname); - } - else - { - fcn_info finfo (name); - - finfo.add_dispatch (type, fname); - - fcn_table[name] = finfo; - } - } - - static void clear_dispatch (const std::string& name, const std::string& type) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.clear_dispatch (type); - } - } - - static void print_dispatch (std::ostream& os, const std::string& name) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.print_dispatch (os); - } - } - - static fcn_info::dispatch_map_type get_dispatch (const std::string& name) - { - fcn_info::dispatch_map_type retval; - - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - retval = finfo.get_dispatch (); - } - - return retval; - } - - static std::string help_for_dispatch (const std::string& name) - { - std::string retval; - - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - retval = finfo.help_for_dispatch (); - } - - return retval; - } - - static void push_context (void) - { - if (xcurrent_scope == xglobal_scope || xcurrent_scope == xtop_scope) - error ("invalid call to xymtab::push_context"); - else - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_push_context (); - } - } - - static void pop_context (void) - { - if (xcurrent_scope == xglobal_scope || xcurrent_scope == xtop_scope) - error ("invalid call to xymtab::pop_context"); - else - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_pop_context (); - } - } - - // For unwind_protect. - static void pop_context (void *) { pop_context (); } - - static void mark_automatic (const std::string& name) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_mark_automatic (name); - } - - static void mark_hidden (const std::string& name) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_mark_hidden (name); - } - - static void mark_global (const std::string& name) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_mark_global (name); - } - - // exclude: Storage classes to exclude, you can OR them together - static std::list - all_variables (scope_id scope = xcurrent_scope, - context_id context = xdefault_context, - bool defined_only = true, - unsigned int exclude = symbol_record::hidden) - { - symbol_table *inst = get_instance (scope); - - return inst - ? inst->do_all_variables (context, defined_only, exclude) - : std::list (); - } - - static std::list glob (const std::string& pattern) - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_glob (pattern) : std::list (); - } - - static std::list regexp (const std::string& pattern) - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_regexp (pattern) : std::list (); - } - - static std::list glob_variables (const std::string& pattern) - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_glob (pattern, true) : std::list (); - } - - static std::list regexp_variables (const std::string& pattern) - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_regexp (pattern, true) : std::list (); - } - - static std::list - glob_global_variables (const std::string& pattern) - { - std::list retval; - - glob_match pat (pattern); - - for (global_table_const_iterator p = global_table.begin (); - p != global_table.end (); p++) - { - // We generate a list of symbol_record objects so that - // the results from glob_variables and glob_global_variables - // may be handled the same way. - - if (pat.match (p->first)) - retval.push_back (symbol_record (xglobal_scope, - p->first, p->second, - symbol_record::global)); - } - - return retval; - } - - static std::list - regexp_global_variables (const std::string& pattern) - { - std::list retval; - - ::regexp pat (pattern); - - for (global_table_const_iterator p = global_table.begin (); - p != global_table.end (); p++) - { - // We generate a list of symbol_record objects so that - // the results from regexp_variables and regexp_global_variables - // may be handled the same way. - - if (pat.is_match (p->first)) - retval.push_back (symbol_record (xglobal_scope, - p->first, p->second, - symbol_record::global)); - } - - return retval; - } - - static std::list glob_variables (const string_vector& patterns) - { - std::list retval; - - size_t len = patterns.length (); - - for (size_t i = 0; i < len; i++) - { - std::list tmp = glob_variables (patterns[i]); - - retval.insert (retval.begin (), tmp.begin (), tmp.end ()); - } - - return retval; - } - - static std::list regexp_variables - (const string_vector& patterns) - { - std::list retval; - - size_t len = patterns.length (); - - for (size_t i = 0; i < len; i++) - { - std::list tmp = regexp_variables (patterns[i]); - - retval.insert (retval.begin (), tmp.begin (), tmp.end ()); - } - - return retval; - } - - static std::list user_function_names (void) - { - std::list retval; - - for (fcn_table_iterator p = fcn_table.begin (); - p != fcn_table.end (); p++) - { - if (p->second.is_user_function_defined ()) - retval.push_back (p->first); - } - - if (! retval.empty ()) - retval.sort (); - - return retval; - } - - static std::list global_variable_names (void) - { - std::list retval; - - for (global_table_const_iterator p = global_table.begin (); - p != global_table.end (); p++) - retval.push_back (p->first); - - retval.sort (); - - return retval; - } - - static std::list top_level_variable_names (void) - { - symbol_table *inst = get_instance (xtop_scope); - - return inst ? inst->do_variable_names () : std::list (); - } - - static std::list variable_names (void) - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_variable_names () : std::list (); - } - - static std::list built_in_function_names (void) - { - std::list retval; - - for (fcn_table_const_iterator p = fcn_table.begin (); - p != fcn_table.end (); p++) - { - octave_value fcn = p->second.find_built_in_function (); - - if (fcn.is_defined ()) - retval.push_back (p->first); - } - - if (! retval.empty ()) - retval.sort (); - - return retval; - } - - static std::list cmdline_function_names (void) - { - std::list retval; - - for (fcn_table_const_iterator p = fcn_table.begin (); - p != fcn_table.end (); p++) - { - octave_value fcn = p->second.find_cmdline_function (); - - if (fcn.is_defined ()) - retval.push_back (p->first); - } - - if (! retval.empty ()) - retval.sort (); - - return retval; - } - - static bool is_local_variable (const std::string& name) - { - if (xcurrent_scope == xglobal_scope) - return false; - else - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_is_local_variable (name) : false; - } - } - - static bool is_global (const std::string& name) - { - if (xcurrent_scope == xglobal_scope) - return true; - else - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_is_global (name) : false; - } - } - - static std::list workspace_info (void) - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst - ? inst->do_workspace_info () : std::list (); - } - - static void dump (std::ostream& os, scope_id scope = xcurrent_scope); - - static void dump_global (std::ostream& os); - - static void dump_functions (std::ostream& os); - - static void cache_name (scope_id scope, const std::string& name) - { - symbol_table *inst = get_instance (scope, false); - - if (inst) - inst->do_cache_name (name); - } - - static void lock_subfunctions (scope_id scope = xcurrent_scope) - { - for (fcn_table_iterator p = fcn_table.begin (); - p != fcn_table.end (); p++) - p->second.lock_subfunction (scope); - } - - static void unlock_subfunctions (scope_id scope = xcurrent_scope) - { - for (fcn_table_iterator p = fcn_table.begin (); - p != fcn_table.end (); p++) - p->second.unlock_subfunction (scope); - } - - static std::map - subfunctions_defined_in_scope (scope_id scope = xcurrent_scope) - { - std::map retval; - - for (fcn_table_const_iterator p = fcn_table.begin (); - p != fcn_table.end (); p++) - { - std::pair tmp - = p->second.subfunction_defined_in_scope (scope); - - std::string nm = tmp.first; - - if (! nm.empty ()) - retval[nm] = tmp.second; - } - - return retval; - } - - static void free_scope (scope_id scope) - { - if (scope == xglobal_scope || scope == xtop_scope) - error ("can't free global or top-level scopes!"); - else - symbol_table::scope_id_cache::free (scope); - } - - static void stash_dir_name_for_subfunctions (scope_id scope, - const std::string& dir_name); - - static void add_to_parent_map (const std::string& classname, - const std::list& parent_list) - { - parent_map[classname] = parent_list; - } - - static std::list - parent_classes (const std::string& dispatch_type) - { - std::list retval; - - const_parent_map_iterator it = parent_map.find (dispatch_type); - - if (it != parent_map.end ()) - retval = it->second; - - for (std::list::const_iterator lit = retval.begin (); - lit != retval.end (); lit++) - { - // Search for parents of parents and append them to the list. - - // FIXME -- should we worry about a circular inheritance graph? - - std::list parents = parent_classes (*lit); - - if (! parents.empty ()) - retval.insert (retval.end (), parents.begin (), parents.end ()); - } - - return retval; - } - - static octave_user_function *get_curr_fcn (scope_id scope = xcurrent_scope) - { - symbol_table *inst = get_instance (scope); - return inst->curr_fcn; - } - - static void set_curr_fcn (octave_user_function *curr_fcn, - scope_id scope = xcurrent_scope) - { - assert (scope != xtop_scope && scope != xglobal_scope); - symbol_table *inst = get_instance (scope); - // FIXME: normally, functions should not usurp each other's scope. - // If for any incredible reason this is needed, call - // set_user_function (0, scope) first. This may cause problems with - // nested functions, as the curr_fcn of symbol_records must be updated. - assert (inst->curr_fcn == 0 || curr_fcn == 0); - inst->curr_fcn = curr_fcn; - } - - static void cleanup (void); - -private: - - // No copying! - - symbol_table (const symbol_table&); - - symbol_table& operator = (const symbol_table&); - - typedef std::map::const_iterator table_const_iterator; - typedef std::map::iterator table_iterator; - - typedef std::map::const_iterator global_table_const_iterator; - typedef std::map::iterator global_table_iterator; - - typedef std::map::const_iterator persistent_table_const_iterator; - typedef std::map::iterator persistent_table_iterator; - - typedef std::map::const_iterator all_instances_const_iterator; - typedef std::map::iterator all_instances_iterator; - - typedef std::map::const_iterator fcn_table_const_iterator; - typedef std::map::iterator fcn_table_iterator; - - // The scope of this symbol table. - scope_id my_scope; - - // Name for this table (usually the file name of the function - // corresponding to the scope); - std::string table_name; - - // Map from symbol names to symbol info. - std::map table; - - // Child nested functions. - std::vector nest_children; - - // Parent nested function (may be null). - symbol_table *nest_parent; - - // The associated user code (may be null). - octave_user_function *curr_fcn; - - // If true then no variables can be added. - bool static_workspace; - - // Map from names of global variables to values. - static std::map global_table; - - // Map from names of persistent variables to values. - std::map persistent_table; - - // Pointer to symbol table for current scope (variables only). - static symbol_table *instance; - - // Map from scope id to symbol table instances. - static std::map all_instances; - - // Map from function names to function info (subfunctions, private - // functions, class constructors, class methods, etc.) - static std::map fcn_table; - - // Mape from class names to set of classes that have lower - // precedence. - static std::map > class_precedence_table; - - typedef std::map >::const_iterator class_precedence_table_const_iterator; - typedef std::map >::iterator class_precedence_table_iterator; - - // Map from class names to parent class names. - static std::map > parent_map; - - typedef std::map >::const_iterator const_parent_map_iterator; - typedef std::map >::iterator parent_map_iterator; - - static const scope_id xglobal_scope; - static const scope_id xtop_scope; - - static scope_id xcurrent_scope; - - static context_id xcurrent_context; - - static const context_id xdefault_context = static_cast (-1); - - symbol_table (scope_id scope) - : my_scope (scope), table_name (), table (), nest_children (), nest_parent (0), - curr_fcn (0), static_workspace (false), persistent_table () { } - - ~symbol_table (void) { } - - static symbol_table *get_instance (scope_id scope, bool create = true) - { - symbol_table *retval = 0; - - bool ok = true; - - if (scope != xglobal_scope) - { - if (scope == xcurrent_scope) - { - if (! instance && create) - { - symbol_table *inst = new symbol_table (scope); - - if (inst) - { - all_instances[scope] = instance = inst; - - if (scope == xtop_scope) - instance->do_cache_name ("top-level"); - } - } - - if (! instance) - ok = false; - - retval = instance; - } - else - { - all_instances_iterator p = all_instances.find (scope); - - if (p == all_instances.end ()) - { - if (create) - { - retval = new symbol_table (scope); - - if (retval) - all_instances[scope] = retval; - else - ok = false; - } - else - ok = false; - } - else - retval = p->second; - } - } - - if (! ok) - error ("unable to %s symbol_table object for scope %d!", - create ? "create" : "find", scope); - - return retval; - } - - void add_nest_child (symbol_table& st) - { - assert (!st.nest_parent); - nest_children.push_back (&st); - st.nest_parent = this; - } - - void insert_symbol_record (const symbol_record& sr) - { - table[sr.name ()] = sr; - } - - void - do_dup_scope (symbol_table& new_symbol_table) const - { - for (table_const_iterator p = table.begin (); p != table.end (); p++) - new_symbol_table.insert_symbol_record (p->second.dup (new_symbol_table.my_scope)); - } - - symbol_record do_find_symbol (const std::string& name) - { - table_iterator p = table.find (name); - - if (p == table.end ()) - return do_insert (name); - else - return p->second; - } - - void do_inherit (symbol_table& donor_table, context_id donor_context) - { - for (table_iterator p = table.begin (); p != table.end (); p++) - { - symbol_record& sr = p->second; - - if (! (sr.is_automatic () || sr.is_formal ())) - { - std::string nm = sr.name (); - - if (nm != "__retval__") - { - octave_value val = donor_table.do_varval (nm, donor_context); - - if (val.is_defined ()) - { - sr.assign (val, 0); - - sr.mark_inherited (); - } - } - } - } - } - - static fcn_info *get_fcn_info (const std::string& name) - { - fcn_table_iterator p = fcn_table.find (name); - return p != fcn_table.end () ? &p->second : 0; - } - - octave_value - do_find (const std::string& name, const octave_value_list& args, - bool skip_variables, bool local_funcs); - - octave_value do_builtin_find (const std::string& name); - - symbol_record& do_insert (const std::string& name, bool force_add = false) - { - table_iterator p = table.find (name); - - if (p == table.end ()) - { - symbol_record ret (my_scope, name); - - if (nest_parent && nest_parent->look_nonlocal (name, ret)) - return table[name] = ret; - else - { - if (static_workspace && ! force_add) - ret.mark_added_static (); - - return table[name] = ret; - } - } - else - return p->second; - } - - void do_rename (const std::string& old_name, const std::string& new_name) - { - table_iterator p = table.find (old_name); - - if (p != table.end ()) - { - symbol_record sr = p->second; - - sr.rename (new_name); - - table.erase (p); - - table[new_name] = sr; - } - } - - void do_assign (const std::string& name, const octave_value& value, - context_id context, bool force_add) - { - table_iterator p = table.find (name); - - if (p == table.end ()) - { - symbol_record& sr = do_insert (name, force_add); - - sr.assign (value, context); - } - else - p->second.assign (value, context); - } - - // Use do_assign (name, value, context, force_add) instead. - // Delete when deprecated varref functions are removed. - octave_value& do_varref (const std::string& name, context_id context, - bool force_add) - { - table_iterator p = table.find (name); - - if (p == table.end ()) - { - symbol_record& sr = do_insert (name, force_add); - - return sr.varref (context); - } - else - return p->second.varref (context); - } - - octave_value do_varval (const std::string& name, context_id context) const - { - table_const_iterator p = table.find (name); - - return (p != table.end ()) ? p->second.varval (context) : octave_value (); - } - - void do_persistent_assign (const std::string& name, - const octave_value& value) - { - persistent_table_iterator p = persistent_table.find (name); - - if (p == persistent_table.end ()) - persistent_table[name] = value; - else - p->second = value; - } - - // Use do_persistent_assign (name, value) instead. - // Delete when deprecated varref functions are removed. - octave_value& do_persistent_varref (const std::string& name) - { - persistent_table_iterator p = persistent_table.find (name); - - return (p == persistent_table.end ()) - ? persistent_table[name] : p->second; - } - - octave_value do_persistent_varval (const std::string& name) - { - persistent_table_const_iterator p = persistent_table.find (name); - - return (p != persistent_table.end ()) ? p->second : octave_value (); - } - - void do_erase_persistent (const std::string& name) - { - persistent_table_iterator p = persistent_table.find (name); - - if (p != persistent_table.end ()) - persistent_table.erase (p); - } - - bool do_is_variable (const std::string& name) const - { - bool retval = false; - - table_const_iterator p = table.find (name); - - if (p != table.end ()) - { - const symbol_record& sr = p->second; - - retval = sr.is_variable (); - } - - return retval; - } - - void do_push_context (void) - { - for (table_iterator p = table.begin (); p != table.end (); p++) - p->second.push_context (my_scope); - } - - void do_pop_context (void) - { - table_iterator p = table.begin (); - - while (p != table.end ()) - { - if (p->second.pop_context (my_scope) == 0) - table.erase (p++); - else - p++; - } - } - - void do_clear_variables (void) - { - for (table_iterator p = table.begin (); p != table.end (); p++) - p->second.clear (my_scope); - } - - void do_clear_objects (void) - { - for (table_iterator p = table.begin (); p != table.end (); p++) - { - symbol_record& sr = p->second; - octave_value val = sr.varval (); - if (val.is_object ()) - p->second.clear (my_scope); - } - } - - void do_clear_global (const std::string& name) - { - table_iterator p = table.find (name); - - if (p != table.end ()) - { - symbol_record& sr = p->second; - - if (sr.is_global ()) - sr.unmark_global (); - } - - global_table_iterator q = global_table.find (name); - - if (q != global_table.end ()) - global_table.erase (q); - - } - - void do_clear_variable (const std::string& name) - { - table_iterator p = table.find (name); - - if (p != table.end ()) - p->second.clear (my_scope); - } - - void do_clear_global_pattern (const std::string& pat) - { - glob_match pattern (pat); - - for (table_iterator p = table.begin (); p != table.end (); p++) - { - symbol_record& sr = p->second; - - if (sr.is_global () && pattern.match (sr.name ())) - sr.unmark_global (); - } - - global_table_iterator q = global_table.begin (); - - while (q != global_table.end ()) - { - if (pattern.match (q->first)) - global_table.erase (q++); - else - q++; - } - - - } - - void do_clear_variable_pattern (const std::string& pat) - { - glob_match pattern (pat); - - for (table_iterator p = table.begin (); p != table.end (); p++) - { - symbol_record& sr = p->second; - - if (sr.is_defined () || sr.is_global ()) - { - if (pattern.match (sr.name ())) - sr.clear (my_scope); - } - } - } - - void do_clear_variable_regexp (const std::string& pat) - { - ::regexp pattern (pat); - - for (table_iterator p = table.begin (); p != table.end (); p++) - { - symbol_record& sr = p->second; - - if (sr.is_defined () || sr.is_global ()) - { - if (pattern.is_match (sr.name ())) - sr.clear (my_scope); - } - } - } - - void do_mark_automatic (const std::string& name) - { - do_insert (name).mark_automatic (); - } - - void do_mark_hidden (const std::string& name) - { - do_insert (name).mark_hidden (); - } - - void do_mark_global (const std::string& name) - { - do_insert (name).mark_global (); - } - - std::list - do_all_variables (context_id context, bool defined_only, - unsigned int exclude) const - { - std::list retval; - - for (table_const_iterator p = table.begin (); p != table.end (); p++) - { - const symbol_record& sr = p->second; - - if ((defined_only && ! sr.is_defined (context)) - || (sr.xstorage_class () & exclude)) - continue; - - retval.push_back (sr); - } - - return retval; - } - - std::list do_glob (const std::string& pattern, - bool vars_only = false) const - { - std::list retval; - - glob_match pat (pattern); - - for (table_const_iterator p = table.begin (); p != table.end (); p++) - { - if (pat.match (p->first)) - { - const symbol_record& sr = p->second; - - if (vars_only && ! sr.is_variable ()) - continue; - - retval.push_back (sr); - } - } - - return retval; - } - - std::list do_regexp (const std::string& pattern, - bool vars_only = false) const - { - std::list retval; - - ::regexp pat (pattern); - - for (table_const_iterator p = table.begin (); p != table.end (); p++) - { - if (pat.is_match (p->first)) - { - const symbol_record& sr = p->second; - - if (vars_only && ! sr.is_variable ()) - continue; - - retval.push_back (sr); - } - } - - return retval; - } - - std::list do_variable_names (void) - { - std::list retval; - - for (table_const_iterator p = table.begin (); p != table.end (); p++) - { - if (p->second.is_variable ()) - retval.push_back (p->first); - } - - retval.sort (); - - return retval; - } - - bool do_is_local_variable (const std::string& name) const - { - table_const_iterator p = table.find (name); - - return (p != table.end () - && ! p->second.is_global () - && p->second.is_defined ()); - } - - bool do_is_global (const std::string& name) const - { - table_const_iterator p = table.find (name); - - return p != table.end () && p->second.is_global (); - } - - std::list do_workspace_info (void) const; - - void do_dump (std::ostream& os); - - void do_cache_name (const std::string& name) { table_name = name; } - - void do_update_nest (void); - - bool look_nonlocal (const std::string& name, symbol_record& result) - { - table_iterator p = table.find (name); - if (p == table.end ()) - { - if (nest_parent) - return nest_parent->look_nonlocal (name, result); - } - else if (! p->second.is_automatic ()) - { - result = p->second; - return true; - } - - return false; - } -}; - -extern bool out_of_date_check (octave_value& function, - const std::string& dispatch_type = std::string (), - bool check_relative = true); - -extern OCTINTERP_API std::string -get_dispatch_type (const octave_value_list& args); -extern OCTINTERP_API std::string -get_dispatch_type (const octave_value_list& args, builtin_type_t& builtin_type); - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/sysdep.cc --- a/libinterp/interpfcn/sysdep.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,908 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include -#include -#include - -#include -#include - -#include -#include - -#if defined (HAVE_TERMIOS_H) -#include -#elif defined (HAVE_TERMIO_H) -#include -#elif defined (HAVE_SGTTY_H) -#include -#endif - -#if defined (HAVE_CONIO_H) -#include -#endif - -#if defined (HAVE_SYS_IOCTL_H) -#include -#endif - -#if defined (HAVE_FLOATINGPOINT_H) -#include -#endif - -#if defined (HAVE_IEEEFP_H) -#include -#endif - -#include "cmd-edit.h" -#include "file-ops.h" -#include "lo-mappers.h" -#include "lo-math.h" -#include "mach-info.h" -#include "oct-env.h" -#include "quit.h" - -#include "Cell.h" -#include "builtins.h" -#include "defun.h" -#include "error.h" -#include "input.h" -#include "oct-obj.h" -#include "ov.h" -#include "pager.h" -#include "parse.h" -#include "sighandlers.h" -#include "sysdep.h" -#include "toplev.h" -#include "utils.h" -#include "file-stat.h" - -#ifndef STDIN_FILENO -#define STDIN_FILENO 1 -#endif - -#if defined (__386BSD__) || defined (__FreeBSD__) || defined (__NetBSD__) -static void -BSD_init (void) -{ -#if defined (HAVE_FLOATINGPOINT_H) - // Disable trapping on common exceptions. -#ifndef FP_X_DNML -#define FP_X_DNML 0 -#endif - fpsetmask (~(FP_X_OFL|FP_X_INV|FP_X_DZ|FP_X_DNML|FP_X_UFL|FP_X_IMP)); -#endif -} -#endif - -#if defined (__WIN32__) && ! defined (_POSIX_VERSION) - -#define WIN32_LEAN_AND_MEAN -#include - -static void -w32_set_octave_home (void) -{ - std::string bin_dir; - - HANDLE h = CreateToolhelp32Snapshot (TH32CS_SNAPMODULE -#ifdef TH32CS_SNAPMODULE32 - | TH32CS_SNAPMODULE32 -#endif - , 0); - - if (h != INVALID_HANDLE_VALUE) - { - MODULEENTRY32 mod_info; - - ZeroMemory (&mod_info, sizeof (mod_info)); - mod_info.dwSize = sizeof (mod_info); - - if (Module32First (h, &mod_info)) - { - do - { - std::string mod_name (mod_info.szModule); - - if (mod_name.find ("octinterp") != std::string::npos) - { - bin_dir = mod_info.szExePath; - if (bin_dir[bin_dir.length () - 1] != '\\') - bin_dir.append (1, '\\'); - break; - } - } - while (Module32Next (h, &mod_info)); - } - - CloseHandle (h); - } - - if (! bin_dir.empty ()) - { - size_t pos = bin_dir.rfind ("\\bin\\"); - - if (pos != std::string::npos) - octave_env::putenv ("OCTAVE_HOME", bin_dir.substr (0, pos)); - } -} - -void -w32_set_quiet_shutdown (void) -{ - // Let the user close the console window or shutdown without the - // pesky dialog. - // - // FIXME -- should this be user configurable? - SetProcessShutdownParameters (0x280, SHUTDOWN_NORETRY); -} - -void -MINGW_signal_cleanup (void) -{ - w32_set_quiet_shutdown (); -} -#endif - -#if defined (__MINGW32__) -static void -MINGW_init (void) -{ - w32_set_octave_home (); -} -#endif - -#if defined (_MSC_VER) -static void -MSVC_init (void) -{ - w32_set_octave_home (); -} -#endif - - -// Return TRUE if FILE1 and FILE2 refer to the same (physical) file. - -bool -same_file_internal (const std::string& file1, const std::string& file2) -{ -#ifdef OCTAVE_USE_WINDOWS_API - - bool retval = false; - - const char *f1 = file1.c_str (); - const char *f2 = file2.c_str (); - - bool f1_is_dir = GetFileAttributes (f1) & FILE_ATTRIBUTE_DIRECTORY; - bool f2_is_dir = GetFileAttributes (f2) & FILE_ATTRIBUTE_DIRECTORY; - - // Windows native code - // Reference: http://msdn2.microsoft.com/en-us/library/aa363788.aspx - - DWORD share = FILE_SHARE_DELETE | FILE_SHARE_READ | FILE_SHARE_WRITE; - - HANDLE hfile1 - = CreateFile (f1, 0, share, 0, OPEN_EXISTING, - f1_is_dir ? FILE_FLAG_BACKUP_SEMANTICS : 0, 0); - - if (hfile1 != INVALID_HANDLE_VALUE) - { - HANDLE hfile2 - = CreateFile (f2, 0, share, 0, OPEN_EXISTING, - f2_is_dir ? FILE_FLAG_BACKUP_SEMANTICS : 0, 0); - - if (hfile2 != INVALID_HANDLE_VALUE) - { - BY_HANDLE_FILE_INFORMATION hfi1; - BY_HANDLE_FILE_INFORMATION hfi2; - - if (GetFileInformationByHandle (hfile1, &hfi1) - && GetFileInformationByHandle (hfile2, &hfi2)) - { - retval = (hfi1.dwVolumeSerialNumber == hfi2.dwVolumeSerialNumber - && hfi1.nFileIndexHigh == hfi2.nFileIndexHigh - && hfi1.nFileIndexLow == hfi2.nFileIndexLow); - } - - CloseHandle (hfile2); - } - - CloseHandle (hfile1); - } - - return retval; - -#else - - // POSIX Code - - file_stat fs_file1 (file1); - file_stat fs_file2 (file2); - - return (fs_file1 && fs_file2 - && fs_file1.ino () == fs_file2.ino () - && fs_file1.dev () == fs_file2.dev ()); - -#endif -} - -void -sysdep_init (void) -{ -#if defined (__386BSD__) || defined (__FreeBSD__) || defined (__NetBSD__) - BSD_init (); -#elif defined (__MINGW32__) - MINGW_init (); -#elif defined (_MSC_VER) - MSVC_init (); -#endif -} - -void -sysdep_cleanup (void) -{ - MINGW_SIGNAL_CLEANUP (); -} - -// Set terminal in raw mode. From less-177. -// -// Change terminal to "raw mode", or restore to "normal" mode. -// "Raw mode" means -// 1. An outstanding read will complete on receipt of a single keystroke. -// 2. Input is not echoed. -// 3. On output, \n is mapped to \r\n. -// 4. \t is NOT expanded into spaces. -// 5. Signal-causing characters such as ctrl-C (interrupt), -// etc. are NOT disabled. -// It doesn't matter whether an input \n is mapped to \r, or vice versa. - -void -raw_mode (bool on, bool wait) -{ - static bool curr_on = false; - - int tty_fd = STDIN_FILENO; - if (! gnulib::isatty (tty_fd)) - { - if (interactive) - error ("stdin is not a tty!"); - return; - } - - if (on == curr_on) - return; - -#if defined (HAVE_TERMIOS_H) - { - struct termios s; - static struct termios save_term; - - if (on) - { - // Get terminal modes. - - tcgetattr (tty_fd, &s); - - // Save modes and set certain variables dependent on modes. - - save_term = s; -// ospeed = s.c_cflag & CBAUD; -// erase_char = s.c_cc[VERASE]; -// kill_char = s.c_cc[VKILL]; - - // Set the modes to the way we want them. - - s.c_lflag &= ~(ICANON|ECHO|ECHOE|ECHOK|ECHONL); - s.c_oflag |= (OPOST|ONLCR); -#if defined (OCRNL) - s.c_oflag &= ~(OCRNL); -#endif -#if defined (ONOCR) - s.c_oflag &= ~(ONOCR); -#endif -#if defined (ONLRET) - s.c_oflag &= ~(ONLRET); -#endif - s.c_cc[VMIN] = wait ? 1 : 0; - s.c_cc[VTIME] = 0; - } - else - { - // Restore saved modes. - - s = save_term; - } - - tcsetattr (tty_fd, wait ? TCSAFLUSH : TCSADRAIN, &s); - } -#elif defined (HAVE_TERMIO_H) - { - struct termio s; - static struct termio save_term; - - if (on) - { - // Get terminal modes. - - ioctl (tty_fd, TCGETA, &s); - - // Save modes and set certain variables dependent on modes. - - save_term = s; -// ospeed = s.c_cflag & CBAUD; -// erase_char = s.c_cc[VERASE]; -// kill_char = s.c_cc[VKILL]; - - // Set the modes to the way we want them. - - s.c_lflag &= ~(ICANON|ECHO|ECHOE|ECHOK|ECHONL); - s.c_oflag |= (OPOST|ONLCR); -#if defined (OCRNL) - s.c_oflag &= ~(OCRNL); -#endif -#if defined (ONOCR) - s.c_oflag &= ~(ONOCR); -#endif -#if defined (ONLRET) - s.c_oflag &= ~(ONLRET); -#endif - s.c_cc[VMIN] = wait ? 1 : 0; - } - else - { - // Restore saved modes. - - s = save_term; - } - - ioctl (tty_fd, TCSETAW, &s); - } -#elif defined (HAVE_SGTTY_H) - { - struct sgttyb s; - static struct sgttyb save_term; - - if (on) - { - // Get terminal modes. - - ioctl (tty_fd, TIOCGETP, &s); - - // Save modes and set certain variables dependent on modes. - - save_term = s; -// ospeed = s.sg_ospeed; -// erase_char = s.sg_erase; -// kill_char = s.sg_kill; - - // Set the modes to the way we want them. - - s.sg_flags |= CBREAK; - s.sg_flags &= ~(ECHO); - } - else - { - // Restore saved modes. - - s = save_term; - } - - ioctl (tty_fd, TIOCSETN, &s); - } -#else - warning ("no support for raw mode console I/O on this system"); - - // Make sure the current mode doesn't toggle. - on = curr_on; -#endif - - curr_on = on; -} - -FILE * -octave_popen (const char *command, const char *mode) -{ -#if defined (__MINGW32__) || defined (_MSC_VER) - if (mode && mode[0] && ! mode[1]) - { - char tmode[3]; - tmode[0] = mode[0]; - tmode[1] = 'b'; - tmode[2] = 0; - - return _popen (command, tmode); - } - else - return _popen (command, mode); -#else - return popen (command, mode); -#endif -} - -int -octave_pclose (FILE *f) -{ -#if defined (__MINGW32__) || defined (_MSC_VER) - return _pclose (f); -#else - return pclose (f); -#endif -} - -// Read one character from the terminal. - -int -octave_kbhit (bool wait) -{ -#ifdef HAVE__KBHIT - int c = (! wait && ! _kbhit ()) ? 0 : std::cin.get (); -#else - raw_mode (true, wait); - - // Get current handler. - octave_interrupt_handler saved_interrupt_handler - = octave_ignore_interrupts (); - - // Restore it, disabling system call restarts (if possible) so the - // read can be interrupted. - - octave_set_interrupt_handler (saved_interrupt_handler, false); - - int c = std::cin.get (); - - if (std::cin.fail () || std::cin.eof ()) - std::cin.clear (); - - // Restore it, enabling system call restarts (if possible). - octave_set_interrupt_handler (saved_interrupt_handler, true); - - raw_mode (false, true); -#endif - - return c; -} - -std::string -get_P_tmpdir (void) -{ -#if defined (__WIN32__) && ! defined (_POSIX_VERSION) - - std::string retval; - -#if defined (P_tmpdir) - retval = P_tmpdir; -#endif - - // Apparently some versions of MinGW and MSVC either don't define - // P_tmpdir, or they define it to a single backslash, neither of which - // is particularly helpful. - - if (retval.empty () || retval == "\\") - { - retval = octave_env::getenv ("TEMP"); - - if (retval.empty ()) - retval = octave_env::getenv ("TMP"); - - if (retval.empty ()) - retval = "c:\\temp"; - } - - return retval; - -#elif defined (P_tmpdir) - - return P_tmpdir; - -#else - - return "/tmp"; - -#endif -} - -DEFUN (clc, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} clc ()\n\ -@deftypefnx {Built-in Function} {} home ()\n\ -Clear the terminal screen and move the cursor to the upper left corner.\n\ -@end deftypefn") -{ - bool skip_redisplay = true; - - command_editor::clear_screen (skip_redisplay); - - return octave_value_list (); -} - -DEFALIAS (home, clc); - -DEFUN (getenv, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} getenv (@var{var})\n\ -Return the value of the environment variable @var{var}. For example,\n\ -\n\ -@example\n\ -getenv (\"PATH\")\n\ -@end example\n\ -\n\ -@noindent\n\ -returns a string containing the value of your path.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - std::string name = args(0).string_value (); - - if (! error_state) - retval = octave_env::getenv (name); - } - else - print_usage (); - - return retval; -} - -DEFUN (putenv, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} putenv (@var{var}, @var{value})\n\ -@deftypefnx {Built-in Function} {} setenv (@var{var}, @var{value})\n\ -Set the value of the environment variable @var{var} to @var{value}.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 2 || nargin == 1) - { - std::string var = args(0).string_value (); - - if (! error_state) - { - std::string val = (nargin == 2 - ? args(1).string_value () : std::string ()); - - if (! error_state) - octave_env::putenv (var, val); - else - error ("putenv: VALUE must be a string"); - } - else - error ("putenv: VAR must be a string"); - } - else - print_usage (); - - return retval; -} - -DEFALIAS (setenv, putenv); - -/* -%!assert (ischar (getenv ("OCTAVE_HOME"))) -%!test -%! setenv ("dummy_variable_that_cannot_matter", "foobar"); -%! assert (getenv ("dummy_variable_that_cannot_matter"), "foobar"); -*/ - -// FIXME -- perhaps kbhit should also be able to print a prompt? - -DEFUN (kbhit, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} kbhit ()\n\ -@deftypefnx {Built-in Function} {} kbhit (1)\n\ -Read a single keystroke from the keyboard. If called with an\n\ -argument, don't wait for a keypress. For example,\n\ -\n\ -@example\n\ -x = kbhit ();\n\ -@end example\n\ -\n\ -@noindent\n\ -will set @var{x} to the next character typed at the keyboard as soon as\n\ -it is typed.\n\ -\n\ -@example\n\ -x = kbhit (1);\n\ -@end example\n\ -\n\ -@noindent\n\ -is identical to the above example, but doesn't wait for a keypress,\n\ -returning the empty string if no key is available.\n\ -@seealso{input}\n\ -@end deftypefn") -{ - octave_value retval; - - // FIXME -- add timeout and default value args? - - if (interactive || forced_interactive) - { - Fdrawnow (); - - int c = octave_kbhit (args.length () == 0); - - if (c == -1) - c = 0; - - char s[2] = { static_cast (c), '\0' }; - - retval = s; - } - - return retval; -} - -DEFUN (pause, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} pause (@var{seconds})\n\ -Suspend the execution of the program. If invoked without any arguments,\n\ -Octave waits until you type a character. With a numeric argument, it\n\ -pauses for the given number of seconds. For example, the following\n\ -statement prints a message and then waits 5 seconds before clearing the\n\ -screen.\n\ -\n\ -@example\n\ -@group\n\ -fprintf (stderr, \"wait please...\\n\");\n\ -pause (5);\n\ -clc;\n\ -@end group\n\ -@end example\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (! (nargin == 0 || nargin == 1)) - { - print_usage (); - return retval; - } - - if (nargin == 1) - { - double dval = args(0).double_value (); - - if (! error_state) - { - if (! xisnan (dval)) - { - Fdrawnow (); - - if (xisinf (dval)) - { - flush_octave_stdout (); - octave_kbhit (); - } - else - octave_sleep (dval); - } - else - warning ("pause: NaN is an invalid delay"); - } - } - else - { - Fdrawnow (); - flush_octave_stdout (); - octave_kbhit (); - } - - return retval; -} - -/* -%!test -%! pause (1); - -%!error (pause (1, 2)) -*/ - -DEFUN (sleep, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} sleep (@var{seconds})\n\ -Suspend the execution of the program for the given number of seconds.\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - double dval = args(0).double_value (); - - if (! error_state) - { - if (xisnan (dval)) - warning ("sleep: NaN is an invalid delay"); - else - { - Fdrawnow (); - octave_sleep (dval); - } - } - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! sleep (1); - -%!error (sleep ()) -%!error (sleep (1, 2)) -*/ - -DEFUN (usleep, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} usleep (@var{microseconds})\n\ -Suspend the execution of the program for the given number of\n\ -microseconds. On systems where it is not possible to sleep for periods\n\ -of time less than one second, @code{usleep} will pause the execution for\n\ -@code{round (@var{microseconds} / 1e6)} seconds.\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - double dval = args(0).double_value (); - - if (! error_state) - { - if (xisnan (dval)) - warning ("usleep: NaN is an invalid delay"); - else - { - Fdrawnow (); - - int delay = NINT (dval); - - if (delay > 0) - octave_usleep (delay); - } - } - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! usleep (1000); - -%!error (usleep ()) -%!error (usleep (1, 2)) -*/ - -// FIXME -- maybe this should only return 1 if IEEE floating -// point functions really work. - -DEFUN (isieee, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isieee ()\n\ -Return true if your computer @emph{claims} to conform to the IEEE standard\n\ -for floating point calculations. No actual tests are performed.\n\ -@end deftypefn") -{ - oct_mach_info::float_format flt_fmt = oct_mach_info::native_float_format (); - - return octave_value (flt_fmt == oct_mach_info::flt_fmt_ieee_little_endian - || flt_fmt == oct_mach_info::flt_fmt_ieee_big_endian); -} - -/* -%!assert (islogical (isieee ())) -*/ - -DEFUN (native_float_format, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} native_float_format ()\n\ -Return the native floating point format as a string\n\ -@end deftypefn") -{ - oct_mach_info::float_format flt_fmt = oct_mach_info::native_float_format (); - - return octave_value (oct_mach_info::float_format_as_string (flt_fmt)); -} - -/* -%!assert (ischar (native_float_format ())) -*/ - -DEFUN (tilde_expand, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} tilde_expand (@var{string})\n\ -Perform tilde expansion on @var{string}. If @var{string} begins with a\n\ -tilde character, (@samp{~}), all of the characters preceding the first\n\ -slash (or all characters, if there is no slash) are treated as a\n\ -possible user name, and the tilde and the following characters up to the\n\ -slash are replaced by the home directory of the named user. If the\n\ -tilde is followed immediately by a slash, the tilde is replaced by the\n\ -home directory of the user running Octave. For example:\n\ -\n\ -@example\n\ -@group\n\ -tilde_expand (\"~joeuser/bin\")\n\ - @result{} \"/home/joeuser/bin\"\n\ -tilde_expand (\"~/bin\")\n\ - @result{} \"/home/jwe/bin\"\n\ -@end group\n\ -@end example\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - octave_value arg = args(0); - - string_vector sv = arg.all_strings (); - - if (! error_state) - { - sv = file_ops::tilde_expand (sv); - - if (arg.is_cellstr ()) - retval = Cell (arg.dims (), sv); - else - retval = sv; - } - else - error ("tilde_expand: expecting argument to be char or cellstr object"); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! if (isempty (getenv ("HOME"))) -%! setenv ("HOME", "foobar"); -%! endif -%! home = getenv ("HOME"); -%! assert (tilde_expand ("~/foobar"), strcat (home, "/foobar")); -%! assert (tilde_expand ("/foo/bar"), "/foo/bar"); -%! assert (tilde_expand ("foo/bar"), "foo/bar"); -*/ diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/sysdep.h --- a/libinterp/interpfcn/sysdep.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,57 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_sysdep_h) -#define octave_sysdep_h 1 - -#include - -#include - -#include "lo-ieee.h" -#include "lo-sysdep.h" - -extern OCTINTERP_API void sysdep_init (void); - -extern OCTINTERP_API void sysdep_cleanup (void); - -extern OCTINTERP_API void raw_mode (bool, bool wait = true); - -extern OCTINTERP_API FILE *octave_popen (const char *command, const char *mode); -extern OCTINTERP_API int octave_pclose (FILE *f); - -extern OCTINTERP_API int octave_kbhit (bool wait = true); - -extern OCTINTERP_API std::string get_P_tmpdir (void); - -extern void w32_set_quiet_shutdown (void); - -#if defined (__WIN32__) && ! defined (_POSIX_VERSION) -extern void MINGW_signal_cleanup (void); -#define MINGW_SIGNAL_CLEANUP() MINGW_signal_cleanup () -#else -#define MINGW_SIGNAL_CLEANUP() do { } while (0) -#endif - -extern OCTINTERP_API bool same_file_internal (const std::string&, const std::string&); - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/toplev.cc --- a/libinterp/interpfcn/toplev.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1552 +0,0 @@ -/* - -Copyright (C) 1995-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include -#include -#include - -#include -#include -#include -#include - -#include -#include -#include - -#include "cmd-edit.h" -#include "cmd-hist.h" -#include "file-ops.h" -#include "lo-error.h" -#include "lo-mappers.h" -#include "oct-env.h" -#include "oct-locbuf.h" -#include "quit.h" -#include "singleton-cleanup.h" -#include "str-vec.h" - -#include "defaults.h" -#include "defun.h" -#include "error.h" -#include "file-io.h" -#include "graphics.h" -#include "input.h" -#include "lex.h" -#include "octave-link.h" -#include "oct-conf.h" -#include "oct-conf-features.h" -#include "oct-hist.h" -#include "oct-map.h" -#include "oct-obj.h" -#include "ov.h" -#include "pager.h" -#include "parse.h" -#include "pathsearch.h" -#include "procstream.h" -#include "pt-eval.h" -#include "pt-jump.h" -#include "pt-stmt.h" -#include "sighandlers.h" -#include "sysdep.h" -#include "syswait.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" -#include "version.h" - -#ifndef SHELL_PATH -#define SHELL_PATH "/bin/sh" -#endif - -void (*octave_exit) (int) = ::exit; - -// TRUE means the quit() call is allowed. -bool quit_allowed = true; - -// TRUE means we are exiting via the builtin exit or quit functions. -bool quitting_gracefully = false; -// This stores the exit status. -int exit_status = 0; - -// TRUE means we are ready to interpret commands, but not everything -// is ready for interactive use. -bool octave_interpreter_ready = false; - -// TRUE means we've processed all the init code and we are good to go. -bool octave_initialized = false; - -octave_call_stack *octave_call_stack::instance = 0; - -void -octave_call_stack::create_instance (void) -{ - instance = new octave_call_stack (); - - if (instance) - { - instance->do_push (0, symbol_table::top_scope (), 0); - - singleton_cleanup_list::add (cleanup_instance); - } -} - -int -octave_call_stack::do_current_line (void) const -{ - int retval = -1; - - if (! cs.empty ()) - { - const call_stack_elt& elt = cs[curr_frame]; - retval = elt.line; - } - - return retval; -} - -int -octave_call_stack::do_current_column (void) const -{ - int retval = -1; - - if (! cs.empty ()) - { - const call_stack_elt& elt = cs[curr_frame]; - retval = elt.column; - } - - return retval; -} - -int -octave_call_stack::do_caller_user_code_line (void) const -{ - int retval = -1; - - const_iterator p = cs.end (); - - while (p != cs.begin ()) - { - const call_stack_elt& elt = *(--p); - - octave_function *f = elt.fcn; - - if (f && f->is_user_code ()) - { - if (elt.line > 0) - { - retval = elt.line; - break; - } - } - } - - return retval; -} - -int -octave_call_stack::do_caller_user_code_column (void) const -{ - int retval = -1; - - const_iterator p = cs.end (); - - while (p != cs.begin ()) - { - const call_stack_elt& elt = *(--p); - - octave_function *f = elt.fcn; - - if (f && f->is_user_code ()) - { - if (elt.column) - { - retval = elt.column; - break; - } - } - } - - return retval; -} - -size_t -octave_call_stack::do_num_user_code_frames (octave_idx_type& curr_user_frame) const -{ - size_t retval = 0; - - curr_user_frame = 0; - - // Look for the caller of dbstack. - size_t frame = cs[curr_frame].prev; - - bool found = false; - - size_t k = cs.size (); - - for (const_reverse_iterator p = cs.rbegin (); p != cs.rend (); p++) - { - octave_function *f = (*p).fcn; - - if (--k == frame) - found = true; - - if (f && f->is_user_code ()) - { - if (! found) - curr_user_frame++; - - retval++; - } - } - - // We counted how many user frames were not the one, in reverse. - // Now set curr_user_frame to be the index in the other direction. - curr_user_frame = retval - curr_user_frame - 1; - - return retval; -} - -octave_user_code * -octave_call_stack::do_caller_user_code (size_t nskip) const -{ - octave_user_code *retval = 0; - - const_iterator p = cs.end (); - - while (p != cs.begin ()) - { - const call_stack_elt& elt = *(--p); - - octave_function *f = elt.fcn; - - if (f && f->is_user_code ()) - { - if (nskip > 0) - nskip--; - else - { - retval = dynamic_cast (f); - break; - } - } - } - - return retval; -} - -// Use static fields for the best efficiency. -// NOTE: C++0x will allow these two to be merged into one. -static const char *bt_fieldnames[] = { "file", "name", "line", - "column", "scope", "context", 0 }; -static const octave_fields bt_fields (bt_fieldnames); - -octave_map -octave_call_stack::empty_backtrace (void) -{ - return octave_map (dim_vector (0, 1), bt_fields); -} - -octave_map -octave_call_stack::do_backtrace (size_t nskip, - octave_idx_type& curr_user_frame) const -{ - size_t user_code_frames = do_num_user_code_frames (curr_user_frame); - - size_t nframes = nskip <= user_code_frames ? user_code_frames - nskip : 0; - - // Our list is reversed. - curr_user_frame = nframes - curr_user_frame - 1; - - octave_map retval (dim_vector (nframes, 1), bt_fields); - - Cell& file = retval.contents (0); - Cell& name = retval.contents (1); - Cell& line = retval.contents (2); - Cell& column = retval.contents (3); - Cell& scope = retval.contents (4); - Cell& context = retval.contents (5); - - if (nframes > 0) - { - int k = 0; - - for (const_reverse_iterator p = cs.rbegin (); p != cs.rend (); p++) - { - const call_stack_elt& elt = *p; - - octave_function *f = elt.fcn; - - if (f && f->is_user_code ()) - { - if (nskip > 0) - nskip--; - else - { - scope(k) = elt.scope; - context(k) = elt.context; - - file(k) = f->fcn_file_name (); - std::string parent_fcn_name = f->parent_fcn_name (); - if (parent_fcn_name == std::string ()) - name(k) = f->name (); - else - name(k) = f->parent_fcn_name () + Vfilemarker + f->name (); - - line(k) = elt.line; - column(k) = elt.column; - - k++; - } - } - } - } - - return retval; -} - -bool -octave_call_stack::do_goto_frame (size_t n, bool verbose) -{ - bool retval = false; - - if (n < cs.size ()) - { - retval = true; - - curr_frame = n; - - const call_stack_elt& elt = cs[n]; - - symbol_table::set_scope_and_context (elt.scope, elt.context); - - if (verbose) - { - octave_function *f = elt.fcn; - std::string nm = f ? f->name () : std::string (""); - - octave_stdout << "stopped in " << nm - << " at line " << elt.line - << " column " << elt.column - << " (" << elt.scope << "[" << elt.context << "])" - << std::endl; - } - } - - return retval; -} - -bool -octave_call_stack::do_goto_frame_relative (int nskip, bool verbose) -{ - bool retval = false; - - int incr = 0; - - if (nskip < 0) - incr = -1; - else if (nskip > 0) - incr = 1; - - // Start looking with the caller of dbup/dbdown/keyboard. - size_t frame = cs[curr_frame].prev; - - while (true) - { - if ((incr < 0 && frame == 0) || (incr > 0 && frame == cs.size () - 1)) - break; - - frame += incr; - - const call_stack_elt& elt = cs[frame]; - - octave_function *f = elt.fcn; - - if (frame == 0 || (f && f->is_user_code ())) - { - if (nskip > 0) - nskip--; - else if (nskip < 0) - nskip++; - - if (nskip == 0) - { - curr_frame = frame; - cs[cs.size () - 1].prev = curr_frame; - - symbol_table::set_scope_and_context (elt.scope, elt.context); - - if (verbose) - { - std::ostringstream buf; - - if (f) - buf << "stopped in " << f->name () - << " at line " << elt.line << std::endl; - else - buf << "at top level" << std::endl; - - octave_stdout << buf.str (); - } - - retval = true; - break; - } - } - - // There is no need to set scope and context here. That will - // happen when the dbup/dbdown/keyboard frame is popped and we - // jump to the new "prev" frame set above. - } - - return retval; -} - -void -octave_call_stack::do_goto_caller_frame (void) -{ - size_t frame = curr_frame; - - bool skipped = false; - - while (frame != 0) - { - frame = cs[frame].prev; - - const call_stack_elt& elt = cs[frame]; - - octave_function *f = elt.fcn; - - if (frame == 0 || (f && f->is_user_code ())) - { - if (! skipped) - // We found the current user code frame, so skip it. - skipped = true; - else - { - // We found the caller user code frame. - call_stack_elt tmp (elt); - tmp.prev = curr_frame; - - curr_frame = cs.size (); - - cs.push_back (tmp); - - symbol_table::set_scope_and_context (tmp.scope, tmp.context); - - break; - } - } - } -} - -void -octave_call_stack::do_goto_base_frame (void) -{ - call_stack_elt tmp (cs[0]); - tmp.prev = curr_frame; - - curr_frame = cs.size (); - - cs.push_back (tmp); - - symbol_table::set_scope_and_context (tmp.scope, tmp.context); -} - -void -octave_call_stack::do_backtrace_error_message (void) const -{ - if (error_state > 0) - { - error_state = -1; - - error ("called from:"); - } - - if (! cs.empty ()) - { - const call_stack_elt& elt = cs.back (); - - octave_function *fcn = elt.fcn; - - std::string fcn_name = "?unknown?"; - - if (fcn) - { - fcn_name = fcn->fcn_file_name (); - - if (fcn_name.empty ()) - fcn_name = fcn->name (); - } - - error (" %s at line %d, column %d", - fcn_name.c_str (), elt.line, elt.column); - } -} - -void -recover_from_exception (void) -{ - can_interrupt = true; - octave_interrupt_immediately = 0; - octave_interrupt_state = 0; - octave_signal_caught = 0; - octave_exception_state = octave_no_exception; - octave_restore_signal_mask (); - octave_catch_interrupts (); -} - -int -main_loop (void) -{ - octave_save_signal_mask (); - - can_interrupt = true; - - octave_signal_hook = octave_signal_handler; - octave_interrupt_hook = 0; - octave_bad_alloc_hook = 0; - - octave_catch_interrupts (); - - octave_initialized = true; - - // The big loop. - - unwind_protect frame; - - // octave_parser constructor sets this for us. - frame.protect_var (LEXER); - - octave_lexer *lxr = ((interactive || forced_interactive) - ? new octave_lexer () - : new octave_lexer (stdin)); - - octave_parser parser (*lxr); - - int retval = 0; - do - { - try - { - unwind_protect inner_frame; - - reset_error_handler (); - - parser.reset (); - - if (symbol_table::at_top_level ()) - tree_evaluator::reset_debug_state (); - - retval = parser.run (); - - if (retval == 0) - { - if (parser.stmt_list) - { - parser.stmt_list->accept (*current_evaluator); - - octave_quit (); - - if (! (interactive || forced_interactive)) - { - bool quit = (tree_return_command::returning - || tree_break_command::breaking); - - if (tree_return_command::returning) - tree_return_command::returning = 0; - - if (tree_break_command::breaking) - tree_break_command::breaking--; - - if (quit) - break; - } - - if (error_state) - { - if (! (interactive || forced_interactive)) - { - // We should exit with a non-zero status. - retval = 1; - break; - } - } - else - { - if (octave_completion_matches_called) - octave_completion_matches_called = false; - else - command_editor::increment_current_command_number (); - } - } - else if (parser.lexer.end_of_input) - break; - } - } - catch (octave_interrupt_exception) - { - recover_from_exception (); - octave_stdout << "\n"; - if (quitting_gracefully) - return exit_status; - } - catch (octave_execution_exception) - { - recover_from_exception (); - std::cerr - << "error: unhandled execution exception -- trying to return to prompt" - << std::endl; - } - catch (std::bad_alloc) - { - recover_from_exception (); - std::cerr - << "error: out of memory -- trying to return to prompt" - << std::endl; - } - } - while (retval == 0); - - return retval; -} - -// Fix up things before exiting. - -static std::list octave_atexit_functions; - -static void -do_octave_atexit (void) -{ - static bool deja_vu = false; - - OCTAVE_SAFE_CALL (remove_input_event_hook_functions, ()); - - while (! octave_atexit_functions.empty ()) - { - std::string fcn = octave_atexit_functions.front (); - - octave_atexit_functions.pop_front (); - - OCTAVE_SAFE_CALL (reset_error_handler, ()); - - OCTAVE_SAFE_CALL (feval, (fcn, octave_value_list (), 0)); - - OCTAVE_SAFE_CALL (flush_octave_stdout, ()); - } - - if (! deja_vu) - { - deja_vu = true; - - // Process pending events and disasble octave_link event - // processing with this call. - - octave_link::process_events (true); - - // Do this explicitly so that destructors for mex file objects - // are called, so that functions registered with mexAtExit are - // called. - OCTAVE_SAFE_CALL (clear_mex_functions, ()); - - OCTAVE_SAFE_CALL (command_editor::restore_terminal_state, ()); - - // FIXME -- is this needed? Can it cause any trouble? - OCTAVE_SAFE_CALL (raw_mode, (0)); - - OCTAVE_SAFE_CALL (octave_history_write_timestamp, ()); - - if (! command_history::ignoring_entries ()) - OCTAVE_SAFE_CALL (command_history::clean_up_and_save, ()); - - OCTAVE_SAFE_CALL (gh_manager::close_all_figures, ()); - - OCTAVE_SAFE_CALL (gtk_manager::unload_all_toolkits, ()); - - OCTAVE_SAFE_CALL (close_files, ()); - - OCTAVE_SAFE_CALL (cleanup_tmp_files, ()); - - OCTAVE_SAFE_CALL (symbol_table::cleanup, ()); - - OCTAVE_SAFE_CALL (sysdep_cleanup, ()); - - OCTAVE_SAFE_CALL (flush_octave_stdout, ()); - - if (! quitting_gracefully && (interactive || forced_interactive)) - { - octave_stdout << "\n"; - - // Yes, we want this to be separate from the call to - // flush_octave_stdout above. - - OCTAVE_SAFE_CALL (flush_octave_stdout, ()); - } - - // Don't call singleton_cleanup_list::cleanup until we have the - // problems with registering/unregistering types worked out. For - // example, uncomment the following line, then use the make_int - // function from the examples directory to create an integer - // object and then exit Octave. Octave should crash with a - // segfault when cleaning up the typinfo singleton. We need some - // way to force new octave_value_X types that are created in - // .oct files to be unregistered when the .oct file shared library - // is unloaded. - // - // OCTAVE_SAFE_CALL (singleton_cleanup_list::cleanup, ()); - - OCTAVE_SAFE_CALL (octave_chunk_buffer::clear, ()); - } -} - -void -clean_up_and_exit (int retval, bool safe_to_return) -{ - do_octave_atexit (); - - if (octave_link::exit (retval)) - { - if (safe_to_return) - return; - else - { - // What should we do here? We might be called from some - // location other than the end of octave_execute_interpreter, - // so it might not be safe to return. - - // We have nothing else to do at this point, and the - // octave_link::exit function is supposed to take care of - // exiting for us. Assume that job won't take more than a - // day... - - gnulib::sleep (86400); - } - } - else - { - if (octave_exit) - (*octave_exit) (retval == EOF ? 0 : retval); - } -} - -DEFUN (quit, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} exit (@var{status})\n\ -@deftypefnx {Built-in Function} {} quit (@var{status})\n\ -Exit the current Octave session. If the optional integer value\n\ -@var{status} is supplied, pass that value to the operating system as the\n\ -Octave's exit status. The default value is zero.\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (! quit_allowed) - error ("quit: not supported in embedded mode"); - else - { - if (args.length () > 0) - { - int tmp = args(0).nint_value (); - - if (! error_state) - exit_status = tmp; - } - - if (! error_state) - { - // Instead of simply calling exit, we simulate an interrupt - // with a request to exit cleanly so that no matter where the - // call to quit occurs, we will run the unwind_protect stack, - // clear the OCTAVE_LOCAL_BUFFER allocations, etc. before - // exiting. - - quitting_gracefully = true; - - octave_interrupt_state = -1; - - octave_throw_interrupt_exception (); - } - } - - return retval; -} - -DEFALIAS (exit, quit); - -DEFUN (warranty, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} warranty ()\n\ -Describe the conditions for copying and distributing Octave.\n\ -@end deftypefn") -{ - octave_value_list retval; - - octave_stdout << "\n" \ - OCTAVE_NAME_VERSION_AND_COPYRIGHT "\n\ -\n\ -GNU Octave free software; you can redistribute it and/or modify\n\ -it under the terms of the GNU General Public License as published by\n\ -the Free Software Foundation; either version 3 of the License, or\n\ -(at your option) any later version.\n\ -\n\ -GNU Octave is distributed in the hope that it will be useful,\n\ -but WITHOUT ANY WARRANTY; without even the implied warranty of\n\ -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n\ -GNU General Public License for more details.\n\ -\n\ -You should have received a copy of the GNU General Public License\n\ -along with this program. If not, see .\n\ -\n"; - - return retval; -} - -// Execute a shell command. - -static int -wait_for_input (int fid) -{ - int retval = -1; - -#if defined (HAVE_SELECT) - if (fid >= 0) - { - fd_set set; - - FD_ZERO (&set); - FD_SET (fid, &set); - - retval = gnulib::select (FD_SETSIZE, &set, 0, 0, 0); - } -#else - retval = 1; -#endif - - return retval; -} - -static octave_value_list -run_command_and_return_output (const std::string& cmd_str) -{ - octave_value_list retval; - unwind_protect frame; - - iprocstream *cmd = new iprocstream (cmd_str.c_str ()); - - frame.add_delete (cmd); - frame.add_fcn (octave_child_list::remove, cmd->pid ()); - - if (*cmd) - { - int fid = cmd->file_number (); - - std::ostringstream output_buf; - - char ch; - - for (;;) - { - if (cmd->get (ch)) - output_buf.put (ch); - else - { - if (! cmd->eof () && errno == EAGAIN) - { - cmd->clear (); - - if (wait_for_input (fid) != 1) - break; - } - else - break; - } - } - - int cmd_status = cmd->close (); - - if (octave_wait::ifexited (cmd_status)) - cmd_status = octave_wait::exitstatus (cmd_status); - else - cmd_status = 127; - - retval(1) = output_buf.str (); - retval(0) = cmd_status; - } - else - error ("unable to start subprocess for '%s'", cmd_str.c_str ()); - - return retval; -} - -enum system_exec_type { et_sync, et_async }; - -DEFUN (system, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} system (\"@var{string}\")\n\ -@deftypefnx {Built-in Function} {} system (\"@var{string}\", @var{return_output})\n\ -@deftypefnx {Built-in Function} {} system (\"@var{string}\", @var{return_output}, @var{type})\n\ -@deftypefnx {Built-in Function} {[@var{status}, @var{output}] =} system (@dots{})\n\ -Execute a shell command specified by @var{string}.\n\ -If the optional argument @var{type} is \"async\", the process\n\ -is started in the background and the process ID of the child process\n\ -is returned immediately. Otherwise, the child process is started and\n\ -Octave waits until it exits. If the @var{type} argument is omitted, it\n\ -defaults to the value \"sync\".\n\ -\n\ -If @var{system} is called with one or more output arguments, or if the\n\ -optional argument @var{return_output} is true and the subprocess is started\n\ -synchronously, then the output from the command is returned as a variable. \n\ -Otherwise, if the subprocess is executed synchronously, its output is sent\n\ -to the standard output. To send the output of a command executed with\n\ -@code{system} through the pager, use a command like\n\ -\n\ -@example\n\ -@group\n\ -[output, text] = system (\"cmd\");\n\ -disp (text);\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -or\n\ -\n\ -@example\n\ -printf (\"%s\\n\", nthargout (2, \"system\", \"cmd\"));\n\ -@end example\n\ -\n\ -The @code{system} function can return two values. The first is the\n\ -exit status of the command and the second is any output from the\n\ -command that was written to the standard output stream. For example,\n\ -\n\ -@example\n\ -[status, output] = system (\"echo foo; exit 2\");\n\ -@end example\n\ -\n\ -@noindent\n\ -will set the variable @code{output} to the string @samp{foo}, and the\n\ -variable @code{status} to the integer @samp{2}.\n\ -\n\ -For commands run asynchronously, @var{status} is the process id of the\n\ -command shell that is started to run the command.\n\ -@seealso{unix, dos}\n\ -@end deftypefn") -{ - octave_value_list retval; - - unwind_protect frame; - - int nargin = args.length (); - - if (nargin > 0 && nargin < 4) - { - bool return_output = (nargin == 1 && nargout > 1); - - system_exec_type type = et_sync; - - if (nargin == 3) - { - std::string type_str = args(2).string_value (); - - if (! error_state) - { - if (type_str == "sync") - type = et_sync; - else if (type_str == "async") - type = et_async; - else - { - error ("system: TYPE must be \"sync\" or \"async\""); - return retval; - } - } - else - { - error ("system: TYPE must be a character string"); - return retval; - } - } - - if (nargin > 1) - { - return_output = args(1).is_true (); - - if (error_state) - { - error ("system: RETURN_OUTPUT must be boolean value true or false"); - return retval; - } - } - - if (return_output && type == et_async) - { - error ("system: can't return output from commands run asynchronously"); - return retval; - } - - std::string cmd_str = args(0).string_value (); - - if (! error_state) - { -#if defined (__WIN32__) && ! defined (__CYGWIN__) - // Work around weird double-quote handling on Windows systems. - if (type == et_sync) - cmd_str = "\"" + cmd_str + "\""; -#endif - - if (type == et_async) - { - // FIXME -- maybe this should go in sysdep.cc? -#ifdef HAVE_FORK - pid_t pid = fork (); - - if (pid < 0) - error ("system: fork failed -- can't create child process"); - else if (pid == 0) - { - // FIXME -- should probably replace this - // call with something portable. - - execl (SHELL_PATH, "sh", "-c", cmd_str.c_str (), - static_cast (0)); - - panic_impossible (); - } - else - retval(0) = pid; -#elif defined (__WIN32__) - STARTUPINFO si; - PROCESS_INFORMATION pi; - ZeroMemory (&si, sizeof (si)); - ZeroMemory (&pi, sizeof (pi)); - OCTAVE_LOCAL_BUFFER (char, xcmd_str, cmd_str.length ()+1); - strcpy (xcmd_str, cmd_str.c_str ()); - - if (! CreateProcess (0, xcmd_str, 0, 0, FALSE, 0, 0, 0, &si, &pi)) - error ("system: CreateProcess failed -- can't create child process"); - else - { - retval(0) = pi.dwProcessId; - CloseHandle (pi.hProcess); - CloseHandle (pi.hThread); - } -#else - error ("asynchronous system calls are not supported"); -#endif - } - else if (return_output) - retval = run_command_and_return_output (cmd_str); - else - { - int status = system (cmd_str.c_str ()); - - // The value in status is as returned by waitpid. If - // the process exited normally, extract the actual exit - // status of the command. Otherwise, return 127 as a - // failure code. - - if (octave_wait::ifexited (status)) - status = octave_wait::exitstatus (status); - - retval(0) = status; - } - } - else - error ("system: expecting string as first argument"); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! cmd = ls_command (); -%! [status, output] = system (cmd); -%! assert (status, 0); -%! assert (ischar (output)); -%! assert (! isempty (output)); - -%!error system () -%!error system (1, 2, 3) -*/ - -void -octave_add_atexit_function (const std::string& fname) -{ - octave_atexit_functions.push_front (fname); -} - -bool -octave_remove_atexit_function (const std::string& fname) -{ - bool found = false; - - for (std::list::iterator p = octave_atexit_functions.begin (); - p != octave_atexit_functions.end (); p++) - { - if (*p == fname) - { - octave_atexit_functions.erase (p); - found = true; - break; - } - } - - return found; -} - - -DEFUN (atexit, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} atexit (@var{fcn})\n\ -@deftypefnx {Built-in Function} {} atexit (@var{fcn}, @var{flag})\n\ -Register a function to be called when Octave exits. For example,\n\ -\n\ -@example\n\ -@group\n\ -function last_words ()\n\ - disp (\"Bye bye\");\n\ -endfunction\n\ -atexit (\"last_words\");\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -will print the message \"Bye bye\" when Octave exits.\n\ -\n\ -The additional argument @var{flag} will register or unregister\n\ -@var{fcn} from the list of functions to be called when Octave\n\ -exits. If @var{flag} is true, the function is registered, and if\n\ -@var{flag} is false, it is unregistered. For example,\n\ -after registering the function @code{last_words} above,\n\ -\n\ -@example\n\ -atexit (\"last_words\", false);\n\ -@end example\n\ -\n\ -@noindent\n\ -will remove the function from the list and Octave will not call\n\ -@code{last_words} when it exits.\n\ -\n\ -Note that @code{atexit} only removes the first occurrence of a function\n\ -from the list, so if a function was placed in the list multiple\n\ -times with @code{atexit}, it must also be removed from the list\n\ -multiple times.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - std::string arg = args(0).string_value (); - - if (! error_state) - { - bool add_mode = true; - - if (nargin == 2) - { - add_mode = args(1).bool_value (); - - if (error_state) - error ("atexit: FLAG argument must be a logical value"); - } - - if (! error_state) - { - if (add_mode) - octave_add_atexit_function (arg); - else - { - bool found = octave_remove_atexit_function (arg); - - if (nargout > 0) - retval(0) = found; - } - } - } - else - error ("atexit: FCN argument must be a string"); - } - else - print_usage (); - - return retval; -} - -DEFUN (octave_config_info, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} octave_config_info ()\n\ -@deftypefnx {Built-in Function} {} octave_config_info (@var{option})\n\ -Return a structure containing configuration and installation\n\ -information for Octave.\n\ -\n\ -If @var{option} is a string, return the configuration information for the\n\ -specified option.\n\ -\n\ -@end deftypefn") -{ - octave_value retval; - -#if defined (ENABLE_DYNAMIC_LINKING) - bool octave_supports_dynamic_linking = true; -#else - bool octave_supports_dynamic_linking = false; -#endif - - static bool initialized = false; - static octave_scalar_map m; - - struct conf_info_struct - { - bool subst_home; - const char *key; - const char *val; - }; - - static const conf_info_struct conf_info[] = - { - { false, "ALL_CFLAGS", OCTAVE_CONF_ALL_CFLAGS }, - { false, "ALL_CXXFLAGS", OCTAVE_CONF_ALL_CXXFLAGS }, - { false, "ALL_FFLAGS", OCTAVE_CONF_ALL_FFLAGS }, - { false, "ALL_LDFLAGS", OCTAVE_CONF_ALL_LDFLAGS }, - { false, "AMD_CPPFLAGS", OCTAVE_CONF_AMD_CPPFLAGS }, - { false, "AMD_LDFLAGS", OCTAVE_CONF_AMD_LDFLAGS }, - { false, "AMD_LIBS", OCTAVE_CONF_AMD_LIBS }, - { false, "AR", OCTAVE_CONF_AR }, - { false, "ARFLAGS", OCTAVE_CONF_ARFLAGS }, - { false, "ARPACK_CPPFLAGS", OCTAVE_CONF_ARPACK_CPPFLAGS }, - { false, "ARPACK_LDFLAGS", OCTAVE_CONF_ARPACK_LDFLAGS }, - { false, "ARPACK_LIBS", OCTAVE_CONF_ARPACK_LIBS }, - { false, "BLAS_LIBS", OCTAVE_CONF_BLAS_LIBS }, - { false, "CAMD_CPPFLAGS", OCTAVE_CONF_CAMD_CPPFLAGS }, - { false, "CAMD_LDFLAGS", OCTAVE_CONF_CAMD_LDFLAGS }, - { false, "CAMD_LIBS", OCTAVE_CONF_CAMD_LIBS }, - { false, "CARBON_LIBS", OCTAVE_CONF_CARBON_LIBS }, - { false, "CC", OCTAVE_CONF_CC }, - // FIXME: CC_VERSION is deprecated. Remove in version 3.12 - { false, "CC_VERSION", OCTAVE_CONF_CC_VERSION }, - { false, "CCOLAMD_CPPFLAGS", OCTAVE_CONF_CCOLAMD_CPPFLAGS }, - { false, "CCOLAMD_LDFLAGS", OCTAVE_CONF_CCOLAMD_LDFLAGS }, - { false, "CCOLAMD_LIBS", OCTAVE_CONF_CCOLAMD_LIBS }, - { false, "CFLAGS", OCTAVE_CONF_CFLAGS }, - { false, "CHOLMOD_CPPFLAGS", OCTAVE_CONF_CHOLMOD_CPPFLAGS }, - { false, "CHOLMOD_LDFLAGS", OCTAVE_CONF_CHOLMOD_LDFLAGS }, - { false, "CHOLMOD_LIBS", OCTAVE_CONF_CHOLMOD_LIBS }, - { false, "COLAMD_CPPFLAGS", OCTAVE_CONF_COLAMD_CPPFLAGS }, - { false, "COLAMD_LDFLAGS", OCTAVE_CONF_COLAMD_LDFLAGS }, - { false, "COLAMD_LIBS", OCTAVE_CONF_COLAMD_LIBS }, - { false, "CPICFLAG", OCTAVE_CONF_CPICFLAG }, - { false, "CPPFLAGS", OCTAVE_CONF_CPPFLAGS }, - { false, "CURL_CPPFLAGS", OCTAVE_CONF_CURL_CPPFLAGS }, - { false, "CURL_LDFLAGS", OCTAVE_CONF_CURL_LDFLAGS }, - { false, "CURL_LIBS", OCTAVE_CONF_CURL_LIBS }, - { false, "CXSPARSE_CPPFLAGS", OCTAVE_CONF_CXSPARSE_CPPFLAGS }, - { false, "CXSPARSE_LDFLAGS", OCTAVE_CONF_CXSPARSE_LDFLAGS }, - { false, "CXSPARSE_LIBS", OCTAVE_CONF_CXSPARSE_LIBS }, - { false, "CXX", OCTAVE_CONF_CXX }, - { false, "CXXCPP", OCTAVE_CONF_CXXCPP }, - { false, "CXXFLAGS", OCTAVE_CONF_CXXFLAGS }, - { false, "CXXPICFLAG", OCTAVE_CONF_CXXPICFLAG }, - // FIXME: CXX_VERSION is deprecated. Remove in version 3.12 - { false, "CXX_VERSION", OCTAVE_CONF_CXX_VERSION }, - { false, "DEFAULT_PAGER", OCTAVE_DEFAULT_PAGER }, - { false, "DEFS", OCTAVE_CONF_DEFS }, - { false, "DL_LD", OCTAVE_CONF_DL_LD }, - { false, "DL_LDFLAGS", OCTAVE_CONF_DL_LDFLAGS }, - { false, "DL_LIBS", OCTAVE_CONF_DL_LIBS }, - { false, "GCC_VERSION", OCTAVE_CONF_GCC_VERSION }, - { false, "GXX_VERSION", OCTAVE_CONF_GXX_VERSION }, - { false, "ENABLE_DYNAMIC_LINKING", OCTAVE_CONF_ENABLE_DYNAMIC_LINKING }, - { false, "EXEEXT", OCTAVE_CONF_EXEEXT }, - { false, "F77", OCTAVE_CONF_F77 }, - { false, "F77_FLOAT_STORE_FLAG", OCTAVE_CONF_F77_FLOAT_STORE_FLAG }, - { false, "F77_INTEGER_8_FLAG", OCTAVE_CONF_F77_INTEGER_8_FLAG }, - { false, "FC", OCTAVE_CONF_FC }, - { false, "FFLAGS", OCTAVE_CONF_FFLAGS }, - { false, "FFTW3_CPPFLAGS", OCTAVE_CONF_FFTW3_CPPFLAGS }, - { false, "FFTW3_LDFLAGS", OCTAVE_CONF_FFTW3_LDFLAGS }, - { false, "FFTW3_LIBS", OCTAVE_CONF_FFTW3_LIBS }, - { false, "FFTW3F_CPPFLAGS", OCTAVE_CONF_FFTW3F_CPPFLAGS }, - { false, "FFTW3F_LDFLAGS", OCTAVE_CONF_FFTW3F_LDFLAGS }, - { false, "FFTW3F_LIBS", OCTAVE_CONF_FFTW3F_LIBS }, - { false, "FLIBS", OCTAVE_CONF_FLIBS }, - { false, "FPICFLAG", OCTAVE_CONF_FPICFLAG }, - { false, "FT2_CFLAGS", OCTAVE_CONF_FT2_CFLAGS }, - { false, "FT2_LIBS", OCTAVE_CONF_FT2_LIBS }, - { false, "GLPK_CPPFLAGS", OCTAVE_CONF_GLPK_CPPFLAGS }, - { false, "GLPK_LDFLAGS", OCTAVE_CONF_GLPK_LDFLAGS }, - { false, "GLPK_LIBS", OCTAVE_CONF_GLPK_LIBS }, - { false, "GNUPLOT", OCTAVE_CONF_GNUPLOT }, - { false, "GRAPHICS_CFLAGS", OCTAVE_CONF_GRAPHICS_CFLAGS }, - { false, "GRAPHICS_LIBS", OCTAVE_CONF_GRAPHICS_LIBS }, - { false, "HDF5_CPPFLAGS", OCTAVE_CONF_HDF5_CPPFLAGS }, - { false, "HDF5_LDFLAGS", OCTAVE_CONF_HDF5_LDFLAGS }, - { false, "HDF5_LIBS", OCTAVE_CONF_HDF5_LIBS }, - { false, "LAPACK_LIBS", OCTAVE_CONF_LAPACK_LIBS }, - { false, "LDFLAGS", OCTAVE_CONF_LDFLAGS }, - { false, "LD_CXX", OCTAVE_CONF_LD_CXX }, - { false, "LD_STATIC_FLAG", OCTAVE_CONF_LD_STATIC_FLAG }, - { false, "LEX", OCTAVE_CONF_LEX }, - { false, "LEXLIB", OCTAVE_CONF_LEXLIB }, - { false, "LFLAGS", OCTAVE_CONF_LFLAGS }, - { false, "LIBEXT", OCTAVE_CONF_LIBEXT }, - { false, "LIBFLAGS", OCTAVE_CONF_LIBFLAGS }, - { false, "LIBOCTAVE", OCTAVE_CONF_LIBOCTAVE }, - { false, "LIBOCTINTERP", OCTAVE_CONF_LIBOCTINTERP }, - { false, "LIBS", OCTAVE_CONF_LIBS }, - { false, "LLVM_CPPFLAGS", OCTAVE_CONF_LLVM_CPPFLAGS }, - { false, "LLVM_LDFLAGS", OCTAVE_CONF_LLVM_LDFLAGS }, - { false, "LLVM_LIBS", OCTAVE_CONF_LLVM_LIBS }, - { false, "LN_S", OCTAVE_CONF_LN_S }, - { false, "MAGICK_CPPFLAGS", OCTAVE_CONF_MAGICK_CPPFLAGS }, - { false, "MAGICK_LDFLAGS", OCTAVE_CONF_MAGICK_LDFLAGS }, - { false, "MAGICK_LIBS", OCTAVE_CONF_MAGICK_LIBS }, - { false, "MKOCTFILE_DL_LDFLAGS", OCTAVE_CONF_MKOCTFILE_DL_LDFLAGS }, - { false, "OCTAVE_LINK_DEPS", OCTAVE_CONF_OCTAVE_LINK_DEPS }, - { false, "OCTAVE_LINK_OPTS", OCTAVE_CONF_OCTAVE_LINK_OPTS }, - { false, "OCT_LINK_DEPS", OCTAVE_CONF_OCT_LINK_DEPS }, - { false, "OCT_LINK_OPTS", OCTAVE_CONF_OCT_LINK_OPTS }, - { false, "OPENGL_LIBS", OCTAVE_CONF_OPENGL_LIBS }, - { false, "PTHREAD_CFLAGS", OCTAVE_CONF_PTHREAD_CFLAGS }, - { false, "PTHREAD_LIBS", OCTAVE_CONF_PTHREAD_LIBS }, - { false, "QHULL_CPPFLAGS", OCTAVE_CONF_QHULL_CPPFLAGS }, - { false, "QHULL_LDFLAGS", OCTAVE_CONF_QHULL_LDFLAGS }, - { false, "QHULL_LIBS", OCTAVE_CONF_QHULL_LIBS }, - { false, "QRUPDATE_CPPFLAGS", OCTAVE_CONF_QRUPDATE_CPPFLAGS }, - { false, "QRUPDATE_LDFLAGS", OCTAVE_CONF_QRUPDATE_LDFLAGS }, - { false, "QRUPDATE_LIBS", OCTAVE_CONF_QRUPDATE_LIBS }, - { false, "QT_CPPFLAGS", OCTAVE_CONF_QT_CPPFLAGS }, - { false, "QT_LDFLAGS", OCTAVE_CONF_QT_LDFLAGS }, - { false, "QT_LIBS", OCTAVE_CONF_QT_LIBS }, - { false, "RANLIB", OCTAVE_CONF_RANLIB }, - { false, "RDYNAMIC_FLAG", OCTAVE_CONF_RDYNAMIC_FLAG }, - { false, "READLINE_LIBS", OCTAVE_CONF_READLINE_LIBS }, - { false, "REGEX_LIBS", OCTAVE_CONF_REGEX_LIBS }, - { false, "SED", OCTAVE_CONF_SED }, - { false, "SHARED_LIBS", OCTAVE_CONF_SHARED_LIBS }, - { false, "SHLEXT", OCTAVE_CONF_SHLEXT }, - { false, "SHLEXT_VER", OCTAVE_CONF_SHLEXT_VER }, - { false, "SH_LD", OCTAVE_CONF_SH_LD }, - { false, "SH_LDFLAGS", OCTAVE_CONF_SH_LDFLAGS }, - { false, "SONAME_FLAGS", OCTAVE_CONF_SONAME_FLAGS }, - { false, "STATIC_LIBS", OCTAVE_CONF_STATIC_LIBS }, - { false, "TERM_LIBS", OCTAVE_CONF_TERM_LIBS }, - { false, "UMFPACK_CPPFLAGS", OCTAVE_CONF_UMFPACK_CPPFLAGS }, - { false, "UMFPACK_LDFLAGS", OCTAVE_CONF_UMFPACK_LDFLAGS }, - { false, "UMFPACK_LIBS", OCTAVE_CONF_UMFPACK_LIBS }, - { false, "USE_64_BIT_IDX_T", OCTAVE_CONF_USE_64_BIT_IDX_T }, - { false, "WARN_CFLAGS", OCTAVE_CONF_WARN_CFLAGS }, - { false, "WARN_CXXFLAGS", OCTAVE_CONF_WARN_CXXFLAGS }, - { false, "X11_INCFLAGS", OCTAVE_CONF_X11_INCFLAGS }, - { false, "X11_LIBS", OCTAVE_CONF_X11_LIBS }, - { false, "XTRA_CFLAGS", OCTAVE_CONF_XTRA_CFLAGS }, - { false, "XTRA_CXXFLAGS", OCTAVE_CONF_XTRA_CXXFLAGS }, - { false, "YACC", OCTAVE_CONF_YACC }, - { false, "YFLAGS", OCTAVE_CONF_YFLAGS }, - { false, "Z_CPPFLAGS", OCTAVE_CONF_Z_CPPFLAGS }, - { false, "Z_LDFLAGS", OCTAVE_CONF_Z_LDFLAGS }, - { false, "Z_LIBS", OCTAVE_CONF_Z_LIBS }, - { false, "api_version", OCTAVE_API_VERSION }, - { true, "archlibdir", OCTAVE_ARCHLIBDIR }, - { true, "bindir", OCTAVE_BINDIR }, - { false, "canonical_host_type", OCTAVE_CANONICAL_HOST_TYPE }, - { false, "config_opts", OCTAVE_CONF_config_opts }, - { true, "datadir", OCTAVE_DATADIR }, - { true, "datarootdir", OCTAVE_DATAROOTDIR }, - { true, "exec_prefix", OCTAVE_EXEC_PREFIX }, - { true, "fcnfiledir", OCTAVE_FCNFILEDIR }, - { true, "imagedir", OCTAVE_IMAGEDIR }, - { true, "includedir", OCTAVE_INCLUDEDIR }, - { true, "infodir", OCTAVE_INFODIR }, - { true, "infofile", OCTAVE_INFOFILE }, - { true, "libdir", OCTAVE_LIBDIR }, - { true, "libexecdir", OCTAVE_LIBEXECDIR }, - { true, "localapiarchlibdir", OCTAVE_LOCALAPIARCHLIBDIR }, - { true, "localapifcnfiledir", OCTAVE_LOCALAPIFCNFILEDIR }, - { true, "localapioctfiledir", OCTAVE_LOCALAPIOCTFILEDIR }, - { true, "localarchlibdir", OCTAVE_LOCALARCHLIBDIR }, - { true, "localfcnfiledir", OCTAVE_LOCALFCNFILEDIR }, - { true, "localoctfiledir", OCTAVE_LOCALOCTFILEDIR }, - { true, "localstartupfiledir", OCTAVE_LOCALSTARTUPFILEDIR }, - { true, "localverarchlibdir", OCTAVE_LOCALVERARCHLIBDIR }, - { true, "localverfcnfiledir", OCTAVE_LOCALVERFCNFILEDIR }, - { true, "localveroctfiledir", OCTAVE_LOCALVEROCTFILEDIR }, - { true, "man1dir", OCTAVE_MAN1DIR }, - { false, "man1ext", OCTAVE_MAN1EXT }, - { true, "mandir", OCTAVE_MANDIR }, - { true, "octfiledir", OCTAVE_OCTFILEDIR }, - { true, "octetcdir", OCTAVE_OCTETCDIR }, - { true, "octincludedir", OCTAVE_OCTINCLUDEDIR }, - { true, "octlibdir", OCTAVE_OCTLIBDIR }, - { true, "octtestsdir", OCTAVE_OCTTESTSDIR }, - { true, "prefix", OCTAVE_PREFIX }, - { true, "startupfiledir", OCTAVE_STARTUPFILEDIR }, - { false, "version", OCTAVE_VERSION }, - { false, 0, 0 } - }; - - if (! initialized) - { - m.assign ("dld", octave_value (octave_supports_dynamic_linking)); - - oct_mach_info::float_format ff = oct_mach_info::native_float_format (); - m.assign ("float_format", - octave_value (oct_mach_info::float_format_as_string (ff))); - - m.assign ("words_big_endian", - octave_value (oct_mach_info::words_big_endian ())); - - m.assign ("words_little_endian", - octave_value (oct_mach_info::words_little_endian ())); - - m.assign ("features", octave_value (octave_config_features ())); - - int i = 0; - - while (true) - { - const conf_info_struct& elt = conf_info[i++]; - - const char *key = elt.key; - - if (key) - { - if (elt.subst_home) - m.assign (key, subst_octave_home (elt.val)); - else - m.assign (key, elt.val); - } - else - break; - } - - bool unix_system = true; - bool mac_system = false; - bool windows_system = false; - -#if defined (WIN32) - windows_system = true; -#if !defined (__CYGWIN__) - unix_system = false; -#endif -#endif - -#if defined (OCTAVE_USE_OS_X_API) - mac_system = true; -#endif - - m.assign ("unix", octave_value (unix_system)); - m.assign ("mac", octave_value (mac_system)); - m.assign ("windows", octave_value (windows_system)); - - initialized = true; - } - - int nargin = args.length (); - - if (nargin == 1) - { - std::string arg = args(0).string_value (); - - if (! error_state) - { - if (m.isfield (arg)) - { - Cell c = m.contents (arg); - - if (c.is_empty ()) - error ("octave_config_info: no info for '%s'", arg.c_str ()); - else - retval = c(0); - } - else - error ("octave_config_info: invalid parameter '%s'", arg.c_str ()); - } - } - else if (nargin == 0) - retval = m; - else - print_usage (); - - return retval; -} - -/* -%!assert (ischar (octave_config_info ("version"))) -%!test -%! x = octave_config_info (); -%! assert (isstruct (x)); -%! assert (! isempty (x)); - -%!error octave_config_info (1, 2) -*/ - -#if defined (__GNUG__) && defined (DEBUG_NEW_DELETE) - -int debug_new_delete = 0; - -typedef void (*vfp)(void); -extern vfp __new_handler; - -void * -__builtin_new (size_t sz) -{ - void *p; - - /* malloc (0) is unpredictable; avoid it. */ - if (sz == 0) - sz = 1; - p = gnulib::malloc (sz); - while (p == 0) - { - (*__new_handler) (); - p = gnulib::malloc (sz); - } - - if (debug_new_delete) - std::cerr << "__builtin_new: " << p << std::endl; - - return p; -} - -void -__builtin_delete (void *ptr) -{ - if (debug_new_delete) - std::cerr << "__builtin_delete: " << ptr << std::endl; - - if (ptr) - free (ptr); -} - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/toplev.h --- a/libinterp/interpfcn/toplev.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,467 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_toplev_h) -#define octave_toplev_h 1 - -#include - -#include -#include - -class octave_value; -class octave_value_list; -class octave_function; -class octave_user_script; -class tree_statement; -class tree_statement_list; -class charMatrix; - -#include "quit.h" - -#include "input.h" -#include "oct-map.h" - - -typedef void (*octave_exit_func) (int); -extern OCTINTERP_API octave_exit_func octave_exit; - -extern OCTINTERP_API bool quit_allowed; - -extern OCTINTERP_API bool quitting_gracefully; - -extern OCTINTERP_API int exit_status; - -extern OCTINTERP_API void -clean_up_and_exit (int status, bool safe_to_return = false); - -extern OCTINTERP_API void recover_from_exception (void); - -extern OCTINTERP_API int main_loop (void); - -extern OCTINTERP_API void -octave_add_atexit_function (const std::string& fname); - -extern OCTINTERP_API bool -octave_remove_atexit_function (const std::string& fname); - -// TRUE means we are ready to interpret commands, but not everything -// is ready for interactive use. -extern OCTINTERP_API bool octave_interpreter_ready; - -// TRUE means we've processed all the init code and we are good to go. -extern OCTINTERP_API bool octave_initialized; - -class -OCTINTERP_API -octave_call_stack -{ -private: - - struct call_stack_elt - { - call_stack_elt (octave_function *f, symbol_table::scope_id s, - symbol_table::context_id c, size_t p = 0) - : fcn (f), line (-1), column (-1), scope (s), context (c), prev (p) - { } - - call_stack_elt (const call_stack_elt& elt) - : fcn (elt.fcn), line (elt.line), column (elt.column), - scope (elt.scope), context (elt.context), prev (elt.prev) - { } - - octave_function *fcn; - int line; - int column; - symbol_table::scope_id scope; - symbol_table::context_id context; - size_t prev; - }; - -protected: - - octave_call_stack (void) : cs (), curr_frame (0) { } - -public: - - typedef std::deque::iterator iterator; - typedef std::deque::const_iterator const_iterator; - - typedef std::deque::reverse_iterator reverse_iterator; - typedef std::deque::const_reverse_iterator const_reverse_iterator; - - static void create_instance (void); - - static bool instance_ok (void) - { - bool retval = true; - - if (! instance) - create_instance (); - - if (! instance) - { - ::error ("unable to create call stack object!"); - - retval = false; - } - - return retval; - } - - // Current function (top of stack). - static octave_function *current (void) - { - return instance_ok () ? instance->do_current () : 0; - } - - // Current line in current function. - static int current_line (void) - { - return instance_ok () ? instance->do_current_line () : -1; - } - - // Current column in current function. - static int current_column (void) - { - return instance_ok () ? instance->do_current_column () : -1; - } - - // Line in user code caller. - static int caller_user_code_line (void) - { - return instance_ok () ? instance->do_caller_user_code_line () : -1; - } - - // Column in user code caller. - static int caller_user_code_column (void) - { - return instance_ok () ? instance->do_caller_user_code_column () : -1; - } - - // Caller function, may be built-in. - static octave_function *caller (void) - { - return instance_ok () ? instance->do_caller () : 0; - } - - static size_t current_frame (void) - { - return instance_ok () ? instance->do_current_frame () : 0; - } - - static size_t size (void) - { - return instance_ok () ? instance->do_size () : 0; - } - - static size_t num_user_code_frames (octave_idx_type& curr_user_frame) - { - return instance_ok () - ? instance->do_num_user_code_frames (curr_user_frame) : 0; - } - - static symbol_table::scope_id current_scope (void) - { - return instance_ok () ? instance->do_current_scope () : 0; - } - - static symbol_table::context_id current_context (void) - { - return instance_ok () ? instance->do_current_context () : 0; - } - - // Function at location N on the call stack (N == 0 is current), may - // be built-in. - static octave_function *element (size_t n) - { - return instance_ok () ? instance->do_element (n) : 0; - } - - // First user-defined function on the stack. - static octave_user_code *caller_user_code (size_t nskip = 0) - { - return instance_ok () ? instance->do_caller_user_code (nskip) : 0; - } - - static void - push (octave_function *f, - symbol_table::scope_id scope = symbol_table::current_scope (), - symbol_table::context_id context = symbol_table::current_context ()) - { - if (instance_ok ()) - instance->do_push (f, scope, context); - } - - static void - push (symbol_table::scope_id scope = symbol_table::current_scope (), - symbol_table::context_id context = symbol_table::current_context ()) - { - if (instance_ok ()) - instance->do_push (0, scope, context); - } - - static void set_location (int l, int c) - { - if (instance_ok ()) - instance->do_set_location (l, c); - } - - static void set_line (int l) - { - if (instance_ok ()) - instance->do_set_line (l); - } - - static void set_column (int c) - { - if (instance_ok ()) - instance->do_set_column (c); - } - - static bool goto_frame (size_t n = 0, bool verbose = false) - { - return instance_ok () ? instance->do_goto_frame (n, verbose) : false; - } - - static void restore_frame (size_t n) - { - goto_frame (n); - } - - static bool goto_frame_relative (int n, bool verbose = false) - { - return instance_ok () - ? instance->do_goto_frame_relative (n, verbose) : false; - } - - static void goto_caller_frame (void) - { - if (instance_ok ()) - instance->do_goto_caller_frame (); - } - - static void goto_base_frame (void) - { - if (instance_ok ()) - instance->do_goto_base_frame (); - } - - static octave_map backtrace (size_t nskip, octave_idx_type& curr_user_frame) - { - return instance_ok () - ? instance->do_backtrace (nskip, curr_user_frame) : octave_map (); - } - - static octave_map empty_backtrace (void); - - static void pop (void) - { - if (instance_ok ()) - instance->do_pop (); - } - - static void clear (void) - { - if (instance_ok ()) - instance->do_clear (); - } - - static void backtrace_error_message (void) - { - if (instance_ok ()) - instance->do_backtrace_error_message (); - } - -private: - - // The current call stack. - std::deque cs; - - size_t curr_frame; - - static octave_call_stack *instance; - - static void cleanup_instance (void) { delete instance; instance = 0; } - - int do_current_line (void) const; - - int do_current_column (void) const; - - int do_caller_user_code_line (void) const; - - int do_caller_user_code_column (void) const; - - octave_function *do_caller (void) const - { - return curr_frame > 1 ? cs[curr_frame-1].fcn : cs[0].fcn; - } - - size_t do_current_frame (void) { return curr_frame; } - - size_t do_size (void) { return cs.size (); } - - size_t do_num_user_code_frames (octave_idx_type& curr_user_frame) const; - - symbol_table::scope_id do_current_scope (void) const - { - return curr_frame > 0 && curr_frame < cs.size () - ? cs[curr_frame].scope : 0; - } - - symbol_table::context_id do_current_context (void) const - { - return curr_frame > 0 && curr_frame < cs.size () - ? cs[curr_frame].context : 0; - } - - octave_function *do_element (size_t n) - { - octave_function *retval = 0; - - if (cs.size () > n) - { - call_stack_elt& elt = cs[n]; - retval = elt.fcn; - } - - return retval; - } - - octave_user_code *do_caller_user_code (size_t nskip) const; - - void do_push (octave_function *f, symbol_table::scope_id scope, - symbol_table::context_id context) - { - size_t prev_frame = curr_frame; - curr_frame = cs.size (); - cs.push_back (call_stack_elt (f, scope, context, prev_frame)); - symbol_table::set_scope_and_context (scope, context); - } - - octave_function *do_current (void) const - { - octave_function *retval = 0; - - if (! cs.empty ()) - { - const call_stack_elt& elt = cs[curr_frame]; - retval = elt.fcn; - } - - return retval; - } - - void do_set_location (int l, int c) - { - if (! cs.empty ()) - { - call_stack_elt& elt = cs.back (); - - elt.line = l; - elt.column = c; - } - } - - void do_set_line (int l) - { - if (! cs.empty ()) - { - call_stack_elt& elt = cs.back (); - - elt.line = l; - } - } - - void do_set_column (int c) - { - if (! cs.empty ()) - { - call_stack_elt& elt = cs.back (); - - elt.column = c; - } - } - - octave_map do_backtrace (size_t nskip, - octave_idx_type& curr_user_frame) const; - - bool do_goto_frame (size_t n, bool verbose); - - bool do_goto_frame_relative (int n, bool verbose); - - void do_goto_caller_frame (void); - - void do_goto_base_frame (void); - - void do_pop (void) - { - if (cs.size () > 1) - { - const call_stack_elt& elt = cs.back (); - curr_frame = elt.prev; - cs.pop_back (); - const call_stack_elt& new_elt = cs[curr_frame]; - symbol_table::set_scope_and_context (new_elt.scope, new_elt.context); - } - } - - void do_clear (void) { cs.clear (); } - - void do_backtrace_error_message (void) const; -}; - -// Call a function with exceptions handled to avoid problems with -// errors while shutting down. - -#define OCTAVE_IGNORE_EXCEPTION(E) \ - catch (E) \ - { \ - std::cerr << "error: ignoring " #E " while preparing to exit" << std::endl; \ - recover_from_exception (); \ - } - -#define OCTAVE_SAFE_CALL(F, ARGS) \ - do \ - { \ - try \ - { \ - unwind_protect frame; \ - \ - frame.protect_var (Vdebug_on_error); \ - frame.protect_var (Vdebug_on_warning); \ - \ - Vdebug_on_error = false; \ - Vdebug_on_warning = false; \ - \ - F ARGS; \ - } \ - OCTAVE_IGNORE_EXCEPTION (octave_interrupt_exception) \ - OCTAVE_IGNORE_EXCEPTION (octave_execution_exception) \ - OCTAVE_IGNORE_EXCEPTION (std::bad_alloc) \ - \ - if (error_state) \ - error_state = 0; \ - } \ - while (0) - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/utils.cc --- a/libinterp/interpfcn/utils.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1433 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton -Copyright (C) 2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include -#include -#include -#include - -#include -#include - -#include "vasnprintf.h" - -#include "quit.h" - -#include "dir-ops.h" -#include "file-ops.h" -#include "file-stat.h" -#include "lo-mappers.h" -#include "lo-utils.h" -#include "oct-cmplx.h" -#include "oct-env.h" -#include "pathsearch.h" -#include "str-vec.h" - -#include "Cell.h" -#include -#include "defun.h" -#include "dirfns.h" -#include "error.h" -#include "gripes.h" -#include "input.h" -#include "lex.h" -#include "load-path.h" -#include "oct-errno.h" -#include "oct-hist.h" -#include "oct-obj.h" -#include "ov-range.h" -#include "pager.h" -#include "parse.h" -#include "sysdep.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" - -// Return TRUE if S is a valid identifier. - -bool -valid_identifier (const char *s) -{ - if (! s || ! (isalpha (*s) || *s == '_' || *s == '$')) - return false; - - while (*++s != '\0') - if (! (isalnum (*s) || *s == '_' || *s == '$')) - return false; - - return true; -} - -bool -valid_identifier (const std::string& s) -{ - return valid_identifier (s.c_str ()); -} - -DEFUN (isvarname, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isvarname (@var{name})\n\ -Return true if @var{name} is a valid variable name.\n\ -@seealso{iskeyword, exist, who}\n\ -@end deftypefn") -{ - octave_value retval = false; - - int nargin = args.length (); - - if (nargin != 1) - print_usage (); - else if (args(0).is_string ()) - { - std::string varname = args(0).string_value (); - retval = valid_identifier (varname) && ! is_keyword (varname); - } - - return retval; -} - -/* -%!assert (isvarname ("foo"), true) -%!assert (isvarname ("_foo"), true) -%!assert (isvarname ("_1"), true) -%!assert (isvarname ("1foo"), false) -%!assert (isvarname (""), false) -%!assert (isvarname (12), false) - -%!error isvarname () -%!error isvarname ("foo", "bar"); -*/ - -// Return TRUE if F and G are both names for the same file. - -bool -same_file (const std::string& f, const std::string& g) -{ - return same_file_internal (f, g); -} - -int -almost_match (const std::string& std, const std::string& s, int min_match_len, - int case_sens) -{ - int stdlen = std.length (); - int slen = s.length (); - - return (slen <= stdlen - && slen >= min_match_len - && (case_sens - ? (strncmp (std.c_str (), s.c_str (), slen) == 0) - : (octave_strncasecmp (std.c_str (), s.c_str (), slen) == 0))); -} - -// Ugh. - -int -keyword_almost_match (const char * const *std, int *min_len, const std::string& s, - int min_toks_to_match, int max_toks) -{ - int status = 0; - int tok_count = 0; - int toks_matched = 0; - - if (s.empty () || max_toks < 1) - return status; - - char *kw = strsave (s.c_str ()); - - char *t = kw; - while (*t != '\0') - { - if (*t == '\t') - *t = ' '; - t++; - } - - char *beg = kw; - while (*beg == ' ') - beg++; - - if (*beg == '\0') - return status; - - - const char **to_match = new const char * [max_toks + 1]; - const char * const *s1 = std; - const char **s2 = to_match; - - if (! s1 || ! s2) - goto done; - - s2[tok_count] = beg; - char *end; - while ((end = strchr (beg, ' ')) != 0) - { - *end = '\0'; - beg = end + 1; - - while (*beg == ' ') - beg++; - - if (*beg == '\0') - break; - - tok_count++; - if (tok_count >= max_toks) - goto done; - - s2[tok_count] = beg; - } - s2[tok_count+1] = 0; - - s2 = to_match; - - for (;;) - { - if (! almost_match (*s1, *s2, min_len[toks_matched], 0)) - goto done; - - toks_matched++; - - s1++; - s2++; - - if (! *s2) - { - status = (toks_matched >= min_toks_to_match); - goto done; - } - - if (! *s1) - goto done; - } - - done: - - delete [] kw; - delete [] to_match; - - return status; -} - -// Return non-zero if either NR or NC is zero. Return -1 if this -// should be considered fatal; return 1 if this is ok. - -int -empty_arg (const char * /* name */, octave_idx_type nr, octave_idx_type nc) -{ - return (nr == 0 || nc == 0); -} - -// See if the given file is in the path. - -std::string -search_path_for_file (const std::string& path, const string_vector& names) -{ - dir_path p (path); - - return octave_env::make_absolute (p.find_first_of (names)); -} - -// Find all locations of the given file in the path. - -string_vector -search_path_for_all_files (const std::string& path, const string_vector& names) -{ - dir_path p (path); - - string_vector sv = p.find_all_first_of (names); - - octave_idx_type len = sv.length (); - - for (octave_idx_type i = 0; i < len; i++) - sv[i] = octave_env::make_absolute (sv[i]); - - return sv; -} - -static string_vector -make_absolute (const string_vector& sv) -{ - octave_idx_type len = sv.length (); - - string_vector retval (len); - - for (octave_idx_type i = 0; i < len; i++) - retval[i] = octave_env::make_absolute (sv[i]); - - return retval; -} - -DEFUN (file_in_loadpath, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} file_in_loadpath (@var{file})\n\ -@deftypefnx {Built-in Function} {} file_in_loadpath (@var{file}, \"all\")\n\ -\n\ -Return the absolute name of @var{file} if it can be found in\n\ -the list of directories specified by @code{path}.\n\ -If no file is found, return an empty character string.\n\ -\n\ -If the first argument is a cell array of strings, search each\n\ -directory of the loadpath for element of the cell array and return\n\ -the first that matches.\n\ -\n\ -If the second optional argument @code{\"all\"} is supplied, return\n\ -a cell array containing the list of all files that have the same\n\ -name in the path. If no files are found, return an empty cell array.\n\ -@seealso{file_in_path, path}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - string_vector names = args(0).all_strings (); - - if (! error_state && names.length () > 0) - { - if (nargin == 1) - retval = octave_env::make_absolute (load_path::find_first_of (names)); - else if (nargin == 2) - { - std::string opt = args(1).string_value (); - - if (! error_state && opt == "all") - retval = Cell (make_absolute - (load_path::find_all_first_of (names))); - else - error ("file_in_loadpath: invalid option"); - } - } - else - error ("file_in_loadpath: FILE argument must be a string"); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! f = file_in_loadpath ("plot.m"); -%! assert (ischar (f)); -%! assert (! isempty (f)); - -%!test -%! f = file_in_loadpath ("$$probably_!!_not_&&_a_!!_file$$"); -%! assert (f, ""); - -%!test -%! lst = file_in_loadpath ("$$probably_!!_not_&&_a_!!_file$$", "all"); -%! assert (lst, {}); - -%!error file_in_loadpath () -%!error file_in_loadpath ("foo", "bar", 1) -*/ - -DEFUN (file_in_path, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} file_in_path (@var{path}, @var{file})\n\ -@deftypefnx {Built-in Function} {} file_in_path (@var{path}, @var{file}, \"all\")\n\ -Return the absolute name of @var{file} if it can be found in\n\ -@var{path}. The value of @var{path} should be a colon-separated list of\n\ -directories in the format described for @code{path}. If no file\n\ -is found, return an empty character string. For example:\n\ -\n\ -@example\n\ -@group\n\ -file_in_path (EXEC_PATH, \"sh\")\n\ - @result{} \"/bin/sh\"\n\ -@end group\n\ -@end example\n\ -\n\ -If the second argument is a cell array of strings, search each\n\ -directory of the path for element of the cell array and return\n\ -the first that matches.\n\ -\n\ -If the third optional argument @code{\"all\"} is supplied, return\n\ -a cell array containing the list of all files that have the same\n\ -name in the path. If no files are found, return an empty cell array.\n\ -@seealso{file_in_loadpath}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2 || nargin == 3) - { - std::string path = args(0).string_value (); - - if (! error_state) - { - string_vector names = args(1).all_strings (); - - if (! error_state && names.length () > 0) - { - if (nargin == 2) - retval = search_path_for_file (path, names); - else if (nargin == 3) - { - std::string opt = args(2).string_value (); - - if (! error_state && opt == "all") - retval = Cell (make_absolute - (search_path_for_all_files (path, names))); - else - error ("file_in_path: invalid option"); - } - } - else - error ("file_in_path: all arguments must be strings"); - } - else - error ("file_in_path: PATH must be a string"); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! f = file_in_path (path (), "plot.m"); -%! assert (ischar (f)); -%! assert (! isempty (f)); - -%!test -%! f = file_in_path (path (), "$$probably_!!_not_&&_a_!!_file$$"); -%! assert (f, ""); - -%!test -%! lst = file_in_path (path (), "$$probably_!!_not_&&_a_!!_file$$", "all"); -%! assert (lst, {}); - -%!error file_in_path () -%!error file_in_path ("foo") -%!error file_in_path ("foo", "bar", "baz", 1) -*/ - -std::string -file_in_path (const std::string& name, const std::string& suffix) -{ - std::string nm = name; - - if (! suffix.empty ()) - nm.append (suffix); - - return octave_env::make_absolute (load_path::find_file (nm)); -} - -// See if there is an function file in the path. If so, return the -// full path to the file. - -std::string -fcn_file_in_path (const std::string& name) -{ - std::string retval; - - int len = name.length (); - - if (len > 0) - { - if (octave_env::absolute_pathname (name)) - { - file_stat fs (name); - - if (fs.exists ()) - retval = name; - } - else if (len > 2 && name[len - 2] == '.' && name[len - 1] == 'm') - retval = load_path::find_fcn_file (name.substr (0, len-2)); - else - { - std::string fname = name; - size_t pos = name.find_first_of (Vfilemarker); - if (pos != std::string::npos) - fname = name.substr (0, pos); - - retval = load_path::find_fcn_file (fname); - } - } - - return retval; -} - -// See if there is a directory called "name" in the path and if it -// contains a Contents.m file return the full path to this file. - -std::string -contents_file_in_path (const std::string& dir) -{ - std::string retval; - - if (dir.length () > 0) - { - std::string tcontents = file_ops::concat (load_path::find_dir (dir), - std::string ("Contents.m")); - - file_stat fs (tcontents); - - if (fs.exists ()) - retval = octave_env::make_absolute (tcontents); - } - - return retval; -} - -// See if there is a .oct file in the path. If so, return the -// full path to the file. - -std::string -oct_file_in_path (const std::string& name) -{ - std::string retval; - - int len = name.length (); - - if (len > 0) - { - if (octave_env::absolute_pathname (name)) - { - file_stat fs (name); - - if (fs.exists ()) - retval = name; - } - else if (len > 4 && name[len - 4] == '.' && name[len - 3] == 'o' - && name[len - 2] == 'c' && name[len - 1] == 't') - retval = load_path::find_oct_file (name.substr (0, len-4)); - else - retval = load_path::find_oct_file (name); - } - - return retval; -} - -// See if there is a .mex file in the path. If so, return the -// full path to the file. - -std::string -mex_file_in_path (const std::string& name) -{ - std::string retval; - - int len = name.length (); - - if (len > 0) - { - if (octave_env::absolute_pathname (name)) - { - file_stat fs (name); - - if (fs.exists ()) - retval = name; - } - else if (len > 4 && name[len - 4] == '.' && name[len - 3] == 'm' - && name[len - 2] == 'e' && name[len - 1] == 'x') - retval = load_path::find_mex_file (name.substr (0, len-4)); - else - retval = load_path::find_mex_file (name); - } - - return retval; -} - -// Replace backslash escapes in a string with the real values. - -std::string -do_string_escapes (const std::string& s) -{ - std::string retval; - - size_t i = 0; - size_t j = 0; - size_t len = s.length (); - - retval.resize (len); - - while (j < len) - { - if (s[j] == '\\' && j+1 < len) - { - switch (s[++j]) - { - case '0': - retval[i] = '\0'; - break; - - case 'a': - retval[i] = '\a'; - break; - - case 'b': // backspace - retval[i] = '\b'; - break; - - case 'f': // formfeed - retval[i] = '\f'; - break; - - case 'n': // newline - retval[i] = '\n'; - break; - - case 'r': // carriage return - retval[i] = '\r'; - break; - - case 't': // horizontal tab - retval[i] = '\t'; - break; - - case 'v': // vertical tab - retval[i] = '\v'; - break; - - case '\\': // backslash - retval[i] = '\\'; - break; - - case '\'': // quote - retval[i] = '\''; - break; - - case '"': // double quote - retval[i] = '"'; - break; - - default: - warning ("unrecognized escape sequence '\\%c' --\ - converting to '%c'", s[j], s[j]); - retval[i] = s[j]; - break; - } - } - else - { - retval[i] = s[j]; - } - - i++; - j++; - } - - retval.resize (i); - - return retval; -} - -DEFUN (do_string_escapes, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} do_string_escapes (@var{string})\n\ -Convert special characters in @var{string} to their escaped forms.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - if (args(0).is_string ()) - retval = do_string_escapes (args(0).string_value ()); - else - error ("do_string_escapes: STRING argument must be of type string"); - } - else - print_usage (); - - return retval; -} - -/* -%!assert (do_string_escapes ('foo\nbar'), "foo\nbar") -%!assert (do_string_escapes ("foo\\nbar"), "foo\nbar") -%!assert (do_string_escapes ("foo\\nbar"), ["foo", char(10), "bar"]) -%!assert ("foo\nbar", ["foo", char(10), "bar"]) - -%!assert (do_string_escapes ('\a\b\f\n\r\t\v'), "\a\b\f\n\r\t\v") -%!assert (do_string_escapes ("\\a\\b\\f\\n\\r\\t\\v"), "\a\b\f\n\r\t\v") -%!assert (do_string_escapes ("\\a\\b\\f\\n\\r\\t\\v"), -%! char ([7, 8, 12, 10, 13, 9, 11])) -%!assert ("\a\b\f\n\r\t\v", char ([7, 8, 12, 10, 13, 9, 11])) - -%!error do_string_escapes () -%!error do_string_escapes ("foo", "bar") -*/ - -const char * -undo_string_escape (char c) -{ - if (! c) - return ""; - - switch (c) - { - case '\0': - return "\\0"; - - case '\a': - return "\\a"; - - case '\b': // backspace - return "\\b"; - - case '\f': // formfeed - return "\\f"; - - case '\n': // newline - return "\\n"; - - case '\r': // carriage return - return "\\r"; - - case '\t': // horizontal tab - return "\\t"; - - case '\v': // vertical tab - return "\\v"; - - case '\\': // backslash - return "\\\\"; - - case '"': // double quote - return "\\\""; - - default: - { - static char retval[2]; - retval[0] = c; - retval[1] = '\0'; - return retval; - } - } -} - -std::string -undo_string_escapes (const std::string& s) -{ - std::string retval; - - for (size_t i = 0; i < s.length (); i++) - retval.append (undo_string_escape (s[i])); - - return retval; -} - -DEFUN (undo_string_escapes, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} undo_string_escapes (@var{s})\n\ -Convert special characters in strings back to their escaped forms. For\n\ -example, the expression\n\ -\n\ -@example\n\ -bell = \"\\a\";\n\ -@end example\n\ -\n\ -@noindent\n\ -assigns the value of the alert character (control-g, ASCII code 7) to\n\ -the string variable @code{bell}. If this string is printed, the\n\ -system will ring the terminal bell (if it is possible). This is\n\ -normally the desired outcome. However, sometimes it is useful to be\n\ -able to print the original representation of the string, with the\n\ -special characters replaced by their escape sequences. For example,\n\ -\n\ -@example\n\ -@group\n\ -octave:13> undo_string_escapes (bell)\n\ -ans = \\a\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -replaces the unprintable alert character with its printable\n\ -representation.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - if (args(0).is_string ()) - retval = undo_string_escapes (args(0).string_value ()); - else - error ("undo_string_escapes: S argument must be a string"); - } - else - print_usage (); - - return retval; -} - -/* -%!assert (undo_string_escapes ("foo\nbar"), 'foo\nbar') -%!assert (undo_string_escapes ("foo\nbar"), "foo\\nbar") -%!assert (undo_string_escapes (["foo", char(10), "bar"]), "foo\\nbar") - -%!assert (undo_string_escapes ("\a\b\f\n\r\t\v"), '\a\b\f\n\r\t\v') -%!assert (undo_string_escapes ("\a\b\f\n\r\t\v"), "\\a\\b\\f\\n\\r\\t\\v") -%!assert (undo_string_escapes (char ([7, 8, 12, 10, 13, 9, 11])), -%! "\\a\\b\\f\\n\\r\\t\\v") - -%!error undo_string_escapes () -%!error undo_string_escapes ("foo", "bar") -*/ - -DEFUN (is_absolute_filename, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} is_absolute_filename (@var{file})\n\ -Return true if @var{file} is an absolute filename.\n\ -@seealso{is_rooted_relative_filename, make_absolute_filename, isdir}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - retval = (args(0).is_string () - && octave_env::absolute_pathname (args(0).string_value ())); - else - print_usage (); - - return retval; -} - -/* -## FIXME: We need system-dependent tests here. - -%!error is_absolute_filename () -%!error is_absolute_filename ("foo", "bar") -*/ - -DEFUN (is_rooted_relative_filename, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} is_rooted_relative_filename (@var{file})\n\ -Return true if @var{file} is a rooted-relative filename.\n\ -@seealso{is_absolute_filename, make_absolute_filename, isdir}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - retval = (args(0).is_string () - && octave_env::rooted_relative_pathname (args(0).string_value ())); - else - print_usage (); - - return retval; -} - -/* -## FIXME: We need system-dependent tests here. - -%!error is_rooted_relative_filename () -%!error is_rooted_relative_filename ("foo", "bar") -*/ - -DEFUN (make_absolute_filename, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} make_absolute_filename (@var{file})\n\ -Return the full name of @var{file} beginning from the root of the file\n\ -system. No check is done for the existence of @var{file}.\n\ -@seealso{canonicalize_file_name, is_absolute_filename, is_rooted_relative_filename, isdir}\n\ -@end deftypefn") -{ - octave_value retval = std::string (); - - if (args.length () == 1) - { - std::string nm = args(0).string_value (); - - if (! error_state) - retval = octave_env::make_absolute (nm); - else - error ("make_absolute_filename: FILE argument must be a file name"); - } - else - print_usage (); - - return retval; -} - -/* -## FIXME: We need system-dependent tests here. - -%!error make_absolute_filename () -%!error make_absolute_filename ("foo", "bar") -*/ - -DEFUN (find_dir_in_path, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} find_dir_in_path (@var{dir})\n\ -@deftypefnx {Built-in Function} {} find_dir_in_path (@var{dir}, \"all\")\n\ -Return the full name of the path element matching @var{dir}. The\n\ -match is performed at the end of each path element. For example, if\n\ -@var{dir} is @code{\"foo/bar\"}, it matches the path element\n\ -@code{\"/some/dir/foo/bar\"}, but not @code{\"/some/dir/foo/bar/baz\"}\n\ -or @code{\"/some/dir/allfoo/bar\"}.\n\ -\n\ -The second argument is optional. If it is supplied, return a cell array\n\ -containing all name matches rather than just the first.\n\ -@end deftypefn") -{ - octave_value retval = std::string (); - - int nargin = args.length (); - - std::string dir; - - if (nargin == 1 || nargin == 2) - { - dir = args(0).string_value (); - - if (! error_state) - { - if (nargin == 1) - retval = load_path::find_dir (dir); - else if (nargin == 2) - retval = Cell (load_path::find_matching_dirs (dir)); - } - else - error ("find_dir_in_path: DIR must be a directory name"); - } - else - print_usage (); - - return retval; -} - -/* -## FIXME: We need system-dependent tests here. - -%!error find_dir_in_path () -%!error find_dir_in_path ("foo", "bar", 1) -*/ - -DEFUNX ("errno", Ferrno, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{err} =} errno ()\n\ -@deftypefnx {Built-in Function} {@var{err} =} errno (@var{val})\n\ -@deftypefnx {Built-in Function} {@var{err} =} errno (@var{name})\n\ -Return the current value of the system-dependent variable errno,\n\ -set its value to @var{val} and return the previous value, or return\n\ -the named error code given @var{name} as a character string, or -1\n\ -if @var{name} is not found.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - if (args(0).is_string ()) - { - std::string nm = args(0).string_value (); - - if (! error_state) - retval = octave_errno::lookup (nm); - else - error ("errno: expecting character string argument"); - } - else - { - int val = args(0).int_value (); - - if (! error_state) - retval = octave_errno::set (val); - else - error ("errno: expecting integer argument"); - } - } - else if (nargin == 0) - retval = octave_errno::get (); - else - print_usage (); - - return retval; -} - -/* -%!assert (isnumeric (errno ())) - -%!test -%! lst = errno_list (); -%! fns = fieldnames (lst); -%! oldval = errno (fns{1}); -%! assert (isnumeric (oldval)); -%! errno (oldval); -%! newval = errno (); -%! assert (oldval, newval); - -%!error errno ("foo", 1) -*/ - -DEFUN (errno_list, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} errno_list ()\n\ -Return a structure containing the system-dependent errno values.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 0) - retval = octave_errno::list (); - else - print_usage (); - - return retval; -} - -/* -%!assert (isstruct (errno_list ())) - -%!error errno_list ("foo") -*/ - -static void -check_dimensions (octave_idx_type& nr, octave_idx_type& nc, const char *warnfor) -{ - if (nr < 0 || nc < 0) - { - warning_with_id ("Octave:neg-dim-as-zero", - "%s: converting negative dimension to zero", warnfor); - - nr = (nr < 0) ? 0 : nr; - nc = (nc < 0) ? 0 : nc; - } -} - -void -check_dimensions (dim_vector& dim, const char *warnfor) -{ - bool neg = false; - - for (int i = 0; i < dim.length (); i++) - { - if (dim(i) < 0) - { - dim(i) = 0; - neg = true; - } - } - - if (neg) - warning_with_id ("Octave:neg-dim-as-zero", - "%s: converting negative dimension to zero", warnfor); -} - - -void -get_dimensions (const octave_value& a, const char *warn_for, - dim_vector& dim) -{ - if (a.is_scalar_type ()) - { - dim.resize (2); - dim(0) = a.int_value (); - dim(1) = dim(0); - } - else - { - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.columns (); - - if (nr == 1 || nc == 1) - { - Array v = a.vector_value (); - - if (error_state) - return; - - octave_idx_type n = v.length (); - dim.resize (n); - for (octave_idx_type i = 0; i < n; i++) - dim(i) = static_cast (fix (v(i))); - } - else - error ("%s (A): use %s (size (A)) instead", warn_for, warn_for); - } - - if (! error_state) - check_dimensions (dim, warn_for); // May set error_state. -} - - -void -get_dimensions (const octave_value& a, const char *warn_for, - octave_idx_type& nr, octave_idx_type& nc) -{ - if (a.is_scalar_type ()) - { - nr = nc = a.int_value (); - } - else - { - nr = a.rows (); - nc = a.columns (); - - if ((nr == 1 && nc == 2) || (nr == 2 && nc == 1)) - { - Array v = a.vector_value (); - - if (error_state) - return; - - nr = static_cast (fix (v (0))); - nc = static_cast (fix (v (1))); - } - else - error ("%s (A): use %s (size (A)) instead", warn_for, warn_for); - } - - if (! error_state) - check_dimensions (nr, nc, warn_for); // May set error_state. -} - -void -get_dimensions (const octave_value& a, const octave_value& b, - const char *warn_for, octave_idx_type& nr, octave_idx_type& nc) -{ - nr = a.is_empty () ? 0 : a.int_value (); - nc = b.is_empty () ? 0 : b.int_value (); - - if (error_state) - error ("%s: expecting two scalar arguments", warn_for); - else - check_dimensions (nr, nc, warn_for); // May set error_state. -} - -octave_idx_type -dims_to_numel (const dim_vector& dims, const octave_value_list& idx) -{ - octave_idx_type retval; - - octave_idx_type len = idx.length (); - - if (len == 0) - retval = dims.numel (); - else - { - const dim_vector dv = dims.redim (len); - retval = 1; - for (octave_idx_type i = 0; i < len; i++) - { - octave_value idxi = idx(i); - if (idxi.is_magic_colon ()) - retval *= dv(i); - else if (idxi.is_numeric_type ()) - retval *= idxi.numel (); - else - { - idx_vector jdx = idxi.index_vector (); - if (error_state) - break; - retval *= jdx.length (dv(i)); - } - } - } - - return retval; -} - -Matrix -identity_matrix (octave_idx_type nr, octave_idx_type nc) -{ - Matrix m (nr, nc, 0.0); - - if (nr > 0 && nc > 0) - { - octave_idx_type n = std::min (nr, nc); - - for (octave_idx_type i = 0; i < n; i++) - m (i, i) = 1.0; - } - - return m; -} - -FloatMatrix -float_identity_matrix (octave_idx_type nr, octave_idx_type nc) -{ - FloatMatrix m (nr, nc, 0.0); - - if (nr > 0 && nc > 0) - { - octave_idx_type n = std::min (nr, nc); - - for (octave_idx_type i = 0; i < n; i++) - m (i, i) = 1.0; - } - - return m; -} - -size_t -octave_format (std::ostream& os, const char *fmt, ...) -{ - size_t retval; - - va_list args; - va_start (args, fmt); - - retval = octave_vformat (os, fmt, args); - - va_end (args); - - return retval; -} - -size_t -octave_vformat (std::ostream& os, const char *fmt, va_list args) -{ - std::string s = octave_vasprintf (fmt, args); - - os << s; - - return s.length (); -} - -std::string -octave_vasprintf (const char *fmt, va_list args) -{ - std::string retval; - - char *result; - - int status = gnulib::vasprintf (&result, fmt, args); - - if (status >= 0) - { - retval = result; - ::free (result); - } - - return retval; -} - -std::string -octave_asprintf (const char *fmt, ...) -{ - std::string retval; - - va_list args; - va_start (args, fmt); - - retval = octave_vasprintf (fmt, args); - - va_end (args); - - return retval; -} - -void -octave_sleep (double seconds) -{ - if (seconds > 0) - { - double t; - - unsigned int usec - = static_cast (modf (seconds, &t) * 1000000); - - unsigned int sec - = ((t > std::numeric_limits::max ()) - ? std::numeric_limits::max () - : static_cast (t)); - - // Versions of these functions that accept unsigned int args are - // defined in cutils.c. - octave_sleep (sec); - octave_usleep (usec); - - octave_quit (); - } -} - -DEFUN (isindex, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isindex (@var{ind})\n\ -@deftypefnx {Built-in Function} {} isindex (@var{ind}, @var{n})\n\ -Return true if @var{ind} is a valid index. Valid indices are\n\ -either positive integers (although possibly of real data type), or logical\n\ -arrays. If present, @var{n} specifies the maximum extent of the dimension\n\ -to be indexed. When possible the internal result is cached so that\n\ -subsequent indexing using @var{ind} will not perform the check again.\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - octave_idx_type n = 0; - - if (nargin == 2) - n = args(1).idx_type_value (); - else if (nargin != 1) - print_usage (); - - if (! error_state) - { - unwind_protect frame; - - frame.protect_var (Vallow_noninteger_range_as_index); - Vallow_noninteger_range_as_index = false; - - frame.protect_var (error_state); - - frame.protect_var (discard_error_messages); - discard_error_messages = true; - - try - { - idx_vector idx = args(0).index_vector (); - if (! error_state) - { - if (nargin == 2) - retval = idx.extent (n) <= n; - else - retval = true; - } - else - retval = false; - } - catch (octave_execution_exception) - { - retval = false; - } - } - - return retval; -} - -/* -%!assert (isindex ([1, 2, 3])) -%!assert (isindex (1:3)) -%!assert (isindex ([1, 2, -3]), false) - -%!error isindex () -*/ - -octave_value_list -do_simple_cellfun (octave_value_list (*fun) (const octave_value_list&, int), - const char *fun_name, const octave_value_list& args, - int nargout) -{ - octave_value_list new_args = args, retval; - int nargin = args.length (); - OCTAVE_LOCAL_BUFFER (bool, iscell, nargin); - OCTAVE_LOCAL_BUFFER (Cell, cells, nargin); - OCTAVE_LOCAL_BUFFER (Cell, rcells, nargout); - - const Cell *ccells = cells; - - octave_idx_type numel = 1; - dim_vector dims (1, 1); - - for (int i = 0; i < nargin; i++) - { - octave_value arg = new_args(i); - iscell[i] = arg.is_cell (); - if (iscell[i]) - { - cells[i] = arg.cell_value (); - octave_idx_type n = ccells[i].numel (); - if (n == 1) - { - iscell[i] = false; - new_args(i) = ccells[i](0); - } - else if (numel == 1) - { - numel = n; - dims = ccells[i].dims (); - } - else if (dims != ccells[i].dims ()) - { - error ("%s: cell arguments must have matching sizes", fun_name); - break; - } - } - } - - if (! error_state) - { - for (int i = 0; i < nargout; i++) - rcells[i].clear (dims); - - for (octave_idx_type j = 0; j < numel; j++) - { - for (int i = 0; i < nargin; i++) - if (iscell[i]) - new_args(i) = ccells[i](j); - - octave_quit (); - - const octave_value_list tmp = fun (new_args, nargout); - - if (tmp.length () < nargout) - { - error ("%s: do_simple_cellfun: internal error", fun_name); - break; - } - else - { - for (int i = 0; i < nargout; i++) - rcells[i](j) = tmp(i); - } - } - } - - if (! error_state) - { - retval.resize (nargout); - for (int i = 0; i < nargout; i++) - retval(i) = rcells[i]; - } - - return retval; -} - -octave_value -do_simple_cellfun (octave_value_list (*fun) (const octave_value_list&, int), - const char *fun_name, const octave_value_list& args) -{ - octave_value retval; - const octave_value_list tmp = do_simple_cellfun (fun, fun_name, args, 1); - if (tmp.length () > 0) - retval = tmp(0); - - return retval; -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/utils.h --- a/libinterp/interpfcn/utils.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,130 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_utils_h) -#define octave_utils_h 1 - -#include - -#include -#include -#include - -#include "dMatrix.h" -#include "lo-utils.h" - -#include "cutils.h" - -class octave_value; -class octave_value_list; -class string_vector; - -extern OCTINTERP_API bool valid_identifier (const char *s); -extern OCTINTERP_API bool valid_identifier (const std::string& s); - -extern OCTINTERP_API bool -same_file (const std::string& f, const std::string& g); - -extern OCTINTERP_API int almost_match (const std::string& std, - const std::string& s, - int min_match_len = 1, - int case_sens = 1); - -extern OCTINTERP_API int -keyword_almost_match (const char * const *std, int *min_len, - const std::string& s, int min_toks_to_match, - int max_toks); - -extern OCTINTERP_API int empty_arg (const char *name, octave_idx_type nr, - octave_idx_type nc); - -extern OCTINTERP_API std::string -search_path_for_file (const std::string&, const string_vector&); - -extern OCTINTERP_API string_vector -search_path_for_all_files (const std::string&, const string_vector&); - -extern OCTINTERP_API std::string -file_in_path (const std::string&, const std::string&); - -extern OCTINTERP_API std::string contents_file_in_path (const std::string&); - -extern OCTINTERP_API std::string fcn_file_in_path (const std::string&); -extern OCTINTERP_API std::string oct_file_in_path (const std::string&); -extern OCTINTERP_API std::string mex_file_in_path (const std::string&); - -extern OCTINTERP_API std::string do_string_escapes (const std::string& s); - -extern OCTINTERP_API const char *undo_string_escape (char c); - -extern OCTINTERP_API std::string undo_string_escapes (const std::string& s); - -extern OCTINTERP_API void -check_dimensions (dim_vector& dim, const char *warnfor); - -extern OCTINTERP_API void -get_dimensions (const octave_value& a, const char *warn_for, - dim_vector& dim); - -extern OCTINTERP_API void -get_dimensions (const octave_value& a, const octave_value& b, - const char *warn_for, octave_idx_type& nr, - octave_idx_type& nc); - -extern OCTINTERP_API void -get_dimensions (const octave_value& a,const char *warn_for, - octave_idx_type& nr, octave_idx_type& nc); - -extern OCTINTERP_API octave_idx_type -dims_to_numel (const dim_vector& dims, const octave_value_list& idx); - -extern OCTINTERP_API Matrix -identity_matrix (octave_idx_type nr, octave_idx_type nc); - -extern OCTINTERP_API FloatMatrix -float_identity_matrix (octave_idx_type nr, octave_idx_type nc); - -extern OCTINTERP_API size_t -octave_format (std::ostream& os, const char *fmt, ...); - -extern OCTINTERP_API size_t -octave_vformat (std::ostream& os, const char *fmt, va_list args); - -extern OCTINTERP_API std::string -octave_vasprintf (const char *fmt, va_list args); - -extern OCTINTERP_API std::string octave_asprintf (const char *fmt, ...); - -extern OCTINTERP_API void octave_sleep (double seconds); - -extern OCTINTERP_API -octave_value_list -do_simple_cellfun (octave_value_list (*fun) (const octave_value_list&, int), - const char *fun_name, const octave_value_list& args, - int nargout); - -extern OCTINTERP_API -octave_value -do_simple_cellfun (octave_value_list (*fun) (const octave_value_list&, int), - const char *fun_name, const octave_value_list& args); - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/variables.cc --- a/libinterp/interpfcn/variables.cc Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2606 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include -#include -#include - -#include "file-stat.h" -#include "oct-env.h" -#include "file-ops.h" -#include "glob-match.h" -#include "regexp.h" -#include "str-vec.h" - -#include -#include "Cell.h" -#include "defun.h" -#include "dirfns.h" -#include "error.h" -#include "gripes.h" -#include "help.h" -#include "input.h" -#include "lex.h" -#include "load-path.h" -#include "octave-link.h" -#include "oct-map.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-class.h" -#include "ov-usr-fcn.h" -#include "pager.h" -#include "parse.h" -#include "symtab.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" - -// Defines layout for the whos/who -long command -static std::string Vwhos_line_format - = " %a:4; %ln:6; %cs:16:6:1; %rb:12; %lc:-1;\n"; - -void -clear_mex_functions (void) -{ - symbol_table::clear_mex_functions (); -} - -void -clear_function (const std::string& nm) -{ - symbol_table::clear_function (nm); -} - -void -clear_variable (const std::string& nm) -{ - symbol_table::clear_variable (nm); -} - -void -clear_symbol (const std::string& nm) -{ - symbol_table::clear_symbol (nm); -} - -// Attributes of variables and functions. - -// Is this octave_value a valid function? - -octave_function * -is_valid_function (const std::string& fcn_name, - const std::string& warn_for, bool warn) -{ - octave_function *ans = 0; - - if (! fcn_name.empty ()) - { - octave_value val = symbol_table::find_function (fcn_name); - - if (val.is_defined ()) - ans = val.function_value (true); - } - - if (! ans && warn) - error ("%s: the symbol '%s' is not valid as a function", - warn_for.c_str (), fcn_name.c_str ()); - - return ans; -} - -octave_function * -is_valid_function (const octave_value& arg, - const std::string& warn_for, bool warn) -{ - octave_function *ans = 0; - - std::string fcn_name; - - if (arg.is_string ()) - { - fcn_name = arg.string_value (); - - if (! error_state) - ans = is_valid_function (fcn_name, warn_for, warn); - else if (warn) - error ("%s: expecting function name as argument", warn_for.c_str ()); - } - else if (warn) - error ("%s: expecting function name as argument", warn_for.c_str ()); - - return ans; -} - -octave_function * -extract_function (const octave_value& arg, const std::string& warn_for, - const std::string& fname, const std::string& header, - const std::string& trailer) -{ - octave_function *retval = 0; - - retval = is_valid_function (arg, warn_for, 0); - - if (! retval) - { - std::string s = arg.string_value (); - - std::string cmd = header; - cmd.append (s); - cmd.append (trailer); - - if (! error_state) - { - int parse_status; - - eval_string (cmd, true, parse_status, 0); - - if (parse_status == 0) - { - retval = is_valid_function (fname, warn_for, 0); - - if (! retval) - { - error ("%s: '%s' is not valid as a function", - warn_for.c_str (), fname.c_str ()); - return retval; - } - - warning ("%s: passing function body as a string is obsolete; please use anonymous functions", - warn_for.c_str ()); - } - else - error ("%s: '%s' is not valid as a function", - warn_for.c_str (), fname.c_str ()); - } - else - error ("%s: expecting first argument to be a string", - warn_for.c_str ()); - } - - return retval; -} - -string_vector -get_struct_elts (const std::string& text) -{ - int n = 1; - - size_t pos = 0; - - size_t len = text.length (); - - while ((pos = text.find ('.', pos)) != std::string::npos) - { - if (++pos == len) - break; - - n++; - } - - string_vector retval (n); - - pos = 0; - - for (int i = 0; i < n; i++) - { - len = text.find ('.', pos); - - if (len != std::string::npos) - len -= pos; - - retval[i] = text.substr (pos, len); - - if (len != std::string::npos) - pos += len + 1; - } - - return retval; -} - -static inline bool -is_variable (const std::string& name) -{ - bool retval = false; - - if (! name.empty ()) - { - octave_value val = symbol_table::varval (name); - - retval = val.is_defined (); - } - - return retval; -} - -string_vector -generate_struct_completions (const std::string& text, - std::string& prefix, std::string& hint) -{ - string_vector names; - - size_t pos = text.rfind ('.'); - - if (pos != std::string::npos) - { - if (pos == text.length ()) - hint = ""; - else - hint = text.substr (pos+1); - - prefix = text.substr (0, pos); - - std::string base_name = prefix; - - pos = base_name.find_first_of ("{(."); - - if (pos != std::string::npos) - base_name = base_name.substr (0, pos); - - if (is_variable (base_name)) - { - int parse_status; - - unwind_protect frame; - - frame.protect_var (error_state); - frame.protect_var (warning_state); - - frame.protect_var (discard_error_messages); - frame.protect_var (discard_warning_messages); - - discard_error_messages = true; - discard_warning_messages = true; - - octave_value tmp = eval_string (prefix, true, parse_status); - - frame.run (); - - if (tmp.is_defined () && (tmp.is_map () || tmp.is_java ())) - names = tmp.map_keys (); - } - } - - return names; -} - -// FIXME -- this will have to be much smarter to work -// "correctly". - -bool -looks_like_struct (const std::string& text) -{ - bool retval = (! text.empty () - && text != "." - && text.find_first_of (file_ops::dir_sep_chars ()) == std::string::npos - && text.find ("..") == std::string::npos - && text.rfind ('.') != std::string::npos); - -#if 0 - symbol_record *sr = curr_sym_tab->lookup (text); - - if (sr && ! sr->is_function ()) - { - int parse_status; - - unwind_protect frame; - - frame.protect_var (discard_error_messages); - frame.protect_var (error_state); - - discard_error_messages = true; - - octave_value tmp = eval_string (text, true, parse_status); - - frame.run (); - - retval = (tmp.is_defined () && tmp.is_map ()); - } -#endif - - return retval; -} - -static octave_value -do_isglobal (const octave_value_list& args) -{ - octave_value retval = false; - - int nargin = args.length (); - - if (nargin != 1) - { - print_usage (); - return retval; - } - - std::string name = args(0).string_value (); - - if (error_state) - { - error ("isglobal: NAME must be a string"); - return retval; - } - - return symbol_table::is_global (name); -} - -DEFUN (isglobal, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isglobal (@var{name})\n\ -Return true if @var{name} is a globally visible variable.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -global x\n\ -isglobal (\"x\")\n\ - @result{} 1\n\ -@end group\n\ -@end example\n\ -@seealso{isvarname, exist}\n\ -@end deftypefn") -{ - return do_isglobal (args); -} - -static octave_value -safe_symbol_lookup (const std::string& symbol_name) -{ - octave_value retval; - - unwind_protect frame; - interpreter_try (frame); - - retval = symbol_table::find (symbol_name); - - error_state = 0; - - return retval; -} - -int -symbol_exist (const std::string& name, const std::string& type) -{ - int retval = 0; - - std::string struct_elts; - std::string symbol_name = name; - - size_t pos = name.find ('.'); - - if (pos != std::string::npos && pos > 0) - { - struct_elts = name.substr (pos+1); - symbol_name = name.substr (0, pos); - } - - // We shouldn't need to look in the global symbol table, since any - // name that is visible in the current scope will be in the local - // symbol table. - - octave_value val = safe_symbol_lookup (symbol_name); - - if (val.is_defined ()) - { - bool not_a_struct = struct_elts.empty (); - bool var_ok = not_a_struct /* || val.is_map_element (struct_elts) */; - - if (! retval - && var_ok - && (type == "any" || type == "var") - && (val.is_constant () || val.is_object () - || val.is_function_handle () - || val.is_anonymous_function () - || val.is_inline_function ())) - { - retval = 1; - } - - if (! retval - && (type == "any" || type == "builtin")) - { - if (not_a_struct && val.is_builtin_function ()) - { - retval = 5; - } - } - - if (! retval - && not_a_struct - && (type == "any" || type == "file") - && (val.is_user_function () || val.is_dld_function ())) - { - octave_function *f = val.function_value (true); - std::string s = f ? f->fcn_file_name () : std::string (); - - retval = s.empty () ? 103 : (val.is_user_function () ? 2 : 3); - } - } - - if (! (type == "var" || type == "builtin")) - { - if (! retval) - { - std::string file_name = lookup_autoload (name); - - if (file_name.empty ()) - file_name = load_path::find_fcn (name); - - size_t len = file_name.length (); - - if (len > 0) - { - if (type == "any" || type == "file") - { - if (len > 4 && (file_name.substr (len-4) == ".oct" - || file_name.substr (len-4) == ".mex")) - retval = 3; - else - retval = 2; - } - } - } - - if (! retval) - { - std::string file_name = file_in_path (name, ""); - - if (file_name.empty ()) - file_name = name; - - file_stat fs (file_name); - - if (fs) - { - if (type == "any" || type == "file") - retval = fs.is_dir () ? 7 : 2; - else if (type == "dir" && fs.is_dir ()) - retval = 7; - } - } - } - - return retval; -} - -#define GET_IDX(LEN) \ - static_cast ((LEN-1) * static_cast (rand ()) / RAND_MAX) - -std::string -unique_symbol_name (const std::string& basename) -{ - static const std::string alpha - = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"; - - static size_t len = alpha.length (); - - std::string nm = basename + alpha[GET_IDX (len)]; - - size_t pos = nm.length (); - - if (nm.substr (0, 2) == "__") - nm.append ("__"); - - while (symbol_exist (nm, "any")) - nm.insert (pos++, 1, alpha[GET_IDX (len)]); - - return nm; -} - -DEFUN (exist, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} exist (@var{name}, @var{type})\n\ -Return 1 if the name exists as a variable, 2 if the name is an\n\ -absolute file name, an ordinary file in Octave's @code{path}, or (after\n\ -appending @samp{.m}) a function file in Octave's @code{path}, 3 if the\n\ -name is a @samp{.oct} or @samp{.mex} file in Octave's @code{path},\n\ -5 if the name is a built-in function, 7 if the name is a directory, or 103\n\ -if the name is a function not associated with a file (entered on\n\ -the command line).\n\ -\n\ -Otherwise, return 0.\n\ -\n\ -This function also returns 2 if a regular file called @var{name}\n\ -exists in Octave's search path. If you want information about\n\ -other types of files, you should use some combination of the functions\n\ -@code{file_in_path} and @code{stat} instead.\n\ -\n\ -If the optional argument @var{type} is supplied, check only for\n\ -symbols of the specified type. Valid types are\n\ -\n\ -@table @asis\n\ -@item \"var\"\n\ -Check only for variables.\n\ -\n\ -@item \"builtin\"\n\ -Check only for built-in functions.\n\ -\n\ -@item \"file\"\n\ -Check only for files and directories.\n\ -\n\ -@item \"dir\"\n\ -Check only for directories.\n\ -@end table\n\ -\n\ -@seealso{file_in_loadpath, file_in_path, stat}\n\ -@end deftypefn") -{ - octave_value retval = false; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - std::string name = args(0).string_value (); - - if (! error_state) - { - std::string type - = (nargin == 2) ? args(1).string_value () : std::string ("any"); - - if (! error_state) - retval = symbol_exist (name, type); - else - error ("exist: TYPE must be a string"); - } - else - error ("exist: NAME must be a string"); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! if (isunix ()) -%! assert (exist ("/tmp") == 7); -%! assert (exist ("/tmp", "file") == 7); -%! assert (exist ("/tmp", "dir") == 7); -%! assert (exist ("/bin/sh") == 2); -%! assert (exist ("/bin/sh", "file") == 2); -%! assert (exist ("/bin/sh", "dir") == 0); -%! assert (exist ("/dev/null") == 2); -%! assert (exist ("/dev/null", "file") == 2); -%! assert (exist ("/dev/null", "dir") == 0); -%! endif -*/ - -octave_value -lookup_function_handle (const std::string& nm) -{ - octave_value val = symbol_table::varval (nm); - - return val.is_function_handle () ? val : octave_value (); -} - -octave_value -get_global_value (const std::string& nm, bool silent) -{ - octave_value val = symbol_table::global_varval (nm); - - if (val.is_undefined () && ! silent) - error ("get_global_value: undefined symbol '%s'", nm.c_str ()); - - return val; -} - -void -set_global_value (const std::string& nm, const octave_value& val) -{ - symbol_table::global_assign (nm, val); -} - -octave_value -get_top_level_value (const std::string& nm, bool silent) -{ - octave_value val = symbol_table::top_level_varval (nm); - - if (val.is_undefined () && ! silent) - error ("get_top_level_value: undefined symbol '%s'", nm.c_str ()); - - return val; -} - -void -set_top_level_value (const std::string& nm, const octave_value& val) -{ - symbol_table::top_level_assign (nm, val); -} - -// Variable values. - -static bool -wants_local_change (const octave_value_list& args, int& nargin) -{ - bool retval = false; - - if (nargin == 2) - { - if (args(1).is_string () && args(1).string_value () == "local") - { - nargin = 1; - retval = true; - } - else - { - error_with_cfn ("expecting second argument to be \"local\""); - nargin = 0; - } - } - - return retval; -} - -template -bool try_local_protect (T& var) -{ - octave_user_code *curr_usr_code = octave_call_stack::caller_user_code (); - octave_user_function *curr_usr_fcn = 0; - if (curr_usr_code && curr_usr_code->is_user_function ()) - curr_usr_fcn = dynamic_cast (curr_usr_code); - - if (curr_usr_fcn && curr_usr_fcn->local_protect (var)) - return true; - else - return false; -} - -octave_value -set_internal_variable (bool& var, const octave_value_list& args, - int nargout, const char *nm) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargout > 0 || nargin == 0) - retval = var; - - if (wants_local_change (args, nargin)) - { - if (! try_local_protect (var)) - warning ("\"local\" has no effect outside a function"); - } - - if (nargin == 1) - { - bool bval = args(0).bool_value (); - - if (! error_state) - var = bval; - else - error ("%s: expecting arg to be a logical value", nm); - } - else if (nargin > 1) - print_usage (); - - return retval; -} - -octave_value -set_internal_variable (char& var, const octave_value_list& args, - int nargout, const char *nm) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargout > 0 || nargin == 0) - retval = var; - - if (wants_local_change (args, nargin)) - { - if (! try_local_protect (var)) - warning ("\"local\" has no effect outside a function"); - } - - if (nargin == 1) - { - std::string sval = args(0).string_value (); - - if (! error_state) - { - switch (sval.length ()) - { - case 1: - var = sval[0]; - break; - - case 0: - var = '\0'; - break; - - default: - error ("%s: argument must be a single character", nm); - break; - } - } - else - error ("%s: argument must be a single character", nm); - } - else if (nargin > 1) - print_usage (); - - return retval; -} - -octave_value -set_internal_variable (int& var, const octave_value_list& args, - int nargout, const char *nm, - int minval, int maxval) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargout > 0 || nargin == 0) - retval = var; - - if (wants_local_change (args, nargin)) - { - if (! try_local_protect (var)) - warning ("\"local\" has no effect outside a function"); - } - - if (nargin == 1) - { - int ival = args(0).int_value (); - - if (! error_state) - { - if (ival < minval) - error ("%s: expecting arg to be greater than %d", nm, minval); - else if (ival > maxval) - error ("%s: expecting arg to be less than or equal to %d", - nm, maxval); - else - var = ival; - } - else - error ("%s: expecting arg to be an integer value", nm); - } - else if (nargin > 1) - print_usage (); - - return retval; -} - -octave_value -set_internal_variable (double& var, const octave_value_list& args, - int nargout, const char *nm, - double minval, double maxval) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargout > 0 || nargin == 0) - retval = var; - - if (wants_local_change (args, nargin)) - { - if (! try_local_protect (var)) - warning ("\"local\" has no effect outside a function"); - } - - if (nargin == 1) - { - double dval = args(0).scalar_value (); - - if (! error_state) - { - if (dval < minval) - error ("%s: expecting arg to be greater than %g", minval); - else if (dval > maxval) - error ("%s: expecting arg to be less than or equal to %g", maxval); - else - var = dval; - } - else - error ("%s: expecting arg to be a scalar value", nm); - } - else if (nargin > 1) - print_usage (); - - return retval; -} - -octave_value -set_internal_variable (std::string& var, const octave_value_list& args, - int nargout, const char *nm, bool empty_ok) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargout > 0 || nargin == 0) - retval = var; - - if (wants_local_change (args, nargin)) - { - if (! try_local_protect (var)) - warning ("\"local\" has no effect outside a function"); - } - - if (nargin == 1) - { - std::string sval = args(0).string_value (); - - if (! error_state) - { - if (empty_ok || ! sval.empty ()) - var = sval; - else - error ("%s: value must not be empty", nm); - } - else - error ("%s: expecting arg to be a character string", nm); - } - else if (nargin > 1) - print_usage (); - - return retval; -} - -octave_value -set_internal_variable (int& var, const octave_value_list& args, - int nargout, const char *nm, const char **choices) -{ - octave_value retval; - int nchoices = 0; - while (choices[nchoices] != 0) - nchoices++; - - int nargin = args.length (); - assert (var < nchoices); - - if (nargout > 0 || nargin == 0) - retval = choices[var]; - - if (wants_local_change (args, nargin)) - { - if (! try_local_protect (var)) - warning ("\"local\" has no effect outside a function"); - } - - if (nargin == 1) - { - std::string sval = args(0).string_value (); - - if (! error_state) - { - int i = 0; - for (; i < nchoices; i++) - { - if (sval == choices[i]) - { - var = i; - break; - } - } - if (i == nchoices) - error ("%s: value not allowed (\"%s\")", nm, sval.c_str ()); - } - else - error ("%s: expecting arg to be a character string", nm); - } - else if (nargin > 1) - print_usage (); - - return retval; -} - -struct -whos_parameter -{ - char command; - char modifier; - int parameter_length; - int first_parameter_length; - int balance; - std::string text; - std::string line; -}; - -static void -print_descriptor (std::ostream& os, std::list params) -{ - // This method prints a line of information on a given symbol - std::list::iterator i = params.begin (); - std::ostringstream param_buf; - - while (i != params.end ()) - { - whos_parameter param = *i; - - if (param.command != '\0') - { - // Do the actual printing - switch (param.modifier) - { - case 'l': - os << std::setiosflags (std::ios::left) << std::setw (param.parameter_length); - param_buf << std::setiosflags (std::ios::left) << std::setw (param.parameter_length); - break; - - case 'r': - os << std::setiosflags (std::ios::right) << std::setw (param.parameter_length); - param_buf << std::setiosflags (std::ios::right) << std::setw (param.parameter_length); - break; - - case 'c': - if (param.command != 's') - { - os << std::setiosflags (std::ios::left) - << std::setw (param.parameter_length); - param_buf << std::setiosflags (std::ios::left) - << std::setw (param.parameter_length); - } - break; - - default: - os << std::setiosflags (std::ios::left) << std::setw (param.parameter_length); - param_buf << std::setiosflags (std::ios::left) << std::setw (param.parameter_length); - } - - if (param.command == 's' && param.modifier == 'c') - { - int a, b; - - if (param.modifier == 'c') - { - a = param.first_parameter_length - param.balance; - a = (a < 0 ? 0 : a); - b = param.parameter_length - a - param.text . length (); - b = (b < 0 ? 0 : b); - os << std::setiosflags (std::ios::left) << std::setw (a) - << "" << std::resetiosflags (std::ios::left) << param.text - << std::setiosflags (std::ios::left) - << std::setw (b) << "" - << std::resetiosflags (std::ios::left); - param_buf << std::setiosflags (std::ios::left) << std::setw (a) - << "" << std::resetiosflags (std::ios::left) << param.line - << std::setiosflags (std::ios::left) - << std::setw (b) << "" - << std::resetiosflags (std::ios::left); - } - } - else - { - os << param.text; - param_buf << param.line; - } - os << std::resetiosflags (std::ios::left) - << std::resetiosflags (std::ios::right); - param_buf << std::resetiosflags (std::ios::left) - << std::resetiosflags (std::ios::right); - i++; - } - else - { - os << param.text; - param_buf << param.line; - i++; - } - } - - os << param_buf.str (); -} - -// FIXME -- This is a bit of a kluge. We'd like to just use val.dims() -// and if val is an object, expect that dims will call size if it is -// overloaded by a user-defined method. But there are currently some -// unresolved const issues that prevent that solution from working. - -std::string -get_dims_str (const octave_value& val) -{ - octave_value tmp = val; - - Matrix sz = tmp.size (); - - dim_vector dv = dim_vector::alloc (sz.numel ()); - - for (octave_idx_type i = 0; i < dv.length (); i++) - dv(i) = sz(i); - - return dv.str (); -} - -class -symbol_info_list -{ -private: - struct symbol_info - { - symbol_info (const symbol_table::symbol_record& sr, - const std::string& expr_str = std::string (), - const octave_value& expr_val = octave_value ()) - : name (expr_str.empty () ? sr.name () : expr_str), - varval (expr_val.is_undefined () ? sr.varval () : expr_val), - is_automatic (sr.is_automatic ()), - is_complex (varval.is_complex_type ()), - is_formal (sr.is_formal ()), - is_global (sr.is_global ()), - is_persistent (sr.is_persistent ()) - { } - - void display_line (std::ostream& os, - const std::list& params) const - { - std::string dims_str = get_dims_str (varval); - - std::list::const_iterator i = params.begin (); - - while (i != params.end ()) - { - whos_parameter param = *i; - - if (param.command != '\0') - { - // Do the actual printing. - - switch (param.modifier) - { - case 'l': - os << std::setiosflags (std::ios::left) - << std::setw (param.parameter_length); - break; - - case 'r': - os << std::setiosflags (std::ios::right) - << std::setw (param.parameter_length); - break; - - case 'c': - if (param.command == 's') - { - int front = param.first_parameter_length - - dims_str.find ('x'); - int back = param.parameter_length - - dims_str.length () - - front; - front = (front > 0) ? front : 0; - back = (back > 0) ? back : 0; - - os << std::setiosflags (std::ios::left) - << std::setw (front) - << "" - << std::resetiosflags (std::ios::left) - << dims_str - << std::setiosflags (std::ios::left) - << std::setw (back) - << "" - << std::resetiosflags (std::ios::left); - } - else - { - os << std::setiosflags (std::ios::left) - << std::setw (param.parameter_length); - } - break; - - default: - error ("whos_line_format: modifier '%c' unknown", - param.modifier); - - os << std::setiosflags (std::ios::right) - << std::setw (param.parameter_length); - } - - switch (param.command) - { - case 'a': - { - char tmp[6]; - - tmp[0] = (is_automatic ? 'a' : ' '); - tmp[1] = (is_complex ? 'c' : ' '); - tmp[2] = (is_formal ? 'f' : ' '); - tmp[3] = (is_global ? 'g' : ' '); - tmp[4] = (is_persistent ? 'p' : ' '); - tmp[5] = 0; - - os << tmp; - } - break; - - case 'b': - os << varval.byte_size (); - break; - - case 'c': - os << varval.class_name (); - break; - - case 'e': - os << varval.capacity (); - break; - - case 'n': - os << name; - break; - - case 's': - if (param.modifier != 'c') - os << dims_str; - break; - - case 't': - os << varval.type_name (); - break; - - default: - error ("whos_line_format: command '%c' unknown", - param.command); - } - - os << std::resetiosflags (std::ios::left) - << std::resetiosflags (std::ios::right); - i++; - } - else - { - os << param.text; - i++; - } - } - } - - std::string name; - octave_value varval; - bool is_automatic; - bool is_complex; - bool is_formal; - bool is_global; - bool is_persistent; - }; - -public: - symbol_info_list (void) : lst () { } - - symbol_info_list (const symbol_info_list& sil) : lst (sil.lst) { } - - symbol_info_list& operator = (const symbol_info_list& sil) - { - if (this != &sil) - lst = sil.lst; - - return *this; - } - - ~symbol_info_list (void) { } - - void append (const symbol_table::symbol_record& sr) - { - lst.push_back (symbol_info (sr)); - } - - void append (const symbol_table::symbol_record& sr, - const std::string& expr_str, - const octave_value& expr_val) - { - lst.push_back (symbol_info (sr, expr_str, expr_val)); - } - - size_t size (void) const { return lst.size (); } - - bool empty (void) const { return lst.empty (); } - - octave_map - map_value (const std::string& caller_function_name, int nesting_level) const - { - size_t len = lst.size (); - - Cell name_info (len, 1); - Cell size_info (len, 1); - Cell bytes_info (len, 1); - Cell class_info (len, 1); - Cell global_info (len, 1); - Cell sparse_info (len, 1); - Cell complex_info (len, 1); - Cell nesting_info (len, 1); - Cell persistent_info (len, 1); - - std::list::const_iterator p = lst.begin (); - - for (size_t j = 0; j < len; j++) - { - const symbol_info& si = *p++; - - octave_scalar_map ni; - - ni.assign ("function", caller_function_name); - ni.assign ("level", nesting_level); - - name_info(j) = si.name; - global_info(j) = si.is_global; - persistent_info(j) = si.is_persistent; - - octave_value val = si.varval; - - size_info(j) = val.size (); - bytes_info(j) = val.byte_size (); - class_info(j) = val.class_name (); - sparse_info(j) = val.is_sparse_type (); - complex_info(j) = val.is_complex_type (); - nesting_info(j) = ni; - } - - octave_map info; - - info.assign ("name", name_info); - info.assign ("size", size_info); - info.assign ("bytes", bytes_info); - info.assign ("class", class_info); - info.assign ("global", global_info); - info.assign ("sparse", sparse_info); - info.assign ("complex", complex_info); - info.assign ("nesting", nesting_info); - info.assign ("persistent", persistent_info); - - return info; - } - - void display (std::ostream& os) - { - if (! lst.empty ()) - { - size_t bytes = 0; - size_t elements = 0; - - std::list params = parse_whos_line_format (); - - print_descriptor (os, params); - - octave_stdout << "\n"; - - for (std::list::const_iterator p = lst.begin (); - p != lst.end (); p++) - { - p->display_line (os, params); - - octave_value val = p->varval; - - elements += val.capacity (); - bytes += val.byte_size (); - } - - os << "\nTotal is " << elements - << (elements == 1 ? " element" : " elements") - << " using " << bytes << (bytes == 1 ? " byte" : " bytes") - << "\n"; - } - } - - // Parse the string whos_line_format, and return a parameter list, - // containing all information needed to print the given - // attributtes of the symbols. - std::list parse_whos_line_format (void) - { - int idx; - size_t format_len = Vwhos_line_format.length (); - char garbage; - std::list params; - - size_t bytes1; - int elements1; - - std::string param_string = "abcenst"; - Array param_length (dim_vector (param_string.length (), 1)); - Array param_names (dim_vector (param_string.length (), 1)); - size_t pos_a, pos_b, pos_c, pos_e, pos_n, pos_s, pos_t; - - pos_a = param_string.find ('a'); // Attributes - pos_b = param_string.find ('b'); // Bytes - pos_c = param_string.find ('c'); // Class - pos_e = param_string.find ('e'); // Elements - pos_n = param_string.find ('n'); // Name - pos_s = param_string.find ('s'); // Size - pos_t = param_string.find ('t'); // Type - - param_names(pos_a) = "Attr"; - param_names(pos_b) = "Bytes"; - param_names(pos_c) = "Class"; - param_names(pos_e) = "Elements"; - param_names(pos_n) = "Name"; - param_names(pos_s) = "Size"; - param_names(pos_t) = "Type"; - - for (size_t i = 0; i < param_string.length (); i++) - param_length(i) = param_names(i).length (); - - // The attribute column needs size 5. - param_length(pos_a) = 5; - - // Calculating necessary spacing for name column, - // bytes column, elements column and class column - - for (std::list::const_iterator p = lst.begin (); - p != lst.end (); p++) - { - std::stringstream ss1, ss2; - std::string str; - - str = p->name; - param_length(pos_n) = ((str.length () - > static_cast (param_length(pos_n))) - ? str.length () : param_length(pos_n)); - - octave_value val = p->varval; - - str = val.type_name (); - param_length(pos_t) = ((str.length () - > static_cast (param_length(pos_t))) - ? str.length () : param_length(pos_t)); - - elements1 = val.capacity (); - ss1 << elements1; - str = ss1.str (); - param_length(pos_e) = ((str.length () - > static_cast (param_length(pos_e))) - ? str.length () : param_length(pos_e)); - - bytes1 = val.byte_size (); - ss2 << bytes1; - str = ss2.str (); - param_length(pos_b) = ((str.length () - > static_cast (param_length(pos_b))) - ? str.length () : param_length (pos_b)); - } - - idx = 0; - while (static_cast (idx) < format_len) - { - whos_parameter param; - param.command = '\0'; - - if (Vwhos_line_format[idx] == '%') - { - bool error_encountered = false; - param.modifier = 'r'; - param.parameter_length = 0; - - int a = 0, b = -1, balance = 1; - unsigned int items; - size_t pos; - std::string cmd; - - // Parse one command from whos_line_format - cmd = Vwhos_line_format.substr (idx, Vwhos_line_format.length ()); - pos = cmd.find (';'); - if (pos != std::string::npos) - cmd = cmd.substr (0, pos+1); - else - error ("parameter without ; in whos_line_format"); - - idx += cmd.length (); - - // FIXME -- use iostream functions instead of sscanf! - - if (cmd.find_first_of ("crl") != 1) - items = sscanf (cmd.c_str (), "%c%c:%d:%d:%d;", - &garbage, ¶m.command, &a, &b, &balance); - else - items = sscanf (cmd.c_str (), "%c%c%c:%d:%d:%d;", - &garbage, ¶m.modifier, ¶m.command, - &a, &b, &balance) - 1; - - if (items < 2) - { - error ("whos_line_format: parameter structure without command in whos_line_format"); - error_encountered = true; - } - - // Insert data into parameter - param.first_parameter_length = 0; - pos = param_string.find (param.command); - if (pos != std::string::npos) - { - param.parameter_length = param_length(pos); - param.text = param_names(pos); - param.line.assign (param_names(pos).length (), '='); - - param.parameter_length = (a > param.parameter_length - ? a : param.parameter_length); - if (param.command == 's' && param.modifier == 'c' && b > 0) - param.first_parameter_length = b; - } - else - { - error ("whos_line_format: '%c' is not a command", - param.command); - error_encountered = true; - } - - if (param.command == 's') - { - // Have to calculate space needed for printing - // matrix dimensions Space needed for Size column is - // hard to determine in prior, because it depends on - // dimensions to be shown. That is why it is - // recalculated for each Size-command int first, - // rest = 0, total; - int rest = 0; - int first = param.first_parameter_length; - int total = param.parameter_length; - - for (std::list::const_iterator p = lst.begin (); - p != lst.end (); p++) - { - octave_value val = p->varval; - std::string dims_str = get_dims_str (val); - int first1 = dims_str.find ('x'); - int total1 = dims_str.length (); - int rest1 = total1 - first1; - rest = (rest1 > rest ? rest1 : rest); - first = (first1 > first ? first1 : first); - total = (total1 > total ? total1 : total); - } - - if (param.modifier == 'c') - { - if (first < balance) - first += balance - first; - if (rest + balance < param.parameter_length) - rest += param.parameter_length - rest - balance; - - param.parameter_length = first + rest; - param.first_parameter_length = first; - param.balance = balance; - } - else - { - param.parameter_length = total; - param.first_parameter_length = 0; - } - } - else if (param.modifier == 'c') - { - error ("whos_line_format: modifier 'c' not available for command '%c'", - param.command); - error_encountered = true; - } - - // What happens if whos_line_format contains negative numbers - // at param_length positions? - param.balance = (b < 0 ? 0 : param.balance); - param.first_parameter_length = (b < 0 ? 0 : - param.first_parameter_length); - param.parameter_length = (a < 0 - ? 0 - : (param.parameter_length - < param_length(pos_s) - ? param_length(pos_s) - : param.parameter_length)); - - // Parameter will not be pushed into parameter list if ... - if (! error_encountered) - params.push_back (param); - } - else - { - // Text string, to be printed as it is ... - std::string text; - size_t pos; - text = Vwhos_line_format.substr (idx, Vwhos_line_format.length ()); - pos = text.find ('%'); - if (pos != std::string::npos) - text = text.substr (0, pos); - - // Push parameter into list ... - idx += text.length (); - param.text=text; - param.line.assign (text.length (), ' '); - params.push_back (param); - } - } - - return params; - } - -private: - std::list lst; - -}; - -static octave_value -do_who (int argc, const string_vector& argv, bool return_list, - bool verbose = false, std::string msg = std::string ()) -{ - octave_value retval; - - std::string my_name = argv[0]; - - bool global_only = false; - bool have_regexp = false; - - int i; - for (i = 1; i < argc; i++) - { - if (argv[i] == "-file") - { - // FIXME. This is an inefficient manner to implement this as the - // variables are loaded in to a temporary context and then treated. - // It would be better to refecat symbol_info_list to not store the - // symbol records and then use it in load-save.cc (do_load) to - // implement this option there so that the variables are never - // stored at all. - if (i == argc - 1) - error ("whos: -file argument must be followed by a file name"); - else - { - std::string nm = argv[i + 1]; - - unwind_protect frame; - - // Set up temporary scope. - - symbol_table::scope_id tmp_scope = symbol_table::alloc_scope (); - frame.add_fcn (symbol_table::erase_scope, tmp_scope); - - symbol_table::set_scope (tmp_scope); - - octave_call_stack::push (tmp_scope, 0); - frame.add_fcn (octave_call_stack::pop); - - frame.add_fcn (symbol_table::clear_variables); - - feval ("load", octave_value (nm), 0); - - if (! error_state) - { - std::string newmsg = std::string ("Variables in the file ") + - nm + ":\n\n"; - - retval = do_who (i, argv, return_list, verbose, newmsg); - } - } - - return retval; - } - else if (argv[i] == "-regexp") - have_regexp = true; - else if (argv[i] == "global") - global_only = true; - else if (argv[i][0] == '-') - warning ("%s: unrecognized option '%s'", my_name.c_str (), - argv[i].c_str ()); - else - break; - } - - int npats = argc - i; - string_vector pats; - if (npats > 0) - { - pats.resize (npats); - for (int j = 0; j < npats; j++) - pats[j] = argv[i+j]; - } - else - { - pats.resize (++npats); - pats[0] = "*"; - } - - symbol_info_list symbol_stats; - std::list symbol_names; - - for (int j = 0; j < npats; j++) - { - std::string pat = pats[j]; - - if (have_regexp) - { - std::list tmp = global_only - ? symbol_table::regexp_global_variables (pat) - : symbol_table::regexp_variables (pat); - - for (std::list::const_iterator p = tmp.begin (); - p != tmp.end (); p++) - { - if (p->is_variable ()) - { - if (verbose) - symbol_stats.append (*p); - else - symbol_names.push_back (p->name ()); - } - } - } - else - { - size_t pos = pat.find_first_of (".({"); - - if (pos != std::string::npos && pos > 0) - { - if (verbose) - { - // NOTE: we can only display information for - // expressions based on global values if the variable is - // global in the current scope because we currently have - // no way of looking up the base value in the global - // scope and then evaluating the arguments in the - // current scope. - - std::string base_name = pat.substr (0, pos); - - if (symbol_table::is_variable (base_name)) - { - symbol_table::symbol_record sr - = symbol_table::find_symbol (base_name); - - if (! global_only || sr.is_global ()) - { - int parse_status; - - octave_value expr_val - = eval_string (pat, true, parse_status); - - if (! error_state) - symbol_stats.append (sr, pat, expr_val); - else - return retval; - } - } - } - } - else - { - std::list tmp = global_only - ? symbol_table::glob_global_variables (pat) - : symbol_table::glob_variables (pat); - - for (std::list::const_iterator p = tmp.begin (); - p != tmp.end (); p++) - { - if (p->is_variable ()) - { - if (verbose) - symbol_stats.append (*p); - else - symbol_names.push_back (p->name ()); - } - } - } - } - } - - if (return_list) - { - if (verbose) - { - std::string caller_function_name; - octave_function *caller = octave_call_stack::caller (); - if (caller) - caller_function_name = caller->name (); - - retval = symbol_stats.map_value (caller_function_name, 1); - } - else - retval = Cell (string_vector (symbol_names)); - } - else if (! (symbol_stats.empty () && symbol_names.empty ())) - { - if (msg.length () == 0) - if (global_only) - octave_stdout << "Global variables:\n\n"; - else - octave_stdout << "Variables in the current scope:\n\n"; - else - octave_stdout << msg; - - if (verbose) - symbol_stats.display (octave_stdout); - else - { - string_vector names (symbol_names); - - names.list_in_columns (octave_stdout); - } - - octave_stdout << "\n"; - } - - return retval; -} - -DEFUN (who, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Command} {} who\n\ -@deftypefnx {Command} {} who pattern @dots{}\n\ -@deftypefnx {Command} {} who option pattern @dots{}\n\ -@deftypefnx {Command} {C =} who (\"pattern\", @dots{})\n\ -List currently defined variables matching the given patterns. Valid\n\ -pattern syntax is the same as described for the @code{clear} command.\n\ -If no patterns are supplied, all variables are listed.\n\ -By default, only variables visible in the local scope are displayed.\n\ -\n\ -The following are valid options but may not be combined.\n\ -\n\ -@table @code\n\ -@item global\n\ -List variables in the global scope rather than the current scope.\n\ -\n\ -@item -regexp\n\ -The patterns are considered to be regular expressions when matching the\n\ -variables to display. The same pattern syntax accepted by\n\ -the @code{regexp} function is used.\n\ -\n\ -@item -file\n\ -The next argument is treated as a filename. All variables found within the\n\ -specified file are listed. No patterns are accepted when reading variables\n\ -from a file.\n\ -@end table\n\ -\n\ -If called as a function, return a cell array of defined variable names\n\ -matching the given patterns.\n\ -@seealso{whos, isglobal, isvarname, exist, regexp}\n\ -@end deftypefn") -{ - octave_value retval; - - if (nargout < 2) - { - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("who"); - - if (! error_state) - retval = do_who (argc, argv, nargout == 1); - } - else - print_usage (); - - return retval; -} - -DEFUN (whos, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Command} {} whos\n\ -@deftypefnx {Command} {} whos pattern @dots{}\n\ -@deftypefnx {Command} {} whos option pattern @dots{}\n\ -@deftypefnx {Command} {S =} whos (\"pattern\", @dots{})\n\ -Provide detailed information on currently defined variables matching the\n\ -given patterns. Options and pattern syntax are the same as for the\n\ -@code{who} command. Extended information about each variable is\n\ -summarized in a table with the following default entries.\n\ -\n\ -@table @asis\n\ -@item Attr\n\ -Attributes of the listed variable. Possible attributes are:\n\ -\n\ -@table @asis\n\ -@item blank\n\ -Variable in local scope\n\ -\n\ -@item @code{a}\n\ -Automatic variable. An automatic variable is one created by the\n\ -interpreter, for example @code{argn}.\n\ -\n\ -@item @code{c}\n\ -Variable of complex type.\n\ -\n\ -@item @code{f}\n\ -Formal parameter (function argument).\n\ -\n\ -@item @code{g}\n\ -Variable with global scope.\n\ -\n\ -@item @code{p}\n\ -Persistent variable.\n\ -@end table\n\ -\n\ -@item Name\n\ -The name of the variable.\n\ -\n\ -@item Size\n\ -The logical size of the variable. A scalar is 1x1, a vector is\n\ -@nospell{1xN} or @nospell{Nx1}, a 2-D matrix is @nospell{MxN}.\n\ -\n\ -@item Bytes\n\ -The amount of memory currently used to store the variable.\n\ -\n\ -@item Class\n\ -The class of the variable. Examples include double, single, char, uint16,\n\ -cell, and struct.\n\ -@end table\n\ -\n\ -The table can be customized to display more or less information through\n\ -the function @code{whos_line_format}.\n\ -\n\ -If @code{whos} is called as a function, return a struct array of defined\n\ -variable names matching the given patterns. Fields in the structure\n\ -describing each variable are: name, size, bytes, class, global, sparse,\n\ -complex, nesting, persistent.\n\ -@seealso{who, whos_line_format}\n\ -@end deftypefn") -{ - octave_value retval; - - if (nargout < 2) - { - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("whos"); - - if (! error_state) - retval = do_who (argc, argv, nargout == 1, true); - } - else - print_usage (); - - return retval; -} - -// Defining variables. - -void -bind_ans (const octave_value& val, bool print) -{ - static std::string ans = "ans"; - - if (val.is_defined ()) - { - if (val.is_cs_list ()) - { - octave_value_list lst = val.list_value (); - - for (octave_idx_type i = 0; i < lst.length (); i++) - bind_ans (lst(i), print); - } - else - { - symbol_table::force_assign (ans, val); - - if (print) - val.print_with_name (octave_stdout, ans); - } - } -} - -void -bind_internal_variable (const std::string& fname, const octave_value& val) -{ - octave_value_list args; - - args(0) = val; - - feval (fname, args, 0); -} - -void -mlock (void) -{ - octave_function *fcn = octave_call_stack::current (); - - if (fcn) - fcn->lock (); - else - error ("mlock: invalid use outside a function"); -} - -void -munlock (const std::string& nm) -{ - octave_value val = symbol_table::find_function (nm); - - if (val.is_defined ()) - { - octave_function *fcn = val.function_value (); - - if (fcn) - fcn->unlock (); - } -} - -bool -mislocked (const std::string& nm) -{ - bool retval = false; - - octave_value val = symbol_table::find_function (nm); - - if (val.is_defined ()) - { - octave_function *fcn = val.function_value (); - - if (fcn) - retval = fcn->islocked (); - } - - return retval; -} - -DEFUN (mlock, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} mlock ()\n\ -Lock the current function into memory so that it can't be cleared.\n\ -@seealso{munlock, mislocked, persistent}\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 0) - { - octave_function *fcn = octave_call_stack::caller (); - - if (fcn) - fcn->lock (); - else - error ("mlock: invalid use outside a function"); - } - else - print_usage (); - - return retval; -} - -DEFUN (munlock, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} munlock ()\n\ -@deftypefnx {Built-in Function} {} munlock (@var{fcn})\n\ -Unlock the named function @var{fcn}. If no function is named\n\ -then unlock the current function.\n\ -@seealso{mlock, mislocked, persistent}\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - std::string name = args(0).string_value (); - - if (! error_state) - munlock (name); - else - error ("munlock: FCN must be a string"); - } - else if (args.length () == 0) - { - octave_function *fcn = octave_call_stack::caller (); - - if (fcn) - fcn->unlock (); - else - error ("munlock: invalid use outside a function"); - } - else - print_usage (); - - return retval; -} - - -DEFUN (mislocked, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} mislocked ()\n\ -@deftypefnx {Built-in Function} {} mislocked (@var{fcn})\n\ -Return true if the named function @var{fcn} is locked. If no function is\n\ -named then return true if the current function is locked.\n\ -@seealso{mlock, munlock, persistent}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - { - std::string name = args(0).string_value (); - - if (! error_state) - retval = mislocked (name); - else - error ("mislocked: FCN must be a string"); - } - else if (args.length () == 0) - { - octave_function *fcn = octave_call_stack::caller (); - - if (fcn) - retval = fcn->islocked (); - else - error ("mislocked: invalid use outside a function"); - } - else - print_usage (); - - return retval; -} - -// Deleting names from the symbol tables. - -static inline bool -name_matches_any_pattern (const std::string& nm, const string_vector& argv, - int argc, int idx, bool have_regexp = false) -{ - bool retval = false; - - for (int k = idx; k < argc; k++) - { - std::string patstr = argv[k]; - if (! patstr.empty ()) - { - if (have_regexp) - { - if (is_regexp_match (patstr, nm)) - { - retval = true; - break; - } - } - else - { - glob_match pattern (patstr); - - if (pattern.match (nm)) - { - retval = true; - break; - } - } - } - } - - return retval; -} - -static inline void -maybe_warn_exclusive (bool exclusive) -{ - if (exclusive) - warning ("clear: ignoring --exclusive option"); -} - -static void -do_clear_functions (const string_vector& argv, int argc, int idx, - bool exclusive = false) -{ - if (idx == argc) - symbol_table::clear_functions (); - else - { - if (exclusive) - { - string_vector fcns = symbol_table::user_function_names (); - - int fcount = fcns.length (); - - for (int i = 0; i < fcount; i++) - { - std::string nm = fcns[i]; - - if (! name_matches_any_pattern (nm, argv, argc, idx)) - symbol_table::clear_function (nm); - } - } - else - { - while (idx < argc) - symbol_table::clear_function_pattern (argv[idx++]); - } - } -} - -static void -do_clear_globals (const string_vector& argv, int argc, int idx, - bool exclusive = false) -{ - if (idx == argc) - { - string_vector gvars = symbol_table::global_variable_names (); - - int gcount = gvars.length (); - - for (int i = 0; i < gcount; i++) - symbol_table::clear_global (gvars[i]); - } - else - { - if (exclusive) - { - string_vector gvars = symbol_table::global_variable_names (); - - int gcount = gvars.length (); - - for (int i = 0; i < gcount; i++) - { - std::string nm = gvars[i]; - - if (! name_matches_any_pattern (nm, argv, argc, idx)) - symbol_table::clear_global (nm); - } - } - else - { - while (idx < argc) - symbol_table::clear_global_pattern (argv[idx++]); - } - } -} - -static void -do_clear_variables (const string_vector& argv, int argc, int idx, - bool exclusive = false, bool have_regexp = false) -{ - if (idx == argc) - symbol_table::clear_variables (); - else - { - if (exclusive) - { - string_vector lvars = symbol_table::variable_names (); - - int lcount = lvars.length (); - - for (int i = 0; i < lcount; i++) - { - std::string nm = lvars[i]; - - if (! name_matches_any_pattern (nm, argv, argc, idx, have_regexp)) - symbol_table::clear_variable (nm); - } - } - else - { - if (have_regexp) - while (idx < argc) - symbol_table::clear_variable_regexp (argv[idx++]); - else - while (idx < argc) - symbol_table::clear_variable_pattern (argv[idx++]); - } - } -} - -static void -do_clear_symbols (const string_vector& argv, int argc, int idx, - bool exclusive = false) -{ - if (idx == argc) - symbol_table::clear_variables (); - else - { - if (exclusive) - { - // FIXME -- is this really what we want, or do we - // somehow want to only clear the functions that are not - // shadowed by local variables? It seems that would be a - // bit harder to do. - - do_clear_variables (argv, argc, idx, exclusive); - do_clear_functions (argv, argc, idx, exclusive); - } - else - { - while (idx < argc) - symbol_table::clear_symbol_pattern (argv[idx++]); - } - } -} - -static void -do_matlab_compatible_clear (const string_vector& argv, int argc, int idx) -{ - // This is supposed to be mostly Matlab compatible. - - for (; idx < argc; idx++) - { - if (argv[idx] == "all" - && ! symbol_table::is_local_variable ("all")) - { - symbol_table::clear_all (); - } - else if (argv[idx] == "functions" - && ! symbol_table::is_local_variable ("functions")) - { - do_clear_functions (argv, argc, ++idx); - } - else if (argv[idx] == "global" - && ! symbol_table::is_local_variable ("global")) - { - do_clear_globals (argv, argc, ++idx); - } - else if (argv[idx] == "variables" - && ! symbol_table::is_local_variable ("variables")) - { - symbol_table::clear_variables (); - } - else if (argv[idx] == "classes" - && ! symbol_table::is_local_variable ("classes")) - { - symbol_table::clear_objects (); - octave_class::clear_exemplar_map (); - } - else - { - symbol_table::clear_symbol_pattern (argv[idx]); - } - } -} - -#define CLEAR_OPTION_ERROR(cond) \ - do \ - { \ - if (cond) \ - { \ - print_usage (); \ - return retval; \ - } \ - } \ - while (0) - -DEFUN (clear, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} clear [options] pattern @dots{}\n\ -Delete the names matching the given patterns from the symbol table. The\n\ -pattern may contain the following special characters:\n\ -\n\ -@table @code\n\ -@item ?\n\ -Match any single character.\n\ -\n\ -@item *\n\ -Match zero or more characters.\n\ -\n\ -@item [ @var{list} ]\n\ -Match the list of characters specified by @var{list}. If the first\n\ -character is @code{!} or @code{^}, match all characters except those\n\ -specified by @var{list}. For example, the pattern @samp{[a-zA-Z]} will\n\ -match all lowercase and uppercase alphabetic characters.\n\ -@end table\n\ -\n\ -For example, the command\n\ -\n\ -@example\n\ -clear foo b*r\n\ -@end example\n\ -\n\ -@noindent\n\ -clears the name @code{foo} and all names that begin with the letter\n\ -@code{b} and end with the letter @code{r}.\n\ -\n\ -If @code{clear} is called without any arguments, all user-defined\n\ -variables (local and global) are cleared from the symbol table. If\n\ -@code{clear} is called with at least one argument, only the visible\n\ -names matching the arguments are cleared. For example, suppose you have\n\ -defined a function @code{foo}, and then hidden it by performing the\n\ -assignment @code{foo = 2}. Executing the command @kbd{clear foo} once\n\ -will clear the variable definition and restore the definition of\n\ -@code{foo} as a function. Executing @kbd{clear foo} a second time will\n\ -clear the function definition.\n\ -\n\ -The following options are available in both long and short form\n\ -\n\ -@table @code\n\ -@item -all, -a\n\ -Clears all local and global user-defined variables and all functions\n\ -from the symbol table.\n\ -\n\ -@item -exclusive, -x\n\ -Clears the variables that don't match the following pattern.\n\ -\n\ -@item -functions, -f\n\ -Clears the function names and the built-in symbols names.\n\ -\n\ -@item -global, -g\n\ -Clears the global symbol names.\n\ -\n\ -@item -variables, -v\n\ -Clears the local variable names.\n\ -\n\ -@item -classes, -c\n\ -Clears the class structure table and clears all objects.\n\ -\n\ -@item -regexp, -r\n\ -The arguments are treated as regular expressions as any variables that\n\ -match will be cleared.\n\ -@end table\n\ -\n\ -With the exception of @code{exclusive}, all long options can be used\n\ -without the dash as well.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("clear"); - - if (! error_state) - { - if (argc == 1) - { - do_clear_globals (argv, argc, true); - do_clear_variables (argv, argc, true); - - octave_link::clear_workspace (); - } - else - { - int idx = 0; - - bool clear_all = false; - bool clear_functions = false; - bool clear_globals = false; - bool clear_variables = false; - bool clear_objects = false; - bool exclusive = false; - bool have_regexp = false; - bool have_dash_option = false; - - while (++idx < argc) - { - if (argv[idx] == "-all" || argv[idx] == "-a") - { - CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); - - have_dash_option = true; - clear_all = true; - } - else if (argv[idx] == "-exclusive" || argv[idx] == "-x") - { - have_dash_option = true; - exclusive = true; - } - else if (argv[idx] == "-functions" || argv[idx] == "-f") - { - CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); - - have_dash_option = true; - clear_functions = true; - } - else if (argv[idx] == "-global" || argv[idx] == "-g") - { - CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); - - have_dash_option = true; - clear_globals = true; - } - else if (argv[idx] == "-variables" || argv[idx] == "-v") - { - CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); - - have_dash_option = true; - clear_variables = true; - } - else if (argv[idx] == "-classes" || argv[idx] == "-c") - { - CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); - - have_dash_option = true; - clear_objects = true; - } - else if (argv[idx] == "-regexp" || argv[idx] == "-r") - { - CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); - - have_dash_option = true; - have_regexp = true; - } - else - break; - } - - if (idx <= argc) - { - if (! have_dash_option) - { - do_matlab_compatible_clear (argv, argc, idx); - } - else - { - if (clear_all) - { - maybe_warn_exclusive (exclusive); - - if (++idx < argc) - warning - ("clear: ignoring extra arguments after -all"); - - symbol_table::clear_all (); - } - else if (have_regexp) - { - do_clear_variables (argv, argc, idx, exclusive, true); - } - else if (clear_functions) - { - do_clear_functions (argv, argc, idx, exclusive); - } - else if (clear_globals) - { - do_clear_globals (argv, argc, idx, exclusive); - } - else if (clear_variables) - { - do_clear_variables (argv, argc, idx, exclusive); - } - else if (clear_objects) - { - symbol_table::clear_objects (); - octave_class::clear_exemplar_map (); - } - else - { - do_clear_symbols (argv, argc, idx, exclusive); - } - } - - octave_link::set_workspace (); - } - } - } - - return retval; -} - -DEFUN (whos_line_format, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} whos_line_format ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} whos_line_format (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} whos_line_format (@var{new_val}, \"local\")\n\ -Query or set the format string used by the command @code{whos}.\n\ -\n\ -A full format string is:\n\ -@c Set example in small font to prevent overfull line\n\ -\n\ -@smallexample\n\ -%[modifier][:width[:left-min[:balance]]];\n\ -@end smallexample\n\ -\n\ -The following command sequences are available:\n\ -\n\ -@table @code\n\ -@item %a\n\ -Prints attributes of variables (g=global, p=persistent,\n\ -f=formal parameter, a=automatic variable).\n\ -\n\ -@item %b\n\ -Prints number of bytes occupied by variables.\n\ -\n\ -@item %c\n\ -Prints class names of variables.\n\ -\n\ -@item %e\n\ -Prints elements held by variables.\n\ -\n\ -@item %n\n\ -Prints variable names.\n\ -\n\ -@item %s\n\ -Prints dimensions of variables.\n\ -\n\ -@item %t\n\ -Prints type names of variables.\n\ -@end table\n\ -\n\ -Every command may also have an alignment modifier:\n\ -\n\ -@table @code\n\ -@item l\n\ -Left alignment.\n\ -\n\ -@item r\n\ -Right alignment (default).\n\ -\n\ -@item c\n\ -Column-aligned (only applicable to command %s).\n\ -@end table\n\ -\n\ -The @code{width} parameter is a positive integer specifying the minimum\n\ -number of columns used for printing. No maximum is needed as the field will\n\ -auto-expand as required.\n\ -\n\ -The parameters @code{left-min} and @code{balance} are only available when the\n\ -column-aligned modifier is used with the command @samp{%s}.\n\ -@code{balance} specifies the column number within the field width which will\n\ -be aligned between entries. Numbering starts from 0 which indicates the\n\ -leftmost column. @code{left-min} specifies the minimum field width to the\n\ -left of the specified balance column.\n\ -\n\ -The default format is\n\ -@code{\" %a:4; %ln:6; %cs:16:6:1; %rb:12; %lc:-1;\\n\"}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{whos}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (whos_line_format); -} - -static std::string Vmissing_function_hook = "__unimplemented__"; - -DEFUN (missing_function_hook, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} missing_function_hook ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} missing_function_hook (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} missing_function_hook (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the function to call when\n\ -an unknown identifier is requested.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (missing_function_hook); -} - -void maybe_missing_function_hook (const std::string& name) -{ - // Don't do this if we're handling errors. - if (buffer_error_messages == 0 && ! Vmissing_function_hook.empty ()) - { - octave_value val = symbol_table::find_function (Vmissing_function_hook); - - if (val.is_defined ()) - { - // Ensure auto-restoration. - unwind_protect frame; - frame.protect_var (Vmissing_function_hook); - - // Clear the variable prior to calling the function. - const std::string func_name = Vmissing_function_hook; - Vmissing_function_hook.clear (); - - // Call. - feval (func_name, octave_value (name)); - } - } -} - -DEFUN (__varval__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __varval__ (@var{name})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - { - std::string name = args(0).string_value (); - - if (! error_state) - retval = symbol_table::varval (args(0).string_value ()); - else - error ("__varval__: expecting argument to be variable name"); - } - else - print_usage (); - - return retval; -} diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/variables.h --- a/libinterp/interpfcn/variables.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,152 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_variables_h) -#define octave_variables_h 1 - -class octave_function; -class octave_user_function; - -class tree_identifier; -class octave_value; -class octave_value_list; -class octave_builtin; -class string_vector; - -#include - -#include -#include - -#include "lo-ieee.h" - -#include "ov.h" -#include "ov-builtin.h" -#include "symtab.h" - -extern OCTINTERP_API void clear_mex_functions (void); - -extern OCTINTERP_API octave_function * -is_valid_function (const octave_value&, const std::string& = std::string (), - bool warn = false); - -extern OCTINTERP_API octave_function * -is_valid_function (const std::string&, const std::string& = std::string (), - bool warn = false); - -extern OCTINTERP_API octave_function * -extract_function (const octave_value& arg, const std::string& warn_for, - const std::string& fname, const std::string& header, - const std::string& trailer); - -extern OCTINTERP_API string_vector -get_struct_elts (const std::string& text); - -extern OCTINTERP_API string_vector -generate_struct_completions (const std::string& text, std::string& prefix, - std::string& hint); - -extern OCTINTERP_API bool -looks_like_struct (const std::string& text); - -extern OCTINTERP_API int -symbol_exist (const std::string& name, const std::string& type = "any"); - -extern OCTINTERP_API std::string -unique_symbol_name (const std::string& basename); - -extern OCTINTERP_API octave_value lookup_function_handle (const std::string& nm); - -extern OCTINTERP_API octave_value -get_global_value (const std::string& nm, bool silent = false); - -extern OCTINTERP_API void -set_global_value (const std::string& nm, const octave_value& val); - -extern OCTINTERP_API octave_value -get_top_level_value (const std::string& nm, bool silent = false); - -extern OCTINTERP_API void -set_top_level_value (const std::string& nm, const octave_value& val); - -extern OCTINTERP_API octave_value -set_internal_variable (bool& var, const octave_value_list& args, - int nargout, const char *nm); - -extern OCTINTERP_API octave_value -set_internal_variable (char& var, const octave_value_list& args, - int nargout, const char *nm); - -extern OCTINTERP_API octave_value -set_internal_variable (int& var, const octave_value_list& args, - int nargout, const char *nm, - int minval = std::numeric_limits::min (), - int maxval = std::numeric_limits::max ()); - -extern OCTINTERP_API octave_value -set_internal_variable (double& var, const octave_value_list& args, - int nargout, const char *nm, - double minval = -octave_Inf, - double maxval = octave_Inf); - -extern OCTINTERP_API octave_value -set_internal_variable (std::string& var, const octave_value_list& args, - int nargout, const char *nm, bool empty_ok = true); - -extern OCTINTERP_API octave_value -set_internal_variable (int& var, const octave_value_list& args, - int nargout, const char *nm, const char **choices); - -#define SET_INTERNAL_VARIABLE(NM) \ - set_internal_variable (V ## NM, args, nargout, #NM) - -#define SET_NONEMPTY_INTERNAL_STRING_VARIABLE(NM) \ - set_internal_variable (V ## NM, args, nargout, #NM, false) - -#define SET_INTERNAL_VARIABLE_WITH_LIMITS(NM, MINVAL, MAXVAL) \ - set_internal_variable (V ## NM, args, nargout, #NM, MINVAL, MAXVAL) - -// in the following, CHOICES must be a C string array terminated by null. -#define SET_INTERNAL_VARIABLE_CHOICES(NM, CHOICES) \ - set_internal_variable (V ## NM, args, nargout, #NM, CHOICES) - -extern OCTINTERP_API std::string builtin_string_variable (const std::string&); -extern OCTINTERP_API int builtin_real_scalar_variable (const std::string&, double&); -extern OCTINTERP_API octave_value builtin_any_variable (const std::string&); - -extern OCTINTERP_API void bind_ans (const octave_value& val, bool print); - -extern OCTINTERP_API void -bind_internal_variable (const std::string& fname, - const octave_value& val) GCC_ATTR_DEPRECATED; - -extern OCTINTERP_API void mlock (void); -extern OCTINTERP_API void munlock (const std::string&); -extern OCTINTERP_API bool mislocked (const std::string&); - -extern OCTINTERP_API void clear_function (const std::string& nm); -extern OCTINTERP_API void clear_variable (const std::string& nm); -extern OCTINTERP_API void clear_symbol (const std::string& nm); - -extern OCTINTERP_API void maybe_missing_function_hook (const std::string& name); - -#endif diff -r 486c3e2731ff -r 68fc671a9339 libinterp/interpfcn/workspace-element.h --- a/libinterp/interpfcn/workspace-element.h Wed Jul 03 13:48:49 2013 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,84 +0,0 @@ -/* - -Copyright (C) 2013 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_workspace_element_h) -#define octave_workspace_element_h 1 - -#include - -class workspace_element -{ -public: - - workspace_element (char scope_arg = 'l', - const std::string& symbol_arg = "", - const std::string& class_name_arg = "", - const std::string& value_arg = "", - const std::string& dimension_arg = "") - : xscope (scope_arg), xsymbol (symbol_arg), - xclass_name (class_name_arg), xvalue (value_arg), - xdimension (dimension_arg) - { } - - workspace_element (const workspace_element& ws_elt) - : xscope (ws_elt.xscope), xsymbol (ws_elt.xsymbol), - xclass_name (ws_elt.xclass_name), xvalue (ws_elt.xvalue), - xdimension (ws_elt.xdimension) - { } - - workspace_element operator = (const workspace_element& ws_elt) - { - if (this != &ws_elt) - { - xscope = ws_elt.xscope; - xsymbol = ws_elt.xsymbol; - xclass_name = ws_elt.xclass_name; - xvalue = ws_elt.xvalue; - xdimension = ws_elt.xdimension; - } - - return *this; - } - - ~workspace_element (void) { } - - char scope (void) const { return xscope; } - - std::string symbol (void) const { return xsymbol; } - - std::string class_name (void) const { return xclass_name; } - - std::string value (void) const { return xvalue; } - - std::string dimension (void) const { return xdimension; } - -private: - - // [g]lobal, [p]ersistent, [l]ocal - char xscope; - std::string xsymbol; - std::string xclass_name; - std::string xvalue; - std::string xdimension; -}; - -#endif diff -r 486c3e2731ff -r 68fc671a9339 src/Makefile.am --- a/src/Makefile.am Wed Jul 03 13:48:49 2013 -0700 +++ b/src/Makefile.am Wed Jul 03 17:43:48 2013 -0700 @@ -28,7 +28,7 @@ -I$(top_srcdir)/liboctave/system \ -I$(top_srcdir)/liboctave/util \ -I$(top_srcdir)/libinterp \ - -I$(top_builddir)/libinterp/interpfcn -I$(top_srcdir)/libinterp/interpfcn \ + -I$(top_builddir)/libinterp/corefcn -I$(top_srcdir)/libinterp/corefcn \ -I$(top_builddir)/libgnu -I$(top_srcdir)/libgnu AM_CFLAGS += $(WARN_CFLAGS)