cforthdf.h

GIS系统支持库Geospatial Data Abstraction Library代码.GDAL is a translator library for raster geospatial dat

#define STR_LONGVVV(       N,T,A,B,C,D)
#define STR_LONGVVVV(      N,T,A,B,C,D)
#define STR_LONGVVVVV(     N,T,A,B,C,D)
#define STR_LONGVVVVVV(    N,T,A,B,C,D)
#define STR_LONGVVVVVVV(   N,T,A,B,C,D)
#define STR_SHORTV(        N,T,A,B,C,D)
#define STR_SHORTVV(       N,T,A,B,C,D)
#define STR_SHORTVVV(      N,T,A,B,C,D)
#define STR_SHORTVVVV(     N,T,A,B,C,D)
#define STR_SHORTVVVVV(    N,T,A,B,C,D)
#define STR_SHORTVVVVVV(   N,T,A,B,C,D)
#define STR_SHORTVVVVVVV(  N,T,A,B,C,D)
#define STR_PBYTE(         N,T,A,B,C,D)
#define STR_PDOUBLE(       N,T,A,B,C,D)
#define STR_PFLOAT(        N,T,A,B,C,D)
#define STR_PINT(          N,T,A,B,C,D)
#define STR_PLOGICAL(      N,T,A,B,C,D) CFARGS##N(T,PLOGICAL,A,B,C,D)
#define STR_PLONG(         N,T,A,B,C,D)
#define STR_PSHORT(        N,T,A,B,C,D)
#define STR_STRING(        N,T,A,B,C,D) CFARGS##N(T,STRING,A,B,C,D)
#define STR_PSTRING(       N,T,A,B,C,D) CFARGS##N(T,PSTRING,A,B,C,D)
#define STR_STRINGV(       N,T,A,B,C,D) CFARGS##N(T,STRINGV,A,B,C,D)
#define STR_PSTRINGV(      N,T,A,B,C,D) CFARGS##N(T,PSTRINGV,A,B,C,D)
#define STR_PNSTRING(      N,T,A,B,C,D) CFARGS##N(T,PNSTRING,A,B,C,D)
#define STR_PPSTRING(      N,T,A,B,C,D) CFARGS##N(T,PPSTRING,A,B,C,D)
#define STR_STRVOID(        N,T,A,B,C,D) CFARGS##N(T,STRVOID,A,B,C,D)
#define STR_PVOID(         N,T,A,B,C,D)
#define STR_ROUTINE(       N,T,A,B,C,D)
#define STR_SIMPLE(        N,T,A,B,C,D)
#define STR_ZTRINGV(       N,T,A,B,C,D) CFARGS##N(T,ZTRINGV,A,B,C,D)
#define STR_PZTRINGV(      N,T,A,B,C,D) CFARGS##N(T,PZTRINGV,A,B,C,D)
#define STR_CF_0(          N,T,A,B,C,D)               

/* See ACF table comments, which explain why CCF was split into two. */
#define CCF(TN,I)          STR_##TN(3,C,A##I,B##I,C##I,0)
#define CLOGICAL( A,B,C)  A=C2FLOGICAL( A);
#define CPLOGICAL(A,B,C) *A=C2FLOGICAL(*A);
#ifdef vmsFortran
#define CSTRING(  A,B,C) (B.clen=strlen(A),B.f.dsc$a_pointer=A,                \
                    C==sizeof(char*)||C==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'));
#define CSTRINGV( A,B,C) (                                                     \
          initfstr(B, malloc((C/0xFFFF)*(C%0xFFFF-1)), C/0xFFFF, C%0xFFFF-1),  \
          c2fstrv(A,B.dsc$a_pointer,C%0xFFFF,(C/0xFFFF)*(C%0xFFFF)) );
#define CPSTRING( A,B,C) (B.dsc$w_length=strlen(A),B.dsc$a_pointer=A,          \
        C==sizeof(char*)?0:(memset((A)+B.dsc$w_length,' ',C-B.dsc$w_length-1), \
                             A[B.dsc$w_length=C-1]='\0'));
#define CPSTRINGV(A,B,C)  (initfstr(B, A, C/0xFFFF, C%0xFFFF-1),               \
                             c2fstrv(A,A,C%0xFFFF,(C/0xFFFF)*(C%0xFFFF)) );
#else
#ifdef CRAYFortran
#define CSTRING(  A,B,C) (B.clen=strlen(A),                                    \
                          C==sizeof(char*)||C==B.clen+1?B.flen=B.clen:         \
                        (memset((A)+B.clen,' ',C-B.clen-1),A[B.flen=C-1]='\0'));
#define CSTRINGV( A,B,C) (B.s=malloc((C/0xFFFF)*(C%0xFFFF-1)),                 \
                    c2fstrv(A,B.s,(B.flen=C%0xFFFF-1)+1,(C/0xFFFF)*(C%0xFFFF)));
#define CPSTRING( A,B,C) (B=strlen(A), C==sizeof(char*)?0:                     \
                            (memset((A)+B,' ',C-B-1),A[B=C-1]='\0'));
