Logo ROOT  

Reference Guide
 
Loading...
Searching...
No Matches
cfortran.h
Go to the documentation of this file.
1/* cfortran.h 4.4 */
2/* http://www-zeus.desy.de/~burow/cfortran/ */
3/* Burkhard Burow burow@desy.de 1990 - 2002. */
4
5#ifndef __CFORTRAN_LOADED
6#define __CFORTRAN_LOADED
7
8#if !defined(ROOT_TGenerator_cxx) && !defined(G__DICTIONARY)
9#warning "This header is an implementation detail, is deprecated and will be moved to ROOT/cfortran.h in ROOT 6.44, and may be removed later on from public inteface. Use instead the `cfortran.h` header from `cfitsio` library"
10#endif
11
12/*
13 THIS FILE IS PROPERTY OF BURKHARD BUROW. IF YOU ARE USING THIS FILE YOU
14 SHOULD ALSO HAVE ACCESS TO CFORTRAN.DOC WHICH PROVIDES TERMS FOR USING,
15 MODIFYING, COPYING AND DISTRIBUTING THE CFORTRAN.H PACKAGE.
16*/
17
18/* The following modifications were made by the authors of CFITSIO or by me.
19 * They are flagged below with CFITSIO, the author's initials, or KMCCARTY.
20 * PDW = Peter Wilson
21 * DM = Doug Mink
22 * LEB = Lee E Brotzman
23 * MR = Martin Reinecke
24 * WDP = William D Pence
25 * -- Kevin McCarty, for Debian (19 Dec. 2005) */
26
27/*******
28 Modifications:
29 Oct 1997: Changed symbol name extname to appendus (PDW/HSTX)
30 (Conflicted with a common variable name in FTOOLS)
31 Nov 1997: If g77Fortran defined, also define f2cFortran (PDW/HSTX)
32 Feb 1998: Let VMS see the NUM_ELEMS code. Lets programs treat
33 single strings as vectors with single elements
34 Nov 1999: If macintoxh defined, also define f2cfortran (for Mac OS-X)
35 Apr 2000: If WIN32 defined, also define PowerStationFortran and
36 VISUAL_CPLUSPLUS (Visual C++)
37 Jun 2000: If __GNUC__ and linux defined, also define f2cFortran
38 (linux/gcc environment detection)
39 Apr 2002: If __CYGWIN__ is defined, also define f2cFortran
40 Nov 2002: If __APPLE__ defined, also define f2cfortran (for Mac OS-X)
41
42 Nov 2003: If __INTEL_COMPILER or INTEL_COMPILER defined, also define
43 f2cFortran (KMCCARTY)
44 Dec 2005: If f2cFortran is defined, enforce REAL functions in FORTRAN
45 returning "double" in C. This was one of the items on
46 Burkhard's TODO list. (KMCCARTY)
47 Dec 2005: Modifications to support 8-byte integers. (MR)
48 USE AT YOUR OWN RISK!
49 Feb 2006 Added logic to typedef the symbol 'LONGLONG' to an appropriate
50 intrinsic 8-byte integer datatype (WDP)
51 Apr 2006: Modifications to support gfortran (and g77 with -fno-f2c flag)
52 since by default it returns "float" for FORTRAN REAL function.
53 (KMCCARTY)
54 May 2008: Revert commenting out of "extern" in COMMON_BLOCK_DEF macro.
55 Add braces around do-nothing ";" in 3 empty while blocks to
56 get rid of compiler warnings. Thanks to ROOT developers
57 Jacek Holeczek and Rene Brun for these suggestions. (KMCCARTY)
58 *******/
59
60/*
61 Avoid symbols already used by compilers and system *.h:
62 __ - OSF1 zukal06 V3.0 347 alpha, cc -c -std1 cfortest.c
63
64*/
65
66/*
67 Determine what 8-byte integer data type is available.
68 'long long' is now supported by most compilers, but older
69 MS Visual C++ compilers before V7.0 use '__int64' instead. (WDP)
70*/
71
72#ifndef LONGLONG_TYPE /* this may have been previously defined */
73#if defined(_MSC_VER) /* Microsoft Visual C++ */
74
75#if (_MSC_VER < 1300) /* versions earlier than V7.0 do not have 'long long' */
76 typedef __int64 LONGLONG;
77#else /* newer versions do support 'long long' */
78 typedef long long LONGLONG;
79#endif
80
81#else
82 typedef long long LONGLONG;
83#endif
84
85#define LONGLONG_TYPE
86#endif
87
88
89/* First prepare for the C compiler. */
90
91#ifndef ANSI_C_preprocessor /* i.e. user can override. */
92#ifdef __CF__KnR
93#define ANSI_C_preprocessor 0
94#else
95#ifdef __STDC__
96#define ANSI_C_preprocessor 1
97#else
98#define _cfleft 1
99#define _cfright
100#define _cfleft_cfright 0
101#define ANSI_C_preprocessor _cfleft/**/_cfright
102#endif
103#endif
104#endif
105
106#if ANSI_C_preprocessor
107#define _0(A,B) A##B
108#define _(A,B) _0(A,B) /* see cat,xcat of K&R ANSI C p. 231 */
109#define _2(A,B) A##B /* K&R ANSI C p.230: .. identifier is not replaced */
110#define _3(A,B,C) _(A,_(B,C))
111#else /* if it turns up again during rescanning. */
112#define _(A,B) A/**/B
113#define _2(A,B) A/**/B
114#define _3(A,B,C) A/**/B/**/C
115#endif
116
117#if (defined(vax)&&defined(unix)) || (defined(__vax__)&&defined(__unix__))
118#define VAXUltrix
119#endif
120
121#include <cstdio> /* NULL [in all machines stdio.h] */
122#include <cstring> /* strlen, memset, memcpy, memchr. */
123#if !( defined(VAXUltrix) || defined(sun) || (defined(apollo)&&!defined(__STDCPP__)) )
124#include <cstdlib> /* malloc,free */
125#else
126#include <malloc.h> /* Had to be removed for DomainOS h105 10.4 sys5.3 425t*/
127#ifdef apollo
128#define __CF__APOLLO67 /* __STDCPP__ is in Apollo 6.8 (i.e. ANSI) and onwards */
129#endif
130#endif
131
132#if !defined(__GNUC__) && !defined(__sun) && (defined(sun)||defined(VAXUltrix)||defined(lynx))
133#define __CF__KnR /* Sun, LynxOS and VAX Ultrix cc only supports K&R. */
134 /* Manually define __CF__KnR for HP if desired/required.*/
135#endif /* i.e. We will generate Kernighan and Ritchie C. */
136/* Note that you may define __CF__KnR before #include cfortran.h, in order to
137generate K&R C instead of the default ANSI C. The differences are mainly in the
138function prototypes and declarations. All machines, except the Apollo, work
139with either style. The Apollo's argument promotion rules require ANSI or use of
140the obsolete std_$call which we have not implemented here. Hence on the Apollo,
141only C calling FORTRAN subroutines will work using K&R style.*/
142
143
144/* Remainder of cfortran.h depends on the Fortran compiler. */
145
146/* 11/29/2003 (KMCCARTY): add *INTEL_COMPILER symbols here */
147/* 04/05/2006 (KMCCARTY): add gFortran symbol here */
148#if defined(CLIPPERFortran) || defined(pgiFortran) || defined(__INTEL_COMPILER) || defined(INTEL_COMPILER) || defined(gFortran)
149#define f2cFortran
150#endif
151
152/* VAX/VMS does not let us \-split long #if lines. */
153/* Split #if into 2 because some HP-UX can't handle long #if */
154#if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran))
155#if !(defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran)||defined(CONVEXFortran)||defined(PowerStationFortran)||defined(AbsoftUNIXFortran)||defined(AbsoftProFortran)||defined(SXFortran))
156/* If no Fortran compiler is given, we choose one for the machines we know. */
157#if defined(lynx) || defined(VAXUltrix)
158#define f2cFortran /* Lynx: Only support f2c at the moment.
159 VAXUltrix: f77 behaves like f2c.
160 Support f2c or f77 with gcc, vcc with f2c.
161 f77 with vcc works, missing link magic for f77 I/O.*/
162#endif
163/* 04/13/00 DM (CFITSIO): Add these lines for NT */
164/* with PowerStationFortran and and Visual C++ */
165#if defined(WIN32) && !defined(__CYGWIN__)
166#define PowerStationFortran
167#define VISUAL_CPLUSPLUS
168#endif
169#if defined(g77Fortran) /* 11/03/97 PDW (CFITSIO) */
170#define f2cFortran
171#endif
172#if defined(__CYGWIN__) /* 04/11/02 LEB (CFITSIO) */
173#define f2cFortran
174#endif
175#if defined(__GNUC__) && defined(linux) /* 06/21/00 PDW (CFITSIO) */
176#define f2cFortran
177#endif
178#if defined(macintosh) /* 11/1999 (CFITSIO) */
179#define f2cFortran
180#endif
181#if defined(__APPLE__) /* 11/2002 (CFITSIO) */
182#define f2cFortran
183#endif
184#if defined(__FreeBSD__)
185#define f2cFortran
186#endif
187#if defined(__hpux) /* 921107: Use __hpux instead of __hp9000s300 */
188#define hpuxFortran /* Should also allow hp9000s7/800 use.*/
189#endif
190#if defined(apollo)
191#define apolloFortran /* __CF__APOLLO67 also defines some behavior. */
192#endif
193#if defined(sun) || defined(__sun)
194#define sunFortran
195#endif
196#if defined(_IBMR2)
197#define IBMR2Fortran
198#endif
199#if defined(_CRAY)
200#define CRAYFortran /* _CRAYT3E also defines some behavior. */
201#endif
202#if defined(_SX)
203#define SXFortran
204#endif
205#if defined(mips) || defined(__mips)
206#define mipsFortran
207#endif
208#if defined(vms) || defined(__vms)
209#define vmsFortran
210#endif
211#if defined(__alpha) && defined(__unix__)
212#define DECFortran
213#endif
214#if defined(__convex__)
215#define CONVEXFortran
216#endif
217#if defined(VISUAL_CPLUSPLUS)
218#define PowerStationFortran
219#endif
220#endif /* ...Fortran */
221#endif /* ...Fortran */
222
223/* Split #if into 2 because some HP-UX can't handle long #if */
224#if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran))
225#if !(defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran)||defined(CONVEXFortran)||defined(PowerStationFortran)||defined(AbsoftUNIXFortran)||defined(AbsoftProFortran)||defined(SXFortran))
226/* If your compiler barfs on ' #error', replace # with the trigraph for # */
227 #error "cfortran.h: Can't find your environment among:\
228 - GNU gcc (g77) on Linux. \
229 - MIPS cc and f77 2.0. (e.g. Silicon Graphics, DECstations, ...) \
230 - IBM AIX XL C and FORTRAN Compiler/6000 Version 01.01.0000.0000 \
231 - VAX VMS CC 3.1 and FORTRAN 5.4. \
232 - Alpha VMS DEC C 1.3 and DEC FORTRAN 6.0. \
233 - Alpha OSF DEC C and DEC Fortran for OSF/1 AXP Version 1.2 \
234 - Apollo DomainOS 10.2 (sys5.3) with f77 10.7 and cc 6.7. \
235 - CRAY \
236 - NEC SX-4 SUPER-UX \
237 - CONVEX \
238 - Sun \
239 - PowerStation Fortran with Visual C++ \
240 - HP9000s300/s700/s800 Latest test with: HP-UX A.08.07 A 9000/730 \
241 - LynxOS: cc or gcc with f2c. \
242 - VAXUltrix: vcc,cc or gcc with f2c. gcc or cc with f77. \
243 - f77 with vcc works; but missing link magic for f77 I/O. \
244 - NO fort. None of gcc, cc or vcc generate required names.\
245 - f2c/g77: Use #define f2cFortran, or cc -Df2cFortran \
246 - gfortran: Use #define gFortran, or cc -DgFortran \
247 (also necessary for g77 with -fno-f2c option) \
248 - NAG f90: Use #define NAGf90Fortran, or cc -DNAGf90Fortran \
249 - Absoft UNIX F77: Use #define AbsoftUNIXFortran or cc -DAbsoftUNIXFortran \
250 - Absoft Pro Fortran: Use #define AbsoftProFortran \
251 - Portland Group Fortran: Use #define pgiFortran \
252 - Intel Fortran: Use #define INTEL_COMPILER"
253/* Compiler must throw us out at this point! */
254#endif
255#endif
256
257
258#if defined(VAXC) && !defined(__VAXC)
259#define OLD_VAXC
260#pragma nostandard /* Prevent %CC-I-PARAMNOTUSED. */
261#endif
262
263/* Throughout cfortran.h we use: UN = Uppercase Name. LN = Lowercase Name. */
264
265/* "extname" changed to "appendus" below (CFITSIO) */
266#if defined(f2cFortran) || defined(NAGf90Fortran) || defined(DECFortran) || defined(mipsFortran) || defined(apolloFortran) || defined(sunFortran) || defined(CONVEXFortran) || defined(SXFortran) || defined(appendus)
267#define CFC_(UN,LN) _(LN,_) /* Lowercase FORTRAN symbols. */
268#define orig_fcallsc(UN,LN) CFC_(UN,LN)
269#else
270#if defined(CRAYFortran) || defined(PowerStationFortran) || defined(AbsoftProFortran)
271#ifdef _CRAY /* (UN), not UN, circumvents CRAY preprocessor bug. */
272#define CFC_(UN,LN) (UN) /* Uppercase FORTRAN symbols. */
273#else /* At least VISUAL_CPLUSPLUS barfs on (UN), so need UN. */
274#define CFC_(UN,LN) UN /* Uppercase FORTRAN symbols. */
275#endif
276#define orig_fcallsc(UN,LN) CFC_(UN,LN) /* CRAY insists on arg.'s here. */
277#else /* For following machines one may wish to change the fcallsc default. */
278#define CF_SAME_NAMESPACE
279#ifdef vmsFortran
280#define CFC_(UN,LN) LN /* Either case FORTRAN symbols. */
281 /* BUT we usually use UN for C macro to FORTRAN routines, so use LN here,*/
282 /* because VAX/VMS doesn't do recursive macros. */
283#define orig_fcallsc(UN,LN) UN
284#else /* HP-UX without +ppu or IBMR2 without -qextname. NOT reccomended. */
285#define CFC_(UN,LN) LN /* Lowercase FORTRAN symbols. */
286#define orig_fcallsc(UN,LN) CFC_(UN,LN)
287#endif /* vmsFortran */
288#endif /* CRAYFortran PowerStationFortran */
289#endif /* ....Fortran */
290
291#define fcallsc(UN,LN) orig_fcallsc(UN,LN)
292#define preface_fcallsc(P,p,UN,LN) CFC_(_(P,UN),_(p,LN))
293#define append_fcallsc(P,p,UN,LN) CFC_(_(UN,P),_(LN,p))
294
295#define C_FUNCTION(UN,LN) fcallsc(UN,LN)
296#define FORTRAN_FUNCTION(UN,LN) CFC_(UN,LN)
297
298#ifndef COMMON_BLOCK
299#ifndef CONVEXFortran
300#ifndef CLIPPERFortran
301#if !(defined(AbsoftUNIXFortran)||defined(AbsoftProFortran))
302#define COMMON_BLOCK(UN,LN) CFC_(UN,LN)
303#else
304#define COMMON_BLOCK(UN,LN) _(_C,LN)
305#endif /* AbsoftUNIXFortran or AbsoftProFortran */
306#else
307#define COMMON_BLOCK(UN,LN) _(LN,__)
308#endif /* CLIPPERFortran */
309#else
310#define COMMON_BLOCK(UN,LN) _3(_,LN,_)
311#endif /* CONVEXFortran */
312#endif /* COMMON_BLOCK */
313
314#ifndef DOUBLE_PRECISION
315#if defined(CRAYFortran) && !defined(_CRAYT3E)
316#define DOUBLE_PRECISION long double
317#else
318#define DOUBLE_PRECISION double
319#endif
320#endif
321
322#ifndef FORTRAN_REAL
323#if defined(CRAYFortran) && defined(_CRAYT3E)
324#define FORTRAN_REAL double
325#else
326#define FORTRAN_REAL float
327#endif
328#endif
329
330#ifdef CRAYFortran
331#ifdef _CRAY
332#include <fortran.h>
333#else
334#include "fortran.h" /* i.e. if crosscompiling assume user has file. */
335#endif
336#define FLOATVVVVVVV_cfPP (FORTRAN_REAL *) /* Used for C calls FORTRAN. */
337/* CRAY's double==float but CRAY says pointers to doubles and floats are diff.*/
338#define VOIDP (void *) /* When FORTRAN calls C, we don't know if C routine
339 arg.'s have been declared float *, or double *. */
340#else
341#define FLOATVVVVVVV_cfPP
342#define VOIDP
343#endif
344
345#ifdef vmsFortran
346#if defined(vms) || defined(__vms)
347#include <descrip.h>
348#else
349#include "descrip.h" /* i.e. if crosscompiling assume user has file. */
350#endif
351#endif
352
353#ifdef sunFortran
354#if defined(sun) || defined(__sun)
355#include <cmath> /* Sun's FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT. */
356#else
357#include "math.h" /* i.e. if crosscompiling assume user has file. */
358#endif
359/* At least starting with the default C compiler SC3.0.1 of SunOS 5.3,
360 * FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT are not required and not in
361 * <cmath>, since sun C no longer promotes C float return values to doubles.
362 * Therefore, only use them if defined.
363 * Even if gcc is being used, assume that it exhibits the Sun C compiler
364 * behavior in order to be able to use *.o from the Sun C compiler.
365 * i.e. If FLOATFUNCTIONTYPE, etc. are in math.h, they required by gcc.
366 */
367#endif
368
369#ifndef apolloFortran
370#define COMMON_BLOCK_DEF(DEFINITION, NAME) extern DEFINITION NAME
371#define CF_NULL_PROTO
372#else /* HP doesn't understand #elif. */
373/* Without ANSI prototyping, Apollo promotes float functions to double. */
374/* Note that VAX/VMS, IBM, Mips choke on 'type function(...);' prototypes. */
375#define CF_NULL_PROTO ...
376#ifndef __CF__APOLLO67
377#define COMMON_BLOCK_DEF(DEFINITION, NAME) \
378 DEFINITION NAME __attribute((__section(NAME)))
379#else
380#define COMMON_BLOCK_DEF(DEFINITION, NAME) \
381 DEFINITION NAME #attribute[section(NAME)]
382#endif
383#endif
384
385#ifdef __cplusplus
386#undef CF_NULL_PROTO
387#define CF_NULL_PROTO ...
388#endif
389
390
391#ifndef USE_NEW_DELETE
392#ifdef __cplusplus
393#define USE_NEW_DELETE 1
394#else
395#define USE_NEW_DELETE 0
396#endif
397#endif
398#if USE_NEW_DELETE
399#define _cf_malloc(N) new char[N]
400#define _cf_free(P) delete[] P
401#else
402#define _cf_malloc(N) (char *)malloc(N)
403#define _cf_free(P) free(P)
404#endif
405
406#ifdef mipsFortran
407#define CF_DECLARE_GETARG int f77argc; char **f77argv
408#define CF_SET_GETARG(ARGC,ARGV) f77argc = ARGC; f77argv = ARGV
409#else
410#define CF_DECLARE_GETARG
411#define CF_SET_GETARG(ARGC,ARGV)
412#endif
413
414#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */
415#pragma standard
416#endif
417
418#define AcfCOMMA ,
419#define AcfCOLON ;
420
421/*-------------------------------------------------------------------------*/
422
423/* UTILITIES USED WITHIN CFORTRAN.H */
424
425#define _cfMIN(A,B) (A<B?A:B)
426
427/* 970211 - XIX.145:
428 firstindexlength - better name is all_but_last_index_lengths
429 secondindexlength - better name is last_index_length
430 */
431#define firstindexlength(A) (sizeof(A[0])==1 ? 1 : (sizeof(A) / sizeof(A[0])) )
432#define secondindexlength(A) (sizeof(A[0])==1 ? sizeof(A) : sizeof(A[0]) )
433
434/* Behavior of FORTRAN LOGICAL. All machines' LOGICAL is same size as C's int.
435Conversion is automatic except for arrays which require F2CLOGICALV/C2FLOGICALV.
436f2c, MIPS f77 [DECstation, SGI], VAX Ultrix f77,
437HP-UX f77 : as in C.
438VAX/VMS FORTRAN, VAX Ultrix fort,
439Absoft Unix Fortran, IBM RS/6000 xlf : LS Bit = 0/1 = TRUE/FALSE.
440Apollo : neg. = TRUE, else FALSE.
441[Apollo accepts -1 as TRUE for function values, but NOT all other neg. values.]
442[DECFortran for Ultrix RISC is also called f77 but is the same as VAX/VMS.]
443[MIPS f77 treats .eqv./.neqv. as .eq./.ne. and hence requires LOGICAL_STRICT.]*/
444
445#if defined(NAGf90Fortran) || defined(f2cFortran) || defined(mipsFortran) || defined(PowerStationFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) || defined(AbsoftProFortran) || defined(SXFortran)
446/* SX/PowerStationFortran have 0 and 1 defined, others are neither T nor F. */
447/* hpuxFortran800 has 0 and 0x01000000 defined. Others are unknown. */
448#define LOGICAL_STRICT /* Other Fortran have .eqv./.neqv. == .eq./.ne. */
449#endif
450
451#define C2FLOGICALV(A,I) \
452 do {int __i; for(__i=0;__i<I;__i++) A[__i]=C2FLOGICAL(A[__i]); } while (0)
453#define F2CLOGICALV(A,I) \
454 do {int __i; for(__i=0;__i<I;__i++) A[__i]=F2CLOGICAL(A[__i]); } while (0)
455
456#if defined(apolloFortran)
457#define C2FLOGICAL(L) ((L)?-1:(L)&~((unsigned)1<<sizeof(int)*8-1))
458#define F2CLOGICAL(L) ((L)<0?(L):0)
459#else
460#if defined(CRAYFortran)
461#define C2FLOGICAL(L) _btol(L)
462#define F2CLOGICAL(L) _ltob(&(L)) /* Strangely _ltob() expects a pointer. */
463#else
464#if defined(IBMR2Fortran) || defined(vmsFortran) || defined(DECFortran) || defined(AbsoftUNIXFortran)
465/* How come no AbsoftProFortran ? */
466#define C2FLOGICAL(L) ((L)?(L)|1:(L)&~(int)1)
467#define F2CLOGICAL(L) ((L)&1?(L):0)
468#else
469#if defined(CONVEXFortran)
470#define C2FLOGICAL(L) ((L) ? ~0 : 0 )
471#define F2CLOGICAL(L) (L)
472#else /* others evaluate LOGICALs as for C. */
473#define C2FLOGICAL(L) (L)
474#define F2CLOGICAL(L) (L)
475#ifndef LOGICAL_STRICT
476#undef C2FLOGICALV
477#undef F2CLOGICALV
478#define C2FLOGICALV(A,I)
479#define F2CLOGICALV(A,I)
480#endif /* LOGICAL_STRICT */
481#endif /* CONVEXFortran || All Others */
482#endif /* IBMR2Fortran vmsFortran DECFortran AbsoftUNIXFortran */
483#endif /* CRAYFortran */
484#endif /* apolloFortran */
485
486/* 970514 - In addition to CRAY, there may be other machines
487 for which LOGICAL_STRICT makes no sense. */
488#if defined(LOGICAL_STRICT) && !defined(CRAYFortran)
489/* Force C2FLOGICAL to generate only the values for either .TRUE. or .FALSE.
490 SX/PowerStationFortran only have 0 and 1 defined.
491 Elsewhere, only needed if you want to do:
492 logical lvariable
493 if (lvariable .eq. .true.) then ! (1)
494 instead of
495 if (lvariable .eqv. .true.) then ! (2)
496 - (1) may not even be FORTRAN/77 and that Apollo's f77 and IBM's xlf
497 refuse to compile (1), so you are probably well advised to stay away from
498 (1) and from LOGICAL_STRICT.
499 - You pay a (slight) performance penalty for using LOGICAL_STRICT. */
500#undef C2FLOGICAL
501#ifdef hpuxFortran800
502#define C2FLOGICAL(L) ((L)?0x01000000:0)
503#else
504#if defined(apolloFortran) || defined(vmsFortran) || defined(DECFortran)
505#define C2FLOGICAL(L) ((L)?-1:0) /* These machines use -1/0 for .true./.false.*/
506#else
507#define C2FLOGICAL(L) ((L)? 1:0) /* All others use +1/0 for .true./.false.*/
508#endif
509#endif
510#endif /* LOGICAL_STRICT */
511
512/* Convert a vector of C strings into FORTRAN strings. */
513#ifndef __CF__KnR
514static char *c2fstrv(char* cstr, char *fstr, int elem_len, int sizeofcstr)
515#else
516static char *c2fstrv( cstr, fstr, elem_len, sizeofcstr)
517 char* cstr; char *fstr; int elem_len; int sizeofcstr;
518#endif
519{ int i,j;
520/* elem_len includes \0 for C strings. Fortran strings don't have term. \0.
521 Useful size of string must be the same in both languages. */
522for (i=0; i<sizeofcstr/elem_len; i++) {
523 for (j=1; j<elem_len && *cstr; j++) *fstr++ = *cstr++;
524 cstr += 1+elem_len-j;
525 for (; j<elem_len; j++) *fstr++ = ' ';
526} /* 95109 - Seems to be returning the original fstr. */
527return fstr-sizeofcstr+sizeofcstr/elem_len; }
528
529/* Convert a vector of FORTRAN strings into C strings. */
530#ifndef __CF__KnR
531static char *f2cstrv(char *fstr, char* cstr, int elem_len, int sizeofcstr)
532#else
533static char *f2cstrv( fstr, cstr, elem_len, sizeofcstr)
534 char *fstr; char* cstr; int elem_len; int sizeofcstr;
535#endif
536{ int i,j;
537/* elem_len includes \0 for C strings. Fortran strings don't have term. \0.
538 Useful size of string must be the same in both languages. */
539cstr += sizeofcstr;
540fstr += sizeofcstr - sizeofcstr/elem_len;
541for (i=0; i<sizeofcstr/elem_len; i++) {
542 *--cstr = '\0';
543 for (j=1; j<elem_len; j++) *--cstr = *--fstr;
544} return cstr; }
545
546/* kill the trailing char t's in string s. */
547#ifndef __CF__KnR
548static char *kill_trailing(char *s, char t)
549#else
550static char *kill_trailing( s, t) char *s; char t;
551#endif
552{char *e;
553e = s + strlen(s);
554if (e>s) { /* Need this to handle NULL string.*/
555 while (e>s && *--e==t) {;} /* Don't follow t's past beginning. */
556 e[*e==t?0:1] = '\0'; /* Handle s[0]=t correctly. */
557} return s; }
558
559/* kill_trailingn(s,t,e) will kill the trailing t's in string s. e normally
560points to the terminating '\0' of s, but may actually point to anywhere in s.
561s's new '\0' will be placed at e or earlier in order to remove any trailing t's.
562If e<s string s is left unchanged. */
563#ifndef __CF__KnR
564static char *kill_trailingn(char *s, char t, char *e)
565#else
566static char *kill_trailingn( s, t, e) char *s; char t; char *e;
567#endif
568{
569if (e==s) *e = '\0'; /* Kill the string makes sense here.*/
570else if (e>s) { /* Watch out for neg. length string.*/
571 while (e>s && *--e==t){;} /* Don't follow t's past beginning. */
572 e[*e==t?0:1] = '\0'; /* Handle s[0]=t correctly. */
573} return s; }
574
575/* Note the following assumes that any element which has t's to be chopped off,
576does indeed fill the entire element. */
577#ifndef __CF__KnR
578static char *vkill_trailing(char* cstr, int elem_len, int sizeofcstr, char t)
579#else
580static char *vkill_trailing( cstr, elem_len, sizeofcstr, t)
581 char* cstr; int elem_len; int sizeofcstr; char t;
582#endif
583{ int i;
584for (i=0; i<sizeofcstr/elem_len; i++) /* elem_len includes \0 for C strings. */
585 kill_trailingn(cstr+elem_len*i,t,cstr+elem_len*(i+1)-1);
586return cstr; }
587
588#ifdef vmsFortran
589typedef struct dsc$descriptor_s fstring;
590#define DSC$DESCRIPTOR_A(DIMCT) \
591struct { \
592 unsigned short dsc$w_length; unsigned char dsc$b_dtype; \
593 unsigned char dsc$b_class; char *dsc$a_pointer; \
594 char dsc$b_scale; unsigned char dsc$b_digits; \
595 struct { \
596 unsigned : 3; unsigned dsc$v_fl_binscale : 1; \
597 unsigned dsc$v_fl_redim : 1; unsigned dsc$v_fl_column : 1; \
598 unsigned dsc$v_fl_coeff : 1; unsigned dsc$v_fl_bounds : 1; \
599 } dsc$b_aflags; \
600 unsigned char dsc$b_dimct; unsigned long dsc$l_arsize; \
601 char *dsc$a_a0; long dsc$l_m [DIMCT]; \
602 struct { \
603 long dsc$l_l; long dsc$l_u; \
604 } dsc$bounds [DIMCT]; \
605}
606typedef DSC$DESCRIPTOR_A(1) fstringvector;
607/*typedef DSC$DESCRIPTOR_A(2) fstringarrarr;
608 typedef DSC$DESCRIPTOR_A(3) fstringarrarrarr;*/
609#define initfstr(F,C,ELEMNO,ELEMLEN) \
610( (F).dsc$l_arsize= ( (F).dsc$w_length =(ELEMLEN) ) \
611 *( (F).dsc$l_m[0]=(F).dsc$bounds[0].dsc$l_u=(ELEMNO) ), \
612 (F).dsc$a_a0 = ( (F).dsc$a_pointer=(C) ) - (F).dsc$w_length ,(F))
613
614#endif /* PDW: 2/10/98 (CFITSIO) -- Let VMS see NUM_ELEMS definitions */
615#define _NUM_ELEMS -1
616#define _NUM_ELEM_ARG -2
617#define NUM_ELEMS(A) A,_NUM_ELEMS
618#define NUM_ELEM_ARG(B) *_2(A,B),_NUM_ELEM_ARG
619#define TERM_CHARS(A,B) A,B
620static void __cfortran__notused_dummy();
621#ifndef __CF__KnR
622static int num_elem(char *strv, unsigned elem_len, int term_char, int num_term)
623#else
624static int num_elem( strv, elem_len, term_char, num_term)
625 char *strv; unsigned elem_len; int term_char; int num_term;
626#endif
627/* elem_len is the number of characters in each element of strv, the FORTRAN
628vector of strings. The last element of the vector must begin with at least
629num_term term_char characters, so that this routine can determine how
630many elements are in the vector. */
631{
632unsigned num,i;
633if (num_term == _NUM_ELEMS || num_term == _NUM_ELEM_ARG)
634 return term_char;
635if (num_term <=0) num_term = (int)elem_len;
636for (num=0; ; num++) {
637 for (i=0; i<(unsigned)num_term && *strv==term_char; i++,strv++){;}
638 if (i==(unsigned)num_term) break;
639 else strv += elem_len-i;
640}
641if (num==0) __cfortran__notused_dummy();
642return (int)num;
643}
644
645static void __cfortran__notused_dummy()
646{
647 /* to prevent not used warnings in gcc (added by ROOT) */
648 if (0) {
649 c2fstrv(0, 0, 0, 0); f2cstrv(0, 0, 0, 0); kill_trailing(0, 0);
650 vkill_trailing(0, 0, 0, 0); num_elem(0, 0, 0, 0);
651 }
652}
653
654/* #endif removed 2/10/98 (CFITSIO) */
655
656/*-------------------------------------------------------------------------*/
657
658/* UTILITIES FOR C TO USE STRINGS IN FORTRAN COMMON BLOCKS */
659
660/* C string TO Fortran Common Block STRing. */
661/* DIM is the number of DIMensions of the array in terms of strings, not
662 characters. e.g. char a[12] has DIM = 0, char a[12][4] has DIM = 1, etc. */
663#define C2FCBSTR(CSTR,FSTR,DIM) \
664 c2fstrv((char *)CSTR, (char *)FSTR, sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \
665 sizeof(FSTR)+cfelementsof(FSTR,DIM))
666
667/* Fortran Common Block string TO C STRing. */
668#define FCB2CSTR(FSTR,CSTR,DIM) \
669 vkill_trailing(f2cstrv((char *)FSTR, (char *)CSTR, \
670 sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \
671 sizeof(FSTR)+cfelementsof(FSTR,DIM)), \
672 sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \
673 sizeof(FSTR)+cfelementsof(FSTR,DIM), ' ')
674
675#define cfDEREFERENCE0
676#define cfDEREFERENCE1 *
677#define cfDEREFERENCE2 **
678#define cfDEREFERENCE3 ***
679#define cfDEREFERENCE4 ****
680#define cfDEREFERENCE5 *****
681#define cfelementsof(A,D) (sizeof(A)/sizeof(_(cfDEREFERENCE,D)(A)))
682
683/*-------------------------------------------------------------------------*/
684
685/* UTILITIES FOR C TO CALL FORTRAN SUBROUTINES */
686
687/* Define lookup tables for how to handle the various types of variables. */
688
689#ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */
690#pragma nostandard
691#endif
692
693#define ZTRINGV_NUM(I) I
694#define ZTRINGV_ARGFP(I) (*(_2(A,I))) /* Undocumented. For PINT, etc. */
695#define ZTRINGV_ARGF(I) _2(A,I)
696#ifdef CFSUBASFUN
697#define ZTRINGV_ARGS(I) ZTRINGV_ARGF(I)
698#else
699#define ZTRINGV_ARGS(I) _2(B,I)
700#endif
701
702#define PBYTE_cfVP(A,B) PINT_cfVP(A,B)
703#define PDOUBLE_cfVP(A,B)
704#define PFLOAT_cfVP(A,B)
705#ifdef ZTRINGV_ARGS_allows_Pvariables
706/* This allows Pvariables for ARGS. ARGF machinery is above ARGFP.
707 * B is not needed because the variable may be changed by the Fortran routine,
708 * but because B is the only way to access an arbitrary macro argument. */
709#define PINT_cfVP(A,B) int B = (int)A; /* For ZSTRINGV_ARGS */
710#else
711#define PINT_cfVP(A,B)
712#endif
713#define PLOGICAL_cfVP(A,B) int *B; /* Returning LOGICAL in FUNn and SUBn */
714#define PLONG_cfVP(A,B) PINT_cfVP(A,B)
715#define PSHORT_cfVP(A,B) PINT_cfVP(A,B)
716
717#define VCF_INT_S(T,A,B) _(T,VVVVVVV_cfTYPE) B = A;
718#define VCF_INT_F(T,A,B) _(T,_cfVCF)(A,B)
719/* _cfVCF table is directly mapped to _cfCCC table. */
720#define BYTE_cfVCF(A,B)
721#define DOUBLE_cfVCF(A,B)
722#if !defined(__CF__KnR)
723#define FLOAT_cfVCF(A,B)
724#else
725#define FLOAT_cfVCF(A,B) FORTRAN_REAL B = A;
726#endif
727#define INT_cfVCF(A,B)
728#define LOGICAL_cfVCF(A,B)
729#define LONG_cfVCF(A,B)
730#define SHORT_cfVCF(A,B)
731
732/* 980416
733 Cast (void (*)(CF_NULL_PROTO)) causes SunOS CC 4.2 occasionally to barf,
734 while the following equivalent typedef is fine.
735 For consistency use the typedef on all machines.
736 */
737typedef void (*cfCAST_FUNCTION)(CF_NULL_PROTO);
738
739#define VCF(TN,I) _Icf4(4,V,TN,_(A,I),_(B,I),F)
740#define VVCF(TN,AI,BI) _Icf4(4,V,TN,AI,BI,S)
741#define INT_cfV(T,A,B,F) _(VCF_INT_,F)(T,A,B)
742#define INTV_cfV(T,A,B,F)
743#define INTVV_cfV(T,A,B,F)
744#define INTVVV_cfV(T,A,B,F)
745#define INTVVVV_cfV(T,A,B,F)
746#define INTVVVVV_cfV(T,A,B,F)
747#define INTVVVVVV_cfV(T,A,B,F)
748#define INTVVVVVVV_cfV(T,A,B,F)
749#define PINT_cfV( T,A,B,F) _(T,_cfVP)(A,B)
750#define PVOID_cfV( T,A,B,F)
751#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) || defined(AbsoftProFortran)
752#define ROUTINE_cfV(T,A,B,F) void (*B)(CF_NULL_PROTO) = (cfCAST_FUNCTION)A;
753#else
754#define ROUTINE_cfV(T,A,B,F)
755#endif
756#define SIMPLE_cfV(T,A,B,F)
757#ifdef vmsFortran
758#define STRING_cfV(T,A,B,F) static struct {fstring f; unsigned clen;} B = \
759 {{0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL},0};
760#define PSTRING_cfV(T,A,B,F) static fstring B={0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL};
761#define STRINGV_cfV(T,A,B,F) static fstringvector B = \
762 {sizeof(A),DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,1,1,1},1,0,NULL,0,{1,0}};
763#define PSTRINGV_cfV(T,A,B,F) static fstringvector B = \
764 {0,DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,1,1,1},1,0,NULL,0,{1,0}};
765#else
766#define STRING_cfV(T,A,B,F) struct {unsigned int clen, flen; char *nombre;} B;
767#define STRINGV_cfV(T,A,B,F) struct {char *s, *fs; unsigned flen; char *nombre;} B;
768#define PSTRING_cfV(T,A,B,F) int B;
769#define PSTRINGV_cfV(T,A,B,F) struct{char *fs; unsigned int sizeofA,flen;}B;
770#endif
771#define ZTRINGV_cfV(T,A,B,F) STRINGV_cfV(T,A,B,F)
772#define PZTRINGV_cfV(T,A,B,F) PSTRINGV_cfV(T,A,B,F)
773
774/* Note that the actions of the A table were performed inside the AA table.
775 VAX Ultrix vcc, and HP-UX cc, didn't evaluate arguments to functions left to
776 right, so we had to split the original table into the current robust two. */
777#define ACF(NAME,TN,AI,I) _(TN,_cfSTR)(4,A,NAME,I,AI,_(B,I),0)
778#define DEFAULT_cfA(M,I,A,B)
779#define LOGICAL_cfA(M,I,A,B) B=C2FLOGICAL(B);
780#define PLOGICAL_cfA(M,I,A,B) A=C2FLOGICAL(A);
781#define STRING_cfA(M,I,A,B) STRING_cfC(M,I,A,B,sizeof(A))
782#define PSTRING_cfA(M,I,A,B) PSTRING_cfC(M,I,A,B,sizeof(A))
783#ifdef vmsFortran
784#define AATRINGV_cfA( A,B, sA,filA,silA) \
785 initfstr(B,_cf_malloc((sA)-(filA)),(filA),(silA)-1), \
786 c2fstrv(A,B.dsc$a_pointer,(silA),(sA));
787#define APATRINGV_cfA( A,B, sA,filA,silA) \
788 initfstr(B,A,(filA),(silA)-1),c2fstrv(A,A,(silA),(sA));
789#else
790#define AATRINGV_cfA( A,B, sA,filA,silA) \
791 (B.s=_cf_malloc((sA)-(filA)),B.fs=c2fstrv(A,B.s,(B.flen=(silA)-1)+1,(sA)));
792#define APATRINGV_cfA( A,B, sA,filA,silA) \
793 B.fs=c2fstrv(A,A,(B.flen=(silA)-1)+1,B.sizeofA=(sA));
794#endif
795#define STRINGV_cfA(M,I,A,B) \
796 AATRINGV_cfA((char *)A,B,sizeof(A),firstindexlength(A),secondindexlength(A))
797#define PSTRINGV_cfA(M,I,A,B) \
798 APATRINGV_cfA((char *)A,B,sizeof(A),firstindexlength(A),secondindexlength(A))
799#define ZTRINGV_cfA(M,I,A,B) AATRINGV_cfA( (char *)A,B, \
800 (_3(M,_ELEMS_,I))*(( _3(M,_ELEMLEN_,I))+1), \
801 (_3(M,_ELEMS_,I)),(_3(M,_ELEMLEN_,I))+1)
802#define PZTRINGV_cfA(M,I,A,B) APATRINGV_cfA( (char *)A,B, \
803 (_3(M,_ELEMS_,I))*(( _3(M,_ELEMLEN_,I))+1), \
804 (_3(M,_ELEMS_,I)),(_3(M,_ELEMLEN_,I))+1)
805
806#define PBYTE_cfAAP(A,B) &A
807#define PDOUBLE_cfAAP(A,B) &A
808#define PFLOAT_cfAAP(A,B) FLOATVVVVVVV_cfPP &A
809#define PINT_cfAAP(A,B) &A
810#define PLOGICAL_cfAAP(A,B) B= &A /* B used to keep a common W table. */
811#define PLONG_cfAAP(A,B) &A
812#define PSHORT_cfAAP(A,B) &A
813
814#define AACF(TN,AI,I,C) _SEP_(TN,C,cfCOMMA) _Icf(3,AA,TN,AI,_(B,I))
815#define INT_cfAA(T,A,B) &B
816#define INTV_cfAA(T,A,B) _(T,VVVVVV_cfPP) A
817#define INTVV_cfAA(T,A,B) _(T,VVVVV_cfPP) A[0]
818#define INTVVV_cfAA(T,A,B) _(T,VVVV_cfPP) A[0][0]
819#define INTVVVV_cfAA(T,A,B) _(T,VVV_cfPP) A[0][0][0]
820#define INTVVVVV_cfAA(T,A,B) _(T,VV_cfPP) A[0][0][0][0]
821#define INTVVVVVV_cfAA(T,A,B) _(T,V_cfPP) A[0][0][0][0][0]
822#define INTVVVVVVV_cfAA(T,A,B) _(T,_cfPP) A[0][0][0][0][0][0]
823#define PINT_cfAA(T,A,B) _(T,_cfAAP)(A,B)
824#define PVOID_cfAA(T,A,B) (void *) A
825#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
826#define ROUTINE_cfAA(T,A,B) &B
827#else
828#define ROUTINE_cfAA(T,A,B) (cfCAST_FUNCTION)A
829#endif
830#define STRING_cfAA(T,A,B) STRING_cfCC(T,A,B)
831#define PSTRING_cfAA(T,A,B) PSTRING_cfCC(T,A,B)
832#ifdef vmsFortran
833#define STRINGV_cfAA(T,A,B) &B
834#else
835#ifdef CRAYFortran
836#define STRINGV_cfAA(T,A,B) _cptofcd(B.fs,B.flen)
837#else
838#define STRINGV_cfAA(T,A,B) B.fs
839#endif
840#endif
841#define PSTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B)
842#define ZTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B)
843#define PZTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B)
844
845#if defined(vmsFortran) || defined(CRAYFortran)
846#define JCF(TN,I)
847#define KCF(TN,I)
848#else
849#define JCF(TN,I) _(TN,_cfSTR)(1,J,_(B,I), 0,0,0,0)
850#if defined(AbsoftUNIXFortran)
851#define DEFAULT_cfJ(B) ,0
852#else
853#define DEFAULT_cfJ(B)
854#endif
855#define LOGICAL_cfJ(B) DEFAULT_cfJ(B)
856#define PLOGICAL_cfJ(B) DEFAULT_cfJ(B)
857#define STRING_cfJ(B) ,B.flen
858#define PSTRING_cfJ(B) ,B
859#define STRINGV_cfJ(B) STRING_cfJ(B)
860#define PSTRINGV_cfJ(B) STRING_cfJ(B)
861#define ZTRINGV_cfJ(B) STRING_cfJ(B)
862#define PZTRINGV_cfJ(B) STRING_cfJ(B)
863
864/* KCF is identical to DCF, except that KCF ZTRING is not empty. */
865#define KCF(TN,I) _(TN,_cfSTR)(1,KK,_(B,I), 0,0,0,0)
866#if defined(AbsoftUNIXFortran)
867#define DEFAULT_cfKK(B) , unsigned B
868#else
869#define DEFAULT_cfKK(B)
870#endif
871#define LOGICAL_cfKK(B) DEFAULT_cfKK(B)
872#define PLOGICAL_cfKK(B) DEFAULT_cfKK(B)
873#define STRING_cfKK(B) , unsigned B
874#define PSTRING_cfKK(B) STRING_cfKK(B)
875#define STRINGV_cfKK(B) STRING_cfKK(B)
876#define PSTRINGV_cfKK(B) STRING_cfKK(B)
877#define ZTRINGV_cfKK(B) STRING_cfKK(B)
878#define PZTRINGV_cfKK(B) STRING_cfKK(B)
879#endif
880
881#define WCF(TN,AN,I) _(TN,_cfSTR)(2,W,AN,_(B,I), 0,0,0)
882#define DEFAULT_cfW(A,B)
883#define LOGICAL_cfW(A,B)
884#define PLOGICAL_cfW(A,B) *B=F2CLOGICAL(*B);
885#define STRING_cfW(A,B) (B.nombre=A,B.nombre[B.clen]!='\0'?B.nombre[B.clen]='\0':0); /* A?="constnt"*/
886#define PSTRING_cfW(A,B) kill_trailing(A,' ');
887#ifdef vmsFortran
888#define STRINGV_cfW(A,B) _cf_free(B.dsc$a_pointer);
889#define PSTRINGV_cfW(A,B) \
890 vkill_trailing(f2cstrv((char*)A, (char*)A, \
891 B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0]), \
892 B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0], ' ');
893#else
894#define STRINGV_cfW(A,B) _cf_free(B.s);
895#define PSTRINGV_cfW(A,B) vkill_trailing( \
896 f2cstrv((char*)A,(char*)A,B.flen+1,B.sizeofA), B.flen+1,B.sizeofA,' ');
897#endif
898#define ZTRINGV_cfW(A,B) STRINGV_cfW(A,B)
899#define PZTRINGV_cfW(A,B) PSTRINGV_cfW(A,B)
900
901#define NCF(TN,I,C) _SEP_(TN,C,cfCOMMA) _Icf(2,N,TN,_(A,I),0)
902#define NNCF(TN,I,C) UUCF(TN,I,C)
903#define NNNCF(TN,I,C) _SEP_(TN,C,cfCOLON) _Icf(2,N,TN,_(A,I),0)
904#define INT_cfN(T,A) _(T,VVVVVVV_cfTYPE) * A
905#define INTV_cfN(T,A) _(T,VVVVVV_cfTYPE) * A
906#define INTVV_cfN(T,A) _(T,VVVVV_cfTYPE) * A
907#define INTVVV_cfN(T,A) _(T,VVVV_cfTYPE) * A
908#define INTVVVV_cfN(T,A) _(T,VVV_cfTYPE) * A
909#define INTVVVVV_cfN(T,A) _(T,VV_cfTYPE) * A
910#define INTVVVVVV_cfN(T,A) _(T,V_cfTYPE) * A
911#define INTVVVVVVV_cfN(T,A) _(T,_cfTYPE) * A
912#define PINT_cfN(T,A) _(T,_cfTYPE) * A
913#define PVOID_cfN(T,A) void * A
914#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
915#define ROUTINE_cfN(T,A) void (**A)(CF_NULL_PROTO)
916#else
917#define ROUTINE_cfN(T,A) void ( *A)(CF_NULL_PROTO)
918#endif
919#ifdef vmsFortran
920#define STRING_cfN(T,A) fstring * A
921#define STRINGV_cfN(T,A) fstringvector * A
922#else
923#ifdef CRAYFortran
924#define STRING_cfN(T,A) _fcd A
925#define STRINGV_cfN(T,A) _fcd A
926#else
927#define STRING_cfN(T,A) char * A
928#define STRINGV_cfN(T,A) char * A
929#endif
930#endif
931#define PSTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */
932#define PNSTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */
933#define PPSTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */
934#define PSTRINGV_cfN(T,A) STRINGV_cfN(T,A)
935#define ZTRINGV_cfN(T,A) STRINGV_cfN(T,A)
936#define PZTRINGV_cfN(T,A) PSTRINGV_cfN(T,A)
937
938
939/* Apollo 6.7, CRAY, old Sun, VAX/Ultrix vcc/cc and new ultrix
940 can't hack more than 31 arg's.
941 e.g. ultrix >= 4.3 gives message:
942 zow35> cc -c -DDECFortran cfortest.c
943 cfe: Fatal: Out of memory: cfortest.c
944 zow35>
945 Old __hpux had the problem, but new 'HP-UX A.09.03 A 9000/735' is fine
946 if using -Aa, otherwise we have a problem.
947 */
948#ifndef MAX_PREPRO_ARGS
949#if !defined(__GNUC__) && (defined(VAXUltrix) || defined(__CF__APOLLO67) || (defined(sun)&&!defined(__sun)) || defined(_CRAY) || defined(__ultrix__) || (defined(__hpux)&&defined(__CF__KnR)))
950#define MAX_PREPRO_ARGS 31
951#else
952#define MAX_PREPRO_ARGS 99
953#endif
954#endif
955
956#if defined(AbsoftUNIXFortran) || defined(AbsoftProFortran)
957/* In addition to explicit Absoft stuff, only Absoft requires:
958 - DEFAULT coming from _cfSTR.
959 DEFAULT could have been called e.g. INT, but keep it for clarity.
960 - M term in CFARGT14 and CFARGT14FS.
961 */
962#define ABSOFT_cf1(T0) _(T0,_cfSTR)(0,ABSOFT1,0,0,0,0,0)
963#define ABSOFT_cf2(T0) _(T0,_cfSTR)(0,ABSOFT2,0,0,0,0,0)
964#define ABSOFT_cf3(T0) _(T0,_cfSTR)(0,ABSOFT3,0,0,0,0,0)
965#define DEFAULT_cfABSOFT1
966#define LOGICAL_cfABSOFT1
967#define STRING_cfABSOFT1 ,MAX_LEN_FORTRAN_FUNCTION_STRING
968#define DEFAULT_cfABSOFT2
969#define LOGICAL_cfABSOFT2
970#define STRING_cfABSOFT2 ,unsigned D0
971#define DEFAULT_cfABSOFT3
972#define LOGICAL_cfABSOFT3
973#define STRING_cfABSOFT3 ,D0
974#else
975#define ABSOFT_cf1(T0)
976#define ABSOFT_cf2(T0)
977#define ABSOFT_cf3(T0)
978#endif
979
980/* _Z introduced to cicumvent IBM and HP silly preprocessor warning.
981 e.g. "Macro CFARGT14 invoked with a null argument."
982 */
983#define _Z
984
985#define CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
986 S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \
987 S(T8,8) S(T9,9) S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14)
988#define CFARGT27S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
989 S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \
990 S(T8,8) S(T9,9) S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14) \
991 S(TF,15) S(TG,16) S(TH,17) S(TI,18) S(TJ,19) S(TK,20) S(TL,21) \
992 S(TM,22) S(TN,23) S(TO,24) S(TP,25) S(TQ,26) S(TR,27)
993
994#define CFARGT14FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
995 F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \
996 F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \
997 M CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
998#define CFARGT27FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
999 F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \
1000 F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \
1001 F(TF,15,1) F(TG,16,1) F(TH,17,1) F(TI,18,1) F(TJ,19,1) F(TK,20,1) F(TL,21,1) \
1002 F(TM,22,1) F(TN,23,1) F(TO,24,1) F(TP,25,1) F(TQ,26,1) F(TR,27,1) \
1003 M CFARGT27S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
1004
1005#if !(defined(PowerStationFortran)||defined(hpuxFortran800))
1006/* Old CFARGT14 -> CFARGT14FS as seen below, for Absoft cross-compile yields:
1007 SunOS> cc -c -Xa -DAbsoftUNIXFortran c.c
1008 "c.c", line 406: warning: argument mismatch
1009 Haven't checked if this is ANSI C or a SunOS bug. SunOS -Xs works ok.
1010 Behavior is most clearly seen in example:
1011 #define A 1 , 2
1012 #define C(X,Y,Z) x=X. y=Y. z=Z.
1013 #define D(X,Y,Z) C(X,Y,Z)
1014 D(x,A,z)
1015 Output from preprocessor is: x = x . y = 1 . z = 2 .
1016 #define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
1017 CFARGT14FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
1018*/
1019#define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
1020 F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \
1021 F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \
1022 M CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
1023#define CFARGT27(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
1024 F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \
1025 F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \
1026 F(TF,15,1) F(TG,16,1) F(TH,17,1) F(TI,18,1) F(TJ,19,1) F(TK,20,1) F(TL,21,1) \
1027 F(TM,22,1) F(TN,23,1) F(TO,24,1) F(TP,25,1) F(TQ,26,1) F(TR,27,1) \
1028 M CFARGT27S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
1029
1030#define CFARGT20(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
1031 F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \
1032 F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \
1033 F(TF,15,1) F(TG,16,1) F(TH,17,1) F(TI,18,1) F(TJ,19,1) F(TK,20,1) \
1034 S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \
1035 S(T8,8) S(T9,9) S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14) \
1036 S(TF,15) S(TG,16) S(TH,17) S(TI,18) S(TJ,19) S(TK,20)
1037#define CFARGTA14(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) \
1038 F(T1,A1,1,0) F(T2,A2,2,1) F(T3,A3,3,1) F(T4,A4,4,1) F(T5,A5,5,1) F(T6,A6,6,1) \
1039 F(T7,A7,7,1) F(T8,A8,8,1) F(T9,A9,9,1) F(TA,AA,10,1) F(TB,AB,11,1) F(TC,AC,12,1) \
1040 F(TD,AD,13,1) F(TE,AE,14,1) S(T1,1) S(T2,2) S(T3,3) S(T4,4) \
1041 S(T5,5) S(T6,6) S(T7,7) S(T8,8) S(T9,9) S(TA,10) \
1042 S(TB,11) S(TC,12) S(TD,13) S(TE,14)
1043#if MAX_PREPRO_ARGS>31
1044#define CFARGTA20(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \
1045 F(T1,A1,1,0) F(T2,A2,2,1) F(T3,A3,3,1) F(T4,A4,4,1) F(T5,A5,5,1) F(T6,A6,6,1) \
1046 F(T7,A7,7,1) F(T8,A8,8,1) F(T9,A9,9,1) F(TA,AA,10,1) F(TB,AB,11,1) F(TC,AC,12,1) \
1047 F(TD,AD,13,1) F(TE,AE,14,1) F(TF,AF,15,1) F(TG,AG,16,1) F(TH,AH,17,1) F(TI,AI,18,1) \
1048 F(TJ,AJ,19,1) F(TK,AK,20,1) S(T1,1) S(T2,2) S(T3,3) S(T4,4) \
1049 S(T5,5) S(T6,6) S(T7,7) S(T8,8) S(T9,9) S(TA,10) \
1050 S(TB,11) S(TC,12) S(TD,13) S(TE,14) S(TF,15) S(TG,16) \
1051 S(TH,17) S(TI,18) S(TJ,19) S(TK,20)
1052#define CFARGTA27(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \
1053 F(T1,A1,1,0) F(T2,A2,2,1) F(T3,A3,3,1) F(T4,A4,4,1) F(T5,A5,5,1) F(T6,A6,6,1) \
1054 F(T7,A7,7,1) F(T8,A8,8,1) F(T9,A9,9,1) F(TA,AA,10,1) F(TB,AB,11,1) F(TC,AC,12,1) \
1055 F(TD,AD,13,1) F(TE,AE,14,1) F(TF,AF,15,1) F(TG,AG,16,1) F(TH,AH,17,1) F(TI,AI,18,1) \
1056 F(TJ,AJ,19,1) F(TK,AK,20,1) F(TL,AL,21,1) F(TM,AM,22,1) F(TN,AN,23,1) F(TO,AO,24,1) \
1057 F(TP,AP,25,1) F(TQ,AQ,26,1) F(TR,AR,27,1) S(T1,1) S(T2,2) S(T3,3) \
1058 S(T4,4) S(T5,5) S(T6,6) S(T7,7) S(T8,8) S(T9,9) \
1059 S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14) S(TF,15) \
1060 S(TG,16) S(TH,17) S(TI,18) S(TJ,19) S(TK,20) S(TL,21) \
1061 S(TM,22) S(TN,23) S(TO,24) S(TP,25) S(TQ,26) S(TR,27)
1062#endif
1063#else
1064#define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
1065 F(T1,1,0) S(T1,1) F(T2,2,1) S(T2,2) F(T3,3,1) S(T3,3) F(T4,4,1) S(T4,4) \
1066 F(T5,5,1) S(T5,5) F(T6,6,1) S(T6,6) F(T7,7,1) S(T7,7) F(T8,8,1) S(T8,8) \
1067 F(T9,9,1) S(T9,9) F(TA,10,1) S(TA,10) F(TB,11,1) S(TB,11) F(TC,12,1) S(TC,12) \
1068 F(TD,13,1) S(TD,13) F(TE,14,1) S(TE,14)
1069#define CFARGT27(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
1070 F(T1,1,0) S(T1,1) F(T2,2,1) S(T2,2) F(T3,3,1) S(T3,3) F(T4,4,1) S(T4,4) \
1071 F(T5,5,1) S(T5,5) F(T6,6,1) S(T6,6) F(T7,7,1) S(T7,7) F(T8,8,1) S(T8,8) \
1072 F(T9,9,1) S(T9,9) F(TA,10,1) S(TA,10) F(TB,11,1) S(TB,11) F(TC,12,1) S(TC,12) \
1073 F(TD,13,1) S(TD,13) F(TE,14,1) S(TE,14) F(TF,15,1) S(TF,15) F(TG,16,1) S(TG,16) \
1074 F(TH,17,1) S(TH,17) F(TI,18,1) S(TI,18) F(TJ,19,1) S(TJ,19) F(TK,20,1) S(TK,20) \
1075 F(TL,21,1) S(TL,21) F(TM,22,1) S(TM,22) F(TN,23,1) S(TN,23) F(TO,24,1) S(TO,24) \
1076 F(TP,25,1) S(TP,25) F(TQ,26,1) S(TQ,26) F(TR,27,1) S(TR,27)
1077
1078#define CFARGT20(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
1079 F(T1,1,0) S(T1,1) F(T2,2,1) S(T2,2) F(T3,3,1) S(T3,3) F(T4,4,1) S(T4,4) \
1080 F(T5,5,1) S(T5,5) F(T6,6,1) S(T6,6) F(T7,7,1) S(T7,7) F(T8,8,1) S(T8,8) \
1081 F(T9,9,1) S(T9,9) F(TA,10,1) S(TA,10) F(TB,11,1) S(TB,11) F(TC,12,1) S(TC,12) \
1082 F(TD,13,1) S(TD,13) F(TE,14,1) S(TE,14) F(TF,15,1) S(TF,15) F(TG,16,1) S(TG,16) \
1083 F(TH,17,1) S(TH,17) F(TI,18,1) S(TI,18) F(TJ,19,1) S(TJ,19) F(TK,20,1) S(TK,20)
1084#define CFARGTA14(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) \
1085 F(T1,A1,1,0) S(T1,1) F(T2,A2,2,1) S(T2,2) F(T3,A3,3,1) S(T3,3) \
1086 F(T4,A4,4,1) S(T4,4) F(T5,A5,5,1) S(T5,5) F(T6,A6,6,1) S(T6,6) \
1087 F(T7,A7,7,1) S(T7,7) F(T8,A8,8,1) S(T8,8) F(T9,A9,9,1) S(T9,9) \
1088 F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12) \
1089 F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14)
1090#if MAX_PREPRO_ARGS>31
1091#define CFARGTA20(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \
1092 F(T1,A1,1,0) S(T1,1) F(T2,A2,2,1) S(T2,2) F(T3,A3,3,1) S(T3,3) \
1093 F(T4,A4,4,1) S(T4,4) F(T5,A5,5,1) S(T5,5) F(T6,A6,6,1) S(T6,6) \
1094 F(T7,A7,7,1) S(T7,7) F(T8,A8,8,1) S(T8,8) F(T9,A9,9,1) S(T9,9) \
1095 F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12) \
1096 F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14) F(TF,AF,15,1) S(TF,15) \
1097 F(TG,AG,16,1) S(TG,16) F(TH,AH,17,1) S(TH,17) F(TI,AI,18,1) S(TI,18) \
1098 F(TJ,AJ,19,1) S(TJ,19) F(TK,AK,20,1) S(TK,20)
1099#define CFARGTA27(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \
1100 F(T1,A1,1,0) S(T1,1) F(T2,A2,2,1) S(T2,2) F(T3,A3,3,1) S(T3,3) \
1101 F(T4,A4,4,1) S(T4,4) F(T5,A5,5,1) S(T5,5) F(T6,A6,6,1) S(T6,6) \
1102 F(T7,A7,7,1) S(T7,7) F(T8,A8,8,1) S(T8,8) F(T9,A9,9,1) S(T9,9) \
1103 F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12) \
1104 F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14) F(TF,AF,15,1) S(TF,15) \
1105 F(TG,AG,16,1) S(TG,16) F(TH,AH,17,1) S(TH,17) F(TI,AI,18,1) S(TI,18) \
1106 F(TJ,AJ,19,1) S(TJ,19) F(TK,AK,20,1) S(TK,20) F(TL,AL,21,1) S(TL,21) \
1107 F(TM,AM,22,1) S(TM,22) F(TN,AN,23,1) S(TN,23) F(TO,AO,24,1) S(TO,24) \
1108 F(TP,AP,25,1) S(TP,25) F(TQ,AQ,26,1) S(TQ,26) F(TR,AR,27,1) S(TR,27)
1109#endif
1110#endif
1111
1112
1113#define PROTOCCALLSFSUB1( UN,LN,T1) \
1114 PROTOCCALLSFSUB14(UN,LN,T1,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
1115#define PROTOCCALLSFSUB2( UN,LN,T1,T2) \
1116 PROTOCCALLSFSUB14(UN,LN,T1,T2,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
1117#define PROTOCCALLSFSUB3( UN,LN,T1,T2,T3) \
1118 PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
1119#define PROTOCCALLSFSUB4( UN,LN,T1,T2,T3,T4) \
1120 PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
1121#define PROTOCCALLSFSUB5( UN,LN,T1,T2,T3,T4,T5) \
1122 PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
1123#define PROTOCCALLSFSUB6( UN,LN,T1,T2,T3,T4,T5,T6) \
1124 PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
1125#define PROTOCCALLSFSUB7( UN,LN,T1,T2,T3,T4,T5,T6,T7) \
1126 PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
1127#define PROTOCCALLSFSUB8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
1128 PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
1129#define PROTOCCALLSFSUB9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
1130 PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,CF_0,CF_0,CF_0,CF_0)
1131#define PROTOCCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
1132 PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0)
1133#define PROTOCCALLSFSUB11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
1134 PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0)
1135#define PROTOCCALLSFSUB12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
1136 PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0)
1137#define PROTOCCALLSFSUB13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
1138 PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0)
1139
1140
1141#define PROTOCCALLSFSUB15(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \
1142 PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,CF_0,CF_0,CF_0,CF_0,CF_0)
1143#define PROTOCCALLSFSUB16(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \
1144 PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,CF_0,CF_0,CF_0,CF_0)
1145#define PROTOCCALLSFSUB17(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \
1146 PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,CF_0,CF_0,CF_0)
1147#define PROTOCCALLSFSUB18(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \
1148 PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,CF_0,CF_0)
1149#define PROTOCCALLSFSUB19(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \
1150 PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0)
1151
1152#define PROTOCCALLSFSUB21(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL) \
1153 PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
1154#define PROTOCCALLSFSUB22(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM) \
1155 PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,CF_0,CF_0,CF_0,CF_0,CF_0)
1156#define PROTOCCALLSFSUB23(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN) \
1157 PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,CF_0,CF_0,CF_0,CF_0)
1158#define PROTOCCALLSFSUB24(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO) \
1159 PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,CF_0,CF_0,CF_0)
1160#define PROTOCCALLSFSUB25(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP) \
1161 PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,CF_0,CF_0)
1162#define PROTOCCALLSFSUB26(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ) \
1163 PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,CF_0)
1164
1165
1166#ifndef FCALLSC_QUALIFIER
1167#ifdef VISUAL_CPLUSPLUS
1168#define FCALLSC_QUALIFIER __stdcall
1169#else
1170#define FCALLSC_QUALIFIER
1171#endif
1172#endif
1173
1174#ifdef __cplusplus
1175#define CFextern extern "C"
1176#else
1177#define CFextern extern
1178#endif
1179
1180
1181#ifdef CFSUBASFUN
1182#define PROTOCCALLSFSUB0(UN,LN) \
1183 PROTOCCALLSFFUN0( VOID,UN,LN)
1184#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
1185 PROTOCCALLSFFUN14(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
1186#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)\
1187 PROTOCCALLSFFUN20(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
1188#define PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)\
1189 PROTOCCALLSFFUN27(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
1190#else
1191/* Note: Prevent compiler warnings, null #define PROTOCCALLSFSUB14/20 after
1192 #include-ing cfortran.h if calling the FORTRAN wrapper within the same
1193 source code where the wrapper is created. */
1194#define PROTOCCALLSFSUB0(UN,LN) _(VOID,_cfPU)(CFC_(UN,LN))();
1195#ifndef __CF__KnR
1196#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
1197 _(VOID,_cfPU)(CFC_(UN,LN))( CFARGT14(NCF,KCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) );
1198#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)\
1199 _(VOID,_cfPU)(CFC_(UN,LN))( CFARGT20(NCF,KCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) );
1200#define PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)\
1201 _(VOID,_cfPU)(CFC_(UN,LN))( CFARGT27(NCF,KCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) );
1202#else
1203#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
1204 PROTOCCALLSFSUB0(UN,LN)
1205#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
1206 PROTOCCALLSFSUB0(UN,LN)
1207#define PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
1208 PROTOCCALLSFSUB0(UN,LN)
1209#endif
1210#endif
1211
1212
1213#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */
1214#pragma standard
1215#endif
1216
1217
1218#define CCALLSFSUB1( UN,LN,T1, A1) \
1219 CCALLSFSUB5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0)
1220#define CCALLSFSUB2( UN,LN,T1,T2, A1,A2) \
1221 CCALLSFSUB5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0)
1222#define CCALLSFSUB3( UN,LN,T1,T2,T3, A1,A2,A3) \
1223 CCALLSFSUB5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0)
1224#define CCALLSFSUB4( UN,LN,T1,T2,T3,T4, A1,A2,A3,A4)\
1225 CCALLSFSUB5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0)
1226#define CCALLSFSUB5( UN,LN,T1,T2,T3,T4,T5, A1,A2,A3,A4,A5) \
1227 CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,0,0,0,0,0)
1228#define CCALLSFSUB6( UN,LN,T1,T2,T3,T4,T5,T6, A1,A2,A3,A4,A5,A6) \
1229 CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,0,0,0,0)
1230#define CCALLSFSUB7( UN,LN,T1,T2,T3,T4,T5,T6,T7, A1,A2,A3,A4,A5,A6,A7) \
1231 CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,0,0,0)
1232#define CCALLSFSUB8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8, A1,A2,A3,A4,A5,A6,A7,A8) \
1233 CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,0,0)
1234#define CCALLSFSUB9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\
1235 CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0)
1236#define CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\
1237 CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,0,0,0,0)
1238#define CCALLSFSUB11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB)\
1239 CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,0,0,0)
1240#define CCALLSFSUB12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC)\
1241 CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,0,0)
1242#define CCALLSFSUB13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD)\
1243 CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,0)
1244
1245#ifdef __cplusplus
1246#define CPPPROTOCLSFSUB0( UN,LN)
1247#define CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
1248#define CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
1249#define CPPPROTOCLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
1250#else
1251#define CPPPROTOCLSFSUB0(UN,LN) \
1252 PROTOCCALLSFSUB0(UN,LN)
1253#define CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
1254 PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
1255#define CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
1256 PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
1257#define CPPPROTOCLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
1258 PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
1259#endif
1260
1261#ifdef CFSUBASFUN
1262#define CCALLSFSUB0(UN,LN) CCALLSFFUN0(UN,LN)
1263#define CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\
1264 CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)
1265#else
1266/* do{...}while(0) allows if(a==b) FORT(); else BORT(); */
1267#define CCALLSFSUB0( UN,LN) do{CPPPROTOCLSFSUB0(UN,LN) CFC_(UN,LN)();}while(0)
1268#define CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\
1269do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \
1270 VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,B10) \
1271 VVCF(TB,AB,B11) VVCF(TC,AC,B12) VVCF(TD,AD,B13) VVCF(TE,AE,B14) \
1272 CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
1273 ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) \
1274 ACF(LN,T4,A4,4) ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) \
1275 ACF(LN,T8,A8,8) ACF(LN,T9,A9,9) ACF(LN,TA,AA,10) ACF(LN,TB,AB,11) \
1276 ACF(LN,TC,AC,12) ACF(LN,TD,AD,13) ACF(LN,TE,AE,14) \
1277 CFC_(UN,LN)( CFARGTA14(AACF,JCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) );\
1278 WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \
1279 WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,10) \
1280 WCF(TB,AB,11) WCF(TC,AC,12) WCF(TD,AD,13) WCF(TE,AE,14) }while(0)
1281#endif
1282
1283
1284#if MAX_PREPRO_ARGS>31
1285#define CCALLSFSUB15(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF)\
1286 CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,0,0,0,0,0)
1287#define CCALLSFSUB16(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG)\
1288 CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,0,0,0,0)
1289#define CCALLSFSUB17(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH)\
1290 CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,0,0,0)
1291#define CCALLSFSUB18(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI)\
1292 CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,0,0)
1293#define CCALLSFSUB19(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ)\
1294 CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,0)
1295
1296#ifdef CFSUBASFUN
1297#define CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \
1298 TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \
1299 CCALLSFFUN20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \
1300 TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK)
1301#else
1302#define CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \
1303 TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \
1304do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \
1305 VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,B10) \
1306 VVCF(TB,AB,B11) VVCF(TC,AC,B12) VVCF(TD,AD,B13) VVCF(TE,AE,B14) VVCF(TF,AF,B15) \
1307 VVCF(TG,AG,B16) VVCF(TH,AH,B17) VVCF(TI,AI,B18) VVCF(TJ,AJ,B19) VVCF(TK,AK,B20) \
1308 CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
1309 ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) ACF(LN,T4,A4,4) \
1310 ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) ACF(LN,T8,A8,8) \
1311 ACF(LN,T9,A9,9) ACF(LN,TA,AA,10) ACF(LN,TB,AB,11) ACF(LN,TC,AC,12) \
1312 ACF(LN,TD,AD,13) ACF(LN,TE,AE,14) ACF(LN,TF,AF,15) ACF(LN,TG,AG,16) \
1313 ACF(LN,TH,AH,17) ACF(LN,TI,AI,18) ACF(LN,TJ,AJ,19) ACF(LN,TK,AK,20) \
1314 CFC_(UN,LN)( CFARGTA20(AACF,JCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) ); \
1315 WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) WCF(T6,A6,6) \
1316 WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,10) WCF(TB,AB,11) WCF(TC,AC,12) \
1317 WCF(TD,AD,13) WCF(TE,AE,14) WCF(TF,AF,15) WCF(TG,AG,16) WCF(TH,AH,17) WCF(TI,AI,18) \
1318 WCF(TJ,AJ,19) WCF(TK,AK,20) }while(0)
1319#endif
1320#endif /* MAX_PREPRO_ARGS */
1321
1322#if MAX_PREPRO_ARGS>31
1323#define CCALLSFSUB21(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL)\
1324 CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,0,0,0,0,0,0)
1325#define CCALLSFSUB22(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM)\
1326 CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,0,0,0,0,0)
1327#define CCALLSFSUB23(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN)\
1328 CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,0,0,0,0)
1329#define CCALLSFSUB24(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO)\
1330 CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,0,0,0)
1331#define CCALLSFSUB25(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP)\
1332 CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,0,0)
1333#define CCALLSFSUB26(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ)\
1334 CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,0)
1335
1336#ifdef CFSUBASFUN
1337#define CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR, \
1338 A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \
1339 CCALLSFFUN27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR, \
1340 A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR)
1341#else
1342#define CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR, \
1343 A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \
1344do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \
1345 VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,B10) \
1346 VVCF(TB,AB,B11) VVCF(TC,AC,B12) VVCF(TD,AD,B13) VVCF(TE,AE,B14) VVCF(TF,AF,B15) \
1347 VVCF(TG,AG,B16) VVCF(TH,AH,B17) VVCF(TI,AI,B18) VVCF(TJ,AJ,B19) VVCF(TK,AK,B20) \
1348 VVCF(TL,AL,B21) VVCF(TM,AM,B22) VVCF(TN,AN,B23) VVCF(TO,AO,B24) VVCF(TP,AP,B25) \
1349 VVCF(TQ,AQ,B26) VVCF(TR,AR,B27) \
1350 CPPPROTOCLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
1351 ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) ACF(LN,T4,A4,4) \
1352 ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) ACF(LN,T8,A8,8) \
1353 ACF(LN,T9,A9,9) ACF(LN,TA,AA,10) ACF(LN,TB,AB,11) ACF(LN,TC,AC,12) \
1354 ACF(LN,TD,AD,13) ACF(LN,TE,AE,14) ACF(LN,TF,AF,15) ACF(LN,TG,AG,16) \
1355 ACF(LN,TH,AH,17) ACF(LN,TI,AI,18) ACF(LN,TJ,AJ,19) ACF(LN,TK,AK,20) \
1356 ACF(LN,TL,AL,21) ACF(LN,TM,AM,22) ACF(LN,TN,AN,23) ACF(LN,TO,AO,24) \
1357 ACF(LN,TP,AP,25) ACF(LN,TQ,AQ,26) ACF(LN,TR,AR,27) \
1358 CFC_(UN,LN)( CFARGTA27(AACF,JCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR,\
1359 A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) ); \
1360 WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) WCF(T6,A6,6) \
1361 WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,10) WCF(TB,AB,11) WCF(TC,AC,12) \
1362 WCF(TD,AD,13) WCF(TE,AE,14) WCF(TF,AF,15) WCF(TG,AG,16) WCF(TH,AH,17) WCF(TI,AI,18) \
1363 WCF(TJ,AJ,19) WCF(TK,AK,20) WCF(TL,AL,21) WCF(TM,AM,22) WCF(TN,AN,23) WCF(TO,AO,24) \
1364 WCF(TP,AP,25) WCF(TQ,AQ,26) WCF(TR,AR,27) }while(0)
1365#endif
1366#endif /* MAX_PREPRO_ARGS */
1367
1368/*-------------------------------------------------------------------------*/
1369
1370/* UTILITIES FOR C TO CALL FORTRAN FUNCTIONS */
1371
1372/*N.B. PROTOCCALLSFFUNn(..) generates code, whether or not the FORTRAN
1373 function is called. Therefore, especially for creator's of C header files
1374 for large FORTRAN libraries which include many functions, to reduce
1375 compile time and object code size, it may be desirable to create
1376 preprocessor directives to allow users to create code for only those
1377 functions which they use. */
1378
1379/* The following defines the maximum length string that a function can return.
1380 Of course it may be undefine-d and re-define-d before individual
1381 PROTOCCALLSFFUNn(..) as required. It would also be nice to have this derived
1382 from the individual machines' limits. */
1383#define MAX_LEN_FORTRAN_FUNCTION_STRING 0x4FE
1384
1385/* The following defines a character used by CFORTRAN.H to flag the end of a
1386 string coming out of a FORTRAN routine. */
1387#define CFORTRAN_NON_CHAR 0x7F
1388
1389#ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */
1390#pragma nostandard
1391#endif
1392
1393#define _SEP_(TN,C,cfCOMMA) _(__SEP_,C)(TN,cfCOMMA)
1394#define __SEP_0(TN,cfCOMMA)
1395#define __SEP_1(TN,cfCOMMA) _Icf(2,SEP,TN,cfCOMMA,0)
1396#define INT_cfSEP(T,B) _(A,B)
1397#define INTV_cfSEP(T,B) INT_cfSEP(T,B)
1398#define INTVV_cfSEP(T,B) INT_cfSEP(T,B)
1399#define INTVVV_cfSEP(T,B) INT_cfSEP(T,B)
1400#define INTVVVV_cfSEP(T,B) INT_cfSEP(T,B)
1401#define INTVVVVV_cfSEP(T,B) INT_cfSEP(T,B)
1402#define INTVVVVVV_cfSEP(T,B) INT_cfSEP(T,B)
1403#define INTVVVVVVV_cfSEP(T,B) INT_cfSEP(T,B)
1404#define PINT_cfSEP(T,B) INT_cfSEP(T,B)
1405#define PVOID_cfSEP(T,B) INT_cfSEP(T,B)
1406#define ROUTINE_cfSEP(T,B) INT_cfSEP(T,B)
1407#define SIMPLE_cfSEP(T,B) INT_cfSEP(T,B)
1408#define VOID_cfSEP(T,B) INT_cfSEP(T,B) /* For FORTRAN calls C subr.s.*/
1409#define STRING_cfSEP(T,B) INT_cfSEP(T,B)
1410#define STRINGV_cfSEP(T,B) INT_cfSEP(T,B)
1411#define PSTRING_cfSEP(T,B) INT_cfSEP(T,B)
1412#define PSTRINGV_cfSEP(T,B) INT_cfSEP(T,B)
1413#define PNSTRING_cfSEP(T,B) INT_cfSEP(T,B)
1414#define PPSTRING_cfSEP(T,B) INT_cfSEP(T,B)
1415#define ZTRINGV_cfSEP(T,B) INT_cfSEP(T,B)
1416#define PZTRINGV_cfSEP(T,B) INT_cfSEP(T,B)
1417
1418#if defined(SIGNED_BYTE) || !defined(UNSIGNED_BYTE)
1419#ifdef OLD_VAXC
1420#define INTEGER_BYTE char /* Old VAXC barfs on 'signed char' */
1421#else
1422#define INTEGER_BYTE signed char /* default */
1423#endif
1424#else
1425#define INTEGER_BYTE unsigned char
1426#endif
1427#define BYTEVVVVVVV_cfTYPE INTEGER_BYTE
1428#define DOUBLEVVVVVVV_cfTYPE DOUBLE_PRECISION
1429#define FLOATVVVVVVV_cfTYPE FORTRAN_REAL
1430#define INTVVVVVVV_cfTYPE int
1431#define LOGICALVVVVVVV_cfTYPE int
1432#define LONGVVVVVVV_cfTYPE long
1433#define LONGLONGVVVVVVV_cfTYPE LONGLONG /* added by MR December 2005 */
1434#define SHORTVVVVVVV_cfTYPE short
1435#define PBYTE_cfTYPE INTEGER_BYTE
1436#define PDOUBLE_cfTYPE DOUBLE_PRECISION
1437#define PFLOAT_cfTYPE FORTRAN_REAL
1438#define PINT_cfTYPE int
1439#define PLOGICAL_cfTYPE int
1440#define PLONG_cfTYPE long
1441#define PLONGLONG_cfTYPE LONGLONG /* added by MR December 2005 */
1442#define PSHORT_cfTYPE short
1443
1444#define CFARGS0(A,T,V,W,X,Y,Z) _3(T,_cf,A)
1445#define CFARGS1(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V)
1446#define CFARGS2(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W)
1447#define CFARGS3(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X)
1448#define CFARGS4(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X,Y)
1449#define CFARGS5(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X,Y,Z)
1450
1451#define _Icf(N,T,I,X,Y) _(I,_cfINT)(N,T,I,X,Y,0)
1452#define _Icf4(N,T,I,X,Y,Z) _(I,_cfINT)(N,T,I,X,Y,Z)
1453#define BYTE_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z)
1454#define DOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INT,B,X,Y,Z,0)
1455#define FLOAT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z)
1456#define INT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z)
1457#define LOGICAL_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z)
1458#define LONG_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z)
1459#define LONGLONG_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1460#define SHORT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z)
1461#define PBYTE_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z)
1462#define PDOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,PINT,B,X,Y,Z,0)
1463#define PFLOAT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z)
1464#define PINT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z)
1465#define PLOGICAL_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z)
1466#define PLONG_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z)
1467#define PLONGLONG_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1468#define PSHORT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z)
1469#define BYTEV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z)
1470#define BYTEVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z)
1471#define BYTEVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
1472#define BYTEVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
1473#define BYTEVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
1474#define BYTEVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
1475#define BYTEVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
1476#define DOUBLEV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTV,B,X,Y,Z,0)
1477#define DOUBLEVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVV,B,X,Y,Z,0)
1478#define DOUBLEVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVV,B,X,Y,Z,0)
1479#define DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVV,B,X,Y,Z,0)
1480#define DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVV,B,X,Y,Z,0)
1481#define DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVVV,B,X,Y,Z,0)
1482#define DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVVVV,B,X,Y,Z,0)
1483#define FLOATV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z)
1484#define FLOATVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z)
1485#define FLOATVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
1486#define FLOATVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
1487#define FLOATVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
1488#define FLOATVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
1489#define FLOATVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
1490#define INTV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z)
1491#define INTVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z)
1492#define INTVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
1493#define INTVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
1494#define INTVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
1495#define INTVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
1496#define INTVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
1497#define LOGICALV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z)
1498#define LOGICALVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z)
1499#define LOGICALVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
1500#define LOGICALVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
1501#define LOGICALVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
1502#define LOGICALVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
1503#define LOGICALVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
1504#define LONGV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z)
1505#define LONGVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z)
1506#define LONGVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
1507#define LONGVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
1508#define LONGVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
1509#define LONGVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
1510#define LONGVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
1511#define LONGLONGV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1512#define LONGLONGVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1513#define LONGLONGVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1514#define LONGLONGVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1515#define LONGLONGVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1516#define LONGLONGVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1517#define LONGLONGVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
1518#define SHORTV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z)
1519#define SHORTVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z)
1520#define SHORTVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
1521#define SHORTVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
1522#define SHORTVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
1523#define SHORTVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
1524#define SHORTVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
1525#define PVOID_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,B,B,X,Y,Z,0)
1526#define ROUTINE_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
1527/*CRAY coughs on the first,
1528 i.e. the usual trouble of not being able to
1529 define macros to macros with arguments.
1530 New ultrix is worse, it coughs on all such uses.
1531 */
1532/*#define SIMPLE_cfINT PVOID_cfINT*/
1533#define SIMPLE_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
1534#define VOID_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
1535#define STRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
1536#define STRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
1537#define PSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
1538#define PSTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
1539#define PNSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
1540#define PPSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
1541#define ZTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
1542#define PZTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
1543#define CF_0_cfINT(N,A,B,X,Y,Z)
1544
1545
1546#define UCF(TN,I,C) _SEP_(TN,C,cfCOMMA) _Icf(2,U,TN,_(A,I),0)
1547#define UUCF(TN,I,C) _SEP_(TN,C,cfCOMMA) _SEP_(TN,1,I)
1548#define UUUCF(TN,I,C) _SEP_(TN,C,cfCOLON) _Icf(2,U,TN,_(A,I),0)
1549#define INT_cfU(T,A) _(T,VVVVVVV_cfTYPE) A
1550#define INTV_cfU(T,A) _(T,VVVVVV_cfTYPE) * A
1551#define INTVV_cfU(T,A) _(T,VVVVV_cfTYPE) * A
1552#define INTVVV_cfU(T,A) _(T,VVVV_cfTYPE) * A
1553#define INTVVVV_cfU(T,A) _(T,VVV_cfTYPE) * A
1554#define INTVVVVV_cfU(T,A) _(T,VV_cfTYPE) * A
1555#define INTVVVVVV_cfU(T,A) _(T,V_cfTYPE) * A
1556#define INTVVVVVVV_cfU(T,A) _(T,_cfTYPE) * A
1557#define PINT_cfU(T,A) _(T,_cfTYPE) * A
1558#define PVOID_cfU(T,A) void *A
1559#define ROUTINE_cfU(T,A) void (*A)(CF_NULL_PROTO)
1560#define VOID_cfU(T,A) void A /* Needed for C calls FORTRAN sub.s. */
1561#define STRING_cfU(T,A) char *A /* via VOID and wrapper. */
1562#define STRINGV_cfU(T,A) char *A
1563#define PSTRING_cfU(T,A) char *A
1564#define PSTRINGV_cfU(T,A) char *A
1565#define ZTRINGV_cfU(T,A) char *A
1566#define PZTRINGV_cfU(T,A) char *A
1567
1568/* VOID breaks U into U and UU. */
1569#define INT_cfUU(T,A) _(T,VVVVVVV_cfTYPE) A
1570#define VOID_cfUU(T,A) /* Needed for FORTRAN calls C sub.s. */
1571#define STRING_cfUU(T,A) char *A
1572
1573
1574#define BYTE_cfPU(A) CFextern INTEGER_BYTE FCALLSC_QUALIFIER A
1575#define DOUBLE_cfPU(A) CFextern DOUBLE_PRECISION FCALLSC_QUALIFIER A
1576#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
1577#if defined (f2cFortran) && ! defined (gFortran)
1578/* f2c/g77 return double from FORTRAN REAL functions. (KMCCARTY, 2005/12/09) */
1579#define FLOAT_cfPU(A) CFextern DOUBLE_PRECISION FCALLSC_QUALIFIER A
1580#else
1581#define FLOAT_cfPU(A) CFextern FORTRAN_REAL FCALLSC_QUALIFIER A
1582#endif
1583#else
1584#define FLOAT_cfPU(A) CFextern FLOATFUNCTIONTYPE FCALLSC_QUALIFIER A
1585#endif
1586#define INT_cfPU(A) CFextern int FCALLSC_QUALIFIER A
1587#define LOGICAL_cfPU(A) CFextern int FCALLSC_QUALIFIER A
1588#define LONG_cfPU(A) CFextern long FCALLSC_QUALIFIER A
1589#define SHORT_cfPU(A) CFextern short FCALLSC_QUALIFIER A
1590#define STRING_cfPU(A) CFextern void FCALLSC_QUALIFIER A
1591#define VOID_cfPU(A) CFextern void FCALLSC_QUALIFIER A
1592
1593#define BYTE_cfE INTEGER_BYTE A0;
1594#define DOUBLE_cfE DOUBLE_PRECISION A0;
1595#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
1596#define FLOAT_cfE FORTRAN_REAL A0;
1597#else
1598#define FLOAT_cfE FORTRAN_REAL AA0; FLOATFUNCTIONTYPE A0;
1599#endif
1600#define INT_cfE int A0;
1601#define LOGICAL_cfE int A0;
1602#define LONG_cfE long A0;
1603#define SHORT_cfE short A0;
1604#define VOID_cfE
1605#ifdef vmsFortran
1606#define STRING_cfE static char AA0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \
1607 static fstring A0 = \
1608 {MAX_LEN_FORTRAN_FUNCTION_STRING,DSC$K_DTYPE_T,DSC$K_CLASS_S,AA0};\
1609 memset(AA0, CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\
1610 *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';
1611#else
1612#ifdef CRAYFortran
1613#define STRING_cfE static char AA0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \
1614 static _fcd A0; *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';\
1615 memset(AA0,CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\
1616 A0 = _cptofcd(AA0,MAX_LEN_FORTRAN_FUNCTION_STRING);
1617#else
1618/* 'cc: SC3.0.1 13 Jul 1994' barfs on char A0[0x4FE+1];
1619 * char A0[0x4FE +1]; char A0[1+0x4FE]; are both OK. */
1620#define STRING_cfE static char A0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \
1621 memset(A0, CFORTRAN_NON_CHAR, \
1622 MAX_LEN_FORTRAN_FUNCTION_STRING); \
1623 *(A0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';
1624#endif
1625#endif
1626/* ESTRING must use static char. array which is guaranteed to exist after
1627 function returns. */
1628
1629/* N.B.i) The diff. for 0 (Zero) and >=1 arguments.
1630 ii)That the following create an unmatched bracket, i.e. '(', which
1631 must of course be matched in the call.
1632 iii)Commas must be handled very carefully */
1633#define INT_cfGZ(T,UN,LN) A0=CFC_(UN,LN)(
1634#define VOID_cfGZ(T,UN,LN) CFC_(UN,LN)(
1635#ifdef vmsFortran
1636#define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)(&A0
1637#else
1638#if defined(CRAYFortran) || defined(AbsoftUNIXFortran) || defined(AbsoftProFortran)
1639#define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)( A0
1640#else
1641#define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)( A0,MAX_LEN_FORTRAN_FUNCTION_STRING
1642#endif
1643#endif
1644
1645#define INT_cfG(T,UN,LN) INT_cfGZ(T,UN,LN)
1646#define VOID_cfG(T,UN,LN) VOID_cfGZ(T,UN,LN)
1647#define STRING_cfG(T,UN,LN) STRING_cfGZ(T,UN,LN), /*, is only diff. from _cfG*/
1648
1649#define BYTEVVVVVVV_cfPP
1650#define INTVVVVVVV_cfPP /* These complement FLOATVVVVVVV_cfPP. */
1651#define DOUBLEVVVVVVV_cfPP
1652#define LOGICALVVVVVVV_cfPP
1653#define LONGVVVVVVV_cfPP
1654#define SHORTVVVVVVV_cfPP
1655#define PBYTE_cfPP
1656#define PINT_cfPP
1657#define PDOUBLE_cfPP
1658#define PLOGICAL_cfPP
1659#define PLONG_cfPP
1660#define PSHORT_cfPP
1661#define PFLOAT_cfPP FLOATVVVVVVV_cfPP
1662
1663#define BCF(TN,AN,C) _SEP_(TN,C,cfCOMMA) _Icf(2,B,TN,AN,0)
1664#define INT_cfB(T,A) (_(T,VVVVVVV_cfTYPE)) A
1665#define INTV_cfB(T,A) A
1666#define INTVV_cfB(T,A) (A)[0]
1667#define INTVVV_cfB(T,A) (A)[0][0]
1668#define INTVVVV_cfB(T,A) (A)[0][0][0]
1669#define INTVVVVV_cfB(T,A) (A)[0][0][0][0]
1670#define INTVVVVVV_cfB(T,A) (A)[0][0][0][0][0]
1671#define INTVVVVVVV_cfB(T,A) (A)[0][0][0][0][0][0]
1672#define PINT_cfB(T,A) _(T,_cfPP)&A
1673#define STRING_cfB(T,A) (char *) A
1674#define STRINGV_cfB(T,A) (char *) A
1675#define PSTRING_cfB(T,A) (char *) A
1676#define PSTRINGV_cfB(T,A) (char *) A
1677#define PVOID_cfB(T,A) (void *) A
1678#define ROUTINE_cfB(T,A) (cfCAST_FUNCTION)A
1679#define ZTRINGV_cfB(T,A) (char *) A
1680#define PZTRINGV_cfB(T,A) (char *) A
1681
1682#define SCF(TN,NAME,I,A) _(TN,_cfSTR)(3,S,NAME,I,A,0,0)
1683#define DEFAULT_cfS(M,I,A)
1684#define LOGICAL_cfS(M,I,A)
1685#define PLOGICAL_cfS(M,I,A)
1686#define STRING_cfS(M,I,A) ,sizeof(A)
1687#define STRINGV_cfS(M,I,A) ,( (unsigned)0xFFFF*firstindexlength(A) \
1688 +secondindexlength(A))
1689#define PSTRING_cfS(M,I,A) ,sizeof(A)
1690#define PSTRINGV_cfS(M,I,A) STRINGV_cfS(M,I,A)
1691#define ZTRINGV_cfS(M,I,A)
1692#define PZTRINGV_cfS(M,I,A)
1693
1694#define HCF(TN,I) _(TN,_cfSTR)(3,H,cfCOMMA, H,_(C,I),0,0)
1695#define HHCF(TN,I) _(TN,_cfSTR)(3,H,cfCOMMA,HH,_(C,I),0,0)
1696#define HHHCF(TN,I) _(TN,_cfSTR)(3,H,cfCOLON, H,_(C,I),0,0)
1697#define H_CF_SPECIAL unsigned
1698#define HH_CF_SPECIAL
1699#define DEFAULT_cfH(M,I,A)
1700#define LOGICAL_cfH(S,U,B)
1701#define PLOGICAL_cfH(S,U,B)
1702#define STRING_cfH(S,U,B) _(A,S) _(U,_CF_SPECIAL) B
1703#define STRINGV_cfH(S,U,B) STRING_cfH(S,U,B)
1704#define PSTRING_cfH(S,U,B) STRING_cfH(S,U,B)
1705#define PSTRINGV_cfH(S,U,B) STRING_cfH(S,U,B)
1706#define PNSTRING_cfH(S,U,B) STRING_cfH(S,U,B)
1707#define PPSTRING_cfH(S,U,B) STRING_cfH(S,U,B)
1708#define ZTRINGV_cfH(S,U,B)
1709#define PZTRINGV_cfH(S,U,B)
1710
1711/* Need VOID_cfSTR because Absoft forced function types go through _cfSTR. */
1712/* No spaces inside expansion. They screws up macro catenation kludge. */
1713#define VOID_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1714#define BYTE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1715#define DOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1716#define FLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1717#define INT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1718#define LOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,LOGICAL,A,B,C,D,E)
1719#define LONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1720#define LONGLONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1721#define SHORT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1722#define BYTEV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1723#define BYTEVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1724#define BYTEVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1725#define BYTEVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1726#define BYTEVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1727#define BYTEVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1728#define BYTEVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1729#define DOUBLEV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1730#define DOUBLEVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1731#define DOUBLEVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1732#define DOUBLEVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1733#define DOUBLEVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1734#define DOUBLEVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1735#define DOUBLEVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1736#define FLOATV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1737#define FLOATVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1738#define FLOATVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1739#define FLOATVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1740#define FLOATVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1741#define FLOATVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1742#define FLOATVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1743#define INTV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1744#define INTVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1745#define INTVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1746#define INTVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1747#define INTVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1748#define INTVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1749#define INTVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1750#define LOGICALV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1751#define LOGICALVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1752#define LOGICALVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1753#define LOGICALVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1754#define LOGICALVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1755#define LOGICALVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1756#define LOGICALVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1757#define LONGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1758#define LONGVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1759#define LONGVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1760#define LONGVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1761#define LONGVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1762#define LONGVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1763#define LONGVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1764#define LONGLONGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1765#define LONGLONGVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1766#define LONGLONGVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1767#define LONGLONGVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1768#define LONGLONGVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1769#define LONGLONGVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1770#define LONGLONGVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1771#define SHORTV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1772#define SHORTVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1773#define SHORTVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1774#define SHORTVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1775#define SHORTVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1776#define SHORTVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1777#define SHORTVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1778#define PBYTE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1779#define PDOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1780#define PFLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1781#define PINT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1782#define PLOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PLOGICAL,A,B,C,D,E)
1783#define PLONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1784#define PLONGLONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
1785#define PSHORT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1786#define STRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,STRING,A,B,C,D,E)
1787#define PSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PSTRING,A,B,C,D,E)
1788#define STRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,STRINGV,A,B,C,D,E)
1789#define PSTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PSTRINGV,A,B,C,D,E)
1790#define PNSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PNSTRING,A,B,C,D,E)
1791#define PPSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PPSTRING,A,B,C,D,E)
1792#define PVOID_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1793#define ROUTINE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1794#define SIMPLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
1795#define ZTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,ZTRINGV,A,B,C,D,E)
1796#define PZTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PZTRINGV,A,B,C,D,E)
1797#define CF_0_cfSTR(N,T,A,B,C,D,E)
1798
1799/* See ACF table comments, which explain why CCF was split into two. */
1800#define CCF(NAME,TN,I) _(TN,_cfSTR)(5,C,NAME,I,_(A,I),_(B,I),_(C,I))
1801#define DEFAULT_cfC(M,I,A,B,C)
1802#define LOGICAL_cfC(M,I,A,B,C) A=C2FLOGICAL( A);
1803#define PLOGICAL_cfC(M,I,A,B,C) *A=C2FLOGICAL(*A);
1804#ifdef vmsFortran
1805#define STRING_cfC(M,I,A,B,C) (B.clen=strlen(A),B.f.dsc$a_pointer=A, \
1806 C==sizeof(char*)||C==(unsigned)(B.clen+1)?B.f.dsc$w_length=B.clen: \
1807 (memset((A)+B.clen,' ',C-B.clen-1),A[B.f.dsc$w_length=C-1]='\0'));
1808 /* PSTRING_cfC to beware of array A which does not contain any \0. */
1809#define PSTRING_cfC(M,I,A,B,C) (B.dsc$a_pointer=A, C==sizeof(char*) ? \
1810 B.dsc$w_length=strlen(A): (A[C-1]='\0',B.dsc$w_length=strlen(A), \
1811 memset((A)+B.dsc$w_length,' ',C-B.dsc$w_length-1), B.dsc$w_length=C-1));
1812#else
1813#define STRING_cfC(M,I,A,B,C) (B.nombre=A,B.clen=strlen(A), \
1814 C==sizeof(char*)||C==(unsigned)(B.clen+1)?B.flen=B.clen: \
1815 (memset(B.nombre+B.clen,' ',C-B.clen-1),B.nombre[B.flen=C-1]='\0'));
1816#define PSTRING_cfC(M,I,A,B,C) (C==sizeof(char*)? B=strlen(A): \
1817 (A[C-1]='\0',B=strlen(A),memset((A)+B,' ',C-B-1),B=C-1));
1818#endif
1819 /* For CRAYFortran for (P)STRINGV_cfC, B.fs is set, but irrelevant. */
1820#define STRINGV_cfC(M,I,A,B,C) \
1821 AATRINGV_cfA( A,B,(C/0xFFFF)*(C%0xFFFF),C/0xFFFF,C%0xFFFF)
1822#define PSTRINGV_cfC(M,I,A,B,C) \
1823 APATRINGV_cfA( A,B,(C/0xFFFF)*(C%0xFFFF),C/0xFFFF,C%0xFFFF)
1824#define ZTRINGV_cfC(M,I,A,B,C) \
1825 AATRINGV_cfA( A,B, (_3(M,_ELEMS_,I))*((_3(M,_ELEMLEN_,I))+1), \
1826 (_3(M,_ELEMS_,I)), (_3(M,_ELEMLEN_,I))+1 )
1827#define PZTRINGV_cfC(M,I,A,B,C) \
1828 APATRINGV_cfA( A,B, (_3(M,_ELEMS_,I))*((_3(M,_ELEMLEN_,I))+1), \
1829 (_3(M,_ELEMS_,I)), (_3(M,_ELEMLEN_,I))+1 )
1830
1831#define BYTE_cfCCC(A,B) &A
1832#define DOUBLE_cfCCC(A,B) &A
1833#if !defined(__CF__KnR)
1834#define FLOAT_cfCCC(A,B) &A
1835 /* Although the VAX doesn't, at least the */
1836#else /* HP and K&R mips promote float arg.'s of */
1837#define FLOAT_cfCCC(A,B) &B /* unprototyped functions to double. Cannot */
1838#endif /* use A here to pass the argument to FORTRAN. */
1839#define INT_cfCCC(A,B) &A
1840#define LOGICAL_cfCCC(A,B) &A
1841#define LONG_cfCCC(A,B) &A
1842#define SHORT_cfCCC(A,B) &A
1843#define PBYTE_cfCCC(A,B) A
1844#define PDOUBLE_cfCCC(A,B) A
1845#define PFLOAT_cfCCC(A,B) A
1846#define PINT_cfCCC(A,B) A
1847#define PLOGICAL_cfCCC(A,B) B=A /* B used to keep a common W table. */
1848#define PLONG_cfCCC(A,B) A
1849#define PSHORT_cfCCC(A,B) A
1850
1851#define CCCF(TN,I,M) _SEP_(TN,M,cfCOMMA) _Icf(3,CC,TN,_(A,I),_(B,I))
1852#define INT_cfCC(T,A,B) _(T,_cfCCC)(A,B)
1853#define INTV_cfCC(T,A,B) A
1854#define INTVV_cfCC(T,A,B) A
1855#define INTVVV_cfCC(T,A,B) A
1856#define INTVVVV_cfCC(T,A,B) A
1857#define INTVVVVV_cfCC(T,A,B) A
1858#define INTVVVVVV_cfCC(T,A,B) A
1859#define INTVVVVVVV_cfCC(T,A,B) A
1860#define PINT_cfCC(T,A,B) _(T,_cfCCC)(A,B)
1861#define PVOID_cfCC(T,A,B) A
1862#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
1863#define ROUTINE_cfCC(T,A,B) &A
1864#else
1865#define ROUTINE_cfCC(T,A,B) A
1866#endif
1867#define SIMPLE_cfCC(T,A,B) A
1868#ifdef vmsFortran
1869#define STRING_cfCC(T,A,B) &B.f
1870#define STRINGV_cfCC(T,A,B) &B
1871#define PSTRING_cfCC(T,A,B) &B
1872#define PSTRINGV_cfCC(T,A,B) &B
1873#else
1874#ifdef CRAYFortran
1875#define STRING_cfCC(T,A,B) _cptofcd(A,B.flen)
1876#define STRINGV_cfCC(T,A,B) _cptofcd(B.s,B.flen)
1877#define PSTRING_cfCC(T,A,B) _cptofcd(A,B)
1878#define PSTRINGV_cfCC(T,A,B) _cptofcd(A,B.flen)
1879#else
1880#define STRING_cfCC(T,A,B) A
1881#define STRINGV_cfCC(T,A,B) B.fs
1882#define PSTRING_cfCC(T,A,B) A
1883#define PSTRINGV_cfCC(T,A,B) B.fs
1884#endif
1885#endif
1886#define ZTRINGV_cfCC(T,A,B) STRINGV_cfCC(T,A,B)
1887#define PZTRINGV_cfCC(T,A,B) PSTRINGV_cfCC(T,A,B)
1888
1889#define BYTE_cfX return A0;
1890#define DOUBLE_cfX return A0;
1891#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
1892#define FLOAT_cfX return A0;
1893#else
1894#define FLOAT_cfX ASSIGNFLOAT(AA0,A0); return AA0;
1895#endif
1896#define INT_cfX return A0;
1897#define LOGICAL_cfX return F2CLOGICAL(A0);
1898#define LONG_cfX return A0;
1899#define SHORT_cfX return A0;
1900#define VOID_cfX return ;
1901#if defined(vmsFortran) || defined(CRAYFortran)
1902#define STRING_cfX return kill_trailing( \
1903 kill_trailing(AA0,CFORTRAN_NON_CHAR),' ');
1904#else
1905#define STRING_cfX return kill_trailing( \
1906 kill_trailing( A0,CFORTRAN_NON_CHAR),' ');
1907#endif
1908
1909#define CFFUN(NAME) _(__cf__,NAME)
1910
1911/* Note that we don't use LN here, but we keep it for consistency. */
1912#define CCALLSFFUN0(UN,LN) CFFUN(UN)()
1913
1914#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */
1915#pragma standard
1916#endif
1917
1918#define CCALLSFFUN1( UN,LN,T1, A1) \
1919 CCALLSFFUN5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0)
1920#define CCALLSFFUN2( UN,LN,T1,T2, A1,A2) \
1921 CCALLSFFUN5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0)
1922#define CCALLSFFUN3( UN,LN,T1,T2,T3, A1,A2,A3) \
1923 CCALLSFFUN5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0)
1924#define CCALLSFFUN4( UN,LN,T1,T2,T3,T4, A1,A2,A3,A4)\
1925 CCALLSFFUN5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0)
1926#define CCALLSFFUN5( UN,LN,T1,T2,T3,T4,T5, A1,A2,A3,A4,A5) \
1927 CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,0,0,0,0,0)
1928#define CCALLSFFUN6( UN,LN,T1,T2,T3,T4,T5,T6, A1,A2,A3,A4,A5,A6) \
1929 CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,0,0,0,0)
1930#define CCALLSFFUN7( UN,LN,T1,T2,T3,T4,T5,T6,T7, A1,A2,A3,A4,A5,A6,A7) \
1931 CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,0,0,0)
1932#define CCALLSFFUN8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8, A1,A2,A3,A4,A5,A6,A7,A8) \
1933 CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,0,0)
1934#define CCALLSFFUN9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\
1935 CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0)
1936#define CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\
1937 CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,0,0,0,0)
1938#define CCALLSFFUN11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB)\
1939 CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,0,0,0)
1940#define CCALLSFFUN12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC)\
1941 CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,0,0)
1942#define CCALLSFFUN13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD)\
1943 CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,0)
1944
1945#define CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\
1946((CFFUN(UN)( BCF(T1,A1,0) BCF(T2,A2,1) BCF(T3,A3,1) BCF(T4,A4,1) BCF(T5,A5,1) \
1947 BCF(T6,A6,1) BCF(T7,A7,1) BCF(T8,A8,1) BCF(T9,A9,1) BCF(TA,AA,1) \
1948 BCF(TB,AB,1) BCF(TC,AC,1) BCF(TD,AD,1) BCF(TE,AE,1) \
1949 SCF(T1,LN,1,A1) SCF(T2,LN,2,A2) SCF(T3,LN,3,A3) SCF(T4,LN,4,A4) \
1950 SCF(T5,LN,5,A5) SCF(T6,LN,6,A6) SCF(T7,LN,7,A7) SCF(T8,LN,8,A8) \
1951 SCF(T9,LN,9,A9) SCF(TA,LN,10,AA) SCF(TB,LN,11,AB) SCF(TC,LN,12,AC) \
1952 SCF(TD,LN,13,AD) SCF(TE,LN,14,AE))))
1953
1954/* N.B. Create a separate function instead of using (call function, function
1955value here) because in order to create the variables needed for the input
1956arg.'s which may be const.'s one has to do the creation within {}, but these
1957can never be placed within ()'s. Therefore one must create wrapper functions.
1958gcc, on the other hand may be able to avoid the wrapper functions. */
1959
1960/* Prototypes are needed to correctly handle the value returned correctly. N.B.
1961Can only have prototype arg.'s with difficulty, a la G... table since FORTRAN
1962functions returning strings have extra arg.'s. Don't bother, since this only
1963causes a compiler warning to come up when one uses FCALLSCFUNn and CCALLSFFUNn
1964for the same function in the same source code. Something done by the experts in
1965debugging only.*/
1966
1967#define PROTOCCALLSFFUN0(F,UN,LN) \
1968_(F,_cfPU)( CFC_(UN,LN))(CF_NULL_PROTO); \
1969static _Icf(2,U,F,CFFUN(UN),0)() {_(F,_cfE) _Icf(3,GZ,F,UN,LN) ABSOFT_cf1(F));_(F,_cfX)}
1970
1971#define PROTOCCALLSFFUN1( T0,UN,LN,T1) \
1972 PROTOCCALLSFFUN5 (T0,UN,LN,T1,CF_0,CF_0,CF_0,CF_0)
1973#define PROTOCCALLSFFUN2( T0,UN,LN,T1,T2) \
1974 PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,CF_0,CF_0,CF_0)
1975#define PROTOCCALLSFFUN3( T0,UN,LN,T1,T2,T3) \
1976 PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,CF_0,CF_0)
1977#define PROTOCCALLSFFUN4( T0,UN,LN,T1,T2,T3,T4) \
1978 PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,T4,CF_0)
1979#define PROTOCCALLSFFUN5( T0,UN,LN,T1,T2,T3,T4,T5) \
1980 PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0)
1981#define PROTOCCALLSFFUN6( T0,UN,LN,T1,T2,T3,T4,T5,T6) \
1982 PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0)
1983#define PROTOCCALLSFFUN7( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7) \
1984 PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0)
1985#define PROTOCCALLSFFUN8( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
1986 PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0)
1987#define PROTOCCALLSFFUN9( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
1988 PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0)
1989#define PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
1990 PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0)
1991#define PROTOCCALLSFFUN11(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
1992 PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0)
1993#define PROTOCCALLSFFUN12(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
1994 PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0)
1995#define PROTOCCALLSFFUN13(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
1996 PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0)
1997
1998/* HP/UX 9.01 cc requires the blank between '_Icf(3,G,T0,UN,LN) CCCF(T1,1,0)' */
1999
2000#ifndef __CF__KnR
2001#define PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
2002 _(T0,_cfPU)(CFC_(UN,LN))(CF_NULL_PROTO); static _Icf(2,U,T0,CFFUN(UN),0)( \
2003 CFARGT14FS(UCF,HCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ) \
2004{ CFARGT14S(VCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfE) \
2005 CCF(LN,T1,1) CCF(LN,T2,2) CCF(LN,T3,3) CCF(LN,T4,4) CCF(LN,T5,5) \
2006 CCF(LN,T6,6) CCF(LN,T7,7) CCF(LN,T8,8) CCF(LN,T9,9) CCF(LN,TA,10) \
2007 CCF(LN,TB,11) CCF(LN,TC,12) CCF(LN,TD,13) CCF(LN,TE,14) _Icf(3,G,T0,UN,LN) \
2008 CFARGT14(CCCF,JCF,ABSOFT_cf1(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \
2009 WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \
2010 WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,A10,10) \
2011 WCF(TB,A11,11) WCF(TC,A12,12) WCF(TD,A13,13) WCF(TE,A14,14) _(T0,_cfX)}
2012#else
2013#define PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
2014 _(T0,_cfPU)(CFC_(UN,LN))(CF_NULL_PROTO); static _Icf(2,U,T0,CFFUN(UN),0)( \
2015 CFARGT14FS(UUCF,HHCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ) \
2016 CFARGT14FS(UUUCF,HHHCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ; \
2017{ CFARGT14S(VCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfE) \
2018 CCF(LN,T1,1) CCF(LN,T2,2) CCF(LN,T3,3) CCF(LN,T4,4) CCF(LN,T5,5) \
2019 CCF(LN,T6,6) CCF(LN,T7,7) CCF(LN,T8,8) CCF(LN,T9,9) CCF(LN,TA,10) \
2020 CCF(LN,TB,11) CCF(LN,TC,12) CCF(LN,TD,13) CCF(LN,TE,14) _Icf(3,G,T0,UN,LN) \
2021 CFARGT14(CCCF,JCF,ABSOFT_cf1(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \
2022 WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \
2023 WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,A10,10) \
2024 WCF(TB,A11,11) WCF(TC,A12,12) WCF(TD,A13,13) WCF(TE,A14,14) _(T0,_cfX)}
2025#endif
2026
2027/*-------------------------------------------------------------------------*/
2028
2029/* UTILITIES FOR FORTRAN TO CALL C ROUTINES */
2030
2031#ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */
2032#pragma nostandard
2033#endif
2034
2035#if defined(vmsFortran) || defined(CRAYFortran)
2036#define DCF(TN,I)
2037#define DDCF(TN,I)
2038#define DDDCF(TN,I)
2039#else
2040#define DCF(TN,I) HCF(TN,I)
2041#define DDCF(TN,I) HHCF(TN,I)
2042#define DDDCF(TN,I) HHHCF(TN,I)
2043#endif
2044
2045#define QCF(TN,I) _(TN,_cfSTR)(1,Q,_(B,I), 0,0,0,0)
2046#define DEFAULT_cfQ(B)
2047#define LOGICAL_cfQ(B)
2048#define PLOGICAL_cfQ(B)
2049#define STRINGV_cfQ(B) char *B; unsigned int _(B,N);
2050#define STRING_cfQ(B) char *B=NULL;
2051#define PSTRING_cfQ(B) char *B=NULL;
2052#define PSTRINGV_cfQ(B) STRINGV_cfQ(B)
2053#define PNSTRING_cfQ(B) char *B=NULL;
2054#define PPSTRING_cfQ(B)
2055
2056#ifdef __sgi /* Else SGI gives warning 182 contrary to its C LRM A.17.7 */
2057#define ROUTINE_orig *(void**)&
2058#else
2059#define ROUTINE_orig (void *)
2060#endif
2061
2062#define ROUTINE_1 ROUTINE_orig
2063#define ROUTINE_2 ROUTINE_orig
2064#define ROUTINE_3 ROUTINE_orig
2065#define ROUTINE_4 ROUTINE_orig
2066#define ROUTINE_5 ROUTINE_orig
2067#define ROUTINE_6 ROUTINE_orig
2068#define ROUTINE_7 ROUTINE_orig
2069#define ROUTINE_8 ROUTINE_orig
2070#define ROUTINE_9 ROUTINE_orig
2071#define ROUTINE_10 ROUTINE_orig
2072#define ROUTINE_11 ROUTINE_orig
2073#define ROUTINE_12 ROUTINE_orig
2074#define ROUTINE_13 ROUTINE_orig
2075#define ROUTINE_14 ROUTINE_orig
2076#define ROUTINE_15 ROUTINE_orig
2077#define ROUTINE_16 ROUTINE_orig
2078#define ROUTINE_17 ROUTINE_orig
2079#define ROUTINE_18 ROUTINE_orig
2080#define ROUTINE_19 ROUTINE_orig
2081#define ROUTINE_20 ROUTINE_orig
2082#define ROUTINE_21 ROUTINE_orig
2083#define ROUTINE_22 ROUTINE_orig
2084#define ROUTINE_23 ROUTINE_orig
2085#define ROUTINE_24 ROUTINE_orig
2086#define ROUTINE_25 ROUTINE_orig
2087#define ROUTINE_26 ROUTINE_orig
2088#define ROUTINE_27 ROUTINE_orig
2089
2090#define TCF(NAME,TN,I,M) _SEP_(TN,M,cfCOMMA) _(TN,_cfT)(NAME,I,_(A,I),_(B,I),_(C,I))
2091#define BYTE_cfT(M,I,A,B,D) *A
2092#define DOUBLE_cfT(M,I,A,B,D) *A
2093#define FLOAT_cfT(M,I,A,B,D) *A
2094#define INT_cfT(M,I,A,B,D) *A
2095#define LOGICAL_cfT(M,I,A,B,D) F2CLOGICAL(*A)
2096#define LONG_cfT(M,I,A,B,D) *A
2097#define LONGLONG_cfT(M,I,A,B,D) *A /* added by MR December 2005 */
2098#define SHORT_cfT(M,I,A,B,D) *A
2099#define BYTEV_cfT(M,I,A,B,D) A
2100#define DOUBLEV_cfT(M,I,A,B,D) A
2101#define FLOATV_cfT(M,I,A,B,D) VOIDP A
2102#define INTV_cfT(M,I,A,B,D) A
2103#define LOGICALV_cfT(M,I,A,B,D) A
2104#define LONGV_cfT(M,I,A,B,D) A
2105#define LONGLONGV_cfT(M,I,A,B,D) A /* added by MR December 2005 */
2106#define SHORTV_cfT(M,I,A,B,D) A
2107#define BYTEVV_cfT(M,I,A,B,D) (void *)A /* We have to cast to void *,*/
2108#define BYTEVVV_cfT(M,I,A,B,D) (void *)A /* since we don't know the */
2109#define BYTEVVVV_cfT(M,I,A,B,D) (void *)A /* dimensions of the array. */
2110#define BYTEVVVVV_cfT(M,I,A,B,D) (void *)A /* i.e. Unfortunately, can't */
2111#define BYTEVVVVVV_cfT(M,I,A,B,D) (void *)A /* check that the type */
2112#define BYTEVVVVVVV_cfT(M,I,A,B,D) (void *)A /* matches the prototype. */
2113#define DOUBLEVV_cfT(M,I,A,B,D) (void *)A
2114#define DOUBLEVVV_cfT(M,I,A,B,D) (void *)A
2115#define DOUBLEVVVV_cfT(M,I,A,B,D) (void *)A
2116#define DOUBLEVVVVV_cfT(M,I,A,B,D) (void *)A
2117#define DOUBLEVVVVVV_cfT(M,I,A,B,D) (void *)A
2118#define DOUBLEVVVVVVV_cfT(M,I,A,B,D) (void *)A
2119#define FLOATVV_cfT(M,I,A,B,D) (void *)A
2120#define FLOATVVV_cfT(M,I,A,B,D) (void *)A
2121#define FLOATVVVV_cfT(M,I,A,B,D) (void *)A
2122#define FLOATVVVVV_cfT(M,I,A,B,D) (void *)A
2123#define FLOATVVVVVV_cfT(M,I,A,B,D) (void *)A
2124#define FLOATVVVVVVV_cfT(M,I,A,B,D) (void *)A
2125#define INTVV_cfT(M,I,A,B,D) (void *)A
2126#define INTVVV_cfT(M,I,A,B,D) (void *)A
2127#define INTVVVV_cfT(M,I,A,B,D) (void *)A
2128#define INTVVVVV_cfT(M,I,A,B,D) (void *)A
2129#define INTVVVVVV_cfT(M,I,A,B,D) (void *)A
2130#define INTVVVVVVV_cfT(M,I,A,B,D) (void *)A
2131#define LOGICALVV_cfT(M,I,A,B,D) (void *)A
2132#define LOGICALVVV_cfT(M,I,A,B,D) (void *)A
2133#define LOGICALVVVV_cfT(M,I,A,B,D) (void *)A
2134#define LOGICALVVVVV_cfT(M,I,A,B,D) (void *)A
2135#define LOGICALVVVVVV_cfT(M,I,A,B,D) (void *)A
2136#define LOGICALVVVVVVV_cfT(M,I,A,B,D) (void *)A
2137#define LONGVV_cfT(M,I,A,B,D) (void *)A
2138#define LONGVVV_cfT(M,I,A,B,D) (void *)A
2139#define LONGVVVV_cfT(M,I,A,B,D) (void *)A
2140#define LONGVVVVV_cfT(M,I,A,B,D) (void *)A
2141#define LONGVVVVVV_cfT(M,I,A,B,D) (void *)A
2142#define LONGVVVVVVV_cfT(M,I,A,B,D) (void *)A
2143#define LONGLONGVV_cfT(M,I,A,B,D) (void *)A /* added by MR December 2005 */
2144#define LONGLONGVVV_cfT(M,I,A,B,D) (void *)A /* added by MR December 2005 */
2145#define LONGLONGVVVV_cfT(M,I,A,B,D) (void *)A /* added by MR December 2005 */
2146#define LONGLONGVVVVV_cfT(M,I,A,B,D) (void *)A /* added by MR December 2005 */
2147#define LONGLONGVVVVVV_cfT(M,I,A,B,D) (void *)A /* added by MR December 2005 */
2148#define LONGLONGVVVVVVV_cfT(M,I,A,B,D) (void *)A /* added by MR December 2005 */
2149#define SHORTVV_cfT(M,I,A,B,D) (void *)A
2150#define SHORTVVV_cfT(M,I,A,B,D) (void *)A
2151#define SHORTVVVV_cfT(M,I,A,B,D) (void *)A
2152#define SHORTVVVVV_cfT(M,I,A,B,D) (void *)A
2153#define SHORTVVVVVV_cfT(M,I,A,B,D) (void *)A
2154#define SHORTVVVVVVV_cfT(M,I,A,B,D) (void *)A
2155#define PBYTE_cfT(M,I,A,B,D) A
2156#define PDOUBLE_cfT(M,I,A,B,D) A
2157#define PFLOAT_cfT(M,I,A,B,D) VOIDP A
2158#define PINT_cfT(M,I,A,B,D) A
2159#define PLOGICAL_cfT(M,I,A,B,D) ((*A=F2CLOGICAL(*A)),A)
2160#define PLONG_cfT(M,I,A,B,D) A
2161#define PLONGLONG_cfT(M,I,A,B,D) A /* added by MR December 2005 */
2162#define PSHORT_cfT(M,I,A,B,D) A
2163#define PVOID_cfT(M,I,A,B,D) A
2164#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
2165#define ROUTINE_cfT(M,I,A,B,D) _(ROUTINE_,I) (*A)
2166#else
2167#define ROUTINE_cfT(M,I,A,B,D) _(ROUTINE_,I) A
2168#endif
2169/* A == pointer to the characters
2170 D == length of the string, or of an element in an array of strings
2171 E == number of elements in an array of strings */
2172#define TTSTR( A,B,D) \
2173 ((B=_cf_malloc(D+1))[D]='\0', memcpy(B,A,D), kill_trailing(B,' '))
2174#define TTTTSTR( A,B,D) (!(D<4||A[0]||A[1]||A[2]||A[3]))?NULL: \
2175 memchr(A,'\0',D) ?A : TTSTR(A,B,D)
2176#define TTTTSTRV( A,B,D,E) (_(B,N)=E,B=_cf_malloc(_(B,N)*(D+1)), (void *) \
2177 vkill_trailing(f2cstrv(A,B,D+1, _(B,N)*(D+1)), D+1,_(B,N)*(D+1),' '))
2178#ifdef vmsFortran
2179#define STRING_cfT(M,I,A,B,D) TTTTSTR( A->dsc$a_pointer,B,A->dsc$w_length)
2180#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(A->dsc$a_pointer, B, \
2181 A->dsc$w_length , A->dsc$l_m[0])
2182#define PSTRING_cfT(M,I,A,B,D) TTSTR( A->dsc$a_pointer,B,A->dsc$w_length)
2183#define PPSTRING_cfT(M,I,A,B,D) A->dsc$a_pointer
2184#else
2185#ifdef CRAYFortran
2186#define STRING_cfT(M,I,A,B,D) TTTTSTR( _fcdtocp(A),B,_fcdlen(A))
2187#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(_fcdtocp(A),B,_fcdlen(A), \
2188 num_elem(_fcdtocp(A),_fcdlen(A),_3(M,_STRV_A,I)))
2189#define PSTRING_cfT(M,I,A,B,D) TTSTR( _fcdtocp(A),B,_fcdlen(A))
2190#define PPSTRING_cfT(M,I,A,B,D) _fcdtocp(A)
2191#else
2192#define STRING_cfT(M,I,A,B,D) TTTTSTR( A,B,D)
2193#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(A,B,D, num_elem(A,D,_3(M,_STRV_A,I)))
2194#define PSTRING_cfT(M,I,A,B,D) TTSTR( A,B,D)
2195#define PPSTRING_cfT(M,I,A,B,D) A
2196#endif
2197#endif
2198#define PNSTRING_cfT(M,I,A,B,D) STRING_cfT(M,I,A,B,D)
2199#define PSTRINGV_cfT(M,I,A,B,D) STRINGV_cfT(M,I,A,B,D)
2200#define CF_0_cfT(M,I,A,B,D)
2201
2202#define RCF(TN,I) _(TN,_cfSTR)(3,R,_(A,I),_(B,I),_(C,I),0,0)
2203#define DEFAULT_cfR(A,B,D)
2204#define LOGICAL_cfR(A,B,D)
2205#define PLOGICAL_cfR(A,B,D) *A=C2FLOGICAL(*A);
2206#define STRING_cfR(A,B,D) if (B) _cf_free(B);
2207#define STRINGV_cfR(A,B,D) _cf_free(B);
2208/* A and D as defined above for TSTRING(V) */
2209#define RRRRPSTR( A,B,D) if (B) memcpy(A,B, _cfMIN(strlen(B),D)), \
2210 (D>strlen(B)?memset(A+strlen(B),' ', D-strlen(B)):0), _cf_free(B);
2211#define RRRRPSTRV(A,B,D) c2fstrv(B,A,D+1,(D+1)*_(B,N)), _cf_free(B);
2212#ifdef vmsFortran
2213#define PSTRING_cfR(A,B,D) RRRRPSTR( A->dsc$a_pointer,B,A->dsc$w_length)
2214#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(A->dsc$a_pointer,B,A->dsc$w_length)
2215#else
2216#ifdef CRAYFortran
2217#define PSTRING_cfR(A,B,D) RRRRPSTR( _fcdtocp(A),B,_fcdlen(A))
2218#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(_fcdtocp(A),B,_fcdlen(A))
2219#else
2220#define PSTRING_cfR(A,B,D) RRRRPSTR( A,B,D)
2221#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(A,B,D)
2222#endif
2223#endif
2224#define PNSTRING_cfR(A,B,D) PSTRING_cfR(A,B,D)
2225#define PPSTRING_cfR(A,B,D)
2226
2227#define BYTE_cfFZ(UN,LN) INTEGER_BYTE FCALLSC_QUALIFIER fcallsc(UN,LN)(
2228#define DOUBLE_cfFZ(UN,LN) DOUBLE_PRECISION FCALLSC_QUALIFIER fcallsc(UN,LN)(
2229#define INT_cfFZ(UN,LN) int FCALLSC_QUALIFIER fcallsc(UN,LN)(
2230#define LOGICAL_cfFZ(UN,LN) int FCALLSC_QUALIFIER fcallsc(UN,LN)(
2231#define LONG_cfFZ(UN,LN) long FCALLSC_QUALIFIER fcallsc(UN,LN)(
2232#define LONGLONG_cfFZ(UN,LN) LONGLONG FCALLSC_QUALIFIER fcallsc(UN,LN)( /* added by MR December 2005 */
2233#define SHORT_cfFZ(UN,LN) short FCALLSC_QUALIFIER fcallsc(UN,LN)(
2234#define VOID_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(
2235#ifndef __CF__KnR
2236/* The void is req'd by the Apollo, to make this an ANSI function declaration.
2237 The Apollo promotes K&R float functions to double. */
2238#if defined (f2cFortran) && ! defined (gFortran)
2239/* f2c/g77 return double from FORTRAN REAL functions. (KMCCARTY, 2005/12/09) */
2240#define FLOAT_cfFZ(UN,LN) DOUBLE_PRECISION FCALLSC_QUALIFIER fcallsc(UN,LN)(void
2241#else
2242#define FLOAT_cfFZ(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)(void
2243#endif
2244#ifdef vmsFortran
2245#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(fstring *AS
2246#else
2247#ifdef CRAYFortran
2248#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(_fcd AS
2249#else
2250#if defined(AbsoftUNIXFortran) || defined(AbsoftProFortran)
2251#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(char *AS
2252#else
2253#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(char *AS, unsigned D0
2254#endif
2255#endif
2256#endif
2257#else
2258#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
2259#if defined (f2cFortran) && ! defined (gFortran)
2260/* f2c/g77 return double from FORTRAN REAL functions. (KMCCARTY, 2005/12/09) */
2261#define FLOAT_cfFZ(UN,LN) DOUBLE_PRECISION FCALLSC_QUALIFIER fcallsc(UN,LN)(
2262#else
2263#define FLOAT_cfFZ(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)(
2264#endif
2265#else
2266#define FLOAT_cfFZ(UN,LN) FLOATFUNCTIONTYPE FCALLSC_QUALIFIER fcallsc(UN,LN)(
2267#endif
2268#if defined(vmsFortran) || defined(CRAYFortran) || defined(AbsoftUNIXFortran)
2269#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(AS
2270#else
2271#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(AS, D0
2272#endif
2273#endif
2274
2275#define BYTE_cfF(UN,LN) BYTE_cfFZ(UN,LN)
2276#define DOUBLE_cfF(UN,LN) DOUBLE_cfFZ(UN,LN)
2277#ifndef __CF_KnR
2278#if defined (f2cFortran) && ! defined (gFortran)
2279/* f2c/g77 return double from FORTRAN REAL functions. (KMCCARTY, 2005/12/09) */
2280#define FLOAT_cfF(UN,LN) DOUBLE_PRECISION FCALLSC_QUALIFIER fcallsc(UN,LN)(
2281#else
2282#define FLOAT_cfF(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)(
2283#endif
2284#else
2285#define FLOAT_cfF(UN,LN) FLOAT_cfFZ(UN,LN)
2286#endif
2287#define INT_cfF(UN,LN) INT_cfFZ(UN,LN)
2288#define LOGICAL_cfF(UN,LN) LOGICAL_cfFZ(UN,LN)
2289#define LONG_cfF(UN,LN) LONG_cfFZ(UN,LN)
2290#define LONGLONG_cfF(UN,LN) LONGLONG_cfFZ(UN,LN) /* added by MR December 2005 */
2291#define SHORT_cfF(UN,LN) SHORT_cfFZ(UN,LN)
2292#define VOID_cfF(UN,LN) VOID_cfFZ(UN,LN)
2293#define STRING_cfF(UN,LN) STRING_cfFZ(UN,LN),
2294
2295#define INT_cfFF
2296#define VOID_cfFF
2297#ifdef vmsFortran
2298#define STRING_cfFF fstring *AS;
2299#else
2300#ifdef CRAYFortran
2301#define STRING_cfFF _fcd AS;
2302#else
2303#define STRING_cfFF char *AS; unsigned D0;
2304#endif
2305#endif
2306
2307#define INT_cfL A0=
2308#define STRING_cfL A0=
2309#define VOID_cfL
2310
2311#define INT_cfK
2312#define VOID_cfK
2313/* KSTRING copies the string into the position provided by the caller. */
2314#ifdef vmsFortran
2315#define STRING_cfK \
2316 memcpy(AS->dsc$a_pointer,A0,_cfMIN(AS->dsc$w_length,(A0==NULL?0:strlen(A0))));\
2317 AS->dsc$w_length>(A0==NULL?0:strlen(A0))? \
2318 memset(AS->dsc$a_pointer+(A0==NULL?0:strlen(A0)),' ', \
2319 AS->dsc$w_length-(A0==NULL?0:strlen(A0))):0;
2320#else
2321#ifdef CRAYFortran
2322#define STRING_cfK \
2323 memcpy(_fcdtocp(AS),A0, _cfMIN(_fcdlen(AS),(A0==NULL?0:strlen(A0))) ); \
2324 _fcdlen(AS)>(A0==NULL?0:strlen(A0))? \
2325 memset(_fcdtocp(AS)+(A0==NULL?0:strlen(A0)),' ', \
2326 _fcdlen(AS)-(A0==NULL?0:strlen(A0))):0;
2327#else
2328#define STRING_cfK memcpy(AS,A0, _cfMIN(D0,(A0==NULL?0:strlen(A0))) ); \
2329 D0>(A0==NULL?0:strlen(A0))?memset(AS+(A0==NULL?0:strlen(A0)), \
2330 ' ', D0-(A0==NULL?0:strlen(A0))):0;
2331#endif
2332#endif
2333
2334/* Note that K.. and I.. can't be combined since K.. has to access data before
2335R.., in order for functions returning strings which are also passed in as
2336arguments to work correctly. Note that R.. frees and hence may corrupt the
2337string. */
2338#define BYTE_cfI return A0;
2339#define DOUBLE_cfI return A0;
2340#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
2341#define FLOAT_cfI return A0;
2342#else
2343#define FLOAT_cfI RETURNFLOAT(A0);
2344#endif
2345#define INT_cfI return A0;
2346#ifdef hpuxFortran800
2347/* Incredibly, functions must return true as 1, elsewhere .true.==0x01000000. */
2348#define LOGICAL_cfI return ((A0)?1:0);
2349#else
2350#define LOGICAL_cfI return C2FLOGICAL(A0);
2351#endif
2352#define LONG_cfI return A0;
2353#define LONGLONG_cfI return A0; /* added by MR December 2005 */
2354#define SHORT_cfI return A0;
2355#define STRING_cfI return ;
2356#define VOID_cfI return ;
2357
2358#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */
2359#pragma standard
2360#endif
2361
2362#define FCALLSCSUB0( CN,UN,LN) FCALLSCFUN0(VOID,CN,UN,LN)
2363#define FCALLSCSUB1( CN,UN,LN,T1) FCALLSCFUN1(VOID,CN,UN,LN,T1)
2364#define FCALLSCSUB2( CN,UN,LN,T1,T2) FCALLSCFUN2(VOID,CN,UN,LN,T1,T2)
2365#define FCALLSCSUB3( CN,UN,LN,T1,T2,T3) FCALLSCFUN3(VOID,CN,UN,LN,T1,T2,T3)
2366#define FCALLSCSUB4( CN,UN,LN,T1,T2,T3,T4) \
2367 FCALLSCFUN4(VOID,CN,UN,LN,T1,T2,T3,T4)
2368#define FCALLSCSUB5( CN,UN,LN,T1,T2,T3,T4,T5) \
2369 FCALLSCFUN5(VOID,CN,UN,LN,T1,T2,T3,T4,T5)
2370#define FCALLSCSUB6( CN,UN,LN,T1,T2,T3,T4,T5,T6) \
2371 FCALLSCFUN6(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6)
2372#define FCALLSCSUB7( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \
2373 FCALLSCFUN7(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7)
2374#define FCALLSCSUB8( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
2375 FCALLSCFUN8(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8)
2376#define FCALLSCSUB9( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
2377 FCALLSCFUN9(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9)
2378#define FCALLSCSUB10(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
2379 FCALLSCFUN10(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA)
2380#define FCALLSCSUB11(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
2381 FCALLSCFUN11(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB)
2382#define FCALLSCSUB12(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
2383 FCALLSCFUN12(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC)
2384#define FCALLSCSUB13(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
2385 FCALLSCFUN13(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD)
2386#define FCALLSCSUB14(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
2387 FCALLSCFUN14(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
2388#define FCALLSCSUB15(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \
2389 FCALLSCFUN15(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF)
2390#define FCALLSCSUB16(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \
2391 FCALLSCFUN16(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG)
2392#define FCALLSCSUB17(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \
2393 FCALLSCFUN17(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH)
2394#define FCALLSCSUB18(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \
2395 FCALLSCFUN18(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI)
2396#define FCALLSCSUB19(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \
2397 FCALLSCFUN19(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ)
2398#define FCALLSCSUB20(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
2399 FCALLSCFUN20(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
2400#define FCALLSCSUB21(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL) \
2401 FCALLSCFUN21(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL)
2402#define FCALLSCSUB22(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM) \
2403 FCALLSCFUN22(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM)
2404#define FCALLSCSUB23(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN) \
2405 FCALLSCFUN23(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN)
2406#define FCALLSCSUB24(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO) \
2407 FCALLSCFUN24(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO)
2408#define FCALLSCSUB25(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP) \
2409 FCALLSCFUN25(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP)
2410#define FCALLSCSUB26(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ) \
2411 FCALLSCFUN26(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ)
2412#define FCALLSCSUB27(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
2413 FCALLSCFUN27(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
2414
2415
2416#define FCALLSCFUN1( T0,CN,UN,LN,T1) \
2417 FCALLSCFUN5 (T0,CN,UN,LN,T1,CF_0,CF_0,CF_0,CF_0)
2418#define FCALLSCFUN2( T0,CN,UN,LN,T1,T2) \
2419 FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,CF_0,CF_0,CF_0)
2420#define FCALLSCFUN3( T0,CN,UN,LN,T1,T2,T3) \
2421 FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,CF_0,CF_0)
2422#define FCALLSCFUN4( T0,CN,UN,LN,T1,T2,T3,T4) \
2423 FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,T4,CF_0)
2424#define FCALLSCFUN5( T0,CN,UN,LN,T1,T2,T3,T4,T5) \
2425 FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0)
2426#define FCALLSCFUN6( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6) \
2427 FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0)
2428#define FCALLSCFUN7( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \
2429 FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0)
2430#define FCALLSCFUN8( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
2431 FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0)
2432#define FCALLSCFUN9( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
2433 FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0)
2434#define FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
2435 FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0)
2436#define FCALLSCFUN11(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
2437 FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0)
2438#define FCALLSCFUN12(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
2439 FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0)
2440#define FCALLSCFUN13(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
2441 FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0)
2442
2443
2444#define FCALLSCFUN15(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \
2445 FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,CF_0,CF_0,CF_0,CF_0,CF_0)
2446#define FCALLSCFUN16(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \
2447 FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,CF_0,CF_0,CF_0,CF_0)
2448#define FCALLSCFUN17(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \
2449 FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,CF_0,CF_0,CF_0)
2450#define FCALLSCFUN18(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \
2451 FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,CF_0,CF_0)
2452#define FCALLSCFUN19(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \
2453 FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0)
2454#define FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
2455 FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
2456#define FCALLSCFUN21(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL) \
2457 FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
2458#define FCALLSCFUN22(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM) \
2459 FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,CF_0,CF_0,CF_0,CF_0,CF_0)
2460#define FCALLSCFUN23(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN) \
2461 FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,CF_0,CF_0,CF_0,CF_0)
2462#define FCALLSCFUN24(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO) \
2463 FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,CF_0,CF_0,CF_0)
2464#define FCALLSCFUN25(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP) \
2465 FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,CF_0,CF_0)
2466#define FCALLSCFUN26(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ) \
2467 FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,CF_0)
2468
2469
2470#ifndef __CF__KnR
2471#define FCALLSCFUN0(T0,CN,UN,LN) CFextern _(T0,_cfFZ)(UN,LN) ABSOFT_cf2(T0)) \
2472 {_Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN(); _Icf(0,K,T0,0,0) _(T0,_cfI)}
2473
2474#define FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
2475 CFextern _(T0,_cfF)(UN,LN) \
2476 CFARGT14(NCF,DCF,ABSOFT_cf2(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ) \
2477 { CFARGT14S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
2478 _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \
2479 TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \
2480 TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \
2481 TCF(LN,TD,13,1) TCF(LN,TE,14,1) ); _Icf(0,K,T0,0,0) \
2482 CFARGT14S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfI) }
2483
2484#define FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
2485 CFextern _(T0,_cfF)(UN,LN) \
2486 CFARGT27(NCF,DCF,ABSOFT_cf2(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) ) \
2487 { CFARGT27S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
2488 _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \
2489 TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \
2490 TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \
2491 TCF(LN,TD,13,1) TCF(LN,TE,14,1) TCF(LN,TF,15,1) TCF(LN,TG,16,1) TCF(LN,TH,17,1) \
2492 TCF(LN,TI,18,1) TCF(LN,TJ,19,1) TCF(LN,TK,20,1) TCF(LN,TL,21,1) TCF(LN,TM,22,1) \
2493 TCF(LN,TN,23,1) TCF(LN,TO,24,1) TCF(LN,TP,25,1) TCF(LN,TQ,26,1) TCF(LN,TR,27,1) ); _Icf(0,K,T0,0,0) \
2494 CFARGT27S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) _(T0,_cfI) }
2495
2496#else
2497#define FCALLSCFUN0(T0,CN,UN,LN) CFextern _(T0,_cfFZ)(UN,LN) ABSOFT_cf3(T0)) _Icf(0,FF,T0,0,0)\
2498 {_Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN(); _Icf(0,K,T0,0,0) _(T0,_cfI)}
2499
2500#define FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
2501 CFextern _(T0,_cfF)(UN,LN) \
2502 CFARGT14(NNCF,DDCF,ABSOFT_cf3(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)) _Icf(0,FF,T0,0,0) \
2503 CFARGT14FS(NNNCF,DDDCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE); \
2504 { CFARGT14S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
2505 _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \
2506 TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \
2507 TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \
2508 TCF(LN,TD,13,1) TCF(LN,TE,14,1) ); _Icf(0,K,T0,0,0) \
2509 CFARGT14S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfI)}
2510
2511#define FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
2512 CFextern _(T0,_cfF)(UN,LN) \
2513 CFARGT27(NNCF,DDCF,ABSOFT_cf3(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)) _Icf(0,FF,T0,0,0) \
2514 CFARGT27FS(NNNCF,DDDCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR); \
2515 { CFARGT27S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
2516 _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \
2517 TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \
2518 TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \
2519 TCF(LN,TD,13,1) TCF(LN,TE,14,1) TCF(LN,TF,15,1) TCF(LN,TG,16,1) TCF(LN,TH,17,1) \
2520 TCF(LN,TI,18,1) TCF(LN,TJ,19,1) TCF(LN,TK,20,1) TCF(LN,TL,21,1) TCF(LN,TM,22,1) \
2521 TCF(LN,TN,23,1) TCF(LN,TO,24,1) TCF(LN,TP,25,1) TCF(LN,TQ,26,1) TCF(LN,TR,27,1) ); _Icf(0,K,T0,0,0) \
2522 CFARGT27S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) _(T0,_cfI)}
2523
2524#endif
2525
2526
2527#endif /* __CFORTRAN_LOADED */
e
#define e(i)
Definition RSha256.hxx:103
kill_trailing
static char * kill_trailing(char *s, char t)
Definition cfortran.h:548
CF_NULL_PROTO
#define CF_NULL_PROTO
Definition cfortran.h:371
f2cstrv
static char * f2cstrv(char *fstr, char *cstr, int elem_len, int sizeofcstr)
Definition cfortran.h:531
num_elem
static int num_elem(char *strv, unsigned elem_len, int term_char, int num_term)
Definition cfortran.h:622
_NUM_ELEMS
#define _NUM_ELEMS
Definition cfortran.h:615
kill_trailingn
static char * kill_trailingn(char *s, char t, char *e)
Definition cfortran.h:564
c2fstrv
static char * c2fstrv(char *cstr, char *fstr, int elem_len, int sizeofcstr)
Definition cfortran.h:514
cfCAST_FUNCTION
void(* cfCAST_FUNCTION)()
Definition cfortran.h:737
_NUM_ELEM_ARG
#define _NUM_ELEM_ARG
Definition cfortran.h:616
__cfortran__notused_dummy
static void __cfortran__notused_dummy()
Definition cfortran.h:645
vkill_trailing
static char * vkill_trailing(char *cstr, int elem_len, int sizeofcstr, char t)
Definition cfortran.h:578
LONGLONG
long long LONGLONG
Definition cfortran.h:82