My Project
 All Classes Files Functions Variables Enumerations Enumerator Friends Macros Pages
pctype.h
1 /*
2  * These ones are necessary to override the behaviour of
3  * PINT_cfB, which puts the & on before getting to the
4  * TYPE specific PCINT_cfPP...
5  * The only way to do this is to introduce PCDOUBLE_cfINT,
6  * which means we use PCINT for alot of the generic macros.
7  */
8 
9 #define PCINT_cfAA PINT_cfAA
10 #define PCINT_cfN PINT_cfN
11 #define PCINT_cfV PINT_cfV
12 #define PCINT_cfZ(T,I,A) (__cfztringv[I]= (int ) *A),
13 #define PCINT_cfSEP INT_cfSEP
14 #define PCINT_cfCC PINT_cfCC
15 #define PCINT_cfB(T,A) _(T,_cfPP) A
16 #define PCINT_cfU PINT_cfU
17 
18 /* These are the real TYPE specific ones, and will need to be
19  * duplicated for FLOAT,...
20  */
21 #define PCINT_cfINT PCDOUBLE_cfINT
22 #define PCINT_cfAAP(A, B) A
23 #define PCINT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
24 #define PCINT_cfTYPE int
25 #define PCINT_cfVP(A,B) int B = (int) *A; /* For ZSTRINGV_ARGS */
26 #define PCINT_cfPP
27 #define PCINT_cfCCC(A,B) A
28 
29 #define PCFLOAT_cfINT PCDOUBLE_cfINT
30 #define PCFLOAT_cfAAP(A, B) A
31 #define PCFLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
32 #define PCFLOAT_cfTYPE float
33 #define PCFLOAT_cfVP PCINT_cfVP /* For ZSTRINGV_ARGS */
34 #define PCFLOAT_cfPP
35 #define PCFLOAT_cfCCC(A,B) A
36 
37 #define PCDOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,PCINT,B,X,Y,Z,0)
38 #define PCDOUBLE_cfAAP(A, B) A
39 #define PCDOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
40 #define PCDOUBLE_cfTYPE double
41 #define PCDOUBLE_cfVP PCINT_cfVP /* For ZSTRINGV_ARGS */
42 #define PCDOUBLE_cfPP
43 #define PCDOUBLE_cfCCC(A,B) A
44 
45 #define PCLOGICAL_cfINT PCDOUBLE_cfINT
46 #define PCLOGICAL_cfA(M,I,A,B) *A=C2FLOGICAL(*A);
47 #define PCLOGICAL_cfAAP(A,B) B = A
48 #define PCLOGICAL_cfC(A,B,C) *A=C2FLOGICAL(*A);
49 #define PCLOGICAL_cfH(S,U,B)
50 #define PCLOGICAL_cfJ(B)
51 #define PCLOGICAL_cfW(A,B) PLOGICAL_cfW(A,B)
52 #define PCLOGICAL_cfS(M,I,A)
53 #define PCLOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PCLOGICAL,A,B,C,D,E)
54 #define PCLOGICAL_cfTYPE int
55 #define PCLOGICAL_cfVP PLOGICAL_cfVP /* For ZSTRINGV_ARGS */
56 #define PCLOGICAL_cfPP
57 #define PCLOGICAL_cfKK PLOGICAL_cfKK
58 #define PCLOGICAL_cfCCC(A,B) B = A
59 
60 /*
61  * I can't find where the following three defines are used...
62  * So they may well be wrong.
63  */
64 
65 #define PCLOGICAL_cfQ(B)
66 #define PCLOGICAL_cfR(A,B,D) *A=C2FLOGICAL(*A);
67 #define PCLOGICAL_cfT(M,I,A,B,D) ((*A=F2CLOGICAL(*A)),A)
68 
69 /* This is to get PZTRINGS to work for dynamically allocated
70  * Contiguous arrays... The problem was that the array is massaged
71  * coming in with the call: c2fstrv( A[0], A[0],... )
72  * and coming out with: f2cstrv( (char *) A, (char *) A,... )
73  *
74  * If you dynamically allocate an array with the trick:
75  *
76  * char ** A;
77  * A = (char **) malloc ( nelements * sizeof(char *) );
78  * A[0] = (char *) malloc (nelements * elemSize * sizeof (char) );
79  * for ( i = 1; i < nelements; i++) A[i] = A[0] + i * elemSize;
80  *
81  * Then the coming in call will kill you if you pass in A, and the
82  * coming out call will kill you if you pass in A[0]...
83  * So, I change the coming in call to (char *)A, and you must then
84  * pass in A[0].
85  *
86  */
87 
88 
89 #undef PZTRINGV_cfA
90 #define PZTRINGV_cfA(M,I,A,B) APAZTRINGV_cfA(M,I,A,B, \
91  (_3(M,_ELEMS_,I))*(( _3(M,_ELEMLEN_,I))+1), \
92  (_3(M,_ELEMS_,I)),(_3(M,_ELEMLEN_,I))+1)
93 #ifdef vmsFortran
94 #define AAZTRINGV_cfA(M,I,A,B, sA,filA,silA) \
95  initfstr(B,malloc((sA)-(filA)),(filA),(silA)-1), \ c2fstrv((char *) A,B.dsc$a_pointer,(silA),(sA));
96 #define APAZTRINGV_cfA(M,I,A,B, sA,filA,silA) \
97  initfstr(B,(char *) A,(filA),(silA)-1),c2fstrv((char *) A,(char *)A,(silA),(sA));
98 #else
99 #define AAZTRINGV_cfA(M,I,A,B, sA,filA,silA) \
100  (B.s=malloc((sA)-(filA)),B.fs=c2fstrv((char *)A,B.s,(B.flen=(silA)-1)+1,(sA)));
101 #define APAZTRINGV_cfA(M,I,A,B, sA,filA,silA) \
102  B.fs=c2fstrv((char *) A,(char *) A,(B.flen=(silA)-1)+1,B.sizeofA=(sA));
103 #endif
104 
105 
106 /*
107  * This allows for character arrays longer than an unsigned short...
108  */
109 
110 #ifndef vmsFortran
111 #undef STRING_cfV
112 #undef PSTRINGV_cfV
113 #define STRING_cfV(T,A,B,F) struct {unsigned int clen, flen;} B;
114 #define PSTRINGV_cfV(T,A,B,F) struct {char *fs; unsigned int sizeofA, flen;} B;
115 #endif
116 
117 /*
118  * This is to introduce a PZTRING ( NO V ) type
119  */
120 
121 
122 #ifdef vmsFortran
123 #define PZTRING_cfV(T,A,B,F) static fstring B={0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL};
124 #define APATRING_cfA(M,I,A,B,silA) \
125  (B.dsc$w_length=strlen(A),B.dsc$a_pointer=A, \
126  B.dsc$w_length >= silA?0:(memset((A)+B.dsc$w_length,' ',silA-B.dsc$w_length-1), \
127  A[B.dsc$w_length=silA-1]='\0'));
128 #define PZTRING_cfC(A,B,C) \
129  (B.dsc$w_length=strlen(A),B.dsc$a_pointer=A, \
130  B.dsc$w_length >= C?0:(memset((A)+B.dsc$w_length,' ',C-B.dsc$w_length-1), \
131  A[B.dsc$w_length=C-1]='\0'));
132 #else
133 #define PZTRING_cfV(T,A,B,F) int B;
134 #define APATRING_cfA(M,I,A,B,silA) \
135  (B=strlen(A),B >= silA?0:(memset((A)+B,' ',silA-B-1)),A[B = silA - 1]='\0');
136 #define PZTRING_cfC(A,B,C) \
137  (B=strlen(A),B > C?0:(memset((A)+B,' ',(C - 1)-B-1)),A[B = C - 1]='\0');
138 #endif
139 
140 #define PZTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PZTRING,A,B,C,D,E)
141 #define PZTRING_cfINT PVOID_cfINT
142 #define PZTRING_cfA(M,I,A,B) APATRING_cfA(M,I,A,B,(_3(M,_ELEMLEN_,I))+1)
143 #define PZTRING_cfAA PSTRING_cfCC
144 #define PZTRING_cfB PSTRING_cfB
145 
146 #define PZTRING_cfCC PSTRING_cfCC
147 #define PZTRING_cfJ PSTRING_cfJ
148 #define PZTRING_cfH STRING_cfH
149 #define PZTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */
150 #define PZTRING_cfS(M,I,A) ,( _3(M,_ELEMLEN_,I) + 1 )
151 #define PZTRING_cfU(T,A) char *A
152 #define PZTRING_cfW(A,B) kill_trailing(A,' ');
153 #define PZTRING_cfZ(T,I,A)
154 #define PZTRING_cfSEP INT_cfSEP
155 #define PZTRING_cfKK STRING_cfKK