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
 
 /*