cfortran.h

c++经典教材 Blitz++ v0.8

#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) float 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)() = (void (*)())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 short 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 short 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(A[0],B,sizeof(A),firstindexlength(A),secondindexlength(A))
#define  PSTRINGV_cfA(M,I,A,B)                                                 \
        APATRINGV_cfA(A[0],B,sizeof(A),firstindexlength(A),secondindexlength(A))
#define   ZTRINGV_cfA(M,I,A,B) AATRINGV_cfA( A[0],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( A[0],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(*)())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)()
#else
#define    ROUTINE_cfN(T,A) void ( *A)()
#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