Mercurial > octave
annotate liboctave/cruft/misc/f77-fcn.h @ 21244:1473547f50f5
include octave-config.h in public header files
* mk-opts.pl, mkbuiltins, mk-ops.awk, sparse-mk-ops.awk:
Emit "#include octave-config.h" statement for generated header files.
* build-env.h, builtins.h, Cell.h, base-text-renderer.h,
c-file-ptr-stream.h, cdisplay.h, comment-list.h, data.h, debug.h,
defaults.in.h, defun-dld.h, defun-int.h, defun.h, dirfns.h, display.h,
dynamic-ld.h, error.h, errwarn.h, event-queue.h, file-io.h,
ft-text-renderer.h, gl-render.h, gl2ps-print.h, graphics.in.h,
gripes.h, help.h, hook-fcn.h, input.h, jit-ir.h, jit-typeinfo.h,
jit-util.h, load-path.h, load-save.h, ls-ascii-helper.h, ls-hdf5.h,
ls-mat-ascii.h, ls-mat4.h, ls-mat5.h, ls-oct-binary.h, ls-oct-text.h,
ls-utils.h, mex.h, mexproto.h, mxarray.in.h, oct-errno.h, oct-fstrm.h,
oct-handle.h, oct-hdf5-types.h, oct-hdf5.h, oct-hist.h, oct-iostrm.h,
oct-lvalue.h, oct-map.h, oct-obj.h, oct-opengl.h, oct-prcstrm.h,
oct-procbuf.h, oct-stdstrm.h, oct-stream.h, oct-strstrm.h, oct.h,
octave-default-image.h, octave-link.h, octave-preserve-stream-state.h,
pager.h, pr-output.h, procstream.h, profiler.h, pt-jit.h,
sighandlers.h, siglist.h, sparse-xdiv.h, sparse-xpow.h, symtab.h,
sysdep.h, text-renderer.h, toplev.h, txt-eng.h, utils.h, variables.h,
workspace-element.h, xdiv.h, xnorm.h, xpow.h, zfstream.h, oct-qhull.h,
ov-base-diag.h, ov-base-int.h, ov-base-mat.h, ov-base-scalar.h,
ov-base-sparse.h, ov-base.h, ov-bool-mat.h, ov-bool-sparse.h,
ov-bool.h, ov-builtin.h, ov-cell.h, ov-ch-mat.h, ov-class.h,
ov-classdef.h, ov-colon.h, ov-complex.h, ov-cs-list.h, ov-cx-diag.h,
ov-cx-mat.h, ov-cx-sparse.h, ov-dld-fcn.h, ov-fcn-handle.h,
ov-fcn-inline.h, ov-fcn.h, ov-float.h, ov-flt-complex.h,
ov-flt-cx-diag.h, ov-flt-cx-mat.h, ov-flt-re-diag.h, ov-flt-re-mat.h,
ov-int-traits.h, ov-int16.h, ov-int32.h, ov-int64.h, ov-int8.h,
ov-intx.h, ov-java.h, ov-lazy-idx.h, ov-mex-fcn.h, ov-null-mat.h,
ov-oncleanup.h, ov-perm.h, ov-range.h, ov-re-diag.h, ov-re-mat.h,
ov-re-sparse.h, ov-scalar.h, ov-str-mat.h, ov-struct.h,
ov-type-conv.h, ov-typeinfo.h, ov-uint16.h, ov-uint32.h, ov-uint64.h,
ov-uint8.h, ov-usr-fcn.h, ov.h, ovl.h, octave.h, op-int.h, ops.h,
options-usage.h, lex.h, parse.h, pt-all.h, pt-arg-list.h,
pt-array-list.h, pt-assign.h, pt-binop.h, pt-bp.h, pt-cbinop.h,
pt-cell.h, pt-check.h, pt-classdef.h, pt-cmd.h, pt-colon.h,
pt-const.h, pt-decl.h, pt-eval.h, pt-except.h, pt-exp.h,
pt-fcn-handle.h, pt-funcall.h, pt-id.h, pt-idx.h, pt-jump.h,
pt-loop.h, pt-mat.h, pt-misc.h, pt-pr-code.h, pt-select.h, pt-stmt.h,
pt-unop.h, pt-walk.h, pt.h, token.h, version.in.h, Array-util.h,
Array.h, CColVector.h, CDiagMatrix.h, CMatrix.h, CNDArray.h,
CRowVector.h, CSparse.h, DiagArray2.h, MArray.h, MDiagArray2.h,
MSparse.h, Matrix.h, MatrixType.h, PermMatrix.h, Range.h, Sparse.h,
boolMatrix.h, boolNDArray.h, boolSparse.h, chMatrix.h, chNDArray.h,
dColVector.h, dDiagMatrix.h, dMatrix.h, dNDArray.h, dRowVector.h,
dSparse.h, dim-vector.h, fCColVector.h, fCDiagMatrix.h, fCMatrix.h,
fCNDArray.h, fCRowVector.h, fColVector.h, fDiagMatrix.h, fMatrix.h,
fNDArray.h, fRowVector.h, idx-vector.h, int16NDArray.h,
int32NDArray.h, int64NDArray.h, int8NDArray.h, intNDArray.h,
uint16NDArray.h, uint32NDArray.h, uint64NDArray.h, uint8NDArray.h,
f77-fcn.h, lo-error.h, quit.h, CmplxAEPBAL.h, CmplxCHOL.h,
CmplxGEPBAL.h, CmplxHESS.h, CmplxLU.h, CmplxQR.h, CmplxQRP.h,
CmplxSCHUR.h, CmplxSVD.h, CollocWt.h, DAE.h, DAEFunc.h, DAERT.h,
DAERTFunc.h, DASPK.h, DASRT.h, DASSL.h, DET.h, EIG.h, LSODE.h, ODE.h,
ODEFunc.h, ODES.h, ODESFunc.h, Quad.h, base-aepbal.h, base-dae.h,
base-de.h, base-lu.h, base-min.h, base-qr.h, bsxfun-decl.h, bsxfun.h,
dbleAEPBAL.h, dbleCHOL.h, dbleGEPBAL.h, dbleHESS.h, dbleLU.h,
dbleQR.h, dbleQRP.h, dbleSCHUR.h, dbleSVD.h, eigs-base.h,
fCmplxAEPBAL.h, fCmplxCHOL.h, fCmplxGEPBAL.h, fCmplxHESS.h,
fCmplxLU.h, fCmplxQR.h, fCmplxQRP.h, fCmplxSCHUR.h, fCmplxSVD.h,
fEIG.h, floatAEPBAL.h, floatCHOL.h, floatGEPBAL.h, floatHESS.h,
floatLU.h, floatQR.h, floatQRP.h, floatSCHUR.h, floatSVD.h,
lo-mappers.h, lo-specfun.h, oct-convn.h, oct-fftw.h, oct-norm.h,
oct-rand.h, oct-spparms.h, randgamma.h, randmtzig.h, randpoisson.h,
sparse-chol.h, sparse-dmsolve.h, sparse-lu.h, sparse-qr.h,
Sparse-diag-op-defs.h, Sparse-op-decls.h, Sparse-op-defs.h,
Sparse-perm-op-defs.h, mx-base.h, mx-defs.h, mx-ext.h, mx-op-decl.h,
mx-op-defs.h, dir-ops.h, file-ops.h, file-stat.h, lo-sysdep.h,
mach-info.h, oct-env.h, oct-group.h, oct-openmp.h, oct-passwd.h,
oct-syscalls.h, oct-time.h, oct-uname.h, pathlen.h, sysdir.h,
syswait.h, action-container.h, base-list.h, byte-swap.h,
caseless-str.h, cmd-edit.h, cmd-hist.h, data-conv.h, functor.h,
glob-match.h, lo-array-errwarn.h, lo-array-gripes.h, lo-cutils.h,
lo-ieee.h, lo-macros.h, lo-math.h, lo-regexp.h, lo-traits.h,
lo-utils.h, oct-alloc.h, oct-base64.h, oct-binmap.h, oct-cmplx.h,
oct-glob.h, oct-inttypes.h, oct-locbuf.h, oct-mutex.h, oct-refcount.h,
oct-rl-edit.h, oct-rl-hist.h, oct-shlib.h, oct-sort.h, oct-sparse.h,
pathsearch.h, singleton-cleanup.h, sparse-sort.h, sparse-util.h,
statdefs.h, str-vec.h, sun-utils.h, unwind-prot.h, url-transfer.h:
Include octave-config.h.
| author | John W. Eaton <jwe@octave.org> |
|---|---|
| date | Wed, 10 Feb 2016 14:25:53 -0500 |
| parents | a83e7a384ee0 |
| children | 5b9868c2e212 |
| rev | line source |
|---|---|
| 2544 | 1 /* |
| 2 | |
|
19697
4197fc428c7d
maint: Update copyright notices for 2015.
John W. Eaton <jwe@octave.org>
parents:
17744
diff
changeset
|
3 Copyright (C) 1996-2015 John W. Eaton |
| 2544 | 4 |
| 5 This file is part of Octave. | |
| 6 | |
| 7 Octave is free software; you can redistribute it and/or modify it | |
| 8 under the terms of the GNU General Public License as published by the | |
| 7016 | 9 Free Software Foundation; either version 3 of the License, or (at your |
| 10 option) any later version. | |
| 2544 | 11 |
| 12 Octave is distributed in the hope that it will be useful, but WITHOUT | |
| 13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 15 for more details. | |
| 16 | |
| 17 You should have received a copy of the GNU General Public License | |
| 7016 | 18 along with Octave; see the file COPYING. If not, see |
| 19 <http://www.gnu.org/licenses/>. | |
| 2544 | 20 |
| 21 */ | |
| 22 | |
|
20791
f7084eae3318
maint: Use Octave coding conventions for #if statements.
Rik <rik@octave.org>
parents:
20545
diff
changeset
|
23 #if ! defined (octave_f77_fcn_h) |
| 2544 | 24 #define octave_f77_fcn_h 1 |
| 25 | |
|
21244
1473547f50f5
include octave-config.h in public header files
John W. Eaton <jwe@octave.org>
parents:
21229
diff
changeset
|
26 #include "octave-config.h" |
|
1473547f50f5
include octave-config.h in public header files
John W. Eaton <jwe@octave.org>
parents:
21229
diff
changeset
|
27 |
| 4268 | 28 #include "quit.h" |
| 29 | |
| 2544 | 30 #ifdef __cplusplus |
| 31 extern "C" { | |
| 32 #endif | |
| 33 | |
| 4153 | 34 /* Hack to stringize macro results. */ |
| 3887 | 35 #define xSTRINGIZE(x) #x |
| 36 #define STRINGIZE(x) xSTRINGIZE(x) | |
| 2544 | 37 |
| 38 /* How to print an error for the F77_XFCN macro. */ | |
| 39 | |
| 40 #define F77_XFCN_ERROR(f, F) \ | |
| 41 (*current_liboctave_error_handler) \ | |
| 3887 | 42 ("exception encountered in Fortran subroutine %s", \ |
| 43 STRINGIZE (F77_FUNC (f, F))) | |
| 2544 | 44 |
| 45 /* This can be used to call a Fortran subroutine that might call | |
| 4153 | 46 XSTOPX. XSTOPX will call lonjmp with current_context. Once back |
| 47 here, we'll restore the previous context and return. We may also | |
| 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 | |
|
20545
c547458dc10e
eliminate error_state from most header files
John W. Eaton <jwe@octave.org>
parents:
19697
diff
changeset
|
50 to the top level. */ |
| 2544 | 51 |
| 52 #define F77_XFCN(f, F, args) \ | |
| 53 do \ | |
| 54 { \ | |
| 4182 | 55 octave_jmp_buf saved_context; \ |
| 5767 | 56 sig_atomic_t saved_octave_interrupt_immediately = octave_interrupt_immediately; \ |
| 2544 | 57 f77_exception_encountered = 0; \ |
| 5760 | 58 octave_save_current_context (saved_context); \ |
| 4153 | 59 if (octave_set_current_context) \ |
|
9930
1ddc25c3623a
libcruft/misc: untabify sources
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
60 { \ |
|
1ddc25c3623a
libcruft/misc: untabify sources
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
61 octave_interrupt_immediately = saved_octave_interrupt_immediately; \ |
| 5760 | 62 octave_restore_current_context (saved_context); \ |
|
9930
1ddc25c3623a
libcruft/misc: untabify sources
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
63 if (f77_exception_encountered) \ |
|
1ddc25c3623a
libcruft/misc: untabify sources
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
64 F77_XFCN_ERROR (f, F); \ |
| 4153 | 65 else \ |
|
9930
1ddc25c3623a
libcruft/misc: untabify sources
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
66 octave_rethrow_exception (); \ |
|
1ddc25c3623a
libcruft/misc: untabify sources
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
67 } \ |
| 2544 | 68 else \ |
| 4153 | 69 { \ |
|
9930
1ddc25c3623a
libcruft/misc: untabify sources
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
70 octave_interrupt_immediately++; \ |
|
1ddc25c3623a
libcruft/misc: untabify sources
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
71 F77_FUNC (f, F) args; \ |
|
1ddc25c3623a
libcruft/misc: untabify sources
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
72 octave_interrupt_immediately--; \ |
| 5760 | 73 octave_restore_current_context (saved_context); \ |
| 4153 | 74 } \ |
| 2544 | 75 } \ |
| 76 while (0) | |
| 77 | |
| 78 /* So we can check to see if an exception has occurred. */ | |
| 21227 | 79 OCTAVE_API extern int f77_exception_encountered; |
| 2544 | 80 |
|
20791
f7084eae3318
maint: Use Octave coding conventions for #if statements.
Rik <rik@octave.org>
parents:
20545
diff
changeset
|
81 #if ! defined (F77_FCN) |
| 3938 | 82 #define F77_FCN(f, F) F77_FUNC (f, F) |
| 83 #endif | |
| 84 | |
|
15128
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
85 /* |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
86 |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
87 The following macros are used for handling Fortran <-> C calling |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
88 conventions. They are defined below for three different types of |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
89 systems, Cray (possibly now obsolete), Visual Fortran, and any system |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
90 that is compatible with the f2c calling conventions, including g77 and |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
91 gfortran. Note that gfortran is not completely compatible with the |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
92 f2c calling conventions, but that we only use the parts that are |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
93 compatible. For example, f2c and gfortran differ in the way they |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
94 handle Fortran functions that return complex values, but Octave does |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
95 not call any Fortran functions like that directly from C or C++. |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
96 |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
97 Use these macros to pass character strings from C to Fortran: |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
98 |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
99 F77_CHAR_ARG(x) |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
100 F77_CONST_CHAR_ARG(x) |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
101 F77_CXX_STRING_ARG(x) |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
102 F77_CHAR_ARG_LEN(l) |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
103 F77_CHAR_ARG_DECL |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
104 F77_CONST_CHAR_ARG_DECL |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
105 F77_CHAR_ARG_LEN_DECL |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
106 |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
107 Use these macros to write C-language functions that accept |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
108 Fortran-style character strings: |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
109 |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
110 F77_CHAR_ARG_DEF(s, len) |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
111 F77_CONST_CHAR_ARG_DEF(s, len) |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
112 F77_CHAR_ARG_LEN_DEF(len) |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
113 F77_CHAR_ARG_USE(s) |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
114 F77_CHAR_ARG_LEN_USE(s, len) |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
115 |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
116 Use this macro to declare the return type of a C-language function |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
117 that is supposed to act like a Fortran subroutine: |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
118 |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
119 F77_RET_T int |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
120 |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
121 Use these macros to return from C-language functions that are supposed |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
122 to act like Fortran subroutines. F77_NORETURN is intended to be used |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
123 as the last statement of such a function that has been tagged with a |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
124 "noreturn" attribute. If the compiler supports the "noreturn" |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
125 attribute or if F77_RET_T is void, then it should expand to nothing so |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
126 that we avoid warnings about functions tagged as "noreturn" |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
127 containing a return statement. Otherwise, it should expand to a |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
128 statement that returns the given value so that we avoid warnings about |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
129 not returning a value from a function declared to return something. |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
130 |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
131 F77_RETURN(retval) |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
132 F77_NORETURN(retval) |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
133 |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
134 */ |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
135 |
| 4552 | 136 #if defined (F77_USES_CRAY_CALLING_CONVENTION) |
| 137 | |
| 138 #include <fortran.h> | |
| 6072 | 139 |
| 140 /* Use these macros to pass character strings from C to Fortran. */ | |
| 4552 | 141 #define F77_CHAR_ARG(x) octave_make_cray_ftn_ch_dsc (x, strlen (x)) |
| 142 #define F77_CONST_CHAR_ARG(x) \ | |
| 143 octave_make_cray_const_ftn_ch_dsc (x, strlen (x)) | |
| 4577 | 144 #define F77_CHAR_ARG2(x, l) octave_make_cray_ftn_ch_dsc (x, l) |
| 145 #define F77_CONST_CHAR_ARG2(x, l) octave_make_cray_const_ftn_ch_dsc (x, l) | |
| 4552 | 146 #define F77_CXX_STRING_ARG(x) \ |
| 147 octave_make_cray_const_ftn_ch_dsc (x.c_str (), x.length ()) | |
| 148 #define F77_CHAR_ARG_LEN(l) | |
| 4577 | 149 #define F77_CHAR_ARG_DECL octave_cray_ftn_ch_dsc |
| 150 #define F77_CONST_CHAR_ARG_DECL octave_cray_ftn_ch_dsc | |
| 4552 | 151 #define F77_CHAR_ARG_LEN_DECL |
| 6072 | 152 |
| 153 /* Use these macros to write C-language functions that accept | |
| 154 Fortran-style character strings. */ | |
| 155 #define F77_CHAR_ARG_DEF(s, len) octave_cray_ftn_ch_dsc s | |
| 156 #define F77_CONST_CHAR_ARG_DEF(s, len) octave_cray_ftn_ch_dsc s | |
|
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
157 #define F77_CHAR_ARG_LEN_DEF(len) |
| 6072 | 158 #define F77_CHAR_ARG_USE(s) s.ptr |
| 159 #define F77_CHAR_ARG_LEN_USE(s, len) (s.mask.len>>3) | |
| 160 | |
|
15128
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
161 /* Use this macro to declare the return type of a C-language function |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
162 that is supposed to act like a Fortran subroutine. */ |
| 4552 | 163 #define F77_RET_T int |
|
15128
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
164 |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
165 /* Use these macros to return from C-language functions that are |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
166 supposed to act like Fortran subroutines. F77_NORETURN is intended |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
167 to be used as the last statement of such a function that has been |
|
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
168 tagged with a "noreturn" attribute. */ |
| 4552 | 169 #define F77_RETURN(retval) return retval; |
|
21229
a83e7a384ee0
create and install a subset of config.h in octave-config.h
John W. Eaton <jwe@octave.org>
parents:
21227
diff
changeset
|
170 #if defined (HAVE_OCTAVE_NORETURN_ATTR) |
|
21202
f7121e111991
maint: indent #ifdef blocks in liboctave and src directories.
Rik <rik@octave.org>
parents:
21076
diff
changeset
|
171 # define F77_NORETURN(retval) |
|
15127
87411930d6c4
avoid "function declared 'noreturn' has a return statement" warning.
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
172 #else |
|
21202
f7121e111991
maint: indent #ifdef blocks in liboctave and src directories.
Rik <rik@octave.org>
parents:
21076
diff
changeset
|
173 # define F77_NORETURN(retval) return retval; |
|
15127
87411930d6c4
avoid "function declared 'noreturn' has a return statement" warning.
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
174 #endif |
| 4552 | 175 |
|
21066
258c787cd9ce
maint: Use "FIXME:" consistently in code base.
Rik <rik@octave.org>
parents:
21040
diff
changeset
|
176 /* FIXME: These should work for SV1 or Y-MP systems but will |
|
258c787cd9ce
maint: Use "FIXME:" consistently in code base.
Rik <rik@octave.org>
parents:
21040
diff
changeset
|
177 need to be changed for others. */ |
| 4552 | 178 |
| 4558 | 179 typedef union |
| 4552 | 180 { |
| 4558 | 181 const char *const_ptr; |
| 182 char *ptr; | |
| 4552 | 183 struct |
| 184 { | |
| 185 unsigned off : 6; | |
| 186 unsigned len : 26; | |
| 187 unsigned add : 32; | |
| 188 } mask; | |
| 4558 | 189 } octave_cray_descriptor; |
| 4552 | 190 |
| 191 typedef void *octave_cray_ftn_ch_dsc; | |
| 192 | |
| 4555 | 193 #ifdef __cplusplus |
|
21202
f7121e111991
maint: indent #ifdef blocks in liboctave and src directories.
Rik <rik@octave.org>
parents:
21076
diff
changeset
|
194 # define OCTAVE_F77_FCN_INLINE inline |
| 4558 | 195 #else |
|
21202
f7121e111991
maint: indent #ifdef blocks in liboctave and src directories.
Rik <rik@octave.org>
parents:
21076
diff
changeset
|
196 # define OCTAVE_F77_FCN_INLINE |
| 4555 | 197 #endif |
| 198 | |
| 199 static OCTAVE_F77_FCN_INLINE octave_cray_ftn_ch_dsc | |
| 4552 | 200 octave_make_cray_ftn_ch_dsc (char *ptr_arg, unsigned long len_arg) |
| 201 { | |
| 202 octave_cray_descriptor desc; | |
| 203 desc.ptr = ptr_arg; | |
| 204 desc.mask.len = len_arg << 3; | |
| 4558 | 205 return *((octave_cray_ftn_ch_dsc *) &desc); |
| 4552 | 206 } |
| 207 | |
| 4555 | 208 static OCTAVE_F77_FCN_INLINE octave_cray_ftn_ch_dsc |
| 4552 | 209 octave_make_cray_const_ftn_ch_dsc (const char *ptr_arg, unsigned long len_arg) |
| 210 { | |
| 211 octave_cray_descriptor desc; | |
| 212 desc.const_ptr = ptr_arg; | |
| 213 desc.mask.len = len_arg << 3; | |
| 4558 | 214 return *((octave_cray_ftn_ch_dsc *) &desc); |
| 4552 | 215 } |
| 216 | |
| 4555 | 217 #ifdef __cplusplus |
|
21202
f7121e111991
maint: indent #ifdef blocks in liboctave and src directories.
Rik <rik@octave.org>
parents:
21076
diff
changeset
|
218 # undef OCTAVE_F77_FCN_INLINE |
| 4555 | 219 #endif |
| 220 | |
| 4552 | 221 #elif defined (F77_USES_VISUAL_FORTRAN_CALLING_CONVENTION) |
| 222 | |
| 6072 | 223 /* Use these macros to pass character strings from C to Fortran. */ |
| 4552 | 224 #define F77_CHAR_ARG(x) x, strlen (x) |
| 225 #define F77_CONST_CHAR_ARG(x) F77_CHAR_ARG (x) | |
| 226 #define F77_CHAR_ARG2(x, l) x, l | |
| 227 #define F77_CONST_CHAR_ARG2(x, l) F77_CHAR_ARG2 (x, l) | |
| 228 #define F77_CXX_STRING_ARG(x) F77_CONST_CHAR_ARG2 (x.c_str (), x.length ()) | |
| 229 #define F77_CHAR_ARG_LEN(l) | |
| 230 #define F77_CHAR_ARG_DECL char *, int | |
| 231 #define F77_CONST_CHAR_ARG_DECL const char *, int | |
| 232 #define F77_CHAR_ARG_LEN_DECL | |
| 6072 | 233 |
| 234 #define F77_CHAR_ARG_DEF(s, len) char *s, int len | |
| 235 #define F77_CONST_CHAR_ARG_DEF(s, len) const char *s, int len | |
|
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
236 #define F77_CHAR_ARG_LEN_DEF(len) |
| 6072 | 237 #define F77_CHAR_ARG_USE(s) s |
| 238 #define F77_CHAR_ARG_LEN_USE(s, len) len | |
| 239 | |
| 4552 | 240 #define F77_RET_T void |
|
15128
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
241 |
|
15127
87411930d6c4
avoid "function declared 'noreturn' has a return statement" warning.
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
242 #define F77_RETURN(retval) return; |
|
87411930d6c4
avoid "function declared 'noreturn' has a return statement" warning.
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
243 #define F77_NORETURN(retval) |
| 4552 | 244 |
| 245 #else | |
| 246 | |
| 4572 | 247 /* Assume f2c-compatible calling convention. */ |
| 4552 | 248 |
| 249 #define F77_CHAR_ARG(x) x | |
| 250 #define F77_CONST_CHAR_ARG(x) F77_CHAR_ARG (x) | |
| 251 #define F77_CHAR_ARG2(x, l) x | |
| 252 #define F77_CONST_CHAR_ARG2(x, l) F77_CHAR_ARG2 (x, l) | |
| 253 #define F77_CXX_STRING_ARG(x) F77_CONST_CHAR_ARG2 (x.c_str (), x.length ()) | |
| 5760 | 254 #define F77_CHAR_ARG_LEN(l) , l |
| 4552 | 255 #define F77_CHAR_ARG_DECL char * |
| 256 #define F77_CONST_CHAR_ARG_DECL const char * | |
| 257 #define F77_CHAR_ARG_LEN_DECL , long | |
| 6072 | 258 |
| 259 #define F77_CHAR_ARG_DEF(s, len) char *s | |
| 260 #define F77_CONST_CHAR_ARG_DEF(s, len) const char *s | |
| 261 #define F77_CHAR_ARG_LEN_DEF(len) , long len | |
| 262 #define F77_CHAR_ARG_USE(s) s | |
| 263 #define F77_CHAR_ARG_LEN_USE(s, len) len | |
| 264 | |
| 4552 | 265 #define F77_RET_T int |
|
15128
4d52239daef5
improve internal documentation of F77_ macros.
John W. Eaton <jwe@octave.org>
parents:
15127
diff
changeset
|
266 |
| 4552 | 267 #define F77_RETURN(retval) return retval; |
|
21229
a83e7a384ee0
create and install a subset of config.h in octave-config.h
John W. Eaton <jwe@octave.org>
parents:
21227
diff
changeset
|
268 #if defined (HAVE_OCTAVE_NORETURN_ATTR) |
|
21202
f7121e111991
maint: indent #ifdef blocks in liboctave and src directories.
Rik <rik@octave.org>
parents:
21076
diff
changeset
|
269 # define F77_NORETURN(retval) |
|
15127
87411930d6c4
avoid "function declared 'noreturn' has a return statement" warning.
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
270 #else |
|
21202
f7121e111991
maint: indent #ifdef blocks in liboctave and src directories.
Rik <rik@octave.org>
parents:
21076
diff
changeset
|
271 # define F77_NORETURN(retval) return retval; |
|
15127
87411930d6c4
avoid "function declared 'noreturn' has a return statement" warning.
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
272 #endif |
| 4552 | 273 |
| 274 #endif | |
| 275 | |
| 6072 | 276 |
| 277 /* Build a C string local variable CS from the Fortran string parameter S | |
| 278 declared as F77_CHAR_ARG_DEF(s, len) or F77_CONST_CHAR_ARG_DEF(s, len). | |
|
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
279 The string will be cleaned up at the end of the current block. |
| 6072 | 280 Needs to include <cstring> and <vector>. */ |
| 281 | |
| 282 #define F77_CSTRING(s, len, cs) \ | |
| 6253 | 283 OCTAVE_LOCAL_BUFFER (char, cs, F77_CHAR_ARG_LEN_USE (s, len) + 1); \ |
| 6072 | 284 memcpy (cs, F77_CHAR_ARG_USE (s), F77_CHAR_ARG_LEN_USE (s, len)); \ |
|
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
285 cs[F77_CHAR_ARG_LEN_USE(s, len)] = '\0' |
| 6072 | 286 |
| 287 | |
| 21227 | 288 OCTAVE_NORETURN OCTAVE_API extern |
|
21076
b433f9990452
strip trailing whitespace from files
John W. Eaton <jwe@octave.org>
parents:
21066
diff
changeset
|
289 F77_RET_T |
| 4801 | 290 F77_FUNC (xstopx, XSTOPX) (F77_CONST_CHAR_ARG_DECL |
|
21029
e3b3bb522d62
maint: Move GCC_ attributes to start of declaration for future compatibility.
Rik <rik@octave.org>
parents:
20791
diff
changeset
|
291 F77_CHAR_ARG_LEN_DECL); |
| 4552 | 292 |
| 2544 | 293 #ifdef __cplusplus |
| 294 } | |
| 295 #endif | |
| 296 | |
| 297 #endif |