#define CPSTRINGV(A,B,C) c2fstrv(A,A,(B.flen=C%0xFFFF-1)+1,                    \
                                   B.sizeofA=(C/0xFFFF)*(C%0xFFFF));
#else
#define CSTRING(  A,B,C) (B.clen=strlen(A),                                    \
                            C==sizeof(char*)||C==B.clen+1?B.flen=B.clen:       \
                        (memset((A)+B.clen,' ',C-B.clen-1),A[B.flen=C-1]='\0'));
#define CSTRINGV( A,B,C) (B.s=malloc((C/0xFFFF)*(C%0xFFFF-1)),                 \
               B.fs=c2fstrv(A,B.s,(B.flen=C%0xFFFF-1)+1,(C/0xFFFF)*(C%0xFFFF)));
#define CPSTRING( A,B,C) (B=strlen(A), C==sizeof(char*)?0:                     \
                            (memset((A)+B,' ',C-B-1),A[B=C-1]='\0'));
#define CPSTRINGV(A,B,C) B.fs=c2fstrv(A,A,(B.flen=C%0xFFFF-1)+1,               \
                                        B.sizeofA=(C/0xFFFF)*(C%0xFFFF));
#endif
#endif
#define CZTRINGV         CSTRINGV
#define CPZTRINGV        CPSTRINGV

#define CCCBYTE(    A,B) &A
#define CCCDOUBLE(  A,B) &A
#if !defined(__CF__KnR)
#define CCCFLOAT(   A,B) &A
                            /* Although the VAX doesn't, at least the         */
#else                       /* HP and K&R mips promote float arg.'s of        */
#define CCCFLOAT(   A,B) &B /* unprototyped functions to double. So we can't  */
#endif                      /* use A here to pass the argument to FORTRAN.    */
#define CCCINT(     A,B) &A
#define CCCLOGICAL( A,B) &A
#define CCCLONG(    A,B) &A
#define CCCSHORT(   A,B) &A
#define CCCPBYTE(   A,B)  A
#define CCCPDOUBLE( A,B)  A
#define CCCPFLOAT(  A,B)  A
#define CCCPINT(    A,B)  A
#define CCCPLOGICAL(A,B)  B=A       /* B used to keep a common W table. */
#define CCCPLONG(   A,B)  A
#define CCCPSHORT(  A,B)  A

#define CCCF(TN,I,M)    _SEP_(TN,M,COMMA) _INT(3,CC,TN,A##I,B##I)
#define CCINT(       T,A,B) CCC##T(A,B) 
#define CCINTV(      T,A,B)  A
#define CCINTVV(     T,A,B)  A
#define CCINTVVV(    T,A,B)  A
#define CCINTVVVV(   T,A,B)  A
#define CCINTVVVVV(  T,A,B)  A
#define CCINTVVVVVV( T,A,B)  A
#define CCINTVVVVVVV(T,A,B)  A
#define CCPINT(      T,A,B) CCC##T(A,B) 
#define CCPVOID(     T,A,B)  A
#ifdef apolloFortran
#define CCROUTINE(   T,A,B) &A
#else
#define CCROUTINE(   T,A,B)  A
#endif
#define CCSIMPLE(    T,A,B)  A
#ifdef vmsFortran
#define CCSTRING(    T,A,B) &B.f
#define CCSTRINGV(   T,A,B) &B
#define CCPSTRING(   T,A,B) &B
#define CCPSTRINGV(  T,A,B) &B
#else
#ifdef CRAYFortran
#define CCSTRING(    T,A,B) _cptofcd(A,B.flen)
#define CCSTRINGV(   T,A,B) _cptofcd(B.s,B.flen)
#define CCPSTRING(   T,A,B) _cptofcd(A,B)
#define CCPSTRINGV(  T,A,B) _cptofcd(A,B.flen)
#else
#define CCSTRING(    T,A,B)  A
#define CCSTRINGV(   T,A,B)  B.fs
#define CCPSTRING(   T,A,B)  A
#define CCPSTRINGV(  T,A,B)  B.fs
#endif
#endif
#define CCZTRINGV           CCSTRINGV
#define CCPZTRINGV          CCPSTRINGV

#define XBYTE          return A0;
#define XDOUBLE        return A0;
#ifndef sunFortran
#define XFLOAT         return A0;
#else
#define XFLOAT         ASSIGNFLOAT(AA0,A0); return AA0;
#endif
#define XINT           return A0;
#define XLOGICAL       return F2CLOGICAL(A0);
#define XLONG          return A0;
#define XSHORT         return A0;
#define XVOID          return   ;
#if defined(vmsFortran) || defined(CRAYFortran)
#define XSTRING        return kill_trailing(                                   \
                                      kill_trailing(AA0,CFORTRAN_NON_CHAR),' ');
#else
#define XSTRING        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)\
(ZCF(T1,1,A1) ZCF(T2,2,A2) ZCF(T3,3,A3) ZCF(T4,4,A4) ZCF(T5,5,A5)              \
 ZCF(T6,6,A6) ZCF(T7,7,A7) ZCF(T8,8,A8) ZCF(T9,9,A9) ZCF(TA,A,AA)              \
 (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) \
           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))))

