Mercurial > hg > octave-nkf
changeset 3808:885b296ef83a
[project @ 2001-03-27 19:12:58 by jwe]
author | jwe |
---|---|
date | Tue, 27 Mar 2001 19:12:59 +0000 |
parents | e4e25cdb6786 |
children | ec80db02d436 |
files | libcruft/ChangeLog libcruft/Makefile.in libcruft/misc/Makefile.in libcruft/misc/dostop.c libcruft/misc/f77-fcn.c libcruft/misc/xstopx.f src/ChangeLog src/DLD-FUNCTIONS/det.cc src/DLD-FUNCTIONS/inv.cc |
diffstat | 9 files changed, 73 insertions(+), 104 deletions(-) [+] |
line wrap: on
line diff
--- a/libcruft/ChangeLog +++ b/libcruft/ChangeLog @@ -1,3 +1,15 @@ +2001-03-27 John W. Eaton <jwe@bevo.che.wisc.edu> + + * misc/xstopx.f: Delete. + * misc/dostop.c: Delete. + * misc/Makefile.in (SPECIAL, SPECIAL_DEPEND): Delete dostop.c and + dostop.o from lists. + * Makefile.in (MISC_OBJ): Delete misc/dostop.o from the list. + + * misc/dostop.c (dostop): Use F77_FCN macro for function definition. + Specify length in error format to avoid need for copying string. + From Paul Kienzle <pkienzle@kienzle.powernet.co.uk>. + 2000-12-14 John W. Eaton <jwe@bevo.che.wisc.edu> * lapack/dgelss.f (DGELSS): Use correct leading dimension for
--- a/libcruft/Makefile.in +++ b/libcruft/Makefile.in @@ -53,7 +53,7 @@ # XXX FIXME XXX -- this should build the shared library directly from # a normal archive file (created from PIC code, though). -MISC_OBJ := misc/machar.o misc/dostop.o misc/f77-extern.o \ +MISC_OBJ := misc/machar.o misc/f77-extern.o \ misc/f77-fcn.o misc/lo-error.o CRUFT_FSRC := $(foreach dir, $(SUBDIRS), $(wildcard $(srcdir)/$(dir)/*.f))
--- a/libcruft/misc/Makefile.in +++ b/libcruft/misc/Makefile.in @@ -12,10 +12,10 @@ top_srcdir = @top_srcdir@ VPATH = @srcdir@ -SPECIAL := machar.c d1mach-tst.for dostop.c f77-extern.cc \ +SPECIAL := machar.c d1mach-tst.for f77-extern.cc \ f77-fcn.c f77-fcn.h lo-error.c lo-error.h -SPECIAL_DEPEND := machar.o dostop.o f77-extern.o f77-fcn.o lo-error.o +SPECIAL_DEPEND := machar.o f77-extern.o f77-fcn.o lo-error.o EXTERNAL_DISTFILES = $(DISTFILES)
deleted file mode 100644 --- a/libcruft/misc/dostop.c +++ /dev/null @@ -1,65 +0,0 @@ -/* dostop.c -*- C -*- */ -/* - -Copyright (C) 1996, 1997 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 2, or (at your option) any -later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, write to the Free -Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -*/ - -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#include <stdlib.h> -#include <string.h> - -#include "f77-fcn.h" -#include "lo-error.h" - -/* All the STOP statements in the Fortran routines have been replaced - with a call to XSTOPX, defined in the file libcruft/misc/xstopx.f. - - The XSTOPX function calls this function, which will longjmp back to - the entry point for the Fortran function that called us. Then the - calling function should do whatever cleanup is necessary. */ - -volatile void -#if defined (F77_APPEND_UNDERSCORE) -dostop_ (const char *s, const int *slen) -#else -dostop (const char *s, const int *slen) -#endif -{ - int len = *slen; - if (len > 0) - { - char *tmp = malloc (len + 1); - strncpy (tmp, s, len); - (*current_liboctave_error_handler) ("%s", tmp); - free (tmp); - } - - longjmp (f77_context, 1); -} - -/* -;;; Local Variables: *** -;;; mode: C *** -;;; page-delimiter: "^/\\*" *** -;;; End: *** -*/
--- a/libcruft/misc/f77-fcn.c +++ b/libcruft/misc/f77-fcn.c @@ -24,9 +24,11 @@ #include <config.h> #endif +#include <stdlib.h> #include <string.h> #include "f77-fcn.h" +#include "lo-error.h" void copy_f77_context (void *from, void *to, unsigned int size) @@ -34,6 +36,22 @@ memcpy (to, from, size); } +/* All the STOP statements in the Fortran routines have been replaced + with a call to XSTOPX. + + XSTOPX jumps back to the entry point for the Fortran function that + called us. Then the calling function should do whatever cleanup + is necessary. */ + +volatile void +F77_FCN (xstopx, XSTOPX) (const char *s, long int slen) +{ + if (s && slen > 0) + (*current_liboctave_error_handler) ("%.*s", s, slen); + + longjmp (f77_context, 1); +} + /* ;;; Local Variables: *** ;;; mode: C++ ***
deleted file mode 100644 --- a/libcruft/misc/xstopx.f +++ /dev/null @@ -1,9 +0,0 @@ - subroutine xstopx (string) - character *(*) string - integer slen - slen = len (string) - if (slen .eq. 1 .and. string(1:1) .eq. ' ') then - slen = 0 - endif - 9999 call dostop (string, slen) - end
--- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,13 @@ +2001-03-26 John W. Eaton <jwe@bevo.che.wisc.edu> + + * DLD-FUNCTIONS/det.cc (Fdet): Only return rcond if nargout > 1. + * DLD-FUNCTIONS/inv.cc (Finv): Only return rcond if nargout > 1. + +2001-03-26 Paul Kienzle <pkienzle@kienzle.powernet.co.uk> + + * DLD-FUNCTIONS/det.cc (Fdet): Suppress warning, but return rcond. + * DLD_FUNCTIONS/inv.cc (Finv): Return rcond if requested. + 2001-02-28 John W. Eaton <jwe@bevo.che.wisc.edu> * pt.h (tree::break_statement): New static member.
--- a/src/DLD-FUNCTIONS/det.cc +++ b/src/DLD-FUNCTIONS/det.cc @@ -33,10 +33,11 @@ #include "oct-obj.h" #include "utils.h" -DEFUN_DLD (det, args, , +DEFUN_DLD (det, args, nargout, "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} det (@var{a})\n\ -Compute the determinant of @var{a} using @sc{Linpack}.\n\ +@deftypefn {Loadable Function} {[@var{d}, @var{rcond}] = } det (@var{a})\n\ +Compute the determinant of @var{a} using @sc{Linpack}. Return an estimate\n\ +of the reciprocal condition number if requested.\n\ @end deftypefn") { octave_value_list retval; @@ -83,15 +84,10 @@ DET det = m.determinant (info, rcond); - double d = 0.0; + if (nargout > 1) + retval(1) = rcond; - if (info == -1) - warning ("det: matrix singular to machine precision, rcond = %g", - rcond); - else - d = det.value (); - - retval = d; + retval(0) = (info == -1 ? 0.0 : det.value ()); } } else if (arg.is_complex_type ()) @@ -105,15 +101,10 @@ ComplexDET det = m.determinant (info, rcond); - Complex c = 0.0; + if (nargout > 1) + retval(1) = rcond; - if (info == -1) - warning ("det: matrix singular to machine precision, rcond = %g", - rcond); - else - c = det.value (); - - retval = c; + retval(0) = (info == -1 ? 0.0 : det.value ()); } } else
--- a/src/DLD-FUNCTIONS/inv.cc +++ b/src/DLD-FUNCTIONS/inv.cc @@ -30,11 +30,13 @@ #include "oct-obj.h" #include "utils.h" -DEFUN_DLD (inv, args, , +DEFUN_DLD (inv, args, nargout, "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} inv (@var{a})\n\ -@deftypefnx {Loadable Function} {} inverse (@var{a})\n\ -Compute the inverse of the square matrix @var{a}.\n\ +@deftypefn {Loadable Function} {[@var{x}, @var{rcond}] = } inv (@var{a})\n\ +@deftypefnx {Loadable Function} {[@var{x}, @var{rcond}] = } inverse (@var{a})\n\ +Compute the inverse of the square matrix @var{a}. Return an estimate\n\ +of the reciprocal condition number if requested, otherwise warn of an\n\ +ill-conditioned matrix if the reciprocal condition number is small.\n\ @end deftypefn") { octave_value_list retval; @@ -74,9 +76,14 @@ int info; double rcond = 0.0; - retval = m.inverse (info, rcond, 1); + Matrix result = m.inverse (info, rcond, 1); - if (info == -1) + if (nargout > 1) + retval(1) = rcond; + + retval(0) = result; + + if (nargout < 2 && info == -1) warning ("inverse: matrix singular to machine precision,\ rcond = %g", rcond); } @@ -90,9 +97,14 @@ int info; double rcond = 0.0; - retval = m.inverse (info, rcond, 1); + ComplexMatrix result = m.inverse (info, rcond, 1); - if (info == -1) + if (nargout > 1) + retval(1) = rcond; + + retval(0) = result; + + if (nargout < 2 && info == -1) warning ("inverse: matrix singular to machine precision,\ rcond = %g", rcond); }