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