Mercurial > hg > octave-nkf
diff liboctave/f77-fcn.h @ 1847:2ffe49eb95a5
[project @ 1996-02-03 12:47:55 by jwe]
author | jwe |
---|---|
date | Sat, 03 Feb 1996 12:51:32 +0000 |
parents | 611d403c7f3d |
children | 979f25fd161f |
line wrap: on
line diff
--- 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 /*