/*  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)                                              \
PU##F( CFC_(UN,LN))(CF_NULL_PROTO);                                          \
static _INT(2,U,F,CFFUN(UN),0)() {E##F  _INT(3,GZ,F,UN,LN)); X##F}

#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)

/* HP/UX 9.01 cc requires the blank between '_INT(3,G,T0,UN,LN) CCCF(T1,1,0)' */

#ifndef __CF__KnR
#define PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA)              \
PU##T0(CFC_(UN,LN))(CF_NULL_PROTO);                                          \
static _INT(2,U,T0,CFFUN(UN),0)(UCF(T1,1,0) UCF(T2,2,1) UCF(T3,3,1) UCF(T4,4,1)  \
   UCF(T5,5,1) UCF(T6,6,1) UCF(T7,7,1) UCF(T8,8,1) UCF(T9,9,1) UCF(TA,A,1)     \
                         HCF(T1,1) HCF(T2,2) HCF(T3,3) HCF(T4,4) HCF(T5,5)     \
                         HCF(T6,6) HCF(T7,7) HCF(T8,8) HCF(T9,9) HCF(TA,A) )   \
{VCF(T1,1) VCF(T2,2) VCF(T3,3) VCF(T4,4) VCF(T5,5)                             \
 VCF(T6,6) VCF(T7,7) VCF(T8,8) VCF(T9,9) VCF(TA,A) E##T0                     \
 CCF(T1,1) CCF(T2,2) CCF(T3,3) CCF(T4,4) CCF(T5,5)                             \
 CCF(T6,6) CCF(T7,7) CCF(T8,8) CCF(T9,9) CCF(TA,A)                             \
 _INT(3,G,T0,UN,LN) CCCF(T1,1,0) CCCF(T2,2,1) CCCF(T3,3,1) CCCF(T4,4,1) CCCF(T5,5,1)\
                    CCCF(T6,6,1) CCCF(T7,7,1) CCCF(T8,8,1) CCCF(T9,9,1) CCCF(TA,A,1)\
               JCF(T1,1) JCF(T2,2) JCF(T3,3) JCF(T4,4) JCF(T5,5)               \
               JCF(T6,6) JCF(T7,7) JCF(T8,8) JCF(T9,9) JCF(TA,A));             \
 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) X##T0}
#else
#define PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA)              \
PU##T0(CFC_(UN,LN))(CF_NULL_PROTO);                                          \
static _INT(2,U,T0,CFFUN(UN),0)(UUCF(T1,1,0) UUCF(T2,2,1) UUCF(T3,3,1) UUCF(T4,4,1) \
      UUCF(T5,5,1) UUCF(T6,6,1) UUCF(T7,7,1) UUCF(T8,8,1) UUCF(T9,9,1) UUCF(TA,A,1) \
                       HHCF(T1,1) HHCF(T2,2) HHCF(T3,3) HHCF(T4,4) HHCF(T5,5)  \
                       HHCF(T6,6) HHCF(T7,7) HHCF(T8,8) HHCF(T9,9) HHCF(TA,A)) \
 UUUCF(T1,1,0) UUUCF(T2,2,1) UUUCF(T3,3,1) UUUCF(T4,4,1) UUUCF(T5,5,1)         \
 UUUCF(T6,6,1) UUUCF(T7,7,1) UUUCF(T8,8,1) UUUCF(T9,9,1) UUUCF(TA,A,1)         \
           HHHCF(T1,1) HHHCF(T2,2) HHHCF(T3,3) HHHCF(T4,4) HHHCF(T5,5)         \
           HHHCF(T6,6) HHHCF(T7,7) HHHCF(T8,8) HHHCF(T9,9) HHHCF(TA,A);        \
{VCF(T1,1) VCF(T2,2) VCF(T3,3) VCF(T4,4) VCF(T5,5)                             \
 VCF(T6,6) VCF(T7,7) VCF(T8,8) VCF(T9,9) VCF(TA,A) E##T0                     \
 CCF(T1,1) CCF(T2,2) CCF(T3,3) CCF(T4,4) CCF(T5,5)                             \
 CCF(T6,6) CCF(T7,7) CCF(T8,8) CCF(T9,9) CCF(TA,A)                             \
 _INT(3,G,T0,UN,LN) CCCF(T1,1,0) CCCF(T2,2,1) CCCF(T3,3,1) CCCF(T4,4,1) CCCF(T5,5,1)\
                    CCCF(T6,6,1) CCCF(T7,7,1) CCCF(T8,8,1) CCCF(T9,9,1) CCCF(TA,A,1)\
               JCF(T1,1) JCF(T2,2) JCF(T3,3) JCF(T4,4) JCF(T5,5)               \
               JCF(T6,6) JCF(T7,7) JCF(T8,8) JCF(T9,9) JCF(TA,A) );            \
 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) X##T0}
#endif

/*-------------------------------------------------------------------------*/

/*               UTILITIES FOR FORTRAN TO CALL C ROUTINES                  */

#ifdef OLD_VAXC                                /* Prevent %CC-I-PARAMNOTUSED. */
#pragma nostandard
#endif

#if defin