Mercurial > hg > octave-terminal
changeset 3243:dd00769643ae
[project @ 1999-05-28 04:19:00 by jwe]
author | jwe |
---|---|
date | Fri, 28 May 1999 04:19:24 +0000 |
parents | 8c5ad0b49742 |
children | 7f8827f4040a |
files | ChangeLog NEWS aclocal.m4 doc/interpreter/data.texi doc/interpreter/io.texi liboctave/Array2-idx.h liboctave/ChangeLog liboctave/LSODE.cc liboctave/LSODE.h liboctave/MArray-defs.h readline/ChangeLog readline/histfile.c scripts/ChangeLog src/ChangeLog src/DLD-FUNCTIONS/chol.cc src/DLD-FUNCTIONS/dassl.cc src/DLD-FUNCTIONS/fsolve.cc src/DLD-FUNCTIONS/lsode.cc src/DLD-FUNCTIONS/minmax.cc src/DLD-FUNCTIONS/quad.cc src/file-io.cc |
diffstat | 21 files changed, 467 insertions(+), 331 deletions(-) [+] |
line wrap: on
line diff
--- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +Mon May 10 09:06:47 1999 John W. Eaton <jwe@bevo.che.wisc.edu> + + * aclocal.m4 (OCTAVE_PROG_G77): Also match "FSF-g77", for egcs. + +Thu Apr 8 19:20:09 1999 John W. Eaton <jwe@bevo.che.wisc.edu> + + * examples/hello.cc (Fhello): octave_value::print now requires a + stream arg. + Wed Feb 3 01:02:37 1999 John W. Eaton <jwe@bevo.che.wisc.edu> * configure.in: Use AC_OUTPUT_COMMANDS to chmod install-octave so
--- a/NEWS +++ b/NEWS @@ -286,8 +286,8 @@ even if you build a copy of Octave that depends on shared versions of the Octave libraries. - * For matrices, x(:) now works no matter what the value of - do_fortran_indexing is. + * For matrices, x(:) now works and returns a column vector no matter + what the value of do_fortran_indexing is. * New keywords __FILE__ and __LINE__ expand to the name of the file that is being read and the current input line number, respectively.
--- a/aclocal.m4 +++ b/aclocal.m4 @@ -81,7 +81,7 @@ octave_cv_f77_is_g77=yes else echo " END" > conftest.f - foutput=`${F77-f77} -v 2>&1 | grep "GNU F77"` + foutput=`${F77-f77} -v conftest.f 2>&1 | egrep "GNU F77|FSF-g77"` if test -n "$foutput"; then octave_cv_f77_is_g77=yes else
--- a/doc/interpreter/data.texi +++ b/doc/interpreter/data.texi @@ -73,7 +73,7 @@ Matrix objects can be of any size, and can be dynamically reshaped and resized. It is easy to extract individual rows, columns, or submatrices -is using a variety of powerful indexing features. @xref{Index Expressions}. +using a variety of powerful indexing features. @xref{Index Expressions}. @xref{Numeric Data Types}, for more information.
--- a/doc/interpreter/io.texi +++ b/doc/interpreter/io.texi @@ -622,10 +622,9 @@ @subsection Line-Oriented Input @deftypefn {Built-in Function} {} fgetl (@var{fid}, @var{len}) -Read characters from a file, stopping at the first newline character -that is encountered or after @var{len} characters have been read, and -returning the characters as a string. The newline is not included in -the returned value. +Read characters from a file, stopping after a newline, or EOF, +or @var{len} characters have been read. The characters read, excluding +the possible trailing newline, are returned as a string. If @var{len} is omitted, @code{fgetl} reads until the next newline character. @@ -634,10 +633,9 @@ @end deftypefn @deftypefn {Built-in Function} {} fgets (@var{fid}, @var{len}) -Read characters from a file, stopping at the first newline character -that is encountered or after @var{len} characters have been read, and -returning the characters as a string. The newline is included in the -returned value. +Read characters from a file, stopping after a newline, or EOF, +or @var{len} characters have been read. The characters read, including +the possible trailing newline, are returned as a string. If @var{len} is omitted, @code{fgets} reads until the next newline character. @@ -1066,7 +1064,9 @@ Read as much as possible, returning a column vector. @item @var{nr} -@itemx [@var{nr}, Inf] +Read up to @var{nr} elements, returning a column vector. + +@item [@var{nr}, Inf] Read as much as possible, returning a matrix with @var{nr} rows. If the number of elements read is not an exact multiple of @var{nr}, the last column is padded with zeros. @@ -1320,7 +1320,9 @@ Read as much as possible, returning a column vector. @item @var{nr} -@itemx [@var{nr}, Inf] +Read up to @var{nr} elements, returning a column vector. + +@item [@var{nr}, Inf] Read as much as possible, returning a matrix with @var{nr} rows. If the number of elements read is not an exact multiple of @var{nr}, the last column is padded with zeros.
--- a/liboctave/Array2-idx.h +++ b/liboctave/Array2-idx.h @@ -84,10 +84,7 @@ } else if (nr == 1 || nc == 1) { - int result_is_column_vector = (nc == 1); - - if (liboctave_dfi_flag && idx.is_colon ()) - result_is_column_vector = 1; + int result_is_column_vector = (nc == 1 || idx.is_colon ()); Array<T> tmp = Array<T>::index (idx);
--- a/liboctave/ChangeLog +++ b/liboctave/ChangeLog @@ -1,3 +1,17 @@ +Mon May 10 07:45:11 1999 John W. Eaton <jwe@bevo.che.wisc.edu> + + * MArray-defs.h (DO_VV_OP2): Fix macro definition to use arg. + +Wed May 5 20:06:10 1999 John W. Eaton <jwe@bevo.che.wisc.edu> + + * Array2-idx.h (Array2<T>index (idx_vector& idx)): Always return a + column vector for A(:), for compatibility with Matlab. + +Fri Apr 23 11:52:23 1999 John W. Eaton <jwe@bevo.che.wisc.edu> + + * LSODE.cc (LSODE::do_integrate (double)): Don't forget to set + iopt when there are optional inputs in rwork or iwork. + Fri Mar 26 11:26:32 1999 John W. Eaton <jwe@bevo.che.wisc.edu> * Makefile.in (libraries): Use the libfoo.a(objects) method of
--- a/liboctave/LSODE.cc +++ b/liboctave/LSODE.cc @@ -218,14 +218,11 @@ sanity_checked = 1; } - // Try 5000 steps before giving up. - - iwork.elem (5) = 5000; - if (stop_time_set) { itask = 4; rwork.elem (0) = stop_time; + iopt = 1; } else { @@ -235,12 +232,29 @@ double abs_tol = absolute_tolerance (); double rel_tol = relative_tolerance (); - rwork.elem (4) = (initial_step_size () >= 0.0) ? initial_step_size () : 0.0; - rwork.elem (5) = (maximum_step_size () >= 0.0) ? maximum_step_size () : 0.0; - rwork.elem (6) = (minimum_step_size () >= 0.0) ? minimum_step_size () : 0.0; + if (initial_step_size () >= 0.0) + { + rwork.elem (4) = initial_step_size (); + iopt = 1; + } + + if (maximum_step_size () >= 0.0) + { + rwork.elem (5) = maximum_step_size (); + iopt = 1; + } + + if (minimum_step_size () >= 0.0) + { + rwork.elem (6) = minimum_step_size (); + iopt = 1; + } if (step_limit () > 0) - iwork.elem (5) = step_limit (); + { + iwork.elem (5) = step_limit (); + iopt = 1; + } int *piwork = iwork.fortran_vec (); double *prwork = rwork.fortran_vec ();
--- a/liboctave/LSODE.h +++ b/liboctave/LSODE.h @@ -78,6 +78,7 @@ x_maximum_step_size = opt.x_maximum_step_size; x_minimum_step_size = opt.x_minimum_step_size; x_relative_tolerance = opt.x_relative_tolerance; + x_step_limit = opt.x_step_limit; }
--- a/liboctave/MArray-defs.h +++ b/liboctave/MArray-defs.h @@ -61,7 +61,7 @@ T *a_tmp = a.fortran_vec (); \ const T *b_tmp = b.data (); \ for (int i = 0; i < l; i++) \ - a_tmp[i] += b_tmp[i]; \ + a_tmp[i] OP b_tmp[i]; \ } \ while (0)
--- a/readline/ChangeLog +++ b/readline/ChangeLog @@ -1,3 +1,7 @@ +Thu May 27 21:47:26 1999 John W. Eaton <jwe@bevo.che.wisc.edu> + + * histfile.c [__CYGWIN__]: Define O_BINARY if not already defined. + Mon Aug 31 12:07:02 1998 John W. Eaton <jwe@bevo.che.wisc.edu> * config.sub: Accept armv4 everywhere arm is allowed.
--- a/readline/histfile.c +++ b/readline/histfile.c @@ -52,11 +52,11 @@ # include <strings.h> #endif /* !HAVE_STRING_H */ -#if defined (__EMX__) +#if defined (__EMX__) || defined (__CYGWIN__) # ifndef O_BINARY # define O_BINARY 0 # endif -#else /* !__EMX__ */ +#else /* !__EMX__ && !__CYGWIN__ */ /* If we're not compiling for __EMX__, we don't want this at all. Ever. */ # undef O_BINARY # define O_BINARY 0
--- a/scripts/ChangeLog +++ b/scripts/ChangeLog @@ -1,3 +1,7 @@ +Wed Apr 7 13:57:26 1999 John W. Eaton <jwe@bevo.che.wisc.edu> + + * linear-algebra/qrhouse.m, linear-algebra/krygetq.m: Delete. + Wed Apr 7 13:22:43 1999 A. S. Hodel <a.s.hodel@eng.auburn.edu> * control/is_controllable.m, control/zgscal.m: Accomodate new
--- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,20 @@ +Thu May 27 18:28:35 1999 John W. Eaton <jwe@bevo.che.wisc.edu> + + * DLD-FUNCTIONS/chol.cc (Fchol): Also return info as second output. + + * DLD-FUNCTIONS/minmax.cc (max (const ComplexMatrix&, const + ComplexMatrix&)): Correct test for real columns only. + (min (const ComplexMatrix&, const ComplexMatrix&)): Likewise. + +Wed Apr 14 12:54:25 1999 John W. Eaton <jwe@bevo.che.wisc.edu> + + * DLD-FUNCTIONS/dassl.cc (Fdassl): Prevent recursive calls. + * DLD-FUNCTIONS/fsolve.cc (Ffsolve): Likewise. + * DLD-FUNCTIONS/lsode.cc (Flsode): Likewise. + * DLD-FUNCTIONS/quad.cc (Fquad): Likewise. + + * file-io.cc (Fsscanf, Ffscanf): Doc fix. + Sat Mar 27 11:07:51 1999 John W. Eaton <jwe@bevo.che.wisc.edu> * ov.h (octave_value::count): New function.
--- a/src/DLD-FUNCTIONS/chol.cc +++ b/src/DLD-FUNCTIONS/chol.cc @@ -34,13 +34,13 @@ #include "utils.h" DEFUN_DLD (chol, args, nargout, - "R = chol (X): cholesky factorization") + "[R, p] = chol (X): cholesky factorization") { octave_value_list retval; int nargin = args.length (); - if (nargin != 1 || nargout > 1) + if (nargin != 1 || nargout > 2) { print_usage ("chol"); return retval; @@ -69,7 +69,10 @@ if (info != 0) error ("chol: matrix not positive definite"); else - retval = fact.chol_matrix (); + { + retval(1) = static_cast<double> (info); + retval(0) = fact.chol_matrix (); + } } } else if (arg.is_complex_type ()) @@ -83,7 +86,10 @@ if (info != 0) error ("chol: matrix not positive definite"); else - retval = fact.chol_matrix (); + { + retval(1) = static_cast<double> (info); + retval(0) = fact.chol_matrix (); + } } } else
--- a/src/DLD-FUNCTIONS/dassl.cc +++ b/src/DLD-FUNCTIONS/dassl.cc @@ -36,6 +36,7 @@ #include "oct-obj.h" #include "ov-fcn.h" #include "pager.h" +#include "unwind-prot.h" #include "utils.h" #include "variables.h" @@ -44,6 +45,9 @@ static DASSL_options dassl_opts; +// Is this a recursive call? +static int call_depth = 0; + ColumnVector dassl_user_function (const ColumnVector& x, const ColumnVector& xdot, double t) { @@ -117,88 +121,100 @@ { octave_value_list retval; - int nargin = args.length (); - - if (nargin < 4 || nargin > 5) - { - print_usage ("dassl"); - return retval; - } - - dassl_fcn = extract_function - (args(0), "dassl", "__dassl_fcn__", - "function res = __dassl_fcn__ (x, xdot, t) res = ", - "; endfunction"); - - if (! dassl_fcn) - return retval; - - ColumnVector state = args(1).vector_value (); + unwind_protect::begin_frame ("Fdassl"); - if (error_state) - { - error ("dassl: expecting state vector as second argument"); - return retval; - } + unwind_protect_int (call_depth); + call_depth++; - ColumnVector deriv = args(2).vector_value (); - - if (error_state) + if (call_depth > 1) { - error ("dassl: expecting derivative vector as third argument"); - return retval; - } - - ColumnVector out_times = args(3).vector_value (); - - if (error_state) - { - error ("dassl: expecting output time vector as fourth argument"); + error ("dassl: invalid recursive call"); return retval; } - ColumnVector crit_times; - int crit_times_set = 0; - if (nargin > 4) + int nargin = args.length (); + + if (nargin > 3 && nargin < 6) { - crit_times = args(4).vector_value (); + dassl_fcn = extract_function + (args(0), "dassl", "__dassl_fcn__", + "function res = __dassl_fcn__ (x, xdot, t) res = ", + "; endfunction"); + + if (! dassl_fcn) + return retval; + + ColumnVector state = args(1).vector_value (); if (error_state) { - error ("dassl: expecting critical time vector as fifth argument"); + error ("dassl: expecting state vector as second argument"); + return retval; + } + + ColumnVector deriv = args(2).vector_value (); + + if (error_state) + { + error ("dassl: expecting derivative vector as third argument"); + return retval; + } + + ColumnVector out_times = args(3).vector_value (); + + if (error_state) + { + error ("dassl: expecting output time vector as fourth argument"); return retval; } - crit_times_set = 1; - } + ColumnVector crit_times; + int crit_times_set = 0; + if (nargin > 4) + { + crit_times = args(4).vector_value (); - if (state.capacity () != deriv.capacity ()) - { - error ("dassl: x and xdot must have the same size"); - return retval; - } + if (error_state) + { + error ("dassl: expecting critical time vector as fifth argument"); + return retval; + } - double tzero = out_times (0); + crit_times_set = 1; + } - DAEFunc func (dassl_user_function); - DASSL dae (state, deriv, tzero, func); - dae.copy (dassl_opts); + if (state.capacity () != deriv.capacity ()) + { + error ("dassl: x and xdot must have the same size"); + return retval; + } + + double tzero = out_times (0); - Matrix output; - Matrix deriv_output; + DAEFunc func (dassl_user_function); + DASSL dae (state, deriv, tzero, func); + dae.copy (dassl_opts); - if (crit_times_set) - output = dae.integrate (out_times, deriv_output, crit_times); - else - output = dae.integrate (out_times, deriv_output); + Matrix output; + Matrix deriv_output; + + if (crit_times_set) + output = dae.integrate (out_times, deriv_output, crit_times); + else + output = dae.integrate (out_times, deriv_output); - if (! error_state) - { - retval.resize (2); + if (! error_state) + { + retval.resize (2); - retval(0) = output; - retval(1) = deriv_output; + retval(0) = output; + retval(1) = deriv_output; + } } + else + print_usage ("dassl"); + + unwind_protect::run_frame ("Fdassl"); return retval; }
--- a/src/DLD-FUNCTIONS/fsolve.cc +++ b/src/DLD-FUNCTIONS/fsolve.cc @@ -36,6 +36,7 @@ #include "oct-obj.h" #include "ov-fcn.h" #include "pager.h" +#include "unwind-prot.h" #include "utils.h" #include "variables.h" @@ -44,6 +45,9 @@ static NLEqn_options fsolve_opts; +// Is this a recursive call? +static int call_depth = 0; + int hybrd_info_to_fsolve_info (int info) { @@ -134,48 +138,60 @@ { octave_value_list retval; - int nargin = args.length (); + unwind_protect::begin_frame ("Ffsolve"); - if (nargin != 2 || nargout > 3) + unwind_protect_int (call_depth); + call_depth++; + + if (call_depth > 1) { - print_usage ("fsolve"); + error ("fsolve: invalid recursive call"); return retval; } - fsolve_fcn = extract_function (args(0), "fsolve", "__fsolve_fcn__", - "function y = __fsolve_fcn__ (x) y = ", - "; endfunction"); - if (! fsolve_fcn) - return retval; + int nargin = args.length (); - ColumnVector x = args(1).vector_value (); + if (nargin == 2 && nargout < 4) + { + fsolve_fcn = extract_function (args(0), "fsolve", "__fsolve_fcn__", + "function y = __fsolve_fcn__ (x) y = ", + "; endfunction"); + if (! fsolve_fcn) + return retval; - if (error_state) - { - error ("fsolve: expecting vector as second argument"); - return retval; - } + ColumnVector x = args(1).vector_value (); - if (nargin > 2) - warning ("fsolve: ignoring extra arguments"); + if (error_state) + { + error ("fsolve: expecting vector as second argument"); + return retval; + } + + if (nargin > 2) + warning ("fsolve: ignoring extra arguments"); - if (nargout > 2) - warning ("fsolve: can't compute path output yet"); + if (nargout > 2) + warning ("fsolve: can't compute path output yet"); - NLFunc foo_fcn (fsolve_user_function); - NLEqn foo (x, foo_fcn); - foo.set_options (fsolve_opts); + NLFunc foo_fcn (fsolve_user_function); + NLEqn foo (x, foo_fcn); + foo.set_options (fsolve_opts); + + int info; + ColumnVector soln = foo.solve (info); - int info; - ColumnVector soln = foo.solve (info); + info = hybrd_info_to_fsolve_info (info); - info = hybrd_info_to_fsolve_info (info); + retval.resize (nargout ? nargout : 1); + retval(0) = soln, 1; - retval.resize (nargout ? nargout : 1); - retval(0) = soln, 1; + if (nargout > 1) + retval(1) = static_cast<double> (info); + } + else + print_usage ("fsolve"); - if (nargout > 1) - retval(1) = static_cast<double> (info); + unwind_protect::run_frame ("Ffsolve"); return retval; }
--- a/src/DLD-FUNCTIONS/lsode.cc +++ b/src/DLD-FUNCTIONS/lsode.cc @@ -37,6 +37,7 @@ #include "oct-obj.h" #include "ov-fcn.h" #include "pager.h" +#include "unwind-prot.h" #include "utils.h" #include "variables.h" @@ -48,6 +49,9 @@ static LSODE_options lsode_opts; +// Is this a recursive call? +static int call_depth = 0; + ColumnVector lsode_user_function (const ColumnVector& x, double t) { @@ -140,114 +144,126 @@ { octave_value_list retval; - int nargin = args.length (); + unwind_protect::begin_frame ("Flsode"); - if (nargin < 3 || nargin > 4 || nargout > 1) + unwind_protect_int (call_depth); + call_depth++; + + if (call_depth > 1) { - print_usage ("lsode"); + error ("lsode: invalid recursive call"); return retval; } - octave_value f_arg = args(0); + int nargin = args.length (); - switch (f_arg.rows ()) + if (nargin > 2 && nargin < 5 && nargout < 2) { - case 1: - lsode_fcn = extract_function - (args(0), "lsode", "__lsode_fcn__", - "function xdot = __lsode_fcn__ (x, t) xdot = ", - "; endfunction"); - break; + octave_value f_arg = args(0); - case 2: - { - string_vector tmp = args(0).all_strings (); + switch (f_arg.rows ()) + { + case 1: + lsode_fcn = extract_function + (args(0), "lsode", "__lsode_fcn__", + "function xdot = __lsode_fcn__ (x, t) xdot = ", + "; endfunction"); + break; - if (! error_state) + case 2: { - lsode_fcn = extract_function - (tmp(0), "lsode", "__lsode_fcn__", - "function xdot = __lsode_fcn__ (x, t) xdot = ", - "; endfunction"); + string_vector tmp = args(0).all_strings (); - if (lsode_fcn) + if (! error_state) { - lsode_jac = extract_function - (tmp(1), "lsode", "__lsode_jac__", - "function jac = __lsode_jac__ (x, t) jac = ", + lsode_fcn = extract_function + (tmp(0), "lsode", "__lsode_fcn__", + "function xdot = __lsode_fcn__ (x, t) xdot = ", "; endfunction"); - if (! lsode_jac) - lsode_fcn = 0; + if (lsode_fcn) + { + lsode_jac = extract_function + (tmp(1), "lsode", "__lsode_jac__", + "function jac = __lsode_jac__ (x, t) jac = ", + "; endfunction"); + + if (! lsode_jac) + lsode_fcn = 0; + } } } - } - break; - - default: - error ("lsode: first arg should be a string or 2-element string array"); - break; - } - - if (error_state || ! lsode_fcn) - return retval; - - ColumnVector state = args(1).vector_value (); + break; - if (error_state) - { - error ("lsode: expecting state vector as second argument"); - return retval; - } - - ColumnVector out_times = args(2).vector_value (); + default: + error ("lsode: first arg should be a string or 2-element string array"); + break; + } - if (error_state) - { - error ("lsode: expecting output time vector as third argument"); - return retval; - } + if (error_state || ! lsode_fcn) + return retval; - ColumnVector crit_times; - - int crit_times_set = 0; - if (nargin > 3) - { - crit_times = args(3).vector_value (); + ColumnVector state = args(1).vector_value (); if (error_state) { - error ("lsode: expecting critical time vector as fourth argument"); + error ("lsode: expecting state vector as second argument"); + return retval; + } + + ColumnVector out_times = args(2).vector_value (); + + if (error_state) + { + error ("lsode: expecting output time vector as third argument"); return retval; } - crit_times_set = 1; - } + ColumnVector crit_times; - double tzero = out_times (0); - int nsteps = out_times.capacity (); + int crit_times_set = 0; + if (nargin > 3) + { + crit_times = args(3).vector_value (); - ODEFunc func (lsode_user_function); - if (lsode_jac) - func.set_jacobian_function (lsode_user_jacobian); + if (error_state) + { + error ("lsode: expecting critical time vector as fourth argument"); + return retval; + } - LSODE ode (state, tzero, func); + crit_times_set = 1; + } - ode.copy (lsode_opts); + double tzero = out_times (0); + int nsteps = out_times.capacity (); + + ODEFunc func (lsode_user_function); + if (lsode_jac) + func.set_jacobian_function (lsode_user_jacobian); - int nstates = state.capacity (); - Matrix output (nsteps, nstates + 1); + LSODE ode (state, tzero, func); + + ode.copy (lsode_opts); + + int nstates = state.capacity (); + Matrix output (nsteps, nstates + 1); - if (crit_times_set) - output = ode.integrate (out_times, crit_times); + if (crit_times_set) + output = ode.integrate (out_times, crit_times); + else + output = ode.integrate (out_times); + + if (! error_state) + { + retval.resize (1); + retval(0) = output; + } + } else - output = ode.integrate (out_times); + print_usage ("lsode"); - if (! error_state) - { - retval.resize (1); - retval(0) = output; - } + unwind_protect::run_frame ("Flsode"); return retval; }
--- a/src/DLD-FUNCTIONS/minmax.cc +++ b/src/DLD-FUNCTIONS/minmax.cc @@ -169,7 +169,7 @@ { int columns_are_real_only = 1; for (int i = 0; i < nr; i++) - if (imag (a (i, j)) != 0.0 && imag (b (i, j)) != 0.0) + if (imag (a (i, j)) != 0.0 || imag (b (i, j)) != 0.0) { columns_are_real_only = 0; break; @@ -327,7 +327,7 @@ { int columns_are_real_only = 1; for (int i = 0; i < nr; i++) - if (imag (a (i, j)) != 0.0 && imag (b (i, j)) != 0.0) + if (imag (a (i, j)) != 0.0 || imag (b (i, j)) != 0.0) { columns_are_real_only = 0; break;
--- a/src/DLD-FUNCTIONS/quad.cc +++ b/src/DLD-FUNCTIONS/quad.cc @@ -37,6 +37,7 @@ #include "pager.h" #include "oct-obj.h" #include "ov-fcn.h" +#include "unwind-prot.h" #include "utils.h" #include "variables.h" @@ -49,6 +50,9 @@ static Quad_options quad_opts; +// Is this a recursive call? +static int call_depth = 0; + double quad_user_function (double x) { @@ -111,141 +115,157 @@ { octave_value_list retval; + unwind_protect::begin_frame ("Fquad"); + + unwind_protect_int (call_depth); + call_depth++; + + if (call_depth > 1) + { + error ("quad: invalid recursive call"); + return retval; + } + int nargin = args.length (); - if (nargin < 3 || nargin > 5 || nargout > 4) + if (nargin > 2 && nargin < 6 && nargout < 5) + { + quad_fcn = extract_function (args(0), "quad", "__quad_fcn__", + "function y = __quad_fcn__ (x) y = ", + "; endfunction"); + if (! quad_fcn) + return retval; + + double a = args(1).double_value (); + + if (error_state) + { + error ("quad: expecting second argument to be a scalar"); + return retval; + } + + double b = args(2).double_value (); + + if (error_state) + { + error ("quad: expecting third argument to be a scalar"); + return retval; + } + + int indefinite = 0; + IndefQuad::IntegralType indef_type = IndefQuad::doubly_infinite; + double bound = 0.0; + if (xisinf (a) && xisinf (b)) + { + indefinite = 1; + indef_type = IndefQuad::doubly_infinite; + } + else if (xisinf (a)) + { + indefinite = 1; + bound = b; + indef_type = IndefQuad::neg_inf_to_bound; + } + else if (xisinf (b)) + { + indefinite = 1; + bound = a; + indef_type = IndefQuad::bound_to_inf; + } + + int ier = 0; + int nfun = 0; + double abserr = 0.0; + double val = 0.0; + double abstol = 1e-6; + double reltol = 1e-6; + ColumnVector tol (2); + ColumnVector sing; + int have_sing = 0; + switch (nargin) + { + case 5: + if (indefinite) + { + error("quad: singularities not allowed on infinite intervals"); + return retval; + } + + have_sing = 1; + + sing = args(4).vector_value (); + + if (error_state) + { + error ("quad: expecting vector of singularities as fourth argument"); + return retval; + } + + case 4: + tol = args(3).vector_value (); + + if (error_state) + { + error ("quad: expecting vector of tolerances as fifth argument"); + return retval; + } + + switch (tol.capacity ()) + { + case 2: + reltol = tol (1); + + case 1: + abstol = tol (0); + break; + + default: + error ("quad: expecting tol to contain no more than two values"); + return retval; + } + + case 3: + if (indefinite) + { + IndefQuad iq (quad_user_function, bound, indef_type, abstol, reltol); + iq.set_options (quad_opts); + val = iq.integrate (ier, nfun, abserr); + } + else + { + if (have_sing) + { + DefQuad dq (quad_user_function, a, b, sing, abstol, reltol); + dq.set_options (quad_opts); + val = dq.integrate (ier, nfun, abserr); + } + else + { + DefQuad dq (quad_user_function, a, b, abstol, reltol); + dq.set_options (quad_opts); + val = dq.integrate (ier, nfun, abserr); + } + } + break; + + default: + panic_impossible (); + break; + } + + retval(3) = abserr; + retval(2) = static_cast<double> (nfun); + retval(1) = static_cast<double> (ier); + retval(0) = val; + } + else { print_usage ("quad"); return retval; } - quad_fcn = extract_function (args(0), "quad", "__quad_fcn__", - "function y = __quad_fcn__ (x) y = ", - "; endfunction"); - if (! quad_fcn) - return retval; - - double a = args(1).double_value (); - - if (error_state) - { - error ("quad: expecting second argument to be a scalar"); - return retval; - } - - double b = args(2).double_value (); - - if (error_state) - { - error ("quad: expecting third argument to be a scalar"); - return retval; - } - - int indefinite = 0; - IndefQuad::IntegralType indef_type = IndefQuad::doubly_infinite; - double bound = 0.0; - if (xisinf (a) && xisinf (b)) - { - indefinite = 1; - indef_type = IndefQuad::doubly_infinite; - } - else if (xisinf (a)) - { - indefinite = 1; - bound = b; - indef_type = IndefQuad::neg_inf_to_bound; - } - else if (xisinf (b)) - { - indefinite = 1; - bound = a; - indef_type = IndefQuad::bound_to_inf; - } - - int ier = 0; - int nfun = 0; - double abserr = 0.0; - double val = 0.0; - double abstol = 1e-6; - double reltol = 1e-6; - ColumnVector tol (2); - ColumnVector sing; - int have_sing = 0; - switch (nargin) - { - case 5: - if (indefinite) - { - error("quad: singularities not allowed on infinite intervals"); - return retval; - } - - have_sing = 1; - - sing = args(4).vector_value (); - - if (error_state) - { - error ("quad: expecting vector of singularities as fourth argument"); - return retval; - } - - case 4: - tol = args(3).vector_value (); - - if (error_state) - { - error ("quad: expecting vector of tolerances as fifth argument"); - return retval; - } - - switch (tol.capacity ()) - { - case 2: - reltol = tol (1); - - case 1: - abstol = tol (0); - break; - - default: - error ("quad: expecting tol to contain no more than two values"); - return retval; - } - - case 3: - if (indefinite) - { - IndefQuad iq (quad_user_function, bound, indef_type, abstol, reltol); - iq.set_options (quad_opts); - val = iq.integrate (ier, nfun, abserr); - } - else - { - if (have_sing) - { - DefQuad dq (quad_user_function, a, b, sing, abstol, reltol); - dq.set_options (quad_opts); - val = dq.integrate (ier, nfun, abserr); - } - else - { - DefQuad dq (quad_user_function, a, b, abstol, reltol); - dq.set_options (quad_opts); - val = dq.integrate (ier, nfun, abserr); - } - } - break; - - default: - panic_impossible (); - break; - } - - retval(3) = abserr; - retval(2) = static_cast<double> (nfun); - retval(1) = static_cast<double> (ier); - retval(0) = val; + abort: + unwind_protect::run_frame ("Fquad"); return retval; }
--- a/src/file-io.cc +++ b/src/file-io.cc @@ -654,9 +654,9 @@ Inf : read as much as possible, returning a column vector\n\ (unless doing all character conversions, in which case a\n\ string is returned)\n\ - NR : read as much as possible, returning a matrix with NR rows\n\ + NR : read up to NR elements, returning a column vector\n\ [NR, NC] : read up to NR x NC elements, returning a matrix with NR rows\n\ - [NR, Inf] : same as NR\n\ + [NR, Inf] : read as much as possible, returning a matrix with NR rows\n\ \n\ If it is omitted, a value of Inf is assumed.\n\ \n\ @@ -740,9 +740,9 @@ Inf : read as much as possible, returning a column vector\n\ (unless doing all character conversions, in which case a\n\ string is returned)\n\ - NR : read as much as possible, returning a matrix with NR rows\n\ + NR : read up to NR elements, returning a column vector\n\ [NR, NC] : read up to NR x NC elements, returning a matrix with NR rows\n\ - [NR, Inf] : same as NR\n\ + [NR, Inf] : read as much as possible, returning a matrix with NR rows\n\ \n\ If it is omitted, a value of Inf is assumed.\n\ \n\