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