23 #if ! defined (octave_f77_fcn_h) 24 #define octave_f77_fcn_h 1 26 #include "octave-config.h" 31 #if defined (__cplusplus) 35 #if defined (__cplusplus) 41 #define F77_XFCN(f, F, args) \ 44 #if ! defined (F77_FCN) 45 # define F77_FCN(f, F) F77_FUNC (f, F) 48 OCTAVE_DEPRECATED (4.4,
"this variable is obsolete and should not be needed")
106 #if defined (F77_USES_CRAY_CALLING_CONVENTION) 114 #define F77_CHAR_ARG(x) octave_make_cray_ftn_ch_dsc (x, strlen (x)) 115 #define F77_CONST_CHAR_ARG(x) \ 116 octave_make_cray_const_ftn_ch_dsc (x, strlen (x)) 117 #define F77_CHAR_ARG2(x, l) octave_make_cray_ftn_ch_dsc (x, l) 118 #define F77_CONST_CHAR_ARG2(x, l) octave_make_cray_const_ftn_ch_dsc (x, l) 119 #define F77_CXX_STRING_ARG(x) \ 120 octave_make_cray_const_ftn_ch_dsc (x.c_str (), x.length ()) 121 #define F77_CHAR_ARG_LEN(l) 122 #define F77_CHAR_ARG_LEN_TYPE 123 #define F77_CHAR_ARG_LEN_DECL 124 #define F77_CHAR_ARG_DECL octave_cray_ftn_ch_dsc 125 #define F77_CONST_CHAR_ARG_DECL octave_cray_ftn_ch_dsc 129 #define F77_CHAR_ARG_DEF(s, len) octave_cray_ftn_ch_dsc s 130 #define F77_CONST_CHAR_ARG_DEF(s, len) octave_cray_ftn_ch_dsc s 131 #define F77_CHAR_ARG_LEN_DEF(len) 132 #define F77_CHAR_ARG_USE(s) s.ptr 133 #define F77_CHAR_ARG_LEN_USE(s, len) (s.mask.len >> 3) 135 #define F77_RET_T int 142 #define F77_RETURN(retval) return retval; 143 #if defined (HAVE_OCTAVE_NORETURN_ATTR) 144 # define F77_NORETURN(retval) 146 # define F77_NORETURN(retval) return retval; 154 const char *const_ptr;
162 } octave_cray_descriptor;
164 typedef void *octave_cray_ftn_ch_dsc;
166 #if defined (__cplusplus) 167 # define OCTAVE_F77_FCN_INLINE inline 169 # define OCTAVE_F77_FCN_INLINE 172 static OCTAVE_F77_FCN_INLINE octave_cray_ftn_ch_dsc
173 octave_make_cray_ftn_ch_dsc (
char *ptr_arg,
unsigned long len_arg)
175 octave_cray_descriptor desc;
177 desc.mask.len = len_arg << 3;
178 return *((octave_cray_ftn_ch_dsc *) &desc);
181 static OCTAVE_F77_FCN_INLINE octave_cray_ftn_ch_dsc
182 octave_make_cray_const_ftn_ch_dsc (
const char *ptr_arg,
unsigned long len_arg)
184 octave_cray_descriptor desc;
185 desc.const_ptr = ptr_arg;
186 desc.mask.len = len_arg << 3;
187 return *((octave_cray_ftn_ch_dsc *) &desc);
190 #undef OCTAVE_F77_FCN_INLINE 192 #elif defined (F77_USES_VISUAL_FORTRAN_CALLING_CONVENTION) 198 #define F77_CHAR_ARG(x) x, strlen (x) 199 #define F77_CONST_CHAR_ARG(x) F77_CHAR_ARG (x) 200 #define F77_CHAR_ARG2(x, l) x, l 201 #define F77_CONST_CHAR_ARG2(x, l) F77_CHAR_ARG2 (x, l) 202 #define F77_CXX_STRING_ARG(x) F77_CONST_CHAR_ARG2 (x.c_str (), x.length ()) 203 #define F77_CHAR_ARG_LEN(l) 204 #define F77_CHAR_ARG_LEN_TYPE int 205 #define F77_CHAR_ARG_LEN_DECL 206 #define F77_CHAR_ARG_DECL char *, F77_CHAR_ARG_LEN_TYPE 207 #define F77_CONST_CHAR_ARG_DECL const char *, F77_CHAR_ARG_LEN_TYPE 209 #define F77_CHAR_ARG_DEF(s, len) char *s, F77_CHAR_ARG_LEN_TYPE len 210 #define F77_CONST_CHAR_ARG_DEF(s, len) const char *s, F77_CHAR_ARG_LEN_TYPE len 211 #define F77_CHAR_ARG_LEN_DEF(len) 212 #define F77_CHAR_ARG_USE(s) s 213 #define F77_CHAR_ARG_LEN_USE(s, len) len 215 #define F77_RET_T void 217 #define F77_RETURN(retval) return; 218 #define F77_NORETURN(retval) 220 #elif defined (F77_USES_GFORTRAN_CALLING_CONVENTION) 232 #define F77_CHAR_ARG(x) x 233 #define F77_CONST_CHAR_ARG(x) F77_CHAR_ARG (x) 234 #define F77_CHAR_ARG2(x, l) x 235 #define F77_CONST_CHAR_ARG2(x, l) F77_CHAR_ARG2 (x, l) 236 #define F77_CXX_STRING_ARG(x) F77_CONST_CHAR_ARG2 (x.c_str (), x.length ()) 237 #define F77_CHAR_ARG_LEN(l) , l 238 #if defined (__GNUC__) && __GNUC__ >= 8 239 # define F77_CHAR_ARG_LEN_TYPE size_t 241 # define F77_CHAR_ARG_LEN_TYPE int 243 #define F77_CHAR_ARG_LEN_DECL , F77_CHAR_ARG_LEN_TYPE 244 #define F77_CHAR_ARG_DECL char * 245 #define F77_CONST_CHAR_ARG_DECL const char * 247 #define F77_CHAR_ARG_DEF(s, len) char *s 248 #define F77_CONST_CHAR_ARG_DEF(s, len) const char *s 249 #define F77_CHAR_ARG_LEN_DEF(len) , F77_CHAR_ARG_LEN_TYPE len 250 #define F77_CHAR_ARG_USE(s) s 251 #define F77_CHAR_ARG_LEN_USE(s, len) len 253 #define F77_RET_T void 255 #define F77_RETURN(retval) return; 256 #if defined (HAVE_OCTAVE_NORETURN_ATTR) 257 # define F77_NORETURN(retval) 259 # define F77_NORETURN(retval) return retval; 262 #elif defined (F77_USES_F2C_CALLING_CONVENTION) 269 #define F77_CHAR_ARG(x) x 270 #define F77_CONST_CHAR_ARG(x) F77_CHAR_ARG (x) 271 #define F77_CHAR_ARG2(x, l) x 272 #define F77_CONST_CHAR_ARG2(x, l) F77_CHAR_ARG2 (x, l) 273 #define F77_CXX_STRING_ARG(x) F77_CONST_CHAR_ARG2 (x.c_str (), x.length ()) 274 #define F77_CHAR_ARG_LEN(l) , l 275 #define F77_CHAR_ARG_LEN_TYPE long 276 #define F77_CHAR_ARG_LEN_DECL , F77_CHAR_ARG_LEN_TYPE 277 #define F77_CHAR_ARG_DECL char * 278 #define F77_CONST_CHAR_ARG_DECL const char * 280 #define F77_CHAR_ARG_DEF(s, len) char *s 281 #define F77_CONST_CHAR_ARG_DEF(s, len) const char *s 282 #define F77_CHAR_ARG_LEN_DEF(len) , F77_CHAR_ARG_LEN_TYPE len 283 #define F77_CHAR_ARG_USE(s) s 284 #define F77_CHAR_ARG_LEN_USE(s, len) len 286 #define F77_RET_T int 288 #define F77_RETURN(retval) return retval; 289 #if defined (HAVE_OCTAVE_NORETURN_ATTR) 290 # define F77_NORETURN(retval) 292 # define F77_NORETURN(retval) return retval; 297 #error "unknown C++ to Fortran calling convention" 309 #define F77_CMPLX_ARG(x) \ 310 reinterpret_cast<float _Complex *> (x) 312 #define F77_CONST_CMPLX_ARG(x) \ 313 reinterpret_cast<const float _Complex *> (x) 315 #define F77_DBLE_CMPLX_ARG(x) \ 316 reinterpret_cast<double _Complex *> (x) 318 #define F77_CONST_DBLE_CMPLX_ARG(x) \ 319 reinterpret_cast<const double _Complex *> (x) 326 #define F77_CSTRING(s, len, cs) \ 327 OCTAVE_LOCAL_BUFFER (char, cs, F77_CHAR_ARG_LEN_USE (s, len) + 1); \ 328 memcpy (cs, F77_CHAR_ARG_USE (s), F77_CHAR_ARG_LEN_USE (s, len)); \ 329 cs[F77_CHAR_ARG_LEN_USE(s, len)] = '\0' 331 OCTAVE_NORETURN OCTAVE_API
extern 336 #if defined (__cplusplus) 345 (*current_liboctave_error_handler)
346 (
"integer dimension or index out of range for Fortran INTEGER type");
354 #if defined (__cplusplus) double _Complex F77_DBLE_CMPLX
F77_RET_T const F77_INT F77_INT const F77_DBLE F77_DBLE const F77_INT F77_DBLE const F77_INT F77_INT F77_INT F77_DBLE F77_DBLE const F77_INT F77_INT &F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL
static const int f77_exception_encountered
F77_RET_T F77_CONST_CHAR_ARG_DECL
F77_RET_T(F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, const F77_INT &, const F77_INT &, const F77_INT &, F77_INT &, F77_INT &, F77_DBLE *, const F77_INT &, F77_DBLE *, const F77_INT &, F77_DBLE *, F77_DBLE *, F77_DBLE *, const F77_INT &, F77_DBLE *, const F77_INT &, F77_DBLE *, const F77_INT &, F77_DBLE *, F77_INT *, F77_INT &F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL)
OCTAVE_NORETURN OCTAVE_API F77_RET_T F77_FUNC(xstopx, XSTOPX)(F77_CONST_CHAR_ARG_DECL F77_CHAR_ARG_LEN_DECL)
octave_f77_int_type F77_LOGICAL
charNDArray max(char d, const charNDArray &m)
octave_f77_int_type F77_INT
F77_RET_T const F77_REAL const F77_REAL F77_REAL &F77_RET_T const F77_DBLE const F77_DBLE F77_DBLE &F77_RET_T const F77_DBLE F77_DBLE &F77_RET_T const F77_REAL F77_REAL &F77_RET_T const F77_DBLE * x
charNDArray min(char d, const charNDArray &m)