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