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