changeset 1847:2ffe49eb95a5

[project @ 1996-02-03 12:47:55 by jwe]
author jwe
date Sat, 03 Feb 1996 12:51:32 +0000
parents 43f018996927
children 979f25fd161f
files liboctave/CColVector.cc liboctave/CMatrix.cc liboctave/CRowVector.cc liboctave/CmplxAEPBAL.cc liboctave/CmplxCHOL.cc liboctave/CmplxHESS.cc liboctave/CmplxLU.cc liboctave/CmplxQR.cc liboctave/CmplxQRP.cc liboctave/CmplxSCHUR.cc liboctave/CmplxSVD.cc liboctave/CollocWt.cc liboctave/DASSL.cc liboctave/EIG.cc liboctave/FSQP.cc liboctave/LSODE.cc liboctave/NLEqn.cc liboctave/NPSOL.cc liboctave/QLD.cc liboctave/QPSOL.cc liboctave/Quad.cc liboctave/acosh.c liboctave/asinh.c liboctave/atanh.c liboctave/dColVector.cc liboctave/dMatrix.cc liboctave/dRowVector.cc liboctave/dbleAEPBAL.cc liboctave/dbleCHOL.cc liboctave/dbleGEPBAL.cc liboctave/dbleHESS.cc liboctave/dbleLU.cc liboctave/dbleQR.cc liboctave/dbleQRP.cc liboctave/dbleSCHUR.cc liboctave/dbleSVD.cc liboctave/erf.c liboctave/erfc.c liboctave/f77-fcn.h liboctave/gamma.c liboctave/lgamma.c liboctave/utils.cc src/mappers.cc src/qzval.cc src/rand.cc src/sysdep.cc
diffstat 46 files changed, 95 insertions(+), 50 deletions(-) [+]
line wrap: on
line diff
--- a/liboctave/CColVector.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/CColVector.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -31,7 +31,7 @@
 
 #include <iostream.h>
 
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "lo-error.h"
 #include "mx-base.h"
 #include "mx-inlines.cc"
--- a/liboctave/CMatrix.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/CMatrix.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -39,7 +39,7 @@
 #include "CmplxDET.h"
 #include "CmplxSCHUR.h"
 #include "CmplxSVD.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "lo-error.h"
 #include "mx-base.h"
 #include "mx-inlines.cc"
--- a/liboctave/CRowVector.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/CRowVector.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -31,7 +31,7 @@
 
 #include <iostream.h>
 
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "lo-error.h"
 #include "mx-base.h"
 #include "mx-inlines.cc"
