diff options
Diffstat (limited to 'include/cfitsio')
| -rw-r--r-- | include/cfitsio/cfortran.h | 2149 | ||||
| -rw-r--r-- | include/cfitsio/compress.h | 212 | ||||
| -rw-r--r-- | include/cfitsio/drvrsmem.h | 178 | ||||
| -rw-r--r-- | include/cfitsio/eval_defs.h | 147 | ||||
| -rw-r--r-- | include/cfitsio/eval_tab.h | 37 | ||||
| -rw-r--r-- | include/cfitsio/f77_wrap.h | 277 | ||||
| -rw-r--r-- | include/cfitsio/fitsio.h | 1355 | ||||
| -rw-r--r-- | include/cfitsio/fitsio2.h | 870 | ||||
| -rw-r--r-- | include/cfitsio/group.h | 65 | ||||
| -rw-r--r-- | include/cfitsio/grparser.h | 181 | ||||
| -rw-r--r-- | include/cfitsio/imcompress.h | 56 | ||||
| -rw-r--r-- | include/cfitsio/longnam.h | 476 | ||||
| -rw-r--r-- | include/cfitsio/pctype.h | 155 | ||||
| -rw-r--r-- | include/cfitsio/region.h | 80 | ||||
| -rw-r--r-- | include/cfitsio/ricecomp.h | 107 |
15 files changed, 6345 insertions, 0 deletions
diff --git a/include/cfitsio/cfortran.h b/include/cfitsio/cfortran.h new file mode 100644 index 0000000..0688224 --- /dev/null +++ b/include/cfitsio/cfortran.h @@ -0,0 +1,2149 @@ +/* cfortran.h 3.9 */ /* anonymous ftp@zebra.desy.de */ +/* Burkhard Burow burow@desy.de 1990 - 1997. */ + +#ifndef __CFORTRAN_LOADED +#define __CFORTRAN_LOADED + +/* + THIS FILE IS PROPERTY OF BURKHARD BUROW. IF YOU ARE USING THIS FILE YOU + SHOULD ALSO HAVE ACCESS TO CFORTRAN.DOC WHICH PROVIDES TERMS FOR USING, + MODIFYING, COPYING AND DISTRIBUTING THE CFORTRAN.H PACKAGE. +*/ + +/******* + Modifications: + Oct 1997: Changed symbol name extname to appendus (PDW/HSTX) + (Conflicted with a common variable name in FTOOLS) + Nov 1997: If g77Fortran defined, also define f2cFortran (PDW/HSTX) + Nov 1997: Define MIN(A,B) as _cfMIN(A,B) + Feb 1998: Let VMS see the NUM_ELEMS code. Lets programs treat + single strings as vectors with single elements + *******/ +#define MIN(A,B) _cfMIN(A,B) + +/* + Avoid symbols already used by compilers and system *.h: + __ - OSF1 zukal06 V3.0 347 alpha, cc -c -std1 cfortest.c + + */ + + +/* First prepare for the C compiler. */ + +#ifndef ANSI_C_preprocessor /* i.e. user can override. */ +#ifdef __CF__KnR +#define ANSI_C_preprocessor 0 +#else +#ifdef __STDC__ +#define ANSI_C_preprocessor 1 +#else +#define _cfleft 1 +#define _cfright +#define _cfleft_cfright 0 +#define ANSI_C_preprocessor _cfleft/**/_cfright +#endif +#endif +#endif + +#if ANSI_C_preprocessor +#define _0(A,B) A##B +#define _(A,B) _0(A,B) /* see cat,xcat of K&R ANSI C p. 231 */ +#define _2(A,B) A##B /* K&R ANSI C p.230: .. identifier is not replaced */ +#define _3(A,B,C) _(A,_(B,C)) +#else /* if it turns up again during rescanning. */ +#define _(A,B) A/**/B +#define _2(A,B) A/**/B +#define _3(A,B,C) A/**/B/**/C +#endif + +#if (defined(vax)&&defined(unix)) || (defined(__vax__)&&defined(__unix__)) +#define VAXUltrix +#endif + +#include <stdio.h> /* NULL [in all machines stdio.h] */ +#include <string.h> /* strlen, memset, memcpy, memchr. */ +#if !( defined(VAXUltrix) || defined(sun) || (defined(apollo)&&!defined(__STDCPP__)) ) +#include <stdlib.h> /* malloc,free */ +#else +#include <malloc.h> /* Had to be removed for DomainOS h105 10.4 sys5.3 425t*/ +#ifdef apollo +#define __CF__APOLLO67 /* __STDCPP__ is in Apollo 6.8 (i.e. ANSI) and onwards */ +#endif +#endif + +#if !defined(__GNUC__) && !defined(__sun) && (defined(sun)||defined(VAXUltrix)||defined(lynx)) +#define __CF__KnR /* Sun, LynxOS and VAX Ultrix cc only supports K&R. */ + /* Manually define __CF__KnR for HP if desired/required.*/ +#endif /* i.e. We will generate Kernighan and Ritchie C. */ +/* Note that you may define __CF__KnR before #include cfortran.h, in order to +generate K&R C instead of the default ANSI C. The differences are mainly in the +function prototypes and declarations. All machines, except the Apollo, work +with either style. The Apollo's argument promotion rules require ANSI or use of +the obsolete std_$call which we have not implemented here. Hence on the Apollo, +only C calling FORTRAN subroutines will work using K&R style.*/ + + +/* Remainder of cfortran.h depends on the Fortran compiler. */ + +#if defined(CLIPPERFortran) || defined(g77Fortran) /* 11/3/97 PDW */ +#define f2cFortran +#endif + +/* VAX/VMS does not let us \-split long #if lines. */ +/* Split #if into 2 because some HP-UX can't handle long #if */ +#if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran)) +#if !(defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran)||defined(CONVEXFortran)||defined(PowerStationFortran)||defined(AbsoftUNIXFortran)||defined(SXFortran)) +/* If no Fortran compiler is given, we choose one for the machines we know. */ +#if defined(lynx) || defined(VAXUltrix) +#define f2cFortran /* Lynx: Only support f2c at the moment. + VAXUltrix: f77 behaves like f2c. + Support f2c or f77 with gcc, vcc with f2c. + f77 with vcc works, missing link magic for f77 I/O.*/ +#endif +#if defined(WIN32) || defined(macintosh) +#define f2cFortran +#endif +#if defined(__hpux) /* 921107: Use __hpux instead of __hp9000s300 */ +#define hpuxFortran /* Should also allow hp9000s7/800 use.*/ +#endif +#if defined(apollo) +#define apolloFortran /* __CF__APOLLO67 also defines some behavior. */ +#endif +#if defined(sun) || defined(__sun) +#define sunFortran +#endif +#if defined(_IBMR2) +#define IBMR2Fortran +#endif +#if defined(_CRAY) +#define CRAYFortran /* _CRAYT3E also defines some behavior. */ +#endif +#if defined(_SX) +#define SXFortran +#endif +#if defined(mips) || defined(__mips) +#define mipsFortran +#endif +#if defined(vms) || defined(__vms) +#define vmsFortran +#endif +#if defined(__alpha) && defined(__unix__) +#define DECFortran +#endif +#if defined(__convex__) +#define CONVEXFortran +#endif +#if defined(VISUAL_CPLUSPLUS) +#define PowerStationFortran +#endif +#endif /* ...Fortran */ +#endif /* ...Fortran */ + +/* Split #if into 2 because some HP-UX can't handle long #if */ +#if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran)) +#if !(defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran)||defined(CONVEXFortran)||defined(PowerStationFortran)||defined(AbsoftUNIXFortran)||defined(SXFortran)) +/* If your compiler barfs on ' #error', replace # with the trigraph for # */ + #error "cfortran.h: Can't find your environment among:\ + - MIPS cc and f77 2.0. (e.g. Silicon Graphics, DECstations, ...) \ + - IBM AIX XL C and FORTRAN Compiler/6000 Version 01.01.0000.0000 \ + - VAX VMS CC 3.1 and FORTRAN 5.4. \ + - Alpha VMS DEC C 1.3 and DEC FORTRAN 6.0. \ + - Alpha OSF DEC C and DEC Fortran for OSF/1 AXP Version 1.2 \ + - Apollo DomainOS 10.2 (sys5.3) with f77 10.7 and cc 6.7. \ + - CRAY \ + - NEC SX-4 SUPER-UX \ + - CONVEX \ + - Sun \ + - PowerStation Fortran with Visual C++ \ + - HP9000s300/s700/s800 Latest test with: HP-UX A.08.07 A 9000/730 \ + - LynxOS: cc or gcc with f2c. \ + - VAXUltrix: vcc,cc or gcc with f2c. gcc or cc with f77. \ + - f77 with vcc works; but missing link magic for f77 I/O. \ + - NO fort. None of gcc, cc or vcc generate required names.\ + - f2c : Use #define f2cFortran, or cc -Df2cFortran \ + - NAG f90: Use #define NAGf90Fortran, or cc -DNAGf90Fortran \ + - g77 v0.5.18 for linux \ + - Absoft UNIX F77: Use #define AbsoftUNIXFortran or cc -DAbsoftUNIXFortran" +/* Compiler must throw us out at this point! */ +#endif +#endif + + +#if defined(VAXC) && !defined(__VAXC) +#define OLD_VAXC +#pragma nostandard /* Prevent %CC-I-PARAMNOTUSED. */ +#endif + +/* Throughout cfortran.h we use: UN = Uppercase Name. LN = Lowercase Name. */ + +#if defined(f2cFortran) || defined(NAGf90Fortran) || defined(DECFortran) || defined(mipsFortran) || defined(apolloFortran) || defined(sunFortran) || defined(CONVEXFortran) || defined(SXFortran) || defined(appendus) /* 10/31/97 PDW */ +#define CFC_(UN,LN) _(LN,_) /* Lowercase FORTRAN symbols. */ +#define orig_fcallsc(UN,LN) CFC_(UN,LN) +#else +#if defined(CRAYFortran) || defined(PowerStationFortran) +#ifdef _CRAY /* (UN), not UN, circumvents CRAY preprocessor bug. */ +#define CFC_(UN,LN) (UN) /* Uppercase FORTRAN symbols. */ +#else /* At least VISUAL_CPLUSPLUS barfs on (UN), so need UN. */ +#define CFC_(UN,LN) UN /* Uppercase FORTRAN symbols. */ +#endif +#define orig_fcallsc(UN,LN) CFC_(UN,LN) /* CRAY insists on arg.'s here. */ +#else /* For following machines one may wish to change the fcallsc default. */ +#define CF_SAME_NAMESPACE +#ifdef vmsFortran +#define CFC_(UN,LN) LN /* Either case FORTRAN symbols. */ + /* BUT we usually use UN for C macro to FORTRAN routines, so use LN here,*/ + /* because VAX/VMS doesn't do recursive macros. */ +#define orig_fcallsc(UN,LN) UN +#else /* HP-UX without +ppu or IBMR2 without -qextname. NOT reccomended. */ +#define CFC_(UN,LN) LN /* Lowercase FORTRAN symbols. */ +#define orig_fcallsc(UN,LN) CFC_(UN,LN) +#endif /* vmsFortran */ +#endif /* CRAYFortran PowerStationFortran */ +#endif /* ....Fortran */ + +#define fcallsc(UN,LN) orig_fcallsc(UN,LN) +#define preface_fcallsc(P,p,UN,LN) CFC_(_(P,UN),_(p,LN)) +#define append_fcallsc(P,p,UN,LN) CFC_(_(UN,P),_(LN,p)) + +#define C_FUNCTION(UN,LN) fcallsc(UN,LN) +#define FORTRAN_FUNCTION(UN,LN) CFC_(UN,LN) + +#ifndef COMMON_BLOCK +#ifndef CONVEXFortran +#ifndef CLIPPERFortran +#ifndef AbsoftUNIXFortran +#define COMMON_BLOCK(UN,LN) CFC_(UN,LN) +#else +#define COMMON_BLOCK(UN,LN) _(_C,LN) +#endif +#else +#define COMMON_BLOCK(UN,LN) _(LN,__) +#endif +#else +#define COMMON_BLOCK(UN,LN) _3(_,LN,_) +#endif +#endif + +#ifndef DOUBLE_PRECISION +#if defined(CRAYFortran) && !defined(_CRAYT3E) +#define DOUBLE_PRECISION long double +#else +#define DOUBLE_PRECISION double +#endif +#endif + +#ifndef FORTRAN_REAL +#if defined(CRAYFortran) && defined(_CRAYT3E) +#define FORTRAN_REAL double +#else +#define FORTRAN_REAL float +#endif +#endif + +#ifdef CRAYFortran +#ifdef _CRAY +#include <fortran.h> +#else +#include "fortran.h" /* i.e. if crosscompiling assume user has file. */ +#endif +#define FLOATVVVVVVV_cfPP (FORTRAN_REAL *) /* Used for C calls FORTRAN. */ +/* CRAY's double==float but CRAY says pointers to doubles and floats are diff.*/ +#define VOIDP (void *) /* When FORTRAN calls C, we don't know if C routine + arg.'s have been declared float *, or double *. */ +#else +#define FLOATVVVVVVV_cfPP +#define VOIDP +#endif + +#ifdef vmsFortran +#if defined(vms) || defined(__vms) +#include <descrip.h> +#else +#include "descrip.h" /* i.e. if crosscompiling assume user has file. */ +#endif +#endif + +#ifdef sunFortran +#if defined(sun) || defined(__sun) +#include <math.h> /* Sun's FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT. */ +#else +#include "math.h" /* i.e. if crosscompiling assume user has file. */ +#endif +/* At least starting with the default C compiler SC3.0.1 of SunOS 5.3, + * FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT are not required and not in + * <math.h>, since sun C no longer promotes C float return values to doubles. + * Therefore, only use them if defined. + * Even if gcc is being used, assume that it exhibits the Sun C compiler + * behavior in order to be able to use *.o from the Sun C compiler. + * i.e. If FLOATFUNCTIONTYPE, etc. are in math.h, they required by gcc. + */ +#endif + +#ifndef apolloFortran +#define COMMON_BLOCK_DEF(DEFINITION, NAME) extern DEFINITION NAME +#define CF_NULL_PROTO +#else /* HP doesn't understand #elif. */ +/* Without ANSI prototyping, Apollo promotes float functions to double. */ +/* Note that VAX/VMS, IBM, Mips choke on 'type function(...);' prototypes. */ +#define CF_NULL_PROTO ... +#ifndef __CF__APOLLO67 +#define COMMON_BLOCK_DEF(DEFINITION, NAME) \ + DEFINITION NAME __attribute((__section(NAME))) +#else +#define COMMON_BLOCK_DEF(DEFINITION, NAME) \ + DEFINITION NAME #attribute[section(NAME)] +#endif +#endif + +#ifdef __cplusplus +#undef CF_NULL_PROTO +#define CF_NULL_PROTO ... +#endif + +#ifdef mipsFortran +#define CF_DECLARE_GETARG int f77argc; char **f77argv +#define CF_SET_GETARG(ARGC,ARGV) f77argc = ARGC; f77argv = ARGV +#else +#define CF_DECLARE_GETARG +#define CF_SET_GETARG(ARGC,ARGV) +#endif + +#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */ +#pragma standard +#endif + +#define ACOMMA , +#define ACOLON ; + +/*-------------------------------------------------------------------------*/ + +/* UTILITIES USED WITHIN CFORTRAN.H */ + +#define _cfMIN(A,B) (A<B?A:B) +#ifndef FALSE +#define FALSE (1==0) +#endif + +/* 970211 - XIX.145: + firstindexlength - better name is all_but_last_index_lengths + secondindexlength - better name is last_index_length + */ +#define firstindexlength(A) (sizeof(A[0])==1 ? 1 : (sizeof(A) / sizeof(A[0])) ) +#define secondindexlength(A) (sizeof(A[0])==1 ? sizeof(A) : sizeof(A[0]) ) + +/* Behavior of FORTRAN LOGICAL. All machines' LOGICAL is same size as C's int. +Conversion is automatic except for arrays which require F2CLOGICALV/C2FLOGICALV. +f2c, MIPS f77 [DECstation, SGI], VAX Ultrix f77, +HP-UX f77 : as in C. +VAX/VMS FORTRAN, VAX Ultrix fort, +Absoft Unix Fortran, IBM RS/6000 xlf : LS Bit = 0/1 = TRUE/FALSE. +Apollo : neg. = TRUE, else FALSE. +[Apollo accepts -1 as TRUE for function values, but NOT all other neg. values.] +[DECFortran for Ultrix RISC is also called f77 but is the same as VAX/VMS.] +[MIPS f77 treats .eqv./.neqv. as .eq./.ne. and hence requires LOGICAL_STRICT.]*/ + +#if defined(NAGf90Fortran) || defined(f2cFortran) || defined(mipsFortran) || defined(PowerStationFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) || defined(SXFortran) +/* SX/PowerStationFortran have 0 and 1 defined, others are neither T nor F. */ +/* hpuxFortran800 has 0 and 0x01000000 defined. Others are unknown. */ +#define LOGICAL_STRICT /* Other Fortran have .eqv./.neqv. == .eq./.ne. */ +#endif + +#define C2FLOGICALV(A,I) \ + do {int __i; for(__i=0;__i<I;__i++) A[__i]=C2FLOGICAL(A[__i]); } while (FALSE) +#define F2CLOGICALV(A,I) \ + do {int __i; for(__i=0;__i<I;__i++) A[__i]=F2CLOGICAL(A[__i]); } while (FALSE) + +#if defined(apolloFortran) +#define C2FLOGICAL(L) ((L)?-1:(L)&~((unsigned)1<<sizeof(int)*8-1)) +#define F2CLOGICAL(L) ((L)<0?(L):0) +#else +#if defined(CRAYFortran) +#define C2FLOGICAL(L) _btol(L) +#define F2CLOGICAL(L) _ltob(&(L)) /* Strangely _ltob() expects a pointer. */ +#else +#if defined(IBMR2Fortran) || defined(vmsFortran) || defined(DECFortran) || defined(AbsoftUNIXFortran) +#define C2FLOGICAL(L) ((L)?(L)|1:(L)&~(int)1) +#define F2CLOGICAL(L) ((L)&1?(L):0) +#else +#if defined(CONVEXFortran) +#define C2FLOGICAL(L) ((L) ? ~0 : 0 ) +#define F2CLOGICAL(L) (L) +#else /* others evaluate LOGICALs as for C. */ +#define C2FLOGICAL(L) (L) +#define F2CLOGICAL(L) (L) +#ifndef LOGICAL_STRICT +#undef C2FLOGICALV +#undef F2CLOGICALV +#define C2FLOGICALV(A,I) +#define F2CLOGICALV(A,I) +#endif /* LOGICAL_STRICT */ +#endif /* CONVEXFortran || All Others */ +#endif /* IBMR2Fortran vmsFortran DECFortran AbsoftUNIXFortran */ +#endif /* CRAYFortran */ +#endif /* apolloFortran */ + +/* 970514 - In addition to CRAY, there may be other machines + for which LOGICAL_STRICT makes no sense. */ +#if defined(LOGICAL_STRICT) && !defined(CRAYFortran) +/* Force C2FLOGICAL to generate only the values for either .TRUE. or .FALSE. + SX/PowerStationFortran only have 0 and 1 defined. + Elsewhere, only needed if you want to do: + logical lvariable + if (lvariable .eq. .true.) then ! (1) + instead of + if (lvariable .eqv. .true.) then ! (2) + - (1) may not even be FORTRAN/77 and that Apollo's f77 and IBM's xlf + refuse to compile (1), so you are probably well advised to stay away from + (1) and from LOGICAL_STRICT. + - You pay a (slight) performance penalty for using LOGICAL_STRICT. */ +#undef C2FLOGICAL +#ifdef hpuxFortran800 +#define C2FLOGICAL(L) ((L)?0x01000000:0) +#else +#if defined(apolloFortran) || defined(vmsFortran) || defined(DECFortran) +#define C2FLOGICAL(L) ((L)?-1:0) /* These machines use -1/0 for .true./.false.*/ +#else +#define C2FLOGICAL(L) ((L)? 1:0) /* All others use +1/0 for .true./.false.*/ +#endif +#endif +#endif /* LOGICAL_STRICT */ + +/* Convert a vector of C strings into FORTRAN strings. */ +#ifndef __CF__KnR +static char *c2fstrv(char* cstr, char *fstr, int elem_len, int sizeofcstr) +#else +static char *c2fstrv( cstr, fstr, elem_len, sizeofcstr) + char* cstr; char *fstr; int elem_len; int sizeofcstr; +#endif +{ int i,j; +/* elem_len includes \0 for C strings. Fortran strings don't have term. \0. + Useful size of string must be the same in both languages. */ +for (i=0; i<sizeofcstr/elem_len; i++) { + for (j=1; j<elem_len && *cstr; j++) *fstr++ = *cstr++; + cstr += 1+elem_len-j; + for (; j<elem_len; j++) *fstr++ = ' '; +} /* 95109 - Seems to be returning the original fstr. */ +return fstr-sizeofcstr+sizeofcstr/elem_len; } + +/* Convert a vector of FORTRAN strings into C strings. */ +#ifndef __CF__KnR +static char *f2cstrv(char *fstr, char* cstr, int elem_len, int sizeofcstr) +#else +static char *f2cstrv( fstr, cstr, elem_len, sizeofcstr) + char *fstr; char* cstr; int elem_len; int sizeofcstr; +#endif +{ int i,j; +/* elem_len includes \0 for C strings. Fortran strings don't have term. \0. + Useful size of string must be the same in both languages. */ +cstr += sizeofcstr; +fstr += sizeofcstr - sizeofcstr/elem_len; +for (i=0; i<sizeofcstr/elem_len; i++) { + *--cstr = '\0'; + for (j=1; j<elem_len; j++) *--cstr = *--fstr; +} return cstr; } + +/* kill the trailing char t's in string s. */ +#ifndef __CF__KnR +static char *kill_trailing(char *s, char t) +#else +static char *kill_trailing( s, t) char *s; char t; +#endif +{char *e; +e = s + strlen(s); +if (e>s) { /* Need this to handle NULL string.*/ + while (e>s && *--e==t); /* Don't follow t's past beginning. */ + e[*e==t?0:1] = '\0'; /* Handle s[0]=t correctly. */ +} return s; } + +/* kill_trailingn(s,t,e) will kill the trailing t's in string s. e normally +points to the terminating '\0' of s, but may actually point to anywhere in s. +s's new '\0' will be placed at e or earlier in order to remove any trailing t's. +If e<s string s is left unchanged. */ +#ifndef __CF__KnR +static char *kill_trailingn(char *s, char t, char *e) +#else +static char *kill_trailingn( s, t, e) char *s; char t; char *e; +#endif +{ +if (e==s) *e = '\0'; /* Kill the string makes sense here.*/ +else if (e>s) { /* Watch out for neg. length string.*/ + while (e>s && *--e==t); /* Don't follow t's past beginning. */ + e[*e==t?0:1] = '\0'; /* Handle s[0]=t correctly. */ +} return s; } + +/* Note the following assumes that any element which has t's to be chopped off, +does indeed fill the entire element. */ +#ifndef __CF__KnR +static char *vkill_trailing(char* cstr, int elem_len, int sizeofcstr, char t) +#else +static char *vkill_trailing( cstr, elem_len, sizeofcstr, t) + char* cstr; int elem_len; int sizeofcstr; char t; +#endif +{ int i; +for (i=0; i<sizeofcstr/elem_len; i++) /* elem_len includes \0 for C strings. */ + kill_trailingn(cstr+elem_len*i,t,cstr+elem_len*(i+1)-1); +return cstr; } + +#ifdef vmsFortran +typedef struct dsc$descriptor_s fstring; +#define DSC$DESCRIPTOR_A(DIMCT) \ +struct { \ + unsigned short dsc$w_length; unsigned char dsc$b_dtype; \ + unsigned char dsc$b_class; char *dsc$a_pointer; \ + char dsc$b_scale; unsigned char dsc$b_digits; \ + struct { \ + unsigned : 3; unsigned dsc$v_fl_binscale : 1; \ + unsigned dsc$v_fl_redim : 1; unsigned dsc$v_fl_column : 1; \ + unsigned dsc$v_fl_coeff : 1; unsigned dsc$v_fl_bounds : 1; \ + } dsc$b_aflags; \ + unsigned char dsc$b_dimct; unsigned long dsc$l_arsize; \ + char *dsc$a_a0; long dsc$l_m [DIMCT]; \ + struct { \ + long dsc$l_l; long dsc$l_u; \ + } dsc$bounds [DIMCT]; \ +} + +typedef DSC$DESCRIPTOR_A(1) fstringvector; +/*typedef DSC$DESCRIPTOR_A(2) fstringarrarr; + typedef DSC$DESCRIPTOR_A(3) fstringarrarrarr;*/ +#define initfstr(F,C,ELEMNO,ELEMLEN) \ +( (F).dsc$l_arsize= ( (F).dsc$w_length =(ELEMLEN) ) \ + *( (F).dsc$l_m[0]=(F).dsc$bounds[0].dsc$l_u=(ELEMNO) ), \ + (F).dsc$a_a0 = ( (F).dsc$a_pointer=(C) ) - (F).dsc$w_length ,(F)) + +#endif /* PDW: 2/10/98 -- Let VMS see NUM_ELEMS definitions */ +#define _NUM_ELEMS -1 +#define _NUM_ELEM_ARG -2 +#define NUM_ELEMS(A) A,_NUM_ELEMS +#define NUM_ELEM_ARG(B) *_2(A,B),_NUM_ELEM_ARG +#define TERM_CHARS(A,B) A,B +#ifndef __CF__KnR +static int num_elem(char *strv, unsigned elem_len, int term_char, int num_term) +#else +static int num_elem( strv, elem_len, term_char, num_term) + char *strv; unsigned elem_len; int term_char; int num_term; +#endif +/* elem_len is the number of characters in each element of strv, the FORTRAN +vector of strings. The last element of the vector must begin with at least +num_term term_char characters, so that this routine can determine how +many elements are in the vector. */ +{ +unsigned num,i; +if (num_term == _NUM_ELEMS || num_term == _NUM_ELEM_ARG) + return term_char; +if (num_term <=0) num_term = (int)elem_len; +for (num=0; ; num++) { + for (i=0; i<(unsigned)num_term && *strv==term_char; i++,strv++); + if (i==(unsigned)num_term) break; + else strv += elem_len-i; +} +return (int)num; +} + +/*-------------------------------------------------------------------------*/ + +/* UTILITIES FOR C TO USE STRINGS IN FORTRAN COMMON BLOCKS */ + +/* C string TO Fortran Common Block STRing. */ +/* DIM is the number of DIMensions of the array in terms of strings, not + characters. e.g. char a[12] has DIM = 0, char a[12][4] has DIM = 1, etc. */ +#define C2FCBSTR(CSTR,FSTR,DIM) \ + c2fstrv((char *)CSTR, (char *)FSTR, sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \ + sizeof(FSTR)+cfelementsof(FSTR,DIM)) + +/* Fortran Common Block string TO C STRing. */ +#define FCB2CSTR(FSTR,CSTR,DIM) \ + vkill_trailing(f2cstrv((char *)FSTR, (char *)CSTR, \ + sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \ + sizeof(FSTR)+cfelementsof(FSTR,DIM)), \ + sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \ + sizeof(FSTR)+cfelementsof(FSTR,DIM), ' ') + +#define cfDEREFERENCE0 +#define cfDEREFERENCE1 * +#define cfDEREFERENCE2 ** +#define cfDEREFERENCE3 *** +#define cfDEREFERENCE4 **** +#define cfDEREFERENCE5 ***** +#define cfelementsof(A,D) (sizeof(A)/sizeof(_(cfDEREFERENCE,D)(A))) + +/*-------------------------------------------------------------------------*/ + +/* UTILITIES FOR C TO CALL FORTRAN SUBROUTINES */ + +/* Define lookup tables for how to handle the various types of variables. */ + +#ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */ +#pragma nostandard +#endif + +#define ZTRINGV_NUM(I) I +#define ZTRINGV_ARGFP(I) (*(_2(A,I))) /* Undocumented. For PINT, etc. */ +#define ZTRINGV_ARGF(I) _2(A,I) +#ifdef CFSUBASFUN +#define ZTRINGV_ARGS(I) ZTRINGV_ARGF(I) +#else +#define ZTRINGV_ARGS(I) _2(B,I) +#endif + +#define PBYTE_cfVP(A,B) PINT_cfVP(A,B) +#define PDOUBLE_cfVP(A,B) +#define PFLOAT_cfVP(A,B) +#ifdef ZTRINGV_ARGS_allows_Pvariables +/* This allows Pvariables for ARGS. ARGF machinery is above ARGFP. + * B is not needed because the variable may be changed by the Fortran routine, + * but because B is the only way to access an arbitrary macro argument. */ +#define PINT_cfVP(A,B) int B = (int)A; /* For ZSTRINGV_ARGS */ +#else +#define PINT_cfVP(A,B) +#endif +#define PLOGICAL_cfVP(A,B) int *B; /* Returning LOGICAL in FUNn and SUBn */ +#define PLONG_cfVP(A,B) PINT_cfVP(A,B) +#define PSHORT_cfVP(A,B) PINT_cfVP(A,B) + +#define VCF_INT_S(T,A,B) _(T,VVVVVVV_cfTYPE) B = A; +#define VCF_INT_F(T,A,B) _(T,_cfVCF)(A,B) +/* _cfVCF table is directly mapped to _cfCCC table. */ +#define BYTE_cfVCF(A,B) +#define DOUBLE_cfVCF(A,B) +#if !defined(__CF__KnR) +#define FLOAT_cfVCF(A,B) +#else +#define FLOAT_cfVCF(A,B) FORTRAN_REAL B = A; +#endif +#define INT_cfVCF(A,B) +#define LOGICAL_cfVCF(A,B) +#define LONG_cfVCF(A,B) +#define SHORT_cfVCF(A,B) + +#define VCF(TN,I) _Icf4(4,V,TN,_(A,I),_(B,I),F) +#define VVCF(TN,AI,BI) _Icf4(4,V,TN,AI,BI,S) +#define INT_cfV(T,A,B,F) _(VCF_INT_,F)(T,A,B) +#define INTV_cfV(T,A,B,F) +#define INTVV_cfV(T,A,B,F) +#define INTVVV_cfV(T,A,B,F) +#define INTVVVV_cfV(T,A,B,F) +#define INTVVVVV_cfV(T,A,B,F) +#define INTVVVVVV_cfV(T,A,B,F) +#define INTVVVVVVV_cfV(T,A,B,F) +#define PINT_cfV( T,A,B,F) _(T,_cfVP)(A,B) +#define PVOID_cfV( T,A,B,F) +#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) +#define ROUTINE_cfV(T,A,B,F) void (*B)(CF_NULL_PROTO) = (void (*)(CF_NULL_PROTO))A; +#else +#define ROUTINE_cfV(T,A,B,F) +#endif +#define SIMPLE_cfV(T,A,B,F) +#ifdef vmsFortran +#define STRING_cfV(T,A,B,F) static struct {fstring f; unsigned clen;} B = \ + {{0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL},0}; +#define PSTRING_cfV(T,A,B,F) static fstring B={0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL}; +#define STRINGV_cfV(T,A,B,F) static fstringvector B = \ + {sizeof(A),DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,1,1,1},1,0,NULL,0,{1,0}}; +#define PSTRINGV_cfV(T,A,B,F) static fstringvector B = \ + {0,DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,1,1,1},1,0,NULL,0,{1,0}}; +#else +#define STRING_cfV(T,A,B,F) struct {unsigned int clen, flen;} B; +#define STRINGV_cfV(T,A,B,F) struct {char *s, *fs; unsigned flen;} B; +#define PSTRING_cfV(T,A,B,F) int B; +#define PSTRINGV_cfV(T,A,B,F) struct{char *fs; unsigned int sizeofA,flen;}B; +#endif +#define ZTRINGV_cfV(T,A,B,F) STRINGV_cfV(T,A,B,F) +#define PZTRINGV_cfV(T,A,B,F) PSTRINGV_cfV(T,A,B,F) + +/* Note that the actions of the A table were performed inside the AA table. + VAX Ultrix vcc, and HP-UX cc, didn't evaluate arguments to functions left to + right, so we had to split the original table into the current robust two. */ +#define ACF(NAME,TN,AI,I) _(TN,_cfSTR)(4,A,NAME,I,AI,_(B,I),0) +#define DEFAULT_cfA(M,I,A,B) +#define LOGICAL_cfA(M,I,A,B) B=C2FLOGICAL(B); +#define PLOGICAL_cfA(M,I,A,B) A=C2FLOGICAL(A); +#define STRING_cfA(M,I,A,B) STRING_cfC(M,I,A,B,sizeof(A)) +#define PSTRING_cfA(M,I,A,B) PSTRING_cfC(M,I,A,B,sizeof(A)) +#ifdef vmsFortran +#define AATRINGV_cfA( A,B, sA,filA,silA) \ + initfstr(B,(char *)malloc((sA)-(filA)),(filA),(silA)-1), \ + c2fstrv(A,B.dsc$a_pointer,(silA),(sA)); +#define APATRINGV_cfA( A,B, sA,filA,silA) \ + initfstr(B,A,(filA),(silA)-1),c2fstrv(A,A,(silA),(sA)); +#else +#define AATRINGV_cfA( A,B, sA,filA,silA) \ + (B.s=(char *)malloc((sA)-(filA)),B.fs=c2fstrv(A,B.s,(B.flen=(silA)-1)+1,(sA))); +#define APATRINGV_cfA( A,B, sA,filA,silA) \ + B.fs=c2fstrv(A,A,(B.flen=(silA)-1)+1,B.sizeofA=(sA)); +#endif +#define STRINGV_cfA(M,I,A,B) \ + AATRINGV_cfA((char *)A,B,sizeof(A),firstindexlength(A),secondindexlength(A)) +#define PSTRINGV_cfA(M,I,A,B) \ + APATRINGV_cfA((char *)A,B,sizeof(A),firstindexlength(A),secondindexlength(A)) +#define ZTRINGV_cfA(M,I,A,B) AATRINGV_cfA( (char *)A,B, \ + (_3(M,_ELEMS_,I))*(( _3(M,_ELEMLEN_,I))+1), \ + (_3(M,_ELEMS_,I)),(_3(M,_ELEMLEN_,I))+1) +#define PZTRINGV_cfA(M,I,A,B) APATRINGV_cfA( (char *)A,B, \ + (_3(M,_ELEMS_,I))*(( _3(M,_ELEMLEN_,I))+1), \ + (_3(M,_ELEMS_,I)),(_3(M,_ELEMLEN_,I))+1) + +#define PBYTE_cfAAP(A,B) &A +#define PDOUBLE_cfAAP(A,B) &A +#define PFLOAT_cfAAP(A,B) FLOATVVVVVVV_cfPP &A +#define PINT_cfAAP(A,B) &A +#define PLOGICAL_cfAAP(A,B) B= &A /* B used to keep a common W table. */ +#define PLONG_cfAAP(A,B) &A +#define PSHORT_cfAAP(A,B) &A + +#define AACF(TN,AI,I,C) _SEP_(TN,C,COMMA) _Icf(3,AA,TN,AI,_(B,I)) +#define INT_cfAA(T,A,B) &B +#define INTV_cfAA(T,A,B) _(T,VVVVVV_cfPP) A +#define INTVV_cfAA(T,A,B) _(T,VVVVV_cfPP) A[0] +#define INTVVV_cfAA(T,A,B) _(T,VVVV_cfPP) A[0][0] +#define INTVVVV_cfAA(T,A,B) _(T,VVV_cfPP) A[0][0][0] +#define INTVVVVV_cfAA(T,A,B) _(T,VV_cfPP) A[0][0][0][0] +#define INTVVVVVV_cfAA(T,A,B) _(T,V_cfPP) A[0][0][0][0][0] +#define INTVVVVVVV_cfAA(T,A,B) _(T,_cfPP) A[0][0][0][0][0][0] +#define PINT_cfAA(T,A,B) _(T,_cfAAP)(A,B) +#define PVOID_cfAA(T,A,B) (void *) A +#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) +#define ROUTINE_cfAA(T,A,B) &B +#else +#define ROUTINE_cfAA(T,A,B) (void(*)(CF_NULL_PROTO))A +#endif +#define STRING_cfAA(T,A,B) STRING_cfCC(T,A,B) +#define PSTRING_cfAA(T,A,B) PSTRING_cfCC(T,A,B) +#ifdef vmsFortran +#define STRINGV_cfAA(T,A,B) &B +#else +#ifdef CRAYFortran +#define STRINGV_cfAA(T,A,B) _cptofcd(B.fs,B.flen) +#else +#define STRINGV_cfAA(T,A,B) B.fs +#endif +#endif +#define PSTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B) +#define ZTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B) +#define PZTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B) + +#if defined(vmsFortran) || defined(CRAYFortran) +#define JCF(TN,I) +#define KCF(TN,I) +#else +#define JCF(TN,I) _(TN,_cfSTR)(1,J,_(B,I), 0,0,0,0) +#if defined(AbsoftUNIXFortran) +#define DEFAULT_cfJ(B) ,0 +#else +#define DEFAULT_cfJ(B) +#endif +#define LOGICAL_cfJ(B) DEFAULT_cfJ(B) +#define PLOGICAL_cfJ(B) DEFAULT_cfJ(B) +#define STRING_cfJ(B) ,B.flen +#define PSTRING_cfJ(B) ,B +#define STRINGV_cfJ(B) STRING_cfJ(B) +#define PSTRINGV_cfJ(B) STRING_cfJ(B) +#define ZTRINGV_cfJ(B) STRING_cfJ(B) +#define PZTRINGV_cfJ(B) STRING_cfJ(B) + +/* KCF is identical to DCF, except that KCF ZTRING is not empty. */ +#define KCF(TN,I) _(TN,_cfSTR)(1,KK,_(B,I), 0,0,0,0) +#if defined(AbsoftUNIXFortran) +#define DEFAULT_cfKK(B) , unsigned B +#else +#define DEFAULT_cfKK(B) +#endif +#define LOGICAL_cfKK(B) DEFAULT_cfKK(B) +#define PLOGICAL_cfKK(B) DEFAULT_cfKK(B) +#define STRING_cfKK(B) , unsigned B +#define PSTRING_cfKK(B) STRING_cfKK(B) +#define STRINGV_cfKK(B) STRING_cfKK(B) +#define PSTRINGV_cfKK(B) STRING_cfKK(B) +#define ZTRINGV_cfKK(B) STRING_cfKK(B) +#define PZTRINGV_cfKK(B) STRING_cfKK(B) +#endif + +#define WCF(TN,AN,I) _(TN,_cfSTR)(2,W,AN,_(B,I), 0,0,0) +#define DEFAULT_cfW(A,B) +#define LOGICAL_cfW(A,B) +#define PLOGICAL_cfW(A,B) *B=F2CLOGICAL(*B); +#define STRING_cfW(A,B) (A[B.clen]!='\0'?A[B.clen]='\0':0); /* A?="constnt"*/ +#define PSTRING_cfW(A,B) kill_trailing(A,' '); +#ifdef vmsFortran +#define STRINGV_cfW(A,B) free(B.dsc$a_pointer); +#define PSTRINGV_cfW(A,B) \ + vkill_trailing(f2cstrv((char*)A, (char*)A, \ + B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0]), \ + B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0], ' '); +#else +#define STRINGV_cfW(A,B) free(B.s); +#define PSTRINGV_cfW(A,B) vkill_trailing( \ + f2cstrv((char*)A,(char*)A,B.flen+1,B.sizeofA), B.flen+1,B.sizeofA,' '); +#endif +#define ZTRINGV_cfW(A,B) STRINGV_cfW(A,B) +#define PZTRINGV_cfW(A,B) PSTRINGV_cfW(A,B) + +#define NCF(TN,I,C) _SEP_(TN,C,COMMA) _Icf(2,N,TN,_(A,I),0) +#define NNCF(TN,I,C) UUCF(TN,I,C) +#define NNNCF(TN,I,C) _SEP_(TN,C,COLON) _Icf(2,N,TN,_(A,I),0) +#define INT_cfN(T,A) _(T,VVVVVVV_cfTYPE) * A +#define INTV_cfN(T,A) _(T,VVVVVV_cfTYPE) * A +#define INTVV_cfN(T,A) _(T,VVVVV_cfTYPE) * A +#define INTVVV_cfN(T,A) _(T,VVVV_cfTYPE) * A +#define INTVVVV_cfN(T,A) _(T,VVV_cfTYPE) * A +#define INTVVVVV_cfN(T,A) _(T,VV_cfTYPE) * A +#define INTVVVVVV_cfN(T,A) _(T,V_cfTYPE) * A +#define INTVVVVVVV_cfN(T,A) _(T,_cfTYPE) * A +#define PINT_cfN(T,A) _(T,_cfTYPE) * A +#define PVOID_cfN(T,A) void * A +#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) +#define ROUTINE_cfN(T,A) void (**A)(CF_NULL_PROTO) +#else +#define ROUTINE_cfN(T,A) void ( *A)(CF_NULL_PROTO) +#endif +#ifdef vmsFortran +#define STRING_cfN(T,A) fstring * A +#define STRINGV_cfN(T,A) fstringvector * A +#else +#ifdef CRAYFortran +#define STRING_cfN(T,A) _fcd A +#define STRINGV_cfN(T,A) _fcd A +#else +#define STRING_cfN(T,A) char * A +#define STRINGV_cfN(T,A) char * A +#endif +#endif +#define PSTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */ +#define PNSTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */ +#define PPSTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */ +#define PSTRINGV_cfN(T,A) STRINGV_cfN(T,A) +#define ZTRINGV_cfN(T,A) STRINGV_cfN(T,A) +#define PZTRINGV_cfN(T,A) PSTRINGV_cfN(T,A) + + +/* Apollo 6.7, CRAY, old Sun, VAX/Ultrix vcc/cc and new ultrix + can't hack more than 31 arg's. + e.g. ultrix >= 4.3 gives message: + zow35> cc -c -DDECFortran cfortest.c + cfe: Fatal: Out of memory: cfortest.c + zow35> + Old __hpux had the problem, but new 'HP-UX A.09.03 A 9000/735' is fine + if using -Aa, otherwise we have a problem. + */ +#ifndef MAX_PREPRO_ARGS +#if !defined(__GNUC__) && (defined(VAXUltrix) || defined(__CF__APOLLO67) || (defined(sun)&&!defined(__sun)) || defined(_CRAY) || defined(__ultrix__) || (defined(__hpux)&&defined(__CF__KnR))) +#define MAX_PREPRO_ARGS 31 +#else +#define MAX_PREPRO_ARGS 99 +#endif +#endif + +#if defined(AbsoftUNIXFortran) +/* In addition to explicit Absoft stuff, only Absoft requires: + - DEFAULT coming from _cfSTR. + DEFAULT could have been called e.g. INT, but keep it for clarity. + - M term in CFARGT14 and CFARGT14FS. + */ +#define ABSOFT_cf1(T0) _(T0,_cfSTR)(0,ABSOFT1,0,0,0,0,0) +#define ABSOFT_cf2(T0) _(T0,_cfSTR)(0,ABSOFT2,0,0,0,0,0) +#define ABSOFT_cf3(T0) _(T0,_cfSTR)(0,ABSOFT3,0,0,0,0,0) +#define DEFAULT_cfABSOFT1 +#define LOGICAL_cfABSOFT1 +#define STRING_cfABSOFT1 ,MAX_LEN_FORTRAN_FUNCTION_STRING +#define DEFAULT_cfABSOFT2 +#define LOGICAL_cfABSOFT2 +#define STRING_cfABSOFT2 ,unsigned D0 +#define DEFAULT_cfABSOFT3 +#define LOGICAL_cfABSOFT3 +#define STRING_cfABSOFT3 ,D0 +#else +#define ABSOFT_cf1(T0) +#define ABSOFT_cf2(T0) +#define ABSOFT_cf3(T0) +#endif + +/* _Z introduced to cicumvent IBM and HP silly preprocessor warning. + e.g. "Macro CFARGT14 invoked with a null argument." + */ +#define _Z + +#define CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \ + S(T8,8) S(T9,9) S(TA,A) S(TB,B) S(TC,C) S(TD,D) S(TE,E) +#define CFARGT14FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + 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) \ + 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) \ + M CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) + +#if !(defined(PowerStationFortran)||defined(hpuxFortran800)) +/* Old CFARGT14 -> CFARGT14FS as seen below, for Absoft cross-compile yields: + SunOS> cc -c -Xa -DAbsoftUNIXFortran c.c + "c.c", line 406: warning: argument mismatch + Haven't checked if this is ANSI C or a SunOS bug. SunOS -Xs works ok. + Behavior is most clearly seen in example: + #define A 1 , 2 + #define C(X,Y,Z) x=X. y=Y. z=Z. + #define D(X,Y,Z) C(X,Y,Z) + D(x,A,z) + Output from preprocessor is: x = x . y = 1 . z = 2 . + #define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + CFARGT14FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +*/ +#define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + 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) \ + 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) \ + M CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +/* F changed to Z for arg 15. Watch out if ever extend to S or Z arguments. */ +#define CFARGT20(Z,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + 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) \ + 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) \ + Z(TF,F,1) Z(TG,G,1) Z(TH,H,1) Z(TI,I,1) Z(TJ,J,1) Z(TK,K,1) \ + S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \ + S(T8,8) S(T9,9) S(TA,A) S(TB,B) S(TC,C) S(TD,D) S(TE,E) \ + S(TF,F) S(TG,G) S(TH,H) S(TI,I) S(TJ,J) S(TK,K) +#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) \ + 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) \ + 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) \ + F(TD,AD,D,1) F(TE,AE,E,1) S(T1,1) S(T2,2) S(T3,3) S(T4,4) \ + S(T5,5) S(T6,6) S(T7,7) S(T8,8) S(T9,9) S(TA,A) \ + S(TB,B) S(TC,C) S(TD,D) S(TE,E) +#if MAX_PREPRO_ARGS>31 +/* F changed to Z for arg 15. Watch out if ever extend to S or Z arguments. */ +#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) \ + 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) \ + 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) \ + 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) \ + Z(TJ,AJ,J,1) Z(TK,AK,K,1) S(T1,1) S(T2,2) S(T3,3) S(T4,4) \ + S(T5,5) S(T6,6) S(T7,7) S(T8,8) S(T9,9) S(TA,A) \ + S(TB,B) S(TC,C) S(TD,D) S(TE,E) S(TF,F) S(TG,G) \ + S(TH,H) S(TI,I) S(TJ,J) S(TK,K) +#endif +#else +#define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + 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) \ + 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) \ + 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) \ + F(TD,D,1) S(TD,D) F(TE,E,1) S(TE,E) +/* F changed to Z for arg 15. Watch out if ever extend to S or Z arguments. */ +#define CFARGT20(Z,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + 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) \ + 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) \ + 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) \ + 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) \ + 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) +#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) \ + F(T1,A1,1,0) S(T1,1) F(T2,A2,2,1) S(T2,2) F(T3,A3,3,1) S(T3,3) \ + F(T4,A4,4,1) S(T4,4) F(T5,A5,5,1) S(T5,5) F(T6,A6,6,1) S(T6,6) \ + F(T7,A7,7,1) S(T7,7) F(T8,A8,8,1) S(T8,8) F(T9,A9,9,1) S(T9,9) \ + F(TA,AA,A,1) S(TA,A) F(TB,AB,B,1) S(TB,B) F(TC,AC,C,1) S(TC,C) \ + F(TD,AD,D,1) S(TD,D) F(TE,AE,E,1) S(TE,E) +#if MAX_PREPRO_ARGS>31 +/* F changed to Z for arg 15. Watch out if ever extend to S or Z arguments. */ +#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) \ + Z(T1,A1,1,0) S(T1,1) Z(T2,A2,2,1) S(T2,2) Z(T3,A3,3,1) S(T3,3) \ + Z(T4,A4,4,1) S(T4,4) Z(T5,A5,5,1) S(T5,5) Z(T6,A6,6,1) S(T6,6) \ + Z(T7,A7,7,1) S(T7,7) Z(T8,A8,8,1) S(T8,8) Z(T9,A9,9,1) S(T9,9) \ + Z(TA,AA,A,1) S(TA,A) Z(TB,AB,B,1) S(TB,B) Z(TC,AC,C,1) S(TC,C) \ + Z(TD,AD,D,1) S(TD,D) Z(TE,AE,E,1) S(TE,E) Z(TF,AF,F,1) S(TF,F) \ + Z(TG,AG,G,1) S(TG,G) Z(TH,AH,H,1) S(TH,H) Z(TI,AI,I,1) S(TI,I) \ + Z(TJ,AJ,J,1) S(TJ,J) Z(TK,AK,K,1) S(TK,K) +#endif +#endif + + +#define PROTOCCALLSFSUB1( UN,LN,T1) \ + 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) +#define PROTOCCALLSFSUB2( UN,LN,T1,T2) \ + 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) +#define PROTOCCALLSFSUB3( UN,LN,T1,T2,T3) \ + 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) +#define PROTOCCALLSFSUB4( UN,LN,T1,T2,T3,T4) \ + 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) +#define PROTOCCALLSFSUB5( UN,LN,T1,T2,T3,T4,T5) \ + 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) +#define PROTOCCALLSFSUB6( UN,LN,T1,T2,T3,T4,T5,T6) \ + 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) +#define PROTOCCALLSFSUB7( UN,LN,T1,T2,T3,T4,T5,T6,T7) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0) +#define PROTOCCALLSFSUB13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0) + + +#define PROTOCCALLSFSUB15(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \ + 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) +#define PROTOCCALLSFSUB16(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \ + 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) +#define PROTOCCALLSFSUB17(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \ + 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) +#define PROTOCCALLSFSUB18(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \ + 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) +#define PROTOCCALLSFSUB19(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \ + PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0) + + +#ifndef FCALLSC_QUALIFIER +#ifdef VISUAL_CPLUSPLUS +#define FCALLSC_QUALIFIER __stdcall +#else +#define FCALLSC_QUALIFIER +#endif +#endif + +#ifdef __cplusplus +#define CFextern extern "C" +#else +#define CFextern extern +#endif + + +#ifdef CFSUBASFUN +#define PROTOCCALLSFSUB0(UN,LN) \ + PROTOCCALLSFFUN0( VOID,UN,LN) +#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + PROTOCCALLSFFUN14(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)\ + PROTOCCALLSFFUN20(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) +#else +/* Note: Prevent compiler warnings, null #define PROTOCCALLSFSUB14/20 after + #include-ing cfortran.h if calling the FORTRAN wrapper within the same + source code where the wrapper is created. */ +#define PROTOCCALLSFSUB0(UN,LN) CFextern void FCALLSC_QUALIFIER CFC_(UN,LN)(); +#ifndef __CF__KnR +#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + 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) ); +#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)\ + 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) ); +#else +#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + PROTOCCALLSFSUB0(UN,LN) +#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + PROTOCCALLSFSUB0(UN,LN) +#endif +#endif + + +#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */ +#pragma standard +#endif + + +#define CCALLSFSUB1( UN,LN,T1, A1) \ + CCALLSFSUB5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0) +#define CCALLSFSUB2( UN,LN,T1,T2, A1,A2) \ + CCALLSFSUB5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0) +#define CCALLSFSUB3( UN,LN,T1,T2,T3, A1,A2,A3) \ + CCALLSFSUB5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0) +#define CCALLSFSUB4( UN,LN,T1,T2,T3,T4, A1,A2,A3,A4)\ + CCALLSFSUB5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0) +#define CCALLSFSUB5( UN,LN,T1,T2,T3,T4,T5, A1,A2,A3,A4,A5) \ + 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) +#define CCALLSFSUB6( UN,LN,T1,T2,T3,T4,T5,T6, A1,A2,A3,A4,A5,A6) \ + 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) +#define CCALLSFSUB7( UN,LN,T1,T2,T3,T4,T5,T6,T7, A1,A2,A3,A4,A5,A6,A7) \ + 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) +#define CCALLSFSUB8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8, A1,A2,A3,A4,A5,A6,A7,A8) \ + 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) +#define CCALLSFSUB9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\ + CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0) +#define CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\ + 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) +#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)\ + 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) +#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)\ + 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) +#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)\ + 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) + +#ifdef __cplusplus +#define CPPPROTOCLSFSUB0( UN,LN) +#define CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +#define CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) +#else +#define CPPPROTOCLSFSUB0(UN,LN) \ + PROTOCCALLSFSUB0(UN,LN) +#define CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +#define CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) +#endif + +#ifdef CFSUBASFUN +#define CCALLSFSUB0(UN,LN) CCALLSFFUN0(UN,LN) +#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)\ + 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) +#else +/* do{...}while(FALSE) allows if(a==b) FORT(); else BORT(); */ +#define CCALLSFSUB0( UN,LN) do{CPPPROTOCLSFSUB0(UN,LN) CFC_(UN,LN)();}while(FALSE) +#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)\ +do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \ + VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,BA) \ + VVCF(TB,AB,BB) VVCF(TC,AC,BC) VVCF(TD,AD,BD) VVCF(TE,AE,BE) \ + CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) \ + ACF(LN,T4,A4,4) ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) \ + ACF(LN,T8,A8,8) ACF(LN,T9,A9,9) ACF(LN,TA,AA,A) ACF(LN,TB,AB,B) \ + ACF(LN,TC,AC,C) ACF(LN,TD,AD,D) ACF(LN,TE,AE,E) \ + 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) );\ + WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \ + WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,A) \ + WCF(TB,AB,B) WCF(TC,AC,C) WCF(TD,AD,D) WCF(TE,AE,E) }while(FALSE) +#endif + + +#if MAX_PREPRO_ARGS>31 +#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)\ + 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) +#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)\ + 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) +#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)\ + 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) +#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)\ + 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) +#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)\ + 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) + +#ifdef CFSUBASFUN +#define CCALLSFSUB20(UN,LN,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) \ + CCALLSFFUN20(UN,LN,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) +#else +#define CCALLSFSUB20(UN,LN,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) \ +do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \ + VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,BA) \ + VVCF(TB,AB,BB) VVCF(TC,AC,BC) VVCF(TD,AD,BD) VVCF(TE,AE,BE) VVCF(TF,AF,BF) \ + VVCF(TG,AG,BG) VVCF(TH,AH,BH) VVCF(TI,AI,BI) VVCF(TJ,AJ,BJ) VVCF(TK,AK,BK) \ + CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) ACF(LN,T4,A4,4) \ + ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) ACF(LN,T8,A8,8) \ + ACF(LN,T9,A9,9) ACF(LN,TA,AA,A) ACF(LN,TB,AB,B) ACF(LN,TC,AC,C) \ + ACF(LN,TD,AD,D) ACF(LN,TE,AE,E) ACF(LN,TF,AF,F) ACF(LN,TG,AG,G) \ + ACF(LN,TH,AH,H) ACF(LN,TI,AI,I) ACF(LN,TJ,AJ,J) ACF(LN,TK,AK,K) \ + 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) ); \ + WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) WCF(T6,A6,6) \ + WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,A) WCF(TB,AB,B) WCF(TC,AC,C) \ + WCF(TD,AD,D) WCF(TE,AE,E) WCF(TF,AF,F) WCF(TG,AG,G) WCF(TH,AH,H) WCF(TI,AI,I) \ + WCF(TJ,AJ,J) WCF(TK,AK,K) }while(FALSE) +#endif +#endif /* MAX_PREPRO_ARGS */ + +/*-------------------------------------------------------------------------*/ + +/* UTILITIES FOR C TO CALL FORTRAN FUNCTIONS */ + +/*N.B. PROTOCCALLSFFUNn(..) generates code, whether or not the FORTRAN + function is called. Therefore, especially for creator's of C header files + for large FORTRAN libraries which include many functions, to reduce + compile time and object code size, it may be desirable to create + preprocessor directives to allow users to create code for only those + functions which they use. */ + +/* The following defines the maximum length string that a function can return. + Of course it may be undefine-d and re-define-d before individual + PROTOCCALLSFFUNn(..) as required. It would also be nice to have this derived + from the individual machines' limits. */ +#define MAX_LEN_FORTRAN_FUNCTION_STRING 0x4FE + +/* The following defines a character used by CFORTRAN.H to flag the end of a + string coming out of a FORTRAN routine. */ +#define CFORTRAN_NON_CHAR 0x7F + +#ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */ +#pragma nostandard +#endif + +#define _SEP_(TN,C,COMMA) _(__SEP_,C)(TN,COMMA) +#define __SEP_0(TN,COMMA) +#define __SEP_1(TN,COMMA) _Icf(2,SEP,TN,COMMA,0) +#define INT_cfSEP(T,B) _(A,B) +#define INTV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVVV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVVVV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVVVVV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVVVVVV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVVVVVVV_cfSEP(T,B) INT_cfSEP(T,B) +#define PINT_cfSEP(T,B) INT_cfSEP(T,B) +#define PVOID_cfSEP(T,B) INT_cfSEP(T,B) +#define ROUTINE_cfSEP(T,B) INT_cfSEP(T,B) +#define SIMPLE_cfSEP(T,B) INT_cfSEP(T,B) +#define VOID_cfSEP(T,B) INT_cfSEP(T,B) /* For FORTRAN calls C subr.s.*/ +#define STRING_cfSEP(T,B) INT_cfSEP(T,B) +#define STRINGV_cfSEP(T,B) INT_cfSEP(T,B) +#define PSTRING_cfSEP(T,B) INT_cfSEP(T,B) +#define PSTRINGV_cfSEP(T,B) INT_cfSEP(T,B) +#define PNSTRING_cfSEP(T,B) INT_cfSEP(T,B) +#define PPSTRING_cfSEP(T,B) INT_cfSEP(T,B) +#define ZTRINGV_cfSEP(T,B) INT_cfSEP(T,B) +#define PZTRINGV_cfSEP(T,B) INT_cfSEP(T,B) + +#if defined(SIGNED_BYTE) || !defined(UNSIGNED_BYTE) +#ifdef OLD_VAXC +#define INTEGER_BYTE char /* Old VAXC barfs on 'signed char' */ +#else +#define INTEGER_BYTE signed char /* default */ +#endif +#else +#define INTEGER_BYTE unsigned char +#endif +#define BYTEVVVVVVV_cfTYPE INTEGER_BYTE +#define DOUBLEVVVVVVV_cfTYPE DOUBLE_PRECISION +#define FLOATVVVVVVV_cfTYPE FORTRAN_REAL +#define INTVVVVVVV_cfTYPE int +#define LOGICALVVVVVVV_cfTYPE int +#define LONGVVVVVVV_cfTYPE long +#define SHORTVVVVVVV_cfTYPE short +#define PBYTE_cfTYPE INTEGER_BYTE +#define PDOUBLE_cfTYPE DOUBLE_PRECISION +#define PFLOAT_cfTYPE FORTRAN_REAL +#define PINT_cfTYPE int +#define PLOGICAL_cfTYPE int +#define PLONG_cfTYPE long +#define PSHORT_cfTYPE short + +#define CFARGS0(A,T,V,W,X,Y,Z) _3(T,_cf,A) +#define CFARGS1(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V) +#define CFARGS2(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W) +#define CFARGS3(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X) +#define CFARGS4(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X,Y) +#define CFARGS5(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X,Y,Z) + +#define _Icf(N,T,I,X,Y) _(I,_cfINT)(N,T,I,X,Y,0) +#define _Icf4(N,T,I,X,Y,Z) _(I,_cfINT)(N,T,I,X,Y,Z) +#define BYTE_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define DOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INT,B,X,Y,Z,0) +#define FLOAT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define INT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define LOGICAL_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define LONG_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define SHORT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define PBYTE_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define PDOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,PINT,B,X,Y,Z,0) +#define PFLOAT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define PINT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define PLOGICAL_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define PLONG_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define PSHORT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define BYTEV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define BYTEVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define BYTEVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define BYTEVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define BYTEVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define BYTEVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define BYTEVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define DOUBLEV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTV,B,X,Y,Z,0) +#define DOUBLEVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVV,B,X,Y,Z,0) +#define DOUBLEVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVV,B,X,Y,Z,0) +#define DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVV,B,X,Y,Z,0) +#define DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVV,B,X,Y,Z,0) +#define DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVVV,B,X,Y,Z,0) +#define DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVVVV,B,X,Y,Z,0) +#define FLOATV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define FLOATVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define FLOATVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define FLOATVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define FLOATVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define FLOATVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define FLOATVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define INTV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define INTVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define INTVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define INTVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define INTVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define INTVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define INTVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define LONGV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define LONGVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define LONGVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define LONGVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define LONGVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define LONGVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define LONGVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define SHORTV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define SHORTVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define SHORTVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define SHORTVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define SHORTVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define SHORTVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define SHORTVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define PVOID_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,B,B,X,Y,Z,0) +#define ROUTINE_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +/*CRAY coughs on the first, + i.e. the usual trouble of not being able to + define macros to macros with arguments. + New ultrix is worse, it coughs on all such uses. + */ +/*#define SIMPLE_cfINT PVOID_cfINT*/ +#define SIMPLE_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define VOID_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define STRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define STRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define PSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define PSTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define PNSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define PPSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define ZTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define PZTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define CF_0_cfINT(N,A,B,X,Y,Z) + + +#define UCF(TN,I,C) _SEP_(TN,C,COMMA) _Icf(2,U,TN,_(A,I),0) +#define UUCF(TN,I,C) _SEP_(TN,C,COMMA) _SEP_(TN,1,I) +#define UUUCF(TN,I,C) _SEP_(TN,C,COLON) _Icf(2,U,TN,_(A,I),0) +#define INT_cfU(T,A) _(T,VVVVVVV_cfTYPE) A +#define INTV_cfU(T,A) _(T,VVVVVV_cfTYPE) * A +#define INTVV_cfU(T,A) _(T,VVVVV_cfTYPE) * A +#define INTVVV_cfU(T,A) _(T,VVVV_cfTYPE) * A +#define INTVVVV_cfU(T,A) _(T,VVV_cfTYPE) * A +#define INTVVVVV_cfU(T,A) _(T,VV_cfTYPE) * A +#define INTVVVVVV_cfU(T,A) _(T,V_cfTYPE) * A +#define INTVVVVVVV_cfU(T,A) _(T,_cfTYPE) * A +#define PINT_cfU(T,A) _(T,_cfTYPE) * A +#define PVOID_cfU(T,A) void *A +#define ROUTINE_cfU(T,A) void (*A)(CF_NULL_PROTO) +#define VOID_cfU(T,A) void A /* Needed for C calls FORTRAN sub.s. */ +#define STRING_cfU(T,A) char *A /* via VOID and wrapper. */ +#define STRINGV_cfU(T,A) char *A +#define PSTRING_cfU(T,A) char *A +#define PSTRINGV_cfU(T,A) char *A +#define ZTRINGV_cfU(T,A) char *A +#define PZTRINGV_cfU(T,A) char *A + +/* VOID breaks U into U and UU. */ +#define INT_cfUU(T,A) _(T,VVVVVVV_cfTYPE) A +#define VOID_cfUU(T,A) /* Needed for FORTRAN calls C sub.s. */ +#define STRING_cfUU(T,A) char *A + + +#define BYTE_cfPU(A) CFextern INTEGER_BYTE FCALLSC_QUALIFIER A +#define DOUBLE_cfPU(A) CFextern DOUBLE_PRECISION FCALLSC_QUALIFIER A +#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT)) +#define FLOAT_cfPU(A) CFextern FORTRAN_REAL FCALLSC_QUALIFIER A +#else +#define FLOAT_cfPU(A) CFextern FLOATFUNCTIONTYPE FCALLSC_QUALIFIER A +#endif +#define INT_cfPU(A) CFextern int FCALLSC_QUALIFIER A +#define LOGICAL_cfPU(A) CFextern int FCALLSC_QUALIFIER A +#define LONG_cfPU(A) CFextern long FCALLSC_QUALIFIER A +#define SHORT_cfPU(A) CFextern short FCALLSC_QUALIFIER A +#define STRING_cfPU(A) CFextern void FCALLSC_QUALIFIER A +#define VOID_cfPU(A) CFextern void FCALLSC_QUALIFIER A + +#define BYTE_cfE INTEGER_BYTE A0; +#define DOUBLE_cfE DOUBLE_PRECISION A0; +#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT)) +#define FLOAT_cfE FORTRAN_REAL A0; +#else +#define FLOAT_cfE FORTRAN_REAL AA0; FLOATFUNCTIONTYPE A0; +#endif +#define INT_cfE int A0; +#define LOGICAL_cfE int A0; +#define LONG_cfE long A0; +#define SHORT_cfE short A0; +#define VOID_cfE +#ifdef vmsFortran +#define STRING_cfE static char AA0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \ + static fstring A0 = \ + {MAX_LEN_FORTRAN_FUNCTION_STRING,DSC$K_DTYPE_T,DSC$K_CLASS_S,AA0};\ + memset(AA0, CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\ + *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0'; +#else +#ifdef CRAYFortran +#define STRING_cfE static char AA0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \ + static _fcd A0; *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';\ + memset(AA0,CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\ + A0 = _cptofcd(AA0,MAX_LEN_FORTRAN_FUNCTION_STRING); +#else +/* 'cc: SC3.0.1 13 Jul 1994' barfs on char A0[0x4FE+1]; + * char A0[0x4FE +1]; char A0[1+0x4FE]; are both OK. */ +#define STRING_cfE static char A0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \ + memset(A0, CFORTRAN_NON_CHAR, \ + MAX_LEN_FORTRAN_FUNCTION_STRING); \ + *(A0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0'; +#endif +#endif +/* ESTRING must use static char. array which is guaranteed to exist after + function returns. */ + +/* N.B.i) The diff. for 0 (Zero) and >=1 arguments. + ii)That the following create an unmatched bracket, i.e. '(', which + must of course be matched in the call. + iii)Commas must be handled very carefully */ +#define INT_cfGZ(T,UN,LN) A0=CFC_(UN,LN)( +#define VOID_cfGZ(T,UN,LN) CFC_(UN,LN)( +#ifdef vmsFortran +#define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)(&A0 +#else +#if defined(CRAYFortran) || defined(AbsoftUNIXFortran) +#define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)( A0 +#else +#define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)( A0,MAX_LEN_FORTRAN_FUNCTION_STRING +#endif +#endif + +#define INT_cfG(T,UN,LN) INT_cfGZ(T,UN,LN) +#define VOID_cfG(T,UN,LN) VOID_cfGZ(T,UN,LN) +#define STRING_cfG(T,UN,LN) STRING_cfGZ(T,UN,LN), /*, is only diff. from _cfG*/ + +#define BYTEVVVVVVV_cfPP +#define INTVVVVVVV_cfPP /* These complement FLOATVVVVVVV_cfPP. */ +#define DOUBLEVVVVVVV_cfPP +#define LOGICALVVVVVVV_cfPP +#define LONGVVVVVVV_cfPP +#define SHORTVVVVVVV_cfPP +#define PBYTE_cfPP +#define PINT_cfPP +#define PDOUBLE_cfPP +#define PLOGICAL_cfPP +#define PLONG_cfPP +#define PSHORT_cfPP +#define PFLOAT_cfPP FLOATVVVVVVV_cfPP + +#define BCF(TN,AN,C) _SEP_(TN,C,COMMA) _Icf(2,B,TN,AN,0) +#define INT_cfB(T,A) (_(T,VVVVVVV_cfTYPE)) A +#define INTV_cfB(T,A) A +#define INTVV_cfB(T,A) (A)[0] +#define INTVVV_cfB(T,A) (A)[0][0] +#define INTVVVV_cfB(T,A) (A)[0][0][0] +#define INTVVVVV_cfB(T,A) (A)[0][0][0][0] +#define INTVVVVVV_cfB(T,A) (A)[0][0][0][0][0] +#define INTVVVVVVV_cfB(T,A) (A)[0][0][0][0][0][0] +#define PINT_cfB(T,A) _(T,_cfPP)&A +#define STRING_cfB(T,A) (char *) A +#define STRINGV_cfB(T,A) (char *) A +#define PSTRING_cfB(T,A) (char *) A +#define PSTRINGV_cfB(T,A) (char *) A +#define PVOID_cfB(T,A) (void *) A +#define ROUTINE_cfB(T,A) (void(*)(CF_NULL_PROTO))A +#define ZTRINGV_cfB(T,A) (char *) A +#define PZTRINGV_cfB(T,A) (char *) A + +#define SCF(TN,NAME,I,A) _(TN,_cfSTR)(3,S,NAME,I,A,0,0) +#define DEFAULT_cfS(M,I,A) +#define LOGICAL_cfS(M,I,A) +#define PLOGICAL_cfS(M,I,A) +#define STRING_cfS(M,I,A) ,sizeof(A) +#define STRINGV_cfS(M,I,A) ,( (unsigned)0xFFFF*firstindexlength(A) \ + +secondindexlength(A)) +#define PSTRING_cfS(M,I,A) ,sizeof(A) +#define PSTRINGV_cfS(M,I,A) STRINGV_cfS(M,I,A) +#define ZTRINGV_cfS(M,I,A) +#define PZTRINGV_cfS(M,I,A) + +#define HCF(TN,I) _(TN,_cfSTR)(3,H,COMMA, H,_(C,I),0,0) +#define HHCF(TN,I) _(TN,_cfSTR)(3,H,COMMA,HH,_(C,I),0,0) +#define HHHCF(TN,I) _(TN,_cfSTR)(3,H,COLON, H,_(C,I),0,0) +#define H_CF_SPECIAL unsigned +#define HH_CF_SPECIAL +#define DEFAULT_cfH(M,I,A) +#define LOGICAL_cfH(S,U,B) +#define PLOGICAL_cfH(S,U,B) +#define STRING_cfH(S,U,B) _(A,S) _(U,_CF_SPECIAL) B +#define STRINGV_cfH(S,U,B) STRING_cfH(S,U,B) +#define PSTRING_cfH(S,U,B) STRING_cfH(S,U,B) +#define PSTRINGV_cfH(S,U,B) STRING_cfH(S,U,B) +#define PNSTRING_cfH(S,U,B) STRING_cfH(S,U,B) +#define PPSTRING_cfH(S,U,B) STRING_cfH(S,U,B) +#define ZTRINGV_cfH(S,U,B) +#define PZTRINGV_cfH(S,U,B) + +/* Need VOID_cfSTR because Absoft forced function types go through _cfSTR. */ +/* No spaces inside expansion. They screws up macro catenation kludge. */ +#define VOID_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,LOGICAL,A,B,C,D,E) +#define LONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PBYTE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PDOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PFLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PINT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PLOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PLOGICAL,A,B,C,D,E) +#define PLONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PSHORT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define STRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,STRING,A,B,C,D,E) +#define PSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PSTRING,A,B,C,D,E) +#define STRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,STRINGV,A,B,C,D,E) +#define PSTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PSTRINGV,A,B,C,D,E) +#define PNSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PNSTRING,A,B,C,D,E) +#define PPSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PPSTRING,A,B,C,D,E) +#define PVOID_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define ROUTINE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SIMPLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define ZTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,ZTRINGV,A,B,C,D,E) +#define PZTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PZTRINGV,A,B,C,D,E) +#define CF_0_cfSTR(N,T,A,B,C,D,E) + +/* See ACF table comments, which explain why CCF was split into two. */ +#define CCF(NAME,TN,I) _(TN,_cfSTR)(5,C,NAME,I,_(A,I),_(B,I),_(C,I)) +#define DEFAULT_cfC(M,I,A,B,C) +#define LOGICAL_cfC(M,I,A,B,C) A=C2FLOGICAL( A); +#define PLOGICAL_cfC(M,I,A,B,C) *A=C2FLOGICAL(*A); +#ifdef vmsFortran +#define STRING_cfC(M,I,A,B,C) (B.clen=strlen(A),B.f.dsc$a_pointer=A, \ + C==sizeof(char*)||C==(unsigned)(B.clen+1)?B.f.dsc$w_length=B.clen: \ + (memset((A)+B.clen,' ',C-B.clen-1),A[B.f.dsc$w_length=C-1]='\0')); + /* PSTRING_cfC to beware of array A which does not contain any \0. */ +#define PSTRING_cfC(M,I,A,B,C) (B.dsc$a_pointer=A, C==sizeof(char*) ? \ + B.dsc$w_length=strlen(A): (A[C-1]='\0',B.dsc$w_length=strlen(A), \ + memset((A)+B.dsc$w_length,' ',C-B.dsc$w_length-1), B.dsc$w_length=C-1)); +#else +#define STRING_cfC(M,I,A,B,C) (B.clen=strlen(A), \ + C==sizeof(char*)||C==(unsigned)(B.clen+1)?B.flen=B.clen: \ + (memset((A)+B.clen,' ',C-B.clen-1),A[B.flen=C-1]='\0')); +#define PSTRING_cfC(M,I,A,B,C) (C==sizeof(char*)? B=strlen(A): \ + (A[C-1]='\0',B=strlen(A),memset((A)+B,' ',C-B-1),B=C-1)); +#endif + /* For CRAYFortran for (P)STRINGV_cfC, B.fs is set, but irrelevant. */ +#define STRINGV_cfC(M,I,A,B,C) \ + AATRINGV_cfA( A,B,(C/0xFFFF)*(C%0xFFFF),C/0xFFFF,C%0xFFFF) +#define PSTRINGV_cfC(M,I,A,B,C) \ + APATRINGV_cfA( A,B,(C/0xFFFF)*(C%0xFFFF),C/0xFFFF,C%0xFFFF) +#define ZTRINGV_cfC(M,I,A,B,C) \ + AATRINGV_cfA( A,B, (_3(M,_ELEMS_,I))*((_3(M,_ELEMLEN_,I))+1), \ + (_3(M,_ELEMS_,I)), (_3(M,_ELEMLEN_,I))+1 ) +#define PZTRINGV_cfC(M,I,A,B,C) \ + APATRINGV_cfA( A,B, (_3(M,_ELEMS_,I))*((_3(M,_ELEMLEN_,I))+1), \ + (_3(M,_ELEMS_,I)), (_3(M,_ELEMLEN_,I))+1 ) + +#define BYTE_cfCCC(A,B) &A +#define DOUBLE_cfCCC(A,B) &A +#if !defined(__CF__KnR) +#define FLOAT_cfCCC(A,B) &A + /* Although the VAX doesn't, at least the */ +#else /* HP and K&R mips promote float arg.'s of */ +#define FLOAT_cfCCC(A,B) &B /* unprototyped functions to double. Cannot */ +#endif /* use A here to pass the argument to FORTRAN. */ +#define INT_cfCCC(A,B) &A +#define LOGICAL_cfCCC(A,B) &A +#define LONG_cfCCC(A,B) &A +#define SHORT_cfCCC(A,B) &A +#define PBYTE_cfCCC(A,B) A +#define PDOUBLE_cfCCC(A,B) A +#define PFLOAT_cfCCC(A,B) A +#define PINT_cfCCC(A,B) A +#define PLOGICAL_cfCCC(A,B) B=A /* B used to keep a common W table. */ +#define PLONG_cfCCC(A,B) A +#define PSHORT_cfCCC(A,B) A + +#define CCCF(TN,I,M) _SEP_(TN,M,COMMA) _Icf(3,CC,TN,_(A,I),_(B,I)) +#define INT_cfCC(T,A,B) _(T,_cfCCC)(A,B) +#define INTV_cfCC(T,A,B) A +#define INTVV_cfCC(T,A,B) A +#define INTVVV_cfCC(T,A,B) A +#define INTVVVV_cfCC(T,A,B) A +#define INTVVVVV_cfCC(T,A,B) A +#define INTVVVVVV_cfCC(T,A,B) A +#define INTVVVVVVV_cfCC(T,A,B) A +#define PINT_cfCC(T,A,B) _(T,_cfCCC)(A,B) +#define PVOID_cfCC(T,A,B) A +#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) +#define ROUTINE_cfCC(T,A,B) &A +#else +#define ROUTINE_cfCC(T,A,B) A +#endif +#define SIMPLE_cfCC(T,A,B) A +#ifdef vmsFortran +#define STRING_cfCC(T,A,B) &B.f +#define STRINGV_cfCC(T,A,B) &B +#define PSTRING_cfCC(T,A,B) &B +#define PSTRINGV_cfCC(T,A,B) &B +#else +#ifdef CRAYFortran +#define STRING_cfCC(T,A,B) _cptofcd(A,B.flen) +#define STRINGV_cfCC(T,A,B) _cptofcd(B.s,B.flen) +#define PSTRING_cfCC(T,A,B) _cptofcd(A,B) +#define PSTRINGV_cfCC(T,A,B) _cptofcd(A,B.flen) +#else +#define STRING_cfCC(T,A,B) A +#define STRINGV_cfCC(T,A,B) B.fs +#define PSTRING_cfCC(T,A,B) A +#define PSTRINGV_cfCC(T,A,B) B.fs +#endif +#endif +#define ZTRINGV_cfCC(T,A,B) STRINGV_cfCC(T,A,B) +#define PZTRINGV_cfCC(T,A,B) PSTRINGV_cfCC(T,A,B) + +#define BYTE_cfX return A0; +#define DOUBLE_cfX return A0; +#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT)) +#define FLOAT_cfX return A0; +#else +#define FLOAT_cfX ASSIGNFLOAT(AA0,A0); return AA0; +#endif +#define INT_cfX return A0; +#define LOGICAL_cfX return F2CLOGICAL(A0); +#define LONG_cfX return A0; +#define SHORT_cfX return A0; +#define VOID_cfX return ; +#if defined(vmsFortran) || defined(CRAYFortran) +#define STRING_cfX return kill_trailing( \ + kill_trailing(AA0,CFORTRAN_NON_CHAR),' '); +#else +#define STRING_cfX return kill_trailing( \ + kill_trailing( A0,CFORTRAN_NON_CHAR),' '); +#endif + +#define CFFUN(NAME) _(__cf__,NAME) + +/* Note that we don't use LN here, but we keep it for consistency. */ +#define CCALLSFFUN0(UN,LN) CFFUN(UN)() + +#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */ +#pragma standard +#endif + +#define CCALLSFFUN1( UN,LN,T1, A1) \ + CCALLSFFUN5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0) +#define CCALLSFFUN2( UN,LN,T1,T2, A1,A2) \ + CCALLSFFUN5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0) +#define CCALLSFFUN3( UN,LN,T1,T2,T3, A1,A2,A3) \ + CCALLSFFUN5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0) +#define CCALLSFFUN4( UN,LN,T1,T2,T3,T4, A1,A2,A3,A4)\ + CCALLSFFUN5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0) +#define CCALLSFFUN5( UN,LN,T1,T2,T3,T4,T5, A1,A2,A3,A4,A5) \ + 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) +#define CCALLSFFUN6( UN,LN,T1,T2,T3,T4,T5,T6, A1,A2,A3,A4,A5,A6) \ + 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) +#define CCALLSFFUN7( UN,LN,T1,T2,T3,T4,T5,T6,T7, A1,A2,A3,A4,A5,A6,A7) \ + 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) +#define CCALLSFFUN8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8, A1,A2,A3,A4,A5,A6,A7,A8) \ + 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) +#define CCALLSFFUN9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\ + CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0) +#define CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\ + 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) +#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)\ + 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) +#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)\ + 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) +#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)\ + 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) + +#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)\ +((CFFUN(UN)( BCF(T1,A1,0) BCF(T2,A2,1) BCF(T3,A3,1) BCF(T4,A4,1) BCF(T5,A5,1) \ + BCF(T6,A6,1) BCF(T7,A7,1) BCF(T8,A8,1) BCF(T9,A9,1) BCF(TA,AA,1) \ + BCF(TB,AB,1) BCF(TC,AC,1) BCF(TD,AD,1) BCF(TE,AE,1) \ + SCF(T1,LN,1,A1) SCF(T2,LN,2,A2) SCF(T3,LN,3,A3) SCF(T4,LN,4,A4) \ + SCF(T5,LN,5,A5) SCF(T6,LN,6,A6) SCF(T7,LN,7,A7) SCF(T8,LN,8,A8) \ + SCF(T9,LN,9,A9) SCF(TA,LN,A,AA) SCF(TB,LN,B,AB) SCF(TC,LN,C,AC) \ + SCF(TD,LN,D,AD)))) + +/* N.B. Create a separate function instead of using (call function, function +value here) because in order to create the variables needed for the input +arg.'s which may be const.'s one has to do the creation within {}, but these +can never be placed within ()'s. Therefore one must create wrapper functions. +gcc, on the other hand may be able to avoid the wrapper functions. */ + +/* Prototypes are needed to correctly handle the value returned correctly. N.B. +Can only have prototype arg.'s with difficulty, a la G... table since FORTRAN +functions returning strings have extra arg.'s. Don't bother, since this only +causes a compiler warning to come up when one uses FCALLSCFUNn and CCALLSFFUNn +for the same function in the same source code. Something done by the experts in +debugging only.*/ + +#define PROTOCCALLSFFUN0(F,UN,LN) \ +_(F,_cfPU)( CFC_(UN,LN))(CF_NULL_PROTO); \ +static _Icf(2,U,F,CFFUN(UN),0)() {_(F,_cfE) _Icf(3,GZ,F,UN,LN) ABSOFT_cf1(F));_(F,_cfX)} + +#define PROTOCCALLSFFUN1( T0,UN,LN,T1) \ + PROTOCCALLSFFUN5 (T0,UN,LN,T1,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN2( T0,UN,LN,T1,T2) \ + PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN3( T0,UN,LN,T1,T2,T3) \ + PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,CF_0,CF_0) +#define PROTOCCALLSFFUN4( T0,UN,LN,T1,T2,T3,T4) \ + PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,T4,CF_0) +#define PROTOCCALLSFFUN5( T0,UN,LN,T1,T2,T3,T4,T5) \ + PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN6( T0,UN,LN,T1,T2,T3,T4,T5,T6) \ + PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN7( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7) \ + PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN8( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \ + PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0) +#define PROTOCCALLSFFUN9( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \ + PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0) +#define PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \ + PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN11(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \ + PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN12(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \ + PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0) +#define PROTOCCALLSFFUN13(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \ + PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0) + +/* HP/UX 9.01 cc requires the blank between '_Icf(3,G,T0,UN,LN) CCCF(T1,1,0)' */ + +#ifndef __CF__KnR +#define PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + _(T0,_cfPU)(CFC_(UN,LN))(CF_NULL_PROTO); static _Icf(2,U,T0,CFFUN(UN),0)( \ + CFARGT14FS(UCF,HCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ) \ +{ CFARGT14S(VCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfE) \ + CCF(LN,T1,1) CCF(LN,T2,2) CCF(LN,T3,3) CCF(LN,T4,4) CCF(LN,T5,5) \ + CCF(LN,T6,6) CCF(LN,T7,7) CCF(LN,T8,8) CCF(LN,T9,9) CCF(LN,TA,A) \ + CCF(LN,TB,B) CCF(LN,TC,C) CCF(LN,TD,D) CCF(LN,TE,E) _Icf(3,G,T0,UN,LN) \ + CFARGT14(CCCF,JCF,ABSOFT_cf1(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \ + WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \ + WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,A) \ + WCF(TB,AB,B) WCF(TC,AC,C) WCF(TD,AD,D) WCF(TE,AE,E) _(T0,_cfX)} +#else +#define PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + _(T0,_cfPU)(CFC_(UN,LN))(CF_NULL_PROTO); static _Icf(2,U,T0,CFFUN(UN),0)( \ + CFARGT14FS(UUCF,HHCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ) \ + CFARGT14FS(UUUCF,HHHCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ; \ +{ CFARGT14S(VCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfE) \ + CCF(LN,T1,1) CCF(LN,T2,2) CCF(LN,T3,3) CCF(LN,T4,4) CCF(LN,T5,5) \ + CCF(LN,T6,6) CCF(LN,T7,7) CCF(LN,T8,8) CCF(LN,T9,9) CCF(LN,TA,A) \ + CCF(LN,TB,B) CCF(LN,TC,C) CCF(LN,TD,D) CCF(LN,TE,E) _Icf(3,G,T0,UN,LN) \ + CFARGT14(CCCF,JCF,ABSOFT_cf1(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \ + WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \ + WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,A) \ + WCF(TB,AB,B) WCF(TC,AC,C) WCF(TD,AD,D) WCF(TE,AE,E) _(T0,_cfX)} +#endif + +/*-------------------------------------------------------------------------*/ + +/* UTILITIES FOR FORTRAN TO CALL C ROUTINES */ + +#ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */ +#pragma nostandard +#endif + +#if defined(vmsFortran) || defined(CRAYFortran) +#define DCF(TN,I) +#define DDCF(TN,I) +#define DDDCF(TN,I) +#else +#define DCF(TN,I) HCF(TN,I) +#define DDCF(TN,I) HHCF(TN,I) +#define DDDCF(TN,I) HHHCF(TN,I) +#endif + +#define QCF(TN,I) _(TN,_cfSTR)(1,Q,_(B,I), 0,0,0,0) +#define DEFAULT_cfQ(B) +#define LOGICAL_cfQ(B) +#define PLOGICAL_cfQ(B) +#define STRINGV_cfQ(B) char *B; unsigned int _(B,N); +#define STRING_cfQ(B) char *B=NULL; +#define PSTRING_cfQ(B) char *B=NULL; +#define PSTRINGV_cfQ(B) STRINGV_cfQ(B) +#define PNSTRING_cfQ(B) char *B=NULL; +#define PPSTRING_cfQ(B) + +#ifdef __sgi /* Else SGI gives warning 182 contrary to its C LRM A.17.7 */ +#define ROUTINE_orig *(void**)& +#else +#define ROUTINE_orig (void *) +#endif + +#define ROUTINE_1 ROUTINE_orig +#define ROUTINE_2 ROUTINE_orig +#define ROUTINE_3 ROUTINE_orig +#define ROUTINE_4 ROUTINE_orig +#define ROUTINE_5 ROUTINE_orig +#define ROUTINE_6 ROUTINE_orig +#define ROUTINE_7 ROUTINE_orig +#define ROUTINE_8 ROUTINE_orig +#define ROUTINE_9 ROUTINE_orig +#define ROUTINE_10 ROUTINE_orig +#define ROUTINE_11 ROUTINE_orig +#define ROUTINE_12 ROUTINE_orig +#define ROUTINE_13 ROUTINE_orig +#define ROUTINE_14 ROUTINE_orig + +#define TCF(NAME,TN,I,M) _SEP_(TN,M,COMMA) _(TN,_cfT)(NAME,I,_(A,I),_(B,I),_(C,I)) +#define BYTE_cfT(M,I,A,B,D) *A +#define DOUBLE_cfT(M,I,A,B,D) *A +#define FLOAT_cfT(M,I,A,B,D) *A +#define INT_cfT(M,I,A,B,D) *A +#define LOGICAL_cfT(M,I,A,B,D) F2CLOGICAL(*A) +#define LONG_cfT(M,I,A,B,D) *A +#define SHORT_cfT(M,I,A,B,D) *A +#define BYTEV_cfT(M,I,A,B,D) A +#define DOUBLEV_cfT(M,I,A,B,D) A +#define FLOATV_cfT(M,I,A,B,D) VOIDP A +#define INTV_cfT(M,I,A,B,D) A +#define LOGICALV_cfT(M,I,A,B,D) A +#define LONGV_cfT(M,I,A,B,D) A +#define SHORTV_cfT(M,I,A,B,D) A +#define BYTEVV_cfT(M,I,A,B,D) (void *)A /* We have to cast to void *,*/ +#define BYTEVVV_cfT(M,I,A,B,D) (void *)A /* since we don't know the */ +#define BYTEVVVV_cfT(M,I,A,B,D) (void *)A /* dimensions of the array. */ +#define BYTEVVVVV_cfT(M,I,A,B,D) (void *)A /* i.e. Unfortunately, can't */ +#define BYTEVVVVVV_cfT(M,I,A,B,D) (void *)A /* check that the type */ +#define BYTEVVVVVVV_cfT(M,I,A,B,D) (void *)A /* matches the prototype. */ +#define DOUBLEVV_cfT(M,I,A,B,D) (void *)A +#define DOUBLEVVV_cfT(M,I,A,B,D) (void *)A +#define DOUBLEVVVV_cfT(M,I,A,B,D) (void *)A +#define DOUBLEVVVVV_cfT(M,I,A,B,D) (void *)A +#define DOUBLEVVVVVV_cfT(M,I,A,B,D) (void *)A +#define DOUBLEVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVVVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVVVVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVVVVVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define INTVV_cfT(M,I,A,B,D) (void *)A +#define INTVVV_cfT(M,I,A,B,D) (void *)A +#define INTVVVV_cfT(M,I,A,B,D) (void *)A +#define INTVVVVV_cfT(M,I,A,B,D) (void *)A +#define INTVVVVVV_cfT(M,I,A,B,D) (void *)A +#define INTVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVVVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVVVVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVVVVVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define LONGVV_cfT(M,I,A,B,D) (void *)A +#define LONGVVV_cfT(M,I,A,B,D) (void *)A +#define LONGVVVV_cfT(M,I,A,B,D) (void *)A +#define LONGVVVVV_cfT(M,I,A,B,D) (void *)A +#define LONGVVVVVV_cfT(M,I,A,B,D) (void *)A +#define LONGVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVVVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVVVVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVVVVVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define PBYTE_cfT(M,I,A,B,D) A +#define PDOUBLE_cfT(M,I,A,B,D) A +#define PFLOAT_cfT(M,I,A,B,D) VOIDP A +#define PINT_cfT(M,I,A,B,D) A +#define PLOGICAL_cfT(M,I,A,B,D) ((*A=F2CLOGICAL(*A)),A) +#define PLONG_cfT(M,I,A,B,D) A +#define PSHORT_cfT(M,I,A,B,D) A +#define PVOID_cfT(M,I,A,B,D) A +#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) +#define ROUTINE_cfT(M,I,A,B,D) _(ROUTINE_,I) (*A) +#else +#define ROUTINE_cfT(M,I,A,B,D) _(ROUTINE_,I) A +#endif +/* A == pointer to the characters + D == length of the string, or of an element in an array of strings + E == number of elements in an array of strings */ +#define TTSTR( A,B,D) \ + ((B=(char*)malloc(D+1))[D]='\0', memcpy(B,A,D), kill_trailing(B,' ')) +#define TTTTSTR( A,B,D) (!(D<4||A[0]||A[1]||A[2]||A[3]))?NULL: \ + memchr(A,'\0',D) ?A : TTSTR(A,B,D) +#define TTTTSTRV( A,B,D,E) (_(B,N)=E,B=(char*)malloc(_(B,N)*(D+1)), (void *) \ + vkill_trailing(f2cstrv(A,B,D+1, _(B,N)*(D+1)), D+1,_(B,N)*(D+1),' ')) +#ifdef vmsFortran +#define STRING_cfT(M,I,A,B,D) TTTTSTR( A->dsc$a_pointer,B,A->dsc$w_length) +#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(A->dsc$a_pointer, B, \ + A->dsc$w_length , A->dsc$l_m[0]) +#define PSTRING_cfT(M,I,A,B,D) TTSTR( A->dsc$a_pointer,B,A->dsc$w_length) +#define PPSTRING_cfT(M,I,A,B,D) A->dsc$a_pointer +#else +#ifdef CRAYFortran +#define STRING_cfT(M,I,A,B,D) TTTTSTR( _fcdtocp(A),B,_fcdlen(A)) +#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(_fcdtocp(A),B,_fcdlen(A), \ + num_elem(_fcdtocp(A),_fcdlen(A),_3(M,_STRV_A,I))) +#define PSTRING_cfT(M,I,A,B,D) TTSTR( _fcdtocp(A),B,_fcdlen(A)) +#define PPSTRING_cfT(M,I,A,B,D) _fcdtocp(A) +#else +#define STRING_cfT(M,I,A,B,D) TTTTSTR( A,B,D) +#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(A,B,D, num_elem(A,D,_3(M,_STRV_A,I))) +#define PSTRING_cfT(M,I,A,B,D) TTSTR( A,B,D) +#define PPSTRING_cfT(M,I,A,B,D) A +#endif +#endif +#define PNSTRING_cfT(M,I,A,B,D) STRING_cfT(M,I,A,B,D) +#define PSTRINGV_cfT(M,I,A,B,D) STRINGV_cfT(M,I,A,B,D) +#define CF_0_cfT(M,I,A,B,D) + +#define RCF(TN,I) _(TN,_cfSTR)(3,R,_(A,I),_(B,I),_(C,I),0,0) +#define DEFAULT_cfR(A,B,D) +#define LOGICAL_cfR(A,B,D) +#define PLOGICAL_cfR(A,B,D) *A=C2FLOGICAL(*A); +#define STRING_cfR(A,B,D) if (B) free(B); +#define STRINGV_cfR(A,B,D) free(B); +/* A and D as defined above for TSTRING(V) */ +#define RRRRPSTR( A,B,D) if (B) memcpy(A,B, _cfMIN(strlen(B),D)), \ + (D>strlen(B)?memset(A+strlen(B),' ', D-strlen(B)):0), free(B); +#define RRRRPSTRV(A,B,D) c2fstrv(B,A,D+1,(D+1)*_(B,N)), free(B); +#ifdef vmsFortran +#define PSTRING_cfR(A,B,D) RRRRPSTR( A->dsc$a_pointer,B,A->dsc$w_length) +#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(A->dsc$a_pointer,B,A->dsc$w_length) +#else +#ifdef CRAYFortran +#define PSTRING_cfR(A,B,D) RRRRPSTR( _fcdtocp(A),B,_fcdlen(A)) +#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(_fcdtocp(A),B,_fcdlen(A)) +#else +#define PSTRING_cfR(A,B,D) RRRRPSTR( A,B,D) +#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(A,B,D) +#endif +#endif +#define PNSTRING_cfR(A,B,D) PSTRING_cfR(A,B,D) +#define PPSTRING_cfR(A,B,D) + +#define BYTE_cfFZ(UN,LN) INTEGER_BYTE FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define DOUBLE_cfFZ(UN,LN) DOUBLE_PRECISION FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define INT_cfFZ(UN,LN) int FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define LOGICAL_cfFZ(UN,LN) int FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define LONG_cfFZ(UN,LN) long FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define SHORT_cfFZ(UN,LN) short FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define VOID_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)( +#ifndef __CF__KnR +/* The void is req'd by the Apollo, to make this an ANSI function declaration. + The Apollo promotes K&R float functions to double. */ +#define FLOAT_cfFZ(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)(void +#ifdef vmsFortran +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(fstring *AS +#else +#ifdef CRAYFortran +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(_fcd AS +#else +#if defined(AbsoftUNIXFortran) +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(char *AS +#else +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(char *AS, unsigned D0 +#endif +#endif +#endif +#else +#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT)) +#define FLOAT_cfFZ(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)( +#else +#define FLOAT_cfFZ(UN,LN) FLOATFUNCTIONTYPE FCALLSC_QUALIFIER fcallsc(UN,LN)( +#endif +#if defined(vmsFortran) || defined(CRAYFortran) || defined(AbsoftUNIXFortran) +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(AS +#else +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(AS, D0 +#endif +#endif + +#define BYTE_cfF(UN,LN) BYTE_cfFZ(UN,LN) +#define DOUBLE_cfF(UN,LN) DOUBLE_cfFZ(UN,LN) +#ifndef __CF_KnR +#define FLOAT_cfF(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)( +#else +#define FLOAT_cfF(UN,LN) FLOAT_cfFZ(UN,LN) +#endif +#define INT_cfF(UN,LN) INT_cfFZ(UN,LN) +#define LOGICAL_cfF(UN,LN) LOGICAL_cfFZ(UN,LN) +#define LONG_cfF(UN,LN) LONG_cfFZ(UN,LN) +#define SHORT_cfF(UN,LN) SHORT_cfFZ(UN,LN) +#define VOID_cfF(UN,LN) VOID_cfFZ(UN,LN) +#define STRING_cfF(UN,LN) STRING_cfFZ(UN,LN), + +#define INT_cfFF +#define VOID_cfFF +#ifdef vmsFortran +#define STRING_cfFF fstring *AS; +#else +#ifdef CRAYFortran +#define STRING_cfFF _fcd AS; +#else +#define STRING_cfFF char *AS; unsigned D0; +#endif +#endif + +#define INT_cfL A0= +#define STRING_cfL A0= +#define VOID_cfL + +#define INT_cfK +#define VOID_cfK +/* KSTRING copies the string into the position provided by the caller. */ +#ifdef vmsFortran +#define STRING_cfK \ + memcpy(AS->dsc$a_pointer,A0,_cfMIN(AS->dsc$w_length,(A0==NULL?0:strlen(A0))));\ + AS->dsc$w_length>(A0==NULL?0:strlen(A0))? \ + memset(AS->dsc$a_pointer+(A0==NULL?0:strlen(A0)),' ', \ + AS->dsc$w_length-(A0==NULL?0:strlen(A0))):0; +#else +#ifdef CRAYFortran +#define STRING_cfK \ + memcpy(_fcdtocp(AS),A0, _cfMIN(_fcdlen(AS),(A0==NULL?0:strlen(A0))) ); \ + _fcdlen(AS)>(A0==NULL?0:strlen(A0))? \ + memset(_fcdtocp(AS)+(A0==NULL?0:strlen(A0)),' ', \ + _fcdlen(AS)-(A0==NULL?0:strlen(A0))):0; +#else +#define STRING_cfK memcpy(AS,A0, _cfMIN(D0,(A0==NULL?0:strlen(A0))) ); \ + D0>(A0==NULL?0:strlen(A0))?memset(AS+(A0==NULL?0:strlen(A0)), \ + ' ', D0-(A0==NULL?0:strlen(A0))):0; +#endif +#endif + +/* Note that K.. and I.. can't be combined since K.. has to access data before +R.., in order for functions returning strings which are also passed in as +arguments to work correctly. Note that R.. frees and hence may corrupt the +string. */ +#define BYTE_cfI return A0; +#define DOUBLE_cfI return A0; +#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT)) +#define FLOAT_cfI return A0; +#else +#define FLOAT_cfI RETURNFLOAT(A0); +#endif +#define INT_cfI return A0; +#ifdef hpuxFortran800 +/* Incredibly, functions must return true as 1, elsewhere .true.==0x01000000. */ +#define LOGICAL_cfI return ((A0)?1:0); +#else +#define LOGICAL_cfI return C2FLOGICAL(A0); +#endif +#define LONG_cfI return A0; +#define SHORT_cfI return A0; +#define STRING_cfI return ; +#define VOID_cfI return ; + +#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */ +#pragma standard +#endif + +#define FCALLSCSUB0( CN,UN,LN) FCALLSCFUN0(VOID,CN,UN,LN) +#define FCALLSCSUB1( CN,UN,LN,T1) FCALLSCFUN1(VOID,CN,UN,LN,T1) +#define FCALLSCSUB2( CN,UN,LN,T1,T2) FCALLSCFUN2(VOID,CN,UN,LN,T1,T2) +#define FCALLSCSUB3( CN,UN,LN,T1,T2,T3) FCALLSCFUN3(VOID,CN,UN,LN,T1,T2,T3) +#define FCALLSCSUB4( CN,UN,LN,T1,T2,T3,T4) \ + FCALLSCFUN4(VOID,CN,UN,LN,T1,T2,T3,T4) +#define FCALLSCSUB5( CN,UN,LN,T1,T2,T3,T4,T5) \ + FCALLSCFUN5(VOID,CN,UN,LN,T1,T2,T3,T4,T5) +#define FCALLSCSUB6( CN,UN,LN,T1,T2,T3,T4,T5,T6) \ + FCALLSCFUN6(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6) +#define FCALLSCSUB7( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \ + FCALLSCFUN7(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) +#define FCALLSCSUB8( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \ + FCALLSCFUN8(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) +#define FCALLSCSUB9( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \ + FCALLSCFUN9(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) +#define FCALLSCSUB10(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \ + FCALLSCFUN10(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) +#define FCALLSCSUB11(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \ + FCALLSCFUN11(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) +#define FCALLSCSUB12(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \ + FCALLSCFUN12(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) +#define FCALLSCSUB13(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \ + FCALLSCFUN13(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) +#define FCALLSCSUB14(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + FCALLSCFUN14(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) + +#define FCALLSCFUN1( T0,CN,UN,LN,T1) \ + FCALLSCFUN5 (T0,CN,UN,LN,T1,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN2( T0,CN,UN,LN,T1,T2) \ + FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,CF_0,CF_0,CF_0) +#define FCALLSCFUN3( T0,CN,UN,LN,T1,T2,T3) \ + FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,CF_0,CF_0) +#define FCALLSCFUN4( T0,CN,UN,LN,T1,T2,T3,T4) \ + FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,T4,CF_0) +#define FCALLSCFUN5( T0,CN,UN,LN,T1,T2,T3,T4,T5) \ + FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN6( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6) \ + FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN7( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \ + FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0) +#define FCALLSCFUN8( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \ + FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0) +#define FCALLSCFUN9( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \ + FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0) +#define FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \ + FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN11(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \ + FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0) +#define FCALLSCFUN12(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \ + FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0) +#define FCALLSCFUN13(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \ + FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0) + +#ifndef __CF__KnR +#define FCALLSCFUN0(T0,CN,UN,LN) CFextern _(T0,_cfFZ)(UN,LN) ABSOFT_cf2(T0)) \ + {_Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN(); _Icf(0,K,T0,0,0) _(T0,_cfI)} + +#define FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + CFextern _(T0,_cfF)(UN,LN) \ + CFARGT14(NCF,DCF,ABSOFT_cf2(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)) \ + { CFARGT14S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \ + 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) \ + 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) \ + TCF(LN,TD,D,1) TCF(LN,TE,E,1) ); _Icf(0,K,T0,0,0) \ + CFARGT14S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfI) } +#else +#define FCALLSCFUN0(T0,CN,UN,LN) CFextern _(T0,_cfFZ)(UN,LN) ABSOFT_cf3(T0)) _Icf(0,FF,T0,0,0)\ + {_Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN(); _Icf(0,K,T0,0,0) _(T0,_cfI)} + +#define FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + CFextern _(T0,_cfF)(UN,LN) \ + 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) \ + CFARGT14FS(NNNCF,DDDCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE); \ + { CFARGT14S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \ + 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) \ + 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) \ + TCF(LN,TD,D,1) TCF(LN,TE,E,1) ); _Icf(0,K,T0,0,0) \ + CFARGT14S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfI)} +#endif + + +#endif /* __CFORTRAN_LOADED */ diff --git a/include/cfitsio/compress.h b/include/cfitsio/compress.h new file mode 100644 index 0000000..7e3c406 --- /dev/null +++ b/include/cfitsio/compress.h @@ -0,0 +1,212 @@ +/* compress.h -- definitions for the decompression routines used in CFITSIO */ + +/* Blatantly copied and modified from the original gzip-1.2.4 source code. */ + +#include <stdlib.h> +#include <stdio.h> +#include <string.h> +#include <ctype.h> + +/* 'near' is only relevant for 16-bit PC with small memory model */ +# define near + +#if defined(VAXC) || defined(VMS) +# define RECORD_IO 1 +#else +# define RECORD_IO 0 +#endif + +#define get_char() get_byte() + +/* gzip.h -- common declarations for all gzip modules */ + +#define OF(args) args +typedef void *voidp; + +#define memzero(s, n) memset ((voidp)(s), 0, (n)) + +typedef unsigned char uch; +typedef unsigned short ush; +typedef unsigned long ulg; + +/* Return codes from gzip */ +#define OK 0 +#define ERROR 1 +#define WARNING 2 + +/* Compression methods (see algorithm.doc) */ +#define STORED 0 +#define COMPRESSED 1 +#define PACKED 2 +#define LZHED 3 +/* methods 4 to 7 reserved */ +#define DEFLATED 8 +#define MAX_METHODS 9 + +#define INBUFSIZ 0x8000 /* input buffer size */ +#define INBUF_EXTRA 64 /* required by unlzw() */ +#define OUTBUFSIZ 16384 /* output buffer size */ +#define OUTBUF_EXTRA 2048 /* required by unlzw() */ +#define DIST_BUFSIZE 0x8000 /* buffer for distances, see trees.c */ +#define WSIZE 0x8000 /* window size--must be a power of two, and */ + +#define DECLARE(type, array, size) type array[size] + +#define tab_suffix window +#define tab_prefix prev /* hash link (see deflate.c) */ +#define head (prev+WSIZE) /* hash head (see deflate.c) */ + +#define PACK_MAGIC "\037\036" /* Magic header for packed files */ +#define GZIP_MAGIC "\037\213" /* Magic header for gzip files, 1F 8B */ +#define OLD_GZIP_MAGIC "\037\236" /* Magic header for gzip 0.5 = freeze 1.x */ +#define LZH_MAGIC "\037\240" /* Magic header for SCO LZH Compress files*/ +#define LZW_MAGIC "\037\235" /* Magic header for lzw files, 1F 9D */ +#define PKZIP_MAGIC "\120\113\003\004" /* Magic header for pkzip files */ + +/* gzip flag byte */ +#define ASCII_FLAG 0x01 /* bit 0 set: file probably ascii text */ +#define CONTINUATION 0x02 /* bit 1 set: continuation of multi-part gzip file */ +#define EXTRA_FIELD 0x04 /* bit 2 set: extra field present */ +#define ORIG_NAME 0x08 /* bit 3 set: original file name present */ +#define COMMENT 0x10 /* bit 4 set: file comment present */ +#define ENCRYPTED 0x20 /* bit 5 set: file is encrypted */ +#define RESERVED 0xC0 /* bit 6,7: reserved */ + +#define MIN_MATCH 3 +#define MAX_MATCH 258 +#define MIN_LOOKAHEAD (MAX_MATCH+MIN_MATCH+1) +#define MAX_DIST (WSIZE-MIN_LOOKAHEAD) +#define translate_eol 0 /* no option -a yet */ + +#define get_byte() (inptr < insize ? inbuf[inptr++] : fill_inbuf(0)) +#define try_byte() (inptr < insize ? inbuf[inptr++] : fill_inbuf(1)) +#define put_ubyte(c) {window[outcnt++]=(uch)(c); if (outcnt==WSIZE)\ + flush_window();} + +/* Macros for getting two-byte and four-byte header values */ +#define SH(p) ((ush)(uch)((p)[0]) | ((ush)(uch)((p)[1]) << 8)) +#define LG(p) ((ulg)(SH(p)) | ((ulg)(SH((p)+2)) << 16)) + +/* Diagnostic functions */ +# define Assert(cond,msg) +# define Trace(x) +# define Tracev(x) +# define Tracevv(x) +# define Tracec(c,x) +# define Tracecv(c,x) + +/* lzw.h -- define the lzw functions. */ + +#ifndef BITS +# define BITS 16 +#endif +#define INIT_BITS 9 /* Initial number of bits per code */ +#define BIT_MASK 0x1f /* Mask for 'number of compression bits' */ +#define BLOCK_MODE 0x80 +#define LZW_RESERVED 0x60 /* reserved bits */ +#define CLEAR 256 /* flush the dictionary */ +#define FIRST (CLEAR+1) /* first free entry */ + +/* prototypes */ + +#define local static +void ffpmsg(const char *err_message); + +local int get_method OF((FILE *in)); + +local ulg updcrc OF((uch *s, unsigned n)); +local int fill_inbuf OF((int eof_ok)); +local void flush_outbuf OF((void)); +local void flush_window OF((void)); +local void write_buf OF((voidp buf, unsigned cnt)); +local void error OF((char *m)); +local ulg flush_block OF((char *buf, ulg stored_len, int eof)); +typedef int file_t; /* Do not use stdio */ +#define NO_FILE (-1) /* in memory compression */ +local int file_read OF((char *buf, unsigned size)); +local void send_bits OF((int value, int length)); +local unsigned bi_reverse OF((unsigned value, int length)); +local void bi_windup OF((void)); +local void copy_block OF((char *buf, unsigned len, int header)); +local int (*read_buf) OF((char *buf, unsigned size)); +local void lm_init OF((int pack_level, ush *flags)); +local ulg deflate OF((void)); +local void ct_init OF((ush *attr, int *method)); +local int ct_tally OF((int dist, int lc)); +local void bi_init OF((file_t zipfile)); + +#define put_byte(c) {outbuf[outcnt++]=(uch)(c); if (outcnt==OUTBUFSIZ)\ + flush_outbuf();} + +/* Output a 16 bit value, lsb first */ +#define put_short(w) \ +{ if (outcnt < OUTBUFSIZ-2) { \ + outbuf[outcnt++] = (uch) ((w) & 0xff); \ + outbuf[outcnt++] = (uch) ((ush)(w) >> 8); \ + } else { \ + put_byte((uch)((w) & 0xff)); \ + put_byte((uch)((ush)(w) >> 8)); \ + } \ +} + +/* Output a 32 bit value to the bit stream, lsb first */ +#define put_long(n) { \ + put_short((n) & 0xffff); \ + put_short(((ulg)(n)) >> 16); \ +} + +#define seekable() 0 /* force sequential output */ + +/* io.c */ +local void fillbuf OF((int n)); +local unsigned getbits OF((int n)); +local void init_getbits OF((void)); + +/* maketbl.c */ +local void make_table OF((int nchar, uch bitlen[], + int tablebits, ush table[])); + +/* huf.c */ +local void read_pt_len OF((int nn, int nbit, int i_special)); +local void read_c_len OF((void)); +local unsigned decode_c OF((void)); +local unsigned decode_p OF((void)); +local void huf_decode_start OF((void)); + +/* decode.c */ +local void decode_start OF((void)); +local unsigned decode OF((unsigned count, uch buffer[])); + +local int unlzh OF((FILE *in, FILE *out)); +local int unlzw OF((FILE *in, FILE *out)); + +local void read_tree OF((void)); +local void build_tree_unpack OF((void)); + +local int unpack OF((FILE *in, FILE *out)); +local int check_zipfile OF((FILE *in)); +local int unzip OF((FILE *in, FILE *out)); + +int (*work) OF((FILE *infile, FILE *outfile)) = unzip; /* function to call */ + +/* inflate.c */ +struct huft { + uch e; /* number of extra bits or operation */ + uch b; /* number of bits in this code or subcode */ + union { + ush n; /* literal, length base, or distance base */ + struct huft *t; /* pointer to next level of table */ + } v; +}; + +local int huft_build OF((unsigned *, unsigned, unsigned, ush *, ush *, + struct huft **, int *)); +local int huft_free OF((struct huft *)); +local int inflate_codes OF((struct huft *, struct huft *, int, int)); +local int inflate_stored OF((void)); +local int inflate_fixed OF((void)); +local int inflate_dynamic OF((void)); +local int inflate_block OF((int *)); +local int inflate OF((void)); + +/* end of compress.h include file */ diff --git a/include/cfitsio/drvrsmem.h b/include/cfitsio/drvrsmem.h new file mode 100644 index 0000000..cd63810 --- /dev/null +++ b/include/cfitsio/drvrsmem.h @@ -0,0 +1,178 @@ +/* S H A R E D M E M O R Y D R I V E R + ======================================= + + by Jerzy.Borkowski@obs.unige.ch + +09-Mar-98 : initial version 1.0 released +23-Mar-98 : shared_malloc now accepts new handle as an argument +*/ + + +#include <sys/ipc.h> /* this is necessary for Solaris/Linux */ +#include <sys/shm.h> +#include <sys/sem.h> + +#ifdef _AIX +#include <fcntl.h> +#else +#include <sys/fcntl.h> +#endif + + /* configuration parameters */ + +#define SHARED_MAXSEG (16) /* maximum number of shared memory blocks */ + +#define SHARED_KEYBASE (14011963) /* base for shared memory keys, may be overriden by getenv */ +#define SHARED_FDNAME ("/tmp/.shmem-lockfile") /* template for lock file name */ + +#define SHARED_ENV_KEYBASE ("SHMEM_LIB_KEYBASE") /* name of environment variable */ +#define SHARED_ENV_MAXSEG ("SHMEM_LIB_MAXSEG") /* name of environment variable */ + + /* useful constants */ + +#define SHARED_RDONLY (0) /* flag for shared_(un)lock, lock for read */ +#define SHARED_RDWRITE (1) /* flag for shared_(un)lock, lock for write */ +#define SHARED_WAIT (0) /* flag for shared_lock, block if cannot lock immediate */ +#define SHARED_NOWAIT (2) /* flag for shared_lock, fail if cannot lock immediate */ +#define SHARED_NOLOCK (0x100) /* flag for shared_validate function */ + +#define SHARED_RESIZE (4) /* flag for shared_malloc, object is resizeable */ +#define SHARED_PERSIST (8) /* flag for shared_malloc, object is not deleted after last proc detaches */ + +#define SHARED_INVALID (-1) /* invalid handle for semaphore/shared memory */ + +#define SHARED_EMPTY (0) /* entries for shared_used table */ +#define SHARED_USED (1) + +#define SHARED_GRANUL (16384) /* granularity of shared_malloc allocation = phys page size, system dependent */ + + + + /* checkpoints in shared memory segments - might be omitted */ + +#define SHARED_ID_0 ('J') /* first byte of identifier in BLKHEAD */ +#define SHARED_ID_1 ('B') /* second byte of identifier in BLKHEAD */ + +#define BLOCK_REG (0) /* value for tflag member of BLKHEAD */ +#define BLOCK_SHARED (1) /* value for tflag member of BLKHEAD */ + + /* generic error codes */ + +#define SHARED_OK (0) + +#define SHARED_ERR_MIN_IDX SHARED_BADARG +#define SHARED_ERR_MAX_IDX SHARED_NORESIZE + + +#define DAL_SHM_FREE (0) +#define DAL_SHM_USED (1) + +#define DAL_SHM_ID0 ('D') +#define DAL_SHM_ID1 ('S') +#define DAL_SHM_ID2 ('M') + +#define DAL_SHM_SEGHEAD_ID (0x19630114) + + + + /* data types */ + +/* BLKHEAD object is placed at the beginning of every memory segment (both + shared and regular) to allow automatic recognition of segments type */ + +typedef union + { struct BLKHEADstruct + { char ID[2]; /* ID = 'JB', just as a checkpoint */ + char tflag; /* is it shared memory or regular one ? */ + int handle; /* this is not necessary, used only for non-resizeable objects via ptr */ + } s; + double d; /* for proper alignment on every machine */ + } BLKHEAD; + +typedef void *SHARED_P; /* generic type of shared memory pointer */ + +typedef struct SHARED_GTABstruct /* data type used in global table */ + { int sem; /* access semaphore (1 field): process count */ + int semkey; /* key value used to generate semaphore handle */ + int key; /* key value used to generate shared memory handle (realloc changes it) */ + int handle; /* handle of shared memory segment */ + int size; /* size of shared memory segment */ + int nprocdebug; /* attached proc counter, helps remove zombie segments */ + char attr; /* attributes of shared memory object */ + } SHARED_GTAB; + +typedef struct SHARED_LTABstruct /* data type used in local table */ + { BLKHEAD *p; /* pointer to segment (may be null) */ + int tcnt; /* number of threads in this process attached to segment */ + int lkcnt; /* >=0 <- number of read locks, -1 - write lock */ + long seekpos; /* current pointer position, read/write/seek operations change it */ + } SHARED_LTAB; + + + /* system dependent definitions */ + +#ifndef HAVE_FLOCK_T +typedef struct flock flock_t; +#define HAVE_FLOCK_T +#endif + +#ifndef HAVE_UNION_SEMUN +union semun + { int val; + struct semid_ds *buf; + unsigned short *array; + }; +#define HAVE_UNION_SEMUN +#endif + + +typedef struct DAL_SHM_SEGHEAD_STRUCT DAL_SHM_SEGHEAD; + +struct DAL_SHM_SEGHEAD_STRUCT + { int ID; /* ID for debugging */ + int h; /* handle of sh. mem */ + int size; /* size of data area */ + int nodeidx; /* offset of root object (node struct typically) */ + }; + + /* API routines */ + +#ifdef __cplusplus +extern "C" { +#endif + +void shared_cleanup(void); /* must be called at exit/abort */ +int shared_init(int debug_msgs); /* must be called before any other shared memory routine */ +int shared_recover(int id); /* try to recover dormant segment(s) after applic crash */ +int shared_malloc(long size, int mode, int newhandle); /* allocate n-bytes of shared memory */ +int shared_attach(int idx); /* attach to segment given index to table */ +int shared_free(int idx); /* release shared memory */ +SHARED_P shared_lock(int idx, int mode); /* lock segment for reading */ +SHARED_P shared_realloc(int idx, long newsize); /* reallocate n-bytes of shared memory (ON LOCKED SEGMENT ONLY) */ +int shared_size(int idx); /* get size of attached shared memory segment (ON LOCKED SEGMENT ONLY) */ +int shared_attr(int idx); /* get attributes of attached shared memory segment (ON LOCKED SEGMENT ONLY) */ +int shared_set_attr(int idx, int newattr); /* set attributes of attached shared memory segment (ON LOCKED SEGMENT ONLY) */ +int shared_unlock(int idx); /* unlock segment (ON LOCKED SEGMENT ONLY) */ +int shared_set_debug(int debug_msgs); /* set/reset debug mode */ +int shared_set_createmode(int mode); /* set/reset debug mode */ +int shared_list(int id); /* list segment(s) */ +int shared_uncond_delete(int id); /* uncondintionally delete (NOWAIT operation) segment(s) */ + +int smem_init(void); +int smem_shutdown(void); +int smem_setoptions(int options); +int smem_getoptions(int *options); +int smem_getversion(int *version); +int smem_open(char *filename, int rwmode, int *driverhandle); +int smem_create(char *filename, int *driverhandle); +int smem_close(int driverhandle); +int smem_remove(char *filename); +int smem_size(int driverhandle, long *size); +int smem_flush(int driverhandle); +int smem_seek(int driverhandle, long offset); +int smem_read(int driverhandle, void *buffer, long nbytes); +int smem_write(int driverhandle, void *buffer, long nbytes); + +#ifdef __cplusplus +} +#endif diff --git a/include/cfitsio/eval_defs.h b/include/cfitsio/eval_defs.h new file mode 100644 index 0000000..c650311 --- /dev/null +++ b/include/cfitsio/eval_defs.h @@ -0,0 +1,147 @@ +#include <stdio.h> +#include <math.h> +#include <stdlib.h> +#include <string.h> +#if defined(__sgi) || defined(__hpux) +#include <alloca.h> +#endif +#ifdef sparc +#include <malloc.h> +#endif +#include "fitsio2.h" + +#ifndef FFBISON +#include "eval_tab.h" +#endif + +#define MAXDIMS 5 +#define MAXSUBS 10 +#define MAXVARNAME 80 +#define CONST_OP -1000 +#define pERROR -1 + +typedef struct { + char name[MAXVARNAME+1]; + int type; + long nelem; + int naxis; + long naxes[MAXDIMS]; + char *undef; + void *data; + } DataInfo; + +typedef struct { + long nelem; + int naxis; + long naxes[MAXDIMS]; + char *undef; + union { + double dbl; + long lng; + char log; + char str[256]; + double *dblptr; + long *lngptr; + char *logptr; + char **strptr; + void *ptr; + } data; + } lval; + +typedef struct Node { + int operation; + void (*DoOp)(struct Node *this); + int nSubNodes; + int SubNodes[MAXSUBS]; + int type; + lval value; + } Node; + +typedef struct { + fitsfile *def_fptr; + int (*getData)( char *dataName, void *dataValue ); + int (*loadData)( int varNum, long fRow, long nRows, + void *data, char *undef ); + + int compressed; + int timeCol; + int parCol; + int valCol; + + char *expr; + int index; + int is_eobuf; + + Node *Nodes; + int nNodes; + int nNodesAlloc; + int resultNode; + + long firstRow; + long nRows; + + int nCols; + iteratorCol *colData; + DataInfo *varData; + + long firstDataRow; + long nDataRows; + long totalRows; + + int datatype; + + int status; + } ParseData; + +typedef enum { + rnd_fct = 1001, + sum_fct, + nelem_fct, + sin_fct, + cos_fct, + tan_fct, + asin_fct, + acos_fct, + atan_fct, + sinh_fct, + cosh_fct, + tanh_fct, + exp_fct, + log_fct, + log10_fct, + sqrt_fct, + abs_fct, + atan2_fct, + ceil_fct, + floor_fct, + round_fct, + min1_fct, + min2_fct, + max1_fct, + max2_fct, + near_fct, + circle_fct, + box_fct, + elps_fct, + isnull_fct, + defnull_fct, + gtifilt_fct, + regfilt_fct, + row_fct + } funcOp; + +extern ParseData gParse; + +#ifdef __cplusplus +extern "C" { +#endif + + int ffparse(void); + int fflex(void); + void ffrestart(FILE*); + + void Evaluate_Parser( long firstRow, long nRows ); + +#ifdef __cplusplus + } +#endif diff --git a/include/cfitsio/eval_tab.h b/include/cfitsio/eval_tab.h new file mode 100644 index 0000000..784ac91 --- /dev/null +++ b/include/cfitsio/eval_tab.h @@ -0,0 +1,37 @@ +typedef union { + int Node; /* Index of Node */ + double dbl; /* real value */ + long lng; /* integer value */ + char log; /* logical value */ + char str[256]; /* string value */ +} FFSTYPE; +#define BOOLEAN 258 +#define LONG 259 +#define DOUBLE 260 +#define STRING 261 +#define BITSTR 262 +#define FUNCTION 263 +#define BFUNCTION 264 +#define GTIFILTER 265 +#define REGFILTER 266 +#define COLUMN 267 +#define BCOLUMN 268 +#define SCOLUMN 269 +#define BITCOL 270 +#define ROWREF 271 +#define OR 272 +#define AND 273 +#define EQ 274 +#define NE 275 +#define GT 276 +#define LT 277 +#define LTE 278 +#define GTE 279 +#define POWER 280 +#define NOT 281 +#define INTCAST 282 +#define FLTCAST 283 +#define UMINUS 284 + + +extern FFSTYPE fflval; diff --git a/include/cfitsio/f77_wrap.h b/include/cfitsio/f77_wrap.h new file mode 100644 index 0000000..121850f --- /dev/null +++ b/include/cfitsio/f77_wrap.h @@ -0,0 +1,277 @@ +#define UNSIGNED_BYTE +#include "cfortran.h" + +/************************************************************************ + DEC C creates longs as 8-byte integers. On most other machines, ints + and longs are both 4-bytes, so both are compatible with Fortrans + default integer which is 4-bytes. To support DECs, we must redefine + LONGs and convert them to 8-bytes when going to C, and restore them + to 4-bytes when returning to Fortran. Ugh!!! +*************************************************************************/ + +#if (defined DECFortran) || (defined(__alpha) && defined(g77Fortran)) + +#undef LONGV_cfSTR +#undef PLONG_cfSTR +#undef LONGVVVVVVV_cfTYPE +#undef PLONG_cfTYPE +#undef LONGV_cfT +#undef PLONG_cfT + +#define LONGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,LONGV,A,B,C,D,E) +#define PLONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PLONG,A,B,C,D,E) +#define LONGVVVVVVV_cfTYPE int +#define PLONG_cfTYPE int +#define LONGV_cfQ(B) long *B, _(B,N); +#define PLONG_cfQ(B) long B; +#define LONGV_cfT(M,I,A,B,D) ( (_(B,N) = * _3(M,_LONGV_A,I)), \ + B = F2Clongv(_(B,N),A) ) +#define PLONG_cfT(M,I,A,B,D) ((B=*A),&B) +#define LONGV_cfR(A,B,D) C2Flongv(_(B,N),A,B); +#define PLONG_cfR(A,B,D) *A=B; +#define LONGV_cfH(S,U,B) +#define PLONG_cfH(S,U,B) + +static long *F2Clongv(long size, int *A) +{ + long i; + long *B; + + B=(long *)malloc( size*sizeof(long) ); + for(i=0;i<size;i++) B[i]=A[i]; + return(B); +} + +static void C2Flongv(long size, int *A, long *B) +{ + long i; + + for(i=0;i<size;i++) A[i]=B[i]; + free(B); +} + +#endif + +/************************************************************************ + Modify cfortran.h's handling of strings. C interprets a "char **" + parameter as an array of pointers to the strings (or as a handle), + not as a pointer to a block of contiguous strings. Also set a + a minimum length for string allocations, to minimize risk of + overflow. +*************************************************************************/ + +extern unsigned long gMinStrLen; + +#undef STRINGV_cfQ +#undef STRINGV_cfR +#undef TTSTR +#undef TTTTSTRV +#undef RRRRPSTRV + +#undef PPSTRING_cfT + +#ifdef vmsFortran +#define PPSTRING_cfT(M,I,A,B,D) (unsigned char*)A->dsc$a_pointer + +/* We want single strings to be equivalent to string vectors with */ +/* a single element, so ignore the number of elements info in the */ +/* vector structure, and rely on the NUM_ELEM definitions. */ + +#undef STRINGV_cfT +#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(A->dsc$a_pointer, B, \ + A->dsc$w_length, \ + num_elem(A->dsc$a_pointer, \ + A->dsc$w_length, \ + _3(M,_STRV_A,I) ) ) +#else +#ifdef CRAYFortran +#define PPSTRING_cfT(M,I,A,B,D) (unsigned char*)_fcdtocp(A) +#else +#define PPSTRING_cfT(M,I,A,B,D) (unsigned char*)A +#endif +#endif + +#define _cfMAX(A,B) ( (A>B) ? A : B ) +#define STRINGV_cfQ(B) char **B; unsigned int _(B,N), _(B,M); +#define STRINGV_cfR(A,B,D) free(B[0]); free(B); +#define TTSTR( A,B,D) \ + ((B=(char*)malloc(_cfMAX(D,gMinStrLen)+1))[D]='\0',memcpy(B,A,D), \ + kill_trailing(B,' ')) +#define TTTTSTRV( A,B,D,E) ( \ + _(B,N)=_cfMAX(E,1), \ + _(B,M)=_cfMAX(D,gMinStrLen)+1, \ + B=(char**)malloc(_(B,N)*sizeof(char*)), \ + B[0]=(char*)malloc(_(B,N)*_(B,M)), \ + vindex(B,_(B,M),_(B,N),f2cstrv2(A,B[0],D,_(B,M),_(B,N))) \ + ) +#define RRRRPSTRV(A,B,D) \ + c2fstrv2(B[0],A,_(B,M),D,_(B,N)), \ + free(B[0]), \ + free(B); + +static char **vindex(char **B, int elem_len, int nelem, char *B0) +{ + int i; + if( nelem ) + for( i=0;i<nelem;i++ ) B[i] = B0+i*elem_len; + return B; +} + +static char *c2fstrv2(char* cstr, char *fstr, int celem_len, int felem_len, + int nelem) +{ + int i,j; + + if( nelem ) + for (i=0; i<nelem; i++) { + for (j=0; j<felem_len && *cstr; j++) *fstr++ = *cstr++; + cstr += celem_len-j; + for (; j<felem_len; j++) *fstr++ = ' '; + } + return( fstr-felem_len*nelem ); +} + +static char *f2cstrv2(char *fstr, char* cstr, int felem_len, int celem_len, + int nelem) +{ + int i,j; + + if( nelem ) + for (i=0; i<nelem; i++, cstr+=(celem_len-felem_len)) { + for (j=0; j<felem_len; j++) *cstr++ = *fstr++; + *cstr='\0'; + kill_trailingn( cstr-felem_len, ' ', cstr ); + } + return( cstr-celem_len*nelem ); +} + +/************************************************************************ + The following definitions redefine the BYTE data type to be + interpretted as a character*1 string instead of an integer*1 which + is not supported by all compilers. +*************************************************************************/ + +#undef BYTE_cfT +#undef BYTEV_cfT +#undef BYTE_cfINT +#undef BYTEV_cfINT +#undef BYTE_cfSTR +#undef BYTEV_cfSTR + +#define BYTE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,BYTE,B,X,Y,Z,0) +#define BYTEV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,BYTEV,B,X,Y,Z,0) +#define BYTE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,BYTE,A,B,C,D,E) +#define BYTEV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,BYTEV,A,B,C,D,E) +#define BYTE_cfSEP(T,B) INT_cfSEP(T,B) +#define BYTEV_cfSEP(T,B) INT_cfSEP(T,B) +#define BYTE_cfH(S,U,B) STRING_cfH(S,U,B) +#define BYTEV_cfH(S,U,B) STRING_cfH(S,U,B) +#define BYTE_cfQ(B) +#define BYTEV_cfQ(B) +#define BYTE_cfR(A,B,D) +#define BYTEV_cfR(A,B,D) + +#ifdef vmsFortran +#define BYTE_cfN(T,A) fstring * A +#define BYTEV_cfN(T,A) fstringvector * A +#define BYTE_cfT(M,I,A,B,D) (INTEGER_BYTE)((A->dsc$a_pointer)[0]) +#define BYTEV_cfT(M,I,A,B,D) (INTEGER_BYTE*)A->dsc$a_pointer +#else +#ifdef CRAYFortran +#define BYTE_cfN(T,A) _fcd A +#define BYTEV_cfN(T,A) _fcd A +#define BYTE_cfT(M,I,A,B,D) (INTEGER_BYTE)((_fcdtocp(A))[0]) +#define BYTEV_cfT(M,I,A,B,D) (INTEGER_BYTE*)_fcdtocp(A) +#else +#define BYTE_cfN(T,A) INTEGER_BYTE * A +#define BYTEV_cfN(T,A) INTEGER_BYTE * A +#define BYTE_cfT(M,I,A,B,D) A[0] +#define BYTEV_cfT(M,I,A,B,D) A +#endif +#endif + +/************************************************************************ + The following definitions and functions handle conversions between + C and Fortran arrays of LOGICALS. Individually, LOGICALS are + treated as int's but as char's when in an array. cfortran defines + (F2C/C2F)LOGICALV but never uses them, so these routines also + handle TRUE/FALSE conversions. +*************************************************************************/ + +#undef LOGICALV_cfSTR +#undef LOGICALV_cfT +#define LOGICALV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,LOGICALV,A,B,C,D,E) +#define LOGICALV_cfQ(B) char *B; unsigned int _(B,N); +#define LOGICALV_cfT(M,I,A,B,D) (_(B,N)= * _3(M,_LOGV_A,I), \ + B=F2CcopyLogVect(_(B,N),A)) +#define LOGICALV_cfR(A,B,D) C2FcopyLogVect(_(B,N),A,B); +#define LOGICALV_cfH(S,U,B) + +static char *F2CcopyLogVect(long size, int *A) +{ + long i; + char *B; + + B=(char *)malloc(size*sizeof(char)); + for( i=0; i<size; i++ ) B[i]=F2CLOGICAL(A[i]); + return(B); +} + +static void C2FcopyLogVect(long size, int *A, char *B) +{ + long i; + + for( i=0; i<size; i++ ) A[i]=C2FLOGICAL(B[i]); + free(B); +} + +/*------------------ Fortran File Handling ----------------------*/ +/* Fortran uses unit numbers, whereas C uses file pointers, so */ +/* a global array of file pointers is setup in which Fortran's */ +/* unit number serves as the index. Two FITSIO routines are */ +/* the integer unit number and the fitsfile file pointer. */ +/*-----------------------------------------------------------------*/ + +#define MAXFITSFILES 200 /* Array of file pointers indexed */ +extern fitsfile *gFitsFiles[]; /* by Fortran unit numbers */ + +#define FITSUNIT_cfINT(N,A,B,X,Y,Z) INT_cfINT(N,A,B,X,Y,Z) +#define FITSUNIT_cfSTR(N,T,A,B,C,D,E) INT_cfSTR(N,T,A,B,C,D,E) +#define FITSUNIT_cfT(M,I,A,B,D) gFitsFiles[*A] +#define FITSUNITVVVVVVV_cfTYPE int +#define PFITSUNIT_cfINT(N,A,B,X,Y,Z) PINT_cfINT(N,A,B,X,Y,Z) +#define PFITSUNIT_cfSTR(N,T,A,B,C,D,E) PINT_cfSTR(N,T,A,B,C,D,E) +#define PFITSUNIT_cfT(M,I,A,B,D) (gFitsFiles + *A) +#define PFITSUNIT_cfTYPE int + + +/*---------------------- Make C++ Happy -----------------------------*/ +/* Redefine FCALLSCFUNn so that they create prototypes of themselves */ +/* and change TTTTSTR to use (char *)0 instead of NULL */ +/*-------------------------------------------------------------------*/ + +#undef FCALLSCFUN0 +#undef FCALLSCFUN14 +#undef TTTTSTR + +#define TTTTSTR(A,B,D) ( !(D<4||A[0]||A[1]||A[2]||A[3]) ) ? ((char*)0) : \ + memchr(A,'\0',D) ? A : TTSTR(A,B,D) + +#define FCALLSCFUN0(T0,CN,UN,LN) \ + CFextern _(T0,_cfFZ)(UN,LN) void ABSOFT_cf2(T0)); \ + CFextern _(T0,_cfFZ)(UN,LN) void ABSOFT_cf2(T0)) \ + {_Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN(); _Icf(0,K,T0,0,0) _(T0,_cfI)} + +#define FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + CFextern _(T0,_cfF)(UN,LN) \ + CFARGT14(NCF,DCF,ABSOFT_cf2(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \ + CFextern _(T0,_cfF)(UN,LN) \ + CFARGT14(NCF,DCF,ABSOFT_cf2(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)) \ + { CFARGT14S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \ + 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) \ + 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) \ + TCF(LN,TD,D,1) TCF(LN,TE,E,1) ); _Icf(0,K,T0,0,0) \ + CFARGT14S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfI) \ + } + diff --git a/include/cfitsio/fitsio.h b/include/cfitsio/fitsio.h new file mode 100644 index 0000000..9330127 --- /dev/null +++ b/include/cfitsio/fitsio.h @@ -0,0 +1,1355 @@ +#ifndef _FITSIO_H +#define _FITSIO_H + +#include <stdio.h> +/* stddef.h is apparently needed to define size_t */ +#include <stddef.h> + +/* The following exclusion if __CINT__ is defined is needed for ROOT */ +#ifndef __CINT__ +#include "longnam.h" +#endif + +/* global variables */ + +#define FLEN_FILENAME 1025 /* max length of a filename */ +#define FLEN_KEYWORD 72 /* max length of a keyword (HIERARCH convention) */ +#define FLEN_CARD 81 /* length of a FITS header card */ +#define FLEN_VALUE 71 /* max length of a keyword value string */ +#define FLEN_COMMENT 73 /* max length of a keyword comment string */ +#define FLEN_ERRMSG 81 /* max length of a FITSIO error message */ +#define FLEN_STATUS 31 /* max length of a FITSIO status text string */ + +#define TBIT 1 /* codes for FITS table data types */ +#define TBYTE 11 +#define TLOGICAL 14 +#define TSTRING 16 +#define TUSHORT 20 +#define TSHORT 21 +#define TUINT 30 +#define TINT 31 +#define TULONG 40 +#define TLONG 41 +#define TFLOAT 42 +#define TDOUBLE 82 +#define TCOMPLEX 83 +#define TDBLCOMPLEX 163 + +#define TYP_STRUC_KEY 10 +#define TYP_CMPRS_KEY 20 +#define TYP_SCAL_KEY 30 +#define TYP_NULL_KEY 40 +#define TYP_DIM_KEY 50 +#define TYP_RANG_KEY 60 +#define TYP_UNIT_KEY 70 +#define TYP_DISP_KEY 80 +#define TYP_HDUID_KEY 90 +#define TYP_CKSUM_KEY 100 +#define TYP_WCS_KEY 110 +#define TYP_REFSYS_KEY 120 +#define TYP_COMM_KEY 130 +#define TYP_CONT_KEY 140 +#define TYP_USER_KEY 150 + +#define INT32BIT int /* 32-bit integer datatype. Currently this */ + /* datatype is an 'int' on all useful platforms */ + /* however, it is possible that that are cases */ + /* where 'int' is a 2-byte integer, in which case */ + /* FITSINT would need to be defined as 'long'. */ + +#define BYTE_IMG 8 /* BITPIX code values for FITS image types */ +#define SHORT_IMG 16 +#define LONG_IMG 32 +#define FLOAT_IMG -32 +#define DOUBLE_IMG -64 + /* The following 2 codes are not true FITS */ + /* datatypes; these codes are only used internally */ + /* within cfitsio to make it easier for users */ + /* to deal with unsigned integers. */ +#define USHORT_IMG 20 +#define ULONG_IMG 40 + +#define IMAGE_HDU 0 /* Primary Array or IMAGE HDU */ +#define ASCII_TBL 1 /* ASCII table HDU */ +#define BINARY_TBL 2 /* Binary table HDU */ +#define ANY_HDU -1 /* matches any HDU type */ + +#define READONLY 0 /* options when opening a file */ +#define READWRITE 1 + +/* adopt a hopefully obscure number to use as a null value flag */ +/* could be problems if the FITS files contain data with these values */ +#define FLOATNULLVALUE -9.11912E-36F +#define DOUBLENULLVALUE -9.1191291391491E-36 + +/* Image compression algorithm types */ +#define MAX_COMPRESS_DIM 6 +#define RICE_1 11 +#define GZIP_1 21 +#define PLIO_1 31 +#define HCOMPRESS_1 41 + +#ifndef TRUE +#define TRUE 1 +#endif + +#ifndef FALSE +#define FALSE 0 +#endif + +#define CASESEN 1 /* do case-sensitive string match */ +#define CASEINSEN 0 /* do case-insensitive string match */ + +#define MAXHDU 1000 /* maximum number of extensions allowed in a FITS file */ + +#define GT_ID_ALL_URI 0 /* hierarchical grouping parameters */ +#define GT_ID_REF 1 +#define GT_ID_POS 2 +#define GT_ID_ALL 3 +#define GT_ID_REF_URI 11 +#define GT_ID_POS_URI 12 + +#define OPT_RM_GPT 0 +#define OPT_RM_ENTRY 1 +#define OPT_RM_MBR 2 +#define OPT_RM_ALL 3 + +#define OPT_GCP_GPT 0 +#define OPT_GCP_MBR 1 +#define OPT_GCP_ALL 2 + +#define OPT_MCP_ADD 0 +#define OPT_MCP_NADD 1 +#define OPT_MCP_REPL 2 +#define OPT_MCP_MOV 3 + +#define OPT_MRG_COPY 0 +#define OPT_MRG_MOV 1 + +#define OPT_CMT_MBR 1 +#define OPT_CMT_MBR_DEL 11 + +typedef struct /* structure used to store table column information */ +{ + char ttype[70]; /* column name = FITS TTYPEn keyword; */ + long tbcol; /* offset in row to first byte of each column */ + int tdatatype; /* datatype code of each column */ + long trepeat; /* repeat count of column; number of elements */ + double tscale; /* FITS TSCALn linear scaling factor */ + double tzero; /* FITS TZEROn linear scaling zero point */ + long tnull; /* FITS null value for int image or binary table cols */ + char strnull[20]; /* FITS null value string for ASCII table columns */ + char tform[10]; /* FITS tform keyword value */ + long twidth; /* width of each ASCII table column */ +}tcolumn; + +#define VALIDSTRUC 555 /* magic value used to identify if structure is valid */ + +typedef struct /* structure used to store basic FITS file information */ +{ + int filehandle; /* handle returned by the file open function */ + int driver; /* defines which set of I/O drivers should be used */ + int open_count; /* number of opened 'fitsfiles' using this structure */ + char *filename; /* file name */ + int validcode; /* magic value used to verify that structure is valid */ + long filesize; /* current size of the physical disk file in bytes */ + long logfilesize; /* logical size of file, including unflushed buffers */ + int lasthdu; /* is this the last HDU in the file? 0 = no, else yes */ + long bytepos; /* current logical I/O pointer position in file */ + long io_pos; /* current I/O pointer position in the physical file */ + int curbuf; /* number of I/O buffer currently in use */ + int curhdu; /* current HDU number; 0 = primary array */ + int hdutype; /* 0 = primary array, 1 = ASCII table, 2 = binary table */ + int writemode; /* 0 = readonly, 1 = readwrite */ + int maxhdu; /* highest numbered HDU known to exist in the file */ + long headstart[MAXHDU + 1]; /* byte offset in file to start of each HDU */ + long headend; /* byte offest in file to end of the current HDU header */ + long nextkey; /* byte offset in file to beginning of next keyword */ + long datastart; /* byte offset in file to start of the current data unit */ + int tfield; /* number of fields in the table (primary array has 2 */ + long origrows; /* original number of rows (value of NAXIS2 keyword) */ + long numrows; /* number of rows in the table (dynamically updated) */ + long rowlength; /* total length of a table row, in bytes */ + tcolumn *tableptr; /* pointer to the table structure */ + long heapstart; /* heap start byte relative to start of data unit */ + long heapsize; /* size of the heap, in bytes */ + + /* the following elements are related to compress images */ + int compressimg; /* 1 if HDU contains a compressed image, else 0 */ + char zcmptype[12]; /* compression type string */ + int compress_type; /* type of compression algorithm */ + int zbitpix; /* FITS data type of image (BITPIX) */ + int zndim; /* dimension of image */ + long znaxis[MAX_COMPRESS_DIM]; /* length of each axis */ + long tilesize[MAX_COMPRESS_DIM]; /* size of compression tiles */ + long maxtilelen; /* max number of pixels in each image tile */ + long maxelem; /* maximum length of variable length arrays */ + + int cn_compressed; /* column number for COMPRESSED_DATA column */ + int cn_uncompressed; /* column number for UNCOMPRESSED_DATA column */ + int cn_zscale; /* column number for ZSCALE column */ + int cn_zzero; /* column number for ZZERO column */ + int cn_zblank; /* column number for the ZBLANK column */ + + double zscale; /* scaling value, if same for all tiles */ + double zzero; /* zero pt, if same for all tiles */ + int zblank; /* value for null pixels, if not a column */ + + int rice_blocksize; /* first compression parameter */ + int rice_nbits; /* second compression parameter */ +} FITSfile; + +typedef struct /* structure used to store basic HDU information */ +{ + int HDUposition; /* HDU position in file; 0 = first HDU */ + FITSfile *Fptr; /* pointer to FITS file structure */ +}fitsfile; + +typedef struct /* structure for the iterator function column information */ +{ + /* elements required as input to fits_iterate_data: */ + + fitsfile *fptr; /* pointer to the HDU containing the column */ + int colnum; /* column number in the table (use name if < 1) */ + char colname[70]; /* name (= TTYPEn value) of the column (optional) */ + int datatype; /* output datatype (converted if necessary */ + int iotype; /* = InputCol, InputOutputCol, or OutputCol */ + + /* output elements that may be useful for the work function: */ + + void *array; /* pointer to the array (and the null value) */ + long repeat; /* binary table vector repeat value */ + long tlmin; /* legal minimum data value */ + long tlmax; /* legal maximum data value */ + char tunit[70]; /* physical unit string */ + char tdisp[70]; /* suggested display format */ + +} iteratorCol; + +#define InputCol 0 /* flag for input only iterator column */ +#define InputOutputCol 1 /* flag for input and output iterator column */ +#define OutputCol 2 /* flag for output only iterator column */ + +/* error status codes */ + +#define USE_MEM_BUFF -101 /* use memory buffer when opening file */ +#define OVERFLOW_ERR -11 /* overflow during datatype conversion */ +#define SAME_FILE 101 /* input and output files are the same */ +#define TOO_MANY_FILES 103 /* tried to open too many FITS files */ +#define FILE_NOT_OPENED 104 /* could not open the named file */ +#define FILE_NOT_CREATED 105 /* could not create the named file */ +#define WRITE_ERROR 106 /* error writing to FITS file */ +#define END_OF_FILE 107 /* tried to move past end of file */ +#define READ_ERROR 108 /* error reading from FITS file */ +#define FILE_NOT_CLOSED 110 /* could not close the file */ +#define ARRAY_TOO_BIG 111 /* array dimensions exceed internal limit */ +#define READONLY_FILE 112 /* Cannot write to readonly file */ +#define MEMORY_ALLOCATION 113 /* Could not allocate memory */ +#define BAD_FILEPTR 114 /* invalid fitsfile pointer */ +#define NULL_INPUT_PTR 115 /* NULL input pointer to routine */ +#define SEEK_ERROR 116 /* error seeking position in file */ + +#define BAD_URL_PREFIX 121 /* invalid URL prefix on file name */ +#define TOO_MANY_DRIVERS 122 /* tried to register too many IO drivers */ +#define DRIVER_INIT_FAILED 123 /* driver initialization failed */ +#define NO_MATCHING_DRIVER 124 /* matching driver is not registered */ +#define URL_PARSE_ERROR 125 /* failed to parse input file URL */ + +#define SHARED_ERRBASE (150) +#define SHARED_BADARG (SHARED_ERRBASE + 1) +#define SHARED_NULPTR (SHARED_ERRBASE + 2) +#define SHARED_TABFULL (SHARED_ERRBASE + 3) +#define SHARED_NOTINIT (SHARED_ERRBASE + 4) +#define SHARED_IPCERR (SHARED_ERRBASE + 5) +#define SHARED_NOMEM (SHARED_ERRBASE + 6) +#define SHARED_AGAIN (SHARED_ERRBASE + 7) +#define SHARED_NOFILE (SHARED_ERRBASE + 8) +#define SHARED_NORESIZE (SHARED_ERRBASE + 9) + +#define HEADER_NOT_EMPTY 201 /* header already contains keywords */ +#define KEY_NO_EXIST 202 /* keyword not found in header */ +#define KEY_OUT_BOUNDS 203 /* keyword record number is out of bounds */ +#define VALUE_UNDEFINED 204 /* keyword value field is blank */ +#define NO_QUOTE 205 /* string is missing the closing quote */ +#define BAD_KEYCHAR 207 /* illegal character in keyword name or card */ +#define BAD_ORDER 208 /* required keywords out of order */ +#define NOT_POS_INT 209 /* keyword value is not a positive integer */ +#define NO_END 210 /* couldn't find END keyword */ +#define BAD_BITPIX 211 /* illegal BITPIX keyword value*/ +#define BAD_NAXIS 212 /* illegal NAXIS keyword value */ +#define BAD_NAXES 213 /* illegal NAXISn keyword value */ +#define BAD_PCOUNT 214 /* illegal PCOUNT keyword value */ +#define BAD_GCOUNT 215 /* illegal GCOUNT keyword value */ +#define BAD_TFIELDS 216 /* illegal TFIELDS keyword value */ +#define NEG_WIDTH 217 /* negative table row size */ +#define NEG_ROWS 218 /* negative number of rows in table */ +#define COL_NOT_FOUND 219 /* column with this name not found in table */ +#define BAD_SIMPLE 220 /* illegal value of SIMPLE keyword */ +#define NO_SIMPLE 221 /* Primary array doesn't start with SIMPLE */ +#define NO_BITPIX 222 /* Second keyword not BITPIX */ +#define NO_NAXIS 223 /* Third keyword not NAXIS */ +#define NO_NAXES 224 /* Couldn't find all the NAXISn keywords */ +#define NO_XTENSION 225 /* HDU doesn't start with XTENSION keyword */ +#define NOT_ATABLE 226 /* the CHDU is not an ASCII table extension */ +#define NOT_BTABLE 227 /* the CHDU is not a binary table extension */ +#define NO_PCOUNT 228 /* couldn't find PCOUNT keyword */ +#define NO_GCOUNT 229 /* couldn't find GCOUNT keyword */ +#define NO_TFIELDS 230 /* couldn't find TFIELDS keyword */ +#define NO_TBCOL 231 /* couldn't find TBCOLn keyword */ +#define NO_TFORM 232 /* couldn't find TFORMn keyword */ +#define NOT_IMAGE 233 /* the CHDU is not an IMAGE extension */ +#define BAD_TBCOL 234 /* TBCOLn keyword value < 0 or > rowlength */ +#define NOT_TABLE 235 /* the CHDU is not a table */ +#define COL_TOO_WIDE 236 /* column is too wide to fit in table */ +#define COL_NOT_UNIQUE 237 /* more than 1 column name matches template */ +#define BAD_ROW_WIDTH 241 /* sum of column widths not = NAXIS1 */ +#define UNKNOWN_EXT 251 /* unrecognizable FITS extension type */ +#define UNKNOWN_REC 252 /* unrecognizable FITS record */ +#define END_JUNK 253 /* END keyword is not blank */ +#define BAD_HEADER_FILL 254 /* Header fill area not blank */ +#define BAD_DATA_FILL 255 /* Data fill area not blank or zero */ +#define BAD_TFORM 261 /* illegal TFORM format code */ +#define BAD_TFORM_DTYPE 262 /* unrecognizable TFORM datatype code */ +#define BAD_TDIM 263 /* illegal TDIMn keyword value */ + +#define BAD_HDU_NUM 301 /* HDU number < 1 or > MAXHDU */ +#define BAD_COL_NUM 302 /* column number < 1 or > tfields */ +#define NEG_FILE_POS 304 /* tried to move before beginning of file */ +#define NEG_BYTES 306 /* tried to read or write negative bytes */ +#define BAD_ROW_NUM 307 /* illegal starting row number in table */ +#define BAD_ELEM_NUM 308 /* illegal starting element number in vector */ +#define NOT_ASCII_COL 309 /* this is not an ASCII string column */ +#define NOT_LOGICAL_COL 310 /* this is not a logical datatype column */ +#define BAD_ATABLE_FORMAT 311 /* ASCII table column has wrong format */ +#define BAD_BTABLE_FORMAT 312 /* Binary table column has wrong format */ +#define NO_NULL 314 /* null value has not been defined */ +#define NOT_VARI_LEN 317 /* this is not a variable length column */ +#define BAD_DIMEN 320 /* illegal number of dimensions in array */ +#define BAD_PIX_NUM 321 /* first pixel number greater than last pixel */ +#define ZERO_SCALE 322 /* illegal BSCALE or TSCALn keyword = 0 */ +#define NEG_AXIS 323 /* illegal axis length < 1 */ + +#define NOT_GROUP_TABLE 340 +#define HDU_ALREADY_MEMBER 341 +#define MEMBER_NOT_FOUND 342 +#define GROUP_NOT_FOUND 343 +#define BAD_GROUP_ID 344 +#define TOO_MANY_HDUS_TRACKED 345 +#define HDU_ALREADY_TRACKED 346 +#define BAD_OPTION 347 +#define IDENTICAL_POINTERS 348 + +#define BAD_I2C 401 /* bad int to formatted string conversion */ +#define BAD_F2C 402 /* bad float to formatted string conversion */ +#define BAD_INTKEY 403 /* can't interprete keyword value as integer */ +#define BAD_LOGICALKEY 404 /* can't interprete keyword value as logical */ +#define BAD_FLOATKEY 405 /* can't interprete keyword value as float */ +#define BAD_DOUBLEKEY 406 /* can't interprete keyword value as double */ +#define BAD_C2I 407 /* bad formatted string to int conversion */ +#define BAD_C2F 408 /* bad formatted string to float conversion */ +#define BAD_C2D 409 /* bad formatted string to double conversion */ +#define BAD_DATATYPE 410 /* bad keyword datatype code */ +#define BAD_DECIM 411 /* bad number of decimal places specified */ +#define NUM_OVERFLOW 412 /* overflow during datatype conversion */ + +# define DATA_COMPRESSION_ERR 413 /* error in imcompress routines */ +# define DATA_DECOMPRESSION_ERR 414 /* error in imcompress routines */ + +#define BAD_DATE 420 /* error in date or time conversion */ + +#define PARSE_SYNTAX_ERR 431 /* syntax error in parser expression */ +#define PARSE_BAD_TYPE 432 /* expression did not evaluate to desired type */ +#define PARSE_LRG_VECTOR 433 /* vector result too large to return in array */ +#define PARSE_NO_OUTPUT 434 /* data parser failed not sent an out column */ +#define PARSE_BAD_COL 435 /* bad data encounter while parsing column */ +#define PARSE_BAD_OUTPUT 436 /* Output file not of proper type */ + +#define ANGLE_TOO_BIG 501 /* celestial angle too large for projection */ +#define BAD_WCS_VAL 502 /* bad celestial coordinate or pixel value */ +#define WCS_ERROR 503 /* error in celestial coordinate calculation */ +#define BAD_WCS_PROJ 504 /* unsupported type of celestial projection */ +#define NO_WCS_KEY 505 /* celestial coordinate keywords not found */ +#define APPROX_WCS_KEY 506 /* approximate WCS keywords were calculated */ + +/*------- following error codes are used in the grparser.c file -----------*/ +#define NGP_ERRBASE (360) /* base chosen so not to interfere with CFITSIO */ +#define NGP_OK (0) +#define NGP_NO_MEMORY (NGP_ERRBASE + 0) /* malloc failed */ +#define NGP_READ_ERR (NGP_ERRBASE + 1) /* read error from file */ +#define NGP_NUL_PTR (NGP_ERRBASE + 2) /* null pointer passed as argument */ +#define NGP_EMPTY_CURLINE (NGP_ERRBASE + 3) /* line read seems to be empty */ +#define NGP_UNREAD_QUEUE_FULL (NGP_ERRBASE + 4) /* cannot unread more then 1 line (or single line twice) */ +#define NGP_INC_NESTING (NGP_ERRBASE + 5) /* too deep include file nesting (inf. loop ?) */ +#define NGP_ERR_FOPEN (NGP_ERRBASE + 6) /* fopen() failed, cannot open file */ +#define NGP_EOF (NGP_ERRBASE + 7) /* end of file encountered */ +#define NGP_BAD_ARG (NGP_ERRBASE + 8) /* bad arguments passed */ +#define NGP_TOKEN_NOT_EXPECT (NGP_ERRBASE + 9) /* token not expected here */ + +/* The following exclusion if __CINT__ is defined is needed for ROOT */ +#ifndef __CINT__ +/* the following 3 lines are needed to support C++ compilers */ +#ifdef __cplusplus +extern "C" { +#endif +#endif + +/*---------------- FITS file URL parsing routines -------------*/ +int fits_get_token(char **ptr, char *delimiter, char *token, int *isanumber); +int ffiurl(char *url, char *urltype, char *infile, + char *outfile, char *extspec, char *rowfilter, + char *binspec, char *colspec, int *status); +int ffrtnm(char *url, char *rootname, int *status); +int ffourl(char *url, char *urltype, char *outfile, char *tmplfile, + int *status); +int ffexts(char *extspec, int *extnum, char *extname, int *extvers, + int *hdutype, char *colname, char *rowexpress, int *status); +int ffextn(char *url, int *extension_num, int *status); +int ffurlt(fitsfile *fptr, char *urlType, int *status); +int ffbins(char *binspec, int *imagetype, int *haxis, + char colname[4][FLEN_VALUE], double *minin, + double *maxin, double *binsizein, + char minname[4][FLEN_VALUE], char maxname[4][FLEN_VALUE], + char binname[4][FLEN_VALUE], double *weight, char *wtname, + int *recip, int *status); +int ffbinr(char **binspec, char *colname, double *minin, + double *maxin, double *binsizein, char *minname, + char *maxname, char *binname, int *status); +int ffimport_file( char *filename, char **contents, int *status ); + +/*---------------- FITS file I/O routines -------------*/ +int ffomem(fitsfile **fptr, const char *name, int mode, void **buffptr, + size_t *buffsize, size_t deltasize, + void *(*mem_realloc)(void *p, size_t newsize), + int *status); +int ffopen(fitsfile **fptr, const char *filename, int iomode, int *status); +int ffreopen(fitsfile *openfptr, fitsfile **newfptr, int *status); +int ffinit(fitsfile **fptr, const char *filename, int *status); +int fftplt(fitsfile **fptr, const char *filename, const char *tempname, + int *status); +int ffflus(fitsfile *fptr, int *status); +int ffclos(fitsfile *fptr, int *status); +int ffdelt(fitsfile *fptr, int *status); +int ffflnm(fitsfile *fptr, char *filename, int *status); +int ffflmd(fitsfile *fptr, int *filemode, int *status); + +/*---------------- utility routines -------------*/ +float ffvers(float *version); +void ffupch(char *string); +void ffgerr(int status, char *errtext); +void ffpmsg(const char *err_message); +int ffgmsg(char *err_message); +void ffcmsg(void); +void ffrprt(FILE *stream, int status); +void ffcmps(char *templt, char *colname, int casesen, int *match, + int *exact); +int fftkey(char *keyword, int *status); +int fftrec(char *card, int *status); +int ffnchk(fitsfile *fptr, int *status); +int ffkeyn(char *keyroot, int value, char *keyname, int *status); +int ffnkey(int value, char *keyroot, char *keyname, int *status); +int ffgkcl(char *card); +int ffdtyp(char *cval, char *dtype, int *status); +int ffpsvc(char *card, char *value, char *comm, int *status); +int ffgknm(char *card, char *name, int *length, int *status); +int ffgthd(char *tmplt, char *card, int *hdtype, int *status); +int ffasfm(char *tform, int *datacode, long *width, int *decim, int *status); +int ffbnfm(char *tform, int *datacode, long *repeat, long *width, int *status); +int ffgabc(int tfields, char **tform, int space, long *rowlen, long *tbcol, + int *status); + +/*----------------- write single keywords --------------*/ +int ffpky(fitsfile *fptr, int datatype, char *keyname, void *value, + char *comm, int *status); +int ffprec(fitsfile *fptr, const char *card, int *status); +int ffpcom(fitsfile *fptr, const char *comm, int *status); +int ffpunt(fitsfile *fptr, char *keyname, char *unit, int *status); +int ffphis(fitsfile *fptr, const char *history, int *status); +int ffpdat(fitsfile *fptr, int *status); +int ffgstm(char *timestr, int *timeref, int *status); +int ffgsdt(int *day, int *month, int *year, int *status); +int ffdt2s(int year, int month, int day, char *datestr, int *status); +int fftm2s(int year, int month, int day, int hour, int minute, double second, + int decimals, char *datestr, int *status); +int ffs2dt(char *datestr, int *year, int *month, int *day, int *status); +int ffs2tm(char *datestr, int *year, int *month, int *day, int *hour, + int *minute, double *second, int *status); +int ffpkyu(fitsfile *fptr, char *keyname, char *comm, int *status); +int ffpkys(fitsfile *fptr, char *keyname, char *value, char *comm,int *status); +int ffpkls(fitsfile *fptr, char *keyname, char *value, char *comm,int *status); +int ffplsw(fitsfile *fptr, int *status); +int ffpkyl(fitsfile *fptr, char *keyname, int value, char *comm, int *status); +int ffpkyj(fitsfile *fptr, char *keyname, long value, char *comm, int *status); +int ffpkyf(fitsfile *fptr, char *keyname, float value, int decim, char *comm, + int *status); +int ffpkye(fitsfile *fptr, char *keyname, float value, int decim, char *comm, + int *status); +int ffpkyg(fitsfile *fptr, char *keyname, double value, int decim, char *comm, + int *status); +int ffpkyd(fitsfile *fptr, char *keyname, double value, int decim, char *comm, + int *status); +int ffpkyc(fitsfile *fptr, char *keyname, float *value, int decim, char *comm, + int *status); +int ffpkym(fitsfile *fptr, char *keyname, double *value, int decim, char *comm, + int *status); +int ffpkfc(fitsfile *fptr, char *keyname, float *value, int decim, char *comm, + int *status); +int ffpkfm(fitsfile *fptr, char *keyname, double *value, int decim, char *comm, + int *status); +int ffpkyt(fitsfile *fptr, char *keyname, long intval, double frac, char *comm, + int *status); +int ffptdm( fitsfile *fptr, int colnum, int naxis, long naxes[], int *status); + +/*----------------- write array of keywords --------------*/ +int ffpkns(fitsfile *fptr, char *keyroot, int nstart, int nkey, char *value[], + char *comm[], int *status); +int ffpknl(fitsfile *fptr, char *keyroot, int nstart, int nkey, int *value, + char *comm[], int *status); +int ffpknj(fitsfile *fptr, char *keyroot, int nstart, int nkey, long *value, + char *comm[], int *status); +int ffpknf(fitsfile *fptr, char *keyroot, int nstart, int nkey, float *value, + int decim, char *comm[], int *status); +int ffpkne(fitsfile *fptr, char *keyroot, int nstart, int nkey, float *value, + int decim, char *comm[], int *status); +int ffpkng(fitsfile *fptr, char *keyroot, int nstart, int nkey, double *value, + int decim, char *comm[], int *status); +int ffpknd(fitsfile *fptr, char *keyroot, int nstart, int nkey, double *value, + int decim, char *comm[], int *status); +int ffcpky(fitsfile *infptr,fitsfile *outfptr,int incol,int outcol, + char *rootname, int *status); + +/*----------------- write required header keywords --------------*/ +int ffphps( fitsfile *fptr, int bitpix, int naxis, long naxes[], int *status); +int ffphpr( fitsfile *fptr, int simple, int bitpix, int naxis, long naxes[], + long pcount, long gcount, int extend, int *status); +int ffphtb(fitsfile *fptr, long naxis1, long naxis2, int tfields, char **ttype, + long *tbcol, char **tform, char **tunit, char *extname, int *status); +int ffphbn(fitsfile *fptr, long naxis2, int tfields, char **ttype, + char **tform, char **tunit, char *extname, long pcount, int *status); + +/*----------------- write template keywords --------------*/ +int ffpktp(fitsfile *fptr, const char *filename, int *status); + +/*------------------ get header information --------------*/ +int ffghsp(fitsfile *fptr, int *nexist, int *nmore, int *status); +int ffghps(fitsfile *fptr, int *nexist, int *position, int *status); + +/*------------------ move position in header -------------*/ +int ffmaky(fitsfile *fptr, int nrec, int *status); +int ffmrky(fitsfile *fptr, int nrec, int *status); + +/*------------------ read single keywords -----------------*/ +int ffgnxk(fitsfile *fptr, char **inclist, int ninc, char **exclist, + int nexc, char *card, int *status); +int ffgrec(fitsfile *fptr, int nrec, char *card, int *status); +int ffgcrd(fitsfile *fptr, char *keyname, char *card, int *status); +int ffgunt(fitsfile *fptr, char *keyname, char *unit, int *status); +int ffgkyn(fitsfile *fptr, int nkey, char *keyname, char *keyval, char *comm, + int *status); +int ffgkey(fitsfile *fptr, char *keyname, char *keyval, char *comm, + int *status); + +int ffgky( fitsfile *fptr, int datatype, char *keyname, void *value, + char *comm, int *status); +int ffgkys(fitsfile *fptr, char *keyname, char *value, char *comm, int *status); +int ffgkls(fitsfile *fptr, char *keyname, char **value, char *comm, int *status) +; +int ffgkyl(fitsfile *fptr, char *keyname, int *value, char *comm, int *status); +int ffgkyj(fitsfile *fptr, char *keyname, long *value, char *comm, int *status); +int ffgkye(fitsfile *fptr, char *keyname, float *value, char *comm,int *status); +int ffgkyd(fitsfile *fptr, char *keyname, double *value,char *comm,int *status); +int ffgkyc(fitsfile *fptr, char *keyname, float *value, char *comm,int *status); +int ffgkym(fitsfile *fptr, char *keyname, double *value,char *comm,int *status); +int ffgkyt(fitsfile *fptr, char *keyname, long *ivalue, double *dvalue, + char *comm, int *status); +int ffgtdm(fitsfile *fptr, int colnum, int maxdim, int *naxis, long naxes[], + int *status); +int ffdtdm(fitsfile *fptr, char *tdimstr, int colnum, int maxdim, + int *naxis, long naxes[], int *status); + +/*------------------ read array of keywords -----------------*/ +int ffgkns(fitsfile *fptr, char *keyname, int nstart, int nmax, char *value[], + int *nfound, int *status); +int ffgknl(fitsfile *fptr, char *keyname, int nstart, int nmax, int *value, + int *nfound, int *status); +int ffgknj(fitsfile *fptr, char *keyname, int nstart, int nmax, long *value, + int *nfound, int *status); +int ffgkne(fitsfile *fptr, char *keyname, int nstart, int nmax, float *value, + int *nfound, int *status); +int ffgknd(fitsfile *fptr, char *keyname, int nstart, int nmax, double *value, + int *nfound, int *status); +int ffh2st(fitsfile *fptr, char **header, int *status); + +/*----------------- read required header keywords --------------*/ +int ffghpr(fitsfile *fptr, int maxdim, int *simple, int *bitpix, int *naxis, + long naxes[], long *pcount, long *gcount, int *extend, int *status); + +int ffghtb(fitsfile *fptr,int maxfield, long *naxis1, long *naxis2, + int *tfields, char **ttype, long *tbcol, char **tform, char **tunit, + char *extname, int *status); + +int ffghbn(fitsfile *fptr, int maxfield, long *naxis2, int *tfields, + char **ttype, char **tform, char **tunit, char *extname, + long *pcount, int *status); + +/*--------------------- update keywords ---------------*/ +int ffuky(fitsfile *fptr, int datatype, char *keyname, void *value, + char *comm, int *status); +int ffucrd(fitsfile *fptr, char *keyname, char *card, int *status); +int ffukyu(fitsfile *fptr, char *keyname, char *comm, int *status); +int ffukys(fitsfile *fptr, char *keyname, char *value, char *comm, int *status); +int ffukls(fitsfile *fptr, char *keyname, char *value, char *comm, int *status); +int ffukyl(fitsfile *fptr, char *keyname, int value, char *comm, int *status); +int ffukyj(fitsfile *fptr, char *keyname, long value, char *comm, int *status); +int ffukyf(fitsfile *fptr, char *keyname, float value, int decim, char *comm, + int *status); +int ffukye(fitsfile *fptr, char *keyname, float value, int decim, char *comm, + int *status); +int ffukyg(fitsfile *fptr, char *keyname, double value, int decim, char *comm, + int *status); +int ffukyd(fitsfile *fptr, char *keyname, double value, int decim, char *comm, + int *status); +int ffukyc(fitsfile *fptr, char *keyname, float *value, int decim, char *comm, + int *status); +int ffukym(fitsfile *fptr, char *keyname, double *value, int decim, char *comm, + int *status); +int ffukfc(fitsfile *fptr, char *keyname, float *value, int decim, char *comm, + int *status); +int ffukfm(fitsfile *fptr, char *keyname, double *value, int decim, char *comm, + int *status); + +/*--------------------- modify keywords ---------------*/ +int ffmrec(fitsfile *fptr, int nkey, char *card, int *status); +int ffmcrd(fitsfile *fptr, char *keyname, char *card, int *status); +int ffmnam(fitsfile *fptr, char *oldname, char *newname, int *status); +int ffmcom(fitsfile *fptr, char *keyname, char *comm, int *status); +int ffmkyu(fitsfile *fptr, char *keyname, char *comm, int *status); +int ffmkys(fitsfile *fptr, char *keyname, char *value, char *comm,int *status); +int ffmkls(fitsfile *fptr, char *keyname, char *value, char *comm,int *status); +int ffmkyl(fitsfile *fptr, char *keyname, int value, char *comm, int *status); +int ffmkyj(fitsfile *fptr, char *keyname, long value, char *comm, int *status); +int ffmkyf(fitsfile *fptr, char *keyname, float value, int decim, char *comm, + int *status); +int ffmkye(fitsfile *fptr, char *keyname, float value, int decim, char *comm, + int *status); +int ffmkyg(fitsfile *fptr, char *keyname, double value, int decim, char *comm, + int *status); +int ffmkyd(fitsfile *fptr, char *keyname, double value, int decim, char *comm, + int *status); +int ffmkyc(fitsfile *fptr, char *keyname, float *value, int decim, char *comm, + int *status); +int ffmkym(fitsfile *fptr, char *keyname, double *value, int decim, char *comm, + int *status); +int ffmkfc(fitsfile *fptr, char *keyname, float *value, int decim, char *comm, + int *status); +int ffmkfm(fitsfile *fptr, char *keyname, double *value, int decim, char *comm, + int *status); + +/*--------------------- insert keywords ---------------*/ +int ffirec(fitsfile *fptr, int nkey, char *card, int *status); +int ffikyu(fitsfile *fptr, char *keyname, char *comm, int *status); +int ffikys(fitsfile *fptr, char *keyname, char *value, char *comm,int *status); +int ffikls(fitsfile *fptr, char *keyname, char *value, char *comm,int *status); +int ffikyl(fitsfile *fptr, char *keyname, int value, char *comm, int *status); +int ffikyj(fitsfile *fptr, char *keyname, long value, char *comm, int *status); +int ffikyf(fitsfile *fptr, char *keyname, float value, int decim, char *comm, + int *status); +int ffikye(fitsfile *fptr, char *keyname, float value, int decim, char *comm, + int *status); +int ffikyg(fitsfile *fptr, char *keyname, double value, int decim, char *comm, + int *status); +int ffikyd(fitsfile *fptr, char *keyname, double value, int decim, char *comm, + int *status); +int ffikyc(fitsfile *fptr, char *keyname, float *value, int decim, char *comm, + int *status); +int ffikym(fitsfile *fptr, char *keyname, double *value, int decim, char *comm, + int *status); +int ffikfc(fitsfile *fptr, char *keyname, float *value, int decim, char *comm, + int *status); +int ffikfm(fitsfile *fptr, char *keyname, double *value, int decim, char *comm, + int *status); + +/*--------------------- delete keywords ---------------*/ +int ffdkey(fitsfile *fptr, char *keyname, int *status); +int ffdrec(fitsfile *fptr, int keypos, int *status); + +/*--------------------- get HDU information -------------*/ +int ffghdn(fitsfile *fptr, int *chdunum); +int ffghdt(fitsfile *fptr, int *exttype, int *status); +int ffghad(fitsfile *fptr, long *headstart, long *datastart, long *dataend, + int *status); +int ffgipr(fitsfile *fptr, int maxaxis, int *imgtype, int *naxis, + long *naxes, int *status); +int ffgidt(fitsfile *fptr, int *imgtype, int *status); +int ffgidm(fitsfile *fptr, int *naxis, int *status); +int ffgisz(fitsfile *fptr, int nlen, long *naxes, int *status); + +/*--------------------- HDU operations -------------*/ +int ffmahd(fitsfile *fptr, int hdunum, int *exttype, int *status); +int ffmrhd(fitsfile *fptr, int hdumov, int *exttype, int *status); +int ffmnhd(fitsfile *fptr, int exttype, char *hduname, int hduvers, + int *status); +int ffthdu(fitsfile *fptr, int *nhdu, int *status); +int ffcrhd(fitsfile *fptr, int *status); +int ffcrim(fitsfile *fptr, int bitpix, int naxis, long *naxes, int *status); +int ffcrtb(fitsfile *fptr, int tbltype, long naxis2, int tfields, char **ttype, + char **tform, char **tunit, char *extname, int *status); +int ffiimg(fitsfile *fptr, int bitpix, int naxis, long *naxes, int *status); +int ffitab(fitsfile *fptr, long naxis1, long naxis2, int tfields, char **ttype, + long *tbcol, char **tform, char **tunit, char *extname, int *status); +int ffibin(fitsfile *fptr,long naxis2, int tfields, char **ttype, char **tform, + char **tunit, char *extname, long pcount, int *status); +int ffrsim(fitsfile *fptr, int bitpix, int naxis, long *naxes, int *status); +int ffdhdu(fitsfile *fptr, int *hdutype, int *status); +int ffcopy(fitsfile *infptr, fitsfile *outfptr, int morekeys, int *status); +int ffcphd(fitsfile *infptr, fitsfile *outfptr, int *status); +int ffcpdt(fitsfile *infptr, fitsfile *outfptr, int *status); +int ffchfl(fitsfile *fptr, int *status); +int ffcdfl(fitsfile *fptr, int *status); + +int ffrdef(fitsfile *fptr, int *status); +int ffhdef(fitsfile *fptr, int morekeys, int *status); +int ffpthp(fitsfile *fptr, long theap, int *status); + +int ffcsum(fitsfile *fptr, long nrec, unsigned long *sum, int *status); +void ffesum(unsigned long sum, int complm, char *ascii); +unsigned long ffdsum(char *ascii, int complm, unsigned long *sum); +int ffpcks(fitsfile *fptr, int *status); +int ffupck(fitsfile *fptr, int *status); +int ffvcks(fitsfile *fptr, int *datastatus, int *hdustatus, int *status); +int ffgcks(fitsfile *fptr, unsigned long *datasum, unsigned long *hdusum, + int *status); + +/*--------------------- define scaling or null values -------------*/ +int ffpscl(fitsfile *fptr, double scale, double zero, int *status); +int ffpnul(fitsfile *fptr, long nulvalue, int *status); +int fftscl(fitsfile *fptr, int colnum, double scale, double zero, int *status); +int fftnul(fitsfile *fptr, int colnum, long nulvalue, int *status); +int ffsnul(fitsfile *fptr, int colnum, char *nulstring, int *status); + +/*--------------------- get column information -------------*/ +int ffgcno(fitsfile *fptr, int casesen, char *templt, int *colnum, + int *status); +int ffgcnn(fitsfile *fptr, int casesen, char *templt, char *colname, + int *colnum, int *status); + +int ffgtcl(fitsfile *fptr, int colnum, int *typecode, long *repeat, + long *width, int *status); +int ffgncl(fitsfile *fptr, int *ncols, int *status); +int ffgnrw(fitsfile *fptr, long *nrows, int *status); +int ffgacl(fitsfile *fptr, int colnum, char *ttype, long *tbcol, + char *tunit, char *tform, double *tscal, double *tzero, + char *tnull, char *tdisp, int *status); +int ffgbcl(fitsfile *fptr, int colnum, char *ttype, char *tunit, + char *dtype, long *repeat, double *tscal, double *tzero, + long *tnull, char *tdisp, int *status); +int ffgrsz(fitsfile *fptr, long *nrows, int *status); +int ffgcdw(fitsfile *fptr, int colnum, int *width, int *status); + +/*--------------------- read primary array or image elements -------------*/ +int ffgpv(fitsfile *fptr, int datatype, long firstelem, long nelem, + void *nulval, void *array, int *anynul, int *status); +int ffgpf(fitsfile *fptr, int datatype, long firstelem, long nelem, + void *array, char *nullarray, int *anynul, int *status); +int ffgpvb(fitsfile *fptr, long group, long firstelem, long nelem, unsigned + char nulval, unsigned char *array, int *anynul, int *status); +int ffgpvui(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned short nulval, unsigned short *array, int *anynul, + int *status); +int ffgpvi(fitsfile *fptr, long group, long firstelem, long nelem, + short nulval, short *array, int *anynul, int *status); +int ffgpvuj(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned long nulval, unsigned long *array, int *anynul, + int *status); +int ffgpvj(fitsfile *fptr, long group, long firstelem, long nelem, + long nulval, long *array, int *anynul, int *status); +int ffgpvuk(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned int nulval, unsigned int *array, int *anynul, int *status); +int ffgpvk(fitsfile *fptr, long group, long firstelem, long nelem, + int nulval, int *array, int *anynul, int *status); +int ffgpve(fitsfile *fptr, long group, long firstelem, long nelem, + float nulval, float *array, int *anynul, int *status); +int ffgpvd(fitsfile *fptr, long group, long firstelem, long nelem, + double nulval, double *array, int *anynul, int *status); + +int ffgpfb(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned char *array, char *nularray, int *anynul, int *status); +int ffgpfui(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned short *array, char *nularray, int *anynul, int *status); +int ffgpfi(fitsfile *fptr, long group, long firstelem, long nelem, + short *array, char *nularray, int *anynul, int *status); +int ffgpfuj(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned long *array, char *nularray, int *anynul, int *status); +int ffgpfj(fitsfile *fptr, long group, long firstelem, long nelem, + long *array, char *nularray, int *anynul, int *status); +int ffgpfuk(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned int *array, char *nularray, int *anynul, int *status); +int ffgpfk(fitsfile *fptr, long group, long firstelem, long nelem, + int *array, char *nularray, int *anynul, int *status); +int ffgpfe(fitsfile *fptr, long group, long firstelem, long nelem, + float *array, char *nularray, int *anynul, int *status); +int ffgpfd(fitsfile *fptr, long group, long firstelem, long nelem, + double *array, char *nularray, int *anynul, int *status); + +int ffg2db(fitsfile *fptr, long group, unsigned char nulval, long ncols, + long naxis1, long naxis2, unsigned char *array, + int *anynul, int *status); +int ffg2dui(fitsfile *fptr, long group, unsigned short nulval, long ncols, + long naxis1, long naxis2, unsigned short *array, + int *anynul, int *status); +int ffg2di(fitsfile *fptr, long group, short nulval, long ncols, + long naxis1, long naxis2, short *array, + int *anynul, int *status); +int ffg2duj(fitsfile *fptr, long group, unsigned long nulval, long ncols, + long naxis1, long naxis2, unsigned long *array, + int *anynul, int *status); +int ffg2dj(fitsfile *fptr, long group, long nulval, long ncols, + long naxis1, long naxis2, long *array, + int *anynul, int *status); +int ffg2duk(fitsfile *fptr, long group, unsigned int nulval, long ncols, + long naxis1, long naxis2, unsigned int *array, + int *anynul, int *status); +int ffg2dk(fitsfile *fptr, long group, int nulval, long ncols, + long naxis1, long naxis2, int *array, + int *anynul, int *status); +int ffg2de(fitsfile *fptr, long group, float nulval, long ncols, + long naxis1, long naxis2, float *array, + int *anynul, int *status); +int ffg2dd(fitsfile *fptr, long group, double nulval, long ncols, + long naxis1, long naxis2, double *array, + int *anynul, int *status); + +int ffg3db(fitsfile *fptr, long group, unsigned char nulval, long ncols, + long nrows, long naxis1, long naxis2, long naxis3, + unsigned char *array, int *anynul, int *status); +int ffg3dui(fitsfile *fptr, long group, unsigned short nulval, long ncols, + long nrows, long naxis1, long naxis2, long naxis3, + unsigned short *array, int *anynul, int *status); +int ffg3di(fitsfile *fptr, long group, short nulval, long ncols, + long nrows, long naxis1, long naxis2, long naxis3, + short *array, int *anynul, int *status); +int ffg3duj(fitsfile *fptr, long group, unsigned long nulval, long ncols, + long nrows, long naxis1, long naxis2, long naxis3, + unsigned long *array, int *anynul, int *status); +int ffg3dj(fitsfile *fptr, long group, long nulval, long ncols, + long nrows, long naxis1, long naxis2, long naxis3, + long *array, int *anynul, int *status); +int ffg3duk(fitsfile *fptr, long group, unsigned int nulval, long ncols, + long nrows, long naxis1, long naxis2, long naxis3, + unsigned int *array, int *anynul, int *status); +int ffg3dk(fitsfile *fptr, long group, int nulval, long ncols, + long nrows, long naxis1, long naxis2, long naxis3, + int *array, int *anynul, int *status); +int ffg3de(fitsfile *fptr, long group, float nulval, long ncols, + long nrows, long naxis1, long naxis2, long naxis3, + float *array, int *anynul, int *status); +int ffg3dd(fitsfile *fptr, long group, double nulval, long ncols, + long nrows, long naxis1, long naxis2, long naxis3, + double *array, int *anynul, int *status); + +int ffgsvb(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, unsigned char nulval, unsigned char *array, + int *anynul, int *status); +int ffgsvui(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, unsigned short nulval, unsigned short *array, + int *anynul, int *status); +int ffgsvi(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, short nulval, short *array, int *anynul, int *status); +int ffgsvuj(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, unsigned long nulval, unsigned long *array, + int *anynul, int *status); +int ffgsvj(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, long nulval, long *array, int *anynul, int *status); +int ffgsvuk(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, unsigned int nulval, unsigned int *array, + int *anynul, int *status); +int ffgsvk(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, int nulval, int *array, int *anynul, int *status); +int ffgsve(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, float nulval, float *array, int *anynul, int *status); +int ffgsvd(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, double nulval, double *array, int *anynul, + int *status); + +int ffgsfb(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, unsigned char *array, char *flagval, + int *anynul, int *status); +int ffgsfui(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, unsigned short *array, char *flagval, int *anynul, + int *status); +int ffgsfi(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, short *array, char *flagval, int *anynul, int *status); +int ffgsfuj(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, unsigned long *array, char *flagval, int *anynul, + int *status); +int ffgsfj(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, long *array, char *flagval, int *anynul, int *status); +int ffgsfuk(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, unsigned int *array, char *flagval, int *anynul, + int *status); +int ffgsfk(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, int *array, char *flagval, int *anynul, int *status); +int ffgsfe(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, float *array, char *flagval, int *anynul, int *status); +int ffgsfd(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, double *array, char *flagval, int *anynul, + int *status); + +int ffggpb(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned char *array, int *status); +int ffggpui(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned short *array, int *status); +int ffggpi(fitsfile *fptr, long group, long firstelem, long nelem, + short *array, int *status); +int ffggpuj(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned long *array, int *status); +int ffggpj(fitsfile *fptr, long group, long firstelem, long nelem, + long *array, int *status); +int ffggpuk(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned int *array, int *status); +int ffggpk(fitsfile *fptr, long group, long firstelem, long nelem, + int *array, int *status); +int ffggpe(fitsfile *fptr, long group, long firstelem, long nelem, + float *array, int *status); +int ffggpd(fitsfile *fptr, long group, long firstelem, long nelem, + double *array, int *status); + +/*--------------------- read column elements -------------*/ +int ffgcv( fitsfile *fptr, int datatype, int colnum, long firstrow, + long firstelem, long nelem, void *nulval, void *array, int *anynul, + int *status); +int ffgcf( fitsfile *fptr, int datatype, int colnum, long firstrow, + long firstelem, long nelem, void *array, char *nullarray, + int *anynul, int *status); +int ffgcvs(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, char *nulval, char **array, int *anynul, int *status); +int ffgcl (fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, char *array, int *status); +int ffgcvl (fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, char nulval, char *array, int *anynul, int *status); +int ffgcvb(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned char nulval, unsigned char *array, + int *anynul, int *status); +int ffgcvui(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned short nulval, unsigned short *array, + int *anynul, int *status); +int ffgcvi(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, short nulval, short *array, int *anynul, int *status); +int ffgcvuj(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned long nulval, unsigned long *array, int *anynul, + int *status); +int ffgcvj(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, long nulval, long *array, int *anynul, int *status); +int ffgcvuk(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned int nulval, unsigned int *array, int *anynul, + int *status); +int ffgcvk(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, int nulval, int *array, int *anynul, int *status); +int ffgcve(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, float nulval, float *array, int *anynul, int *status); +int ffgcvd(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, double nulval, double *array, int *anynul, int *status); +int ffgcvc(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, float nulval, float *array, int *anynul, int *status); +int ffgcvm(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, double nulval, double *array, int *anynul, int *status); +int ffgcx(fitsfile *fptr, int colnum, long firstrow, long firstbit, + long nbits, char *larray, int *status); +int ffgcxui(fitsfile *fptr, int colnum, long firstrow, long nrows, + long firstbit, int nbits, unsigned short *array, int *status); +int ffgcxuk(fitsfile *fptr, int colnum, long firstrow, long nrows, + long firstbit, int nbits, unsigned int *array, int *status); + +int ffgcfs(fitsfile *fptr, int colnum, long firstrow, long firstelem, long + nelem, char **array, char *nularray, int *anynul, int *status); +int ffgcfl(fitsfile *fptr, int colnum, long firstrow, long firstelem, long + nelem, char *array, char *nularray, int *anynul, int *status); +int ffgcfb(fitsfile *fptr, int colnum, long firstrow, long firstelem, long + nelem, unsigned char *array, char *nularray, int *anynul, int *status); +int ffgcfui(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned short *array, char *nularray, int *anynul, + int *status); +int ffgcfi(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, short *array, char *nularray, int *anynul, int *status); +int ffgcfuj(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned long *array, char *nularray, int *anynul, + int *status); +int ffgcfj(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, long *array, char *nularray, int *anynul, int *status); +int ffgcfuk(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned int *array, char *nularray, int *anynul, + int *status); +int ffgcfk(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, int *array, char *nularray, int *anynul, int *status); +int ffgcfe(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, float *array, char *nularray, int *anynul, int *status); +int ffgcfd(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, double *array, char *nularray, int *anynul, int *status); +int ffgcfc(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, float *array, char *nularray, int *anynul, int *status); +int ffgcfm(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, double *array, char *nularray, int *anynul, int *status); + +int ffgdes(fitsfile *fptr, int colnum, long rownum, long *length, + long *heapaddr, int *status); + +int ffgdess(fitsfile *fptr, int colnum, long firstrow, long nrows, long *length, + long *heapaddr, int *status); + +int ffgtbb(fitsfile *fptr, long firstrow, long firstchar, long nchars, + unsigned char *values, int *status); + +/*------------ write primary array or image elements -------------*/ +int ffppr(fitsfile *fptr, int datatype, long firstelem, long nelem, + void *array, int *status); +int ffpprb(fitsfile *fptr, long group, long firstelem, + long nelem, unsigned char *array, int *status); +int ffpprui(fitsfile *fptr, long group, long firstelem, + long nelem, unsigned short *array, int *status); +int ffppri(fitsfile *fptr, long group, long firstelem, + long nelem, short *array, int *status); +int ffppruj(fitsfile *fptr, long group, long firstelem, + long nelem, unsigned long *array, int *status); +int ffpprj(fitsfile *fptr, long group, long firstelem, + long nelem, long *array, int *status); +int ffppruk(fitsfile *fptr, long group, long firstelem, + long nelem, unsigned int *array, int *status); +int ffpprk(fitsfile *fptr, long group, long firstelem, + long nelem, int *array, int *status); +int ffppre(fitsfile *fptr, long group, long firstelem, + long nelem, float *array, int *status); +int ffpprd(fitsfile *fptr, long group, long firstelem, + long nelem, double *array, int *status); + +int ffppru(fitsfile *fptr, long group, long firstelem, long nelem, + int *status); +int ffpprn(fitsfile *fptr, long firstelem, long nelem, int *status); + +int ffppn(fitsfile *fptr, int datatype, long firstelem, long nelem, + void *array, void *nulval, int *status); +int ffppnb(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned char *array, unsigned char nulval, int *status); +int ffppnui(fitsfile *fptr, long group, long firstelem, + long nelem, unsigned short *array, unsigned short nulval, + int *status); +int ffppni(fitsfile *fptr, long group, long firstelem, + long nelem, short *array, short nulval, int *status); +int ffppnj(fitsfile *fptr, long group, long firstelem, + long nelem, long *array, long nulval, int *status); +int ffppnuj(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned long *array, unsigned long nulval, int *status); +int ffppnuk(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned int *array, unsigned int nulval, int *status); +int ffppnk(fitsfile *fptr, long group, long firstelem, + long nelem, int *array, int nulval, int *status); +int ffppne(fitsfile *fptr, long group, long firstelem, + long nelem, float *array, float nulval, int *status); +int ffppnd(fitsfile *fptr, long group, long firstelem, + long nelem, double *array, double nulval, int *status); + +int ffp2db(fitsfile *fptr, long group, long ncols, long naxis1, + long naxis2, unsigned char *array, int *status); +int ffp2dui(fitsfile *fptr, long group, long ncols, long naxis1, + long naxis2, unsigned short *array, int *status); +int ffp2di(fitsfile *fptr, long group, long ncols, long naxis1, + long naxis2, short *array, int *status); +int ffp2duj(fitsfile *fptr, long group, long ncols, long naxis1, + long naxis2, unsigned long *array, int *status); +int ffp2dj(fitsfile *fptr, long group, long ncols, long naxis1, + long naxis2, long *array, int *status); +int ffp2duk(fitsfile *fptr, long group, long ncols, long naxis1, + long naxis2, unsigned int *array, int *status); +int ffp2dk(fitsfile *fptr, long group, long ncols, long naxis1, + long naxis2, int *array, int *status); +int ffp2de(fitsfile *fptr, long group, long ncols, long naxis1, + long naxis2, float *array, int *status); +int ffp2dd(fitsfile *fptr, long group, long ncols, long naxis1, + long naxis2, double *array, int *status); + +int ffp3db(fitsfile *fptr, long group, long ncols, long nrows, long naxis1, + long naxis2, long naxis3, unsigned char *array, int *status); +int ffp3dui(fitsfile *fptr, long group, long ncols, long nrows, long naxis1, + long naxis2, long naxis3, unsigned short *array, int *status); +int ffp3di(fitsfile *fptr, long group, long ncols, long nrows, long naxis1, + long naxis2, long naxis3, short *array, int *status); +int ffp3duj(fitsfile *fptr, long group, long ncols, long nrows, long naxis1, + long naxis2, long naxis3, unsigned long *array, int *status); +int ffp3dj(fitsfile *fptr, long group, long ncols, long nrows, long naxis1, + long naxis2, long naxis3, long *array, int *status); +int ffp3duk(fitsfile *fptr, long group, long ncols, long nrows, long naxis1, + long naxis2, long naxis3, unsigned int *array, int *status); +int ffp3dk(fitsfile *fptr, long group, long ncols, long nrows, long naxis1, + long naxis2, long naxis3, int *array, int *status); +int ffp3de(fitsfile *fptr, long group, long ncols, long nrows, long naxis1, + long naxis2, long naxis3, float *array, int *status); +int ffp3dd(fitsfile *fptr, long group, long ncols, long nrows, long naxis1, + long naxis2, long naxis3, double *array, int *status); + +int ffpssb(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, unsigned char *array, int *status); +int ffpssui(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, unsigned short *array, int *status); +int ffpssi(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, short *array, int *status); +int ffpssuj(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, unsigned long *array, int *status); +int ffpssj(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, long *array, int *status); +int ffpssuk(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, unsigned int *array, int *status); +int ffpssk(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, int *array, int *status); +int ffpsse(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, float *array, int *status); +int ffpssd(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, double *array, int *status); + +int ffpgpb(fitsfile *fptr, long group, long firstelem, + long nelem, unsigned char *array, int *status); +int ffpgpui(fitsfile *fptr, long group, long firstelem, + long nelem, unsigned short *array, int *status); +int ffpgpi(fitsfile *fptr, long group, long firstelem, + long nelem, short *array, int *status); +int ffpgpuj(fitsfile *fptr, long group, long firstelem, + long nelem, unsigned long *array, int *status); +int ffpgpj(fitsfile *fptr, long group, long firstelem, + long nelem, long *array, int *status); +int ffpgpuk(fitsfile *fptr, long group, long firstelem, + long nelem, unsigned int *array, int *status); +int ffpgpk(fitsfile *fptr, long group, long firstelem, + long nelem, int *array, int *status); +int ffpgpe(fitsfile *fptr, long group, long firstelem, + long nelem, float *array, int *status); +int ffpgpd(fitsfile *fptr, long group, long firstelem, + long nelem, double *array, int *status); + +/*--------------------- iterator functions -------------*/ +int fits_iter_set_by_name(iteratorCol *col, fitsfile *fptr, char *colname, + int datatype, int iotype); +int fits_iter_set_by_num(iteratorCol *col, fitsfile *fptr, int colnum, + int datatype, int iotype); +int fits_iter_set_file(iteratorCol *col, fitsfile *fptr); +int fits_iter_set_colname(iteratorCol *col, char *colname); +int fits_iter_set_colnum(iteratorCol *col, int colnum); +int fits_iter_set_datatype(iteratorCol *col, int datatype); +int fits_iter_set_iotype(iteratorCol *col, int iotype); + +fitsfile * fits_iter_get_file(iteratorCol *col); +char * fits_iter_get_colname(iteratorCol *col); +int fits_iter_get_colnum(iteratorCol *col); +int fits_iter_get_datatype(iteratorCol *col); +int fits_iter_get_iotype(iteratorCol *col); +void * fits_iter_get_array(iteratorCol *col); +long fits_iter_get_tlmin(iteratorCol *col); +long fits_iter_get_tlmax(iteratorCol *col); +long fits_iter_get_repeat(iteratorCol *col); +char * fits_iter_get_tunit(iteratorCol *col); +char * fits_iter_get_tdisp(iteratorCol *col); + +int ffiter(int ncols, iteratorCol *data, long offset, long nPerLoop, + int (*workFn)( long totaln, long offset, long firstn, + long nvalues, int narrays, iteratorCol *data, void *userPointer), + void *userPointer, int *status); + +/*--------------------- write column elements -------------*/ +int ffpcl(fitsfile *fptr, int datatype, int colnum, long firstrow, + long firstelem, long nelem, void *array, int *status); +int ffpcls(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, char **array, int *status); +int ffpcll(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, char *array, int *status); +int ffpclb(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned char *array, int *status); +int ffpclui(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned short *array, int *status); +int ffpcli(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, short *array, int *status); +int ffpcluj(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned long *array, int *status); +int ffpclj(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, long *array, int *status); +int ffpcluk(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned int *array, int *status); +int ffpclk(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, int *array, int *status); +int ffpcle(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, float *array, int *status); +int ffpcld(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, double *array, int *status); +int ffpclc(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, float *array, int *status); +int ffpclm(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, double *array, int *status); +int ffpclu(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, int *status); +int ffpclx(fitsfile *fptr, int colnum, long frow, long fbit, long nbit, + char *larray, int *status); + +int ffpcn(fitsfile *fptr, int datatype, int colnum, long firstrow, + long firstelem, long nelem, void *array, void *nulval, int *status); +int ffpcns( fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, char **array, char *nulvalue, int *status); +int ffpcnl( fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, char *array, char nulvalue, int *status); +int ffpcnb(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned char *array, unsigned char nulvalue, + int *status); +int ffpcnui(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned short *array, unsigned short nulvalue, + int *status); +int ffpcni(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, short *array, short nulvalue, int *status); +int ffpcnuj(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned long *array, unsigned long nulvalue, + int *status); +int ffpcnj(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, long *array, long nulvalue, int *status); +int ffpcnuk(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned int *array, unsigned int nulvalue, + int *status); +int ffpcnk(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, int *array, int nulvalue, int *status); +int ffpcne(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, float *array, float nulvalue, int *status); +int ffpcnd(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, double *array, double nulvalue, int *status); + +int ffpdes(fitsfile *fptr, int colnum, long rownum, long length, + long heapaddr, int *status); + +int ffptbb(fitsfile *fptr, long firstrow, long firstchar, long nchars, + unsigned char *values, int *status); + +int ffirow(fitsfile *fptr, long firstrow, long nrows, int *status); +int ffdrow(fitsfile *fptr, long firstrow, long nrows, int *status); +int ffdrws(fitsfile *fptr, long *rownum, long nrows, int *status); +int fficol(fitsfile *fptr, int numcol, char *ttype, char *tform, int *status); +int fficls(fitsfile *fptr, int firstcol, int ncols, char **ttype, + char **tform, int *status); +int ffmvec(fitsfile *fptr, int colnum, long newveclen, int *status); +int ffdcol(fitsfile *fptr, int numcol, int *status); +int ffcpcl(fitsfile *infptr, fitsfile *outfptr, int incol, int outcol, + int create_col, int *status); + +/*--------------------- WCS Utilities ------------------*/ +int ffgics(fitsfile *fptr, double *xrval, double *yrval, double *xrpix, + double *yrpix, double *xinc, double *yinc, double *rot, + char *type, int *status); +int ffgtcs(fitsfile *fptr, int xcol, int ycol, double *xrval, + double *yrval, double *xrpix, double *yrpix, double *xinc, + double *yinc, double *rot, char *type, int *status); +int ffwldp(double xpix, double ypix, double xref, double yref, + double xrefpix, double yrefpix, double xinc, double yinc, + double rot, char *type, double *xpos, double *ypos, int *status); +int ffxypx(double xpos, double ypos, double xref, double yref, + double xrefpix, double yrefpix, double xinc, double yinc, + double rot, char *type, double *xpix, double *ypix, int *status); + +/* WCS support routines (provide interface to Doug Mink's WCS library */ +int ffgiwcs(fitsfile *fptr, char **header, int *status); +int ffgtwcs(fitsfile *fptr, int xcol, int ycol, char **header, int *status); + +/*--------------------- lexical parsing routines ------------------*/ +int fftexp( fitsfile *fptr, char *expr, int maxdim, + int *datatype, long *nelem, int *naxis, + long *naxes, int *status ); + +int fffrow( fitsfile *infptr, char *expr, + long firstrow, long nrows, + long *n_good_rows, char *row_status, int *status); + +int ffffrw( fitsfile *fptr, char *expr, long *rownum, int *status); + +int fffrwc( fitsfile *fptr, char *expr, char *timeCol, + char *parCol, char *valCol, long ntimes, + double *times, char *time_status, int *status ); + +int ffsrow( fitsfile *infptr, fitsfile *outfptr, char *expr, + int *status); + +int ffcrow( fitsfile *fptr, int datatype, char *expr, + long firstrow, long nelements, void *nulval, + void *array, int *anynul, int *status ); + +int ffcalc_rng( fitsfile *infptr, char *expr, fitsfile *outfptr, + char *parName, char *parInfo, int nRngs, + long *start, long *end, int *status ); + +int ffcalc( fitsfile *infptr, char *expr, fitsfile *outfptr, + char *parName, char *parInfo, int *status ); + + /* ffhist is not really intended as a user-callable routine */ + /* but it may be useful for some specialized applications */ + +int ffhist(fitsfile **fptr, char *outfile, int imagetype, int naxis, + char colname[4][FLEN_VALUE], + double *minin, double *maxin, double *binsizein, + char minname[4][FLEN_VALUE], char maxname[4][FLEN_VALUE], + char binname[4][FLEN_VALUE], + double weightin, char wtcol[FLEN_VALUE], + int recip, char *rowselect, int *status); + +int fits_select_image_section(fitsfile **fptr, char *outfile, + char *imagesection, int *status); +int fits_select_section( fitsfile *infptr, fitsfile *outfptr, + char *imagesection, int *status); + +/*--------------------- grouping routines ------------------*/ + +int ffgtcr(fitsfile *fptr, char *grpname, int grouptype, int *status); +int ffgtis(fitsfile *fptr, char *grpname, int grouptype, int *status); +int ffgtch(fitsfile *gfptr, int grouptype, int *status); +int ffgtrm(fitsfile *gfptr, int rmopt, int *status); +int ffgtcp(fitsfile *infptr, fitsfile *outfptr, int cpopt, int *status); +int ffgtmg(fitsfile *infptr, fitsfile *outfptr, int mgopt, int *status); +int ffgtcm(fitsfile *gfptr, int cmopt, int *status); +int ffgtvf(fitsfile *gfptr, long *firstfailed, int *status); +int ffgtop(fitsfile *mfptr,int group,fitsfile **gfptr,int *status); +int ffgtam(fitsfile *gfptr, fitsfile *mfptr, int hdupos, int *status); +int ffgtnm(fitsfile *gfptr, long *nmembers, int *status); +int ffgmng(fitsfile *mfptr, long *nmembers, int *status); +int ffgmop(fitsfile *gfptr, long member, fitsfile **mfptr, int *status); +int ffgmcp(fitsfile *gfptr, fitsfile *mfptr, long member, int cpopt, + int *status); +int ffgmtf(fitsfile *infptr, fitsfile *outfptr, long member, int tfopt, + int *status); +int ffgmrm(fitsfile *fptr, long member, int rmopt, int *status); + +/*--------------------- group template parser routines ------------------*/ + +int fits_execute_template(fitsfile *ff, char *ngp_template, int *status); + +/*--------------------- image compression routines ------------------*/ + +int fits_comp_img(fitsfile *infptr, fitsfile *outfptr, int compress_type, + long *tilesize, int parm1, int parm2, int *status); +int fits_is_compressed_image(fitsfile *fptr, int *status); +int fits_decomp_img (fitsfile *infptr, fitsfile *outfptr, int *status); +int fits_read_compressed_img(fitsfile *fptr, + int datatype, long *fpixel,long *lpixel,long *inc, + int nullcheck, void *nulval, void *array, char *nullarray, + int *anynul, int *status); + +int fits_read_compressed_pixels(fitsfile *fptr, + int datatype, long fpixel, long npixels, + int nullcheck, void *nulval, void *array, char *nullarray, + int *anynul, int *status); + +int fits_quantize_float (float fdata[], int nx, float in_null_value, + int noise_bits, int idata[], double *bscale, double *bzero, + int *iminval, int *imaxval); +int fits_quantize_double (double fdata[], int nx, double in_null_value, + int noise_bits, int idata[], double *bscale, double *bzero, + int *iminval, int *imaxval); +int fits_rcomp(int a[], int nx, unsigned char *c, int clen,int nblock); +int fits_rdecomp (unsigned char *c, int clen, unsigned int array[], int nx, + int nblock); + +/* The following exclusion if __CINT__ is defined is needed for ROOT */ +#ifndef __CINT__ +#ifdef __cplusplus +} +#endif +#endif + +#endif + diff --git a/include/cfitsio/fitsio2.h b/include/cfitsio/fitsio2.h new file mode 100644 index 0000000..5636cc3 --- /dev/null +++ b/include/cfitsio/fitsio2.h @@ -0,0 +1,870 @@ +#ifndef _FITSIO2_H +#define _FITSIO2_H + +#include "fitsio.h" + +#define DBUFFSIZE 28800 /* size of data buffer in bytes */ + +#define NIOBUF 25 /* number of IO buffers to create */ +#define IOBUFLEN 2880 /* size in bytes of each IO buffer */ +#define MINDIRECT 8640 /* minimum size for direct reads and writes */ + /* MINDIRECT must have a value >= 8640 */ + +#define NATIVE 0 /* a generic machine that uses IEEE formats */ +#define ULTRIX 1 +#define ALPHA_OSF 2 +#define VAXVMS 3 +#define ALPHAVMS 4 +#define IBMPC 5 +#define CRAY 6 + +#define GFLOAT 1 +#define IEEEFLOAT 2 + +/* the following are used to determine what type machine we are running on */ + +/* the following block determines the size of longs on SGI IRIX machines */ +#if defined(_MIPS_SZLONG) +# if _MIPS_SZLONG == 32 +# define LONGSIZE 32 +# elif _MIPS_SZLONG == 64 +# define LONGSIZE 64 +# else +# error "can't handle long size given by _MIPS_SZLONG" +# endif +#endif + +#if defined(vax) && defined(VMS) + +#define MACHINE VAXVMS +#define BYTESWAPPED TRUE + +#elif defined(__alpha) && defined(__VMS) + +#if (__D_FLOAT == TRUE) + +/* this float option is the same as for VAX/VMS machines. */ +#define MACHINE VAXVMS +#define BYTESWAPPED TRUE + +#elif (__G_FLOAT == TRUE) + +/* G_FLOAT is the default for ALPHA VMS systems */ +#define MACHINE ALPHAVMS +#define BYTESWAPPED TRUE +#define FLOATTYPE GFLOAT + +#elif (__IEEE_FLOAT == TRUE) + +#define MACHINE ALPHAVMS +#define BYTESWAPPED TRUE +#define FLOATTYPE IEEEFLOAT + +#endif + +#elif defined(__alpha) && defined(__unix__) + +#define MACHINE ALPHA_OSF +#define BYTESWAPPED TRUE +#define LONGSIZE 64 + +#elif defined(ultrix) && defined(unix) + +#define MACHINE ULTRIX +#define BYTESWAPPED TRUE + +#elif defined(__i386) || defined(__i386__) || defined(__i486__) || defined(__i586__) + +/* IBM PC */ +#define MACHINE IBMPC +#define BYTESWAPPED TRUE + +#elif defined(_MSC_VER) || defined(__BORLANDC__) || defined(__TURBOC__) + +/* IBM PC running DOS or Windows */ +#define MACHINE IBMPC +#define BYTESWAPPED TRUE + +#elif defined(_NI_mswin_) + +/* LabWindows/CVI with Windows 3.x, 95, or NT */ +#define MACHINE IBMPC +#define BYTESWAPPED TRUE + +#elif defined(__EMX__) + +/* IBM PC running OS/2 */ +#define MACHINE IBMPC +#define BYTESWAPPED TRUE + +#elif defined(__sparcv9) + +/* SUN Solaris7 in 64-bit mode */ +#define BYTESWAPPED FALSE +#define MACHINE NATIVE +#define LONGSIZE 64 + +#else + +/* assume machine uses the same IEEE formats as used in FITS files */ +#define MACHINE NATIVE +#define BYTESWAPPED FALSE + +#endif + +/* assume longs are 4 bytes long, unless previously set otherwise */ +#ifndef LONGSIZE +#define LONGSIZE 32 +#endif + +#define IGNORE_EOF 1 +#define REPORT_EOF 0 +#define DATA_UNDEFINED -1 +#define NULL_UNDEFINED 1234554321 +#define ASCII_NULL_UNDEFINED 1 /* indicate no defined null value */ + +#define maxvalue(A,B) ((A) > (B) ? (A) : (B)) +#define minvalue(A,B) ((A) < (B) ? (A) : (B)) + +#define FSTRCMP(a,b) ((a)[0]<(b)[0]? -1:(a)[0]>(b)[0]?1:strcmp((a),(b))) +#define FSTRNCMP(a,b,n) ((a)[0]<(b)[0]?-1:(a)[0]>(b)[0]?1:strncmp((a),(b),(n))) + +#if defined(__VMS) || defined(VMS) + +#define FNANMASK 0xFFFF /* mask all bits */ +#define DNANMASK 0xFFFF /* mask all bits */ + +#else + +#define FNANMASK 0x7F80 /* mask bits 1 - 8; all set on NaNs */ + /* all 0 on underflow or 0. */ + +#define DNANMASK 0x7FF0 /* mask bits 1 - 11; all set on NaNs */ + /* all 0 on underflow or 0. */ + +#endif + +#if MACHINE == CRAY + /* + Cray machines: the large negative integer corresponds + to the 3 most sig digits set to 1. If these + 3 bits are set in a floating point number (64 bits), then it represents + a reserved value (i.e., a NaN) + */ +#define fnan(L) ( (L) >= 0xE000000000000000 ? 1 : 0) ) + +#else + /* these functions work for both big and little endian machines */ + /* that use the IEEE floating point format for internal numbers */ + + /* These functions tests whether the float value is a reserved IEEE */ + /* value such as a Not-a-Number (NaN), or underflow, overflow, or */ + /* infinity. The functions returns 1 if the value is a NaN, overflow */ + /* or infinity; it returns 2 if the value is an denormalized underflow */ + /* value; otherwise it returns 0. fnan tests floats, dnan tests doubles */ + +#define fnan(L) \ + ( (L & FNANMASK) == FNANMASK ? 1 : (L & FNANMASK) == 0 ? 2 : 0) + +#define dnan(L) \ + ( (L & DNANMASK) == DNANMASK ? 1 : (L & DNANMASK) == 0 ? 2 : 0) + +#endif + +#define DUCHAR_MAX 255.49 /* max double value that fits in an unsigned char */ +#define DUCHAR_MIN -0.49 /* min double value that fits in an unsigned char */ +#define DUSHRT_MAX 65535.49 /* max double value that fits in a unsigned short*/ +#define DUSHRT_MIN -0.49 /* min double value that fits in an unsigned short */ +#define DSHRT_MAX 32767.49 /* max double value that fits in a short */ +#define DSHRT_MIN -32768.49 /* min double value that fits in a short */ +#define DULONG_MAX 4294967295.49 /* max double that fits in a unsigned long */ +#define DULONG_MIN -0.49 /* min double value that fits in an unsigned long */ +#define DLONG_MAX 2147483647.49 /* max double value that fits in a long */ +#define DLONG_MIN -2147483648.49 /* min double value that fits in a long */ +#define DUINT_MAX 4294967295.49 /* max dbl that fits in a unsigned 4-byte int */ +#define DUINT_MIN -0.49 /* min dbl that fits in an unsigned 4-byte int */ +#define DINT_MAX 2147483647.49 /* max double value that fits in a 4-byte int */ +#define DINT_MIN -2147483648.49 /* min double value that fits in a 4-byte int */ + +#ifndef UINT32_MAX +#define UINT32_MAX 4294967295U /* max unsigned 32-bit integer */ +#endif +#ifndef INT32_MAX +#define INT32_MAX 2147483647 /* max 32-bit integer */ +#endif +#ifndef INT32_MIN +#define INT32_MIN -2147483647 /* min 32-bit integer */ +#endif + +#define COMPRESS_NULL_VALUE -2147483647 + +int ffmkky(char *keyname, char *keyval, char *comm, char *card, int *status); +int ffgnky(fitsfile *fptr, char *card, int *status); +void ffcfmt(char *tform, char *cform); +void ffcdsp(char *tform, char *cform); +void ffswap2(short *values, long nvalues); +void ffswap4(INT32BIT *values, long nvalues); +void ffswap8(double *values, long nvalues); +int ffi2c(long ival, char *cval, int *status); +int ffl2c(int lval, char *cval, int *status); +int ffs2c(char *instr, char *outstr, int *status); +int ffr2f(float fval, int decim, char *cval, int *status); +int ffr2e(float fval, int decim, char *cval, int *status); +int ffd2f(double dval, int decim, char *cval, int *status); +int ffd2e(double dval, int decim, char *cval, int *status); +int ffc2ii(char *cval, long *ival, int *status); +int ffc2ll(char *cval, int *lval, int *status); +int ffc2rr(char *cval, float *fval, int *status); +int ffc2dd(char *cval, double *dval, int *status); +int ffc2x(char *cval, char *dtype, long *ival, int *lval, char *sval, + double *dval, int *status); +int ffc2s(char *instr, char *outstr, int *status); +int ffc2i(char *cval, long *ival, int *status); +int ffc2r(char *cval, float *fval, int *status); +int ffc2d(char *cval, double *dval, int *status); +int ffc2l(char *cval, int *lval, int *status); +void ffxmsg(int action, char *err_message); +int ffgcnt(fitsfile *fptr, char *value, int *status); +int ffgtkn(fitsfile *fptr, int numkey, char *keyname, long *value, int *status); +int fftkyn(fitsfile *fptr, int numkey, char *keyname, char *value, int *status); +int ffgphd(fitsfile *fptr, int maxdim, int *simple, int *bitpix, int *naxis, + long naxes[], long *pcount, long *gcount, int *extend, double *bscale, + double *bzero, long *blank, int *nspace, int *status); +int ffgttb(fitsfile *fptr, long *rowlen, long *nrows, long *pcount, + long *tfield, int *status); + +int ffmkey(fitsfile *fptr, char *card, int *status); +int ffikey(fitsfile *fptr, char *card, int *status); + +int ffmbyt(fitsfile *fptr, long bytpos, int ignore_err, int *status); +int ffgbyt(fitsfile *fptr, long nbytes, void *buffer, int *status); +int ffpbyt(fitsfile *fptr, long nbytes, void *buffer, int *status); +int ffgbytoff(fitsfile *fptr, long gsize, long ngroups, long offset, + void *buffer, int *status); +int ffpbytoff(fitsfile *fptr, long gsize, long ngroups, long offset, + void *buffer, int *status); +int ffldrc(fitsfile *fptr, long record, int err_mode, int *status); +int ffwhbf(fitsfile *fptr, int *nbuff); +int ffcurbuf(int nbuff, FITSfile **Fptr); +int ffflsh(fitsfile *fptr, int clearbuf, int *status); +int ffbfeof(fitsfile *fptr, int *status); +int ffbfwt(int nbuff, int *status); +int fits_get_num_files(void); +int ffpxsz(int datatype); + +int ffoptplt(fitsfile *fptr, const char *tempname, int *status); +int fits_is_this_a_copy(char *urltype); +int fits_already_open(fitsfile **fptr, char *url, + char *urltype, char *infile, char *extspec, char *rowfilter, + char *binspec, char *colspec, int mode,int *isopen, int *status); +int ffedit_columns(fitsfile **fptr, char *outfile, char *expr, int *status); +int fits_get_col_minmax(fitsfile *fptr, int colnum, float *datamin, + float *datamax, int *status); +int ffwritehisto(long totaln, long offset, long firstn, long nvalues, + int narrays, iteratorCol *imagepars, void *userPointer); +int ffcalchist(long totalrows, long offset, long firstrow, long nrows, + int ncols, iteratorCol *colpars, void *userPointer); +int fits_copy_image_cell(fitsfile **fptr, char *outfile, char *colname, + long rownum, int *status); +int fits_copy_image_keywords(fitsfile *infptr, fitsfile *outfptr, int *status); +int fits_get_section_range(char **ptr,long *secmin,long *secmax,long *incre, + int *status); +int ffrhdu(fitsfile *fptr, int *hdutype, int *status); +int ffpinit(fitsfile *fptr, int *status); +int ffainit(fitsfile *fptr, int *status); +int ffbinit(fitsfile *fptr, int *status); +int ffchdu(fitsfile *fptr, int *status); +int ffwend(fitsfile *fptr, int *status); +int ffpdfl(fitsfile *fptr, int *status); +int ffuptf(fitsfile *fptr, int *status); + +int ffdblk(fitsfile *fptr, long nblocks, int *status); +int ffgext(fitsfile *fptr, int moveto, int *exttype, int *status); +int ffgtbc(fitsfile *fptr, long *totalwidth, int *status); +int ffgtbp(fitsfile *fptr, char *name, char *value, int *status); +int ffiblk(fitsfile *fptr, long nblock, int headdata, int *status); +int ffshft(fitsfile *fptr, long firstbyte, long nbytes, long nshift, + int *status); + +int ffgcpr(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, int writemode, double *scale, double *zero, char *tform, + long *twidth, int *tcode, int *maxelem, long *startpos, + long *elemnum, long *incre, long *repeat,long *rowlen, + int *hdutype, long *tnull, char *snull, int *status); + +int ffflushx(FITSfile *fptr); +int ffseek(FITSfile *fptr, long position); +int ffread(FITSfile *fptr, long nbytes, void *buffer, + int *status); +int ffwrite(FITSfile *fptr, long nbytes, void *buffer, + int *status); +int fftrun(fitsfile *fptr, long filesize, int *status); + +int ffgcll(fitsfile *fptr, int colnum, long firstrow, long firstelem, long + nelem, int nultyp, char nulval, char *array, char *nularray, + int *anynul, int *status); +int ffgcls(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, int nultyp, char *nulval, + char **array, char *nularray, int *anynul, int *status); +int ffgcls2(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, int nultyp, char *nulval, + char **array, char *nularray, int *anynul, int *status); +int ffgclb(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, long elemincre, int nultyp, unsigned char nulval, + unsigned char *array, char *nularray, int *anynul, int *status); +int ffgclui(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, long elemincre, int nultyp, unsigned short nulval, + unsigned short *array, char *nularray, int *anynul, int *status); +int ffgcli(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, long elemincre, int nultyp, short nulval, + short *array, char *nularray, int *anynul, int *status); +int ffgcluj(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, long elemincre, int nultyp, unsigned long nulval, + unsigned long *array, char *nularray, int *anynul, int *status); +int ffgclj(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, long elemincre, int nultyp, long nulval, long *array, + char *nularray, int *anynul, int *status); +int ffgcluk(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, long elemincre, int nultyp, unsigned int nulval, + unsigned int *array, char *nularray, int *anynul, int *status); +int ffgclk(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, long elemincre, int nultyp, int nulval, int *array, + char *nularray, int *anynul, int *status); +int ffgcle(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, long elemincre, int nultyp, float nulval, float *array, + char *nularray, int *anynul, int *status); +int ffgcld(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, long elemincre, int nultyp, double nulval, + double *array, char *nularray, int *anynul, int *status); + +int ffpi1b(fitsfile *fptr, long nelem, long incre, unsigned char *buffer, + int *status); +int ffpi2b(fitsfile *fptr, long nelem, long incre, short *buffer, int *status); +int ffpi4b(fitsfile *fptr, long nelem, long incre, INT32BIT *buffer, + int *status); +int ffpr4b(fitsfile *fptr, long nelem, long incre, float *buffer, int *status); +int ffpr8b(fitsfile *fptr, long nelem, long incre, double *buffer, int *status); + +int ffgi1b(fitsfile *fptr, long pos, long nelem, long incre, + unsigned char *buffer, int *status); +int ffgi2b(fitsfile *fptr, long pos, long nelem, long incre, short *buffer, + int *status); +int ffgi4b(fitsfile *fptr, long pos, long nelem, long incre, INT32BIT *buffer, + int *status); +int ffgr4b(fitsfile *fptr, long pos, long nelem, long incre, float *buffer, + int *status); +int ffgr8b(fitsfile *fptr, long pos, long nelem, long incre, double *buffer, + int *status); + +int ffcins(fitsfile *fptr, long naxis1, long naxis2, long nbytes, + long bytepos, int *status); +int ffcdel(fitsfile *fptr, long naxis1, long naxis2, long nbytes, + long bytepos, int *status); +int ffkshf(fitsfile *fptr, int firstcol, int tfields, int nshift, int *status); + +int fffi1i1(unsigned char *input, long ntodo, double scale, double zero, + int nullcheck, unsigned char tnull, unsigned char nullval, char + *nullarray, int *anynull, unsigned char *output, int *status); +int fffi2i1(short *input, long ntodo, double scale, double zero, + int nullcheck, short tnull, unsigned char nullval, char *nullarray, + int *anynull, unsigned char *output, int *status); +int fffi4i1(INT32BIT *input, long ntodo, double scale, double zero, + int nullcheck, INT32BIT tnull, unsigned char nullval, char *nullarray, + int *anynull, unsigned char *output, int *status); +int fffr4i1(float *input, long ntodo, double scale, double zero, + int nullcheck, unsigned char nullval, char *nullarray, + int *anynull, unsigned char *output, int *status); +int fffr8i1(double *input, long ntodo, double scale, double zero, + int nullcheck, unsigned char nullval, char *nullarray, + int *anynull, unsigned char *output, int *status); +int fffstri1(char *input, long ntodo, double scale, double zero, + long twidth, double power, int nullcheck, char *snull, + unsigned char nullval, char *nullarray, int *anynull, + unsigned char *output, int *status); + +int fffi1u2(unsigned char *input, long ntodo, double scale, double zero, + int nullcheck, unsigned char tnull, unsigned short nullval, + char *nullarray, + int *anynull, unsigned short *output, int *status); +int fffi2u2(short *input, long ntodo, double scale, double zero, + int nullcheck, short tnull, unsigned short nullval, char *nullarray, + int *anynull, unsigned short *output, int *status); +int fffi4u2(INT32BIT *input, long ntodo, double scale, double zero, + int nullcheck, INT32BIT tnull, unsigned short nullval, char *nullarray, + int *anynull, unsigned short *output, int *status); +int fffr4u2(float *input, long ntodo, double scale, double zero, + int nullcheck, unsigned short nullval, char *nullarray, + int *anynull, unsigned short *output, int *status); +int fffr8u2(double *input, long ntodo, double scale, double zero, + int nullcheck, unsigned short nullval, char *nullarray, + int *anynull, unsigned short *output, int *status); +int fffstru2(char *input, long ntodo, double scale, double zero, + long twidth, double power, int nullcheck, char *snull, + unsigned short nullval, char *nullarray, int *anynull, + unsigned short *output, int *status); + +int fffi1i2(unsigned char *input, long ntodo, double scale, double zero, + int nullcheck, unsigned char tnull, short nullval, char *nullarray, + int *anynull, short *output, int *status); +int fffi2i2(short *input, long ntodo, double scale, double zero, + int nullcheck, short tnull, short nullval, char *nullarray, + int *anynull, short *output, int *status); +int fffi4i2(INT32BIT *input, long ntodo, double scale, double zero, + int nullcheck, INT32BIT tnull, short nullval, char *nullarray, + int *anynull, short *output, int *status); +int fffr4i2(float *input, long ntodo, double scale, double zero, + int nullcheck, short nullval, char *nullarray, + int *anynull, short *output, int *status); +int fffr8i2(double *input, long ntodo, double scale, double zero, + int nullcheck, short nullval, char *nullarray, + int *anynull, short *output, int *status); +int fffstri2(char *input, long ntodo, double scale, double zero, + long twidth, double power, int nullcheck, char *snull, + short nullval, char *nullarray, int *anynull, short *output, + int *status); + +int fffi1u4(unsigned char *input, long ntodo, double scale, double zero, + int nullcheck, unsigned char tnull, unsigned long nullval, + char *nullarray, + int *anynull, unsigned long *output, int *status); +int fffi2u4(short *input, long ntodo, double scale, double zero, + int nullcheck, short tnull, unsigned long nullval, char *nullarray, + int *anynull, unsigned long *output, int *status); +int fffi4u4(INT32BIT *input, long ntodo, double scale, double zero, + int nullcheck, INT32BIT tnull, unsigned long nullval, char *nullarray, + int *anynull, unsigned long *output, int *status); +int fffr4u4(float *input, long ntodo, double scale, double zero, + int nullcheck, unsigned long nullval, char *nullarray, + int *anynull, unsigned long *output, int *status); +int fffr8u4(double *input, long ntodo, double scale, double zero, + int nullcheck, unsigned long nullval, char *nullarray, + int *anynull, unsigned long *output, int *status); +int fffstru4(char *input, long ntodo, double scale, double zero, + long twidth, double power, int nullcheck, char *snull, + unsigned long nullval, char *nullarray, int *anynull, + unsigned long *output, int *status); + +int fffi1i4(unsigned char *input, long ntodo, double scale, double zero, + int nullcheck, unsigned char tnull, long nullval, char *nullarray, + int *anynull, long *output, int *status); +int fffi2i4(short *input, long ntodo, double scale, double zero, + int nullcheck, short tnull, long nullval, char *nullarray, + int *anynull, long *output, int *status); +int fffi4i4(INT32BIT *input, long ntodo, double scale, double zero, + int nullcheck, INT32BIT tnull, long nullval, char *nullarray, + int *anynull, long *output, int *status); +int fffr4i4(float *input, long ntodo, double scale, double zero, + int nullcheck, long nullval, char *nullarray, + int *anynull, long *output, int *status); +int fffr8i4(double *input, long ntodo, double scale, double zero, + int nullcheck, long nullval, char *nullarray, + int *anynull, long *output, int *status); +int fffstri4(char *input, long ntodo, double scale, double zero, + long twidth, double power, int nullcheck, char *snull, + long nullval, char *nullarray, int *anynull, long *output, + int *status); + +int fffi1int(unsigned char *input, long ntodo, double scale, double zero, + int nullcheck, unsigned char tnull, int nullval, char *nullarray, + int *anynull, int *output, int *status); +int fffi2int(short *input, long ntodo, double scale, double zero, + int nullcheck, short tnull, int nullval, char *nullarray, + int *anynull, int *output, int *status); +int fffi4int(INT32BIT *input, long ntodo, double scale, double zero, + int nullcheck, INT32BIT tnull, int nullval, char *nullarray, + int *anynull, int *output, int *status); +int fffr4int(float *input, long ntodo, double scale, double zero, + int nullcheck, int nullval, char *nullarray, + int *anynull, int *output, int *status); +int fffr8int(double *input, long ntodo, double scale, double zero, + int nullcheck, int nullval, char *nullarray, + int *anynull, int *output, int *status); +int fffstrint(char *input, long ntodo, double scale, double zero, + long twidth, double power, int nullcheck, char *snull, + int nullval, char *nullarray, int *anynull, int *output, + int *status); + +int fffi1uint(unsigned char *input, long ntodo, double scale, double zero, + int nullcheck, unsigned char tnull, unsigned int nullval, + char *nullarray, int *anynull, unsigned int *output, int *status); +int fffi2uint(short *input, long ntodo, double scale, double zero, + int nullcheck, short tnull, unsigned int nullval, char *nullarray, + int *anynull, unsigned int *output, int *status); +int fffi4uint(INT32BIT *input, long ntodo, double scale, double zero, + int nullcheck, INT32BIT tnull, unsigned int nullval, char *nullarray, + int *anynull, unsigned int *output, int *status); +int fffr4uint(float *input, long ntodo, double scale, double zero, + int nullcheck, unsigned int nullval, char *nullarray, + int *anynull, unsigned int *output, int *status); +int fffr8uint(double *input, long ntodo, double scale, double zero, + int nullcheck, unsigned int nullval, char *nullarray, + int *anynull, unsigned int *output, int *status); +int fffstruint(char *input, long ntodo, double scale, double zero, + long twidth, double power, int nullcheck, char *snull, + unsigned int nullval, char *nullarray, int *anynull, + unsigned int *output, int *status); + +int fffi1r4(unsigned char *input, long ntodo, double scale, double zero, + int nullcheck, unsigned char tnull, float nullval, char *nullarray, + int *anynull, float *output, int *status); +int fffi2r4(short *input, long ntodo, double scale, double zero, + int nullcheck, short tnull, float nullval, char *nullarray, + int *anynull, float *output, int *status); +int fffi4r4(INT32BIT *input, long ntodo, double scale, double zero, + int nullcheck, INT32BIT tnull, float nullval, char *nullarray, + int *anynull, float *output, int *status); +int fffr4r4(float *input, long ntodo, double scale, double zero, + int nullcheck, float nullval, char *nullarray, + int *anynull, float *output, int *status); +int fffr8r4(double *input, long ntodo, double scale, double zero, + int nullcheck, float nullval, char *nullarray, + int *anynull, float *output, int *status); +int fffstrr4(char *input, long ntodo, double scale, double zero, + long twidth, double power, int nullcheck, char *snull, + float nullval, char *nullarray, int *anynull, float *output, + int *status); + +int fffi1r8(unsigned char *input, long ntodo, double scale, double zero, + int nullcheck, unsigned char tnull, double nullval, char *nullarray, + int *anynull, double *output, int *status); +int fffi2r8(short *input, long ntodo, double scale, double zero, + int nullcheck, short tnull, double nullval, char *nullarray, + int *anynull, double *output, int *status); +int fffi4r8(INT32BIT *input, long ntodo, double scale, double zero, + int nullcheck, INT32BIT tnull, double nullval, char *nullarray, + int *anynull, double *output, int *status); +int fffr4r8(float *input, long ntodo, double scale, double zero, + int nullcheck, double nullval, char *nullarray, + int *anynull, double *output, int *status); +int fffr8r8(double *input, long ntodo, double scale, double zero, + int nullcheck, double nullval, char *nullarray, + int *anynull, double *output, int *status); +int fffstrr8(char *input, long ntodo, double scale, double zero, + long twidth, double power, int nullcheck, char *snull, + double nullval, char *nullarray, int *anynull, double *output, + int *status); + +int ffi1fi1(unsigned char *array, long ntodo, double scale, double zero, + unsigned char *buffer, int *status); +int ffu2fi1(unsigned short *array, long ntodo, double scale, double zero, + unsigned char *buffer, int *status); +int ffi2fi1(short *array, long ntodo, double scale, double zero, + unsigned char *buffer, int *status); +int ffu4fi1(unsigned long *array, long ntodo, double scale, double zero, + unsigned char *buffer, int *status); +int ffi4fi1(long *array, long ntodo, double scale, double zero, + unsigned char *buffer, int *status); +int ffuintfi1(unsigned int *array, long ntodo, double scale, double zero, + unsigned char *buffer, int *status); +int ffintfi1(int *array, long ntodo, double scale, double zero, + unsigned char *buffer, int *status); +int ffr4fi1(float *array, long ntodo, double scale, double zero, + unsigned char *buffer, int *status); +int ffr8fi1(double *array, long ntodo, double scale, double zero, + unsigned char *buffer, int *status); + +int ffi1fi2(unsigned char *array, long ntodo, double scale, double zero, + short *buffer, int *status); +int ffu2fi2(unsigned short *array, long ntodo, double scale, double zero, + short *buffer, int *status); +int ffi2fi2(short *array, long ntodo, double scale, double zero, + short *buffer, int *status); +int ffu4fi2(unsigned long *array, long ntodo, double scale, double zero, + short *buffer, int *status); +int ffi4fi2(long *array, long ntodo, double scale, double zero, + short *buffer, int *status); +int ffuintfi2(unsigned int *array, long ntodo, double scale, double zero, + short *buffer, int *status); +int ffintfi2(int *array, long ntodo, double scale, double zero, + short *buffer, int *status); +int ffr4fi2(float *array, long ntodo, double scale, double zero, + short *buffer, int *status); +int ffr8fi2(double *array, long ntodo, double scale, double zero, + short *buffer, int *status); + +int ffi1fi4(unsigned char *array, long ntodo, double scale, double zero, + INT32BIT *buffer, int *status); +int ffu2fi4(unsigned short *array, long ntodo, double scale, double zero, + INT32BIT *buffer, int *status); +int ffi2fi4(short *array, long ntodo, double scale, double zero, + INT32BIT *buffer, int *status); +int ffu4fi4(unsigned long *array, long ntodo, double scale, double zero, + INT32BIT *buffer, int *status); +int ffi4fi4(long *array, long ntodo, double scale, double zero, + INT32BIT *buffer, int *status); +int ffuintfi4(unsigned int *array, long ntodo, double scale, double zero, + INT32BIT *buffer, int *status); +int ffintfi4(int *array, long ntodo, double scale, double zero, + INT32BIT *buffer, int *status); +int ffr4fi4(float *array, long ntodo, double scale, double zero, + INT32BIT *buffer, int *status); +int ffr8fi4(double *array, long ntodo, double scale, double zero, + INT32BIT *buffer, int *status); + +int ffi1fr4(unsigned char *array, long ntodo, double scale, double zero, + float *buffer, int *status); +int ffu2fr4(unsigned short *array, long ntodo, double scale, double zero, + float *buffer, int *status); +int ffi2fr4(short *array, long ntodo, double scale, double zero, + float *buffer, int *status); +int ffu4fr4(unsigned long *array, long ntodo, double scale, double zero, + float *buffer, int *status); +int ffi4fr4(long *array, long ntodo, double scale, double zero, + float *buffer, int *status); +int ffuintfr4(unsigned int *array, long ntodo, double scale, double zero, + float *buffer, int *status); +int ffintfr4(int *array, long ntodo, double scale, double zero, + float *buffer, int *status); +int ffr4fr4(float *array, long ntodo, double scale, double zero, + float *buffer, int *status); +int ffr8fr4(double *array, long ntodo, double scale, double zero, + float *buffer, int *status); + +int ffi1fr8(unsigned char *array, long ntodo, double scale, double zero, + double *buffer, int *status); +int ffu2fr8(unsigned short *array, long ntodo, double scale, double zero, + double *buffer, int *status); +int ffi2fr8(short *array, long ntodo, double scale, double zero, + double *buffer, int *status); +int ffu4fr8(unsigned long *array, long ntodo, double scale, double zero, + double *buffer, int *status); +int ffi4fr8(long *array, long ntodo, double scale, double zero, + double *buffer, int *status); +int ffuintfr8(unsigned int *array, long ntodo, double scale, double zero, + double *buffer, int *status); +int ffintfr8(int *array, long ntodo, double scale, double zero, + double *buffer, int *status); +int ffr4fr8(float *array, long ntodo, double scale, double zero, + double *buffer, int *status); +int ffr8fr8(double *array, long ntodo, double scale, double zero, + double *buffer, int *status); + +int ffi1fstr(unsigned char *input, long ntodo, double scale, double zero, + char *cform, long twidth, char *output, int *status); +int ffu2fstr(unsigned short *input, long ntodo, double scale, double zero, + char *cform, long twidth, char *output, int *status); +int ffi2fstr(short *input, long ntodo, double scale, double zero, + char *cform, long twidth, char *output, int *status); +int ffu4fstr(unsigned long *input, long ntodo, double scale, double zero, + char *cform, long twidth, char *output, int *status); +int ffi4fstr(long *input, long ntodo, double scale, double zero, + char *cform, long twidth, char *output, int *status); +int ffintfstr(int *input, long ntodo, double scale, double zero, + char *cform, long twidth, char *output, int *status); +int ffuintfstr(unsigned int *input, long ntodo, double scale, double zero, + char *cform, long twidth, char *output, int *status); +int ffr4fstr(float *input, long ntodo, double scale, double zero, + char *cform, long twidth, char *output, int *status); +int ffr8fstr(double *input, long ntodo, double scale, double zero, + char *cform, long twidth, char *output, int *status); + +/* the following 4 routines are VMS macros used on VAX or Alpha VMS */ +void ieevpd(double *inarray, double *outarray, long *nvals); +void ieevud(double *inarray, double *outarray, long *nvals); +void ieevpr(float *inarray, float *outarray, long *nvals); +void ieevur(float *inarray, float *outarray, long *nvals); + +/* routines related to the lexical parser */ +int ffselect_table(fitsfile **fptr, char *outfile, char *expr, int *status); +int ffiprs( fitsfile *fptr, int compressed, char *expr, int maxdim, + int *datatype, long *nelem, int *naxis, long *naxes, + int *status ); +void ffcprs( void ); +int ffcvtn( int inputType, void *input, char *undef, long ntodo, + int outputType, void *nulval, void *output, + int *anynull, int *status ); +int parse_data( long totalrows, long offset, long firstrow, + long nrows, int nCols, iteratorCol *colData, + void *userPtr ); +int uncompress_hkdata( fitsfile *fptr, long ntimes, + double *times, int *status ); +int ffffrw_work( long totalrows, long offset, long firstrow, + long nrows, int nCols, iteratorCol *colData, + void *userPtr ); + + +/* image compression routines */ +int imcomp_init_table(fitsfile *outfptr, int compress_type, + int bitpix, int naxis,long *naxes,long *tilesize, + int rice_blocksize,int rice_nbits,int *status); +int imcomp_calc_max_elem (int comptype, int nx, int blocksize); +int imcomp_copy_imheader(fitsfile *infptr, fitsfile *outfptr, + int *status); +int imcomp_compress_image (fitsfile *infptr, fitsfile *outfptr, + int *status); +int imcomp_compress_tile (fitsfile *outfptr, long row, + int datatype, void *tiledata, long tilelen, int *status); + +/* image decompression routines */ +int fits_read_compressed_img_plane(fitsfile *fptr, int datatype, + int bytesperpixel, long nplane, long *firstcoord, long *lastcoord, + long *inc, long *naxes, int nullcheck, void *nullval, + void *array, char *nullarray, int *anynul, long *nread, int *status); +int imcomp_get_compressed_image_par(fitsfile *infptr, int *status); +int imcomp_decompress_tile (fitsfile *infptr, + int nrow, int tilesize, int datatype, int nullcheck, + void *nulval, void *buffer, char *bnullarray, int *anynul, + int *status); +int imcomp_copy_overlap (char *tile, int datatype, int ndim, + long *tfpixel, long *tlpixel, char *bnullarray, char *image, + long *fpixel, long *lpixel, int nullcheck, char *nullarray, + int *status); + +int pl_p2li (int *pxsrc, int xs, short *lldst, int npix); +int pl_l2pi (short *ll_src, int xs, int *px_dst, int npix); + +/* general driver routines */ + +int urltype2driver(char *urltype, int *driver); +int fits_init_cfitsio(void); + +int fits_register_driver( char *prefix, + int (*init)(void), + int (*fitsshutdown)(void), + int (*setoptions)(int option), + int (*getoptions)(int *options), + int (*getversion)(int *version), + int (*checkfile) (char *urltype, char *infile, char *outfile), + int (*fitsopen)(char *filename, int rwmode, int *driverhandle), + int (*fitscreate)(char *filename, int *driverhandle), + int (*fitstruncate)(int driverhandle, long filesize), + int (*fitsclose)(int driverhandle), + int (*fremove)(char *filename), + int (*size)(int driverhandle, long *size), + int (*flush)(int driverhandle), + int (*seek)(int driverhandle, long offset), + int (*fitsread) (int driverhandle, void *buffer, long nbytes), + int (*fitswrite)(int driverhandle, void *buffer, long nbytes)); + +/* file driver I/O routines */ + +int file_init(void); +int file_setoptions(int options); +int file_getoptions(int *options); +int file_getversion(int *version); +int file_shutdown(void); +int file_checkfile(char *urltype, char *infile, char *outfile); +int file_open(char *filename, int rwmode, int *driverhandle); +int file_compress_open(char *filename, int rwmode, int *hdl); +int file_openfile(char *filename, int rwmode, FILE **diskfile); +int file_create(char *filename, int *driverhandle); +int file_truncate(int driverhandle, long filesize); +int file_size(int driverhandle, long *filesize); +int file_close(int driverhandle); +int file_remove(char *filename); +int file_flush(int driverhandle); +int file_seek(int driverhandle, long offset); +int file_read (int driverhandle, void *buffer, long nbytes); +int file_write(int driverhandle, void *buffer, long nbytes); +int file_is_compressed(char *filename); + +/* memory driver I/O routines */ + +int mem_init(void); +int mem_setoptions(int options); +int mem_getoptions(int *options); +int mem_getversion(int *version); +int mem_shutdown(void); +int mem_create(char *filename, int *handle); +int mem_openmem(void **buffptr, size_t *buffsize, size_t deltasize, + void *(*memrealloc)(void *p, size_t newsize), int *handle); +int mem_createmem(size_t memsize, int *handle); +int stdin_checkfile(char *urltype, char *infile, char *outfile); +int stdin_open(char *filename, int rwmode, int *handle); +int stdin2mem(int hd); +int stdin2file(int hd); +int stdout_close(int handle); +int mem_compress_open(char *filename, int rwmode, int *hdl); +int mem_iraf_open(char *filename, int rwmode, int *hdl); +int mem_size(int handle, long *filesize); +int mem_truncate(int handle, long filesize); +int mem_close_free(int handle); +int mem_close_keep(int handle); +int mem_seek(int handle, long offset); +int mem_read(int hdl, void *buffer, long nbytes); +int mem_write(int hdl, void *buffer, long nbytes); +int mem_uncompress2mem(char *filename, FILE *diskfile, int hdl); + +int iraf2mem(char *filename, char **buffptr, size_t *buffsize, + size_t *filesize, int *status); + +/* root driver I/O routines */ + +int root_init(void); +int root_setoptions(int options); +int root_getoptions(int *options); +int root_getversion(int *version); +int root_shutdown(void); +int root_open(char *filename, int rwmode, int *driverhandle); +int root_create(char *filename, int *driverhandle); +int root_close(int driverhandle); +int root_flush(int driverhandle); +int root_seek(int driverhandle, long offset); +int root_read (int driverhandle, void *buffer, long nbytes); +int root_write(int driverhandle, void *buffer, long nbytes); +int root_size(int handle, long *filesize); + +/* http driver I/O routines */ + +int http_checkfile(char *urltype, char *infile, char *outfile); +int http_open(char *filename, int rwmode, int *driverhandle); +int http_file_open(char *filename, int rwmode, int *driverhandle); +int http_compress_open(char *filename, int rwmode, int *driverhandle); + +/* ftp driver I/O routines */ + +int ftp_checkfile(char *urltype, char *infile, char *outfile); +int ftp_open(char *filename, int rwmode, int *driverhandle); +int ftp_file_open(char *filename, int rwmode, int *driverhandle); +int ftp_compress_open(char *filename, int rwmode, int *driverhandle); + + +int uncompress2mem(char *filename, FILE *diskfile, + char **buffptr, size_t *buffsize, + void *(*mem_realloc)(void *p, size_t newsize), + size_t *filesize, int *status); + +int uncompress2mem_from_mem( + char *inmemptr, + size_t inmemsize, + char **buffptr, + size_t *buffsize, + void *(*mem_realloc)(void *p, size_t newsize), + size_t *filesize, + int *status); + +int uncompress2file(char *filename, + FILE *indiskfile, + FILE *outdiskfile, + int *status); + +int compress2mem_from_mem( + char *inmemptr, + size_t inmemsize, + char **buffptr, + size_t *buffsize, + void *(*mem_realloc)(void *p, size_t newsize), + size_t *filesize, + int *status); + +/* ==================== SHARED MEMORY DRIVER SECTION ======================= */ + +#ifdef HAVE_SHMEM_SERVICES +#include "drvrsmem.h" +#endif + +/* ==================== END OF SHARED MEMORY DRIVER SECTION ================ */ + +#endif + + +#if defined(vms) || defined(__vms) || defined(WIN32) || defined(__WIN32__) || defined(macintosh) + +/* ================================================================== */ +/* A hack for nonunix machines, which lack strcasecmp and strncasecmp */ +/* ================================================================== */ + +int strcasecmp (const char *s1, const char *s2 ); +int strncasecmp(const char *s1, const char *s2, size_t n); + +#endif diff --git a/include/cfitsio/group.h b/include/cfitsio/group.h new file mode 100644 index 0000000..f7aae5b --- /dev/null +++ b/include/cfitsio/group.h @@ -0,0 +1,65 @@ +#define MAX_HDU_TRACKER 1000 + +typedef struct _HDUtracker HDUtracker; + +struct _HDUtracker +{ + int nHDU; + + char *filename[MAX_HDU_TRACKER]; + int position[MAX_HDU_TRACKER]; + + char *newFilename[MAX_HDU_TRACKER]; + int newPosition[MAX_HDU_TRACKER]; +}; + +/* functions used internally in the grouping convention module */ + +int ffgtdc(int grouptype, int xtensioncol, int extnamecol, int extvercol, + int positioncol, int locationcol, int uricol, char *ttype[], + char *tform[], int *ncols, int *status); + +int ffgtgc(fitsfile *gfptr, int *xtensionCol, int *extnameCol, int *extverCol, + int *positionCol, int *locationCol, int *uriCol, int *grptype, + int *status); + +int ffgmul(fitsfile *mfptr, int rmopt, int *status); + +int ffgmf(fitsfile *gfptr, char *xtension, char *extname, int extver, + int position, char *location, long *member, int *status); + +int ffgtrmr(fitsfile *gfptr, HDUtracker *HDU, int *status); + +int ffgtcpr(fitsfile *infptr, fitsfile *outfptr, int cpopt, HDUtracker *HDU, + int *status); + +int fftsad(fitsfile *mfptr, HDUtracker *HDU, int *newPosition, + char *newFileName); + +int fftsud(fitsfile *mfptr, HDUtracker *HDU, int newPosition, + char *newFileName); + +void prepare_keyvalue(char *keyvalue); + +int fits_path2url(char *inpath, char *outpath, int *status); + +int fits_url2path(char *inpath, char *outpath, int *status); + +int fits_get_cwd(char *cwd, int *status); + +int fits_get_url(fitsfile *fptr, char *realURL, char *startURL, + char *realAccess, char *startAccess, int *iostate, + int *status); + +int fits_clean_url(char *inURL, char *outURL, int *status); + +int fits_relurl2url(char *refURL, char *relURL, char *absURL, int *status); + +int fits_url2relurl(char *refURL, char *absURL, char *relURL, int *status); + +int fits_encode_url(char *inpath, char *outpath, int *status); + +int fits_unencode_url(char *inpath, char *outpath, int *status); + +int fits_is_url_absolute(char *url); + diff --git a/include/cfitsio/grparser.h b/include/cfitsio/grparser.h new file mode 100644 index 0000000..32a172b --- /dev/null +++ b/include/cfitsio/grparser.h @@ -0,0 +1,181 @@ +/* T E M P L A T E P A R S E R H E A D E R F I L E + ===================================================== + + by Jerzy.Borkowski@obs.unige.ch + + Integral Science Data Center + ch. d'Ecogia 16 + 1290 Versoix + Switzerland + +14-Oct-98: initial release +16-Oct-98: reference to fitsio.h removed, also removed strings after #endif + directives to make gcc -Wall not to complain +20-Oct-98: added declarations NGP_XTENSION_SIMPLE and NGP_XTENSION_FIRST +24-Oct-98: prototype of ngp_read_line() function updated. +22-Jan-99: prototype for ngp_set_extver() function added. +*/ + +#ifndef GRPARSER_H_INCLUDED +#define GRPARSER_H_INCLUDED + +#ifdef __cplusplus +extern "C" { +#endif + + /* error codes - now defined in fitsio.h */ + + /* common constants definitions */ + +#define NGP_ALLOCCHUNK (1000) +#define NGP_MAX_INCLUDE (10) /* include file nesting limit */ +#define NGP_MAX_COMMENT (80) /* max size for comment */ +#define NGP_MAX_NAME (20) /* max size for KEYWORD (FITS limits it to 8 chars) */ +#define NGP_MAX_STRING (80) /* max size for various strings */ +#define NGP_MAX_ARRAY_DIM (999) /* max. number of dimensions in array */ +#define NGP_MAX_FNAME (1000) /* max size of combined path+fname */ +#define NGP_MAX_ENVFILES (10000) /* max size of CFITSIO_INCLUDE_FILES env. variable */ + +#define NGP_TOKEN_UNKNOWN (-1) /* token type unknown */ +#define NGP_TOKEN_INCLUDE (0) /* \INCLUDE token */ +#define NGP_TOKEN_GROUP (1) /* \GROUP token */ +#define NGP_TOKEN_END (2) /* \END token */ +#define NGP_TOKEN_XTENSION (3) /* XTENSION token */ +#define NGP_TOKEN_SIMPLE (4) /* SIMPLE token */ +#define NGP_TOKEN_EOF (5) /* End Of File pseudo token */ + +#define NGP_TTYPE_UNKNOWN (0) /* undef (yet) token type - invalid to print/write to disk */ +#define NGP_TTYPE_BOOL (1) /* boolean, it is 'T' or 'F' */ +#define NGP_TTYPE_STRING (2) /* something withing "" or starting with letter */ +#define NGP_TTYPE_INT (3) /* starting with digit and not with '.' */ +#define NGP_TTYPE_REAL (4) /* digits + '.' */ +#define NGP_TTYPE_COMPLEX (5) /* 2 reals, separated with ',' */ +#define NGP_TTYPE_NULL (6) /* NULL token, format is : NAME = / comment */ +#define NGP_TTYPE_RAW (7) /* HISTORY/COMMENT/8SPACES + comment string without / */ + +#define NGP_FOUND_EQUAL_SIGN (1) /* line contains '=' after keyword name */ + +#define NGP_FORMAT_OK (0) /* line format OK */ +#define NGP_FORMAT_ERROR (1) /* line format error */ + +#define NGP_NODE_INVALID (0) /* default node type - invalid (to catch errors) */ +#define NGP_NODE_IMAGE (1) /* IMAGE type */ +#define NGP_NODE_ATABLE (2) /* ASCII table type */ +#define NGP_NODE_BTABLE (3) /* BINARY table type */ + +#define NGP_NON_SYSTEM_ONLY (0) /* save all keywords except NAXIS,BITPIX,etc.. */ +#define NGP_REALLY_ALL (1) /* save really all keywords */ + +#define NGP_XTENSION_SIMPLE (1) /* HDU defined with SIMPLE T */ +#define NGP_XTENSION_FIRST (2) /* this is first extension in template */ + +#define NGP_LINE_REREAD (1) /* reread line */ + +#define NGP_BITPIX_INVALID (-12345) /* default BITPIX (to catch errors) */ + + /* common macro definitions */ + +#ifdef NGP_PARSER_DEBUG_MALLOC + +#define ngp_alloc(x) dal_malloc(x) +#define ngp_free(x) dal_free(x) +#define ngp_realloc(x,y) dal_realloc(x,y) + +#else + +#define ngp_alloc(x) malloc(x) +#define ngp_free(x) free(x) +#define ngp_realloc(x,y) realloc(x,y) + +#endif + + /* type definitions */ + +typedef struct NGP_RAW_LINE_STRUCT + { char *line; + char *name; + char *value; + int type; + char *comment; + int format; + int flags; + } NGP_RAW_LINE; + + +typedef union NGP_TOKVAL_UNION + { char *s; /* space allocated separately, be careful !!! */ + char b; + int i; + double d; + struct NGP_COMPLEX_STRUCT + { double re; + double im; + } c; /* complex value */ + } NGP_TOKVAL; + + +typedef struct NGP_TOKEN_STRUCT + { int type; + char name[NGP_MAX_NAME]; + NGP_TOKVAL value; + char comment[NGP_MAX_COMMENT]; + } NGP_TOKEN; + + +typedef struct NGP_HDU_STRUCT + { int tokcnt; + NGP_TOKEN *tok; + } NGP_HDU; + + +typedef struct NGP_TKDEF_STRUCT + { char *name; + int code; + } NGP_TKDEF; + + +typedef struct NGP_EXTVER_TAB_STRUCT + { char *extname; + int version; + } NGP_EXTVER_TAB; + + + /* globally visible variables declarations */ + +extern NGP_RAW_LINE ngp_curline; +extern NGP_RAW_LINE ngp_prevline; + +extern int ngp_extver_tab_size; +extern NGP_EXTVER_TAB *ngp_extver_tab; + + + /* globally visible functions declarations */ + +int ngp_get_extver(char *extname, int *version); +int ngp_set_extver(char *extname, int version); +int ngp_delete_extver_tab(void); +int ngp_strcasecmp(char *p1, char *p2); +int ngp_line_from_file(FILE *fp, char **p); +int ngp_free_line(void); +int ngp_free_prevline(void); +int ngp_read_line_buffered(FILE *fp); +int ngp_unread_line(void); +int ngp_extract_tokens(NGP_RAW_LINE *cl); +int ngp_include_file(char *fname); +int ngp_read_line(int ignore_blank_lines); +int ngp_keyword_is_write(NGP_TOKEN *ngp_tok); +int ngp_keyword_all_write(NGP_HDU *ngph, fitsfile *ffp, int mode); +int ngp_hdu_init(NGP_HDU *ngph); +int ngp_hdu_clear(NGP_HDU *ngph); +int ngp_hdu_insert_token(NGP_HDU *ngph, NGP_TOKEN *newtok); +int ngp_append_columns(fitsfile *ff, NGP_HDU *ngph, int aftercol); +int ngp_read_xtension(fitsfile *ff, int parent_hn, int simple_mode); +int ngp_read_group(fitsfile *ff, char *grpname, int parent_hn); + + /* top level API function - now defined in fitsio.h */ + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/include/cfitsio/imcompress.h b/include/cfitsio/imcompress.h new file mode 100644 index 0000000..c5ba7d2 --- /dev/null +++ b/include/cfitsio/imcompress.h @@ -0,0 +1,56 @@ +#define MAX_COMPRESS_DIM 6 +#define COMPRESS_NULL_VALUE -2147483647 + +typedef struct { + char zcmptype[12]; /* compression type string */ + int compress_type; /* type of compression algorithm */ + int bitpix; /* FITS data type of image (BITPIX) */ + int ndim; /* dimension of image */ + long naxis[MAX_COMPRESS_DIM]; /* length of each axis */ + int cn_compressed; /* column number for COMPRESSED_DATA column */ + int cn_uncompressed; /* column number for UNCOMPRESSED_DATA column */ + int cn_zscale; /* column number for CSCALE column */ + int cn_zzero; /* column number for CZERO column */ + int cn_zblank; /* column number for the CBLANK column */ + double zscale; /* scaling value, if keyword and not column */ + double zzero; /* zero pt, if keyword and not column */ + int zblank; /* value for null pixels, if not a column */ + long nrows; /* number of rows in table */ + int ncols; /* number of columns in table */ + int rice_blocksize; /* first compression parameter */ + int rice_nbits; /* second compression parameter */ + long tilesize[MAX_COMPRESS_DIM]; /* size of compression tiles */ + long maxtilelen; /* max number of pixels in each image tile */ + long maxelem; /* maximum length of variable length arrays */ +} CompressImageInfo; + +/* image compression routines */ +static int imcomp_get_image_params(fitsfile *infptr, CompressImageInfo *otb, + int *status); +static int imcomp_init_table(fitsfile *outfptr, + CompressImageInfo *otb, int *status); +static int imcomp_calc_max_elem (int nx, int blocksize); +static int imcomp_copy_imheader(fitsfile *infptr, fitsfile *outfptr, + int *status); +static int imcomp_img_to_tbl_special (char *card); +static int imcomp_compress_image (fitsfile *infptr, fitsfile *outfptr, + CompressImageInfo *otb, int *status); + +/* image decompression routines */ +int fits_read_compressed_img_plane(fitsfile *fptr, int datatype, + int bytesperpixel, long nplane, long *firstcoord, long *lastcoord, + long *inc, long *naxes, int nullcheck, void *nullval, + void *array, char *nullarray, int *anynul, int *status); +static int imcomp_get_table_params(fitsfile *infptr, CompressImageInfo *itb, + int *status); +static int imcomp_copy_tblheader(fitsfile *infptr, fitsfile *outfptr, + int *status); +static int imcomp_tbl_to_img_special (char *keyname); +static int imcomp_decompress_tile (fitsfile *infptr, CompressImageInfo *itb, + int nrow, int tilesize, int datatype, int nullcheck, + void *nulval, void *buffer, char *bnullarray, int *anynul, + int *status); +static int imcomp_copy_overlap (char *tile, int datatype, int ndim, + long *tfpixel, long *tlpixel, char *bnullarray, char *image, + long *fpixel, long *lpixel, int nullcheck, char *nullarray, + int *status); diff --git a/include/cfitsio/longnam.h b/include/cfitsio/longnam.h new file mode 100644 index 0000000..ac083bc --- /dev/null +++ b/include/cfitsio/longnam.h @@ -0,0 +1,476 @@ +#ifndef _LONGNAME_H +#define _LONGNAME_H + +#define fits_parse_input_url ffiurl +#define fits_parse_rootname ffrtnm +#define fits_parse_output_url ffourl +#define fits_parse_extspec ffexts +#define fits_parse_extnum ffextn +#define fits_parse_binspec ffbins +#define fits_parse_binrange ffbinr +#define fits_open_memfile ffomem +#define fits_open_file ffopen +#define fits_reopen_file ffreopen +#define fits_create_file ffinit +#define fits_create_template fftplt +#define fits_flush_file ffflus +#define fits_close_file ffclos +#define fits_delete_file ffdelt +#define fits_file_name ffflnm +#define fits_file_mode ffflmd +#define fits_url_type ffurlt + +#define fits_get_version ffvers +#define fits_uppercase ffupch +#define fits_get_errstatus ffgerr +#define fits_write_errmsg ffpmsg +#define fits_read_errmsg ffgmsg +#define fits_clear_errmsg ffcmsg +#define fits_report_error ffrprt +#define fits_compare_str ffcmps +#define fits_test_keyword fftkey +#define fits_test_record fftrec +#define fits_null_check ffnchk +#define fits_make_keyn ffkeyn +#define fits_make_nkey ffnkey +#define fits_get_keyclass ffgkcl +#define fits_get_keytype ffdtyp +#define fits_parse_value ffpsvc +#define fits_get_keyname ffgknm +#define fits_parse_template ffgthd +#define fits_ascii_tform ffasfm +#define fits_binary_tform ffbnfm +#define fits_get_tbcol ffgabc +#define fits_get_rowsize ffgrsz +#define fits_get_col_display_width ffgcdw + +#define fits_write_record ffprec +#define fits_write_key ffpky +#define fits_write_key_unit ffpunt +#define fits_write_comment ffpcom +#define fits_write_history ffphis +#define fits_write_date ffpdat +#define fits_get_system_time ffgstm +#define fits_get_system_date ffgsdt +#define fits_date2str ffdt2s +#define fits_time2str fftm2s +#define fits_str2date ffs2dt +#define fits_str2time ffs2tm +#define fits_write_key_longstr ffpkls +#define fits_write_key_longwarn ffplsw +#define fits_write_key_null ffpkyu +#define fits_write_key_str ffpkys +#define fits_write_key_log ffpkyl +#define fits_write_key_lng ffpkyj +#define fits_write_key_fixflt ffpkyf +#define fits_write_key_flt ffpkye +#define fits_write_key_fixdbl ffpkyg +#define fits_write_key_dbl ffpkyd +#define fits_write_key_fixcmp ffpkfc +#define fits_write_key_cmp ffpkyc +#define fits_write_key_fixdblcmp ffpkfm +#define fits_write_key_dblcmp ffpkym +#define fits_write_key_triple ffpkyt +#define fits_write_tdim ffptdm +#define fits_write_keys_str ffpkns +#define fits_write_keys_log ffpknl +#define fits_write_keys_lng ffpknj +#define fits_write_keys_fixflt ffpknf +#define fits_write_keys_flt ffpkne +#define fits_write_keys_fixdbl ffpkng +#define fits_write_keys_dbl ffpknd +#define fits_copy_key ffcpky +#define fits_write_imghdr ffphps +#define fits_write_grphdr ffphpr +#define fits_write_atblhdr ffphtb +#define fits_write_btblhdr ffphbn +#define fits_write_key_template ffpktp + +#define fits_get_hdrspace ffghsp +#define fits_get_hdrpos ffghps +#define fits_movabs_key ffmaky +#define fits_movrel_key ffmrky +#define fits_find_nextkey ffgnxk + +#define fits_read_record ffgrec +#define fits_read_card ffgcrd +#define fits_read_key_unit ffgunt +#define fits_read_keyn ffgkyn +#define fits_read_key ffgky +#define fits_read_keyword ffgkey +#define fits_read_key_str ffgkys +#define fits_read_key_log ffgkyl +#define fits_read_key_lng ffgkyj +#define fits_read_key_flt ffgkye +#define fits_read_key_dbl ffgkyd +#define fits_read_key_cmp ffgkyc +#define fits_read_key_dblcmp ffgkym +#define fits_read_key_triple ffgkyt +#define fits_read_key_longstr ffgkls +#define fits_read_tdim ffgtdm +#define fits_decode_tdim ffdtdm +#define fits_read_keys_str ffgkns +#define fits_read_keys_log ffgknl +#define fits_read_keys_lng ffgknj +#define fits_read_keys_flt ffgkne +#define fits_read_keys_dbl ffgknd +#define fits_read_imghdr ffghpr +#define fits_read_atblhdr ffghtb +#define fits_read_btblhdr ffghbn +#define fits_header2str ffh2st + +#define fits_update_card ffucrd +#define fits_update_key ffuky +#define fits_update_key_null ffukyu +#define fits_update_key_str ffukys +#define fits_update_key_longstr ffukls +#define fits_update_key_log ffukyl +#define fits_update_key_lng ffukyj +#define fits_update_key_fixflt ffukyf +#define fits_update_key_flt ffukye +#define fits_update_key_fixdbl ffukyg +#define fits_update_key_dbl ffukyd +#define fits_update_key_fixcmp ffukfc +#define fits_update_key_cmp ffukyc +#define fits_update_key_fixdblcmp ffukfm +#define fits_update_key_dblcmp ffukym + +#define fits_modify_record ffmrec +#define fits_modify_card ffmcrd +#define fits_modify_name ffmnam +#define fits_modify_comment ffmcom +#define fits_modify_key_null ffmkyu +#define fits_modify_key_str ffmkys +#define fits_modify_key_longstr ffmkls +#define fits_modify_key_log ffmkyl +#define fits_modify_key_lng ffmkyj +#define fits_modify_key_fixflt ffmkyf +#define fits_modify_key_flt ffmkye +#define fits_modify_key_fixdbl ffmkyg +#define fits_modify_key_dbl ffmkyd +#define fits_modify_key_fixcmp ffmkfc +#define fits_modify_key_cmp ffmkyc +#define fits_modify_key_fixdblcmp ffmkfm +#define fits_modify_key_dblcmp ffmkym + +#define fits_insert_record ffirec +#define fits_insert_key_null ffikyu +#define fits_insert_key_str ffikys +#define fits_insert_key_longstr ffikls +#define fits_insert_key_log ffikyl +#define fits_insert_key_lng ffikyj +#define fits_insert_key_fixflt ffikyf +#define fits_insert_key_flt ffikye +#define fits_insert_key_fixdbl ffikyg +#define fits_insert_key_dbl ffikyd +#define fits_insert_key_fixcmp ffikfc +#define fits_insert_key_cmp ffikyc +#define fits_insert_key_fixdblcmp ffikfm +#define fits_insert_key_dblcmp ffikym + +#define fits_delete_key ffdkey +#define fits_delete_record ffdrec +#define fits_get_hdu_num ffghdn +#define fits_get_hdu_type ffghdt +#define fits_get_hduaddr ffghad + +#define fits_get_img_param ffgipr +#define fits_get_img_type ffgidt +#define fits_get_img_dim ffgidm +#define fits_get_img_size ffgisz + +#define fits_movabs_hdu ffmahd +#define fits_movrel_hdu ffmrhd +#define fits_movnam_hdu ffmnhd +#define fits_get_num_hdus ffthdu +#define fits_create_img ffcrim +#define fits_create_tbl ffcrtb +#define fits_create_hdu ffcrhd +#define fits_insert_img ffiimg +#define fits_insert_atbl ffitab +#define fits_insert_btbl ffibin +#define fits_resize_img ffrsim +#define fits_delete_hdu ffdhdu +#define fits_copy_hdu ffcopy +#define fits_copy_header ffcphd +#define fits_copy_data ffcpdt + +#define fits_set_hdustruc ffrdef +#define fits_set_hdrsize ffhdef +#define fits_write_theap ffpthp + +#define fits_encode_chksum ffesum +#define fits_decode_chksum ffdsum +#define fits_write_chksum ffpcks +#define fits_update_chksum ffupck +#define fits_verify_chksum ffvcks +#define fits_get_chksum ffgcks + +#define fits_set_bscale ffpscl +#define fits_set_tscale fftscl +#define fits_set_imgnull ffpnul +#define fits_set_btblnull fftnul +#define fits_set_atblnull ffsnul + +#define fits_get_colnum ffgcno +#define fits_get_colname ffgcnn +#define fits_get_coltype ffgtcl +#define fits_get_num_rows ffgnrw +#define fits_get_num_cols ffgncl +#define fits_get_acolparms ffgacl +#define fits_get_bcolparms ffgbcl + +#define fits_iterate_data ffiter + +#define fits_read_grppar_byt ffggpb +#define fits_read_grppar_usht ffggpui +#define fits_read_grppar_ulng ffggpuj +#define fits_read_grppar_sht ffggpi +#define fits_read_grppar_lng ffggpj +#define fits_read_grppar_int ffggpk +#define fits_read_grppar_uint ffggpuk +#define fits_read_grppar_flt ffggpe +#define fits_read_grppar_dbl ffggpd + +#define fits_read_img ffgpv +#define fits_read_imgnull ffgpf +#define fits_read_img_byt ffgpvb +#define fits_read_img_usht ffgpvui +#define fits_read_img_ulng ffgpvuj +#define fits_read_img_sht ffgpvi +#define fits_read_img_lng ffgpvj +#define fits_read_img_uint ffgpvuk +#define fits_read_img_int ffgpvk +#define fits_read_img_flt ffgpve +#define fits_read_img_dbl ffgpvd + +#define fits_read_imgnull_byt ffgpfb +#define fits_read_imgnull_usht ffgpfui +#define fits_read_imgnull_ulng ffgpfuj +#define fits_read_imgnull_sht ffgpfi +#define fits_read_imgnull_lng ffgpfj +#define fits_read_imgnull_uint ffgpfuk +#define fits_read_imgnull_int ffgpfk +#define fits_read_imgnull_flt ffgpfe +#define fits_read_imgnull_dbl ffgpfd + +#define fits_read_2d_byt ffg2db +#define fits_read_2d_usht ffg2dui +#define fits_read_2d_ulng ffg2duj +#define fits_read_2d_sht ffg2di +#define fits_read_2d_lng ffg2dj +#define fits_read_2d_uint ffg2duk +#define fits_read_2d_int ffg2dk +#define fits_read_2d_flt ffg2de +#define fits_read_2d_dbl ffg2dd + +#define fits_read_3d_byt ffg3db +#define fits_read_3d_usht ffg3dui +#define fits_read_3d_ulng ffg3duj +#define fits_read_3d_sht ffg3di +#define fits_read_3d_lng ffg3dj +#define fits_read_3d_uint ffg3duk +#define fits_read_3d_int ffg3dk +#define fits_read_3d_flt ffg3de +#define fits_read_3d_dbl ffg3dd + +#define fits_read_subset_byt ffgsvb +#define fits_read_subset_usht ffgsvui +#define fits_read_subset_ulng ffgsvuj +#define fits_read_subset_sht ffgsvi +#define fits_read_subset_lng ffgsvj +#define fits_read_subset_uint ffgsvuk +#define fits_read_subset_int ffgsvk +#define fits_read_subset_flt ffgsve +#define fits_read_subset_dbl ffgsvd + +#define fits_read_subsetnull_byt ffgsfb +#define fits_read_subsetnull_usht ffgsfui +#define fits_read_subsetnull_ulng ffgsfuj +#define fits_read_subsetnull_sht ffgsfi +#define fits_read_subsetnull_lng ffgsfj +#define fits_read_subsetnull_uint ffgsfuk +#define fits_read_subsetnull_int ffgsfk +#define fits_read_subsetnull_flt ffgsfe +#define fits_read_subsetnull_dbl ffgsfd + +#define fits_read_col ffgcv +#define fits_read_colnull ffgcf +#define fits_read_col_str ffgcvs +#define fits_read_col_log ffgcvl +#define fits_read_col_byt ffgcvb +#define fits_read_col_usht ffgcvui +#define fits_read_col_ulng ffgcvuj +#define fits_read_col_sht ffgcvi +#define fits_read_col_lng ffgcvj +#define fits_read_col_uint ffgcvuk +#define fits_read_col_int ffgcvk +#define fits_read_col_flt ffgcve +#define fits_read_col_dbl ffgcvd +#define fits_read_col_cmp ffgcvc +#define fits_read_col_dblcmp ffgcvm +#define fits_read_col_bit ffgcx +#define fits_read_col_bit_usht ffgcxui +#define fits_read_col_bit_uint ffgcxuk + +#define fits_read_colnull_str ffgcfs +#define fits_read_colnull_log ffgcfl +#define fits_read_colnull_byt ffgcfb +#define fits_read_colnull_usht ffgcfui +#define fits_read_colnull_ulng ffgcfuj +#define fits_read_colnull_sht ffgcfi +#define fits_read_colnull_lng ffgcfj +#define fits_read_colnull_uint ffgcfuk +#define fits_read_colnull_int ffgcfk +#define fits_read_colnull_flt ffgcfe +#define fits_read_colnull_dbl ffgcfd +#define fits_read_colnull_cmp ffgcfc +#define fits_read_colnull_dblcmp ffgcfm + +#define fits_read_descript ffgdes +#define fits_read_descripts ffgdess +#define fits_read_tblbytes ffgtbb + +#define fits_write_grppar_byt ffpgpb +#define fits_write_grppar_usht ffpgpui +#define fits_write_grppar_ulng ffpgpuj +#define fits_write_grppar_sht ffpgpi +#define fits_write_grppar_lng ffpgpj +#define fits_write_grppar_uint ffpgpuk +#define fits_write_grppar_int ffpgpk +#define fits_write_grppar_flt ffpgpe +#define fits_write_grppar_dbl ffpgpd + +#define fits_write_img ffppr +#define fits_write_img_byt ffpprb +#define fits_write_img_usht ffpprui +#define fits_write_img_ulng ffppruj +#define fits_write_img_sht ffppri +#define fits_write_img_lng ffpprj +#define fits_write_img_uint ffppruk +#define fits_write_img_int ffpprk +#define fits_write_img_flt ffppre +#define fits_write_img_dbl ffpprd + +#define fits_write_imgnull ffppn +#define fits_write_imgnull_byt ffppnb +#define fits_write_imgnull_usht ffppnui +#define fits_write_imgnull_ulng ffppnuj +#define fits_write_imgnull_sht ffppni +#define fits_write_imgnull_lng ffppnj +#define fits_write_imgnull_uint ffppnuk +#define fits_write_imgnull_int ffppnk +#define fits_write_imgnull_flt ffppne +#define fits_write_imgnull_dbl ffppnd + +#define fits_write_img_null ffppru +#define fits_write_null_img ffpprn + +#define fits_write_2d_byt ffp2db +#define fits_write_2d_usht ffp2dui +#define fits_write_2d_ulng ffp2duj +#define fits_write_2d_sht ffp2di +#define fits_write_2d_lng ffp2dj +#define fits_write_2d_uint ffp2duk +#define fits_write_2d_int ffp2dk +#define fits_write_2d_flt ffp2de +#define fits_write_2d_dbl ffp2dd + +#define fits_write_3d_byt ffp3db +#define fits_write_3d_usht ffp3dui +#define fits_write_3d_ulng ffp3duj +#define fits_write_3d_sht ffp3di +#define fits_write_3d_lng ffp3dj +#define fits_write_3d_uint ffp3duk +#define fits_write_3d_int ffp3dk +#define fits_write_3d_flt ffp3de +#define fits_write_3d_dbl ffp3dd + +#define fits_write_subset_byt ffpssb +#define fits_write_subset_usht ffpssui +#define fits_write_subset_ulng ffpssuj +#define fits_write_subset_sht ffpssi +#define fits_write_subset_lng ffpssj +#define fits_write_subset_uint ffpssuk +#define fits_write_subset_int ffpssk +#define fits_write_subset_flt ffpsse +#define fits_write_subset_dbl ffpssd + +#define fits_write_col ffpcl +#define fits_write_col_str ffpcls +#define fits_write_col_log ffpcll +#define fits_write_col_byt ffpclb +#define fits_write_col_usht ffpclui +#define fits_write_col_ulng ffpcluj +#define fits_write_col_sht ffpcli +#define fits_write_col_lng ffpclj +#define fits_write_col_uint ffpcluk +#define fits_write_col_int ffpclk +#define fits_write_col_flt ffpcle +#define fits_write_col_dbl ffpcld +#define fits_write_col_cmp ffpclc +#define fits_write_col_dblcmp ffpclm +#define fits_write_col_null ffpclu +#define fits_write_col_bit ffpclx + +#define fits_write_colnull ffpcn +#define fits_write_colnull_str ffpcns +#define fits_write_colnull_log ffpcnl +#define fits_write_colnull_byt ffpcnb +#define fits_write_colnull_usht ffpcnui +#define fits_write_colnull_ulng ffpcnuj +#define fits_write_colnull_sht ffpcni +#define fits_write_colnull_lng ffpcnj +#define fits_write_colnull_uint ffpcnuk +#define fits_write_colnull_int ffpcnk +#define fits_write_colnull_flt ffpcne +#define fits_write_colnull_dbl ffpcnd + +#define fits_write_descript ffpdes + +#define fits_write_tblbytes ffptbb +#define fits_insert_rows ffirow +#define fits_delete_rows ffdrow +#define fits_delete_rowlist ffdrws +#define fits_insert_col fficol +#define fits_insert_cols fficls +#define fits_delete_col ffdcol +#define fits_copy_col ffcpcl +#define fits_modify_vector_len ffmvec + +#define fits_read_img_coord ffgics +#define fits_read_tbl_coord ffgtcs +#define fits_pix_to_world ffwldp +#define fits_world_to_pix ffxypx + +#define fits_get_image_wcs_keys ffgiwcs +#define fits_get_table_wcs_keys ffgtwcs + +#define fits_find_rows fffrow +#define fits_find_first_row ffffrw +#define fits_find_rows_cmp fffrwc +#define fits_select_rows ffsrow +#define fits_calc_rows ffcrow +#define fits_calculator ffcalc +#define fits_calculator_rng ffcalc_rng +#define fits_test_expr fftexp + +#define fits_create_group ffgtcr +#define fits_insert_group ffgtis +#define fits_change_group ffgtch +#define fits_remove_group ffgtrm +#define fits_copy_group ffgtcp +#define fits_merge_groups ffgtmg +#define fits_compact_group ffgtcm +#define fits_verify_group ffgtvf +#define fits_open_group ffgtop +#define fits_add_group_member ffgtam +#define fits_get_num_members ffgtnm + +#define fits_get_num_groups ffgmng +#define fits_open_member ffgmop +#define fits_copy_member ffgmcp +#define fits_transfer_member ffgmtf +#define fits_remove_member ffgmrm + +#endif diff --git a/include/cfitsio/pctype.h b/include/cfitsio/pctype.h new file mode 100644 index 0000000..2ef4a67 --- /dev/null +++ b/include/cfitsio/pctype.h @@ -0,0 +1,155 @@ +/* + * These ones are necessary to override the behaviour of + * PINT_cfB, which puts the & on before getting to the + * TYPE specific PCINT_cfPP... + * The only way to do this is to introduce PCDOUBLE_cfINT, + * which means we use PCINT for alot of the generic macros. + */ + +#define PCINT_cfAA PINT_cfAA +#define PCINT_cfN PINT_cfN +#define PCINT_cfV PINT_cfV +#define PCINT_cfZ(T,I,A) (__cfztringv[I]= (int ) *A), +#define PCINT_cfSEP INT_cfSEP +#define PCINT_cfCC PINT_cfCC +#define PCINT_cfB(T,A) _(T,_cfPP) A +#define PCINT_cfU PINT_cfU + +/* These are the real TYPE specific ones, and will need to be + * duplicated for FLOAT,... + */ +#define PCINT_cfINT PCDOUBLE_cfINT +#define PCINT_cfAAP(A, B) A +#define PCINT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PCINT_cfTYPE int +#define PCINT_cfVP(A,B) int B = (int) *A; /* For ZSTRINGV_ARGS */ +#define PCINT_cfPP +#define PCINT_cfCCC(A,B) A + +#define PCFLOAT_cfINT PCDOUBLE_cfINT +#define PCFLOAT_cfAAP(A, B) A +#define PCFLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PCFLOAT_cfTYPE float +#define PCFLOAT_cfVP PCINT_cfVP /* For ZSTRINGV_ARGS */ +#define PCFLOAT_cfPP +#define PCFLOAT_cfCCC(A,B) A + +#define PCDOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,PCINT,B,X,Y,Z,0) +#define PCDOUBLE_cfAAP(A, B) A +#define PCDOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PCDOUBLE_cfTYPE double +#define PCDOUBLE_cfVP PCINT_cfVP /* For ZSTRINGV_ARGS */ +#define PCDOUBLE_cfPP +#define PCDOUBLE_cfCCC(A,B) A + +#define PCLOGICAL_cfINT PCDOUBLE_cfINT +#define PCLOGICAL_cfA(M,I,A,B) *A=C2FLOGICAL(*A); +#define PCLOGICAL_cfAAP(A,B) B = A +#define PCLOGICAL_cfC(A,B,C) *A=C2FLOGICAL(*A); +#define PCLOGICAL_cfH(S,U,B) +#define PCLOGICAL_cfJ(B) +#define PCLOGICAL_cfW(A,B) PLOGICAL_cfW(A,B) +#define PCLOGICAL_cfS(M,I,A) +#define PCLOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PCLOGICAL,A,B,C,D,E) +#define PCLOGICAL_cfTYPE int +#define PCLOGICAL_cfVP PLOGICAL_cfVP /* For ZSTRINGV_ARGS */ +#define PCLOGICAL_cfPP +#define PCLOGICAL_cfKK PLOGICAL_cfKK +#define PCLOGICAL_cfCCC(A,B) B = A + +/* + * I can't find where the following three defines are used... + * So they may well be wrong. + */ + +#define PCLOGICAL_cfQ(B) +#define PCLOGICAL_cfR(A,B,D) *A=C2FLOGICAL(*A); +#define PCLOGICAL_cfT(M,I,A,B,D) ((*A=F2CLOGICAL(*A)),A) + +/* This is to get PZTRINGS to work for dynamically allocated + * Contiguous arrays... The problem was that the array is massaged + * coming in with the call: c2fstrv( A[0], A[0],... ) + * and coming out with: f2cstrv( (char *) A, (char *) A,... ) + * + * If you dynamically allocate an array with the trick: + * + * char ** A; + * A = (char **) malloc ( nelements * sizeof(char *) ); + * A[0] = (char *) malloc (nelements * elemSize * sizeof (char) ); + * for ( i = 1; i < nelements; i++) A[i] = A[0] + i * elemSize; + * + * Then the coming in call will kill you if you pass in A, and the + * coming out call will kill you if you pass in A[0]... + * So, I change the coming in call to (char *)A, and you must then + * pass in A[0]. + * + */ + + +#undef PZTRINGV_cfA +#define PZTRINGV_cfA(M,I,A,B) APAZTRINGV_cfA(M,I,A,B, \ + (_3(M,_ELEMS_,I))*(( _3(M,_ELEMLEN_,I))+1), \ + (_3(M,_ELEMS_,I)),(_3(M,_ELEMLEN_,I))+1) +#ifdef vmsFortran +#define AAZTRINGV_cfA(M,I,A,B, sA,filA,silA) \ + initfstr(B,malloc((sA)-(filA)),(filA),(silA)-1), \ c2fstrv((char *) A,B.dsc$a_pointer,(silA),(sA)); +#define APAZTRINGV_cfA(M,I,A,B, sA,filA,silA) \ + initfstr(B,(char *) A,(filA),(silA)-1),c2fstrv((char *) A,(char *)A,(silA),(sA)); +#else +#define AAZTRINGV_cfA(M,I,A,B, sA,filA,silA) \ + (B.s=malloc((sA)-(filA)),B.fs=c2fstrv((char *)A,B.s,(B.flen=(silA)-1)+1,(sA))); +#define APAZTRINGV_cfA(M,I,A,B, sA,filA,silA) \ + B.fs=c2fstrv((char *) A,(char *) A,(B.flen=(silA)-1)+1,B.sizeofA=(sA)); +#endif + + +/* + * This allows for character arrays longer than an unsigned short... + */ + +#ifndef vmsFortran +#undef STRING_cfV +#undef PSTRINGV_cfV +#define STRING_cfV(T,A,B,F) struct {unsigned int clen, flen;} B; +#define PSTRINGV_cfV(T,A,B,F) struct {char *fs; unsigned int sizeofA, flen;} B; +#endif + +/* + * This is to introduce a PZTRING ( NO V ) type + */ + + +#ifdef vmsFortran +#define PZTRING_cfV(T,A,B,F) static fstring B={0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL}; +#define APATRING_cfA(M,I,A,B,silA) \ + (B.dsc$w_length=strlen(A),B.dsc$a_pointer=A, \ + B.dsc$w_length >= silA?0:(memset((A)+B.dsc$w_length,' ',silA-B.dsc$w_length-1), \ + A[B.dsc$w_length=silA-1]='\0')); +#define PZTRING_cfC(A,B,C) \ + (B.dsc$w_length=strlen(A),B.dsc$a_pointer=A, \ + B.dsc$w_length >= C?0:(memset((A)+B.dsc$w_length,' ',C-B.dsc$w_length-1), \ + A[B.dsc$w_length=C-1]='\0')); +#else +#define PZTRING_cfV(T,A,B,F) int B; +#define APATRING_cfA(M,I,A,B,silA) \ + (B=strlen(A),B >= silA?0:(memset((A)+B,' ',silA-B-1)),A[B = silA - 1]='\0'); +#define PZTRING_cfC(A,B,C) \ + (B=strlen(A),B > C?0:(memset((A)+B,' ',(C - 1)-B-1)),A[B = C - 1]='\0'); +#endif + +#define PZTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PZTRING,A,B,C,D,E) +#define PZTRING_cfINT PVOID_cfINT +#define PZTRING_cfA(M,I,A,B) APATRING_cfA(M,I,A,B,(_3(M,_ELEMLEN_,I))+1) +#define PZTRING_cfAA PSTRING_cfCC +#define PZTRING_cfB PSTRING_cfB + +#define PZTRING_cfCC PSTRING_cfCC +#define PZTRING_cfJ PSTRING_cfJ +#define PZTRING_cfH STRING_cfH +#define PZTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */ +#define PZTRING_cfS(M,I,A) ,( _3(M,_ELEMLEN_,I) + 1 ) +#define PZTRING_cfU(T,A) char *A +#define PZTRING_cfW(A,B) kill_trailing(A,' '); +#define PZTRING_cfZ(T,I,A) +#define PZTRING_cfSEP INT_cfSEP +#define PZTRING_cfKK STRING_cfKK diff --git a/include/cfitsio/region.h b/include/cfitsio/region.h new file mode 100644 index 0000000..4d7c96c --- /dev/null +++ b/include/cfitsio/region.h @@ -0,0 +1,80 @@ +/***************************************************************/ +/* REGION STUFF */ +/***************************************************************/ + +#define myPI 3.1415926535897932385 + +typedef struct { + int exists; + double xrefval, yrefval; + double xrefpix, yrefpix; + double xinc, yinc; + double rot; + char type[6]; +} WCSdata; + +typedef enum { + point_rgn, + line_rgn, + circle_rgn, + annulus_rgn, + ellipse_rgn, + elliptannulus_rgn, + box_rgn, + rectangle_rgn, + diamond_rgn, + sector_rgn, + poly_rgn +} shapeType; + +typedef enum { pixel_fmt, degree_fmt, hhmmss_fmt } coordFmt; + +typedef struct { + char sign; /* Include or exclude? */ + shapeType shape; /* Shape of this region */ + + union { /* Parameters - In pixels */ + + /**** Generic Shape Data ****/ + + struct { + double p[8]; /* Region parameters */ + double sinT, cosT; /* For rotated shapes */ + double a, b; /* Extra scratch area */ + } gen; + + /**** Polygon Data ****/ + + struct { + int nPts; /* Number of Polygon pts */ + double *Pts; /* Polygon points */ + double xmin,xmax; /* Polygon bounding box */ + double ymin,ymax; + } poly; + + } param; + +} RgnShape; + +typedef struct { + int nShapes; + RgnShape *Shapes; + WCSdata wcs; +} SAORegion; + +#ifdef __cplusplus +extern "C" { +#endif + +int ffrrgn( const char *filename, WCSdata *wcs, SAORegion **Rgn, int *status ); +int fftrgn( double X, double Y, SAORegion *Rgn ); +void fffrgn( SAORegion *Rgn ); + +#ifdef __cplusplus + } +#endif + +#define fits_read_rgnfile ffrrgn +#define fits_in_region fftrgn +#define fits_free_region fffrgn + diff --git a/include/cfitsio/ricecomp.h b/include/cfitsio/ricecomp.h new file mode 100644 index 0000000..4a48328 --- /dev/null +++ b/include/cfitsio/ricecomp.h @@ -0,0 +1,107 @@ +/* @(#) buffer.h 1.1 98/07/21 12:34:27 */ +/* buffer.h: structure for compression to buffer rather than to a file, including + * bit I/O buffer + * + * R. White, 19 June 1998 + */ + + +typedef unsigned char Buffer_t; + +typedef struct { + int bitbuffer; /* bit buffer */ + int bits_to_go; /* bits to go in buffer */ + Buffer_t *start; /* start of buffer */ + Buffer_t *current; /* current position in buffer */ + Buffer_t *end; /* end of buffer */ +} Buffer; + +#define buffree(mf) (free(mf->start), free(mf)) +#define bufused(mf) (mf->current - mf->start) +#define bufreset(mf) (mf->current = mf->start) + +/* + * getcbuf, putcbuf macros for character IO to buffer + * putcbuf returns EOF on end of buffer, else returns 0 + */ +#define getcbuf(mf) ((mf->current >= mf->end) ? EOF : *(mf->current)++) +#define putcbuf(c,mf) \ + ((mf->current >= mf->end) ? \ + EOF :\ + ((*(mf->current)++ = c), 0)) + +/* + * bufalloc sets up buffer of length n + */ + +/* not needed by CFITSIO + +static Buffer *bufalloc(int n) +{ +Buffer *mf; + + mf = (Buffer *) malloc(sizeof(Buffer)); + if (mf == (Buffer *)NULL) return((Buffer *)NULL); + + mf->start = (Buffer_t *) malloc(n*sizeof(Buffer_t)); + if (mf->start == (Buffer_t *)NULL) { + free(mf); + return((Buffer *)NULL); + } + mf->bits_to_go = 8; + mf->end = mf->start + n; + mf->current = mf->start; + return(mf); +} +*/ + +/* + * bufrealloc extends buffer (or truncates it) by + * reallocating memory + */ + +/* not needed by CFITSIO +static int bufrealloc(Buffer *mf, int n) +{ +int len; + + len = mf->current - mf->start; + + * silently throw away data if buffer is already longer than n * + if (len>n) len = n; + if (len<0) len = 0; + + mf->start = (Buffer_t *) realloc(mf->start, n*sizeof(Buffer_t)); + if (mf->start == (Buffer_t *)NULL) return(0); + + mf->end = mf->start + n; + mf->current = mf->start + len; + return(n); +} +*/ + +/* + * bufdump dumps contents of buffer to outfile and resets + * it to be empty. Returns number of bytes written. + * + * Note we don't write out the bit buffer -- you must call + * done_outputing_bits() first to ensure that the bit buffer + * is written out. I do it this way to allow incremental + * buffer dumps while bit IO is still going on. + */ + +/* not needed by CFITSIO + +static int bufdump(FILE *outfile, Buffer *buffer) +{ +int ndump; + + ndump = bufused(buffer); + if (fwrite(buffer->start, 1, ndump, outfile) != ndump) { + fprintf(stderr, "bufdump: error in write\n"); + exit(1); + } + bufreset(buffer); + return(ndump); +} +*/ |