# HG changeset patch # User jwe # Date 848466586 0 # Node ID a33bbd3fadd708e32de9750d24b7dc03bdda2356 # Parent 050924aee81a80a62b7ccca06ba4481c17585560 [project @ 1996-11-20 05:09:29 by jwe] diff --git a/libcruft/misc/f77-fcn.c b/libcruft/misc/f77-fcn.c new file mode 100644 --- /dev/null +++ b/libcruft/misc/f77-fcn.c @@ -0,0 +1,41 @@ +/* + +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. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "f77-fcn.h" + +void +copy_f77_context (void *from, void *to, unsigned int size) +{ + memcpy (to, from, size); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/ diff --git a/libcruft/misc/f77-fcn.h b/libcruft/misc/f77-fcn.h new file mode 100644 --- /dev/null +++ b/libcruft/misc/f77-fcn.h @@ -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 + +/* 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: *** +*/ diff --git a/liboctave/f77-fcn.c b/liboctave/f77-fcn.c deleted file mode 100644 --- a/liboctave/f77-fcn.c +++ /dev/null @@ -1,41 +0,0 @@ -/* - -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. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "f77-fcn.h" - -void -copy_f77_context (void *from, void *to, unsigned int size) -{ - memcpy (to, from, size); -} - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; End: *** -*/ diff --git a/liboctave/f77-fcn.h b/liboctave/f77-fcn.h deleted file mode 100644 --- a/liboctave/f77-fcn.h +++ /dev/null @@ -1,106 +0,0 @@ -/* - -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 - -/* 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: *** -*/