Mercurial > octave-nkf
diff libcruft/misc/f77-fcn.h @ 2544:a33bbd3fadd7
[project @ 1996-11-20 05:09:29 by jwe]
author | jwe |
---|---|
date | Wed, 20 Nov 1996 05:09:46 +0000 |
parents | |
children | 8b262e771614 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libcruft/misc/f77-fcn.h Wed Nov 20 05:09:46 1996 +0000 @@ -0,0 +1,106 @@ +/* + +Copyright (C) 1996 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. + +*/ + +#if !defined (octave_f77_fcn_h) +#define octave_f77_fcn_h 1 + +#ifdef __cplusplus +extern "C" { +#endif + +#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##_ +#else +#define F77_FCN(f, F) f##_ +#endif +#else +#if defined (F77_UPPERCASE_NAMES) +#define F77_FCN(f, F) F +#else +#define F77_FCN(f, F) f +#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; \ + f77_exception_encountered = 0; \ + copy_f77_context ((char *) f77_context, (char *) saved_f77_context, \ + sizeof (jmp_buf)); \ + if (setjmp (f77_context)) \ + { \ + f77_exception_encountered = 1; \ + 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) + +/* So we can check to see if an exception has occurred. */ +extern int f77_exception_encountered; + +/* For setjmp/longjmp. */ +extern 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); + +#ifdef __cplusplus +} +#endif + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/