Mercurial > hg > octave-lyh
changeset 1847:2ffe49eb95a5
[project @ 1996-02-03 12:47:55 by jwe]
line wrap: on
line diff
--- a/liboctave/CColVector.cc +++ b/liboctave/CColVector.cc @@ -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 +++ b/liboctave/CMatrix.cc @@ -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 +++ b/liboctave/CRowVector.cc @@ -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 +++ b/liboctave/CmplxAEPBAL.cc @@ -33,7 +33,7 @@ #include "CmplxAEPBAL.h" #include "dMatrix.h" -#include "f77-uscore.h" +#include "f77-fcn.h" extern "C" {
--- a/liboctave/CmplxCHOL.cc +++ b/liboctave/CmplxCHOL.cc @@ -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 +++ b/liboctave/CmplxHESS.cc @@ -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 +++ b/liboctave/CmplxLU.cc @@ -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 +++ b/liboctave/CmplxQR.cc @@ -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 +++ b/liboctave/CmplxQRP.cc @@ -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 +++ b/liboctave/CmplxSCHUR.cc @@ -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 +++ b/liboctave/CmplxSVD.cc @@ -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 +++ b/liboctave/CollocWt.cc @@ -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 +++ b/liboctave/DASSL.cc @@ -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 +++ b/liboctave/EIG.cc @@ -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 +++ b/liboctave/FSQP.cc @@ -32,7 +32,7 @@ #ifndef FSQP_MISSING #include "FSQP.h" -#include "f77-uscore.h" +#include "f77-fcn.h" #endif
--- a/liboctave/LSODE.cc +++ b/liboctave/LSODE.cc @@ -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 +++ b/liboctave/NLEqn.cc @@ -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 +++ b/liboctave/NPSOL.cc @@ -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 +++ b/liboctave/QLD.cc @@ -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 +++ b/liboctave/QPSOL.cc @@ -35,7 +35,7 @@ #ifndef QPSOL_MISSING #include "QPSOL.h" -#include "f77-uscore.h" +#include "f77-fcn.h" extern "C" {
--- a/liboctave/Quad.cc +++ b/liboctave/Quad.cc @@ -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 +++ b/liboctave/acosh.c @@ -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 +++ b/liboctave/asinh.c @@ -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 +++ b/liboctave/atanh.c @@ -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 +++ b/liboctave/dColVector.cc @@ -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 +++ b/liboctave/dMatrix.cc @@ -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 +++ b/liboctave/dRowVector.cc @@ -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 +++ b/liboctave/dbleAEPBAL.cc @@ -32,7 +32,7 @@ #include <string> #include "dbleAEPBAL.h" -#include "f77-uscore.h" +#include "f77-fcn.h" extern "C" {
--- a/liboctave/dbleCHOL.cc +++ b/liboctave/dbleCHOL.cc @@ -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 +++ b/liboctave/dbleGEPBAL.cc @@ -34,7 +34,7 @@ #include <string> #include "dbleGEPBAL.h" -#include "f77-uscore.h" +#include "f77-fcn.h" extern "C" {
--- a/liboctave/dbleHESS.cc +++ b/liboctave/dbleHESS.cc @@ -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 +++ b/liboctave/dbleLU.cc @@ -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 +++ b/liboctave/dbleQR.cc @@ -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 +++ b/liboctave/dbleQRP.cc @@ -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 +++ b/liboctave/dbleSCHUR.cc @@ -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 +++ b/liboctave/dbleSVD.cc @@ -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 +++ b/liboctave/erf.c @@ -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 +++ b/liboctave/erfc.c @@ -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 +++ b/liboctave/f77-fcn.h @@ -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 +++ b/liboctave/gamma.c @@ -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 +++ b/liboctave/lgamma.c @@ -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 +++ b/liboctave/utils.cc @@ -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 +++ b/src/mappers.cc @@ -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 +++ b/src/qzval.cc @@ -29,7 +29,7 @@ #include <cfloat> -#include "f77-uscore.h" +#include "f77-fcn.h" #include "defun-dld.h" #include "error.h"