Mercurial > octave-nkf

comparison libcruft/misc/f77-fcn.h @ 4153:6b96ce9f5743

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 2002-11-06 20:38:49 by jwe]
author jwe
date Wed, 06 Nov 2002 20:38:50 +0000
parents 9be12c29c7d5
children 61fba034b13b
comparison
equal deleted inserted replaced
4152:f14251d33b01 4153:6b96ce9f5743
25 25
26 #ifdef __cplusplus 26 #ifdef __cplusplus
27 extern "C" { 27 extern "C" {
28 #endif 28 #endif
29 29
30 #include <setjmp.h> 30 #include "quit.h"
31 31
32 /* hack to stringize macro results */ 32 #include <stdio.h>
33
34 /* Hack to stringize macro results. */
33 #define xSTRINGIZE(x) #x 35 #define xSTRINGIZE(x) #x
34 #define STRINGIZE(x) xSTRINGIZE(x) 36 #define STRINGIZE(x) xSTRINGIZE(x)
35 37
36 /* How to print an error for the F77_XFCN macro. */ 38 /* How to print an error for the F77_XFCN macro. */
37 39
39 (*current_liboctave_error_handler) \ 41 (*current_liboctave_error_handler) \
40 ("exception encountered in Fortran subroutine %s", \ 42 ("exception encountered in Fortran subroutine %s", \
41 STRINGIZE (F77_FUNC (f, F))) 43 STRINGIZE (F77_FUNC (f, F)))
42 44
43 /* This can be used to call a Fortran subroutine that might call 45 /* This can be used to call a Fortran subroutine that might call
44 XSTOPX. XSTOPX will call lonjmp with f77_context and we'll return, 46 XSTOPX. XSTOPX will call lonjmp with current_context. Once back
45 call the error function, restore the previous context. After using 47 here, we'll restore the previous context and return. We may also
46 this macro, error_state should be checked. */ 48 end up here if an interrupt is processed when the Fortran
49 subroutine is called. In that case, we resotre the context and go
50 to the top level. The error_state should be checked immediately
51 after this macro is used. */
47 52
48 #define F77_XFCN(f, F, args) \ 53 #define F77_XFCN(f, F, args) \
49 do \ 54 do \
50 { \ 55 { \
51 jmp_buf saved_f77_context; \ 56 jmp_buf saved_context; \
52 f77_exception_encountered = 0; \ 57 f77_exception_encountered = 0; \
53 copy_f77_context ((char *) f77_context, (char *) saved_f77_context, \ 58 octave_save_current_context ((char *) saved_context); \
54 sizeof (jmp_buf)); \ 59 if (octave_set_current_context) \
55 if (setjmp (f77_context)) \
56 { \ 60 { \
57 f77_exception_encountered = 1; \ 61 octave_restore_current_context ((char *) saved_context); \
58 F77_XFCN_ERROR (f, F); \ 62 if (f77_exception_encountered) \
63 F77_XFCN_ERROR (f, F); \
64 else \
65 OCTAVE_THROW_TO_TOP_LEVEL; \
59 } \ 66 } \
60 else \ 67 else \
61 F77_FUNC (f, F) args; \ 68 { \
62 copy_f77_context ((char *) saved_f77_context, (char *) f77_context, \ 69 octave_interrupt_immediately++; \
63 sizeof (jmp_buf)); \ 70 F77_FUNC (f, F) args; \
71 octave_interrupt_immediately--; \
72 octave_restore_current_context ((char *) saved_context); \
73 } \
64 } \ 74 } \
65 while (0) 75 while (0)
66 76
67 /* So we can check to see if an exception has occurred. */ 77 /* So we can check to see if an exception has occurred. */
68 extern int f77_exception_encountered; 78 extern int f77_exception_encountered;
69
70 /* For setjmp/longjmp. */
71 extern jmp_buf f77_context;
72
73 /* Defining this as a separate function allows us to avoid having to
74 include string.h in this file. */
75
76 extern void copy_f77_context (void *, void *, unsigned int);
77 79
78 extern void 80 extern void
79 F77_FUNC (xstopx, XSTOPX) (const char *s, long int slen) GCC_ATTR_NORETURN; 81 F77_FUNC (xstopx, XSTOPX) (const char *s, long int slen) GCC_ATTR_NORETURN;
80 82
81 #if !defined (F77_FCN) 83 #if !defined (F77_FCN)