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