File: f77_wrap.h

package info (click to toggle)
cfitsio 3.470-3
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 14,484 kB
  • sloc: ansic: 106,145; yacc: 4,883; sh: 3,259; fortran: 2,613; lex: 504; makefile: 162
file content (287 lines) | stat: -rw-r--r-- 10,911 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
#define UNSIGNED_BYTE

#include <cfortran.h>

/************************************************************************
   Some platforms creates longs as 8-byte integers.  On other machines, ints
   and longs are both 4-bytes, so both are compatible with Fortrans
   default integer which is 4-bytes.  To support 8-byte longs, 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)) \
    || (defined(mipsFortran)  && _MIPS_SZLONG==64) \
    || (defined(IBMR2Fortran) && defined(__64BIT__)) \
    ||  defined(__ia64__)  \
    ||  defined (__sparcv9) || (defined(__sparc__) && defined(__arch64__)) \
    ||  defined (__x86_64__) \
    ||  defined (_SX) \
    ||  defined (__powerpc64__)\
    ||  defined (__s390x__)

#define   LONG8BYTES_INT4BYTES

#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) CFORTRAN_XCAT_(CFARGS,N)(T,LONGV,A,B,C,D,E)
#define    PLONG_cfSTR(N,T,A,B,C,D,E) CFORTRAN_XCAT_(CFARGS,N)(T,PLONG,A,B,C,D,E)
#define    LONGVVVVVVV_cfTYPE    int
#define    PLONG_cfTYPE          int
#define    LONGV_cfQ(B)          long *B, CFORTRAN_XCAT_(B,N);
#define    PLONG_cfQ(B)          long B;
#define    LONGV_cfT(M,I,A,B,D)  ( (CFORTRAN_XCAT_(B,N) = * CFORTRAN_XCAT_3(M,_LONGV_A,I)), \
				    B = F2Clongv(CFORTRAN_XCAT_(B,N),A) )
#define    PLONG_cfT(M,I,A,B,D)  ((B=*A),&B)
#define    LONGV_cfR(A,B,D)      C2Flongv(CFORTRAN_XCAT_(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, \
                                                  CFORTRAN_XCAT_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 CFORTRAN_XCAT_(B,N), CFORTRAN_XCAT_(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)  ( \
            CFORTRAN_XCAT_(B,N)=_cfMAX(E,1), \
            CFORTRAN_XCAT_(B,M)=_cfMAX(D,gMinStrLen)+1, \
            B=(char**)malloc(CFORTRAN_XCAT_(B,N)*sizeof(char*)), \
            B[0]=(char*)malloc(CFORTRAN_XCAT_(B,N)*CFORTRAN_XCAT_(B,M)), \
            vindex(B,CFORTRAN_XCAT_(B,M),CFORTRAN_XCAT_(B,N),f2cstrv2(A,B[0],D,CFORTRAN_XCAT_(B,M),CFORTRAN_XCAT_(B,N))) \
            )
#define  RRRRPSTRV(A,B,D)    \
            c2fstrv2(B[0],A,CFORTRAN_XCAT_(B,M),D,CFORTRAN_XCAT_(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)      CFORTRAN_XCAT_(CFARGS,N)(A,BYTE,B,X,Y,Z,0)
#define   BYTEV_cfINT(N,A,B,X,Y,Z)     CFORTRAN_XCAT_(CFARGS,N)(A,BYTEV,B,X,Y,Z,0)
#define   BYTE_cfSTR(N,T,A,B,C,D,E)    CFORTRAN_XCAT_(CFARGS,N)(T,BYTE,A,B,C,D,E)
#define   BYTEV_cfSTR(N,T,A,B,C,D,E)   CFORTRAN_XCAT_(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) CFORTRAN_XCAT_(CFARGS,N)(T,LOGICALV,A,B,C,D,E)
#define LOGICALV_cfQ(B)               char *B; unsigned int CFORTRAN_XCAT_(B,N);
#define LOGICALV_cfT(M,I,A,B,D)       (CFORTRAN_XCAT_(B,N)= * CFORTRAN_XCAT_3(M,_LOGV_A,I), \
                                            B=F2CcopyLogVect(CFORTRAN_XCAT_(B,N),A))
#define LOGICALV_cfR(A,B,D)           C2FcopyLogVect(CFORTRAN_XCAT_(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.         */
/*-----------------------------------------------------------------*/

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 CFORTRAN_XCAT_(T0,_cfFZ)(UN,LN) void ABSOFT_cf2(T0)); \
  CFextern CFORTRAN_XCAT_(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) CFORTRAN_XCAT_(T0,_cfI)}

#define FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)    \
  CFextern CFORTRAN_XCAT_(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 CFORTRAN_XCAT_(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,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \
    TCF(LN,TD,13,1) TCF(LN,TE,14,1) );                          _Icf(0,K,T0,0,0) \
    CFARGT14S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)        CFORTRAN_XCAT_(T0,_cfI) \
  }