--- a/liboctave/CmplxAEPBAL.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/CmplxAEPBAL.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -33,7 +33,7 @@
 
 #include "CmplxAEPBAL.h"
 #include "dMatrix.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 
 extern "C"
 {
--- a/liboctave/CmplxCHOL.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/CmplxCHOL.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -30,7 +30,7 @@
 #endif
 
 #include "CmplxCHOL.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "lo-error.h"
 #include "mx-inlines.cc"
 
--- a/liboctave/CmplxHESS.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/CmplxHESS.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -30,7 +30,7 @@
 #endif
 
 #include "CmplxHESS.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "lo-error.h"
 #include "mx-inlines.cc"
 
--- a/liboctave/CmplxLU.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/CmplxLU.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -30,7 +30,7 @@
 #endif
 
 #include "CmplxLU.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "lo-error.h"
 #include "mx-inlines.cc"
 
--- a/liboctave/CmplxQR.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/CmplxQR.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -30,7 +30,7 @@
 #endif
 
 #include "CmplxQR.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "lo-error.h"
 #include "mx-inlines.cc"
 
--- a/liboctave/CmplxQRP.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/CmplxQRP.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -32,7 +32,7 @@
 #include <cassert>
 
 #include "CmplxQRP.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "lo-error.h"
 #include "mx-inlines.cc"
 
--- a/liboctave/CmplxSCHUR.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/CmplxSCHUR.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -30,7 +30,7 @@
 #endif
 
 #include "CmplxSCHUR.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "lo-error.h"
 #include "mx-inlines.cc"
 
--- a/liboctave/CmplxSVD.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/CmplxSVD.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -30,7 +30,7 @@
 #endif
 
 #include "CmplxSVD.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "lo-error.h"
 #include "mx-inlines.cc"
 
--- a/liboctave/CollocWt.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/CollocWt.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -32,7 +32,7 @@
 #include <iostream.h>
 
 #include "CollocWt.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "lo-error.h"
 
 extern "C"
--- a/liboctave/DASSL.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/DASSL.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -33,7 +33,7 @@
 #include <cmath>
 
 #include "DASSL.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "lo-error.h"
 
 extern "C"
--- a/liboctave/EIG.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/EIG.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -30,7 +30,7 @@
 #endif
 
 #include "EIG.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "lo-error.h"
 #include "mx-inlines.cc"
 
--- a/liboctave/FSQP.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/FSQP.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -32,7 +32,7 @@
 #ifndef FSQP_MISSING
 
 #include "FSQP.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 
 #endif
 
--- a/liboctave/LSODE.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/LSODE.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -35,7 +35,7 @@
 #include <iostream.h>
 
 #include "LSODE.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "lo-error.h"
 
 extern "C"
--- a/liboctave/NLEqn.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/NLEqn.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -31,7 +31,7 @@
 
 #include "NLEqn.h"
 #include "dMatrix.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "lo-error.h"
 
 extern "C"
--- a/liboctave/NPSOL.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/NPSOL.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -39,7 +39,7 @@
 
 #include "NPSOL.h"
 #include "dMatrix.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "sun-utils.h"
 
 extern "C"
--- a/liboctave/QLD.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/QLD.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -37,7 +37,7 @@
 #include "dColVector.h"
 #include "dMatrix.h"
 #include "dRowVector.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 
 extern "C"
 {
--- a/liboctave/QPSOL.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/QPSOL.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -35,7 +35,7 @@
 #ifndef QPSOL_MISSING
 
 #include "QPSOL.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 
 extern "C"
 {
--- a/liboctave/Quad.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/Quad.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -30,7 +30,7 @@
 #endif
 
 #include "Quad.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "sun-utils.h"
 
 static integrand_fcn user_fcn;
--- a/liboctave/acosh.c	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/acosh.c	Sat Feb 03 12:51:32 1996 +0000
@@ -26,7 +26,7 @@
 
 #ifndef HAVE_ACOSH
 
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 
 extern double F77_FCN (dacosh, DACOSH) (const double*);
 
--- a/liboctave/asinh.c	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/asinh.c	Sat Feb 03 12:51:32 1996 +0000
@@ -26,7 +26,7 @@
 
 #ifndef HAVE_ASINH
 
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 
 extern double F77_FCN (dasinh, DASINH) (const double*);
 
--- a/liboctave/atanh.c	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/atanh.c	Sat Feb 03 12:51:32 1996 +0000
@@ -26,7 +26,7 @@
 
 #ifndef HAVE_ATANH
 
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 
 extern double F77_FCN (datanh, DATANH) (const double*);
 
--- a/liboctave/dColVector.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/dColVector.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -31,7 +31,7 @@
 
 #include <iostream.h>
 
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "lo-error.h"
 #include "mx-base.h"
 #include "mx-inlines.cc"
--- a/liboctave/dMatrix.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/dMatrix.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -41,7 +41,7 @@
 #include "dbleDET.h"
 #include "dbleSCHUR.h"
 #include "dbleSVD.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "lo-error.h"
 #include "mx-base.h"
 #include "mx-inlines.cc"
--- a/liboctave/dRowVector.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/dRowVector.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -31,7 +31,7 @@
 
 #include <iostream.h>
 
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "lo-error.h"
 #include "mx-base.h"
 #include "mx-inlines.cc"
--- a/liboctave/dbleAEPBAL.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/dbleAEPBAL.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -32,7 +32,7 @@
 #include <string>
 
 #include "dbleAEPBAL.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 
 extern "C"
 {
--- a/liboctave/dbleCHOL.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/dbleCHOL.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -30,7 +30,7 @@
 #endif
 
 #include "dbleCHOL.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "lo-error.h"
 #include "mx-inlines.cc"
 
--- a/liboctave/dbleGEPBAL.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/dbleGEPBAL.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -34,7 +34,7 @@
 #include <string>
 
 #include "dbleGEPBAL.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 
 extern "C"
 {
--- a/liboctave/dbleHESS.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/dbleHESS.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -30,7 +30,7 @@
 #endif
 
 #include "dbleHESS.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "lo-error.h"
 #include "mx-inlines.cc"
 
--- a/liboctave/dbleLU.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/dbleLU.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -30,7 +30,7 @@
 #endif
 
 #include "dbleLU.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "lo-error.h"
 #include "mx-inlines.cc"
 
--- a/liboctave/dbleQR.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/dbleQR.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -30,7 +30,7 @@
 #endif
 
 #include "dbleQR.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "lo-error.h"
 #include "mx-inlines.cc"
 
--- a/liboctave/dbleQRP.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/dbleQRP.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -32,7 +32,7 @@
 #include <cassert>
 
 #include "dbleQRP.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "lo-error.h"
 #include "mx-inlines.cc"
 
--- a/liboctave/dbleSCHUR.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/dbleSCHUR.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -32,7 +32,7 @@
 #include <iostream.h>
 
 #include "dbleSCHUR.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "lo-error.h"
 #include "mx-inlines.cc"
 
--- a/liboctave/dbleSVD.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/dbleSVD.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -32,7 +32,7 @@
 #include <iostream.h>
 
 #include "dbleSVD.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "mx-inlines.cc"
 
 extern "C"
--- a/liboctave/erf.c	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/erf.c	Sat Feb 03 12:51:32 1996 +0000
@@ -26,7 +26,7 @@
 
 #ifndef HAVE_ERF
 
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 
 extern double F77_FCN (derf, DERF) (const double*);
 
--- a/liboctave/erfc.c	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/erfc.c	Sat Feb 03 12:51:32 1996 +0000
@@ -26,7 +26,7 @@
 
 #ifndef HAVE_ERFC
 
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 
 extern double F77_FCN (derfc, DERFC) (const double*);
 
--- a/liboctave/f77-fcn.h	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/f77-fcn.h	Sat Feb 03 12:51:32 1996 +0000
@@ -1,6 +1,6 @@
 /*
 
-Copyright (C) 1992, 1993, 1994, 1995 John W. Eaton
+Copyright (C) 1996 John W. Eaton
 
 This file is part of Octave.
 
@@ -20,14 +20,19 @@
 
 */
 
-#if !defined (octave_f77_uscore_h)
-#define octave_f77_uscore_h 1
+#if !defined (octave_f77_fcn_h)
+#define octave_f77_fcn_h 1
+
+#include <setjmp.h>
+
+/* Some Fortran compilers append underscores or generate uppercase
+   external names. */
 
 #if defined (F77_APPEND_UNDERSCORE)
 #if defined (F77_UPPERCASE_NAMES)
-#define F77_FCN(f, F) F##_
+#define F77_FCN(f, F) F ## _
 #else
-#define F77_FCN(f, F) f##_
+#define F77_FCN(f, F) f ## _
 #endif
 #else
 #if defined (F77_UPPERCASE_NAMES)
@@ -37,6 +42,46 @@
 #endif
 #endif
 
+/* How to print an error for the F77_XFCN macro. */
+
+#if defined (F77_UPPERCASE_NAMES)
+#define F77_XFCN_ERROR(f, F) \
+  (*current_liboctave_error_handler)
+    ("exception encountered in Fortran subroutine %s", F);
+#else
+#define F77_XFCN_ERROR(f, F) \
+  (*current_liboctave_error_handler)
+    ("exception encountered in Fortran subroutine %s", f);
+#endif
+
+/* This can be used to call a Fortran subroutine that might call
+   XSTOPX.  XSTOPX will call lonjmp with f77_context and we'll return,
+   call the error function, restore the previous context.  After using
+   this macro, error_state should be checked. */
+
+#define F77_XFCN(f, F, args) \
+  do \
+    { \
+      jmp_buf saved_f77_context; \
+      copy_f77_context ((char *) f77_context, (char *) saved_f77_context, \
+			sizeof (jmp_buf)); \
+      if (setjmp (f77_context)) \
+	F77_XFCN_ERROR (f, F); \
+      else \
+	F77_FCN (f, F) args; \
+      copy_f77_context ((char *) saved_f77_context, (char *) f77_context, \
+			sizeof (jmp_buf)); \
+    } \
+  while (0)
+
+/* For setjmp/longjmp. */
+jmp_buf f77_context;
+
+/* Defining this as a separate function allows us to avoid having to
+   include string.h in this file. */
+
+extern void copy_f77_context (void *, void *, unsigned int);
+
 #endif
 
 /*
--- a/liboctave/gamma.c	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/gamma.c	Sat Feb 03 12:51:32 1996 +0000
@@ -26,7 +26,7 @@
 
 #ifndef HAVE_GAMMA
 
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 
 extern double F77_FCN (dgamma, DGAMMA) (const double*);
 
--- a/liboctave/lgamma.c	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/lgamma.c	Sat Feb 03 12:51:32 1996 +0000
@@ -26,7 +26,7 @@
 
 #ifndef HAVE_LGAMMA
 
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 
 /* If the system doesn't have lgamma, assume that it doesn't have
    signgam either */
--- a/liboctave/utils.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/liboctave/utils.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -33,7 +33,7 @@
 #include <unistd.h>
 #endif
 
-#include "f77-uscore.h"
+#include "f77-fcn.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.
--- a/src/mappers.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/src/mappers.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -32,7 +32,7 @@
 
 #include "defun.h"
 #include "error.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "mappers.h"
 #include "sysdep.h"
 #include "utils.h"
--- a/src/qzval.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/src/qzval.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -29,7 +29,7 @@
 
 #include <cfloat>
 
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 
 #include "defun-dld.h"
 #include "error.h"
--- a/src/rand.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/src/rand.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -29,7 +29,7 @@
 
 #include <string>
 
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 
 #include "defun-dld.h"
 #include "error.h"
--- a/src/sysdep.cc	Sat Feb 03 12:47:55 1996 +0000
+++ b/src/sysdep.cc	Sat Feb 03 12:51:32 1996 +0000
@@ -76,7 +76,7 @@
 
 #include "defun.h"
 #include "error.h"
-#include "f77-uscore.h"
+#include "f77-fcn.h"
 #include "help.h"
 #include "input.h"
 #include "mappers.h"