Mercurial > octave-nkf

changeset 3808:885b296ef83a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[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	Thu Mar 08 21:21:33 2001 +0000
+++ b/libcruft/ChangeLog	Tue Mar 27 19:12:59 2001 +0000
@@ -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	Thu Mar 08 21:21:33 2001 +0000
+++ b/libcruft/Makefile.in	Tue Mar 27 19:12:59 2001 +0000
@@ -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	Thu Mar 08 21:21:33 2001 +0000
+++ b/libcruft/misc/Makefile.in	Tue Mar 27 19:12:59 2001 +0000
@@ -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)
 
--- a/libcruft/misc/dostop.c	Thu Mar 08 21:21:33 2001 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -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	Thu Mar 08 21:21:33 2001 +0000
+++ b/libcruft/misc/f77-fcn.c	Tue Mar 27 19:12:59 2001 +0000
@@ -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++ ***
--- a/libcruft/misc/xstopx.f	Thu Mar 08 21:21:33 2001 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -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	Thu Mar 08 21:21:33 2001 +0000
+++ b/src/ChangeLog	Tue Mar 27 19:12:59 2001 +0000
@@ -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	Thu Mar 08 21:21:33 2001 +0000
+++ b/src/DLD-FUNCTIONS/det.cc	Tue Mar 27 19:12:59 2001 +0000
@@ -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	Thu Mar 08 21:21:33 2001 +0000
+++ b/src/DLD-FUNCTIONS/inv.cc	Tue Mar 27 19:12:59 2001 +0000
@@ -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);
 	}