Mercurial > octave-nkf
changeset 15075:b62b0b85369c
move more files to corefcn directory
* bitfcns.cc, mappers.cc, sparse.cc, strfns.cc, syscalls.cc: Move to
corefcn diretory.
* src/Makefile.am (DIST_SRC): Remove bitfcns.cc, mappers.cc,
sparse.cc, strfns.cc, and syscalls.cc from the list.
* src/corefcn/module.mk (COREFCN_SRC): Add bitfcns.cc, mappers.cc,
sparse.cc, strfns.cc, and syscalls.cc to the list
| author | John W. Eaton <jwe@octave.org> |
|---|---|
| date | Tue, 31 Jul 2012 20:46:47 -0400 |
| parents | 2cb76b2b8b29 |
| children | 000587f92082 |
| files | src/Makefile.am src/bitfcns.cc src/corefcn/bitfcns.cc src/corefcn/mappers.cc src/corefcn/module.mk src/corefcn/sparse.cc src/corefcn/strfns.cc src/corefcn/syscalls.cc src/mappers.cc src/sparse.cc src/strfns.cc src/syscalls.cc |
| diffstat | 12 files changed, 6032 insertions(+), 6032 deletions(-) [+] |
line wrap: on
line diff
--- a/src/Makefile.am Tue Jul 31 20:39:08 2012 -0400 +++ b/src/Makefile.am Tue Jul 31 20:46:47 2012 -0400 @@ -238,7 +238,6 @@ DIST_SRC = \ Cell.cc \ - bitfcns.cc \ c-file-ptr-stream.cc \ comment-list.cc \ cutils.c \ @@ -268,7 +267,6 @@ ls-oct-ascii.cc \ ls-oct-binary.cc \ ls-utils.cc \ - mappers.cc \ matherr.c \ mex.cc \ oct-fstrm.cc \ @@ -289,12 +287,9 @@ profiler.cc \ sighandlers.cc \ siglist.c \ - sparse.cc \ sparse-xdiv.cc \ sparse-xpow.cc \ - strfns.cc \ symtab.cc \ - syscalls.cc \ sysdep.cc \ token.cc \ toplev.cc \
--- a/src/bitfcns.cc Tue Jul 31 20:39:08 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,756 +0,0 @@ -/* - -Copyright (C) 2004-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 -<http://www.gnu.org/licenses/>. - -*/ - -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#include "str-vec.h" -#include "quit.h" - -#include "defun.h" -#include "error.h" -#include "ov.h" -#include "ov-uint64.h" -#include "ov-uint32.h" -#include "ov-uint16.h" -#include "ov-uint8.h" -#include "ov-int64.h" -#include "ov-int32.h" -#include "ov-int16.h" -#include "ov-int8.h" -#include "ov-scalar.h" -#include "ov-re-mat.h" -#include "ov-bool.h" - -#include <functional> - -#if !defined (HAVE_CXX_BITWISE_OP_TEMPLATES) -namespace std -{ - template <typename T> - struct bit_and - { - public: - T operator() (const T & op1, const T & op2) const { return (op1 & op2); } - }; - - template <typename T> - struct bit_or - { - public: - T operator() (const T & op1, const T & op2) const { return (op1 | op2); } - }; - - template <typename T> - struct bit_xor - { - public: - T operator() (const T & op1, const T & op2) const { return (op1 ^ op2); } - }; -} -#endif - -template <typename OP, typename T> -octave_value -bitopxx (const OP& op, const std::string& fname, - const Array<T>& x, const Array<T>& y) -{ - int nelx = x.numel (); - int nely = y.numel (); - - bool is_scalar_op = (nelx == 1 || nely == 1); - - dim_vector dvx = x.dims (); - dim_vector dvy = y.dims (); - - bool is_array_op = (dvx == dvy); - - octave_value retval; - if (is_array_op || is_scalar_op) - { - Array<T> result; - - if (nelx != 1) - result.resize (dvx); - else - result.resize (dvy); - - for (int i = 0; i < nelx; i++) - if (is_scalar_op) - for (int k = 0; k < nely; k++) - result(i+k) = op (x(i), y(k)); - else - result(i) = op (x(i), y(i)); - - retval = result; - } - else - error ("%s: size of X and Y must match, or one operand must be a scalar", - fname.c_str ()); - - return retval; -} - -// Trampoline function, instantiates the proper template above, with -// reflective information hardwired. We can't hardwire this information -// in Fbitxxx DEFUNs below, because at that moment, we still don't have -// information about which integer types we need to instantiate. -template<typename T> -octave_value -bitopx (const std::string& fname, const Array<T>& x, const Array<T>& y) -{ - if (fname == "bitand") - return bitopxx (std::bit_and<T>(), fname, x, y); - if (fname == "bitor") - return bitopxx (std::bit_or<T>(), fname, x, y); - - //else (fname == "bitxor") - return bitopxx (std::bit_xor<T>(), fname, x, y); -} - -octave_value -bitop (const std::string& fname, const octave_value_list& args) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2) - { - if ((args(0).class_name () == octave_scalar::static_class_name ()) - || (args(0).class_name () == octave_bool::static_class_name ()) - || (args(1).class_name () == octave_scalar::static_class_name ()) - || (args(1).class_name () == octave_bool::static_class_name ())) - { - bool arg0_is_int = (args(0).class_name () != - octave_scalar::static_class_name () && - args(0).class_name () != - octave_bool::static_class_name ()); - bool arg1_is_int = (args(1).class_name () != - octave_scalar::static_class_name () && - args(1).class_name () != - octave_bool::static_class_name ()); - - if (! (arg0_is_int || arg1_is_int)) - { - uint64NDArray x (args(0).array_value ()); - uint64NDArray y (args(1).array_value ()); - if (! error_state) - retval = bitopx (fname, x, y).array_value (); - } - else - { - int p = (arg0_is_int ? 1 : 0); - int q = (arg0_is_int ? 0 : 1); - - NDArray dx = args(p).array_value (); - - if (args(q).type_id () == octave_uint64_matrix::static_type_id () - || args(q).type_id () == octave_uint64_scalar::static_type_id ()) - { - uint64NDArray x (dx); - uint64NDArray y = args(q).uint64_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(q).type_id () == octave_uint32_matrix::static_type_id () - || args(q).type_id () == octave_uint32_scalar::static_type_id ()) - { - uint32NDArray x (dx); - uint32NDArray y = args(q).uint32_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(q).type_id () == octave_uint16_matrix::static_type_id () - || args(q).type_id () == octave_uint16_scalar::static_type_id ()) - { - uint16NDArray x (dx); - uint16NDArray y = args(q).uint16_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(q).type_id () == octave_uint8_matrix::static_type_id () - || args(q).type_id () == octave_uint8_scalar::static_type_id ()) - { - uint8NDArray x (dx); - uint8NDArray y = args(q).uint8_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(q).type_id () == octave_int64_matrix::static_type_id () - || args(q).type_id () == octave_int64_scalar::static_type_id ()) - { - int64NDArray x (dx); - int64NDArray y = args(q).int64_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(q).type_id () == octave_int32_matrix::static_type_id () - || args(q).type_id () == octave_int32_scalar::static_type_id ()) - { - int32NDArray x (dx); - int32NDArray y = args(q).int32_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(q).type_id () == octave_int16_matrix::static_type_id () - || args(q).type_id () == octave_int16_scalar::static_type_id ()) - { - int16NDArray x (dx); - int16NDArray y = args(q).int16_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(q).type_id () == octave_int8_matrix::static_type_id () - || args(q).type_id () == octave_int8_scalar::static_type_id ()) - { - int8NDArray x (dx); - int8NDArray y = args(q).int8_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else - error ("%s: invalid operand type", fname.c_str ()); - } - } - else if (args(0).class_name () == args(1).class_name ()) - { - if (args(0).type_id () == octave_uint64_matrix::static_type_id () - || args(0).type_id () == octave_uint64_scalar::static_type_id ()) - { - uint64NDArray x = args(0).uint64_array_value (); - uint64NDArray y = args(1).uint64_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(0).type_id () == octave_uint32_matrix::static_type_id () - || args(0).type_id () == octave_uint32_scalar::static_type_id ()) - { - uint32NDArray x = args(0).uint32_array_value (); - uint32NDArray y = args(1).uint32_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(0).type_id () == octave_uint16_matrix::static_type_id () - || args(0).type_id () == octave_uint16_scalar::static_type_id ()) - { - uint16NDArray x = args(0).uint16_array_value (); - uint16NDArray y = args(1).uint16_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(0).type_id () == octave_uint8_matrix::static_type_id () - || args(0).type_id () == octave_uint8_scalar::static_type_id ()) - { - uint8NDArray x = args(0).uint8_array_value (); - uint8NDArray y = args(1).uint8_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(0).type_id () == octave_int64_matrix::static_type_id () - || args(0).type_id () == octave_int64_scalar::static_type_id ()) - { - int64NDArray x = args(0).int64_array_value (); - int64NDArray y = args(1).int64_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(0).type_id () == octave_int32_matrix::static_type_id () - || args(0).type_id () == octave_int32_scalar::static_type_id ()) - { - int32NDArray x = args(0).int32_array_value (); - int32NDArray y = args(1).int32_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(0).type_id () == octave_int16_matrix::static_type_id () - || args(0).type_id () == octave_int16_scalar::static_type_id ()) - { - int16NDArray x = args(0).int16_array_value (); - int16NDArray y = args(1).int16_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(0).type_id () == octave_int8_matrix::static_type_id () - || args(0).type_id () == octave_int8_scalar::static_type_id ()) - { - int8NDArray x = args(0).int8_array_value (); - int8NDArray y = args(1).int8_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else - error ("%s: invalid operand type", fname.c_str ()); - } - else - error ("%s: must have matching operand types", fname.c_str ()); - } - else - print_usage (); - - return retval; -} - -DEFUN (bitand, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} bitand (@var{x}, @var{y})\n\ -Return the bitwise AND of non-negative integers.\n\ -@var{x}, @var{y} must be in the range [0,bitmax]\n\ -@seealso{bitor, bitxor, bitset, bitget, bitcmp, bitshift, bitmax}\n\ -@end deftypefn") -{ - return bitop ("bitand", args); -} - -DEFUN (bitor, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} bitor (@var{x}, @var{y})\n\ -Return the bitwise OR of non-negative integers.\n\ -@var{x}, @var{y} must be in the range [0,bitmax]\n\ -@seealso{bitor, bitxor, bitset, bitget, bitcmp, bitshift, bitmax}\n\ -@end deftypefn") -{ - return bitop ("bitor", args); -} - -DEFUN (bitxor, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} bitxor (@var{x}, @var{y})\n\ -Return the bitwise XOR of non-negative integers.\n\ -@var{x}, @var{y} must be in the range [0,bitmax]\n\ -@seealso{bitand, bitor, bitset, bitget, bitcmp, bitshift, bitmax}\n\ -@end deftypefn") -{ - return bitop ("bitxor", args); -} - -static int64_t -bitshift (double a, int n, int64_t mask) -{ - // In the name of bug-for-bug compatibility. - if (a < 0) - return -bitshift (-a, n, mask); - - if (n > 0) - return (static_cast<int64_t> (a) << n) & mask; - else if (n < 0) - return (static_cast<int64_t> (a) >> -n) & mask; - else - return static_cast<int64_t> (a) & mask; -} - -static int64_t -bitshift (float a, int n, int64_t mask) -{ - // In the name of bug-for-bug compatibility. - if (a < 0) - return -bitshift (-a, n, mask); - - if (n > 0) - return (static_cast<int64_t> (a) << n) & mask; - else if (n < 0) - return (static_cast<int64_t> (a) >> -n) & mask; - else - return static_cast<int64_t> (a) & mask; -} - -// Note that the bitshift operators are undefined if shifted by more -// bits than in the type, so we need to test for the size of the -// shift. - -#define DO_BITSHIFT(T) \ - if (! error_state) \ - { \ - double d1, d2; \ - \ - if (n.all_integers (d1, d2)) \ - { \ - int m_nel = m.numel (); \ - int n_nel = n.numel (); \ - \ - bool is_scalar_op = (m_nel == 1 || n_nel == 1); \ - \ - dim_vector m_dv = m.dims (); \ - dim_vector n_dv = n.dims (); \ - \ - bool is_array_op = (m_dv == n_dv); \ - \ - if (is_array_op || is_scalar_op) \ - { \ - T ## NDArray result; \ - \ - if (m_nel != 1) \ - result.resize (m_dv); \ - else \ - result.resize (n_dv); \ - \ - for (int i = 0; i < m_nel; i++) \ - if (is_scalar_op) \ - for (int k = 0; k < n_nel; k++) \ - if (static_cast<int> (n(k)) >= bits_in_type) \ - result(i+k) = 0; \ - else \ - result(i+k) = bitshift (m(i), static_cast<int> (n(k)), mask); \ - else \ - if (static_cast<int> (n(i)) >= bits_in_type) \ - result(i) = 0; \ - else \ - result(i) = bitshift (m(i), static_cast<int> (n(i)), mask); \ - \ - retval = result; \ - } \ - else \ - error ("bitshift: size of A and N must match, or one operand must be a scalar"); \ - } \ - else \ - error ("bitshift: expecting integer as second argument"); \ - } - -#define DO_UBITSHIFT(T, N) \ - do \ - { \ - int bits_in_type = octave_ ## T :: nbits (); \ - T ## NDArray m = m_arg.T ## _array_value (); \ - octave_ ## T mask = octave_ ## T::max (); \ - if ((N) < bits_in_type) \ - mask = bitshift (mask, (N) - bits_in_type); \ - else if ((N) < 1) \ - mask = 0; \ - DO_BITSHIFT (T); \ - } \ - while (0) - -#define DO_SBITSHIFT(T, N) \ - do \ - { \ - int bits_in_type = octave_ ## T :: nbits (); \ - T ## NDArray m = m_arg.T ## _array_value (); \ - octave_ ## T mask = octave_ ## T::max (); \ - if ((N) < bits_in_type) \ - mask = bitshift (mask, (N) - bits_in_type); \ - else if ((N) < 1) \ - mask = 0; \ - mask = mask | octave_ ## T :: min (); /* FIXME: 2's complement only? */ \ - DO_BITSHIFT (T); \ - } \ - while (0) - -DEFUN (bitshift, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} bitshift (@var{a}, @var{k})\n\ -@deftypefnx {Built-in Function} {} bitshift (@var{a}, @var{k}, @var{n})\n\ -Return a @var{k} bit shift of @var{n}-digit unsigned\n\ -integers in @var{a}. A positive @var{k} leads to a left shift;\n\ -A negative value to a right shift. If @var{n} is omitted it defaults\n\ -to log2(bitmax)+1.\n\ -@var{n} must be in the range [1,log2(bitmax)+1] usually [1,33].\n\ -\n\ -@example\n\ -@group\n\ -bitshift (eye (3), 1)\n\ -@result{}\n\ -@group\n\ -2 0 0\n\ -0 2 0\n\ -0 0 2\n\ -@end group\n\ -\n\ -bitshift (10, [-2, -1, 0, 1, 2])\n\ -@result{} 2 5 10 20 40\n\ -@c FIXME -- restore this example when third arg is allowed to be an array.\n\ -@c\n\ -@c\n\ -@c bitshift ([1, 10], 2, [3,4])\n\ -@c @result{} 4 8\n\ -@end group\n\ -@end example\n\ -@seealso{bitand, bitor, bitxor, bitset, bitget, bitcmp, bitmax}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2 || nargin == 3) - { - int nbits = 64; - - NDArray n = args(1).array_value (); - - if (error_state) - error ("bitshift: expecting integer as second argument"); - else - { - if (nargin == 3) - { - // FIXME -- for compatibility, we should accept an array - // or a scalar as the third argument. - if (args(2).numel () > 1) - error ("bitshift: N must be a scalar integer"); - else - { - nbits = args(2).int_value (); - - if (error_state) - error ("bitshift: N must be an integer"); - else if (nbits < 0) - error ("bitshift: N must be positive"); - } - } - } - - if (error_state) - return retval; - - octave_value m_arg = args(0); - std::string cname = m_arg.class_name (); - - if (cname == "uint8") - DO_UBITSHIFT (uint8, nbits < 8 ? nbits : 8); - else if (cname == "uint16") - DO_UBITSHIFT (uint16, nbits < 16 ? nbits : 16); - else if (cname == "uint32") - DO_UBITSHIFT (uint32, nbits < 32 ? nbits : 32); - else if (cname == "uint64") - DO_UBITSHIFT (uint64, nbits < 64 ? nbits : 64); - else if (cname == "int8") - DO_SBITSHIFT (int8, nbits < 8 ? nbits : 8); - else if (cname == "int16") - DO_SBITSHIFT (int16, nbits < 16 ? nbits : 16); - else if (cname == "int32") - DO_SBITSHIFT (int32, nbits < 32 ? nbits : 32); - else if (cname == "int64") - DO_SBITSHIFT (int64, nbits < 64 ? nbits : 64); - else if (cname == "double") - { - nbits = (nbits < 53 ? nbits : 53); - int64_t mask = 0x1FFFFFFFFFFFFFLL; - if (nbits < 53) - mask = mask >> (53 - nbits); - else if (nbits < 1) - mask = 0; - int bits_in_type = 64; - NDArray m = m_arg.array_value (); - DO_BITSHIFT ( ); - } - else - error ("bitshift: not defined for %s objects", cname.c_str ()); - } - else - print_usage (); - - return retval; -} - -DEFUN (bitmax, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} bitmax ()\n\ -@deftypefnx {Built-in Function} {} bitmax (\"double\")\n\ -@deftypefnx {Built-in Function} {} bitmax (\"single\")\n\ -Return the largest integer that can be represented within a floating point\n\ -value. The default class is \"double\", but \"single\" is a valid option.\n\ -On IEEE-754 compatible systems, @code{bitmax} is @w{@math{2^{53} - 1}}.\n\ -@end deftypefn") -{ - octave_value retval; - std::string cname = "double"; - int nargin = args.length (); - - if (nargin == 1 && args(0).is_string ()) - cname = args(0).string_value (); - else if (nargin != 0) - { - print_usage (); - return retval; - } - - if (cname == "double") - retval = (static_cast<double> (0x1FFFFFFFFFFFFFLL)); - else if (cname == "single") - retval = (static_cast<double> (0xFFFFFFL)); - else - error ("bitmax: not defined for class '%s'", cname.c_str ()); - - return retval; -} - -DEFUN (intmax, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} intmax (@var{type})\n\ -Return the largest integer that can be represented in an integer type.\n\ -The variable @var{type} can be\n\ -\n\ -@table @code\n\ -@item int8\n\ -signed 8-bit integer.\n\ -\n\ -@item int16\n\ -signed 16-bit integer.\n\ -\n\ -@item int32\n\ -signed 32-bit integer.\n\ -\n\ -@item int64\n\ -signed 64-bit integer.\n\ -\n\ -@item uint8\n\ -unsigned 8-bit integer.\n\ -\n\ -@item uint16\n\ -unsigned 16-bit integer.\n\ -\n\ -@item uint32\n\ -unsigned 32-bit integer.\n\ -\n\ -@item uint64\n\ -unsigned 64-bit integer.\n\ -@end table\n\ -\n\ -The default for @var{type} is @code{uint32}.\n\ -@seealso{intmin, bitmax}\n\ -@end deftypefn") -{ - octave_value retval; - std::string cname = "int32"; - int nargin = args.length (); - - if (nargin == 1 && args(0).is_string ()) - cname = args(0).string_value (); - else if (nargin != 0) - { - print_usage (); - return retval; - } - - if (cname == "uint8") - retval = octave_uint8 (std::numeric_limits<uint8_t>::max ()); - else if (cname == "uint16") - retval = octave_uint16 (std::numeric_limits<uint16_t>::max ()); - else if (cname == "uint32") - retval = octave_uint32 (std::numeric_limits<uint32_t>::max ()); - else if (cname == "uint64") - retval = octave_uint64 (std::numeric_limits<uint64_t>::max ()); - else if (cname == "int8") - retval = octave_int8 (std::numeric_limits<int8_t>::max ()); - else if (cname == "int16") - retval = octave_int16 (std::numeric_limits<int16_t>::max ()); - else if (cname == "int32") - retval = octave_int32 (std::numeric_limits<int32_t>::max ()); - else if (cname == "int64") - retval = octave_int64 (std::numeric_limits<int64_t>::max ()); - else - error ("intmax: not defined for '%s' objects", cname.c_str ()); - - return retval; -} - -DEFUN (intmin, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} intmin (@var{type})\n\ -Return the smallest integer that can be represented in an integer type.\n\ -The variable @var{type} can be\n\ -\n\ -@table @code\n\ -@item int8\n\ -signed 8-bit integer.\n\ -\n\ -@item int16\n\ -signed 16-bit integer.\n\ -\n\ -@item int32\n\ -signed 32-bit integer.\n\ -\n\ -@item int64\n\ -signed 64-bit integer.\n\ -\n\ -@item uint8\n\ -unsigned 8-bit integer.\n\ -\n\ -@item uint16\n\ -unsigned 16-bit integer.\n\ -\n\ -@item uint32\n\ -unsigned 32-bit integer.\n\ -\n\ -@item uint64\n\ -unsigned 64-bit integer.\n\ -@end table\n\ -\n\ -The default for @var{type} is @code{uint32}.\n\ -@seealso{intmax, bitmax}\n\ -@end deftypefn") -{ - octave_value retval; - std::string cname = "int32"; - int nargin = args.length (); - - if (nargin == 1 && args(0).is_string ()) - cname = args(0).string_value (); - else if (nargin != 0) - { - print_usage (); - return retval; - } - - if (cname == "uint8") - retval = octave_uint8 (std::numeric_limits<uint8_t>::min ()); - else if (cname == "uint16") - retval = octave_uint16 (std::numeric_limits<uint16_t>::min ()); - else if (cname == "uint32") - retval = octave_uint32 (std::numeric_limits<uint32_t>::min ()); - else if (cname == "uint64") - retval = octave_uint64 (std::numeric_limits<uint64_t>::min ()); - else if (cname == "int8") - retval = octave_int8 (std::numeric_limits<int8_t>::min ()); - else if (cname == "int16") - retval = octave_int16 (std::numeric_limits<int16_t>::min ()); - else if (cname == "int32") - retval = octave_int32 (std::numeric_limits<int32_t>::min ()); - else if (cname == "int64") - retval = octave_int64 (std::numeric_limits<int64_t>::min ()); - else - error ("intmin: not defined for '%s' objects", cname.c_str ()); - - return retval; -} - -DEFUN (sizemax, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} sizemax ()\n\ -Return the largest value allowed for the size of an array.\n\ -If Octave is compiled with 64-bit indexing, the result is of class int64,\n\ -otherwise it is of class int32. The maximum array size is slightly\n\ -smaller than the maximum value allowable for the relevant class as reported\n\ -by @code{intmax}.\n\ -@seealso{intmax}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 0) - retval = octave_int<octave_idx_type> (dim_vector::dim_max ()); - else - print_usage (); - - return retval; -}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/corefcn/bitfcns.cc Tue Jul 31 20:46:47 2012 -0400 @@ -0,0 +1,756 @@ +/* + +Copyright (C) 2004-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 +<http://www.gnu.org/licenses/>. + +*/ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include "str-vec.h" +#include "quit.h" + +#include "defun.h" +#include "error.h" +#include "ov.h" +#include "ov-uint64.h" +#include "ov-uint32.h" +#include "ov-uint16.h" +#include "ov-uint8.h" +#include "ov-int64.h" +#include "ov-int32.h" +#include "ov-int16.h" +#include "ov-int8.h" +#include "ov-scalar.h" +#include "ov-re-mat.h" +#include "ov-bool.h" + +#include <functional> + +#if !defined (HAVE_CXX_BITWISE_OP_TEMPLATES) +namespace std +{ + template <typename T> + struct bit_and + { + public: + T operator() (const T & op1, const T & op2) const { return (op1 & op2); } + }; + + template <typename T> + struct bit_or + { + public: + T operator() (const T & op1, const T & op2) const { return (op1 | op2); } + }; + + template <typename T> + struct bit_xor + { + public: + T operator() (const T & op1, const T & op2) const { return (op1 ^ op2); } + }; +} +#endif + +template <typename OP, typename T> +octave_value +bitopxx (const OP& op, const std::string& fname, + const Array<T>& x, const Array<T>& y) +{ + int nelx = x.numel (); + int nely = y.numel (); + + bool is_scalar_op = (nelx == 1 || nely == 1); + + dim_vector dvx = x.dims (); + dim_vector dvy = y.dims (); + + bool is_array_op = (dvx == dvy); + + octave_value retval; + if (is_array_op || is_scalar_op) + { + Array<T> result; + + if (nelx != 1) + result.resize (dvx); + else + result.resize (dvy); + + for (int i = 0; i < nelx; i++) + if (is_scalar_op) + for (int k = 0; k < nely; k++) + result(i+k) = op (x(i), y(k)); + else + result(i) = op (x(i), y(i)); + + retval = result; + } + else + error ("%s: size of X and Y must match, or one operand must be a scalar", + fname.c_str ()); + + return retval; +} + +// Trampoline function, instantiates the proper template above, with +// reflective information hardwired. We can't hardwire this information +// in Fbitxxx DEFUNs below, because at that moment, we still don't have +// information about which integer types we need to instantiate. +template<typename T> +octave_value +bitopx (const std::string& fname, const Array<T>& x, const Array<T>& y) +{ + if (fname == "bitand") + return bitopxx (std::bit_and<T>(), fname, x, y); + if (fname == "bitor") + return bitopxx (std::bit_or<T>(), fname, x, y); + + //else (fname == "bitxor") + return bitopxx (std::bit_xor<T>(), fname, x, y); +} + +octave_value +bitop (const std::string& fname, const octave_value_list& args) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2) + { + if ((args(0).class_name () == octave_scalar::static_class_name ()) + || (args(0).class_name () == octave_bool::static_class_name ()) + || (args(1).class_name () == octave_scalar::static_class_name ()) + || (args(1).class_name () == octave_bool::static_class_name ())) + { + bool arg0_is_int = (args(0).class_name () != + octave_scalar::static_class_name () && + args(0).class_name () != + octave_bool::static_class_name ()); + bool arg1_is_int = (args(1).class_name () != + octave_scalar::static_class_name () && + args(1).class_name () != + octave_bool::static_class_name ()); + + if (! (arg0_is_int || arg1_is_int)) + { + uint64NDArray x (args(0).array_value ()); + uint64NDArray y (args(1).array_value ()); + if (! error_state) + retval = bitopx (fname, x, y).array_value (); + } + else + { + int p = (arg0_is_int ? 1 : 0); + int q = (arg0_is_int ? 0 : 1); + + NDArray dx = args(p).array_value (); + + if (args(q).type_id () == octave_uint64_matrix::static_type_id () + || args(q).type_id () == octave_uint64_scalar::static_type_id ()) + { + uint64NDArray x (dx); + uint64NDArray y = args(q).uint64_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(q).type_id () == octave_uint32_matrix::static_type_id () + || args(q).type_id () == octave_uint32_scalar::static_type_id ()) + { + uint32NDArray x (dx); + uint32NDArray y = args(q).uint32_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(q).type_id () == octave_uint16_matrix::static_type_id () + || args(q).type_id () == octave_uint16_scalar::static_type_id ()) + { + uint16NDArray x (dx); + uint16NDArray y = args(q).uint16_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(q).type_id () == octave_uint8_matrix::static_type_id () + || args(q).type_id () == octave_uint8_scalar::static_type_id ()) + { + uint8NDArray x (dx); + uint8NDArray y = args(q).uint8_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(q).type_id () == octave_int64_matrix::static_type_id () + || args(q).type_id () == octave_int64_scalar::static_type_id ()) + { + int64NDArray x (dx); + int64NDArray y = args(q).int64_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(q).type_id () == octave_int32_matrix::static_type_id () + || args(q).type_id () == octave_int32_scalar::static_type_id ()) + { + int32NDArray x (dx); + int32NDArray y = args(q).int32_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(q).type_id () == octave_int16_matrix::static_type_id () + || args(q).type_id () == octave_int16_scalar::static_type_id ()) + { + int16NDArray x (dx); + int16NDArray y = args(q).int16_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(q).type_id () == octave_int8_matrix::static_type_id () + || args(q).type_id () == octave_int8_scalar::static_type_id ()) + { + int8NDArray x (dx); + int8NDArray y = args(q).int8_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else + error ("%s: invalid operand type", fname.c_str ()); + } + } + else if (args(0).class_name () == args(1).class_name ()) + { + if (args(0).type_id () == octave_uint64_matrix::static_type_id () + || args(0).type_id () == octave_uint64_scalar::static_type_id ()) + { + uint64NDArray x = args(0).uint64_array_value (); + uint64NDArray y = args(1).uint64_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(0).type_id () == octave_uint32_matrix::static_type_id () + || args(0).type_id () == octave_uint32_scalar::static_type_id ()) + { + uint32NDArray x = args(0).uint32_array_value (); + uint32NDArray y = args(1).uint32_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(0).type_id () == octave_uint16_matrix::static_type_id () + || args(0).type_id () == octave_uint16_scalar::static_type_id ()) + { + uint16NDArray x = args(0).uint16_array_value (); + uint16NDArray y = args(1).uint16_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(0).type_id () == octave_uint8_matrix::static_type_id () + || args(0).type_id () == octave_uint8_scalar::static_type_id ()) + { + uint8NDArray x = args(0).uint8_array_value (); + uint8NDArray y = args(1).uint8_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(0).type_id () == octave_int64_matrix::static_type_id () + || args(0).type_id () == octave_int64_scalar::static_type_id ()) + { + int64NDArray x = args(0).int64_array_value (); + int64NDArray y = args(1).int64_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(0).type_id () == octave_int32_matrix::static_type_id () + || args(0).type_id () == octave_int32_scalar::static_type_id ()) + { + int32NDArray x = args(0).int32_array_value (); + int32NDArray y = args(1).int32_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(0).type_id () == octave_int16_matrix::static_type_id () + || args(0).type_id () == octave_int16_scalar::static_type_id ()) + { + int16NDArray x = args(0).int16_array_value (); + int16NDArray y = args(1).int16_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(0).type_id () == octave_int8_matrix::static_type_id () + || args(0).type_id () == octave_int8_scalar::static_type_id ()) + { + int8NDArray x = args(0).int8_array_value (); + int8NDArray y = args(1).int8_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else + error ("%s: invalid operand type", fname.c_str ()); + } + else + error ("%s: must have matching operand types", fname.c_str ()); + } + else + print_usage (); + + return retval; +} + +DEFUN (bitand, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} bitand (@var{x}, @var{y})\n\ +Return the bitwise AND of non-negative integers.\n\ +@var{x}, @var{y} must be in the range [0,bitmax]\n\ +@seealso{bitor, bitxor, bitset, bitget, bitcmp, bitshift, bitmax}\n\ +@end deftypefn") +{ + return bitop ("bitand", args); +} + +DEFUN (bitor, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} bitor (@var{x}, @var{y})\n\ +Return the bitwise OR of non-negative integers.\n\ +@var{x}, @var{y} must be in the range [0,bitmax]\n\ +@seealso{bitor, bitxor, bitset, bitget, bitcmp, bitshift, bitmax}\n\ +@end deftypefn") +{ + return bitop ("bitor", args); +} + +DEFUN (bitxor, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} bitxor (@var{x}, @var{y})\n\ +Return the bitwise XOR of non-negative integers.\n\ +@var{x}, @var{y} must be in the range [0,bitmax]\n\ +@seealso{bitand, bitor, bitset, bitget, bitcmp, bitshift, bitmax}\n\ +@end deftypefn") +{ + return bitop ("bitxor", args); +} + +static int64_t +bitshift (double a, int n, int64_t mask) +{ + // In the name of bug-for-bug compatibility. + if (a < 0) + return -bitshift (-a, n, mask); + + if (n > 0) + return (static_cast<int64_t> (a) << n) & mask; + else if (n < 0) + return (static_cast<int64_t> (a) >> -n) & mask; + else + return static_cast<int64_t> (a) & mask; +} + +static int64_t +bitshift (float a, int n, int64_t mask) +{ + // In the name of bug-for-bug compatibility. + if (a < 0) + return -bitshift (-a, n, mask); + + if (n > 0) + return (static_cast<int64_t> (a) << n) & mask; + else if (n < 0) + return (static_cast<int64_t> (a) >> -n) & mask; + else + return static_cast<int64_t> (a) & mask; +} + +// Note that the bitshift operators are undefined if shifted by more +// bits than in the type, so we need to test for the size of the +// shift. + +#define DO_BITSHIFT(T) \ + if (! error_state) \ + { \ + double d1, d2; \ + \ + if (n.all_integers (d1, d2)) \ + { \ + int m_nel = m.numel (); \ + int n_nel = n.numel (); \ + \ + bool is_scalar_op = (m_nel == 1 || n_nel == 1); \ + \ + dim_vector m_dv = m.dims (); \ + dim_vector n_dv = n.dims (); \ + \ + bool is_array_op = (m_dv == n_dv); \ + \ + if (is_array_op || is_scalar_op) \ + { \ + T ## NDArray result; \ + \ + if (m_nel != 1) \ + result.resize (m_dv); \ + else \ + result.resize (n_dv); \ + \ + for (int i = 0; i < m_nel; i++) \ + if (is_scalar_op) \ + for (int k = 0; k < n_nel; k++) \ + if (static_cast<int> (n(k)) >= bits_in_type) \ + result(i+k) = 0; \ + else \ + result(i+k) = bitshift (m(i), static_cast<int> (n(k)), mask); \ + else \ + if (static_cast<int> (n(i)) >= bits_in_type) \ + result(i) = 0; \ + else \ + result(i) = bitshift (m(i), static_cast<int> (n(i)), mask); \ + \ + retval = result; \ + } \ + else \ + error ("bitshift: size of A and N must match, or one operand must be a scalar"); \ + } \ + else \ + error ("bitshift: expecting integer as second argument"); \ + } + +#define DO_UBITSHIFT(T, N) \ + do \ + { \ + int bits_in_type = octave_ ## T :: nbits (); \ + T ## NDArray m = m_arg.T ## _array_value (); \ + octave_ ## T mask = octave_ ## T::max (); \ + if ((N) < bits_in_type) \ + mask = bitshift (mask, (N) - bits_in_type); \ + else if ((N) < 1) \ + mask = 0; \ + DO_BITSHIFT (T); \ + } \ + while (0) + +#define DO_SBITSHIFT(T, N) \ + do \ + { \ + int bits_in_type = octave_ ## T :: nbits (); \ + T ## NDArray m = m_arg.T ## _array_value (); \ + octave_ ## T mask = octave_ ## T::max (); \ + if ((N) < bits_in_type) \ + mask = bitshift (mask, (N) - bits_in_type); \ + else if ((N) < 1) \ + mask = 0; \ + mask = mask | octave_ ## T :: min (); /* FIXME: 2's complement only? */ \ + DO_BITSHIFT (T); \ + } \ + while (0) + +DEFUN (bitshift, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} bitshift (@var{a}, @var{k})\n\ +@deftypefnx {Built-in Function} {} bitshift (@var{a}, @var{k}, @var{n})\n\ +Return a @var{k} bit shift of @var{n}-digit unsigned\n\ +integers in @var{a}. A positive @var{k} leads to a left shift;\n\ +A negative value to a right shift. If @var{n} is omitted it defaults\n\ +to log2(bitmax)+1.\n\ +@var{n} must be in the range [1,log2(bitmax)+1] usually [1,33].\n\ +\n\ +@example\n\ +@group\n\ +bitshift (eye (3), 1)\n\ +@result{}\n\ +@group\n\ +2 0 0\n\ +0 2 0\n\ +0 0 2\n\ +@end group\n\ +\n\ +bitshift (10, [-2, -1, 0, 1, 2])\n\ +@result{} 2 5 10 20 40\n\ +@c FIXME -- restore this example when third arg is allowed to be an array.\n\ +@c\n\ +@c\n\ +@c bitshift ([1, 10], 2, [3,4])\n\ +@c @result{} 4 8\n\ +@end group\n\ +@end example\n\ +@seealso{bitand, bitor, bitxor, bitset, bitget, bitcmp, bitmax}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2 || nargin == 3) + { + int nbits = 64; + + NDArray n = args(1).array_value (); + + if (error_state) + error ("bitshift: expecting integer as second argument"); + else + { + if (nargin == 3) + { + // FIXME -- for compatibility, we should accept an array + // or a scalar as the third argument. + if (args(2).numel () > 1) + error ("bitshift: N must be a scalar integer"); + else + { + nbits = args(2).int_value (); + + if (error_state) + error ("bitshift: N must be an integer"); + else if (nbits < 0) + error ("bitshift: N must be positive"); + } + } + } + + if (error_state) + return retval; + + octave_value m_arg = args(0); + std::string cname = m_arg.class_name (); + + if (cname == "uint8") + DO_UBITSHIFT (uint8, nbits < 8 ? nbits : 8); + else if (cname == "uint16") + DO_UBITSHIFT (uint16, nbits < 16 ? nbits : 16); + else if (cname == "uint32") + DO_UBITSHIFT (uint32, nbits < 32 ? nbits : 32); + else if (cname == "uint64") + DO_UBITSHIFT (uint64, nbits < 64 ? nbits : 64); + else if (cname == "int8") + DO_SBITSHIFT (int8, nbits < 8 ? nbits : 8); + else if (cname == "int16") + DO_SBITSHIFT (int16, nbits < 16 ? nbits : 16); + else if (cname == "int32") + DO_SBITSHIFT (int32, nbits < 32 ? nbits : 32); + else if (cname == "int64") + DO_SBITSHIFT (int64, nbits < 64 ? nbits : 64); + else if (cname == "double") + { + nbits = (nbits < 53 ? nbits : 53); + int64_t mask = 0x1FFFFFFFFFFFFFLL; + if (nbits < 53) + mask = mask >> (53 - nbits); + else if (nbits < 1) + mask = 0; + int bits_in_type = 64; + NDArray m = m_arg.array_value (); + DO_BITSHIFT ( ); + } + else + error ("bitshift: not defined for %s objects", cname.c_str ()); + } + else + print_usage (); + + return retval; +} + +DEFUN (bitmax, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} bitmax ()\n\ +@deftypefnx {Built-in Function} {} bitmax (\"double\")\n\ +@deftypefnx {Built-in Function} {} bitmax (\"single\")\n\ +Return the largest integer that can be represented within a floating point\n\ +value. The default class is \"double\", but \"single\" is a valid option.\n\ +On IEEE-754 compatible systems, @code{bitmax} is @w{@math{2^{53} - 1}}.\n\ +@end deftypefn") +{ + octave_value retval; + std::string cname = "double"; + int nargin = args.length (); + + if (nargin == 1 && args(0).is_string ()) + cname = args(0).string_value (); + else if (nargin != 0) + { + print_usage (); + return retval; + } + + if (cname == "double") + retval = (static_cast<double> (0x1FFFFFFFFFFFFFLL)); + else if (cname == "single") + retval = (static_cast<double> (0xFFFFFFL)); + else + error ("bitmax: not defined for class '%s'", cname.c_str ()); + + return retval; +} + +DEFUN (intmax, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} intmax (@var{type})\n\ +Return the largest integer that can be represented in an integer type.\n\ +The variable @var{type} can be\n\ +\n\ +@table @code\n\ +@item int8\n\ +signed 8-bit integer.\n\ +\n\ +@item int16\n\ +signed 16-bit integer.\n\ +\n\ +@item int32\n\ +signed 32-bit integer.\n\ +\n\ +@item int64\n\ +signed 64-bit integer.\n\ +\n\ +@item uint8\n\ +unsigned 8-bit integer.\n\ +\n\ +@item uint16\n\ +unsigned 16-bit integer.\n\ +\n\ +@item uint32\n\ +unsigned 32-bit integer.\n\ +\n\ +@item uint64\n\ +unsigned 64-bit integer.\n\ +@end table\n\ +\n\ +The default for @var{type} is @code{uint32}.\n\ +@seealso{intmin, bitmax}\n\ +@end deftypefn") +{ + octave_value retval; + std::string cname = "int32"; + int nargin = args.length (); + + if (nargin == 1 && args(0).is_string ()) + cname = args(0).string_value (); + else if (nargin != 0) + { + print_usage (); + return retval; + } + + if (cname == "uint8") + retval = octave_uint8 (std::numeric_limits<uint8_t>::max ()); + else if (cname == "uint16") + retval = octave_uint16 (std::numeric_limits<uint16_t>::max ()); + else if (cname == "uint32") + retval = octave_uint32 (std::numeric_limits<uint32_t>::max ()); + else if (cname == "uint64") + retval = octave_uint64 (std::numeric_limits<uint64_t>::max ()); + else if (cname == "int8") + retval = octave_int8 (std::numeric_limits<int8_t>::max ()); + else if (cname == "int16") + retval = octave_int16 (std::numeric_limits<int16_t>::max ()); + else if (cname == "int32") + retval = octave_int32 (std::numeric_limits<int32_t>::max ()); + else if (cname == "int64") + retval = octave_int64 (std::numeric_limits<int64_t>::max ()); + else + error ("intmax: not defined for '%s' objects", cname.c_str ()); + + return retval; +} + +DEFUN (intmin, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} intmin (@var{type})\n\ +Return the smallest integer that can be represented in an integer type.\n\ +The variable @var{type} can be\n\ +\n\ +@table @code\n\ +@item int8\n\ +signed 8-bit integer.\n\ +\n\ +@item int16\n\ +signed 16-bit integer.\n\ +\n\ +@item int32\n\ +signed 32-bit integer.\n\ +\n\ +@item int64\n\ +signed 64-bit integer.\n\ +\n\ +@item uint8\n\ +unsigned 8-bit integer.\n\ +\n\ +@item uint16\n\ +unsigned 16-bit integer.\n\ +\n\ +@item uint32\n\ +unsigned 32-bit integer.\n\ +\n\ +@item uint64\n\ +unsigned 64-bit integer.\n\ +@end table\n\ +\n\ +The default for @var{type} is @code{uint32}.\n\ +@seealso{intmax, bitmax}\n\ +@end deftypefn") +{ + octave_value retval; + std::string cname = "int32"; + int nargin = args.length (); + + if (nargin == 1 && args(0).is_string ()) + cname = args(0).string_value (); + else if (nargin != 0) + { + print_usage (); + return retval; + } + + if (cname == "uint8") + retval = octave_uint8 (std::numeric_limits<uint8_t>::min ()); + else if (cname == "uint16") + retval = octave_uint16 (std::numeric_limits<uint16_t>::min ()); + else if (cname == "uint32") + retval = octave_uint32 (std::numeric_limits<uint32_t>::min ()); + else if (cname == "uint64") + retval = octave_uint64 (std::numeric_limits<uint64_t>::min ()); + else if (cname == "int8") + retval = octave_int8 (std::numeric_limits<int8_t>::min ()); + else if (cname == "int16") + retval = octave_int16 (std::numeric_limits<int16_t>::min ()); + else if (cname == "int32") + retval = octave_int32 (std::numeric_limits<int32_t>::min ()); + else if (cname == "int64") + retval = octave_int64 (std::numeric_limits<int64_t>::min ()); + else + error ("intmin: not defined for '%s' objects", cname.c_str ()); + + return retval; +} + +DEFUN (sizemax, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} sizemax ()\n\ +Return the largest value allowed for the size of an array.\n\ +If Octave is compiled with 64-bit indexing, the result is of class int64,\n\ +otherwise it is of class int32. The maximum array size is slightly\n\ +smaller than the maximum value allowable for the relevant class as reported\n\ +by @code{intmax}.\n\ +@seealso{intmax}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 0) + retval = octave_int<octave_idx_type> (dim_vector::dim_max ()); + else + print_usage (); + + return retval; +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/corefcn/mappers.cc Tue Jul 31 20:46:47 2012 -0400 @@ -0,0 +1,2087 @@ +/* + +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 +<http://www.gnu.org/licenses/>. + +*/ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <cctype> +#include <cfloat> + +#include "lo-ieee.h" +#include "lo-specfun.h" +#include "lo-mappers.h" + +#include "defun.h" +#include "error.h" +#include "variables.h" + +DEFUN (abs, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} abs (@var{z})\n\ +Compute the magnitude of @var{z}, defined as\n\ +@tex\n\ +$|z| = \\sqrt{x^2 + y^2}$.\n\ +@end tex\n\ +@ifnottex\n\ +|@var{z}| = @code{sqrt (x^2 + y^2)}.\n\ +@end ifnottex\n\ +\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +abs (3 + 4i)\n\ + @result{} 5\n\ +@end group\n\ +@end example\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).abs (); + else + print_usage (); + + return retval; +} + +/* +%!assert (abs (1), 1) +%!assert (abs (-3.5), 3.5) +%!assert (abs (3+4i), 5) +%!assert (abs (3-4i), 5) +%!assert (abs ([1.1, 3i; 3+4i, -3-4i]), [1.1, 3; 5, 5]) + +%!assert (abs (single (1)), single (1)) +%!assert (abs (single (-3.5)), single (3.5)) +%!assert (abs (single (3+4i)), single (5)) +%!assert (abs (single (3-4i)), single (5)) +%!assert (abs (single ([1.1, 3i; 3+4i, -3-4i])), single ([1.1, 3; 5, 5])) + +%!error abs () +%!error abs (1, 2) +*/ + +DEFUN (acos, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} acos (@var{x})\n\ +Compute the inverse cosine in radians for each element of @var{x}.\n\ +@seealso{cos, acosd}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).acos (); + else + print_usage (); + + return retval; +} + +/* +%!shared rt2, rt3 +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); + +%!test +%! x = [1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]; +%! v = [0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]; +%! assert (acos (x), v, sqrt (eps)); + +%!test +%! x = single ([1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]); +%! v = single ([0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]); +%! assert (acos (x), v, sqrt (eps ("single"))); + +%!error acos () +%!error acos (1, 2) +*/ + +DEFUN (acosh, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} acosh (@var{x})\n\ +Compute the inverse hyperbolic cosine for each element of @var{x}.\n\ +@seealso{cosh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).acosh (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! x = [1, 0, -1, 0]; +%! v = [0, pi/2*i, pi*i, pi/2*i]; +%! assert (acosh (x), v, sqrt (eps)); + +%!test +%! x = single ([1, 0, -1, 0]); +%! v = single ([0, pi/2*i, pi*i, pi/2*i]); +%! assert (acosh (x), v, sqrt (eps ("single"))); + +%!error acosh () +%!error acosh (1, 2) +*/ + +DEFUN (angle, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} angle (@var{z})\n\ +See arg.\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).arg (); + else + print_usage (); + + return retval; +} + +DEFUN (arg, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} arg (@var{z})\n\ +@deftypefnx {Mapping Function} {} angle (@var{z})\n\ +Compute the argument of @var{z}, defined as,\n\ +@tex\n\ +$\\theta = atan2 (y, x),$\n\ +@end tex\n\ +@ifnottex\n\ +@var{theta} = @code{atan2 (@var{y}, @var{x})},\n\ +@end ifnottex\n\ +in radians.\n\ +\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +arg (3 + 4i)\n\ + @result{} 0.92730\n\ +@end group\n\ +@end example\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).arg (); + else + print_usage (); + + return retval; +} + +/* +%!assert (arg (1), 0) +%!assert (arg (i), pi/2) +%!assert (arg (-1), pi) +%!assert (arg (-i), -pi/2) +%!assert (arg ([1, i; -1, -i]), [0, pi/2; pi, -pi/2]) + +%!assert (arg (single (1)), single (0)) +%!assert (arg (single (i)), single (pi/2)) +%!test +%! if (ismac ()) +%! ## Avoid failing for a MacOS feature +%! assert (arg (single (-1)), single (pi), 2*eps (single (1))); +%! else +%! assert (arg (single (-1)), single (pi)); +%! endif +%!assert (arg (single (-i)), single (-pi/2)) +%!assert (arg (single ([1, i; -1, -i])), single ([0, pi/2; pi, -pi/2]), 2e1*eps ("single")) + +%!error arg () +%!error arg (1, 2) +*/ + +DEFUN (asin, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} asin (@var{x})\n\ +Compute the inverse sine in radians for each element of @var{x}.\n\ +@seealso{sin, asind}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).asin (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); +%! x = [0, 1/2, rt2/2, rt3/2, 1, rt3/2, rt2/2, 1/2, 0]; +%! v = [0, pi/6, pi/4, pi/3, pi/2, pi/3, pi/4, pi/6, 0]; +%! assert (all (abs (asin (x) - v) < sqrt (eps))); + +%!error asin () +%!error asin (1, 2) +*/ + +DEFUN (asinh, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} asinh (@var{x})\n\ +Compute the inverse hyperbolic sine for each element of @var{x}.\n\ +@seealso{sinh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).asinh (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! v = [0, pi/2*i, 0, -pi/2*i]; +%! x = [0, i, 0, -i]; +%! assert (asinh (x), v, sqrt (eps)); + +%!test +%! v = single ([0, pi/2*i, 0, -pi/2*i]); +%! x = single ([0, i, 0, -i]); +%! assert (asinh (x), v, sqrt (eps ("single"))); + +%!error asinh () +%!error asinh (1, 2) +*/ + +DEFUN (atan, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} atan (@var{x})\n\ +Compute the inverse tangent in radians for each element of @var{x}.\n\ +@seealso{tan, atand}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).atan (); + else + print_usage (); + + return retval; +} + +/* +%!shared rt2, rt3 +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); + +%!test +%! v = [0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]; +%! x = [0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]; +%! assert (atan (x), v, sqrt (eps)); + +%!test +%! v = single ([0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]); +%! x = single ([0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]); +%! assert (atan (x), v, sqrt (eps ("single"))); + +%!error atan () +%!error atan (1, 2) +*/ + +DEFUN (atanh, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} atanh (@var{x})\n\ +Compute the inverse hyperbolic tangent for each element of @var{x}.\n\ +@seealso{tanh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).atanh (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! v = [0, 0]; +%! x = [0, 0]; +%! assert (atanh (x), v, sqrt (eps)); + +%!test +%! v = single ([0, 0]); +%! x = single ([0, 0]); +%! assert (atanh (x), v, sqrt (eps ("single"))); + +%!error atanh () +%!error atanh (1, 2) +*/ + +DEFUN (cbrt, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} cbrt (@var{x})\n\ +Compute the real cube root of each element of @var{x}.\n\ +Unlike @code{@var{x}^(1/3)}, the result will be negative if @var{x} is\n\ +negative.\n\ +@seealso{nthroot}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).cbrt (); + else + print_usage (); + + return retval; +} + +/* +%!assert (cbrt (64), 4) +%!assert (cbrt (-125), -5) +%!assert (cbrt (0), 0) +%!assert (cbrt (Inf), Inf) +%!assert (cbrt (-Inf), -Inf) +%!assert (cbrt (NaN), NaN) +%!assert (cbrt (2^300), 2^100) +%!assert (cbrt (125*2^300), 5*2^100) + +%!error cbrt () +%!error cbrt (1, 2) +*/ + +DEFUN (ceil, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} ceil (@var{x})\n\ +Return the smallest integer not less than @var{x}. This is equivalent to\n\ +rounding towards positive infinity. If @var{x} is\n\ +complex, return @code{ceil (real (@var{x})) + ceil (imag (@var{x})) * I}.\n\ +\n\ +@example\n\ +@group\n\ +ceil ([-2.7, 2.7])\n\ + @result{} -2 3\n\ +@end group\n\ +@end example\n\ +@seealso{floor, round, fix}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).ceil (); + else + print_usage (); + + return retval; +} + +/* +## double precision +%!assert (ceil ([2, 1.1, -1.1, -1]), [2, 2, -1, -1]) + +## complex double precison +%!assert (ceil ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i]), [2+2i, 2+2i, -1-i, -1-i]) + +## single precision +%!assert (ceil (single ([2, 1.1, -1.1, -1])), single ([2, 2, -1, -1])) + +## complex single precision +%!assert (ceil (single ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i])), single ([2+2i, 2+2i, -1-i, -1-i])) + +%!error ceil () +%!error ceil (1, 2) +*/ + +DEFUN (conj, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} conj (@var{z})\n\ +Return the complex conjugate of @var{z}, defined as\n\ +@tex\n\ +$\\bar{z} = x - iy$.\n\ +@end tex\n\ +@ifnottex\n\ +@code{conj (@var{z})} = @var{x} - @var{i}@var{y}.\n\ +@end ifnottex\n\ +@seealso{real, imag}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).conj (); + else + print_usage (); + + return retval; +} + +/* +%!assert (conj (1), 1) +%!assert (conj (i), -i) +%!assert (conj (1+i), 1-i) +%!assert (conj (1-i), 1+i) +%!assert (conj ([-1, -i; -1+i, -1-i]), [-1, i; -1-i, -1+i]) + +%!assert (conj (single (1)), single (1)) +%!assert (conj (single (i)), single (-i)) +%!assert (conj (single (1+i)), single (1-i)) +%!assert (conj (single (1-i)), single (1+i)) +%!assert (conj (single ([-1, -i; -1+i, -1-i])), single ([-1, i; -1-i, -1+i])) + +%!error conj () +%!error conj (1, 2) +*/ + +DEFUN (cos, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} cos (@var{x})\n\ +Compute the cosine for each element of @var{x} in radians.\n\ +@seealso{acos, cosd, cosh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).cos (); + else + print_usage (); + + return retval; +} + +/* +%!shared rt2, rt3 +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); + +%!test +%! x = [0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]; +%! v = [1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]; +%! assert (cos (x), v, sqrt (eps)); + +%!test +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); +%! x = single ([0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]); +%! v = single ([1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]); +%! assert (cos (x), v, sqrt (eps ("single"))); + +%!error cos () +%!error cos (1, 2) +*/ + +DEFUN (cosh, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} cosh (@var{x})\n\ +Compute the hyperbolic cosine for each element of @var{x}.\n\ +@seealso{acosh, sinh, tanh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).cosh (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! x = [0, pi/2*i, pi*i, 3*pi/2*i]; +%! v = [1, 0, -1, 0]; +%! assert (cosh (x), v, sqrt (eps)); + +%!test +%! x = single ([0, pi/2*i, pi*i, 3*pi/2*i]); +%! v = single ([1, 0, -1, 0]); +%! assert (cosh (x), v, sqrt (eps ("single"))); + +%!error cosh () +%!error cosh (1, 2) +*/ + +DEFUN (erf, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} erf (@var{z})\n\ +Compute the error function,\n\ +@tex\n\ +$$\n\ + {\\rm erf} (z) = {2 \\over \\sqrt{\\pi}}\\int_0^z e^{-t^2} dt\n\ +$$\n\ +@end tex\n\ +@ifnottex\n\ +\n\ +@example\n\ +@group\n\ + z\n\ + 2 /\n\ +erf (z) = --------- * | e^(-t^2) dt\n\ + sqrt (pi) /\n\ + t=0\n\ +@end group\n\ +@end example\n\ +\n\ +@end ifnottex\n\ +@seealso{erfc, erfcx, erfinv, erfcinv}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).erf (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! a = -1i*sqrt (-1/(6.4187*6.4187)); +%! assert (erf (a), erf (real (a))); + +%!test +%! x = [0,.5,1]; +%! v = [0, .520499877813047, .842700792949715]; +%! assert (erf (x), v, 1.e-10); +%! assert (erf (-x), -v, 1.e-10); +%! assert (erfc (x), 1-v, 1.e-10); +%! assert (erfinv (v), x, 1.e-10); + +%!test +%! a = -1i*sqrt (single (-1/(6.4187*6.4187))); +%! assert (erf (a), erf (real (a))); + +%!test +%! x = single ([0,.5,1]); +%! v = single ([0, .520499877813047, .842700792949715]); +%! assert (erf (x), v, 1.e-6); +%! assert (erf (-x), -v, 1.e-6); +%! assert (erfc (x), 1-v, 1.e-6); +%! assert (erfinv (v), x, 1.e-6); + +%!error erf () +%!error erf (1, 2) +*/ + +DEFUN (erfinv, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} erfinv (@var{x})\n\ +Compute the inverse error function, i.e., @var{y} such that\n\ +\n\ +@example\n\ +erf (@var{y}) == @var{x}\n\ +@end example\n\ +@seealso{erf, erfc, erfcx, erfcinv}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).erfinv (); + else + print_usage (); + + return retval; +} + +/* +## middle region +%!assert (erf (erfinv ([-0.9 -0.3 0 0.4 0.8])), [-0.9 -0.3 0 0.4 0.8], eps) +%!assert (erf (erfinv (single ([-0.9 -0.3 0 0.4 0.8]))), single ([-0.9 -0.3 0 0.4 0.8]), eps ("single")) +## tail region +%!assert (erf (erfinv ([-0.999 -0.99 0.9999 0.99999])), [-0.999 -0.99 0.9999 0.99999], eps) +%!assert (erf (erfinv (single ([-0.999 -0.99 0.9999 0.99999]))), single ([-0.999 -0.99 0.9999 0.99999]), eps ("single")) +## backward - loss of accuracy +%!assert (erfinv (erf ([-3 -1 -0.4 0.7 1.3 2.8])), [-3 -1 -0.4 0.7 1.3 2.8], -1e-12) +%!assert (erfinv (erf (single ([-3 -1 -0.4 0.7 1.3 2.8]))), single ([-3 -1 -0.4 0.7 1.3 2.8]), -1e-4) +## exceptional +%!assert (erfinv ([-1, 1, 1.1, -2.1]), [-Inf, Inf, NaN, NaN]) +%!error erfinv (1+2i) + +%!error erfinv () +%!error erfinv (1, 2) +*/ + +DEFUN (erfcinv, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} erfcinv (@var{x})\n\ +Compute the inverse complementary error function, i.e., @var{y} such that\n\ +\n\ +@example\n\ +erfc (@var{y}) == @var{x}\n\ +@end example\n\ +@seealso{erfc, erf, erfcx, erfinv}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).erfcinv (); + else + print_usage (); + + return retval; +} + +/* +## middle region +%!assert (erfc (erfcinv ([1.9 1.3 1 0.6 0.2])), [1.9 1.3 1 0.6 0.2], eps) +%!assert (erfc (erfcinv (single ([1.9 1.3 1 0.6 0.2]))), single ([1.9 1.3 1 0.6 0.2]), eps ("single")) +## tail region +%!assert (erfc (erfcinv ([0.001 0.01 1.9999 1.99999])), [0.001 0.01 1.9999 1.99999], eps) +%!assert (erfc (erfcinv (single ([0.001 0.01 1.9999 1.99999]))), single ([0.001 0.01 1.9999 1.99999]), eps ("single")) +## backward - loss of accuracy +%!assert (erfcinv (erfc ([-3 -1 -0.4 0.7 1.3 2.8])), [-3 -1 -0.4 0.7 1.3 2.8], -1e-12) +%!assert (erfcinv (erfc (single ([-3 -1 -0.4 0.7 1.3 2.8]))), single ([-3 -1 -0.4 0.7 1.3 2.8]), -1e-4) +## exceptional +%!assert (erfcinv ([2, 0, -0.1, 2.1]), [-Inf, Inf, NaN, NaN]) +%!error erfcinv (1+2i) + +%!error erfcinv () +%!error erfcinv (1, 2) +*/ + +DEFUN (erfc, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} erfc (@var{z})\n\ +Compute the complementary error function,\n\ +@tex\n\ +$1 - {\\rm erf} (z)$.\n\ +@end tex\n\ +@ifnottex\n\ +@w{@code{1 - erf (@var{z})}}.\n\ +@end ifnottex\n\ +@seealso{erfcinv, erfcx, erf, erfinv}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).erfc (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! a = -1i*sqrt (-1/(6.4187*6.4187)); +%! assert (erfc (a), erfc (real (a))); + +%!error erfc () +%!error erfc (1, 2) +*/ + +DEFUN (erfcx, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} erfcx (@var{z})\n\ +Compute the scaled complementary error function,\n\ +@tex\n\ +$$\n\ + e^{z^2} {\\rm erfc} (z) \\equiv e^{z^2} (1 - {\\rm erf} (z))\n\ +$$\n\ +@end tex\n\ +@ifnottex\n\ +\n\ +@example\n\ +exp (z^2) * erfc (x)\n\ +@end example\n\ +\n\ +@end ifnottex\n\ +@seealso{erfc, erf, erfinv, erfcinv}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).erfcx (); + else + print_usage (); + + return retval; +} + +/* +## FIXME: Need a test for erfcx + +%!error erfcx () +%!error erfcx (1, 2) +*/ + +DEFUN (exp, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} exp (@var{x})\n\ +Compute\n\ +@tex\n\ +$e^{x}$\n\ +@end tex\n\ +@ifnottex\n\ +@code{e^x}\n\ +@end ifnottex\n\ +for each element of @var{x}. To compute the matrix\n\ +exponential, see @ref{Linear Algebra}.\n\ +@seealso{log}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).exp (); + else + print_usage (); + + return retval; +} + +/* +%!assert (exp ([0, 1, -1, -1000]), [1, e, 1/e, 0], sqrt (eps)) +%!assert (exp (1+i), e * (cos (1) + sin (1) * i), sqrt (eps)) +%!assert (exp (single ([0, 1, -1, -1000])), single ([1, e, 1/e, 0]), sqrt (eps ("single"))) +%!assert (exp (single (1+i)), single (e * (cos (1) + sin (1) * i)), sqrt (eps ("single"))) + +%!assert (exp ([Inf, -Inf, NaN]), [Inf 0 NaN]) +%!assert (exp (single ([Inf, -Inf, NaN])), single ([Inf 0 NaN])) + +%!error exp () +%!error exp (1, 2) +*/ + +DEFUN (expm1, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} expm1 (@var{x})\n\ +Compute\n\ +@tex\n\ +$ e^{x} - 1 $\n\ +@end tex\n\ +@ifnottex\n\ +@code{exp (@var{x}) - 1}\n\ +@end ifnottex\n\ +accurately in the neighborhood of zero.\n\ +@seealso{exp}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).expm1 (); + else + print_usage (); + + return retval; +} + +/* +%!assert (expm1 (2*eps), 2*eps, 1e-29) + +%!assert (expm1 ([Inf, -Inf, NaN]), [Inf -1 NaN]) +%!assert (expm1 (single ([Inf, -Inf, NaN])), single ([Inf -1 NaN])) + +%!error expm1 () +%!error expm1 (1, 2) +*/ + +DEFUN (isfinite, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isfinite (@var{x})\n\ +@deftypefnx {Mapping Function} {} finite (@var{x})\n\ +Return a logical array which is true where the elements of @var{x} are\n\ +finite values and false where they are not.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +finite ([13, Inf, NA, NaN])\n\ + @result{} [ 1, 0, 0, 0 ]\n\ +@end group\n\ +@end example\n\ +@seealso{isinf, isnan, isna}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).finite (); + else + print_usage (); + + return retval; +} + +/* +%!assert (!finite (Inf)) +%!assert (!finite (NaN)) +%!assert (finite (rand (1,10))) + +%!assert (!finite (single (Inf))) +%!assert (!finite (single (NaN))) +%!assert (finite (single (rand (1,10)))) + +%!error finite () +%!error finite (1, 2) +*/ + +DEFUN (fix, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} fix (@var{x})\n\ +Truncate fractional portion of @var{x} and return the integer portion. This\n\ +is equivalent to rounding towards zero. If @var{x} is complex, return\n\ +@code{fix (real (@var{x})) + fix (imag (@var{x})) * I}.\n\ +\n\ +@example\n\ +@group\n\ +fix ([-2.7, 2.7])\n\ + @result{} -2 2\n\ +@end group\n\ +@end example\n\ +@seealso{ceil, floor, round}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).fix (); + else + print_usage (); + + return retval; +} + +/* +%!assert (fix ([1.1, 1, -1.1, -1]), [1, 1, -1, -1]) +%!assert (fix ([1.1+1.1i, 1+i, -1.1-1.1i, -1-i]), [1+i, 1+i, -1-i, -1-i]) +%!assert (fix (single ([1.1, 1, -1.1, -1])), single ([1, 1, -1, -1])) +%!assert (fix (single ([1.1+1.1i, 1+i, -1.1-1.1i, -1-i])), single ([1+i, 1+i, -1-i, -1-i])) + +%!error fix () +%!error fix (1, 2) +*/ + +DEFUN (floor, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} floor (@var{x})\n\ +Return the largest integer not greater than @var{x}. This is equivalent to\n\ +rounding towards negative infinity. If @var{x} is\n\ +complex, return @code{floor (real (@var{x})) + floor (imag (@var{x})) * I}.\n\ +\n\ +@example\n\ +@group\n\ +floor ([-2.7, 2.7])\n\ + @result{} -3 2\n\ +@end group\n\ +@end example\n\ +@seealso{ceil, round, fix}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).floor (); + else + print_usage (); + + return retval; +} + +/* +%!assert (floor ([2, 1.1, -1.1, -1]), [2, 1, -2, -1]) +%!assert (floor ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i]), [2+2i, 1+i, -2-2i, -1-i]) +%!assert (floor (single ([2, 1.1, -1.1, -1])), single ([2, 1, -2, -1])) +%!assert (floor (single ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i])), single ([2+2i, 1+i, -2-2i, -1-i])) + +%!error floor () +%!error floor (1, 2) +*/ + +DEFUN (gamma, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} gamma (@var{z})\n\ +Compute the Gamma function,\n\ +@tex\n\ +$$\n\ + \\Gamma (z) = \\int_0^\\infty t^{z-1} e^{-t} dt.\n\ +$$\n\ +@end tex\n\ +@ifnottex\n\ +\n\ +@example\n\ +@group\n\ + infinity\n\ + /\n\ +gamma (z) = | t^(z-1) exp (-t) dt.\n\ + /\n\ + t=0\n\ +@end group\n\ +@end example\n\ +\n\ +@end ifnottex\n\ +@seealso{gammainc, lgamma}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).gamma (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! a = -1i*sqrt (-1/(6.4187*6.4187)); +%! assert (gamma (a), gamma (real (a))); + +%!test +%! x = [.5, 1, 1.5, 2, 3, 4, 5]; +%! v = [sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]; +%! assert (gamma (x), v, sqrt (eps)); + +%!test +%! a = single (-1i*sqrt (-1/(6.4187*6.4187))); +%! assert (gamma (a), gamma (real (a))); + +%!test +%! x = single ([.5, 1, 1.5, 2, 3, 4, 5]); +%! v = single ([sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]); +%! assert (gamma (x), v, sqrt (eps ("single"))); + +%!test +%! x = [-1, 0, 1, Inf]; +%! v = [Inf, Inf, 1, Inf]; +%! assert (gamma (x), v); +%! assert (gamma (single (x)), single (v)); + +%!error gamma () +%!error gamma (1, 2) +*/ + +DEFUN (imag, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} imag (@var{z})\n\ +Return the imaginary part of @var{z} as a real number.\n\ +@seealso{real, conj}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).imag (); + else + print_usage (); + + return retval; +} + +/* +%!assert (imag (1), 0) +%!assert (imag (i), 1) +%!assert (imag (1+i), 1) +%!assert (imag ([i, 1; 1, i]), full (eye (2))) + +%!assert (imag (single (1)), single (0)) +%!assert (imag (single (i)), single (1)) +%!assert (imag (single (1+i)), single (1)) +%!assert (imag (single ([i, 1; 1, i])), full (eye (2,"single"))) + +%!error imag () +%!error imag (1, 2) +*/ + +DEFUNX ("isalnum", Fisalnum, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isalnum (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +letters or digits and false where they are not. This is equivalent to\n\ +(@code{isalpha (@var{s}) | isdigit (@var{s})}).\n\ +@seealso{isalpha, isdigit, ispunct, isspace, iscntrl}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisalnum (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii ("A":"Z") + 1) = true; +%! result(toascii ("0":"9") + 1) = true; +%! result(toascii ("a":"z") + 1) = true; +%! assert (isalnum (charset), result); + +%!error isalnum () +%!error isalnum (1, 2) +*/ + +DEFUNX ("isalpha", Fisalpha, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isalpha (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +letters and false where they are not. This is equivalent to\n\ +(@code{islower (@var{s}) | isupper (@var{s})}).\n\ +@seealso{isdigit, ispunct, isspace, iscntrl, isalnum, islower, isupper}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisalpha (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii ("A":"Z") + 1) = true; +%! result(toascii ("a":"z") + 1) = true; +%! assert (isalpha (charset), result); + +%!error isalpha () +%!error isalpha (1, 2) +*/ + +DEFUNX ("isascii", Fisascii, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isascii (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +ASCII characters (in the range 0 to 127 decimal) and false where they are\n\ +not.\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisascii (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = true (1, 128); +%! assert (isascii (charset), result); + +%!error isascii () +%!error isascii (1, 2) +*/ + +DEFUNX ("iscntrl", Fiscntrl, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} iscntrl (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +control characters and false where they are not.\n\ +@seealso{ispunct, isspace, isalpha, isdigit}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xiscntrl (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(1:32) = true; +%! result(128) = true; +%! assert (iscntrl (charset), result); + +%!error iscntrl () +%!error iscntrl (1, 2) +*/ + +DEFUNX ("isdigit", Fisdigit, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isdigit (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +decimal digits (0-9) and false where they are not.\n\ +@seealso{isxdigit, isalpha, isletter, ispunct, isspace, iscntrl}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisdigit (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii ("0":"9") + 1) = true; +%! assert (isdigit (charset), result); + +%!error isdigit () +%!error isdigit (1, 2) +*/ + +DEFUN (isinf, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isinf (@var{x})\n\ +Return a logical array which is true where the elements of @var{x} are\n\ +are infinite and false where they are not.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +isinf ([13, Inf, NA, NaN])\n\ + @result{} [ 0, 1, 0, 0 ]\n\ +@end group\n\ +@end example\n\ +@seealso{isfinite, isnan, isna}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).isinf (); + else + print_usage (); + + return retval; +} + +/* +%!assert (isinf (Inf)) +%!assert (!isinf (NaN)) +%!assert (!isinf (NA)) +%!assert (isinf (rand (1,10)), false (1,10)) +%!assert (isinf ([NaN -Inf -1 0 1 Inf NA]), [false, true, false, false, false, true, false]) + +%!assert (isinf (single (Inf))) +%!assert (!isinf (single (NaN))) +%!assert (!isinf (single (NA))) +%!assert (isinf (single (rand (1,10))), false (1,10)) +%!assert (isinf (single ([NaN -Inf -1 0 1 Inf NA])), [false, true, false, false, false, true, false]) + +%!error isinf () +%!error isinf (1, 2) +*/ + +DEFUNX ("isgraph", Fisgraph, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isgraph (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +printable characters (but not the space character) and false where they are\n\ +not.\n\ +@seealso{isprint}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisgraph (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(34:127) = true; +%! assert (isgraph (charset), result); + +%!error isgraph () +%!error isgraph (1, 2) +*/ + +DEFUNX ("islower", Fislower, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} islower (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +lowercase letters and false where they are not.\n\ +@seealso{isupper, isalpha, isletter, isalnum}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xislower (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii ("a":"z") + 1) = true; +%! assert (islower (charset), result); + +%!error islower () +%!error islower (1, 2) +*/ + +DEFUN (isna, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isna (@var{x})\n\ +Return a logical array which is true where the elements of @var{x} are\n\ +NA (missing) values and false where they are not.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +isna ([13, Inf, NA, NaN])\n\ + @result{} [ 0, 0, 1, 0 ]\n\ +@end group\n\ +@end example\n\ +@seealso{isnan, isinf, isfinite}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).isna (); + else + print_usage (); + + return retval; +} + +/* +%!assert (!isna (Inf)) +%!assert (!isna (NaN)) +%!assert (isna (NA)) +%!assert (isna (rand (1,10)), false (1,10)) +%!assert (isna ([NaN -Inf -1 0 1 Inf NA]), [false, false, false, false, false, false, true]) + +%!assert (!isna (single (Inf))) +%!assert (!isna (single (NaN))) +%!assert (isna (single (NA))) +%!assert (isna (single (rand (1,10))), false (1,10)) +%!assert (isna (single ([NaN -Inf -1 0 1 Inf NA])), [false, false, false, false, false, false, true]) + +%!error isna () +%!error isna (1, 2) +*/ + +DEFUN (isnan, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isnan (@var{x})\n\ +Return a logical array which is true where the elements of @var{x} are\n\ +NaN values and false where they are not.\n\ +NA values are also considered NaN values. For example:\n\ +\n\ +@example\n\ +@group\n\ +isnan ([13, Inf, NA, NaN])\n\ + @result{} [ 0, 0, 1, 1 ]\n\ +@end group\n\ +@end example\n\ +@seealso{isna, isinf, isfinite}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).isnan (); + else + print_usage (); + + return retval; +} + +/* +%!assert (!isnan (Inf)) +%!assert (isnan (NaN)) +%!assert (isnan (NA)) +%!assert (isnan (rand (1,10)), false (1,10)) +%!assert (isnan ([NaN -Inf -1 0 1 Inf NA]), [true, false, false, false, false, false, true]) + +%!assert (!isnan (single (Inf))) +%!assert (isnan (single (NaN))) +%!assert (isnan (single (NA))) +%!assert (isnan (single (rand (1,10))), false (1,10)) +%!assert (isnan (single ([NaN -Inf -1 0 1 Inf NA])), [true, false, false, false, false, false, true]) + +%!error isnan () +%!error isnan (1, 2) +*/ + +DEFUNX ("isprint", Fisprint, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isprint (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +printable characters (including the space character) and false where they\n\ +are not.\n\ +@seealso{isgraph}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisprint (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(33:127) = true; +%! assert (isprint (charset), result); + +%!error isprint () +%!error isprint (1, 2) +*/ + +DEFUNX ("ispunct", Fispunct, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} ispunct (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +punctuation characters and false where they are not.\n\ +@seealso{isalpha, isdigit, isspace, iscntrl}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xispunct (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(34:48) = true; +%! result(59:65) = true; +%! result(92:97) = true; +%! result(124:127) = true; +%! assert (ispunct (charset), result); + +%!error ispunct () +%!error ispunct (1, 2) +*/ + +DEFUNX ("isspace", Fisspace, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isspace (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +whitespace characters (space, formfeed, newline, carriage return, tab, and\n\ +vertical tab) and false where they are not.\n\ +@seealso{iscntrl, ispunct, isalpha, isdigit}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisspace (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii (" \f\n\r\t\v") + 1) = true; +%! assert (isspace (charset), result); + +%!error isspace () +%!error isspace (1, 2) +*/ + +DEFUNX ("isupper", Fisupper, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isupper (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +uppercase letters and false where they are not.\n\ +@seealso{islower, isalpha, isletter, isalnum}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisupper (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii ("A":"Z") + 1) = true; +%! assert (isupper (charset), result); + +%!error isupper () +%!error isupper (1, 2) +*/ + +DEFUNX ("isxdigit", Fisxdigit, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isxdigit (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +hexadecimal digits (0-9 and @nospell{a-fA-F}).\n\ +@seealso{isdigit}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisxdigit (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii ("A":"F") + 1) = true; +%! result(toascii ("0":"9") + 1) = true; +%! result(toascii ("a":"f") + 1) = true; +%! assert (isxdigit (charset), result); + +%!error isxdigit () +%!error isxdigit (1, 2) +*/ + +DEFUN (lgamma, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} lgamma (@var{x})\n\ +@deftypefnx {Mapping Function} {} gammaln (@var{x})\n\ +Return the natural logarithm of the gamma function of @var{x}.\n\ +@seealso{gamma, gammainc}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).lgamma (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! a = -1i*sqrt (-1/(6.4187*6.4187)); +%! assert (lgamma (a), lgamma (real (a))); + +%!test +%! x = [.5, 1, 1.5, 2, 3, 4, 5]; +%! v = [sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]; +%! assert (lgamma (x), log (v), sqrt (eps)) + +%!test +%! a = single (-1i*sqrt (-1/(6.4187*6.4187))); +%! assert (lgamma (a), lgamma (real (a))); + +%!test +%! x = single ([.5, 1, 1.5, 2, 3, 4, 5]); +%! v = single ([sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]); +%! assert (lgamma (x), log (v), sqrt (eps ("single"))) + +%!test +%! x = [-1, 0, 1, Inf]; +%! v = [Inf, Inf, 0, Inf]; +%! assert (lgamma (x), v); +%! assert (lgamma (single (x)), single (v)); + +%!error lgamma () +%!error lgamma (1,2) +*/ + +DEFUN (log, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} log (@var{x})\n\ +Compute the natural logarithm,\n\ +@tex\n\ +$\\ln{(x)},$\n\ +@end tex\n\ +@ifnottex\n\ +@code{ln (@var{x})},\n\ +@end ifnottex\n\ +for each element of @var{x}. To compute the\n\ +matrix logarithm, see @ref{Linear Algebra}.\n\ +@seealso{exp, log1p, log2, log10, logspace}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).log (); + else + print_usage (); + + return retval; +} + +/* +%!assert (log ([1, e, e^2]), [0, 1, 2], sqrt (eps)) +%!assert (log ([-0.5, -1.5, -2.5]), log ([0.5, 1.5, 2.5]) + pi*1i, sqrt (eps)) + +%!assert (log (single ([1, e, e^2])), single ([0, 1, 2]), sqrt (eps ("single"))) +%!assert (log (single ([-0.5, -1.5, -2.5])), single (log ([0.5, 1.5, 2.5]) + pi*1i), 4*eps ("single")) + +%!error log () +%!error log (1, 2) +*/ + +DEFUN (log10, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} log10 (@var{x})\n\ +Compute the base-10 logarithm of each element of @var{x}.\n\ +@seealso{log, log2, logspace, exp}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).log10 (); + else + print_usage (); + + return retval; +} + +/* +%!assert (log10 ([0.01, 0.1, 1, 10, 100]), [-2, -1, 0, 1, 2], sqrt (eps)) +%!assert (log10 (single ([0.01, 0.1, 1, 10, 100])), single ([-2, -1, 0, 1, 2]), sqrt (eps ("single"))) + +%!error log10 () +%!error log10 (1, 2) +*/ + +DEFUN (log1p, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} log1p (@var{x})\n\ +Compute\n\ +@tex\n\ +$\\ln{(1 + x)}$\n\ +@end tex\n\ +@ifnottex\n\ +@code{log (1 + @var{x})}\n\ +@end ifnottex\n\ +accurately in the neighborhood of zero.\n\ +@seealso{log, exp, expm1}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).log1p (); + else + print_usage (); + + return retval; +} + +/* +%!assert (log1p ([0, 2*eps, -2*eps]), [0, 2*eps, -2*eps], 1e-29) +%!assert (log1p (single ([0, 2*eps, -2*eps])), single ([0, 2*eps, -2*eps]), 1e-29) + +%!error log1p () +%!error log1p (1, 2) +*/ + +DEFUN (real, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} real (@var{z})\n\ +Return the real part of @var{z}.\n\ +@seealso{imag, conj}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).real (); + else + print_usage (); + + return retval; +} + +/* +%!assert (real (1), 1) +%!assert (real (i), 0) +%!assert (real (1+i), 1) +%!assert (real ([1, i; i, 1]), full (eye (2))) + +%!assert (real (single (1)), single (1)) +%!assert (real (single (i)), single (0)) +%!assert (real (single (1+i)), single (1)) +%!assert (real (single ([1, i; i, 1])), full (eye (2,"single"))) + +%!error real () +%!error real (1, 2) +*/ + +DEFUN (round, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} round (@var{x})\n\ +Return the integer nearest to @var{x}. If @var{x} is complex, return\n\ +@code{round (real (@var{x})) + round (imag (@var{x})) * I}. If there\n\ +are two nearest integers, return the one further away from zero.\n\ +\n\ +@example\n\ +@group\n\ +round ([-2.7, 2.7])\n\ + @result{} -3 3\n\ +@end group\n\ +@end example\n\ +@seealso{ceil, floor, fix, roundb}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).round (); + else + print_usage (); + + return retval; +} + +/* +%!assert (round (1), 1) +%!assert (round (1.1), 1) +%!assert (round (5.5), 6) +%!assert (round (i), i) +%!assert (round (2.5+3.5i), 3+4i) +%!assert (round (-2.6), -3) +%!assert (round ([1.1, -2.4; -3.7, 7.1]), [1, -2; -4, 7]) + +%!assert (round (single (1)), single (1)) +%!assert (round (single (1.1)), single (1)) +%!assert (round (single (5.5)), single (6)) +%!assert (round (single (i)), single (i)) +%!assert (round (single (2.5+3.5i)), single (3+4i)) +%!assert (round (single (-2.6)), single (-3)) +%!assert (round (single ([1.1, -2.4; -3.7, 7.1])), single ([1, -2; -4, 7])) + +%!error round () +%!error round (1, 2) +*/ + +DEFUN (roundb, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} roundb (@var{x})\n\ +Return the integer nearest to @var{x}. If there are two nearest\n\ +integers, return the even one (banker's rounding). If @var{x} is complex,\n\ +return @code{roundb (real (@var{x})) + roundb (imag (@var{x})) * I}.\n\ +@seealso{round}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).roundb (); + else + print_usage (); + + return retval; +} + +/* +%!assert (roundb (1), 1) +%!assert (roundb (1.1), 1) +%!assert (roundb (1.5), 2) +%!assert (roundb (4.5), 4) +%!assert (roundb (i), i) +%!assert (roundb (2.5+3.5i), 2+4i) +%!assert (roundb (-2.6), -3) +%!assert (roundb ([1.1, -2.4; -3.7, 7.1]), [1, -2; -4, 7]) + +%!assert (roundb (single (1)), single (1)) +%!assert (roundb (single (1.1)), single (1)) +%!assert (roundb (single (1.5)), single (2)) +%!assert (roundb (single (4.5)), single (4)) +%!assert (roundb (single (i)), single (i)) +%!assert (roundb (single (2.5+3.5i)), single (2+4i)) +%!assert (roundb (single (-2.6)), single (-3)) +%!assert (roundb (single ([1.1, -2.4; -3.7, 7.1])), single ([1, -2; -4, 7])) + +%!error roundb () +%!error roundb (1, 2) +*/ + +DEFUN (sign, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} sign (@var{x})\n\ +Compute the @dfn{signum} function, which is defined as\n\ +@tex\n\ +$$\n\ +{\\rm sign} (@var{x}) = \\cases{1,&$x>0$;\\cr 0,&$x=0$;\\cr -1,&$x<0$.\\cr}\n\ +$$\n\ +@end tex\n\ +@ifnottex\n\ +\n\ +@example\n\ +@group\n\ + -1, x < 0;\n\ +sign (x) = 0, x = 0;\n\ + 1, x > 0.\n\ +@end group\n\ +@end example\n\ +\n\ +@end ifnottex\n\ +\n\ +For complex arguments, @code{sign} returns @code{x ./ abs (@var{x})}.\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).signum (); + else + print_usage (); + + return retval; +} + +/* +%!assert (sign (-2) , -1) +%!assert (sign (0), 0) +%!assert (sign (3), 1) +%!assert (sign ([1, -pi; e, 0]), [1, -1; 1, 0]) + +%!assert (sign (single (-2)) , single (-1)) +%!assert (sign (single (0)), single (0)) +%!assert (sign (single (3)), single (1)) +%!assert (sign (single ([1, -pi; e, 0])), single ([1, -1; 1, 0])) + +%!error sign () +%!error sign (1, 2) +*/ + +DEFUN (sin, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} sin (@var{x})\n\ +Compute the sine for each element of @var{x} in radians.\n\ +@seealso{asin, sind, sinh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).sin (); + else + print_usage (); + + return retval; +} + +/* +%!shared rt2, rt3 +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); + +%!test +%! x = [0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]; +%! v = [0, 1/2, rt2/2, rt3/2, 1, rt3/2, rt2/2, 1/2, 0]; +%! assert (sin (x), v, sqrt (eps)); + +%!test +%! x = single ([0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]); +%! v = single ([0, 1/2, rt2/2, rt3/2, 1, rt3/2, rt2/2, 1/2, 0]); +%! assert (sin (x), v, sqrt (eps ("single"))); + +%!error sin () +%!error sin (1, 2) +*/ + +DEFUN (sinh, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} sinh (@var{x})\n\ +Compute the hyperbolic sine for each element of @var{x}.\n\ +@seealso{asinh, cosh, tanh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).sinh (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! x = [0, pi/2*i, pi*i, 3*pi/2*i]; +%! v = [0, i, 0, -i]; +%! assert (sinh (x), v, sqrt (eps)); + +%!test +%! x = single ([0, pi/2*i, pi*i, 3*pi/2*i]); +%! v = single ([0, i, 0, -i]); +%! assert (sinh (x), v, sqrt (eps ("single"))); + +%!error sinh () +%!error sinh (1, 2) +*/ + +DEFUN (sqrt, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} sqrt (@var{x})\n\ +Compute the square root of each element of @var{x}. If @var{x} is negative,\n\ +a complex result is returned. To compute the matrix square root, see\n\ +@ref{Linear Algebra}.\n\ +@seealso{realsqrt, nthroot}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).sqrt (); + else + print_usage (); + + return retval; +} + +/* +%!assert (sqrt (4), 2) +%!assert (sqrt (-1), i) +%!assert (sqrt (1+i), exp (0.5 * log (1+i)), sqrt (eps)) +%!assert (sqrt ([4, -4; i, 1-i]), [2, 2i; exp(0.5 * log (i)), exp(0.5 * log (1-i))], sqrt (eps)) + +%!assert (sqrt (single (4)), single (2)) +%!assert (sqrt (single (-1)), single (i)) +%!assert (sqrt (single (1+i)), single (exp (0.5 * log (1+i))), sqrt (eps ("single"))) +%!assert (sqrt (single ([4, -4; i, 1-i])), single ([2, 2i; exp(0.5 * log (i)), exp(0.5 * log (1-i))]), sqrt (eps ("single"))) + +%!error sqrt () +%!error sqrt (1, 2) +*/ + +DEFUN (tan, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} tan (@var{z})\n\ +Compute the tangent for each element of @var{x} in radians.\n\ +@seealso{atan, tand, tanh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).tan (); + else + print_usage (); + + return retval; +} + +/* +%!shared rt2, rt3 +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); + +%!test +%! x = [0, pi/6, pi/4, pi/3, 2*pi/3, 3*pi/4, 5*pi/6, pi]; +%! v = [0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]; +%! assert (tan (x), v, sqrt (eps)); + +%!test +%! x = single ([0, pi/6, pi/4, pi/3, 2*pi/3, 3*pi/4, 5*pi/6, pi]); +%! v = single ([0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]); +%! assert (tan (x), v, sqrt (eps ("single"))); + +%!error tan () +%!error tan (1, 2) +*/ + +DEFUN (tanh, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} tanh (@var{x})\n\ +Compute hyperbolic tangent for each element of @var{x}.\n\ +@seealso{atanh, sinh, cosh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).tanh (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! x = [0, pi*i]; +%! v = [0, 0]; +%! assert (tanh (x), v, sqrt (eps)); + +%!test +%! x = single ([0, pi*i]); +%! v = single ([0, 0]); +%! assert (tanh (x), v, sqrt (eps ("single"))); + +%!error tanh () +%!error tanh (1, 2) +*/ + +DEFUNX ("toascii", Ftoascii, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} toascii (@var{s})\n\ +Return ASCII representation of @var{s} in a matrix. For example:\n\ +\n\ +@example\n\ +@group\n\ +toascii (\"ASCII\")\n\ + @result{} [ 65, 83, 67, 73, 73 ]\n\ +@end group\n\ +\n\ +@end example\n\ +@seealso{char}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xtoascii (); + else + print_usage (); + + return retval; +} + +/* +%!assert (toascii (char (0:127)), 0:127) +%!assert (toascii (" ":"@"), 32:64) +%!assert (toascii ("A":"Z"), 65:90) +%!assert (toascii ("[":"`"), 91:96) +%!assert (toascii ("a":"z"), 97:122) +%!assert (toascii ("{":"~"), 123:126) + +%!error toascii () +%!error toascii (1, 2) +*/ + +DEFUNX ("tolower", Ftolower, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} tolower (@var{s})\n\ +@deftypefnx {Mapping Function} {} lower (@var{s})\n\ +Return a copy of the string or cell string @var{s}, with each uppercase\n\ +character replaced by the corresponding lowercase one; non-alphabetic\n\ +characters are left unchanged. For example:\n\ +\n\ +@example\n\ +@group\n\ +tolower (\"MiXeD cAsE 123\")\n\ + @result{} \"mixed case 123\"\n\ +@end group\n\ +@end example\n\ +@seealso{toupper}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xtolower (); + else + print_usage (); + + return retval; +} + +DEFALIAS (lower, tolower); + +/* +%!assert (tolower ("OCTAVE"), "octave") +%!assert (tolower ("123OCTave!_&"), "123octave!_&") +%!assert (tolower ({"ABC", "DEF", {"GHI", {"JKL"}}}), {"abc", "def", {"ghi", {"jkl"}}}) +%!assert (tolower (["ABC"; "DEF"]), ["abc"; "def"]) +%!assert (tolower ({["ABC"; "DEF"]}), {["abc";"def"]}) +%!assert (tolower (68), "d") +%!assert (tolower ({[68, 68; 68, 68]}), {["dd";"dd"]}) +%!test +%! a(3,3,3,3) = "D"; +%! assert (tolower (a)(3,3,3,3), "d"); + +%!test +%! charset = char (0:127); +%! result = charset; +%! result (toascii ("A":"Z") + 1) = result (toascii ("a":"z") + 1); +%! assert (tolower (charset), result); + +%!error <Invalid call to tolower> lower () +%!error <Invalid call to tolower> tolower () +%!error tolower (1, 2) +*/ + +DEFUNX ("toupper", Ftoupper, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} toupper (@var{s})\n\ +@deftypefnx {Mapping Function} {} upper (@var{s})\n\ +Return a copy of the string or cell string @var{s}, with each lowercase\n\ +character replaced by the corresponding uppercase one; non-alphabetic\n\ +characters are left unchanged. For example:\n\ +\n\ +@example\n\ +@group\n\ +toupper (\"MiXeD cAsE 123\")\n\ + @result{} \"MIXED CASE 123\"\n\ +@end group\n\ +@end example\n\ +@seealso{tolower}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xtoupper (); + else + print_usage (); + + return retval; +} + +DEFALIAS (upper, toupper); + +/* +%!assert (toupper ("octave"), "OCTAVE") +%!assert (toupper ("123OCTave!_&"), "123OCTAVE!_&") +%!assert (toupper ({"abc", "def", {"ghi", {"jkl"}}}), {"ABC", "DEF", {"GHI", {"JKL"}}}) +%!assert (toupper (["abc"; "def"]), ["ABC"; "DEF"]) +%!assert (toupper ({["abc"; "def"]}), {["ABC";"DEF"]}) +%!assert (toupper (100), "D") +%!assert (toupper ({[100, 100; 100, 100]}), {["DD";"DD"]}) +%!test +%! a(3,3,3,3) = "d"; +%! assert (toupper (a)(3,3,3,3), "D"); +%!test +%! charset = char (0:127); +%! result = charset; +%! result (toascii ("a":"z") + 1) = result (toascii ("A":"Z") + 1); +%! assert (toupper (charset), result); + +%!error <Invalid call to toupper> toupper () +%!error <Invalid call to toupper> upper () +%!error toupper (1, 2) +*/ + +DEFALIAS (gammaln, lgamma); + +DEFALIAS (finite, isfinite);
--- a/src/corefcn/module.mk Tue Jul 31 20:39:08 2012 -0400 +++ b/src/corefcn/module.mk Tue Jul 31 20:46:47 2012 -0400 @@ -10,6 +10,7 @@ corefcn/balance.cc \ corefcn/besselj.cc \ corefcn/betainc.cc \ + corefcn/bitfcns.cc \ corefcn/bsxfun.cc \ corefcn/cellfun.cc \ corefcn/colloc.cc \ @@ -40,6 +41,7 @@ corefcn/lsode.cc \ corefcn/lu.cc \ corefcn/luinc.cc \ + corefcn/mappers.cc \ corefcn/matrix_type.cc \ corefcn/max.cc \ corefcn/md5sum.cc \ @@ -53,13 +55,16 @@ corefcn/rcond.cc \ corefcn/regexp.cc \ corefcn/schur.cc \ + corefcn/sparse.cc \ corefcn/spparms.cc \ corefcn/sqrtm.cc \ corefcn/str2double.cc \ corefcn/strfind.cc \ + corefcn/strfns.cc \ corefcn/sub2ind.cc \ corefcn/svd.cc \ corefcn/syl.cc \ + corefcn/syscalls.cc \ corefcn/time.cc \ corefcn/tril.cc \ corefcn/typecast.cc
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/corefcn/sparse.cc Tue Jul 31 20:46:47 2012 -0400 @@ -0,0 +1,268 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler +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 +<http://www.gnu.org/licenses/>. + +*/ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <cstdlib> +#include <string> + +#include "variables.h" +#include "utils.h" +#include "pager.h" +#include "defun.h" +#include "gripes.h" +#include "quit.h" +#include "unwind-prot.h" + +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" +#include "ov-bool-sparse.h" + +DEFUN (issparse, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} issparse (@var{x})\n\ +Return true if @var{x} is a sparse matrix.\n\ +@seealso{ismatrix}\n\ +@end deftypefn") +{ + if (args.length () != 1) + { + print_usage (); + return octave_value (); + } + else + return octave_value (args(0).is_sparse_type ()); +} + +DEFUN (sparse, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{s} =} sparse (@var{a})\n\ +@deftypefnx {Built-in Function} {@var{s} =} sparse (@var{i}, @var{j}, @var{sv}, @var{m}, @var{n}, @var{nzmax})\n\ +@deftypefnx {Built-in Function} {@var{s} =} sparse (@var{i}, @var{j}, @var{sv})\n\ +@deftypefnx {Built-in Function} {@var{s} =} sparse (@var{i}, @var{j}, @var{s}, @var{m}, @var{n}, \"unique\")\n\ +@deftypefnx {Built-in Function} {@var{s} =} sparse (@var{m}, @var{n})\n\ +Create a sparse matrix from the full matrix or row, column, value triplets.\n\ +If @var{a} is a full matrix, convert it to a sparse matrix representation,\n\ +removing all zero values in the process.\n\ +\n\ +Given the integer index vectors @var{i} and @var{j}, a 1-by-@code{nnz} vector\n\ +of real of complex values @var{sv}, overall dimensions @var{m} and @var{n}\n\ +of the sparse matrix. The argument @code{nzmax} is ignored but accepted for\n\ +compatibility with @sc{matlab}. If @var{m} or @var{n} are not specified\n\ +their values are derived from the maximum index in the vectors @var{i} and\n\ +@var{j} as given by @code{@var{m} = max (@var{i})},\n\ +@code{@var{n} = max (@var{j})}.\n\ +\n\ +@strong{Note}: if multiple values are specified with the same\n\ +@var{i}, @var{j} indices, the corresponding values in @var{s} will\n\ +be added. See @code{accumarray} for an example of how to produce different\n\ +behavior, such as taking the minimum instead.\n\ +\n\ +The following are all equivalent:\n\ +\n\ +@example\n\ +@group\n\ +s = sparse (i, j, s, m, n)\n\ +s = sparse (i, j, s, m, n, \"summation\")\n\ +s = sparse (i, j, s, m, n, \"sum\")\n\ +@end group\n\ +@end example\n\ +\n\ +Given the option \"unique\". if more than two values are specified for the\n\ +same @var{i}, @var{j} indices, the last specified value will be used.\n\ +\n\ +@code{sparse (@var{m}, @var{n})} is equivalent to\n\ +@code{sparse ([], [], [], @var{m}, @var{n}, 0)}\n\ +\n\ +If any of @var{sv}, @var{i} or @var{j} are scalars, they are expanded\n\ +to have a common size.\n\ +@seealso{full, accumarray}\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + + // Temporarily disable sparse_auto_mutate if set (it's obsolete anyway). + unwind_protect frame; + frame.protect_var (Vsparse_auto_mutate); + Vsparse_auto_mutate = false; + + if (nargin == 1) + { + octave_value arg = args (0); + if (arg.is_bool_type ()) + retval = arg.sparse_bool_matrix_value (); + else if (arg.is_complex_type ()) + retval = arg.sparse_complex_matrix_value (); + else if (arg.is_numeric_type ()) + retval = arg.sparse_matrix_value (); + else + gripe_wrong_type_arg ("sparse", arg); + } + else if (nargin == 2) + { + octave_idx_type m = 0, n = 0; + if (args(0).is_scalar_type () && args(1).is_scalar_type ()) + { + m = args(0).idx_type_value (); + n = args(1).idx_type_value (); + } + else + error ("sparse: dimensions M,N must be scalar"); + + if (! error_state) + { + if (m >= 0 && n >= 0) + retval = SparseMatrix (m, n); + else + error ("sparse: dimensions M,N must be positive or zero"); + } + } + else if (nargin >= 3) + { + bool summation = true; + if (nargin > 3 && args(nargin-1).is_string ()) + { + std::string opt = args(nargin-1).string_value (); + if (opt == "unique") + summation = false; + else if (opt == "sum" || opt == "summation") + summation = true; + else + error ("sparse: invalid option: %s", opt.c_str ()); + + nargin -= 1; + } + + if (! error_state) + { + octave_idx_type m = -1, n = -1, nzmax = -1; + if (nargin == 6) + { + nzmax = args(5).idx_type_value (); + nargin --; + } + + if (nargin == 5) + { + if (args(3).is_scalar_type () && args(4).is_scalar_type ()) + { + m = args(3).idx_type_value (); + n = args(4).idx_type_value (); + } + else + error ("sparse: expecting scalar dimensions"); + + + if (! error_state && (m < 0 || n < 0)) + error ("sparse: dimensions must be non-negative"); + } + else if (nargin != 3) + print_usage (); + + if (! error_state) + { + idx_vector i = args(0).index_vector (); + idx_vector j = args(1).index_vector (); + + if (args(2).is_bool_type ()) + retval = SparseBoolMatrix (args(2).bool_array_value (), i, j, + m, n, summation, nzmax); + else if (args(2).is_complex_type ()) + retval = SparseComplexMatrix (args(2).complex_array_value (), + i, j, m, n, summation, nzmax); + else if (args(2).is_numeric_type ()) + retval = SparseMatrix (args(2).array_value (), i, j, + m, n, summation, nzmax); + else + gripe_wrong_type_arg ("sparse", args(2)); + } + + } + } + + return retval; +} + +DEFUN (spalloc, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{s} =} spalloc (@var{m}, @var{n}, @var{nz})\n\ +Create an @var{m}-by-@var{n} sparse matrix with pre-allocated space for at\n\ +most @var{nz} nonzero elements. This is useful for building the matrix\n\ +incrementally by a sequence of indexed assignments. Subsequent indexed\n\ +assignments will reuse the pre-allocated memory, provided they are of one of\n\ +the simple forms\n\ +\n\ +@itemize\n\ +@item @code{@var{s}(I:J) = @var{x}}\n\ +\n\ +@item @code{@var{s}(:,I:J) = @var{x}}\n\ +\n\ +@item @code{@var{s}(K:L,I:J) = @var{x}}\n\ +@end itemize\n\ +\n\ +@b{and} that the following conditions are met:\n\ +\n\ +@itemize\n\ +@item the assignment does not decrease nnz (@var{S}).\n\ +\n\ +@item after the assignment, nnz (@var{S}) does not exceed @var{nz}.\n\ +\n\ +@item no index is out of bounds.\n\ +@end itemize\n\ +\n\ +Partial movement of data may still occur, but in general the assignment will\n\ +be more memory and time-efficient under these circumstances. In particular,\n\ +it is possible to efficiently build a pre-allocated sparse matrix from\n\ +contiguous block of columns.\n\ +\n\ +The amount of pre-allocated memory for a given matrix may be queried using\n\ +the function @code{nzmax}.\n\ +@seealso{nzmax, sparse}\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + + if (nargin == 2 || nargin == 3) + { + octave_idx_type m = args(0).idx_type_value (); + octave_idx_type n = args(1).idx_type_value (); + octave_idx_type nz = 0; + if (nargin == 3) + nz = args(2).idx_type_value (); + if (error_state) + ; + else if (m >= 0 && n >= 0 && nz >= 0) + retval = SparseMatrix (dim_vector (m, n), nz); + else + error ("spalloc: M,N,NZ must be non-negative"); + } + else + print_usage (); + + return retval; +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/corefcn/strfns.cc Tue Jul 31 20:46:47 2012 -0400 @@ -0,0 +1,973 @@ +/* + +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 +<http://www.gnu.org/licenses/>. + +*/ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <cctype> + +#include <queue> +#include <sstream> + +#include "dMatrix.h" + +#include "Cell.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "ov.h" +#include "oct-obj.h" +#include "unwind-prot.h" +#include "utils.h" + +DEFUN (char, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} char (@var{x})\n\ +@deftypefnx {Built-in Function} {} char (@var{x}, @dots{})\n\ +@deftypefnx {Built-in Function} {} char (@var{s1}, @var{s2}, @dots{})\n\ +@deftypefnx {Built-in Function} {} char (@var{cell_array})\n\ +Create a string array from one or more numeric matrices, character\n\ +matrices, or cell arrays. Arguments are concatenated vertically.\n\ +The returned values are padded with blanks as needed to make each row\n\ +of the string array have the same length. Empty input strings are\n\ +significant and will concatenated in the output.\n\ +\n\ +For numerical input, each element is converted\n\ +to the corresponding ASCII character. A range error results if an input\n\ +is outside the ASCII range (0-255).\n\ +\n\ +For cell arrays, each element is concatenated separately. Cell arrays\n\ +converted through\n\ +@code{char} can mostly be converted back with @code{cellstr}.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +char ([97, 98, 99], \"\", @{\"98\", \"99\", 100@}, \"str1\", [\"ha\", \"lf\"])\n\ + @result{} [\"abc \"\n\ + \" \"\n\ + \"98 \"\n\ + \"99 \"\n\ + \"d \"\n\ + \"str1 \"\n\ + \"half \"]\n\ +@end group\n\ +@end example\n\ +@seealso{strvcat, cellstr}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + retval = ""; + else if (nargin == 1) + retval = args(0).convert_to_str (true, true, + args(0).is_dq_string () ? '"' : '\''); + else + { + int n_elts = 0; + + int max_len = 0; + + std::queue<string_vector> args_as_strings; + + for (int i = 0; i < nargin; i++) + { + string_vector s = args(i).all_strings (); + + if (error_state) + { + error ("char: unable to convert some args to strings"); + return retval; + } + + if (s.length () > 0) + n_elts += s.length (); + else + n_elts += 1; + + int s_max_len = s.max_length (); + + if (s_max_len > max_len) + max_len = s_max_len; + + args_as_strings.push (s); + } + + string_vector result (n_elts); + + int k = 0; + + for (int i = 0; i < nargin; i++) + { + string_vector s = args_as_strings.front (); + args_as_strings.pop (); + + int n = s.length (); + + if (n > 0) + { + for (int j = 0; j < n; j++) + { + std::string t = s[j]; + int t_len = t.length (); + + if (max_len > t_len) + t += std::string (max_len - t_len, ' '); + + result[k++] = t; + } + } + else + result[k++] = std::string (max_len, ' '); + } + + retval = octave_value (result, '\''); + } + + return retval; +} + +/* +%!assert (char (), ''); +%!assert (char (100), "d"); +%!assert (char (100,100), ["d";"d"]) +%!assert (char ({100,100}), ["d";"d"]) +%!assert (char ([100,100]), ["dd"]) +%!assert (char ({100,{100}}), ["d";"d"]) +%!assert (char (100, [], 100), ["d";" ";"d"]) +%!assert (char ({100, [], 100}), ["d";" ";"d"]) +%!assert (char ({100,{100, {""}}}), ["d";"d";" "]) +%!assert (char (["a";"be"], {"c", 100}), ["a";"be";"c";"d"]) +%!assert (char ("a", "bb", "ccc"), ["a "; "bb "; "ccc"]) +%!assert (char ([65, 83, 67, 73, 73]), "ASCII") + +%!test +%! x = char ("foo", "bar", "foobar"); +%! assert (x(1,:), "foo "); +%! assert (x(2,:), "bar "); +%! assert (x(3,:), "foobar"); +*/ + +DEFUN (strvcat, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} strvcat (@var{x})\n\ +@deftypefnx {Built-in Function} {} strvcat (@var{x}, @dots{})\n\ +@deftypefnx {Built-in Function} {} strvcat (@var{s1}, @var{s2}, @dots{})\n\ +@deftypefnx {Built-in Function} {} strvcat (@var{cell_array})\n\ +Create a character array from one or more numeric matrices, character\n\ +matrices, or cell arrays. Arguments are concatenated vertically.\n\ +The returned values are padded with blanks as needed to make each row\n\ +of the string array have the same length. Unlike @code{char}, empty\n\ +strings are removed and will not appear in the output.\n\ +\n\ +For numerical input, each element is converted\n\ +to the corresponding ASCII character. A range error results if an input\n\ +is outside the ASCII range (0-255).\n\ +\n\ +For cell arrays, each element is concatenated separately. Cell arrays\n\ +converted through\n\ +@code{strvcat} can mostly be converted back with @code{cellstr}.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +strvcat ([97, 98, 99], \"\", @{\"98\", \"99\", 100@}, \"str1\", [\"ha\", \"lf\"])\n\ + @result{} [\"abc \"\n\ + \"98 \"\n\ + \"99 \"\n\ + \"d \"\n\ + \"str1 \"\n\ + \"half \"]\n\ +@end group\n\ +@end example\n\ +@seealso{char, strcat, cstrcat}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin > 0) + { + int n_elts = 0; + + size_t max_len = 0; + + std::queue<string_vector> args_as_strings; + + for (int i = 0; i < nargin; i++) + { + string_vector s = args(i).all_strings (); + + if (error_state) + { + error ("strvcat: unable to convert some args to strings"); + return retval; + } + + size_t n = s.length (); + + // do not count empty strings in calculation of number of elements + if (n > 0) + { + for (size_t j = 0; j < n; j++) + { + if (s[j].length () > 0) + n_elts++; + } + } + + size_t s_max_len = s.max_length (); + + if (s_max_len > max_len) + max_len = s_max_len; + + args_as_strings.push (s); + } + + string_vector result (n_elts); + + octave_idx_type k = 0; + + for (int i = 0; i < nargin; i++) + { + string_vector s = args_as_strings.front (); + args_as_strings.pop (); + + size_t n = s.length (); + + if (n > 0) + { + for (size_t j = 0; j < n; j++) + { + std::string t = s[j]; + if (t.length () > 0) + { + size_t t_len = t.length (); + + if (max_len > t_len) + t += std::string (max_len - t_len, ' '); + + result[k++] = t; + } + } + } + } + + retval = octave_value (result, '\''); + } + else + print_usage (); + + return retval; +} + +/* +%!assert (strvcat (""), ""); +%!assert (strvcat (100) == "d"); +%!assert (strvcat (100,100), ["d";"d"]) +%!assert (strvcat ({100,100}), ["d";"d"]) +%!assert (strvcat ([100,100]), ["dd"]) +%!assert (strvcat ({100,{100}}), ["d";"d"]) +%!assert (strvcat (100, [], 100), ["d";"d"]) +%!assert (strvcat ({100, [], 100}), ["d";"d"]) +%!assert (strvcat ({100,{100, {""}}}), ["d";"d"]) +%!assert (strvcat (["a";"be"], {"c", 100}), ["a";"be";"c";"d"]) +%!assert (strvcat ("a", "bb", "ccc"), ["a "; "bb "; "ccc"]) + +%!error strvcat () +*/ + + +DEFUN (ischar, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ischar (@var{x})\n\ +Return true if @var{x} is a character array.\n\ +@seealso{isfloat, isinteger, islogical, isnumeric, iscellstr, isa}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1 && args(0).is_defined ()) + retval = args(0).is_string (); + else + print_usage (); + + return retval; +} + +/* +%!assert (ischar ("a"), true) +%!assert (ischar (["ab";"cd"]), true) +%!assert (ischar ({"ab"}), false) +%!assert (ischar (1), false) +%!assert (ischar ([1, 2]), false) +%!assert (ischar ([]), false) +%!assert (ischar ([1, 2; 3, 4]), false) +%!assert (ischar (""), true) +%!assert (ischar ("test"), true) +%!assert (ischar (["test"; "ing"]), true) +%!assert (ischar (struct ("foo", "bar")), false) + +%!error ischar () +%!error ischar ("test", 1) +*/ + +static octave_value +do_strcmp_fun (const octave_value& arg0, const octave_value& arg1, + octave_idx_type n, const char *fcn_name, + bool (*array_op) (const charNDArray&, const charNDArray&, octave_idx_type), + bool (*str_op) (const std::string&, const std::string&, octave_idx_type)) + +{ + octave_value retval; + + bool s1_string = arg0.is_string (); + bool s1_cell = arg0.is_cell (); + bool s2_string = arg1.is_string (); + bool s2_cell = arg1.is_cell (); + + if (s1_string && s2_string) + retval = array_op (arg0.char_array_value (), arg1.char_array_value (), n); + else if ((s1_string && s2_cell) || (s1_cell && s2_string)) + { + octave_value str_val, cell_val; + + if (s1_string) + { + str_val = arg0; + cell_val = arg1; + } + else + { + str_val = arg1; + cell_val = arg0; + } + + const Cell cell = cell_val.cell_value (); + const string_vector str = str_val.all_strings (); + octave_idx_type r = str.length (); + + if (r == 0 || r == 1) + { + // Broadcast the string. + + boolNDArray output (cell_val.dims (), false); + + std::string s = r == 0 ? std::string () : str[0]; + + if (cell_val.is_cellstr ()) + { + const Array<std::string> cellstr = cell_val.cellstr_value (); + for (octave_idx_type i = 0; i < cellstr.length (); i++) + output(i) = str_op (cellstr(i), s, n); + } + else + { + // FIXME: should we warn here? + for (octave_idx_type i = 0; i < cell.length (); i++) + { + if (cell(i).is_string ()) + output(i) = str_op (cell(i).string_value (), s, n); + } + } + + retval = output; + } + else if (r > 1) + { + if (cell.length () == 1) + { + // Broadcast the cell. + + const dim_vector dv (r, 1); + boolNDArray output (dv, false); + + if (cell(0).is_string ()) + { + const std::string str2 = cell(0).string_value (); + + for (octave_idx_type i = 0; i < r; i++) + output(i) = str_op (str[i], str2, n); + } + + retval = output; + } + else + { + // Must match in all dimensions. + + boolNDArray output (cell.dims (), false); + + if (cell.length () == r) + { + if (cell_val.is_cellstr ()) + { + const Array<std::string> cellstr = cell_val.cellstr_value (); + for (octave_idx_type i = 0; i < cellstr.length (); i++) + output(i) = str_op (str[i], cellstr(i), n); + } + else + { + // FIXME: should we warn here? + for (octave_idx_type i = 0; i < r; i++) + { + if (cell(i).is_string ()) + output(i) = str_op (str[i], cell(i).string_value (), n); + } + } + + retval = output; + } + else + retval = false; + } + } + } + else if (s1_cell && s2_cell) + { + octave_value cell1_val, cell2_val; + octave_idx_type r1 = arg0.numel (), r2; + + if (r1 == 1) + { + // Make the singleton cell2. + + cell1_val = arg1; + cell2_val = arg0; + } + else + { + cell1_val = arg0; + cell2_val = arg1; + } + + const Cell cell1 = cell1_val.cell_value (); + const Cell cell2 = cell2_val.cell_value (); + r1 = cell1.numel (); + r2 = cell2.numel (); + + const dim_vector size1 = cell1.dims (); + const dim_vector size2 = cell2.dims (); + + boolNDArray output (size1, false); + + if (r2 == 1) + { + // Broadcast cell2. + + if (cell2(0).is_string ()) + { + const std::string str2 = cell2(0).string_value (); + + if (cell1_val.is_cellstr ()) + { + const Array<std::string> cellstr = cell1_val.cellstr_value (); + for (octave_idx_type i = 0; i < cellstr.length (); i++) + output(i) = str_op (cellstr(i), str2, n); + } + else + { + // FIXME: should we warn here? + for (octave_idx_type i = 0; i < r1; i++) + { + if (cell1(i).is_string ()) + { + const std::string str1 = cell1(i).string_value (); + output(i) = str_op (str1, str2, n); + } + } + } + } + } + else + { + if (size1 != size2) + { + error ("%s: nonconformant cell arrays", fcn_name); + return retval; + } + + if (cell1.is_cellstr () && cell2.is_cellstr ()) + { + const Array<std::string> cellstr1 = cell1_val.cellstr_value (); + const Array<std::string> cellstr2 = cell2_val.cellstr_value (); + for (octave_idx_type i = 0; i < r1; i++) + output (i) = str_op (cellstr1(i), cellstr2(i), n); + } + else + { + // FIXME: should we warn here? + for (octave_idx_type i = 0; i < r1; i++) + { + if (cell1(i).is_string () && cell2(i).is_string ()) + { + const std::string str1 = cell1(i).string_value (); + const std::string str2 = cell2(i).string_value (); + output(i) = str_op (str1, str2, n); + } + } + } + } + + retval = output; + } + else + retval = false; + + return retval; +} + +// If both args are arrays, dimensions may be significant. +static bool +strcmp_array_op (const charNDArray& s1, const charNDArray& s2, octave_idx_type) +{ + return (s1.dims () == s2.dims () + && std::equal (s1.data (), s1.data () + s1.numel (), s2.data ())); +} + +// Otherwise, just use strings. +static bool +strcmp_str_op (const std::string& s1, const std::string& s2, + octave_idx_type) +{ + return s1 == s2; +} + +DEFUN (strcmp, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} strcmp (@var{s1}, @var{s2})\n\ +Return 1 if the character strings @var{s1} and @var{s2} are the same,\n\ +and 0 otherwise.\n\ +\n\ +If either @var{s1} or @var{s2} is a cell array of strings, then an array\n\ +of the same size is returned, containing the values described above for\n\ +every member of the cell array. The other argument may also be a cell\n\ +array of strings (of the same size or with only one element), char matrix\n\ +or character string.\n\ +\n\ +@strong{Caution:} For compatibility with @sc{matlab}, Octave's strcmp\n\ +function returns 1 if the character strings are equal, and 0 otherwise.\n\ +This is just the opposite of the corresponding C library function.\n\ +@seealso{strcmpi, strncmp, strncmpi}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 2) + { + retval = do_strcmp_fun (args (0), args (1), 0, + "strcmp", strcmp_array_op, strcmp_str_op); + } + else + print_usage (); + + return retval; +} + +/* +%!shared x +%! x = char (zeros (0, 2)); +%!assert (strcmp ("", x), false) +%!assert (strcmp (x, ""), false) +%!assert (strcmp (x, x), true) +## %!assert (strcmp ({""}, x), true) +## %!assert (strcmp ({x}, ""), false) +## %!assert (strcmp ({x}, x), true) +## %!assert (strcmp ("", {x}), false) +## %!assert (strcmp (x, {""}), false) +## %!assert (strcmp (x, {x}), true) +## %!assert (strcmp ({x; x}, ""), [false; false]) +## %!assert (strcmp ({x; x}, {""}), [false; false]) +## %!assert (strcmp ("", {x; x}), [false; false]) +## %!assert (strcmp ({""}, {x; x}), [false; false]) +%!assert (strcmp ({"foo"}, x), false) +%!assert (strcmp ({"foo"}, "foo"), true) +%!assert (strcmp ({"foo"}, x), false) +%!assert (strcmp (x, {"foo"}), false) +%!assert (strcmp ("foo", {"foo"}), true) +%!assert (strcmp (x, {"foo"}), false) +%!shared y +%! y = char (zeros (2, 0)); +%!assert (strcmp ("", y), false) +%!assert (strcmp (y, ""), false) +%!assert (strcmp (y, y), true) +%!assert (strcmp ({""}, y), [true; true]) +%!assert (strcmp ({y}, ""), true) +%!assert (strcmp ({y}, y), [true; true]) +%!assert (strcmp ("", {y}), true) +%!assert (strcmp (y, {""}), [true; true]) +%!assert (strcmp (y, {y}), [true; true]) +%!assert (strcmp ({y; y}, ""), [true; true]) +%!assert (strcmp ({y; y}, {""}), [true; true]) +%!assert (strcmp ("", {y; y}), [true; true]) +%!assert (strcmp ({""}, {y; y}), [true; true]) +%!assert (strcmp ({"foo"}, y), [false; false]) +%!assert (strcmp ({"foo"}, y), [false; false]) +%!assert (strcmp (y, {"foo"}), [false; false]) +%!assert (strcmp (y, {"foo"}), [false; false]) +%!assert (strcmp ("foobar", "foobar"), true) +%!assert (strcmp ("fooba", "foobar"), false) + +%!error strcmp () +%!error strcmp ("foo", "bar", 3) +*/ + +// Apparently, Matlab ignores the dims with strncmp. It also +static bool +strncmp_array_op (const charNDArray& s1, const charNDArray& s2, octave_idx_type n) +{ + octave_idx_type l1 = s1.numel (), l2 = s2.numel (); + return (n > 0 && n <= l1 && n <= l2 + && std::equal (s1.data (), s1.data () + n, s2.data ())); +} + +// Otherwise, just use strings. Note that we neither extract substrings (which +// would mean a copy, at least in GCC), nor use string::compare (which is a +// 3-way compare). +static bool +strncmp_str_op (const std::string& s1, const std::string& s2, octave_idx_type n) +{ + octave_idx_type l1 = s1.length (), l2 = s2.length (); + return (n > 0 && n <= l1 && n <= l2 + && std::equal (s1.data (), s1.data () + n, s2.data ())); +} + +DEFUN (strncmp, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} strncmp (@var{s1}, @var{s2}, @var{n})\n\ +Return 1 if the first @var{n} characters of strings @var{s1} and @var{s2} are\n\ +the same, and 0 otherwise.\n\ +\n\ +@example\n\ +@group\n\ +strncmp (\"abce\", \"abcd\", 3)\n\ + @result{} 1\n\ +@end group\n\ +@end example\n\ +\n\ +If either @var{s1} or @var{s2} is a cell array of strings, then an array\n\ +of the same size is returned, containing the values described above for\n\ +every member of the cell array. The other argument may also be a cell\n\ +array of strings (of the same size or with only one element), char matrix\n\ +or character string.\n\ +\n\ +@example\n\ +@group\n\ +strncmp (\"abce\", @{\"abcd\", \"bca\", \"abc\"@}, 3)\n\ + @result{} [1, 0, 1]\n\ +@end group\n\ +@end example\n\ +\n\ +@strong{Caution:} For compatibility with @sc{matlab}, Octave's strncmp\n\ +function returns 1 if the character strings are equal, and 0 otherwise.\n\ +This is just the opposite of the corresponding C library function.\n\ +@seealso{strncmpi, strcmp, strcmpi}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 3) + { + octave_idx_type n = args(2).idx_type_value (); + + if (! error_state) + { + if (n > 0) + { + retval = do_strcmp_fun (args(0), args(1), n, "strncmp", + strncmp_array_op, strncmp_str_op); + } + else + error ("strncmp: N must be greater than 0"); + } + } + else + print_usage (); + + return retval; +} + +/* +%!assert (strncmp ("abce", "abc", 3), true) +%!assert (strncmp (100, 100, 1), false) +%!assert (strncmp ("abce", {"abcd", "bca", "abc"}, 3), logical ([1, 0, 1])) +%!assert (strncmp ("abc", {"abcd", "bca", "abc"}, 4), logical ([0, 0, 0])) +%!assert (strncmp ({"abcd", "bca", "abc"},"abce", 3), logical ([1, 0, 1])) +%!assert (strncmp ({"abcd", "bca", "abc"},{"abcd", "bca", "abe"}, 3), logical ([1, 1, 0])) +%!assert (strncmp ("abc", {"abcd", 10}, 2), logical ([1, 0])) + +%!error strncmp () +%!error strncmp ("abc", "def") +*/ + +// case-insensitive character equality functor +struct icmp_char_eq : public std::binary_function<char, char, bool> +{ + bool operator () (char x, char y) const + { return std::toupper (x) == std::toupper (y); } +}; + +// strcmpi is equivalent to strcmp in that it checks all dims. +static bool +strcmpi_array_op (const charNDArray& s1, const charNDArray& s2, octave_idx_type) +{ + return (s1.dims () == s2.dims () + && std::equal (s1.data (), s1.data () + s1.numel (), s2.data (), + icmp_char_eq ())); +} + +// Ditto for string. +static bool +strcmpi_str_op (const std::string& s1, const std::string& s2, + octave_idx_type) +{ + return (s1.size () == s2.size () + && std::equal (s1.data (), s1.data () + s1.size (), s2.data (), + icmp_char_eq ())); +} + +DEFUNX ("strcmpi", Fstrcmpi, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} strcmpi (@var{s1}, @var{s2})\n\ +Return 1 if the character strings @var{s1} and @var{s2} are the same,\n\ +disregarding case of alphabetic characters, and 0 otherwise.\n\ +\n\ +If either @var{s1} or @var{s2} is a cell array of strings, then an array\n\ +of the same size is returned, containing the values described above for\n\ +every member of the cell array. The other argument may also be a cell\n\ +array of strings (of the same size or with only one element), char matrix\n\ +or character string.\n\ +\n\ +@strong{Caution:} For compatibility with @sc{matlab}, Octave's strcmp\n\ +function returns 1 if the character strings are equal, and 0 otherwise.\n\ +This is just the opposite of the corresponding C library function.\n\ +\n\ +@strong{Caution:} National alphabets are not supported.\n\ +@seealso{strcmp, strncmp, strncmpi}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 2) + { + retval = do_strcmp_fun (args (0), args (1), 0, + "strcmpi", strcmpi_array_op, strcmpi_str_op); + } + else + print_usage (); + + return retval; +} + +/* +%!assert (strcmpi ("abc123", "ABC123"), true) +*/ + +// Like strncmp. +static bool +strncmpi_array_op (const charNDArray& s1, const charNDArray& s2, octave_idx_type n) +{ + octave_idx_type l1 = s1.numel (), l2 = s2.numel (); + return (n > 0 && n <= l1 && n <= l2 + && std::equal (s1.data (), s1.data () + n, s2.data (), + icmp_char_eq ())); +} + +// Ditto. +static bool +strncmpi_str_op (const std::string& s1, const std::string& s2, octave_idx_type n) +{ + octave_idx_type l1 = s1.length (), l2 = s2.length (); + return (n > 0 && n <= l1 && n <= l2 + && std::equal (s1.data (), s1.data () + n, s2.data (), + icmp_char_eq ())); +} + +DEFUNX ("strncmpi", Fstrncmpi, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} strncmpi (@var{s1}, @var{s2}, @var{n})\n\ +Return 1 if the first @var{n} character of @var{s1} and @var{s2} are the\n\ +same, disregarding case of alphabetic characters, and 0 otherwise.\n\ +\n\ +If either @var{s1} or @var{s2} is a cell array of strings, then an array\n\ +of the same size is returned, containing the values described above for\n\ +every member of the cell array. The other argument may also be a cell\n\ +array of strings (of the same size or with only one element), char matrix\n\ +or character string.\n\ +\n\ +@strong{Caution:} For compatibility with @sc{matlab}, Octave's strncmpi\n\ +function returns 1 if the character strings are equal, and 0 otherwise.\n\ +This is just the opposite of the corresponding C library function.\n\ +\n\ +@strong{Caution:} National alphabets are not supported.\n\ +@seealso{strncmp, strcmp, strcmpi}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 3) + { + octave_idx_type n = args(2).idx_type_value (); + + if (! error_state) + { + if (n > 0) + { + retval = do_strcmp_fun (args(0), args(1), n, "strncmpi", + strncmpi_array_op, strncmpi_str_op); + } + else + error ("strncmpi: N must be greater than 0"); + } + } + else + print_usage (); + + return retval; +} + +/* +%!assert (strncmpi ("abc123", "ABC456", 3), true) +*/ + +DEFUN (list_in_columns, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} list_in_columns (@var{arg}, @var{width}, @var{prefix})\n\ +Return a string containing the elements of @var{arg} listed in\n\ +columns with an overall maximum width of @var{width} and optional\n\ +prefix @var{prefix}. The argument @var{arg} must be a cell array\n\ +of character strings or a character array. If @var{width} is not\n\ +specified or is an empty matrix, or less than or equal to zero,\n\ +the width of the terminal screen is used.\n\ +Newline characters are used to break the lines in the output string.\n\ +For example:\n\ +@c Set example in small font to prevent overfull line\n\ +\n\ +@smallexample\n\ +@group\n\ +list_in_columns (@{\"abc\", \"def\", \"ghijkl\", \"mnop\", \"qrs\", \"tuv\"@}, 20)\n\ + @result{} abc mnop\n\ + def qrs\n\ + ghijkl tuv\n\ +\n\ +whos ans\n\ + @result{}\n\ + Variables in the current scope:\n\ +\n\ + Attr Name Size Bytes Class\n\ + ==== ==== ==== ===== =====\n\ + ans 1x37 37 char\n\ +\n\ + Total is 37 elements using 37 bytes\n\ +@end group\n\ +@end smallexample\n\ +\n\ +@seealso{terminal_size}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin < 1 || nargin > 3) + { + print_usage (); + return retval; + } + + string_vector s = args(0).all_strings (); + + if (error_state) + { + error ("list_in_columns: expecting cellstr or char array"); + return retval; + } + + int width = -1; + + if (nargin > 1 && ! args(1).is_empty ()) + { + width = args(1).int_value (); + + if (error_state) + { + error ("list_in_columns: WIDTH must be an integer"); + return retval; + } + } + + std::string prefix; + + if (nargin > 2) + { + if (args(2).is_string ()) + { + prefix = args(2).string_value (); + + if (error_state) + { + error ("list_in_columns: PREFIX must be a character string"); + return retval; + } + } + else + { + error ("list_in_columns: PREFIX must be a character string"); + return retval; + } + } + + std::ostringstream buf; + + s.list_in_columns (buf, width, prefix); + + retval = buf.str (); + + return retval; +} + +/* +%!test +%! input = {"abc", "def", "ghijkl", "mnop", "qrs", "tuv"}; +%! result = "abc mnop\ndef qrs\nghijkl tuv\n"; +%! assert (list_in_columns (input, 20), result); +%!test +%! input = ["abc"; "def"; "ghijkl"; "mnop"; "qrs"; "tuv"]; +%! result = "abc mnop \ndef qrs \nghijkl tuv \n"; +%! assert (list_in_columns (input, 20), result); +%!test +%! input = ["abc"; "def"; "ghijkl"; "mnop"; "qrs"; "tuv"]; +%! result = " abc mnop \n def qrs \n ghijkl tuv \n"; +%! assert (list_in_columns (input, 20, " "), result); + +%!error list_in_columns () +%!error list_in_columns (["abc", "def"], 20, 2) +%!error list_in_columns (["abc", "def"], 20, " ", 3) +%!error <invalid conversion from string to real scalar> list_in_columns (["abc", "def"], "a") +*/
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/corefcn/syscalls.cc Tue Jul 31 20:46:47 2012 -0400 @@ -0,0 +1,1943 @@ +/* + +Copyright (C) 1996-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 +<http://www.gnu.org/licenses/>. + +*/ + +// Thomas Baier <baier@ci.tuwien.ac.at> added the original versions of +// the following functions: +// +// mkfifo unlink waitpid + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <cstdio> +#include <cstring> + +#include <sys/types.h> +#include <unistd.h> + +#include <fcntl.h> + +#include "file-ops.h" +#include "file-stat.h" +#include "oct-env.h" +#include "oct-syscalls.h" +#include "oct-uname.h" + +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "lo-utils.h" +#include "oct-map.h" +#include "oct-obj.h" +#include "oct-stdstrm.h" +#include "oct-stream.h" +#include "sysdep.h" +#include "utils.h" +#include "variables.h" +#include "input.h" + +static octave_scalar_map +mk_stat_map (const base_file_stat& fs) +{ + octave_scalar_map m; + + m.assign ("dev", static_cast<double> (fs.dev ())); + m.assign ("ino", fs.ino ()); + m.assign ("mode", fs.mode ()); + m.assign ("modestr", fs.mode_as_string ()); + m.assign ("nlink", fs.nlink ()); + m.assign ("uid", fs.uid ()); + m.assign ("gid", fs.gid ()); +#if defined (HAVE_STRUCT_STAT_ST_RDEV) + m.assign ("rdev", static_cast<double> (fs.rdev ())); +#endif + m.assign ("size", fs.size ()); + m.assign ("atime", fs.atime ()); + m.assign ("mtime", fs.mtime ()); + m.assign ("ctime", fs.ctime ()); +#if defined (HAVE_STRUCT_STAT_ST_BLKSIZE) + m.assign ("blksize", fs.blksize ()); +#endif +#if defined (HAVE_STRUCT_STAT_ST_BLOCKS) + m.assign ("blocks", fs.blocks ()); +#endif + + return m; +} + +static octave_value_list +mk_stat_result (const base_file_stat& fs) +{ + octave_value_list retval; + + if (fs) + { + retval(2) = std::string (); + retval(1) = 0; + retval(0) = octave_value (mk_stat_map (fs)); + } + else + { + retval(2) = fs.error (); + retval(1) = -1; + retval(0) = Matrix (); + } + + return retval; +} + +DEFUNX ("dup2", Fdup2, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{fid}, @var{msg}] =} dup2 (@var{old}, @var{new})\n\ +Duplicate a file descriptor.\n\ +\n\ +If successful, @var{fid} is greater than zero and contains the new file\n\ +ID@. Otherwise, @var{fid} is negative and @var{msg} contains a\n\ +system-dependent error message.\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 2) + { + octave_stream old_stream + = octave_stream_list::lookup (args(0), "dup2"); + + if (! error_state) + { + octave_stream new_stream + = octave_stream_list::lookup (args(1), "dup2"); + + if (! error_state) + { + int i_old = old_stream.file_number (); + int i_new = new_stream.file_number (); + + if (i_old >= 0 && i_new >= 0) + { + std::string msg; + + int status = octave_syscalls::dup2 (i_old, i_new, msg); + + retval(1) = msg; + retval(0) = status; + } + } + } + else + error ("dup2: invalid stream"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("exec", Fexec, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} exec (@var{file}, @var{args})\n\ +Replace current process with a new process. Calling @code{exec} without\n\ +first calling @code{fork} will terminate your current Octave process and\n\ +replace it with the program named by @var{file}. For example,\n\ +\n\ +@example\n\ +exec (\"ls\" \"-l\")\n\ +@end example\n\ +\n\ +@noindent\n\ +will run @code{ls} and return you to your shell prompt.\n\ +\n\ +If successful, @code{exec} does not return. If @code{exec} does return,\n\ +@var{err} will be nonzero, and @var{msg} will contain a system-dependent\n\ +error message.\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + std::string exec_file = args(0).string_value (); + + if (! error_state) + { + string_vector exec_args; + + if (nargin == 2) + { + string_vector tmp = args(1).all_strings (); + + if (! error_state) + { + int len = tmp.length (); + + exec_args.resize (len + 1); + + exec_args[0] = exec_file; + + for (int i = 0; i < len; i++) + exec_args[i+1] = tmp[i]; + } + else + error ("exec: arguments must be character strings"); + } + else + { + exec_args.resize (1); + + exec_args[0] = exec_file; + } + + if (! error_state) + { + std::string msg; + + int status = octave_syscalls::execvp (exec_file, exec_args, msg); + + retval(1) = msg; + retval(0) = status; + } + } + else + error ("exec: FILE must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("popen2", Fpopen2, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{in}, @var{out}, @var{pid}] =} popen2 (@var{command}, @var{args})\n\ +Start a subprocess with two-way communication. The name of the process\n\ +is given by @var{command}, and @var{args} is an array of strings\n\ +containing options for the command. The file identifiers for the input\n\ +and output streams of the subprocess are returned in @var{in} and\n\ +@var{out}. If execution of the command is successful, @var{pid}\n\ +contains the process ID of the subprocess. Otherwise, @var{pid} is\n\ +@minus{}1.\n\ +\n\ +For example:\n\ +\n\ +@example\n\ +[in, out, pid] = popen2 (\"sort\", \"-r\");\n\ +fputs (in, \"these\\nare\\nsome\\nstrings\\n\");\n\ +fclose (in);\n\ +EAGAIN = errno (\"EAGAIN\");\n\ +done = false;\n\ +do\n\ + s = fgets (out);\n\ + if (ischar (s))\n\ + fputs (stdout, s);\n\ + elseif (errno () == EAGAIN)\n\ + sleep (0.1);\n\ + fclear (out);\n\ + else\n\ + done = true;\n\ + endif\n\ +until (done)\n\ +fclose (out);\n\ +waitpid (pid);\n\ +\n\ + @print{} these\n\ + @print{} strings\n\ + @print{} some\n\ + @print{} are\n\ +@end example\n\ +\n\ +Note that @code{popen2}, unlike @code{popen}, will not \"reap\" the\n\ +child process. If you don't use @code{waitpid} to check the child's\n\ +exit status, it will linger until Octave exits.\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(2) = -1; + retval(1) = Matrix (); + retval(0) = Matrix (); + + int nargin = args.length (); + + if (nargin >= 1 && nargin <= 3) + { + std::string exec_file = args(0).string_value (); + + if (! error_state) + { + string_vector arg_list; + + if (nargin >= 2) + { + string_vector tmp = args(1).all_strings (); + + if (! error_state) + { + int len = tmp.length (); + + arg_list.resize (len + 1); + + arg_list[0] = exec_file; + + for (int i = 0; i < len; i++) + arg_list[i+1] = tmp[i]; + } + else + error ("popen2: arguments must be character strings"); + } + else + { + arg_list.resize (1); + + arg_list[0] = exec_file; + } + + if (! error_state) + { + bool sync_mode = (nargin == 3 ? args(2).bool_value () : false); + + if (! error_state) + { + int fildes[2]; + std::string msg; + pid_t pid; + + pid = octave_syscalls::popen2 (exec_file, arg_list, sync_mode, fildes, msg, interactive); + if (pid >= 0) + { + FILE *ifile = fdopen (fildes[1], "r"); + FILE *ofile = fdopen (fildes[0], "w"); + + std::string nm; + + octave_stream is = octave_stdiostream::create (nm, ifile, + std::ios::in); + + octave_stream os = octave_stdiostream::create (nm, ofile, + std::ios::out); + + Cell file_ids (1, 2); + + retval(2) = pid; + retval(1) = octave_stream_list::insert (is); + retval(0) = octave_stream_list::insert (os); + } + else + error (msg.c_str ()); + } + } + else + error ("popen2: arguments must be character strings"); + } + else + error ("popen2: COMMAND argument must be a string"); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! if (isunix ()) +%! [in, out, pid] = popen2 ("sort", "-r"); +%! EAGAIN = errno ("EAGAIN"); +%! else +%! [in, out, pid] = popen2 ("sort", "/R"); +%! EAGAIN = errno ("EINVAL"); +%! endif +%! fputs (in, "these\nare\nsome\nstrings\n"); +%! fclose (in); +%! done = false; +%! str = {}; +%! idx = 0; +%! errs = 0; +%! do +%! if (!isunix ()) +%! errno (0); +%! endif +%! s = fgets (out); +%! if (ischar (s)) +%! idx++; +%! str{idx} = s; +%! elseif (errno () == EAGAIN) +%! fclear (out); +%! sleep (0.1); +%! if (++errs == 100) +%! done = true; +%! endif +%! else +%! done = true; +%! endif +%! until (done) +%! fclose (out); +%! if (isunix ()) +%! assert (str, {"these\n","strings\n","some\n","are\n"}); +%! else +%! assert (str, {"these\r\n","strings\r\n","some\r\n","are\r\n"}); +%! endif +*/ + +DEFUNX ("fcntl", Ffcntl, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} fcntl (@var{fid}, @var{request}, @var{arg})\n\ +Change the properties of the open file @var{fid}. The following values\n\ +may be passed as @var{request}:\n\ +\n\ +@vtable @code\n\ +@item F_DUPFD\n\ +Return a duplicate file descriptor.\n\ +\n\ +@item F_GETFD\n\ +Return the file descriptor flags for @var{fid}.\n\ +\n\ +@item F_SETFD\n\ +Set the file descriptor flags for @var{fid}.\n\ +\n\ +@item F_GETFL\n\ +Return the file status flags for @var{fid}. The following codes may be\n\ +returned (some of the flags may be undefined on some systems).\n\ +\n\ +@vtable @code\n\ +@item O_RDONLY\n\ +Open for reading only.\n\ +\n\ +@item O_WRONLY\n\ +Open for writing only.\n\ +\n\ +@item O_RDWR\n\ +Open for reading and writing.\n\ +\n\ +@item O_APPEND\n\ +Append on each write.\n\ +\n\ +@item O_CREAT\n\ +Create the file if it does not exist.\n\ +\n\ +@item O_NONBLOCK\n\ +Non-blocking mode.\n\ +\n\ +@item O_SYNC\n\ +Wait for writes to complete.\n\ +\n\ +@item O_ASYNC\n\ +Asynchronous I/O.\n\ +@end vtable\n\ +\n\ +@item F_SETFL\n\ +Set the file status flags for @var{fid} to the value specified by\n\ +@var{arg}. The only flags that can be changed are @w{@code{O_APPEND}} and\n\ +@w{@code{O_NONBLOCK}}.\n\ +@end vtable\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\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 3) + { + octave_stream strm = octave_stream_list::lookup (args (0), "fcntl"); + + if (! error_state) + { + int fid = strm.file_number (); + + int req = args(1).int_value (true); + int arg = args(2).int_value (true); + + if (! error_state) + { + // FIXME -- Need better checking here? + if (fid < 0) + error ("fcntl: invalid file id"); + else + { + std::string msg; + + int status = octave_fcntl (fid, req, arg, msg); + + retval(1) = msg; + retval(0) = status; + } + } + } + else + error ("fcntl: FID, REQUEST, and ARG must be integers"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("fork", Ffork, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{pid}, @var{msg}] =} fork ()\n\ +Create a copy of the current process.\n\ +\n\ +Fork can return one of the following values:\n\ +\n\ +@table @asis\n\ +@item > 0\n\ +You are in the parent process. The value returned from @code{fork} is\n\ +the process id of the child process. You should probably arrange to\n\ +wait for any child processes to exit.\n\ +\n\ +@item 0\n\ +You are in the child process. You can call @code{exec} to start another\n\ +process. If that fails, you should probably call @code{exit}.\n\ +\n\ +@item < 0\n\ +The call to @code{fork} failed for some reason. You must take evasive\n\ +action. A system dependent error message will be waiting in @var{msg}.\n\ +@end table\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 0) + { + std::string msg; + + pid_t pid = octave_syscalls::fork (msg); + + retval(1) = msg; + retval(0) = pid; + } + else + print_usage (); + + return retval; +} + +DEFUNX ("getpgrp", Fgetpgrp, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {pgid =} getpgrp ()\n\ +Return the process group id of the current process.\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 0) + { + std::string msg; + + retval(1) = msg; + retval(0) = octave_syscalls::getpgrp (msg); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("getpid", Fgetpid, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {pid =} getpid ()\n\ +Return the process id of the current process.\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 0) + retval = octave_syscalls::getpid (); + else + print_usage (); + + return retval; +} + +DEFUNX ("getppid", Fgetppid, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {pid =} getppid ()\n\ +Return the process id of the parent process.\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 0) + retval = octave_syscalls::getppid (); + else + print_usage (); + + return retval; +} + +DEFUNX ("getegid", Fgetegid, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {egid =} getegid ()\n\ +Return the effective group id of the current process.\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 0) + retval = octave_syscalls::getegid (); + else + print_usage (); + + return retval; +} + +DEFUNX ("getgid", Fgetgid, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {gid =} getgid ()\n\ +Return the real group id of the current process.\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 0) + retval = octave_syscalls::getgid (); + else + print_usage (); + + return retval; +} + +DEFUNX ("geteuid", Fgeteuid, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {euid =} geteuid ()\n\ +Return the effective user id of the current process.\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 0) + retval = octave_syscalls::geteuid (); + else + print_usage (); + + return retval; +} + +DEFUNX ("getuid", Fgetuid, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {uid =} getuid ()\n\ +Return the real user id of the current process.\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 0) + retval = octave_syscalls::getuid (); + else + print_usage (); + + return retval; +} + +DEFUNX ("kill", Fkill, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} kill (@var{pid}, @var{sig})\n\ +Send signal @var{sig} to process @var{pid}.\n\ +\n\ +If @var{pid} is positive, then signal @var{sig} is sent to @var{pid}.\n\ +\n\ +If @var{pid} is 0, then signal @var{sig} is sent to every process\n\ +in the process group of the current process.\n\ +\n\ +If @var{pid} is -1, then signal @var{sig} is sent to every process\n\ +except process 1.\n\ +\n\ +If @var{pid} is less than -1, then signal @var{sig} is sent to every\n\ +process in the process group @var{-pid}.\n\ +\n\ +If @var{sig} is 0, then no signal is sent, but error checking is still\n\ +performed.\n\ +\n\ +Return 0 if successful, otherwise return -1.\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + if (args.length () == 2) + { + pid_t pid = args(0).int_value (true); + + if (! error_state) + { + int sig = args(1).int_value (true); + + if (! error_state) + { + std::string msg; + + int status = octave_syscalls::kill (pid, sig, msg); + + retval(1) = msg; + retval(0) = status; + } + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("lstat", Flstat, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} lstat (@var{symlink})\n\ +Return a structure @var{info} containing information about the symbolic link\n\ +@var{symlink}. The function outputs are described in the documentation for\n\ +@code{stat}.\n\ +@seealso{stat}\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + std::string fname = args(0).string_value (); + + if (! error_state) + { + file_stat fs (fname, false); + + retval = mk_stat_result (fs); + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("mkfifo", Fmkfifo, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} mkfifo (@var{name}, @var{mode})\n\ +Create a @var{fifo} special file named @var{name} with file mode @var{mode}\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\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 2) + { + if (args(0).is_string ()) + { + std::string name = args(0).string_value (); + + if (args(1).is_scalar_type ()) + { + long mode = args(1).long_value (); + + if (! error_state) + { + std::string msg; + + int status = octave_mkfifo (name, mode, msg); + + retval(0) = status; + + if (status < 0) + retval(1) = msg; + } + else + error ("mkfifo: invalid MODE"); + } + else + error ("mkfifo: MODE must be an integer"); + } + else + error ("mkfifo: FILE must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("pipe", Fpipe, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{read_fd}, @var{write_fd}, @var{err}, @var{msg}] =} pipe ()\n\ +Create a pipe and return the reading and writing ends of the pipe\n\ +into @var{read_fd} and @var{write_fd} respectively.\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\ +@end deftypefn") +{ + octave_value_list retval; + + retval(3) = std::string (); + retval(2) = -1; + retval(1) = -1; + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 0) + { + int fid[2]; + + std::string msg; + + int status = octave_syscalls::pipe (fid, msg); + + if (status < 0) + retval(3) = msg; + else + { + FILE *ifile = fdopen (fid[0], "r"); + FILE *ofile = fdopen (fid[1], "w"); + + std::string nm; + + octave_stream is = octave_stdiostream::create (nm, ifile, + std::ios::in); + + octave_stream os = octave_stdiostream::create (nm, ofile, + std::ios::out); + + retval(2) = status; + retval(1) = octave_stream_list::insert (os); + retval(0) = octave_stream_list::insert (is); + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("stat", Fstat, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} stat (@var{file})\n\ +@deftypefnx {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} stat (@var{fid})\n\ +@deftypefnx {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} lstat (@var{file})\n\ +@deftypefnx {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} lstat (@var{fid})\n\ +Return a structure @var{info} containing the following information about\n\ +@var{file} or file identifier @var{fid}.\n\ +\n\ +@table @code\n\ +@item dev\n\ +ID of device containing a directory entry for this file.\n\ +\n\ +@item ino\n\ +File number of the file.\n\ +\n\ +@item mode\n\ +File mode, as an integer. Use the functions @w{@code{S_ISREG}},\n\ +@w{@code{S_ISDIR}}, @w{@code{S_ISCHR}}, @w{@code{S_ISBLK}}, @w{@code{S_ISFIFO}},\n\ +@w{@code{S_ISLNK}}, or @w{@code{S_ISSOCK}} to extract information from this\n\ +value.\n\ +\n\ +@item modestr\n\ +File mode, as a string of ten letters or dashes as would be returned by\n\ +@kbd{ls -l}.\n\ +\n\ +@item nlink\n\ +Number of links.\n\ +\n\ +@item uid\n\ +User ID of file's owner.\n\ +\n\ +@item gid\n\ +Group ID of file's group.\n\ +\n\ +@item rdev\n\ +ID of device for block or character special files.\n\ +\n\ +@item size\n\ +Size in bytes.\n\ +\n\ +@item atime\n\ +Time of last access in the same form as time values returned from\n\ +@code{time}. @xref{Timing Utilities}.\n\ +\n\ +@item mtime\n\ +Time of last modification in the same form as time values returned from\n\ +@code{time}. @xref{Timing Utilities}.\n\ +\n\ +@item ctime\n\ +Time of last file status change in the same form as time values\n\ +returned from @code{time}. @xref{Timing Utilities}.\n\ +\n\ +@item blksize\n\ +Size of blocks in the file.\n\ +\n\ +@item blocks\n\ +Number of blocks allocated for file.\n\ +@end table\n\ +\n\ +If the call is successful @var{err} is 0 and @var{msg} is an empty\n\ +string. If the file does not exist, or some other error occurs, @var{info}\n\ +is an empty matrix, @var{err} is @minus{}1, and @var{msg} contains the\n\ +corresponding system error message.\n\ +\n\ +If @var{file} is a symbolic link, @code{stat} will return information\n\ +about the actual file that is referenced by the link. Use @code{lstat}\n\ +if you want information about the symbolic link itself.\n\ +\n\ +For example:\n\ +\n\ +@example\n\ +[info, err, msg] = stat (\"/vmlinuz\")\n\ + @result{} info =\n\ + @{\n\ + atime = 855399756\n\ + rdev = 0\n\ + ctime = 847219094\n\ + uid = 0\n\ + size = 389218\n\ + blksize = 4096\n\ + mtime = 847219094\n\ + gid = 6\n\ + nlink = 1\n\ + blocks = 768\n\ + mode = -rw-r--r--\n\ + modestr = -rw-r--r--\n\ + ino = 9316\n\ + dev = 2049\n\ + @}\n\ + @result{} err = 0\n\ + @result{} msg =\n\ +@end example\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + if (args(0).is_scalar_type ()) + { + int fid = octave_stream_list::get_file_number (args(0)); + + if (! error_state) + { + file_fstat fs (fid); + + retval = mk_stat_result (fs); + } + } + else + { + std::string fname = args(0).string_value (); + + if (! error_state) + { + file_stat fs (fname); + + retval = mk_stat_result (fs); + } + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("S_ISREG", FS_ISREG, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} S_ISREG (@var{mode})\n\ +Return true if @var{mode} corresponds to a regular file. The value\n\ +of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ +@seealso{stat, lstat}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + { + double mode = args(0).double_value (); + + if (! error_state) + retval = file_stat::is_reg (static_cast<mode_t> (mode)); + else + error ("S_ISREG: invalid MODE value"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("S_ISDIR", FS_ISDIR, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} S_ISDIR (@var{mode})\n\ +Return true if @var{mode} corresponds to a directory. The value\n\ +of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ +@seealso{stat, lstat}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + { + double mode = args(0).double_value (); + + if (! error_state) + retval = file_stat::is_dir (static_cast<mode_t> (mode)); + else + error ("S_ISDIR: invalid MODE value"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("S_ISCHR", FS_ISCHR, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} S_ISCHR (@var{mode})\n\ +Return true if @var{mode} corresponds to a character device. The value\n\ +of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ +@seealso{stat, lstat}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + { + double mode = args(0).double_value (); + + if (! error_state) + retval = file_stat::is_chr (static_cast<mode_t> (mode)); + else + error ("S_ISCHR: invalid MODE value"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("S_ISBLK", FS_ISBLK, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} S_ISBLK (@var{mode})\n\ +Return true if @var{mode} corresponds to a block device. The value\n\ +of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ +@seealso{stat, lstat}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + { + double mode = args(0).double_value (); + + if (! error_state) + retval = file_stat::is_blk (static_cast<mode_t> (mode)); + else + error ("S_ISBLK: invalid MODE value"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("S_ISFIFO", FS_ISFIFO, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} S_ISFIFO (@var{mode})\n\ +Return true if @var{mode} corresponds to a fifo. The value\n\ +of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ +@seealso{stat, lstat}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + { + double mode = args(0).double_value (); + + if (! error_state) + retval = file_stat::is_fifo (static_cast<mode_t> (mode)); + else + error ("S_ISFIFO: invalid MODE value"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("S_ISLNK", FS_ISLNK, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} S_ISLNK (@var{mode})\n\ +Return true if @var{mode} corresponds to a symbolic link. The value\n\ +of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ +@seealso{stat, lstat}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + { + double mode = args(0).double_value (); + + if (! error_state) + retval = file_stat::is_lnk (static_cast<mode_t> (mode)); + else + error ("S_ISLNK: invalid MODE value"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("S_ISSOCK", FS_ISSOCK, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} S_ISSOCK (@var{mode})\n\ +Return true if @var{mode} corresponds to a socket. The value\n\ +of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ +@seealso{stat, lstat}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + { + double mode = args(0).double_value (); + + if (! error_state) + retval = file_stat::is_sock (static_cast<mode_t> (mode)); + else + error ("S_ISSOCK: invalid MODE value"); + } + else + print_usage (); + + return retval; +} + +DEFUN (gethostname, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} gethostname ()\n\ +Return the hostname of the system where Octave is running.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 0) + retval = octave_env::get_host_name (); + else + print_usage (); + + return retval; +} + +DEFUN (uname, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{uts}, @var{err}, @var{msg}] =} uname ()\n\ +Return system information in the structure. For example:\n\ +\n\ +@example\n\ +@group\n\ +uname ()\n\ + @result{} @{\n\ + sysname = x86_64\n\ + nodename = segfault\n\ + release = 2.6.15-1-amd64-k8-smp\n\ + version = Linux\n\ + machine = #2 SMP Thu Feb 23 04:57:49 UTC 2006\n\ + @}\n\ +@end group\n\ +@end example\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\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 0) + { + octave_uname sysinfo; + + octave_scalar_map m; + + m.assign ("sysname", sysinfo.sysname ()); + m.assign ("nodename", sysinfo.nodename ()); + m.assign ("release", sysinfo.release ()); + m.assign ("version", sysinfo.version ()); + m.assign ("machine", sysinfo.machine ()); + + retval(2) = sysinfo.message (); + retval(1) = sysinfo.error (); + retval(0) = m; + } + else + print_usage (); + + return retval; +} + +DEFUNX ("unlink", Funlink, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} unlink (@var{file})\n\ +Delete the file named @var{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\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 1) + { + if (args(0).is_string ()) + { + std::string name = args(0).string_value (); + + std::string msg; + + int status = octave_unlink (name, msg); + + retval(1) = msg; + retval(0) = status; + } + else + error ("unlink: FILE must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("waitpid", Fwaitpid, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{pid}, @var{status}, @var{msg}] =} waitpid (@var{pid}, @var{options})\n\ +Wait for process @var{pid} to terminate. The @var{pid} argument can be:\n\ +\n\ +@table @asis\n\ +@item @minus{}1\n\ +Wait for any child process.\n\ +\n\ +@item 0\n\ +Wait for any child process whose process group ID is equal to that of\n\ +the Octave interpreter process.\n\ +\n\ +@item > 0\n\ +Wait for termination of the child process with ID @var{pid}.\n\ +@end table\n\ +\n\ +The @var{options} argument can be a bitwise OR of zero or more of\n\ +the following constants:\n\ +\n\ +@table @code\n\ +@item 0\n\ +Wait until signal is received or a child process exits (this is the\n\ +default if the @var{options} argument is missing).\n\ +\n\ +@item WNOHANG\n\ +Do not hang if status is not immediately available.\n\ +\n\ +@item WUNTRACED\n\ +Report the status of any child processes that are stopped, and whose\n\ +status has not yet been reported since they stopped.\n\ +\n\ +@item WCONTINUE\n\ +Return if a stopped child has been resumed by delivery of @code{SIGCONT}.\n\ +This value may not be meaningful on all systems.\n\ +@end table\n\ +\n\ +If the returned value of @var{pid} is greater than 0, it is the process\n\ +ID of the child process that exited. If an error occurs, @var{pid} will\n\ +be less than zero and @var{msg} will contain a system-dependent error\n\ +message. The value of @var{status} contains additional system-dependent\n\ +information about the subprocess that exited.\n\ +@seealso{WCONTINUE, WCOREDUMP, WEXITSTATUS, WIFCONTINUED, WIFSIGNALED, WIFSTOPPED, WNOHANG, WSTOPSIG, WTERMSIG, WUNTRACED}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(2) = std::string (); + retval(1) = 0; + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + pid_t pid = args(0).int_value (true); + + if (! error_state) + { + int options = 0; + + if (args.length () == 2) + options = args(1).int_value (true); + + if (! error_state) + { + std::string msg; + + int status = 0; + + pid_t result = octave_syscalls::waitpid (pid, &status, options, msg); + + retval(2) = msg; + retval(1) = status; + retval(0) = result; + } + else + error ("waitpid: OPTIONS must be an integer"); + } + else + error ("waitpid: PID must be an integer value"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("WIFEXITED", FWIFEXITED, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WIFEXITED (@var{status})\n\ +Given @var{status} from a call to @code{waitpid}, return true if the\n\ +child terminated normally.\n\ +@seealso{waitpid, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WCOREDUMP, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ +@end deftypefn") +{ + octave_value retval = 0.0; + +#if defined (WIFEXITED) + if (args.length () == 1) + { + int status = args(0).int_value (); + + if (! error_state) + retval = WIFEXITED (status); + else + error ("WIFEXITED: STATUS must be an integer"); + } +#else + warning ("WIFEXITED always returns false in this version of Octave"); +#endif + + return retval; +} + +DEFUNX ("WEXITSTATUS", FWEXITSTATUS, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WEXITSTATUS (@var{status})\n\ +Given @var{status} from a call to @code{waitpid}, return the exit\n\ +status of the child. This function should only be employed if\n\ +@code{WIFEXITED} returned true.\n\ +@seealso{waitpid, WIFEXITED, WIFSIGNALED, WTERMSIG, WCOREDUMP, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ +@end deftypefn") +{ + octave_value retval = 0.0; + +#if defined (WEXITSTATUS) + if (args.length () == 1) + { + int status = args(0).int_value (); + + if (! error_state) + retval = WEXITSTATUS (status); + else + error ("WEXITSTATUS: STATUS must be an integer"); + } +#else + warning ("WEXITSTATUS always returns false in this version of Octave"); +#endif + + return retval; +} + +DEFUNX ("WIFSIGNALED", FWIFSIGNALED, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WIFSIGNALED (@var{status})\n\ +Given @var{status} from a call to @code{waitpid}, return true if the\n\ +child process was terminated by a signal.\n\ +@seealso{waitpid, WIFEXITED, WEXITSTATUS, WTERMSIG, WCOREDUMP, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ +@end deftypefn") +{ + octave_value retval = 0.0; + +#if defined (WIFSIGNALED) + if (args.length () == 1) + { + int status = args(0).int_value (); + + if (! error_state) + retval = WIFSIGNALED (status); + else + error ("WIFSIGNALED: STATUS must be an integer"); + } +#else + warning ("WIFSIGNALED always returns false in this version of Octave"); +#endif + + return retval; +} + +DEFUNX ("WTERMSIG", FWTERMSIG, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WTERMSIG (@var{status})\n\ +Given @var{status} from a call to @code{waitpid}, return the number of\n\ +the signal that caused the child process to terminate. This function\n\ +should only be employed if @code{WIFSIGNALED} returned true.\n\ +@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WCOREDUMP, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ +@end deftypefn") +{ + octave_value retval = 0.0; + +#if defined (WTERMSIG) + if (args.length () == 1) + { + int status = args(0).int_value (); + + if (! error_state) + retval = WTERMSIG (status); + else + error ("WTERMSIG: STATUS must be an integer"); + } +#else + warning ("WTERMSIG always returns false in this version of Octave"); +#endif + + return retval; +} + +DEFUNX ("WCOREDUMP", FWCOREDUMP, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WCOREDUMP (@var{status})\n\ +Given @var{status} from a call to @code{waitpid}, return true if the\n\ +child produced a core dump. This function should only be employed if\n\ +@code{WIFSIGNALED} returned true. The macro used to implement this\n\ +function is not specified in POSIX.1-2001 and is not available on some\n\ +Unix implementations (e.g., AIX, SunOS).\n\ +@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ +@end deftypefn") +{ + octave_value retval = 0.0; + +#if defined (WCOREDUMP) + if (args.length () == 1) + { + int status = args(0).int_value (); + + if (! error_state) + retval = WCOREDUMP (status); + else + error ("WCOREDUMP: STATUS must be an integer"); + } +#else + warning ("WCOREDUMP always returns false in this version of Octave"); +#endif + + return retval; +} + +DEFUNX ("WIFSTOPPED", FWIFSTOPPED, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WIFSTOPPED (@var{status})\n\ +Given @var{status} from a call to @code{waitpid}, return true if the\n\ +child process was stopped by delivery of a signal; this is only\n\ +possible if the call was done using @code{WUNTRACED} or when the child\n\ +is being traced (see ptrace(2)).\n\ +@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WCOREDUMP, WSTOPSIG, WIFCONTINUED}\n\ +@end deftypefn") +{ + octave_value retval = 0.0; + +#if defined (WIFSTOPPED) + if (args.length () == 1) + { + int status = args(0).int_value (); + + if (! error_state) + retval = WIFSTOPPED (status); + else + error ("WIFSTOPPED: STATUS must be an integer"); + } +#else + warning ("WIFSTOPPED always returns false in this version of Octave"); +#endif + + return retval; +} + +DEFUNX ("WSTOPSIG", FWSTOPSIG, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WSTOPSIG (@var{status})\n\ +Given @var{status} from a call to @code{waitpid}, return the number of\n\ +the signal which caused the child to stop. This function should only\n\ +be employed if @code{WIFSTOPPED} returned true.\n\ +@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WCOREDUMP, WIFSTOPPED, WIFCONTINUED}\n\ +@end deftypefn") +{ + octave_value retval = 0.0; + +#if defined (WSTOPSIG) + if (args.length () == 1) + { + int status = args(0).int_value (); + + if (! error_state) + retval = WSTOPSIG (status); + else + error ("WSTOPSIG: STATUS must be an integer"); + } +#else + warning ("WSTOPSIG always returns false in this version of Octave"); +#endif + + return retval; +} + +DEFUNX ("WIFCONTINUED", FWIFCONTINUED, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WIFCONTINUED (@var{status})\n\ +Given @var{status} from a call to @code{waitpid}, return true if the\n\ +child process was resumed by delivery of @code{SIGCONT}.\n\ +@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WCOREDUMP, WIFSTOPPED, WSTOPSIG}\n\ +@end deftypefn") +{ + octave_value retval = 0.0; + +#if defined (WIFCONTINUED) + if (args.length () == 1) + { + int status = args(0).int_value (); + + if (! error_state) + retval = WIFCONTINUED (status); + else + error ("WIFCONTINUED: STATUS must be an integer"); + } +#else + warning ("WIFCONTINUED always returns false in this version of Octave"); +#endif + + return retval; +} + +DEFUNX ("canonicalize_file_name", Fcanonicalize_file_name, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{cname}, @var{status}, @var{msg}] =} canonicalize_file_name (@var{fname})\n\ +Return the canonical name of file @var{fname}. If the file does not exist\n\ +the empty string (\"\") is returned.\n\ +@seealso{make_absolute_filename, is_absolute_filename, is_rooted_relative_filename}\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + std::string name = args(0).string_value (); + + if (! error_state) + { + std::string msg; + + std::string result = octave_canonicalize_file_name (name, msg); + + retval(2) = msg; + retval(1) = msg.empty () ? 0 : -1; + retval(0) = result; + } + else + error ("canonicalize_file_name: NAME must be a character string"); + } + else + print_usage (); + + return retval; +} + +static octave_value +const_value (const octave_value_list& args, int val) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + retval = val; + else + print_usage (); + + return retval; +} + +#if !defined (O_NONBLOCK) && defined (O_NDELAY) +#define O_NONBLOCK O_NDELAY +#endif + +DEFUNX ("F_DUPFD", FF_DUPFD, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} F_DUPFD ()\n\ +Return the numerical value to pass to @code{fcntl} to return a\n\ +duplicate file descriptor.\n\ +@seealso{fcntl, F_GETFD, F_GETFL, F_SETFD, F_SETFL}\n\ +@end deftypefn") +{ +#if defined (F_DUPFD) + return const_value (args, F_DUPFD); +#else + error ("F_DUPFD: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("F_GETFD", FF_GETFD, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} F_GETFD ()\n\ +Return the numerical value to pass to @code{fcntl} to return the\n\ +file descriptor flags.\n\ +@seealso{fcntl, F_DUPFD, F_GETFL, F_SETFD, F_SETFL}\n\ +@end deftypefn") +{ +#if defined (F_GETFD) + return const_value (args, F_GETFD); +#else + error ("F_GETFD: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("F_GETFL", FF_GETFL, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} F_GETFL ()\n\ +Return the numerical value to pass to @code{fcntl} to return the\n\ +file status flags.\n\ +@seealso{fcntl, F_DUPFD, F_GETFD, F_SETFD, F_SETFL}\n\ +@end deftypefn") +{ +#if defined (F_GETFL) + return const_value (args, F_GETFL); +#else + error ("F_GETFL: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("F_SETFD", FF_SETFD, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} F_SETFD ()\n\ +Return the numerical value to pass to @code{fcntl} to set the file\n\ +descriptor flags.\n\ +@seealso{fcntl, F_DUPFD, F_GETFD, F_GETFL, F_SETFL}\n\ +@end deftypefn") +{ +#if defined (F_SETFD) + return const_value (args, F_SETFD); +#else + error ("F_SETFD: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("F_SETFL", FF_SETFL, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} F_SETFL ()\n\ +Return the numerical value to pass to @code{fcntl} to set the file\n\ +status flags.\n\ +@seealso{fcntl, F_DUPFD, F_GETFD, F_GETFL, F_SETFD}\n\ +@end deftypefn") +{ +#if defined (F_SETFL) + return const_value (args, F_SETFL); +#else + error ("F_SETFL: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_APPEND", FO_APPEND, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_APPEND ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate each write operation appends,\n\ +or that may be passed to @code{fcntl} to set the write mode to append.\n\ +@seealso{fcntl, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_APPEND) + return const_value (args, O_APPEND); +#else + error ("O_APPEND: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_ASYNC", FO_ASYNC, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_ASYNC ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate asynchronous I/O.\n\ +@seealso{fcntl, O_APPEND, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_ASYNC) + return const_value (args, O_ASYNC); +#else + error ("O_ASYNC: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_CREAT", FO_CREAT, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_CREAT ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate that a file should be\n\ +created if it does not exist.\n\ +@seealso{fcntl, O_APPEND, O_ASYNC, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_CREAT) + return const_value (args, O_CREAT); +#else + error ("O_CREAT: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_EXCL", FO_EXCL, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_EXCL ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate that file locking is used.\n\ +@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_EXCL) + return const_value (args, O_EXCL); +#else + error ("O_EXCL: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_NONBLOCK", FO_NONBLOCK, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_NONBLOCK ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate that non-blocking I/O is in use,\n\ +or that may be passsed to @code{fcntl} to set non-blocking I/O.\n\ +@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_NONBLOCK) + return const_value (args, O_NONBLOCK); +#else + error ("O_NONBLOCK: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_RDONLY", FO_RDONLY, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_RDONLY ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate that a file is open for\n\ +reading only.\n\ +@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_RDONLY) + return const_value (args, O_RDONLY); +#else + error ("O_RDONLY: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_RDWR", FO_RDWR, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_RDWR ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate that a file is open for both\n\ +reading and writing.\n\ +@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_SYNC, O_TRUNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_RDWR) + return const_value (args, O_RDWR); +#else + error ("O_RDWR: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_SYNC", FO_SYNC, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_SYNC ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate that a file is open for\n\ +synchronous I/O.\n\ +@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_TRUNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_SYNC) + return const_value (args, O_SYNC); +#else + error ("O_SYNC: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_TRUNC", FO_TRUNC, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} O_TRUNC ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate that if file exists, it should\n\ +be truncated when writing.\n\ +@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_TRUNC) + return const_value (args, O_TRUNC); +#else + error ("O_TRUNC: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_WRONLY", FO_WRONLY, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_WRONLY ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate that a file is open for\n\ +writing only.\n\ +@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC}\n\ +@end deftypefn") +{ +#if defined (O_WRONLY) + return const_value (args, O_WRONLY); +#else + error ("O_WRONLY: not available on this system"); + return octave_value (); +#endif +} + +#if !defined (WNOHANG) +#define WNOHANG 0 +#endif + +DEFUNX ("WNOHANG", FWNOHANG, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WNOHANG ()\n\ +Return the numerical value of the option argument that may be\n\ +passed to @code{waitpid} to indicate that it should return its\n\ +status immediately instead of waiting for a process to exit.\n\ +@seealso{waitpid, WUNTRACED, WCONTINUE}\n\ +@end deftypefn") +{ + return const_value (args, WNOHANG); +} + +#if !defined (WUNTRACED) +#define WUNTRACED 0 +#endif + +DEFUNX ("WUNTRACED", FWUNTRACED, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WUNTRACED ()\n\ +Return the numerical value of the option argument that may be\n\ +passed to @code{waitpid} to indicate that it should also return\n\ +if the child process has stopped but is not traced via the\n\ +@code{ptrace} system call\n\ +@seealso{waitpid, WNOHANG, WCONTINUE}\n\ +@end deftypefn") +{ + return const_value (args, WUNTRACED); +} + +#if !defined (WCONTINUE) +#define WCONTINUE 0 +#endif + +DEFUNX ("WCONTINUE", FWCONTINUE, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WCONTINUE ()\n\ +Return the numerical value of the option argument that may be\n\ +passed to @code{waitpid} to indicate that it should also return\n\ +if a stopped child has been resumed by delivery of a @code{SIGCONT}\n\ +signal.\n\ +@seealso{waitpid, WNOHANG, WUNTRACED}\n\ +@end deftypefn") +{ + return const_value (args, WCONTINUE); +}
--- a/src/mappers.cc Tue Jul 31 20:39:08 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2087 +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 -<http://www.gnu.org/licenses/>. - -*/ - -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#include <cctype> -#include <cfloat> - -#include "lo-ieee.h" -#include "lo-specfun.h" -#include "lo-mappers.h" - -#include "defun.h" -#include "error.h" -#include "variables.h" - -DEFUN (abs, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} abs (@var{z})\n\ -Compute the magnitude of @var{z}, defined as\n\ -@tex\n\ -$|z| = \\sqrt{x^2 + y^2}$.\n\ -@end tex\n\ -@ifnottex\n\ -|@var{z}| = @code{sqrt (x^2 + y^2)}.\n\ -@end ifnottex\n\ -\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -abs (3 + 4i)\n\ - @result{} 5\n\ -@end group\n\ -@end example\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).abs (); - else - print_usage (); - - return retval; -} - -/* -%!assert (abs (1), 1) -%!assert (abs (-3.5), 3.5) -%!assert (abs (3+4i), 5) -%!assert (abs (3-4i), 5) -%!assert (abs ([1.1, 3i; 3+4i, -3-4i]), [1.1, 3; 5, 5]) - -%!assert (abs (single (1)), single (1)) -%!assert (abs (single (-3.5)), single (3.5)) -%!assert (abs (single (3+4i)), single (5)) -%!assert (abs (single (3-4i)), single (5)) -%!assert (abs (single ([1.1, 3i; 3+4i, -3-4i])), single ([1.1, 3; 5, 5])) - -%!error abs () -%!error abs (1, 2) -*/ - -DEFUN (acos, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} acos (@var{x})\n\ -Compute the inverse cosine in radians for each element of @var{x}.\n\ -@seealso{cos, acosd}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).acos (); - else - print_usage (); - - return retval; -} - -/* -%!shared rt2, rt3 -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); - -%!test -%! x = [1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]; -%! v = [0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]; -%! assert (acos (x), v, sqrt (eps)); - -%!test -%! x = single ([1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]); -%! v = single ([0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]); -%! assert (acos (x), v, sqrt (eps ("single"))); - -%!error acos () -%!error acos (1, 2) -*/ - -DEFUN (acosh, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} acosh (@var{x})\n\ -Compute the inverse hyperbolic cosine for each element of @var{x}.\n\ -@seealso{cosh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).acosh (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! x = [1, 0, -1, 0]; -%! v = [0, pi/2*i, pi*i, pi/2*i]; -%! assert (acosh (x), v, sqrt (eps)); - -%!test -%! x = single ([1, 0, -1, 0]); -%! v = single ([0, pi/2*i, pi*i, pi/2*i]); -%! assert (acosh (x), v, sqrt (eps ("single"))); - -%!error acosh () -%!error acosh (1, 2) -*/ - -DEFUN (angle, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} angle (@var{z})\n\ -See arg.\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).arg (); - else - print_usage (); - - return retval; -} - -DEFUN (arg, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} arg (@var{z})\n\ -@deftypefnx {Mapping Function} {} angle (@var{z})\n\ -Compute the argument of @var{z}, defined as,\n\ -@tex\n\ -$\\theta = atan2 (y, x),$\n\ -@end tex\n\ -@ifnottex\n\ -@var{theta} = @code{atan2 (@var{y}, @var{x})},\n\ -@end ifnottex\n\ -in radians.\n\ -\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -arg (3 + 4i)\n\ - @result{} 0.92730\n\ -@end group\n\ -@end example\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).arg (); - else - print_usage (); - - return retval; -} - -/* -%!assert (arg (1), 0) -%!assert (arg (i), pi/2) -%!assert (arg (-1), pi) -%!assert (arg (-i), -pi/2) -%!assert (arg ([1, i; -1, -i]), [0, pi/2; pi, -pi/2]) - -%!assert (arg (single (1)), single (0)) -%!assert (arg (single (i)), single (pi/2)) -%!test -%! if (ismac ()) -%! ## Avoid failing for a MacOS feature -%! assert (arg (single (-1)), single (pi), 2*eps (single (1))); -%! else -%! assert (arg (single (-1)), single (pi)); -%! endif -%!assert (arg (single (-i)), single (-pi/2)) -%!assert (arg (single ([1, i; -1, -i])), single ([0, pi/2; pi, -pi/2]), 2e1*eps ("single")) - -%!error arg () -%!error arg (1, 2) -*/ - -DEFUN (asin, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} asin (@var{x})\n\ -Compute the inverse sine in radians for each element of @var{x}.\n\ -@seealso{sin, asind}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).asin (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); -%! x = [0, 1/2, rt2/2, rt3/2, 1, rt3/2, rt2/2, 1/2, 0]; -%! v = [0, pi/6, pi/4, pi/3, pi/2, pi/3, pi/4, pi/6, 0]; -%! assert (all (abs (asin (x) - v) < sqrt (eps))); - -%!error asin () -%!error asin (1, 2) -*/ - -DEFUN (asinh, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} asinh (@var{x})\n\ -Compute the inverse hyperbolic sine for each element of @var{x}.\n\ -@seealso{sinh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).asinh (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! v = [0, pi/2*i, 0, -pi/2*i]; -%! x = [0, i, 0, -i]; -%! assert (asinh (x), v, sqrt (eps)); - -%!test -%! v = single ([0, pi/2*i, 0, -pi/2*i]); -%! x = single ([0, i, 0, -i]); -%! assert (asinh (x), v, sqrt (eps ("single"))); - -%!error asinh () -%!error asinh (1, 2) -*/ - -DEFUN (atan, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} atan (@var{x})\n\ -Compute the inverse tangent in radians for each element of @var{x}.\n\ -@seealso{tan, atand}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).atan (); - else - print_usage (); - - return retval; -} - -/* -%!shared rt2, rt3 -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); - -%!test -%! v = [0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]; -%! x = [0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]; -%! assert (atan (x), v, sqrt (eps)); - -%!test -%! v = single ([0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]); -%! x = single ([0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]); -%! assert (atan (x), v, sqrt (eps ("single"))); - -%!error atan () -%!error atan (1, 2) -*/ - -DEFUN (atanh, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} atanh (@var{x})\n\ -Compute the inverse hyperbolic tangent for each element of @var{x}.\n\ -@seealso{tanh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).atanh (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! v = [0, 0]; -%! x = [0, 0]; -%! assert (atanh (x), v, sqrt (eps)); - -%!test -%! v = single ([0, 0]); -%! x = single ([0, 0]); -%! assert (atanh (x), v, sqrt (eps ("single"))); - -%!error atanh () -%!error atanh (1, 2) -*/ - -DEFUN (cbrt, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} cbrt (@var{x})\n\ -Compute the real cube root of each element of @var{x}.\n\ -Unlike @code{@var{x}^(1/3)}, the result will be negative if @var{x} is\n\ -negative.\n\ -@seealso{nthroot}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).cbrt (); - else - print_usage (); - - return retval; -} - -/* -%!assert (cbrt (64), 4) -%!assert (cbrt (-125), -5) -%!assert (cbrt (0), 0) -%!assert (cbrt (Inf), Inf) -%!assert (cbrt (-Inf), -Inf) -%!assert (cbrt (NaN), NaN) -%!assert (cbrt (2^300), 2^100) -%!assert (cbrt (125*2^300), 5*2^100) - -%!error cbrt () -%!error cbrt (1, 2) -*/ - -DEFUN (ceil, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} ceil (@var{x})\n\ -Return the smallest integer not less than @var{x}. This is equivalent to\n\ -rounding towards positive infinity. If @var{x} is\n\ -complex, return @code{ceil (real (@var{x})) + ceil (imag (@var{x})) * I}.\n\ -\n\ -@example\n\ -@group\n\ -ceil ([-2.7, 2.7])\n\ - @result{} -2 3\n\ -@end group\n\ -@end example\n\ -@seealso{floor, round, fix}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).ceil (); - else - print_usage (); - - return retval; -} - -/* -## double precision -%!assert (ceil ([2, 1.1, -1.1, -1]), [2, 2, -1, -1]) - -## complex double precison -%!assert (ceil ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i]), [2+2i, 2+2i, -1-i, -1-i]) - -## single precision -%!assert (ceil (single ([2, 1.1, -1.1, -1])), single ([2, 2, -1, -1])) - -## complex single precision -%!assert (ceil (single ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i])), single ([2+2i, 2+2i, -1-i, -1-i])) - -%!error ceil () -%!error ceil (1, 2) -*/ - -DEFUN (conj, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} conj (@var{z})\n\ -Return the complex conjugate of @var{z}, defined as\n\ -@tex\n\ -$\\bar{z} = x - iy$.\n\ -@end tex\n\ -@ifnottex\n\ -@code{conj (@var{z})} = @var{x} - @var{i}@var{y}.\n\ -@end ifnottex\n\ -@seealso{real, imag}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).conj (); - else - print_usage (); - - return retval; -} - -/* -%!assert (conj (1), 1) -%!assert (conj (i), -i) -%!assert (conj (1+i), 1-i) -%!assert (conj (1-i), 1+i) -%!assert (conj ([-1, -i; -1+i, -1-i]), [-1, i; -1-i, -1+i]) - -%!assert (conj (single (1)), single (1)) -%!assert (conj (single (i)), single (-i)) -%!assert (conj (single (1+i)), single (1-i)) -%!assert (conj (single (1-i)), single (1+i)) -%!assert (conj (single ([-1, -i; -1+i, -1-i])), single ([-1, i; -1-i, -1+i])) - -%!error conj () -%!error conj (1, 2) -*/ - -DEFUN (cos, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} cos (@var{x})\n\ -Compute the cosine for each element of @var{x} in radians.\n\ -@seealso{acos, cosd, cosh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).cos (); - else - print_usage (); - - return retval; -} - -/* -%!shared rt2, rt3 -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); - -%!test -%! x = [0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]; -%! v = [1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]; -%! assert (cos (x), v, sqrt (eps)); - -%!test -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); -%! x = single ([0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]); -%! v = single ([1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]); -%! assert (cos (x), v, sqrt (eps ("single"))); - -%!error cos () -%!error cos (1, 2) -*/ - -DEFUN (cosh, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} cosh (@var{x})\n\ -Compute the hyperbolic cosine for each element of @var{x}.\n\ -@seealso{acosh, sinh, tanh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).cosh (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! x = [0, pi/2*i, pi*i, 3*pi/2*i]; -%! v = [1, 0, -1, 0]; -%! assert (cosh (x), v, sqrt (eps)); - -%!test -%! x = single ([0, pi/2*i, pi*i, 3*pi/2*i]); -%! v = single ([1, 0, -1, 0]); -%! assert (cosh (x), v, sqrt (eps ("single"))); - -%!error cosh () -%!error cosh (1, 2) -*/ - -DEFUN (erf, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} erf (@var{z})\n\ -Compute the error function,\n\ -@tex\n\ -$$\n\ - {\\rm erf} (z) = {2 \\over \\sqrt{\\pi}}\\int_0^z e^{-t^2} dt\n\ -$$\n\ -@end tex\n\ -@ifnottex\n\ -\n\ -@example\n\ -@group\n\ - z\n\ - 2 /\n\ -erf (z) = --------- * | e^(-t^2) dt\n\ - sqrt (pi) /\n\ - t=0\n\ -@end group\n\ -@end example\n\ -\n\ -@end ifnottex\n\ -@seealso{erfc, erfcx, erfinv, erfcinv}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).erf (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! a = -1i*sqrt (-1/(6.4187*6.4187)); -%! assert (erf (a), erf (real (a))); - -%!test -%! x = [0,.5,1]; -%! v = [0, .520499877813047, .842700792949715]; -%! assert (erf (x), v, 1.e-10); -%! assert (erf (-x), -v, 1.e-10); -%! assert (erfc (x), 1-v, 1.e-10); -%! assert (erfinv (v), x, 1.e-10); - -%!test -%! a = -1i*sqrt (single (-1/(6.4187*6.4187))); -%! assert (erf (a), erf (real (a))); - -%!test -%! x = single ([0,.5,1]); -%! v = single ([0, .520499877813047, .842700792949715]); -%! assert (erf (x), v, 1.e-6); -%! assert (erf (-x), -v, 1.e-6); -%! assert (erfc (x), 1-v, 1.e-6); -%! assert (erfinv (v), x, 1.e-6); - -%!error erf () -%!error erf (1, 2) -*/ - -DEFUN (erfinv, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} erfinv (@var{x})\n\ -Compute the inverse error function, i.e., @var{y} such that\n\ -\n\ -@example\n\ -erf (@var{y}) == @var{x}\n\ -@end example\n\ -@seealso{erf, erfc, erfcx, erfcinv}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).erfinv (); - else - print_usage (); - - return retval; -} - -/* -## middle region -%!assert (erf (erfinv ([-0.9 -0.3 0 0.4 0.8])), [-0.9 -0.3 0 0.4 0.8], eps) -%!assert (erf (erfinv (single ([-0.9 -0.3 0 0.4 0.8]))), single ([-0.9 -0.3 0 0.4 0.8]), eps ("single")) -## tail region -%!assert (erf (erfinv ([-0.999 -0.99 0.9999 0.99999])), [-0.999 -0.99 0.9999 0.99999], eps) -%!assert (erf (erfinv (single ([-0.999 -0.99 0.9999 0.99999]))), single ([-0.999 -0.99 0.9999 0.99999]), eps ("single")) -## backward - loss of accuracy -%!assert (erfinv (erf ([-3 -1 -0.4 0.7 1.3 2.8])), [-3 -1 -0.4 0.7 1.3 2.8], -1e-12) -%!assert (erfinv (erf (single ([-3 -1 -0.4 0.7 1.3 2.8]))), single ([-3 -1 -0.4 0.7 1.3 2.8]), -1e-4) -## exceptional -%!assert (erfinv ([-1, 1, 1.1, -2.1]), [-Inf, Inf, NaN, NaN]) -%!error erfinv (1+2i) - -%!error erfinv () -%!error erfinv (1, 2) -*/ - -DEFUN (erfcinv, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} erfcinv (@var{x})\n\ -Compute the inverse complementary error function, i.e., @var{y} such that\n\ -\n\ -@example\n\ -erfc (@var{y}) == @var{x}\n\ -@end example\n\ -@seealso{erfc, erf, erfcx, erfinv}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).erfcinv (); - else - print_usage (); - - return retval; -} - -/* -## middle region -%!assert (erfc (erfcinv ([1.9 1.3 1 0.6 0.2])), [1.9 1.3 1 0.6 0.2], eps) -%!assert (erfc (erfcinv (single ([1.9 1.3 1 0.6 0.2]))), single ([1.9 1.3 1 0.6 0.2]), eps ("single")) -## tail region -%!assert (erfc (erfcinv ([0.001 0.01 1.9999 1.99999])), [0.001 0.01 1.9999 1.99999], eps) -%!assert (erfc (erfcinv (single ([0.001 0.01 1.9999 1.99999]))), single ([0.001 0.01 1.9999 1.99999]), eps ("single")) -## backward - loss of accuracy -%!assert (erfcinv (erfc ([-3 -1 -0.4 0.7 1.3 2.8])), [-3 -1 -0.4 0.7 1.3 2.8], -1e-12) -%!assert (erfcinv (erfc (single ([-3 -1 -0.4 0.7 1.3 2.8]))), single ([-3 -1 -0.4 0.7 1.3 2.8]), -1e-4) -## exceptional -%!assert (erfcinv ([2, 0, -0.1, 2.1]), [-Inf, Inf, NaN, NaN]) -%!error erfcinv (1+2i) - -%!error erfcinv () -%!error erfcinv (1, 2) -*/ - -DEFUN (erfc, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} erfc (@var{z})\n\ -Compute the complementary error function,\n\ -@tex\n\ -$1 - {\\rm erf} (z)$.\n\ -@end tex\n\ -@ifnottex\n\ -@w{@code{1 - erf (@var{z})}}.\n\ -@end ifnottex\n\ -@seealso{erfcinv, erfcx, erf, erfinv}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).erfc (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! a = -1i*sqrt (-1/(6.4187*6.4187)); -%! assert (erfc (a), erfc (real (a))); - -%!error erfc () -%!error erfc (1, 2) -*/ - -DEFUN (erfcx, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} erfcx (@var{z})\n\ -Compute the scaled complementary error function,\n\ -@tex\n\ -$$\n\ - e^{z^2} {\\rm erfc} (z) \\equiv e^{z^2} (1 - {\\rm erf} (z))\n\ -$$\n\ -@end tex\n\ -@ifnottex\n\ -\n\ -@example\n\ -exp (z^2) * erfc (x)\n\ -@end example\n\ -\n\ -@end ifnottex\n\ -@seealso{erfc, erf, erfinv, erfcinv}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).erfcx (); - else - print_usage (); - - return retval; -} - -/* -## FIXME: Need a test for erfcx - -%!error erfcx () -%!error erfcx (1, 2) -*/ - -DEFUN (exp, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} exp (@var{x})\n\ -Compute\n\ -@tex\n\ -$e^{x}$\n\ -@end tex\n\ -@ifnottex\n\ -@code{e^x}\n\ -@end ifnottex\n\ -for each element of @var{x}. To compute the matrix\n\ -exponential, see @ref{Linear Algebra}.\n\ -@seealso{log}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).exp (); - else - print_usage (); - - return retval; -} - -/* -%!assert (exp ([0, 1, -1, -1000]), [1, e, 1/e, 0], sqrt (eps)) -%!assert (exp (1+i), e * (cos (1) + sin (1) * i), sqrt (eps)) -%!assert (exp (single ([0, 1, -1, -1000])), single ([1, e, 1/e, 0]), sqrt (eps ("single"))) -%!assert (exp (single (1+i)), single (e * (cos (1) + sin (1) * i)), sqrt (eps ("single"))) - -%!assert (exp ([Inf, -Inf, NaN]), [Inf 0 NaN]) -%!assert (exp (single ([Inf, -Inf, NaN])), single ([Inf 0 NaN])) - -%!error exp () -%!error exp (1, 2) -*/ - -DEFUN (expm1, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} expm1 (@var{x})\n\ -Compute\n\ -@tex\n\ -$ e^{x} - 1 $\n\ -@end tex\n\ -@ifnottex\n\ -@code{exp (@var{x}) - 1}\n\ -@end ifnottex\n\ -accurately in the neighborhood of zero.\n\ -@seealso{exp}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).expm1 (); - else - print_usage (); - - return retval; -} - -/* -%!assert (expm1 (2*eps), 2*eps, 1e-29) - -%!assert (expm1 ([Inf, -Inf, NaN]), [Inf -1 NaN]) -%!assert (expm1 (single ([Inf, -Inf, NaN])), single ([Inf -1 NaN])) - -%!error expm1 () -%!error expm1 (1, 2) -*/ - -DEFUN (isfinite, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isfinite (@var{x})\n\ -@deftypefnx {Mapping Function} {} finite (@var{x})\n\ -Return a logical array which is true where the elements of @var{x} are\n\ -finite values and false where they are not.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -finite ([13, Inf, NA, NaN])\n\ - @result{} [ 1, 0, 0, 0 ]\n\ -@end group\n\ -@end example\n\ -@seealso{isinf, isnan, isna}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).finite (); - else - print_usage (); - - return retval; -} - -/* -%!assert (!finite (Inf)) -%!assert (!finite (NaN)) -%!assert (finite (rand (1,10))) - -%!assert (!finite (single (Inf))) -%!assert (!finite (single (NaN))) -%!assert (finite (single (rand (1,10)))) - -%!error finite () -%!error finite (1, 2) -*/ - -DEFUN (fix, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} fix (@var{x})\n\ -Truncate fractional portion of @var{x} and return the integer portion. This\n\ -is equivalent to rounding towards zero. If @var{x} is complex, return\n\ -@code{fix (real (@var{x})) + fix (imag (@var{x})) * I}.\n\ -\n\ -@example\n\ -@group\n\ -fix ([-2.7, 2.7])\n\ - @result{} -2 2\n\ -@end group\n\ -@end example\n\ -@seealso{ceil, floor, round}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).fix (); - else - print_usage (); - - return retval; -} - -/* -%!assert (fix ([1.1, 1, -1.1, -1]), [1, 1, -1, -1]) -%!assert (fix ([1.1+1.1i, 1+i, -1.1-1.1i, -1-i]), [1+i, 1+i, -1-i, -1-i]) -%!assert (fix (single ([1.1, 1, -1.1, -1])), single ([1, 1, -1, -1])) -%!assert (fix (single ([1.1+1.1i, 1+i, -1.1-1.1i, -1-i])), single ([1+i, 1+i, -1-i, -1-i])) - -%!error fix () -%!error fix (1, 2) -*/ - -DEFUN (floor, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} floor (@var{x})\n\ -Return the largest integer not greater than @var{x}. This is equivalent to\n\ -rounding towards negative infinity. If @var{x} is\n\ -complex, return @code{floor (real (@var{x})) + floor (imag (@var{x})) * I}.\n\ -\n\ -@example\n\ -@group\n\ -floor ([-2.7, 2.7])\n\ - @result{} -3 2\n\ -@end group\n\ -@end example\n\ -@seealso{ceil, round, fix}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).floor (); - else - print_usage (); - - return retval; -} - -/* -%!assert (floor ([2, 1.1, -1.1, -1]), [2, 1, -2, -1]) -%!assert (floor ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i]), [2+2i, 1+i, -2-2i, -1-i]) -%!assert (floor (single ([2, 1.1, -1.1, -1])), single ([2, 1, -2, -1])) -%!assert (floor (single ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i])), single ([2+2i, 1+i, -2-2i, -1-i])) - -%!error floor () -%!error floor (1, 2) -*/ - -DEFUN (gamma, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} gamma (@var{z})\n\ -Compute the Gamma function,\n\ -@tex\n\ -$$\n\ - \\Gamma (z) = \\int_0^\\infty t^{z-1} e^{-t} dt.\n\ -$$\n\ -@end tex\n\ -@ifnottex\n\ -\n\ -@example\n\ -@group\n\ - infinity\n\ - /\n\ -gamma (z) = | t^(z-1) exp (-t) dt.\n\ - /\n\ - t=0\n\ -@end group\n\ -@end example\n\ -\n\ -@end ifnottex\n\ -@seealso{gammainc, lgamma}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).gamma (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! a = -1i*sqrt (-1/(6.4187*6.4187)); -%! assert (gamma (a), gamma (real (a))); - -%!test -%! x = [.5, 1, 1.5, 2, 3, 4, 5]; -%! v = [sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]; -%! assert (gamma (x), v, sqrt (eps)); - -%!test -%! a = single (-1i*sqrt (-1/(6.4187*6.4187))); -%! assert (gamma (a), gamma (real (a))); - -%!test -%! x = single ([.5, 1, 1.5, 2, 3, 4, 5]); -%! v = single ([sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]); -%! assert (gamma (x), v, sqrt (eps ("single"))); - -%!test -%! x = [-1, 0, 1, Inf]; -%! v = [Inf, Inf, 1, Inf]; -%! assert (gamma (x), v); -%! assert (gamma (single (x)), single (v)); - -%!error gamma () -%!error gamma (1, 2) -*/ - -DEFUN (imag, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} imag (@var{z})\n\ -Return the imaginary part of @var{z} as a real number.\n\ -@seealso{real, conj}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).imag (); - else - print_usage (); - - return retval; -} - -/* -%!assert (imag (1), 0) -%!assert (imag (i), 1) -%!assert (imag (1+i), 1) -%!assert (imag ([i, 1; 1, i]), full (eye (2))) - -%!assert (imag (single (1)), single (0)) -%!assert (imag (single (i)), single (1)) -%!assert (imag (single (1+i)), single (1)) -%!assert (imag (single ([i, 1; 1, i])), full (eye (2,"single"))) - -%!error imag () -%!error imag (1, 2) -*/ - -DEFUNX ("isalnum", Fisalnum, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isalnum (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -letters or digits and false where they are not. This is equivalent to\n\ -(@code{isalpha (@var{s}) | isdigit (@var{s})}).\n\ -@seealso{isalpha, isdigit, ispunct, isspace, iscntrl}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisalnum (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(toascii ("A":"Z") + 1) = true; -%! result(toascii ("0":"9") + 1) = true; -%! result(toascii ("a":"z") + 1) = true; -%! assert (isalnum (charset), result); - -%!error isalnum () -%!error isalnum (1, 2) -*/ - -DEFUNX ("isalpha", Fisalpha, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isalpha (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -letters and false where they are not. This is equivalent to\n\ -(@code{islower (@var{s}) | isupper (@var{s})}).\n\ -@seealso{isdigit, ispunct, isspace, iscntrl, isalnum, islower, isupper}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisalpha (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(toascii ("A":"Z") + 1) = true; -%! result(toascii ("a":"z") + 1) = true; -%! assert (isalpha (charset), result); - -%!error isalpha () -%!error isalpha (1, 2) -*/ - -DEFUNX ("isascii", Fisascii, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isascii (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -ASCII characters (in the range 0 to 127 decimal) and false where they are\n\ -not.\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisascii (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = true (1, 128); -%! assert (isascii (charset), result); - -%!error isascii () -%!error isascii (1, 2) -*/ - -DEFUNX ("iscntrl", Fiscntrl, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} iscntrl (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -control characters and false where they are not.\n\ -@seealso{ispunct, isspace, isalpha, isdigit}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xiscntrl (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(1:32) = true; -%! result(128) = true; -%! assert (iscntrl (charset), result); - -%!error iscntrl () -%!error iscntrl (1, 2) -*/ - -DEFUNX ("isdigit", Fisdigit, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isdigit (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -decimal digits (0-9) and false where they are not.\n\ -@seealso{isxdigit, isalpha, isletter, ispunct, isspace, iscntrl}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisdigit (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(toascii ("0":"9") + 1) = true; -%! assert (isdigit (charset), result); - -%!error isdigit () -%!error isdigit (1, 2) -*/ - -DEFUN (isinf, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isinf (@var{x})\n\ -Return a logical array which is true where the elements of @var{x} are\n\ -are infinite and false where they are not.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -isinf ([13, Inf, NA, NaN])\n\ - @result{} [ 0, 1, 0, 0 ]\n\ -@end group\n\ -@end example\n\ -@seealso{isfinite, isnan, isna}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).isinf (); - else - print_usage (); - - return retval; -} - -/* -%!assert (isinf (Inf)) -%!assert (!isinf (NaN)) -%!assert (!isinf (NA)) -%!assert (isinf (rand (1,10)), false (1,10)) -%!assert (isinf ([NaN -Inf -1 0 1 Inf NA]), [false, true, false, false, false, true, false]) - -%!assert (isinf (single (Inf))) -%!assert (!isinf (single (NaN))) -%!assert (!isinf (single (NA))) -%!assert (isinf (single (rand (1,10))), false (1,10)) -%!assert (isinf (single ([NaN -Inf -1 0 1 Inf NA])), [false, true, false, false, false, true, false]) - -%!error isinf () -%!error isinf (1, 2) -*/ - -DEFUNX ("isgraph", Fisgraph, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isgraph (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -printable characters (but not the space character) and false where they are\n\ -not.\n\ -@seealso{isprint}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisgraph (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(34:127) = true; -%! assert (isgraph (charset), result); - -%!error isgraph () -%!error isgraph (1, 2) -*/ - -DEFUNX ("islower", Fislower, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} islower (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -lowercase letters and false where they are not.\n\ -@seealso{isupper, isalpha, isletter, isalnum}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xislower (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(toascii ("a":"z") + 1) = true; -%! assert (islower (charset), result); - -%!error islower () -%!error islower (1, 2) -*/ - -DEFUN (isna, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isna (@var{x})\n\ -Return a logical array which is true where the elements of @var{x} are\n\ -NA (missing) values and false where they are not.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -isna ([13, Inf, NA, NaN])\n\ - @result{} [ 0, 0, 1, 0 ]\n\ -@end group\n\ -@end example\n\ -@seealso{isnan, isinf, isfinite}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).isna (); - else - print_usage (); - - return retval; -} - -/* -%!assert (!isna (Inf)) -%!assert (!isna (NaN)) -%!assert (isna (NA)) -%!assert (isna (rand (1,10)), false (1,10)) -%!assert (isna ([NaN -Inf -1 0 1 Inf NA]), [false, false, false, false, false, false, true]) - -%!assert (!isna (single (Inf))) -%!assert (!isna (single (NaN))) -%!assert (isna (single (NA))) -%!assert (isna (single (rand (1,10))), false (1,10)) -%!assert (isna (single ([NaN -Inf -1 0 1 Inf NA])), [false, false, false, false, false, false, true]) - -%!error isna () -%!error isna (1, 2) -*/ - -DEFUN (isnan, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isnan (@var{x})\n\ -Return a logical array which is true where the elements of @var{x} are\n\ -NaN values and false where they are not.\n\ -NA values are also considered NaN values. For example:\n\ -\n\ -@example\n\ -@group\n\ -isnan ([13, Inf, NA, NaN])\n\ - @result{} [ 0, 0, 1, 1 ]\n\ -@end group\n\ -@end example\n\ -@seealso{isna, isinf, isfinite}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).isnan (); - else - print_usage (); - - return retval; -} - -/* -%!assert (!isnan (Inf)) -%!assert (isnan (NaN)) -%!assert (isnan (NA)) -%!assert (isnan (rand (1,10)), false (1,10)) -%!assert (isnan ([NaN -Inf -1 0 1 Inf NA]), [true, false, false, false, false, false, true]) - -%!assert (!isnan (single (Inf))) -%!assert (isnan (single (NaN))) -%!assert (isnan (single (NA))) -%!assert (isnan (single (rand (1,10))), false (1,10)) -%!assert (isnan (single ([NaN -Inf -1 0 1 Inf NA])), [true, false, false, false, false, false, true]) - -%!error isnan () -%!error isnan (1, 2) -*/ - -DEFUNX ("isprint", Fisprint, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isprint (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -printable characters (including the space character) and false where they\n\ -are not.\n\ -@seealso{isgraph}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisprint (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(33:127) = true; -%! assert (isprint (charset), result); - -%!error isprint () -%!error isprint (1, 2) -*/ - -DEFUNX ("ispunct", Fispunct, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} ispunct (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -punctuation characters and false where they are not.\n\ -@seealso{isalpha, isdigit, isspace, iscntrl}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xispunct (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(34:48) = true; -%! result(59:65) = true; -%! result(92:97) = true; -%! result(124:127) = true; -%! assert (ispunct (charset), result); - -%!error ispunct () -%!error ispunct (1, 2) -*/ - -DEFUNX ("isspace", Fisspace, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isspace (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -whitespace characters (space, formfeed, newline, carriage return, tab, and\n\ -vertical tab) and false where they are not.\n\ -@seealso{iscntrl, ispunct, isalpha, isdigit}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisspace (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(toascii (" \f\n\r\t\v") + 1) = true; -%! assert (isspace (charset), result); - -%!error isspace () -%!error isspace (1, 2) -*/ - -DEFUNX ("isupper", Fisupper, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isupper (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -uppercase letters and false where they are not.\n\ -@seealso{islower, isalpha, isletter, isalnum}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisupper (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(toascii ("A":"Z") + 1) = true; -%! assert (isupper (charset), result); - -%!error isupper () -%!error isupper (1, 2) -*/ - -DEFUNX ("isxdigit", Fisxdigit, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isxdigit (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -hexadecimal digits (0-9 and @nospell{a-fA-F}).\n\ -@seealso{isdigit}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisxdigit (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(toascii ("A":"F") + 1) = true; -%! result(toascii ("0":"9") + 1) = true; -%! result(toascii ("a":"f") + 1) = true; -%! assert (isxdigit (charset), result); - -%!error isxdigit () -%!error isxdigit (1, 2) -*/ - -DEFUN (lgamma, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} lgamma (@var{x})\n\ -@deftypefnx {Mapping Function} {} gammaln (@var{x})\n\ -Return the natural logarithm of the gamma function of @var{x}.\n\ -@seealso{gamma, gammainc}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).lgamma (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! a = -1i*sqrt (-1/(6.4187*6.4187)); -%! assert (lgamma (a), lgamma (real (a))); - -%!test -%! x = [.5, 1, 1.5, 2, 3, 4, 5]; -%! v = [sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]; -%! assert (lgamma (x), log (v), sqrt (eps)) - -%!test -%! a = single (-1i*sqrt (-1/(6.4187*6.4187))); -%! assert (lgamma (a), lgamma (real (a))); - -%!test -%! x = single ([.5, 1, 1.5, 2, 3, 4, 5]); -%! v = single ([sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]); -%! assert (lgamma (x), log (v), sqrt (eps ("single"))) - -%!test -%! x = [-1, 0, 1, Inf]; -%! v = [Inf, Inf, 0, Inf]; -%! assert (lgamma (x), v); -%! assert (lgamma (single (x)), single (v)); - -%!error lgamma () -%!error lgamma (1,2) -*/ - -DEFUN (log, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} log (@var{x})\n\ -Compute the natural logarithm,\n\ -@tex\n\ -$\\ln{(x)},$\n\ -@end tex\n\ -@ifnottex\n\ -@code{ln (@var{x})},\n\ -@end ifnottex\n\ -for each element of @var{x}. To compute the\n\ -matrix logarithm, see @ref{Linear Algebra}.\n\ -@seealso{exp, log1p, log2, log10, logspace}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).log (); - else - print_usage (); - - return retval; -} - -/* -%!assert (log ([1, e, e^2]), [0, 1, 2], sqrt (eps)) -%!assert (log ([-0.5, -1.5, -2.5]), log ([0.5, 1.5, 2.5]) + pi*1i, sqrt (eps)) - -%!assert (log (single ([1, e, e^2])), single ([0, 1, 2]), sqrt (eps ("single"))) -%!assert (log (single ([-0.5, -1.5, -2.5])), single (log ([0.5, 1.5, 2.5]) + pi*1i), 4*eps ("single")) - -%!error log () -%!error log (1, 2) -*/ - -DEFUN (log10, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} log10 (@var{x})\n\ -Compute the base-10 logarithm of each element of @var{x}.\n\ -@seealso{log, log2, logspace, exp}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).log10 (); - else - print_usage (); - - return retval; -} - -/* -%!assert (log10 ([0.01, 0.1, 1, 10, 100]), [-2, -1, 0, 1, 2], sqrt (eps)) -%!assert (log10 (single ([0.01, 0.1, 1, 10, 100])), single ([-2, -1, 0, 1, 2]), sqrt (eps ("single"))) - -%!error log10 () -%!error log10 (1, 2) -*/ - -DEFUN (log1p, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} log1p (@var{x})\n\ -Compute\n\ -@tex\n\ -$\\ln{(1 + x)}$\n\ -@end tex\n\ -@ifnottex\n\ -@code{log (1 + @var{x})}\n\ -@end ifnottex\n\ -accurately in the neighborhood of zero.\n\ -@seealso{log, exp, expm1}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).log1p (); - else - print_usage (); - - return retval; -} - -/* -%!assert (log1p ([0, 2*eps, -2*eps]), [0, 2*eps, -2*eps], 1e-29) -%!assert (log1p (single ([0, 2*eps, -2*eps])), single ([0, 2*eps, -2*eps]), 1e-29) - -%!error log1p () -%!error log1p (1, 2) -*/ - -DEFUN (real, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} real (@var{z})\n\ -Return the real part of @var{z}.\n\ -@seealso{imag, conj}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).real (); - else - print_usage (); - - return retval; -} - -/* -%!assert (real (1), 1) -%!assert (real (i), 0) -%!assert (real (1+i), 1) -%!assert (real ([1, i; i, 1]), full (eye (2))) - -%!assert (real (single (1)), single (1)) -%!assert (real (single (i)), single (0)) -%!assert (real (single (1+i)), single (1)) -%!assert (real (single ([1, i; i, 1])), full (eye (2,"single"))) - -%!error real () -%!error real (1, 2) -*/ - -DEFUN (round, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} round (@var{x})\n\ -Return the integer nearest to @var{x}. If @var{x} is complex, return\n\ -@code{round (real (@var{x})) + round (imag (@var{x})) * I}. If there\n\ -are two nearest integers, return the one further away from zero.\n\ -\n\ -@example\n\ -@group\n\ -round ([-2.7, 2.7])\n\ - @result{} -3 3\n\ -@end group\n\ -@end example\n\ -@seealso{ceil, floor, fix, roundb}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).round (); - else - print_usage (); - - return retval; -} - -/* -%!assert (round (1), 1) -%!assert (round (1.1), 1) -%!assert (round (5.5), 6) -%!assert (round (i), i) -%!assert (round (2.5+3.5i), 3+4i) -%!assert (round (-2.6), -3) -%!assert (round ([1.1, -2.4; -3.7, 7.1]), [1, -2; -4, 7]) - -%!assert (round (single (1)), single (1)) -%!assert (round (single (1.1)), single (1)) -%!assert (round (single (5.5)), single (6)) -%!assert (round (single (i)), single (i)) -%!assert (round (single (2.5+3.5i)), single (3+4i)) -%!assert (round (single (-2.6)), single (-3)) -%!assert (round (single ([1.1, -2.4; -3.7, 7.1])), single ([1, -2; -4, 7])) - -%!error round () -%!error round (1, 2) -*/ - -DEFUN (roundb, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} roundb (@var{x})\n\ -Return the integer nearest to @var{x}. If there are two nearest\n\ -integers, return the even one (banker's rounding). If @var{x} is complex,\n\ -return @code{roundb (real (@var{x})) + roundb (imag (@var{x})) * I}.\n\ -@seealso{round}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).roundb (); - else - print_usage (); - - return retval; -} - -/* -%!assert (roundb (1), 1) -%!assert (roundb (1.1), 1) -%!assert (roundb (1.5), 2) -%!assert (roundb (4.5), 4) -%!assert (roundb (i), i) -%!assert (roundb (2.5+3.5i), 2+4i) -%!assert (roundb (-2.6), -3) -%!assert (roundb ([1.1, -2.4; -3.7, 7.1]), [1, -2; -4, 7]) - -%!assert (roundb (single (1)), single (1)) -%!assert (roundb (single (1.1)), single (1)) -%!assert (roundb (single (1.5)), single (2)) -%!assert (roundb (single (4.5)), single (4)) -%!assert (roundb (single (i)), single (i)) -%!assert (roundb (single (2.5+3.5i)), single (2+4i)) -%!assert (roundb (single (-2.6)), single (-3)) -%!assert (roundb (single ([1.1, -2.4; -3.7, 7.1])), single ([1, -2; -4, 7])) - -%!error roundb () -%!error roundb (1, 2) -*/ - -DEFUN (sign, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} sign (@var{x})\n\ -Compute the @dfn{signum} function, which is defined as\n\ -@tex\n\ -$$\n\ -{\\rm sign} (@var{x}) = \\cases{1,&$x>0$;\\cr 0,&$x=0$;\\cr -1,&$x<0$.\\cr}\n\ -$$\n\ -@end tex\n\ -@ifnottex\n\ -\n\ -@example\n\ -@group\n\ - -1, x < 0;\n\ -sign (x) = 0, x = 0;\n\ - 1, x > 0.\n\ -@end group\n\ -@end example\n\ -\n\ -@end ifnottex\n\ -\n\ -For complex arguments, @code{sign} returns @code{x ./ abs (@var{x})}.\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).signum (); - else - print_usage (); - - return retval; -} - -/* -%!assert (sign (-2) , -1) -%!assert (sign (0), 0) -%!assert (sign (3), 1) -%!assert (sign ([1, -pi; e, 0]), [1, -1; 1, 0]) - -%!assert (sign (single (-2)) , single (-1)) -%!assert (sign (single (0)), single (0)) -%!assert (sign (single (3)), single (1)) -%!assert (sign (single ([1, -pi; e, 0])), single ([1, -1; 1, 0])) - -%!error sign () -%!error sign (1, 2) -*/ - -DEFUN (sin, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} sin (@var{x})\n\ -Compute the sine for each element of @var{x} in radians.\n\ -@seealso{asin, sind, sinh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).sin (); - else - print_usage (); - - return retval; -} - -/* -%!shared rt2, rt3 -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); - -%!test -%! x = [0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]; -%! v = [0, 1/2, rt2/2, rt3/2, 1, rt3/2, rt2/2, 1/2, 0]; -%! assert (sin (x), v, sqrt (eps)); - -%!test -%! x = single ([0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]); -%! v = single ([0, 1/2, rt2/2, rt3/2, 1, rt3/2, rt2/2, 1/2, 0]); -%! assert (sin (x), v, sqrt (eps ("single"))); - -%!error sin () -%!error sin (1, 2) -*/ - -DEFUN (sinh, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} sinh (@var{x})\n\ -Compute the hyperbolic sine for each element of @var{x}.\n\ -@seealso{asinh, cosh, tanh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).sinh (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! x = [0, pi/2*i, pi*i, 3*pi/2*i]; -%! v = [0, i, 0, -i]; -%! assert (sinh (x), v, sqrt (eps)); - -%!test -%! x = single ([0, pi/2*i, pi*i, 3*pi/2*i]); -%! v = single ([0, i, 0, -i]); -%! assert (sinh (x), v, sqrt (eps ("single"))); - -%!error sinh () -%!error sinh (1, 2) -*/ - -DEFUN (sqrt, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} sqrt (@var{x})\n\ -Compute the square root of each element of @var{x}. If @var{x} is negative,\n\ -a complex result is returned. To compute the matrix square root, see\n\ -@ref{Linear Algebra}.\n\ -@seealso{realsqrt, nthroot}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).sqrt (); - else - print_usage (); - - return retval; -} - -/* -%!assert (sqrt (4), 2) -%!assert (sqrt (-1), i) -%!assert (sqrt (1+i), exp (0.5 * log (1+i)), sqrt (eps)) -%!assert (sqrt ([4, -4; i, 1-i]), [2, 2i; exp(0.5 * log (i)), exp(0.5 * log (1-i))], sqrt (eps)) - -%!assert (sqrt (single (4)), single (2)) -%!assert (sqrt (single (-1)), single (i)) -%!assert (sqrt (single (1+i)), single (exp (0.5 * log (1+i))), sqrt (eps ("single"))) -%!assert (sqrt (single ([4, -4; i, 1-i])), single ([2, 2i; exp(0.5 * log (i)), exp(0.5 * log (1-i))]), sqrt (eps ("single"))) - -%!error sqrt () -%!error sqrt (1, 2) -*/ - -DEFUN (tan, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} tan (@var{z})\n\ -Compute the tangent for each element of @var{x} in radians.\n\ -@seealso{atan, tand, tanh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).tan (); - else - print_usage (); - - return retval; -} - -/* -%!shared rt2, rt3 -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); - -%!test -%! x = [0, pi/6, pi/4, pi/3, 2*pi/3, 3*pi/4, 5*pi/6, pi]; -%! v = [0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]; -%! assert (tan (x), v, sqrt (eps)); - -%!test -%! x = single ([0, pi/6, pi/4, pi/3, 2*pi/3, 3*pi/4, 5*pi/6, pi]); -%! v = single ([0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]); -%! assert (tan (x), v, sqrt (eps ("single"))); - -%!error tan () -%!error tan (1, 2) -*/ - -DEFUN (tanh, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} tanh (@var{x})\n\ -Compute hyperbolic tangent for each element of @var{x}.\n\ -@seealso{atanh, sinh, cosh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).tanh (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! x = [0, pi*i]; -%! v = [0, 0]; -%! assert (tanh (x), v, sqrt (eps)); - -%!test -%! x = single ([0, pi*i]); -%! v = single ([0, 0]); -%! assert (tanh (x), v, sqrt (eps ("single"))); - -%!error tanh () -%!error tanh (1, 2) -*/ - -DEFUNX ("toascii", Ftoascii, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} toascii (@var{s})\n\ -Return ASCII representation of @var{s} in a matrix. For example:\n\ -\n\ -@example\n\ -@group\n\ -toascii (\"ASCII\")\n\ - @result{} [ 65, 83, 67, 73, 73 ]\n\ -@end group\n\ -\n\ -@end example\n\ -@seealso{char}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xtoascii (); - else - print_usage (); - - return retval; -} - -/* -%!assert (toascii (char (0:127)), 0:127) -%!assert (toascii (" ":"@"), 32:64) -%!assert (toascii ("A":"Z"), 65:90) -%!assert (toascii ("[":"`"), 91:96) -%!assert (toascii ("a":"z"), 97:122) -%!assert (toascii ("{":"~"), 123:126) - -%!error toascii () -%!error toascii (1, 2) -*/ - -DEFUNX ("tolower", Ftolower, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} tolower (@var{s})\n\ -@deftypefnx {Mapping Function} {} lower (@var{s})\n\ -Return a copy of the string or cell string @var{s}, with each uppercase\n\ -character replaced by the corresponding lowercase one; non-alphabetic\n\ -characters are left unchanged. For example:\n\ -\n\ -@example\n\ -@group\n\ -tolower (\"MiXeD cAsE 123\")\n\ - @result{} \"mixed case 123\"\n\ -@end group\n\ -@end example\n\ -@seealso{toupper}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xtolower (); - else - print_usage (); - - return retval; -} - -DEFALIAS (lower, tolower); - -/* -%!assert (tolower ("OCTAVE"), "octave") -%!assert (tolower ("123OCTave!_&"), "123octave!_&") -%!assert (tolower ({"ABC", "DEF", {"GHI", {"JKL"}}}), {"abc", "def", {"ghi", {"jkl"}}}) -%!assert (tolower (["ABC"; "DEF"]), ["abc"; "def"]) -%!assert (tolower ({["ABC"; "DEF"]}), {["abc";"def"]}) -%!assert (tolower (68), "d") -%!assert (tolower ({[68, 68; 68, 68]}), {["dd";"dd"]}) -%!test -%! a(3,3,3,3) = "D"; -%! assert (tolower (a)(3,3,3,3), "d"); - -%!test -%! charset = char (0:127); -%! result = charset; -%! result (toascii ("A":"Z") + 1) = result (toascii ("a":"z") + 1); -%! assert (tolower (charset), result); - -%!error <Invalid call to tolower> lower () -%!error <Invalid call to tolower> tolower () -%!error tolower (1, 2) -*/ - -DEFUNX ("toupper", Ftoupper, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} toupper (@var{s})\n\ -@deftypefnx {Mapping Function} {} upper (@var{s})\n\ -Return a copy of the string or cell string @var{s}, with each lowercase\n\ -character replaced by the corresponding uppercase one; non-alphabetic\n\ -characters are left unchanged. For example:\n\ -\n\ -@example\n\ -@group\n\ -toupper (\"MiXeD cAsE 123\")\n\ - @result{} \"MIXED CASE 123\"\n\ -@end group\n\ -@end example\n\ -@seealso{tolower}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xtoupper (); - else - print_usage (); - - return retval; -} - -DEFALIAS (upper, toupper); - -/* -%!assert (toupper ("octave"), "OCTAVE") -%!assert (toupper ("123OCTave!_&"), "123OCTAVE!_&") -%!assert (toupper ({"abc", "def", {"ghi", {"jkl"}}}), {"ABC", "DEF", {"GHI", {"JKL"}}}) -%!assert (toupper (["abc"; "def"]), ["ABC"; "DEF"]) -%!assert (toupper ({["abc"; "def"]}), {["ABC";"DEF"]}) -%!assert (toupper (100), "D") -%!assert (toupper ({[100, 100; 100, 100]}), {["DD";"DD"]}) -%!test -%! a(3,3,3,3) = "d"; -%! assert (toupper (a)(3,3,3,3), "D"); -%!test -%! charset = char (0:127); -%! result = charset; -%! result (toascii ("a":"z") + 1) = result (toascii ("A":"Z") + 1); -%! assert (toupper (charset), result); - -%!error <Invalid call to toupper> toupper () -%!error <Invalid call to toupper> upper () -%!error toupper (1, 2) -*/ - -DEFALIAS (gammaln, lgamma); - -DEFALIAS (finite, isfinite);
--- a/src/sparse.cc Tue Jul 31 20:39:08 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,268 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler -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 -<http://www.gnu.org/licenses/>. - -*/ - -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#include <cstdlib> -#include <string> - -#include "variables.h" -#include "utils.h" -#include "pager.h" -#include "defun.h" -#include "gripes.h" -#include "quit.h" -#include "unwind-prot.h" - -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" -#include "ov-bool-sparse.h" - -DEFUN (issparse, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} issparse (@var{x})\n\ -Return true if @var{x} is a sparse matrix.\n\ -@seealso{ismatrix}\n\ -@end deftypefn") -{ - if (args.length () != 1) - { - print_usage (); - return octave_value (); - } - else - return octave_value (args(0).is_sparse_type ()); -} - -DEFUN (sparse, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{s} =} sparse (@var{a})\n\ -@deftypefnx {Built-in Function} {@var{s} =} sparse (@var{i}, @var{j}, @var{sv}, @var{m}, @var{n}, @var{nzmax})\n\ -@deftypefnx {Built-in Function} {@var{s} =} sparse (@var{i}, @var{j}, @var{sv})\n\ -@deftypefnx {Built-in Function} {@var{s} =} sparse (@var{i}, @var{j}, @var{s}, @var{m}, @var{n}, \"unique\")\n\ -@deftypefnx {Built-in Function} {@var{s} =} sparse (@var{m}, @var{n})\n\ -Create a sparse matrix from the full matrix or row, column, value triplets.\n\ -If @var{a} is a full matrix, convert it to a sparse matrix representation,\n\ -removing all zero values in the process.\n\ -\n\ -Given the integer index vectors @var{i} and @var{j}, a 1-by-@code{nnz} vector\n\ -of real of complex values @var{sv}, overall dimensions @var{m} and @var{n}\n\ -of the sparse matrix. The argument @code{nzmax} is ignored but accepted for\n\ -compatibility with @sc{matlab}. If @var{m} or @var{n} are not specified\n\ -their values are derived from the maximum index in the vectors @var{i} and\n\ -@var{j} as given by @code{@var{m} = max (@var{i})},\n\ -@code{@var{n} = max (@var{j})}.\n\ -\n\ -@strong{Note}: if multiple values are specified with the same\n\ -@var{i}, @var{j} indices, the corresponding values in @var{s} will\n\ -be added. See @code{accumarray} for an example of how to produce different\n\ -behavior, such as taking the minimum instead.\n\ -\n\ -The following are all equivalent:\n\ -\n\ -@example\n\ -@group\n\ -s = sparse (i, j, s, m, n)\n\ -s = sparse (i, j, s, m, n, \"summation\")\n\ -s = sparse (i, j, s, m, n, \"sum\")\n\ -@end group\n\ -@end example\n\ -\n\ -Given the option \"unique\". if more than two values are specified for the\n\ -same @var{i}, @var{j} indices, the last specified value will be used.\n\ -\n\ -@code{sparse (@var{m}, @var{n})} is equivalent to\n\ -@code{sparse ([], [], [], @var{m}, @var{n}, 0)}\n\ -\n\ -If any of @var{sv}, @var{i} or @var{j} are scalars, they are expanded\n\ -to have a common size.\n\ -@seealso{full, accumarray}\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - - // Temporarily disable sparse_auto_mutate if set (it's obsolete anyway). - unwind_protect frame; - frame.protect_var (Vsparse_auto_mutate); - Vsparse_auto_mutate = false; - - if (nargin == 1) - { - octave_value arg = args (0); - if (arg.is_bool_type ()) - retval = arg.sparse_bool_matrix_value (); - else if (arg.is_complex_type ()) - retval = arg.sparse_complex_matrix_value (); - else if (arg.is_numeric_type ()) - retval = arg.sparse_matrix_value (); - else - gripe_wrong_type_arg ("sparse", arg); - } - else if (nargin == 2) - { - octave_idx_type m = 0, n = 0; - if (args(0).is_scalar_type () && args(1).is_scalar_type ()) - { - m = args(0).idx_type_value (); - n = args(1).idx_type_value (); - } - else - error ("sparse: dimensions M,N must be scalar"); - - if (! error_state) - { - if (m >= 0 && n >= 0) - retval = SparseMatrix (m, n); - else - error ("sparse: dimensions M,N must be positive or zero"); - } - } - else if (nargin >= 3) - { - bool summation = true; - if (nargin > 3 && args(nargin-1).is_string ()) - { - std::string opt = args(nargin-1).string_value (); - if (opt == "unique") - summation = false; - else if (opt == "sum" || opt == "summation") - summation = true; - else - error ("sparse: invalid option: %s", opt.c_str ()); - - nargin -= 1; - } - - if (! error_state) - { - octave_idx_type m = -1, n = -1, nzmax = -1; - if (nargin == 6) - { - nzmax = args(5).idx_type_value (); - nargin --; - } - - if (nargin == 5) - { - if (args(3).is_scalar_type () && args(4).is_scalar_type ()) - { - m = args(3).idx_type_value (); - n = args(4).idx_type_value (); - } - else - error ("sparse: expecting scalar dimensions"); - - - if (! error_state && (m < 0 || n < 0)) - error ("sparse: dimensions must be non-negative"); - } - else if (nargin != 3) - print_usage (); - - if (! error_state) - { - idx_vector i = args(0).index_vector (); - idx_vector j = args(1).index_vector (); - - if (args(2).is_bool_type ()) - retval = SparseBoolMatrix (args(2).bool_array_value (), i, j, - m, n, summation, nzmax); - else if (args(2).is_complex_type ()) - retval = SparseComplexMatrix (args(2).complex_array_value (), - i, j, m, n, summation, nzmax); - else if (args(2).is_numeric_type ()) - retval = SparseMatrix (args(2).array_value (), i, j, - m, n, summation, nzmax); - else - gripe_wrong_type_arg ("sparse", args(2)); - } - - } - } - - return retval; -} - -DEFUN (spalloc, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{s} =} spalloc (@var{m}, @var{n}, @var{nz})\n\ -Create an @var{m}-by-@var{n} sparse matrix with pre-allocated space for at\n\ -most @var{nz} nonzero elements. This is useful for building the matrix\n\ -incrementally by a sequence of indexed assignments. Subsequent indexed\n\ -assignments will reuse the pre-allocated memory, provided they are of one of\n\ -the simple forms\n\ -\n\ -@itemize\n\ -@item @code{@var{s}(I:J) = @var{x}}\n\ -\n\ -@item @code{@var{s}(:,I:J) = @var{x}}\n\ -\n\ -@item @code{@var{s}(K:L,I:J) = @var{x}}\n\ -@end itemize\n\ -\n\ -@b{and} that the following conditions are met:\n\ -\n\ -@itemize\n\ -@item the assignment does not decrease nnz (@var{S}).\n\ -\n\ -@item after the assignment, nnz (@var{S}) does not exceed @var{nz}.\n\ -\n\ -@item no index is out of bounds.\n\ -@end itemize\n\ -\n\ -Partial movement of data may still occur, but in general the assignment will\n\ -be more memory and time-efficient under these circumstances. In particular,\n\ -it is possible to efficiently build a pre-allocated sparse matrix from\n\ -contiguous block of columns.\n\ -\n\ -The amount of pre-allocated memory for a given matrix may be queried using\n\ -the function @code{nzmax}.\n\ -@seealso{nzmax, sparse}\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - - if (nargin == 2 || nargin == 3) - { - octave_idx_type m = args(0).idx_type_value (); - octave_idx_type n = args(1).idx_type_value (); - octave_idx_type nz = 0; - if (nargin == 3) - nz = args(2).idx_type_value (); - if (error_state) - ; - else if (m >= 0 && n >= 0 && nz >= 0) - retval = SparseMatrix (dim_vector (m, n), nz); - else - error ("spalloc: M,N,NZ must be non-negative"); - } - else - print_usage (); - - return retval; -}
--- a/src/strfns.cc Tue Jul 31 20:39:08 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,973 +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 -<http://www.gnu.org/licenses/>. - -*/ - -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#include <cctype> - -#include <queue> -#include <sstream> - -#include "dMatrix.h" - -#include "Cell.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "ov.h" -#include "oct-obj.h" -#include "unwind-prot.h" -#include "utils.h" - -DEFUN (char, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} char (@var{x})\n\ -@deftypefnx {Built-in Function} {} char (@var{x}, @dots{})\n\ -@deftypefnx {Built-in Function} {} char (@var{s1}, @var{s2}, @dots{})\n\ -@deftypefnx {Built-in Function} {} char (@var{cell_array})\n\ -Create a string array from one or more numeric matrices, character\n\ -matrices, or cell arrays. Arguments are concatenated vertically.\n\ -The returned values are padded with blanks as needed to make each row\n\ -of the string array have the same length. Empty input strings are\n\ -significant and will concatenated in the output.\n\ -\n\ -For numerical input, each element is converted\n\ -to the corresponding ASCII character. A range error results if an input\n\ -is outside the ASCII range (0-255).\n\ -\n\ -For cell arrays, each element is concatenated separately. Cell arrays\n\ -converted through\n\ -@code{char} can mostly be converted back with @code{cellstr}.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -char ([97, 98, 99], \"\", @{\"98\", \"99\", 100@}, \"str1\", [\"ha\", \"lf\"])\n\ - @result{} [\"abc \"\n\ - \" \"\n\ - \"98 \"\n\ - \"99 \"\n\ - \"d \"\n\ - \"str1 \"\n\ - \"half \"]\n\ -@end group\n\ -@end example\n\ -@seealso{strvcat, cellstr}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - retval = ""; - else if (nargin == 1) - retval = args(0).convert_to_str (true, true, - args(0).is_dq_string () ? '"' : '\''); - else - { - int n_elts = 0; - - int max_len = 0; - - std::queue<string_vector> args_as_strings; - - for (int i = 0; i < nargin; i++) - { - string_vector s = args(i).all_strings (); - - if (error_state) - { - error ("char: unable to convert some args to strings"); - return retval; - } - - if (s.length () > 0) - n_elts += s.length (); - else - n_elts += 1; - - int s_max_len = s.max_length (); - - if (s_max_len > max_len) - max_len = s_max_len; - - args_as_strings.push (s); - } - - string_vector result (n_elts); - - int k = 0; - - for (int i = 0; i < nargin; i++) - { - string_vector s = args_as_strings.front (); - args_as_strings.pop (); - - int n = s.length (); - - if (n > 0) - { - for (int j = 0; j < n; j++) - { - std::string t = s[j]; - int t_len = t.length (); - - if (max_len > t_len) - t += std::string (max_len - t_len, ' '); - - result[k++] = t; - } - } - else - result[k++] = std::string (max_len, ' '); - } - - retval = octave_value (result, '\''); - } - - return retval; -} - -/* -%!assert (char (), ''); -%!assert (char (100), "d"); -%!assert (char (100,100), ["d";"d"]) -%!assert (char ({100,100}), ["d";"d"]) -%!assert (char ([100,100]), ["dd"]) -%!assert (char ({100,{100}}), ["d";"d"]) -%!assert (char (100, [], 100), ["d";" ";"d"]) -%!assert (char ({100, [], 100}), ["d";" ";"d"]) -%!assert (char ({100,{100, {""}}}), ["d";"d";" "]) -%!assert (char (["a";"be"], {"c", 100}), ["a";"be";"c";"d"]) -%!assert (char ("a", "bb", "ccc"), ["a "; "bb "; "ccc"]) -%!assert (char ([65, 83, 67, 73, 73]), "ASCII") - -%!test -%! x = char ("foo", "bar", "foobar"); -%! assert (x(1,:), "foo "); -%! assert (x(2,:), "bar "); -%! assert (x(3,:), "foobar"); -*/ - -DEFUN (strvcat, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} strvcat (@var{x})\n\ -@deftypefnx {Built-in Function} {} strvcat (@var{x}, @dots{})\n\ -@deftypefnx {Built-in Function} {} strvcat (@var{s1}, @var{s2}, @dots{})\n\ -@deftypefnx {Built-in Function} {} strvcat (@var{cell_array})\n\ -Create a character array from one or more numeric matrices, character\n\ -matrices, or cell arrays. Arguments are concatenated vertically.\n\ -The returned values are padded with blanks as needed to make each row\n\ -of the string array have the same length. Unlike @code{char}, empty\n\ -strings are removed and will not appear in the output.\n\ -\n\ -For numerical input, each element is converted\n\ -to the corresponding ASCII character. A range error results if an input\n\ -is outside the ASCII range (0-255).\n\ -\n\ -For cell arrays, each element is concatenated separately. Cell arrays\n\ -converted through\n\ -@code{strvcat} can mostly be converted back with @code{cellstr}.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -strvcat ([97, 98, 99], \"\", @{\"98\", \"99\", 100@}, \"str1\", [\"ha\", \"lf\"])\n\ - @result{} [\"abc \"\n\ - \"98 \"\n\ - \"99 \"\n\ - \"d \"\n\ - \"str1 \"\n\ - \"half \"]\n\ -@end group\n\ -@end example\n\ -@seealso{char, strcat, cstrcat}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin > 0) - { - int n_elts = 0; - - size_t max_len = 0; - - std::queue<string_vector> args_as_strings; - - for (int i = 0; i < nargin; i++) - { - string_vector s = args(i).all_strings (); - - if (error_state) - { - error ("strvcat: unable to convert some args to strings"); - return retval; - } - - size_t n = s.length (); - - // do not count empty strings in calculation of number of elements - if (n > 0) - { - for (size_t j = 0; j < n; j++) - { - if (s[j].length () > 0) - n_elts++; - } - } - - size_t s_max_len = s.max_length (); - - if (s_max_len > max_len) - max_len = s_max_len; - - args_as_strings.push (s); - } - - string_vector result (n_elts); - - octave_idx_type k = 0; - - for (int i = 0; i < nargin; i++) - { - string_vector s = args_as_strings.front (); - args_as_strings.pop (); - - size_t n = s.length (); - - if (n > 0) - { - for (size_t j = 0; j < n; j++) - { - std::string t = s[j]; - if (t.length () > 0) - { - size_t t_len = t.length (); - - if (max_len > t_len) - t += std::string (max_len - t_len, ' '); - - result[k++] = t; - } - } - } - } - - retval = octave_value (result, '\''); - } - else - print_usage (); - - return retval; -} - -/* -%!assert (strvcat (""), ""); -%!assert (strvcat (100) == "d"); -%!assert (strvcat (100,100), ["d";"d"]) -%!assert (strvcat ({100,100}), ["d";"d"]) -%!assert (strvcat ([100,100]), ["dd"]) -%!assert (strvcat ({100,{100}}), ["d";"d"]) -%!assert (strvcat (100, [], 100), ["d";"d"]) -%!assert (strvcat ({100, [], 100}), ["d";"d"]) -%!assert (strvcat ({100,{100, {""}}}), ["d";"d"]) -%!assert (strvcat (["a";"be"], {"c", 100}), ["a";"be";"c";"d"]) -%!assert (strvcat ("a", "bb", "ccc"), ["a "; "bb "; "ccc"]) - -%!error strvcat () -*/ - - -DEFUN (ischar, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ischar (@var{x})\n\ -Return true if @var{x} is a character array.\n\ -@seealso{isfloat, isinteger, islogical, isnumeric, iscellstr, isa}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1 && args(0).is_defined ()) - retval = args(0).is_string (); - else - print_usage (); - - return retval; -} - -/* -%!assert (ischar ("a"), true) -%!assert (ischar (["ab";"cd"]), true) -%!assert (ischar ({"ab"}), false) -%!assert (ischar (1), false) -%!assert (ischar ([1, 2]), false) -%!assert (ischar ([]), false) -%!assert (ischar ([1, 2; 3, 4]), false) -%!assert (ischar (""), true) -%!assert (ischar ("test"), true) -%!assert (ischar (["test"; "ing"]), true) -%!assert (ischar (struct ("foo", "bar")), false) - -%!error ischar () -%!error ischar ("test", 1) -*/ - -static octave_value -do_strcmp_fun (const octave_value& arg0, const octave_value& arg1, - octave_idx_type n, const char *fcn_name, - bool (*array_op) (const charNDArray&, const charNDArray&, octave_idx_type), - bool (*str_op) (const std::string&, const std::string&, octave_idx_type)) - -{ - octave_value retval; - - bool s1_string = arg0.is_string (); - bool s1_cell = arg0.is_cell (); - bool s2_string = arg1.is_string (); - bool s2_cell = arg1.is_cell (); - - if (s1_string && s2_string) - retval = array_op (arg0.char_array_value (), arg1.char_array_value (), n); - else if ((s1_string && s2_cell) || (s1_cell && s2_string)) - { - octave_value str_val, cell_val; - - if (s1_string) - { - str_val = arg0; - cell_val = arg1; - } - else - { - str_val = arg1; - cell_val = arg0; - } - - const Cell cell = cell_val.cell_value (); - const string_vector str = str_val.all_strings (); - octave_idx_type r = str.length (); - - if (r == 0 || r == 1) - { - // Broadcast the string. - - boolNDArray output (cell_val.dims (), false); - - std::string s = r == 0 ? std::string () : str[0]; - - if (cell_val.is_cellstr ()) - { - const Array<std::string> cellstr = cell_val.cellstr_value (); - for (octave_idx_type i = 0; i < cellstr.length (); i++) - output(i) = str_op (cellstr(i), s, n); - } - else - { - // FIXME: should we warn here? - for (octave_idx_type i = 0; i < cell.length (); i++) - { - if (cell(i).is_string ()) - output(i) = str_op (cell(i).string_value (), s, n); - } - } - - retval = output; - } - else if (r > 1) - { - if (cell.length () == 1) - { - // Broadcast the cell. - - const dim_vector dv (r, 1); - boolNDArray output (dv, false); - - if (cell(0).is_string ()) - { - const std::string str2 = cell(0).string_value (); - - for (octave_idx_type i = 0; i < r; i++) - output(i) = str_op (str[i], str2, n); - } - - retval = output; - } - else - { - // Must match in all dimensions. - - boolNDArray output (cell.dims (), false); - - if (cell.length () == r) - { - if (cell_val.is_cellstr ()) - { - const Array<std::string> cellstr = cell_val.cellstr_value (); - for (octave_idx_type i = 0; i < cellstr.length (); i++) - output(i) = str_op (str[i], cellstr(i), n); - } - else - { - // FIXME: should we warn here? - for (octave_idx_type i = 0; i < r; i++) - { - if (cell(i).is_string ()) - output(i) = str_op (str[i], cell(i).string_value (), n); - } - } - - retval = output; - } - else - retval = false; - } - } - } - else if (s1_cell && s2_cell) - { - octave_value cell1_val, cell2_val; - octave_idx_type r1 = arg0.numel (), r2; - - if (r1 == 1) - { - // Make the singleton cell2. - - cell1_val = arg1; - cell2_val = arg0; - } - else - { - cell1_val = arg0; - cell2_val = arg1; - } - - const Cell cell1 = cell1_val.cell_value (); - const Cell cell2 = cell2_val.cell_value (); - r1 = cell1.numel (); - r2 = cell2.numel (); - - const dim_vector size1 = cell1.dims (); - const dim_vector size2 = cell2.dims (); - - boolNDArray output (size1, false); - - if (r2 == 1) - { - // Broadcast cell2. - - if (cell2(0).is_string ()) - { - const std::string str2 = cell2(0).string_value (); - - if (cell1_val.is_cellstr ()) - { - const Array<std::string> cellstr = cell1_val.cellstr_value (); - for (octave_idx_type i = 0; i < cellstr.length (); i++) - output(i) = str_op (cellstr(i), str2, n); - } - else - { - // FIXME: should we warn here? - for (octave_idx_type i = 0; i < r1; i++) - { - if (cell1(i).is_string ()) - { - const std::string str1 = cell1(i).string_value (); - output(i) = str_op (str1, str2, n); - } - } - } - } - } - else - { - if (size1 != size2) - { - error ("%s: nonconformant cell arrays", fcn_name); - return retval; - } - - if (cell1.is_cellstr () && cell2.is_cellstr ()) - { - const Array<std::string> cellstr1 = cell1_val.cellstr_value (); - const Array<std::string> cellstr2 = cell2_val.cellstr_value (); - for (octave_idx_type i = 0; i < r1; i++) - output (i) = str_op (cellstr1(i), cellstr2(i), n); - } - else - { - // FIXME: should we warn here? - for (octave_idx_type i = 0; i < r1; i++) - { - if (cell1(i).is_string () && cell2(i).is_string ()) - { - const std::string str1 = cell1(i).string_value (); - const std::string str2 = cell2(i).string_value (); - output(i) = str_op (str1, str2, n); - } - } - } - } - - retval = output; - } - else - retval = false; - - return retval; -} - -// If both args are arrays, dimensions may be significant. -static bool -strcmp_array_op (const charNDArray& s1, const charNDArray& s2, octave_idx_type) -{ - return (s1.dims () == s2.dims () - && std::equal (s1.data (), s1.data () + s1.numel (), s2.data ())); -} - -// Otherwise, just use strings. -static bool -strcmp_str_op (const std::string& s1, const std::string& s2, - octave_idx_type) -{ - return s1 == s2; -} - -DEFUN (strcmp, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} strcmp (@var{s1}, @var{s2})\n\ -Return 1 if the character strings @var{s1} and @var{s2} are the same,\n\ -and 0 otherwise.\n\ -\n\ -If either @var{s1} or @var{s2} is a cell array of strings, then an array\n\ -of the same size is returned, containing the values described above for\n\ -every member of the cell array. The other argument may also be a cell\n\ -array of strings (of the same size or with only one element), char matrix\n\ -or character string.\n\ -\n\ -@strong{Caution:} For compatibility with @sc{matlab}, Octave's strcmp\n\ -function returns 1 if the character strings are equal, and 0 otherwise.\n\ -This is just the opposite of the corresponding C library function.\n\ -@seealso{strcmpi, strncmp, strncmpi}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 2) - { - retval = do_strcmp_fun (args (0), args (1), 0, - "strcmp", strcmp_array_op, strcmp_str_op); - } - else - print_usage (); - - return retval; -} - -/* -%!shared x -%! x = char (zeros (0, 2)); -%!assert (strcmp ("", x), false) -%!assert (strcmp (x, ""), false) -%!assert (strcmp (x, x), true) -## %!assert (strcmp ({""}, x), true) -## %!assert (strcmp ({x}, ""), false) -## %!assert (strcmp ({x}, x), true) -## %!assert (strcmp ("", {x}), false) -## %!assert (strcmp (x, {""}), false) -## %!assert (strcmp (x, {x}), true) -## %!assert (strcmp ({x; x}, ""), [false; false]) -## %!assert (strcmp ({x; x}, {""}), [false; false]) -## %!assert (strcmp ("", {x; x}), [false; false]) -## %!assert (strcmp ({""}, {x; x}), [false; false]) -%!assert (strcmp ({"foo"}, x), false) -%!assert (strcmp ({"foo"}, "foo"), true) -%!assert (strcmp ({"foo"}, x), false) -%!assert (strcmp (x, {"foo"}), false) -%!assert (strcmp ("foo", {"foo"}), true) -%!assert (strcmp (x, {"foo"}), false) -%!shared y -%! y = char (zeros (2, 0)); -%!assert (strcmp ("", y), false) -%!assert (strcmp (y, ""), false) -%!assert (strcmp (y, y), true) -%!assert (strcmp ({""}, y), [true; true]) -%!assert (strcmp ({y}, ""), true) -%!assert (strcmp ({y}, y), [true; true]) -%!assert (strcmp ("", {y}), true) -%!assert (strcmp (y, {""}), [true; true]) -%!assert (strcmp (y, {y}), [true; true]) -%!assert (strcmp ({y; y}, ""), [true; true]) -%!assert (strcmp ({y; y}, {""}), [true; true]) -%!assert (strcmp ("", {y; y}), [true; true]) -%!assert (strcmp ({""}, {y; y}), [true; true]) -%!assert (strcmp ({"foo"}, y), [false; false]) -%!assert (strcmp ({"foo"}, y), [false; false]) -%!assert (strcmp (y, {"foo"}), [false; false]) -%!assert (strcmp (y, {"foo"}), [false; false]) -%!assert (strcmp ("foobar", "foobar"), true) -%!assert (strcmp ("fooba", "foobar"), false) - -%!error strcmp () -%!error strcmp ("foo", "bar", 3) -*/ - -// Apparently, Matlab ignores the dims with strncmp. It also -static bool -strncmp_array_op (const charNDArray& s1, const charNDArray& s2, octave_idx_type n) -{ - octave_idx_type l1 = s1.numel (), l2 = s2.numel (); - return (n > 0 && n <= l1 && n <= l2 - && std::equal (s1.data (), s1.data () + n, s2.data ())); -} - -// Otherwise, just use strings. Note that we neither extract substrings (which -// would mean a copy, at least in GCC), nor use string::compare (which is a -// 3-way compare). -static bool -strncmp_str_op (const std::string& s1, const std::string& s2, octave_idx_type n) -{ - octave_idx_type l1 = s1.length (), l2 = s2.length (); - return (n > 0 && n <= l1 && n <= l2 - && std::equal (s1.data (), s1.data () + n, s2.data ())); -} - -DEFUN (strncmp, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} strncmp (@var{s1}, @var{s2}, @var{n})\n\ -Return 1 if the first @var{n} characters of strings @var{s1} and @var{s2} are\n\ -the same, and 0 otherwise.\n\ -\n\ -@example\n\ -@group\n\ -strncmp (\"abce\", \"abcd\", 3)\n\ - @result{} 1\n\ -@end group\n\ -@end example\n\ -\n\ -If either @var{s1} or @var{s2} is a cell array of strings, then an array\n\ -of the same size is returned, containing the values described above for\n\ -every member of the cell array. The other argument may also be a cell\n\ -array of strings (of the same size or with only one element), char matrix\n\ -or character string.\n\ -\n\ -@example\n\ -@group\n\ -strncmp (\"abce\", @{\"abcd\", \"bca\", \"abc\"@}, 3)\n\ - @result{} [1, 0, 1]\n\ -@end group\n\ -@end example\n\ -\n\ -@strong{Caution:} For compatibility with @sc{matlab}, Octave's strncmp\n\ -function returns 1 if the character strings are equal, and 0 otherwise.\n\ -This is just the opposite of the corresponding C library function.\n\ -@seealso{strncmpi, strcmp, strcmpi}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 3) - { - octave_idx_type n = args(2).idx_type_value (); - - if (! error_state) - { - if (n > 0) - { - retval = do_strcmp_fun (args(0), args(1), n, "strncmp", - strncmp_array_op, strncmp_str_op); - } - else - error ("strncmp: N must be greater than 0"); - } - } - else - print_usage (); - - return retval; -} - -/* -%!assert (strncmp ("abce", "abc", 3), true) -%!assert (strncmp (100, 100, 1), false) -%!assert (strncmp ("abce", {"abcd", "bca", "abc"}, 3), logical ([1, 0, 1])) -%!assert (strncmp ("abc", {"abcd", "bca", "abc"}, 4), logical ([0, 0, 0])) -%!assert (strncmp ({"abcd", "bca", "abc"},"abce", 3), logical ([1, 0, 1])) -%!assert (strncmp ({"abcd", "bca", "abc"},{"abcd", "bca", "abe"}, 3), logical ([1, 1, 0])) -%!assert (strncmp ("abc", {"abcd", 10}, 2), logical ([1, 0])) - -%!error strncmp () -%!error strncmp ("abc", "def") -*/ - -// case-insensitive character equality functor -struct icmp_char_eq : public std::binary_function<char, char, bool> -{ - bool operator () (char x, char y) const - { return std::toupper (x) == std::toupper (y); } -}; - -// strcmpi is equivalent to strcmp in that it checks all dims. -static bool -strcmpi_array_op (const charNDArray& s1, const charNDArray& s2, octave_idx_type) -{ - return (s1.dims () == s2.dims () - && std::equal (s1.data (), s1.data () + s1.numel (), s2.data (), - icmp_char_eq ())); -} - -// Ditto for string. -static bool -strcmpi_str_op (const std::string& s1, const std::string& s2, - octave_idx_type) -{ - return (s1.size () == s2.size () - && std::equal (s1.data (), s1.data () + s1.size (), s2.data (), - icmp_char_eq ())); -} - -DEFUNX ("strcmpi", Fstrcmpi, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} strcmpi (@var{s1}, @var{s2})\n\ -Return 1 if the character strings @var{s1} and @var{s2} are the same,\n\ -disregarding case of alphabetic characters, and 0 otherwise.\n\ -\n\ -If either @var{s1} or @var{s2} is a cell array of strings, then an array\n\ -of the same size is returned, containing the values described above for\n\ -every member of the cell array. The other argument may also be a cell\n\ -array of strings (of the same size or with only one element), char matrix\n\ -or character string.\n\ -\n\ -@strong{Caution:} For compatibility with @sc{matlab}, Octave's strcmp\n\ -function returns 1 if the character strings are equal, and 0 otherwise.\n\ -This is just the opposite of the corresponding C library function.\n\ -\n\ -@strong{Caution:} National alphabets are not supported.\n\ -@seealso{strcmp, strncmp, strncmpi}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 2) - { - retval = do_strcmp_fun (args (0), args (1), 0, - "strcmpi", strcmpi_array_op, strcmpi_str_op); - } - else - print_usage (); - - return retval; -} - -/* -%!assert (strcmpi ("abc123", "ABC123"), true) -*/ - -// Like strncmp. -static bool -strncmpi_array_op (const charNDArray& s1, const charNDArray& s2, octave_idx_type n) -{ - octave_idx_type l1 = s1.numel (), l2 = s2.numel (); - return (n > 0 && n <= l1 && n <= l2 - && std::equal (s1.data (), s1.data () + n, s2.data (), - icmp_char_eq ())); -} - -// Ditto. -static bool -strncmpi_str_op (const std::string& s1, const std::string& s2, octave_idx_type n) -{ - octave_idx_type l1 = s1.length (), l2 = s2.length (); - return (n > 0 && n <= l1 && n <= l2 - && std::equal (s1.data (), s1.data () + n, s2.data (), - icmp_char_eq ())); -} - -DEFUNX ("strncmpi", Fstrncmpi, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} strncmpi (@var{s1}, @var{s2}, @var{n})\n\ -Return 1 if the first @var{n} character of @var{s1} and @var{s2} are the\n\ -same, disregarding case of alphabetic characters, and 0 otherwise.\n\ -\n\ -If either @var{s1} or @var{s2} is a cell array of strings, then an array\n\ -of the same size is returned, containing the values described above for\n\ -every member of the cell array. The other argument may also be a cell\n\ -array of strings (of the same size or with only one element), char matrix\n\ -or character string.\n\ -\n\ -@strong{Caution:} For compatibility with @sc{matlab}, Octave's strncmpi\n\ -function returns 1 if the character strings are equal, and 0 otherwise.\n\ -This is just the opposite of the corresponding C library function.\n\ -\n\ -@strong{Caution:} National alphabets are not supported.\n\ -@seealso{strncmp, strcmp, strcmpi}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 3) - { - octave_idx_type n = args(2).idx_type_value (); - - if (! error_state) - { - if (n > 0) - { - retval = do_strcmp_fun (args(0), args(1), n, "strncmpi", - strncmpi_array_op, strncmpi_str_op); - } - else - error ("strncmpi: N must be greater than 0"); - } - } - else - print_usage (); - - return retval; -} - -/* -%!assert (strncmpi ("abc123", "ABC456", 3), true) -*/ - -DEFUN (list_in_columns, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} list_in_columns (@var{arg}, @var{width}, @var{prefix})\n\ -Return a string containing the elements of @var{arg} listed in\n\ -columns with an overall maximum width of @var{width} and optional\n\ -prefix @var{prefix}. The argument @var{arg} must be a cell array\n\ -of character strings or a character array. If @var{width} is not\n\ -specified or is an empty matrix, or less than or equal to zero,\n\ -the width of the terminal screen is used.\n\ -Newline characters are used to break the lines in the output string.\n\ -For example:\n\ -@c Set example in small font to prevent overfull line\n\ -\n\ -@smallexample\n\ -@group\n\ -list_in_columns (@{\"abc\", \"def\", \"ghijkl\", \"mnop\", \"qrs\", \"tuv\"@}, 20)\n\ - @result{} abc mnop\n\ - def qrs\n\ - ghijkl tuv\n\ -\n\ -whos ans\n\ - @result{}\n\ - Variables in the current scope:\n\ -\n\ - Attr Name Size Bytes Class\n\ - ==== ==== ==== ===== =====\n\ - ans 1x37 37 char\n\ -\n\ - Total is 37 elements using 37 bytes\n\ -@end group\n\ -@end smallexample\n\ -\n\ -@seealso{terminal_size}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin < 1 || nargin > 3) - { - print_usage (); - return retval; - } - - string_vector s = args(0).all_strings (); - - if (error_state) - { - error ("list_in_columns: expecting cellstr or char array"); - return retval; - } - - int width = -1; - - if (nargin > 1 && ! args(1).is_empty ()) - { - width = args(1).int_value (); - - if (error_state) - { - error ("list_in_columns: WIDTH must be an integer"); - return retval; - } - } - - std::string prefix; - - if (nargin > 2) - { - if (args(2).is_string ()) - { - prefix = args(2).string_value (); - - if (error_state) - { - error ("list_in_columns: PREFIX must be a character string"); - return retval; - } - } - else - { - error ("list_in_columns: PREFIX must be a character string"); - return retval; - } - } - - std::ostringstream buf; - - s.list_in_columns (buf, width, prefix); - - retval = buf.str (); - - return retval; -} - -/* -%!test -%! input = {"abc", "def", "ghijkl", "mnop", "qrs", "tuv"}; -%! result = "abc mnop\ndef qrs\nghijkl tuv\n"; -%! assert (list_in_columns (input, 20), result); -%!test -%! input = ["abc"; "def"; "ghijkl"; "mnop"; "qrs"; "tuv"]; -%! result = "abc mnop \ndef qrs \nghijkl tuv \n"; -%! assert (list_in_columns (input, 20), result); -%!test -%! input = ["abc"; "def"; "ghijkl"; "mnop"; "qrs"; "tuv"]; -%! result = " abc mnop \n def qrs \n ghijkl tuv \n"; -%! assert (list_in_columns (input, 20, " "), result); - -%!error list_in_columns () -%!error list_in_columns (["abc", "def"], 20, 2) -%!error list_in_columns (["abc", "def"], 20, " ", 3) -%!error <invalid conversion from string to real scalar> list_in_columns (["abc", "def"], "a") -*/
--- a/src/syscalls.cc Tue Jul 31 20:39:08 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1943 +0,0 @@ -/* - -Copyright (C) 1996-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 -<http://www.gnu.org/licenses/>. - -*/ - -// Thomas Baier <baier@ci.tuwien.ac.at> added the original versions of -// the following functions: -// -// mkfifo unlink waitpid - -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#include <cstdio> -#include <cstring> - -#include <sys/types.h> -#include <unistd.h> - -#include <fcntl.h> - -#include "file-ops.h" -#include "file-stat.h" -#include "oct-env.h" -#include "oct-syscalls.h" -#include "oct-uname.h" - -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "lo-utils.h" -#include "oct-map.h" -#include "oct-obj.h" -#include "oct-stdstrm.h" -#include "oct-stream.h" -#include "sysdep.h" -#include "utils.h" -#include "variables.h" -#include "input.h" - -static octave_scalar_map -mk_stat_map (const base_file_stat& fs) -{ - octave_scalar_map m; - - m.assign ("dev", static_cast<double> (fs.dev ())); - m.assign ("ino", fs.ino ()); - m.assign ("mode", fs.mode ()); - m.assign ("modestr", fs.mode_as_string ()); - m.assign ("nlink", fs.nlink ()); - m.assign ("uid", fs.uid ()); - m.assign ("gid", fs.gid ()); -#if defined (HAVE_STRUCT_STAT_ST_RDEV) - m.assign ("rdev", static_cast<double> (fs.rdev ())); -#endif - m.assign ("size", fs.size ()); - m.assign ("atime", fs.atime ()); - m.assign ("mtime", fs.mtime ()); - m.assign ("ctime", fs.ctime ()); -#if defined (HAVE_STRUCT_STAT_ST_BLKSIZE) - m.assign ("blksize", fs.blksize ()); -#endif -#if defined (HAVE_STRUCT_STAT_ST_BLOCKS) - m.assign ("blocks", fs.blocks ()); -#endif - - return m; -} - -static octave_value_list -mk_stat_result (const base_file_stat& fs) -{ - octave_value_list retval; - - if (fs) - { - retval(2) = std::string (); - retval(1) = 0; - retval(0) = octave_value (mk_stat_map (fs)); - } - else - { - retval(2) = fs.error (); - retval(1) = -1; - retval(0) = Matrix (); - } - - return retval; -} - -DEFUNX ("dup2", Fdup2, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{fid}, @var{msg}] =} dup2 (@var{old}, @var{new})\n\ -Duplicate a file descriptor.\n\ -\n\ -If successful, @var{fid} is greater than zero and contains the new file\n\ -ID@. Otherwise, @var{fid} is negative and @var{msg} contains a\n\ -system-dependent error message.\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 2) - { - octave_stream old_stream - = octave_stream_list::lookup (args(0), "dup2"); - - if (! error_state) - { - octave_stream new_stream - = octave_stream_list::lookup (args(1), "dup2"); - - if (! error_state) - { - int i_old = old_stream.file_number (); - int i_new = new_stream.file_number (); - - if (i_old >= 0 && i_new >= 0) - { - std::string msg; - - int status = octave_syscalls::dup2 (i_old, i_new, msg); - - retval(1) = msg; - retval(0) = status; - } - } - } - else - error ("dup2: invalid stream"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("exec", Fexec, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} exec (@var{file}, @var{args})\n\ -Replace current process with a new process. Calling @code{exec} without\n\ -first calling @code{fork} will terminate your current Octave process and\n\ -replace it with the program named by @var{file}. For example,\n\ -\n\ -@example\n\ -exec (\"ls\" \"-l\")\n\ -@end example\n\ -\n\ -@noindent\n\ -will run @code{ls} and return you to your shell prompt.\n\ -\n\ -If successful, @code{exec} does not return. If @code{exec} does return,\n\ -@var{err} will be nonzero, and @var{msg} will contain a system-dependent\n\ -error message.\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - std::string exec_file = args(0).string_value (); - - if (! error_state) - { - string_vector exec_args; - - if (nargin == 2) - { - string_vector tmp = args(1).all_strings (); - - if (! error_state) - { - int len = tmp.length (); - - exec_args.resize (len + 1); - - exec_args[0] = exec_file; - - for (int i = 0; i < len; i++) - exec_args[i+1] = tmp[i]; - } - else - error ("exec: arguments must be character strings"); - } - else - { - exec_args.resize (1); - - exec_args[0] = exec_file; - } - - if (! error_state) - { - std::string msg; - - int status = octave_syscalls::execvp (exec_file, exec_args, msg); - - retval(1) = msg; - retval(0) = status; - } - } - else - error ("exec: FILE must be a string"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("popen2", Fpopen2, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{in}, @var{out}, @var{pid}] =} popen2 (@var{command}, @var{args})\n\ -Start a subprocess with two-way communication. The name of the process\n\ -is given by @var{command}, and @var{args} is an array of strings\n\ -containing options for the command. The file identifiers for the input\n\ -and output streams of the subprocess are returned in @var{in} and\n\ -@var{out}. If execution of the command is successful, @var{pid}\n\ -contains the process ID of the subprocess. Otherwise, @var{pid} is\n\ -@minus{}1.\n\ -\n\ -For example:\n\ -\n\ -@example\n\ -[in, out, pid] = popen2 (\"sort\", \"-r\");\n\ -fputs (in, \"these\\nare\\nsome\\nstrings\\n\");\n\ -fclose (in);\n\ -EAGAIN = errno (\"EAGAIN\");\n\ -done = false;\n\ -do\n\ - s = fgets (out);\n\ - if (ischar (s))\n\ - fputs (stdout, s);\n\ - elseif (errno () == EAGAIN)\n\ - sleep (0.1);\n\ - fclear (out);\n\ - else\n\ - done = true;\n\ - endif\n\ -until (done)\n\ -fclose (out);\n\ -waitpid (pid);\n\ -\n\ - @print{} these\n\ - @print{} strings\n\ - @print{} some\n\ - @print{} are\n\ -@end example\n\ -\n\ -Note that @code{popen2}, unlike @code{popen}, will not \"reap\" the\n\ -child process. If you don't use @code{waitpid} to check the child's\n\ -exit status, it will linger until Octave exits.\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(2) = -1; - retval(1) = Matrix (); - retval(0) = Matrix (); - - int nargin = args.length (); - - if (nargin >= 1 && nargin <= 3) - { - std::string exec_file = args(0).string_value (); - - if (! error_state) - { - string_vector arg_list; - - if (nargin >= 2) - { - string_vector tmp = args(1).all_strings (); - - if (! error_state) - { - int len = tmp.length (); - - arg_list.resize (len + 1); - - arg_list[0] = exec_file; - - for (int i = 0; i < len; i++) - arg_list[i+1] = tmp[i]; - } - else - error ("popen2: arguments must be character strings"); - } - else - { - arg_list.resize (1); - - arg_list[0] = exec_file; - } - - if (! error_state) - { - bool sync_mode = (nargin == 3 ? args(2).bool_value () : false); - - if (! error_state) - { - int fildes[2]; - std::string msg; - pid_t pid; - - pid = octave_syscalls::popen2 (exec_file, arg_list, sync_mode, fildes, msg, interactive); - if (pid >= 0) - { - FILE *ifile = fdopen (fildes[1], "r"); - FILE *ofile = fdopen (fildes[0], "w"); - - std::string nm; - - octave_stream is = octave_stdiostream::create (nm, ifile, - std::ios::in); - - octave_stream os = octave_stdiostream::create (nm, ofile, - std::ios::out); - - Cell file_ids (1, 2); - - retval(2) = pid; - retval(1) = octave_stream_list::insert (is); - retval(0) = octave_stream_list::insert (os); - } - else - error (msg.c_str ()); - } - } - else - error ("popen2: arguments must be character strings"); - } - else - error ("popen2: COMMAND argument must be a string"); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! if (isunix ()) -%! [in, out, pid] = popen2 ("sort", "-r"); -%! EAGAIN = errno ("EAGAIN"); -%! else -%! [in, out, pid] = popen2 ("sort", "/R"); -%! EAGAIN = errno ("EINVAL"); -%! endif -%! fputs (in, "these\nare\nsome\nstrings\n"); -%! fclose (in); -%! done = false; -%! str = {}; -%! idx = 0; -%! errs = 0; -%! do -%! if (!isunix ()) -%! errno (0); -%! endif -%! s = fgets (out); -%! if (ischar (s)) -%! idx++; -%! str{idx} = s; -%! elseif (errno () == EAGAIN) -%! fclear (out); -%! sleep (0.1); -%! if (++errs == 100) -%! done = true; -%! endif -%! else -%! done = true; -%! endif -%! until (done) -%! fclose (out); -%! if (isunix ()) -%! assert (str, {"these\n","strings\n","some\n","are\n"}); -%! else -%! assert (str, {"these\r\n","strings\r\n","some\r\n","are\r\n"}); -%! endif -*/ - -DEFUNX ("fcntl", Ffcntl, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} fcntl (@var{fid}, @var{request}, @var{arg})\n\ -Change the properties of the open file @var{fid}. The following values\n\ -may be passed as @var{request}:\n\ -\n\ -@vtable @code\n\ -@item F_DUPFD\n\ -Return a duplicate file descriptor.\n\ -\n\ -@item F_GETFD\n\ -Return the file descriptor flags for @var{fid}.\n\ -\n\ -@item F_SETFD\n\ -Set the file descriptor flags for @var{fid}.\n\ -\n\ -@item F_GETFL\n\ -Return the file status flags for @var{fid}. The following codes may be\n\ -returned (some of the flags may be undefined on some systems).\n\ -\n\ -@vtable @code\n\ -@item O_RDONLY\n\ -Open for reading only.\n\ -\n\ -@item O_WRONLY\n\ -Open for writing only.\n\ -\n\ -@item O_RDWR\n\ -Open for reading and writing.\n\ -\n\ -@item O_APPEND\n\ -Append on each write.\n\ -\n\ -@item O_CREAT\n\ -Create the file if it does not exist.\n\ -\n\ -@item O_NONBLOCK\n\ -Non-blocking mode.\n\ -\n\ -@item O_SYNC\n\ -Wait for writes to complete.\n\ -\n\ -@item O_ASYNC\n\ -Asynchronous I/O.\n\ -@end vtable\n\ -\n\ -@item F_SETFL\n\ -Set the file status flags for @var{fid} to the value specified by\n\ -@var{arg}. The only flags that can be changed are @w{@code{O_APPEND}} and\n\ -@w{@code{O_NONBLOCK}}.\n\ -@end vtable\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\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 3) - { - octave_stream strm = octave_stream_list::lookup (args (0), "fcntl"); - - if (! error_state) - { - int fid = strm.file_number (); - - int req = args(1).int_value (true); - int arg = args(2).int_value (true); - - if (! error_state) - { - // FIXME -- Need better checking here? - if (fid < 0) - error ("fcntl: invalid file id"); - else - { - std::string msg; - - int status = octave_fcntl (fid, req, arg, msg); - - retval(1) = msg; - retval(0) = status; - } - } - } - else - error ("fcntl: FID, REQUEST, and ARG must be integers"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("fork", Ffork, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{pid}, @var{msg}] =} fork ()\n\ -Create a copy of the current process.\n\ -\n\ -Fork can return one of the following values:\n\ -\n\ -@table @asis\n\ -@item > 0\n\ -You are in the parent process. The value returned from @code{fork} is\n\ -the process id of the child process. You should probably arrange to\n\ -wait for any child processes to exit.\n\ -\n\ -@item 0\n\ -You are in the child process. You can call @code{exec} to start another\n\ -process. If that fails, you should probably call @code{exit}.\n\ -\n\ -@item < 0\n\ -The call to @code{fork} failed for some reason. You must take evasive\n\ -action. A system dependent error message will be waiting in @var{msg}.\n\ -@end table\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 0) - { - std::string msg; - - pid_t pid = octave_syscalls::fork (msg); - - retval(1) = msg; - retval(0) = pid; - } - else - print_usage (); - - return retval; -} - -DEFUNX ("getpgrp", Fgetpgrp, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {pgid =} getpgrp ()\n\ -Return the process group id of the current process.\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 0) - { - std::string msg; - - retval(1) = msg; - retval(0) = octave_syscalls::getpgrp (msg); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("getpid", Fgetpid, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {pid =} getpid ()\n\ -Return the process id of the current process.\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 0) - retval = octave_syscalls::getpid (); - else - print_usage (); - - return retval; -} - -DEFUNX ("getppid", Fgetppid, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {pid =} getppid ()\n\ -Return the process id of the parent process.\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 0) - retval = octave_syscalls::getppid (); - else - print_usage (); - - return retval; -} - -DEFUNX ("getegid", Fgetegid, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {egid =} getegid ()\n\ -Return the effective group id of the current process.\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 0) - retval = octave_syscalls::getegid (); - else - print_usage (); - - return retval; -} - -DEFUNX ("getgid", Fgetgid, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {gid =} getgid ()\n\ -Return the real group id of the current process.\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 0) - retval = octave_syscalls::getgid (); - else - print_usage (); - - return retval; -} - -DEFUNX ("geteuid", Fgeteuid, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {euid =} geteuid ()\n\ -Return the effective user id of the current process.\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 0) - retval = octave_syscalls::geteuid (); - else - print_usage (); - - return retval; -} - -DEFUNX ("getuid", Fgetuid, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {uid =} getuid ()\n\ -Return the real user id of the current process.\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 0) - retval = octave_syscalls::getuid (); - else - print_usage (); - - return retval; -} - -DEFUNX ("kill", Fkill, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} kill (@var{pid}, @var{sig})\n\ -Send signal @var{sig} to process @var{pid}.\n\ -\n\ -If @var{pid} is positive, then signal @var{sig} is sent to @var{pid}.\n\ -\n\ -If @var{pid} is 0, then signal @var{sig} is sent to every process\n\ -in the process group of the current process.\n\ -\n\ -If @var{pid} is -1, then signal @var{sig} is sent to every process\n\ -except process 1.\n\ -\n\ -If @var{pid} is less than -1, then signal @var{sig} is sent to every\n\ -process in the process group @var{-pid}.\n\ -\n\ -If @var{sig} is 0, then no signal is sent, but error checking is still\n\ -performed.\n\ -\n\ -Return 0 if successful, otherwise return -1.\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - if (args.length () == 2) - { - pid_t pid = args(0).int_value (true); - - if (! error_state) - { - int sig = args(1).int_value (true); - - if (! error_state) - { - std::string msg; - - int status = octave_syscalls::kill (pid, sig, msg); - - retval(1) = msg; - retval(0) = status; - } - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("lstat", Flstat, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} lstat (@var{symlink})\n\ -Return a structure @var{info} containing information about the symbolic link\n\ -@var{symlink}. The function outputs are described in the documentation for\n\ -@code{stat}.\n\ -@seealso{stat}\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - std::string fname = args(0).string_value (); - - if (! error_state) - { - file_stat fs (fname, false); - - retval = mk_stat_result (fs); - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("mkfifo", Fmkfifo, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} mkfifo (@var{name}, @var{mode})\n\ -Create a @var{fifo} special file named @var{name} with file mode @var{mode}\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\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 2) - { - if (args(0).is_string ()) - { - std::string name = args(0).string_value (); - - if (args(1).is_scalar_type ()) - { - long mode = args(1).long_value (); - - if (! error_state) - { - std::string msg; - - int status = octave_mkfifo (name, mode, msg); - - retval(0) = status; - - if (status < 0) - retval(1) = msg; - } - else - error ("mkfifo: invalid MODE"); - } - else - error ("mkfifo: MODE must be an integer"); - } - else - error ("mkfifo: FILE must be a string"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("pipe", Fpipe, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{read_fd}, @var{write_fd}, @var{err}, @var{msg}] =} pipe ()\n\ -Create a pipe and return the reading and writing ends of the pipe\n\ -into @var{read_fd} and @var{write_fd} respectively.\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\ -@end deftypefn") -{ - octave_value_list retval; - - retval(3) = std::string (); - retval(2) = -1; - retval(1) = -1; - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 0) - { - int fid[2]; - - std::string msg; - - int status = octave_syscalls::pipe (fid, msg); - - if (status < 0) - retval(3) = msg; - else - { - FILE *ifile = fdopen (fid[0], "r"); - FILE *ofile = fdopen (fid[1], "w"); - - std::string nm; - - octave_stream is = octave_stdiostream::create (nm, ifile, - std::ios::in); - - octave_stream os = octave_stdiostream::create (nm, ofile, - std::ios::out); - - retval(2) = status; - retval(1) = octave_stream_list::insert (os); - retval(0) = octave_stream_list::insert (is); - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("stat", Fstat, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} stat (@var{file})\n\ -@deftypefnx {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} stat (@var{fid})\n\ -@deftypefnx {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} lstat (@var{file})\n\ -@deftypefnx {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} lstat (@var{fid})\n\ -Return a structure @var{info} containing the following information about\n\ -@var{file} or file identifier @var{fid}.\n\ -\n\ -@table @code\n\ -@item dev\n\ -ID of device containing a directory entry for this file.\n\ -\n\ -@item ino\n\ -File number of the file.\n\ -\n\ -@item mode\n\ -File mode, as an integer. Use the functions @w{@code{S_ISREG}},\n\ -@w{@code{S_ISDIR}}, @w{@code{S_ISCHR}}, @w{@code{S_ISBLK}}, @w{@code{S_ISFIFO}},\n\ -@w{@code{S_ISLNK}}, or @w{@code{S_ISSOCK}} to extract information from this\n\ -value.\n\ -\n\ -@item modestr\n\ -File mode, as a string of ten letters or dashes as would be returned by\n\ -@kbd{ls -l}.\n\ -\n\ -@item nlink\n\ -Number of links.\n\ -\n\ -@item uid\n\ -User ID of file's owner.\n\ -\n\ -@item gid\n\ -Group ID of file's group.\n\ -\n\ -@item rdev\n\ -ID of device for block or character special files.\n\ -\n\ -@item size\n\ -Size in bytes.\n\ -\n\ -@item atime\n\ -Time of last access in the same form as time values returned from\n\ -@code{time}. @xref{Timing Utilities}.\n\ -\n\ -@item mtime\n\ -Time of last modification in the same form as time values returned from\n\ -@code{time}. @xref{Timing Utilities}.\n\ -\n\ -@item ctime\n\ -Time of last file status change in the same form as time values\n\ -returned from @code{time}. @xref{Timing Utilities}.\n\ -\n\ -@item blksize\n\ -Size of blocks in the file.\n\ -\n\ -@item blocks\n\ -Number of blocks allocated for file.\n\ -@end table\n\ -\n\ -If the call is successful @var{err} is 0 and @var{msg} is an empty\n\ -string. If the file does not exist, or some other error occurs, @var{info}\n\ -is an empty matrix, @var{err} is @minus{}1, and @var{msg} contains the\n\ -corresponding system error message.\n\ -\n\ -If @var{file} is a symbolic link, @code{stat} will return information\n\ -about the actual file that is referenced by the link. Use @code{lstat}\n\ -if you want information about the symbolic link itself.\n\ -\n\ -For example:\n\ -\n\ -@example\n\ -[info, err, msg] = stat (\"/vmlinuz\")\n\ - @result{} info =\n\ - @{\n\ - atime = 855399756\n\ - rdev = 0\n\ - ctime = 847219094\n\ - uid = 0\n\ - size = 389218\n\ - blksize = 4096\n\ - mtime = 847219094\n\ - gid = 6\n\ - nlink = 1\n\ - blocks = 768\n\ - mode = -rw-r--r--\n\ - modestr = -rw-r--r--\n\ - ino = 9316\n\ - dev = 2049\n\ - @}\n\ - @result{} err = 0\n\ - @result{} msg =\n\ -@end example\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - if (args(0).is_scalar_type ()) - { - int fid = octave_stream_list::get_file_number (args(0)); - - if (! error_state) - { - file_fstat fs (fid); - - retval = mk_stat_result (fs); - } - } - else - { - std::string fname = args(0).string_value (); - - if (! error_state) - { - file_stat fs (fname); - - retval = mk_stat_result (fs); - } - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("S_ISREG", FS_ISREG, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} S_ISREG (@var{mode})\n\ -Return true if @var{mode} corresponds to a regular file. The value\n\ -of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ -@seealso{stat, lstat}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - { - double mode = args(0).double_value (); - - if (! error_state) - retval = file_stat::is_reg (static_cast<mode_t> (mode)); - else - error ("S_ISREG: invalid MODE value"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("S_ISDIR", FS_ISDIR, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} S_ISDIR (@var{mode})\n\ -Return true if @var{mode} corresponds to a directory. The value\n\ -of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ -@seealso{stat, lstat}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - { - double mode = args(0).double_value (); - - if (! error_state) - retval = file_stat::is_dir (static_cast<mode_t> (mode)); - else - error ("S_ISDIR: invalid MODE value"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("S_ISCHR", FS_ISCHR, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} S_ISCHR (@var{mode})\n\ -Return true if @var{mode} corresponds to a character device. The value\n\ -of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ -@seealso{stat, lstat}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - { - double mode = args(0).double_value (); - - if (! error_state) - retval = file_stat::is_chr (static_cast<mode_t> (mode)); - else - error ("S_ISCHR: invalid MODE value"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("S_ISBLK", FS_ISBLK, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} S_ISBLK (@var{mode})\n\ -Return true if @var{mode} corresponds to a block device. The value\n\ -of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ -@seealso{stat, lstat}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - { - double mode = args(0).double_value (); - - if (! error_state) - retval = file_stat::is_blk (static_cast<mode_t> (mode)); - else - error ("S_ISBLK: invalid MODE value"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("S_ISFIFO", FS_ISFIFO, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} S_ISFIFO (@var{mode})\n\ -Return true if @var{mode} corresponds to a fifo. The value\n\ -of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ -@seealso{stat, lstat}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - { - double mode = args(0).double_value (); - - if (! error_state) - retval = file_stat::is_fifo (static_cast<mode_t> (mode)); - else - error ("S_ISFIFO: invalid MODE value"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("S_ISLNK", FS_ISLNK, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} S_ISLNK (@var{mode})\n\ -Return true if @var{mode} corresponds to a symbolic link. The value\n\ -of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ -@seealso{stat, lstat}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - { - double mode = args(0).double_value (); - - if (! error_state) - retval = file_stat::is_lnk (static_cast<mode_t> (mode)); - else - error ("S_ISLNK: invalid MODE value"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("S_ISSOCK", FS_ISSOCK, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} S_ISSOCK (@var{mode})\n\ -Return true if @var{mode} corresponds to a socket. The value\n\ -of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ -@seealso{stat, lstat}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - { - double mode = args(0).double_value (); - - if (! error_state) - retval = file_stat::is_sock (static_cast<mode_t> (mode)); - else - error ("S_ISSOCK: invalid MODE value"); - } - else - print_usage (); - - return retval; -} - -DEFUN (gethostname, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} gethostname ()\n\ -Return the hostname of the system where Octave is running.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 0) - retval = octave_env::get_host_name (); - else - print_usage (); - - return retval; -} - -DEFUN (uname, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{uts}, @var{err}, @var{msg}] =} uname ()\n\ -Return system information in the structure. For example:\n\ -\n\ -@example\n\ -@group\n\ -uname ()\n\ - @result{} @{\n\ - sysname = x86_64\n\ - nodename = segfault\n\ - release = 2.6.15-1-amd64-k8-smp\n\ - version = Linux\n\ - machine = #2 SMP Thu Feb 23 04:57:49 UTC 2006\n\ - @}\n\ -@end group\n\ -@end example\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\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 0) - { - octave_uname sysinfo; - - octave_scalar_map m; - - m.assign ("sysname", sysinfo.sysname ()); - m.assign ("nodename", sysinfo.nodename ()); - m.assign ("release", sysinfo.release ()); - m.assign ("version", sysinfo.version ()); - m.assign ("machine", sysinfo.machine ()); - - retval(2) = sysinfo.message (); - retval(1) = sysinfo.error (); - retval(0) = m; - } - else - print_usage (); - - return retval; -} - -DEFUNX ("unlink", Funlink, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} unlink (@var{file})\n\ -Delete the file named @var{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\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 1) - { - if (args(0).is_string ()) - { - std::string name = args(0).string_value (); - - std::string msg; - - int status = octave_unlink (name, msg); - - retval(1) = msg; - retval(0) = status; - } - else - error ("unlink: FILE must be a string"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("waitpid", Fwaitpid, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{pid}, @var{status}, @var{msg}] =} waitpid (@var{pid}, @var{options})\n\ -Wait for process @var{pid} to terminate. The @var{pid} argument can be:\n\ -\n\ -@table @asis\n\ -@item @minus{}1\n\ -Wait for any child process.\n\ -\n\ -@item 0\n\ -Wait for any child process whose process group ID is equal to that of\n\ -the Octave interpreter process.\n\ -\n\ -@item > 0\n\ -Wait for termination of the child process with ID @var{pid}.\n\ -@end table\n\ -\n\ -The @var{options} argument can be a bitwise OR of zero or more of\n\ -the following constants:\n\ -\n\ -@table @code\n\ -@item 0\n\ -Wait until signal is received or a child process exits (this is the\n\ -default if the @var{options} argument is missing).\n\ -\n\ -@item WNOHANG\n\ -Do not hang if status is not immediately available.\n\ -\n\ -@item WUNTRACED\n\ -Report the status of any child processes that are stopped, and whose\n\ -status has not yet been reported since they stopped.\n\ -\n\ -@item WCONTINUE\n\ -Return if a stopped child has been resumed by delivery of @code{SIGCONT}.\n\ -This value may not be meaningful on all systems.\n\ -@end table\n\ -\n\ -If the returned value of @var{pid} is greater than 0, it is the process\n\ -ID of the child process that exited. If an error occurs, @var{pid} will\n\ -be less than zero and @var{msg} will contain a system-dependent error\n\ -message. The value of @var{status} contains additional system-dependent\n\ -information about the subprocess that exited.\n\ -@seealso{WCONTINUE, WCOREDUMP, WEXITSTATUS, WIFCONTINUED, WIFSIGNALED, WIFSTOPPED, WNOHANG, WSTOPSIG, WTERMSIG, WUNTRACED}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(2) = std::string (); - retval(1) = 0; - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - pid_t pid = args(0).int_value (true); - - if (! error_state) - { - int options = 0; - - if (args.length () == 2) - options = args(1).int_value (true); - - if (! error_state) - { - std::string msg; - - int status = 0; - - pid_t result = octave_syscalls::waitpid (pid, &status, options, msg); - - retval(2) = msg; - retval(1) = status; - retval(0) = result; - } - else - error ("waitpid: OPTIONS must be an integer"); - } - else - error ("waitpid: PID must be an integer value"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("WIFEXITED", FWIFEXITED, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WIFEXITED (@var{status})\n\ -Given @var{status} from a call to @code{waitpid}, return true if the\n\ -child terminated normally.\n\ -@seealso{waitpid, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WCOREDUMP, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ -@end deftypefn") -{ - octave_value retval = 0.0; - -#if defined (WIFEXITED) - if (args.length () == 1) - { - int status = args(0).int_value (); - - if (! error_state) - retval = WIFEXITED (status); - else - error ("WIFEXITED: STATUS must be an integer"); - } -#else - warning ("WIFEXITED always returns false in this version of Octave"); -#endif - - return retval; -} - -DEFUNX ("WEXITSTATUS", FWEXITSTATUS, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WEXITSTATUS (@var{status})\n\ -Given @var{status} from a call to @code{waitpid}, return the exit\n\ -status of the child. This function should only be employed if\n\ -@code{WIFEXITED} returned true.\n\ -@seealso{waitpid, WIFEXITED, WIFSIGNALED, WTERMSIG, WCOREDUMP, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ -@end deftypefn") -{ - octave_value retval = 0.0; - -#if defined (WEXITSTATUS) - if (args.length () == 1) - { - int status = args(0).int_value (); - - if (! error_state) - retval = WEXITSTATUS (status); - else - error ("WEXITSTATUS: STATUS must be an integer"); - } -#else - warning ("WEXITSTATUS always returns false in this version of Octave"); -#endif - - return retval; -} - -DEFUNX ("WIFSIGNALED", FWIFSIGNALED, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WIFSIGNALED (@var{status})\n\ -Given @var{status} from a call to @code{waitpid}, return true if the\n\ -child process was terminated by a signal.\n\ -@seealso{waitpid, WIFEXITED, WEXITSTATUS, WTERMSIG, WCOREDUMP, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ -@end deftypefn") -{ - octave_value retval = 0.0; - -#if defined (WIFSIGNALED) - if (args.length () == 1) - { - int status = args(0).int_value (); - - if (! error_state) - retval = WIFSIGNALED (status); - else - error ("WIFSIGNALED: STATUS must be an integer"); - } -#else - warning ("WIFSIGNALED always returns false in this version of Octave"); -#endif - - return retval; -} - -DEFUNX ("WTERMSIG", FWTERMSIG, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WTERMSIG (@var{status})\n\ -Given @var{status} from a call to @code{waitpid}, return the number of\n\ -the signal that caused the child process to terminate. This function\n\ -should only be employed if @code{WIFSIGNALED} returned true.\n\ -@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WCOREDUMP, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ -@end deftypefn") -{ - octave_value retval = 0.0; - -#if defined (WTERMSIG) - if (args.length () == 1) - { - int status = args(0).int_value (); - - if (! error_state) - retval = WTERMSIG (status); - else - error ("WTERMSIG: STATUS must be an integer"); - } -#else - warning ("WTERMSIG always returns false in this version of Octave"); -#endif - - return retval; -} - -DEFUNX ("WCOREDUMP", FWCOREDUMP, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WCOREDUMP (@var{status})\n\ -Given @var{status} from a call to @code{waitpid}, return true if the\n\ -child produced a core dump. This function should only be employed if\n\ -@code{WIFSIGNALED} returned true. The macro used to implement this\n\ -function is not specified in POSIX.1-2001 and is not available on some\n\ -Unix implementations (e.g., AIX, SunOS).\n\ -@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ -@end deftypefn") -{ - octave_value retval = 0.0; - -#if defined (WCOREDUMP) - if (args.length () == 1) - { - int status = args(0).int_value (); - - if (! error_state) - retval = WCOREDUMP (status); - else - error ("WCOREDUMP: STATUS must be an integer"); - } -#else - warning ("WCOREDUMP always returns false in this version of Octave"); -#endif - - return retval; -} - -DEFUNX ("WIFSTOPPED", FWIFSTOPPED, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WIFSTOPPED (@var{status})\n\ -Given @var{status} from a call to @code{waitpid}, return true if the\n\ -child process was stopped by delivery of a signal; this is only\n\ -possible if the call was done using @code{WUNTRACED} or when the child\n\ -is being traced (see ptrace(2)).\n\ -@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WCOREDUMP, WSTOPSIG, WIFCONTINUED}\n\ -@end deftypefn") -{ - octave_value retval = 0.0; - -#if defined (WIFSTOPPED) - if (args.length () == 1) - { - int status = args(0).int_value (); - - if (! error_state) - retval = WIFSTOPPED (status); - else - error ("WIFSTOPPED: STATUS must be an integer"); - } -#else - warning ("WIFSTOPPED always returns false in this version of Octave"); -#endif - - return retval; -} - -DEFUNX ("WSTOPSIG", FWSTOPSIG, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WSTOPSIG (@var{status})\n\ -Given @var{status} from a call to @code{waitpid}, return the number of\n\ -the signal which caused the child to stop. This function should only\n\ -be employed if @code{WIFSTOPPED} returned true.\n\ -@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WCOREDUMP, WIFSTOPPED, WIFCONTINUED}\n\ -@end deftypefn") -{ - octave_value retval = 0.0; - -#if defined (WSTOPSIG) - if (args.length () == 1) - { - int status = args(0).int_value (); - - if (! error_state) - retval = WSTOPSIG (status); - else - error ("WSTOPSIG: STATUS must be an integer"); - } -#else - warning ("WSTOPSIG always returns false in this version of Octave"); -#endif - - return retval; -} - -DEFUNX ("WIFCONTINUED", FWIFCONTINUED, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WIFCONTINUED (@var{status})\n\ -Given @var{status} from a call to @code{waitpid}, return true if the\n\ -child process was resumed by delivery of @code{SIGCONT}.\n\ -@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WCOREDUMP, WIFSTOPPED, WSTOPSIG}\n\ -@end deftypefn") -{ - octave_value retval = 0.0; - -#if defined (WIFCONTINUED) - if (args.length () == 1) - { - int status = args(0).int_value (); - - if (! error_state) - retval = WIFCONTINUED (status); - else - error ("WIFCONTINUED: STATUS must be an integer"); - } -#else - warning ("WIFCONTINUED always returns false in this version of Octave"); -#endif - - return retval; -} - -DEFUNX ("canonicalize_file_name", Fcanonicalize_file_name, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{cname}, @var{status}, @var{msg}] =} canonicalize_file_name (@var{fname})\n\ -Return the canonical name of file @var{fname}. If the file does not exist\n\ -the empty string (\"\") is returned.\n\ -@seealso{make_absolute_filename, is_absolute_filename, is_rooted_relative_filename}\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - std::string name = args(0).string_value (); - - if (! error_state) - { - std::string msg; - - std::string result = octave_canonicalize_file_name (name, msg); - - retval(2) = msg; - retval(1) = msg.empty () ? 0 : -1; - retval(0) = result; - } - else - error ("canonicalize_file_name: NAME must be a character string"); - } - else - print_usage (); - - return retval; -} - -static octave_value -const_value (const octave_value_list& args, int val) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - retval = val; - else - print_usage (); - - return retval; -} - -#if !defined (O_NONBLOCK) && defined (O_NDELAY) -#define O_NONBLOCK O_NDELAY -#endif - -DEFUNX ("F_DUPFD", FF_DUPFD, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} F_DUPFD ()\n\ -Return the numerical value to pass to @code{fcntl} to return a\n\ -duplicate file descriptor.\n\ -@seealso{fcntl, F_GETFD, F_GETFL, F_SETFD, F_SETFL}\n\ -@end deftypefn") -{ -#if defined (F_DUPFD) - return const_value (args, F_DUPFD); -#else - error ("F_DUPFD: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("F_GETFD", FF_GETFD, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} F_GETFD ()\n\ -Return the numerical value to pass to @code{fcntl} to return the\n\ -file descriptor flags.\n\ -@seealso{fcntl, F_DUPFD, F_GETFL, F_SETFD, F_SETFL}\n\ -@end deftypefn") -{ -#if defined (F_GETFD) - return const_value (args, F_GETFD); -#else - error ("F_GETFD: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("F_GETFL", FF_GETFL, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} F_GETFL ()\n\ -Return the numerical value to pass to @code{fcntl} to return the\n\ -file status flags.\n\ -@seealso{fcntl, F_DUPFD, F_GETFD, F_SETFD, F_SETFL}\n\ -@end deftypefn") -{ -#if defined (F_GETFL) - return const_value (args, F_GETFL); -#else - error ("F_GETFL: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("F_SETFD", FF_SETFD, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} F_SETFD ()\n\ -Return the numerical value to pass to @code{fcntl} to set the file\n\ -descriptor flags.\n\ -@seealso{fcntl, F_DUPFD, F_GETFD, F_GETFL, F_SETFL}\n\ -@end deftypefn") -{ -#if defined (F_SETFD) - return const_value (args, F_SETFD); -#else - error ("F_SETFD: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("F_SETFL", FF_SETFL, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} F_SETFL ()\n\ -Return the numerical value to pass to @code{fcntl} to set the file\n\ -status flags.\n\ -@seealso{fcntl, F_DUPFD, F_GETFD, F_GETFL, F_SETFD}\n\ -@end deftypefn") -{ -#if defined (F_SETFL) - return const_value (args, F_SETFL); -#else - error ("F_SETFL: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_APPEND", FO_APPEND, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_APPEND ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate each write operation appends,\n\ -or that may be passed to @code{fcntl} to set the write mode to append.\n\ -@seealso{fcntl, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_APPEND) - return const_value (args, O_APPEND); -#else - error ("O_APPEND: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_ASYNC", FO_ASYNC, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_ASYNC ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate asynchronous I/O.\n\ -@seealso{fcntl, O_APPEND, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_ASYNC) - return const_value (args, O_ASYNC); -#else - error ("O_ASYNC: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_CREAT", FO_CREAT, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_CREAT ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate that a file should be\n\ -created if it does not exist.\n\ -@seealso{fcntl, O_APPEND, O_ASYNC, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_CREAT) - return const_value (args, O_CREAT); -#else - error ("O_CREAT: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_EXCL", FO_EXCL, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_EXCL ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate that file locking is used.\n\ -@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_EXCL) - return const_value (args, O_EXCL); -#else - error ("O_EXCL: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_NONBLOCK", FO_NONBLOCK, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_NONBLOCK ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate that non-blocking I/O is in use,\n\ -or that may be passsed to @code{fcntl} to set non-blocking I/O.\n\ -@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_NONBLOCK) - return const_value (args, O_NONBLOCK); -#else - error ("O_NONBLOCK: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_RDONLY", FO_RDONLY, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_RDONLY ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate that a file is open for\n\ -reading only.\n\ -@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_RDONLY) - return const_value (args, O_RDONLY); -#else - error ("O_RDONLY: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_RDWR", FO_RDWR, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_RDWR ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate that a file is open for both\n\ -reading and writing.\n\ -@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_SYNC, O_TRUNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_RDWR) - return const_value (args, O_RDWR); -#else - error ("O_RDWR: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_SYNC", FO_SYNC, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_SYNC ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate that a file is open for\n\ -synchronous I/O.\n\ -@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_TRUNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_SYNC) - return const_value (args, O_SYNC); -#else - error ("O_SYNC: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_TRUNC", FO_TRUNC, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} O_TRUNC ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate that if file exists, it should\n\ -be truncated when writing.\n\ -@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_TRUNC) - return const_value (args, O_TRUNC); -#else - error ("O_TRUNC: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_WRONLY", FO_WRONLY, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_WRONLY ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate that a file is open for\n\ -writing only.\n\ -@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC}\n\ -@end deftypefn") -{ -#if defined (O_WRONLY) - return const_value (args, O_WRONLY); -#else - error ("O_WRONLY: not available on this system"); - return octave_value (); -#endif -} - -#if !defined (WNOHANG) -#define WNOHANG 0 -#endif - -DEFUNX ("WNOHANG", FWNOHANG, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WNOHANG ()\n\ -Return the numerical value of the option argument that may be\n\ -passed to @code{waitpid} to indicate that it should return its\n\ -status immediately instead of waiting for a process to exit.\n\ -@seealso{waitpid, WUNTRACED, WCONTINUE}\n\ -@end deftypefn") -{ - return const_value (args, WNOHANG); -} - -#if !defined (WUNTRACED) -#define WUNTRACED 0 -#endif - -DEFUNX ("WUNTRACED", FWUNTRACED, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WUNTRACED ()\n\ -Return the numerical value of the option argument that may be\n\ -passed to @code{waitpid} to indicate that it should also return\n\ -if the child process has stopped but is not traced via the\n\ -@code{ptrace} system call\n\ -@seealso{waitpid, WNOHANG, WCONTINUE}\n\ -@end deftypefn") -{ - return const_value (args, WUNTRACED); -} - -#if !defined (WCONTINUE) -#define WCONTINUE 0 -#endif - -DEFUNX ("WCONTINUE", FWCONTINUE, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WCONTINUE ()\n\ -Return the numerical value of the option argument that may be\n\ -passed to @code{waitpid} to indicate that it should also return\n\ -if a stopped child has been resumed by delivery of a @code{SIGCONT}\n\ -signal.\n\ -@seealso{waitpid, WNOHANG, WUNTRACED}\n\ -@end deftypefn") -{ - return const_value (args, WCONTINUE); -}