3 #define BIGGEST_SHORT 0x7fff /* Assumes 32-bit arithmetic */
4 #define BIGGEST_LONG 0x7fffffff /* Assumes 32-bit arithmetic */
6 #define M(x) (1<<x) /* Mask (x) returns 2^x */
8 #define ALLOC(x) (struct x *) ckalloc(sizeof(struct x))
9 #define ALLEXPR (expptr) ckalloc( sizeof(union Expression) )
11 typedef char *charptr;
14 typedef char field; /* actually need only 4 bits */
15 typedef long int ftnint;
21 #define CNULL (char *) 0 /* Character string null */
23 #define CHNULL (chainp) 0 /* Chain null */
24 #define ENULL (expptr) 0
27 /* BAD_MEMNO - used to distinguish between long string constants and other
28 constants in the table */
30 #define BAD_MEMNO -32768
33 /* block tag values -- syntactic stuff */
39 #define TPRIM 5 /* Primitive datum - should not appear in an
40 expptr variable, it should have already been
47 /* parser states - order is important, since there are several tests for
56 /* procedure classes */
64 /* storage classes -- vstg values. BSS and INIT are used in the later
65 merge pass over identifiers; and they are entered differently into the
69 #define STGARG 1 /* adjustable dimensions */
70 #define STGAUTO 2 /* for stack references */
71 #define STGBSS 3 /* uninitialized storage (normal variables) */
72 #define STGINIT 4 /* initialized storage */
74 #define STGEXT 6 /* external storage */
75 #define STGINTR 7 /* intrinsic (late decision) reference. See
76 chapter 5 of the Fortran 77 standard */
80 #define STGREG 11 /* register - the outermost DO loop index will be
81 in a register (because the compiler is one
82 pass, it can't know where the innermost loop is
86 #define STGMEMNO 14 /* interemediate-file pointer to constant table */
88 /* name classes -- vclass values, also procclass values */
91 #define CLPARAM 1 /* Parameter - macro definition */
92 #define CLVAR 2 /* variable */
97 #define CLNAMELIST 7 /* in data with this tag, the vdcldone flag should
98 be ignored (according to vardcl()) */
101 /* vprocclass values -- there is some overlap with the vclass values given
108 #define PTHISPROC 4 /* here to allow recursion - further distinction
109 is given in the CL tag (those just above).
110 This applies to the presence of the name of a
111 function used within itself. The function name
112 means either call the function again, or assign
113 some value to the storage allocated to the
114 function's return value. */
116 /* control stack codes - these are part of a state machine which handles
117 the nesting of blocks (i.e. what to do about the ELSE statement) */
124 /* operators for both Fortran input and C output. They are common because
125 so many are shared between the trees */
160 #define OPCOMMA_ARG 34
166 #define OPWHATSIN 40 /* dereferencing operator */
167 #define OPMINUSEQ 41 /* assignment operators */
170 #define OPLSHIFTEQ 44
171 #define OPRSHIFTEQ 45
172 #define OPBITANDEQ 46
173 #define OPBITXOREQ 47
175 #define OPPREINC 49 /* Preincrement (++x) operator */
176 #define OPPREDEC 50 /* Predecrement (--x) operator */
177 #define OPDOT 51 /* structure field reference */
178 #define OPARROW 52 /* structure pointer field reference */
179 #define OPNEG1 53 /* simple negation under forcedouble */
180 #define OPDMIN 54 /* min(a,b) macro under forcedouble */
181 #define OPDMAX 55 /* max(a,b) macro under forcedouble */
182 #define OPASSIGNI 56 /* assignment for inquire stmt */
183 #define OPIDENTITY 57 /* for turning TADDR into TEXPR */
184 #define OPCHARCAST 58 /* for casting to char * (in I/O stmts) */
185 #define OPDABS 59 /* abs macro under forcedouble */
186 #define OPMIN2 60 /* min(a,b) macro */
187 #define OPMAX2 61 /* max(a,b) macro */
189 /* label type codes -- used with the ASSIGN statement */
197 /* INTRINSIC function codes*/
203 #define INTRGEN 4 /* General intrinsic, e.g. cos v. dcos, zcos, ccos */
206 #define INTRCNST 7 /* constants, e.g. bigint(1.0) v. bigint (1d0) */
209 /* I/O statement codes - these all form Integer Constants, and are always
212 #define IOSTDIN ICON(5)
213 #define IOSTDOUT ICON(6)
214 #define IOSTDERR ICON(0)
217 #define IOSPOSITIONAL 0
225 #define IOBACKSPACE 5
231 /* User name tags -- these identify the form of the original identifier
232 stored in a struct Addrblock structure (in the user field). */
234 #define UNAM_UNKNOWN 0 /* Not specified */
235 #define UNAM_NAME 1 /* Local symbol, store in the hash table */
236 #define UNAM_IDENT 2 /* Character string not stored elsewhere */
237 #define UNAM_EXTERN 3 /* External reference; check symbol table
238 using memno as index */
239 #define UNAM_CONST 4 /* Constant value */
240 #define UNAM_CHARP 5 /* pointer to string */
243 #define IDENT_LEN 31 /* Maximum length user.ident */
245 /* type masks - TYLOGICAL defined in ftypes */
247 #define MSKLOGICAL M(TYLOGICAL)
248 #define MSKADDR M(TYADDR)
249 #define MSKCHAR M(TYCHAR)
250 #define MSKINT M(TYSHORT)|M(TYLONG)
251 #define MSKREAL M(TYREAL)|M(TYDREAL) /* DREAL means Double Real */
252 #define MSKCOMPLEX M(TYCOMPLEX)|M(TYDCOMPLEX)
253 #define MSKSTATIC (M(STGINIT)|M(STGBSS)|M(STGCOMMON)|M(STGEQUIV)|M(STGCONST))
255 /* miscellaneous macros */
257 /* ONEOF (x, y) -- x is the number of one of the OR'ed masks in y (i.e., x is
258 the log of one of the OR'ed masks in y) */
260 #define ONEOF(x,y) (M(x) & (y))
261 #define ISCOMPLEX(z) ONEOF(z, MSKCOMPLEX)
262 #define ISREAL(z) ONEOF(z, MSKREAL)
263 #define ISNUMERIC(z) ONEOF(z, MSKINT|MSKREAL|MSKCOMPLEX)
264 #define ISICON(z) (z->tag==TCONST && ISINT(z->constblock.vtype))
266 /* ISCHAR assumes that z has some kind of structure, i.e. is not null */
268 #define ISCHAR(z) (z->headblock.vtype==TYCHAR)
269 #define ISINT(z) ONEOF(z, MSKINT) /* z is a tag, i.e. a mask number */
270 #define ISCONST(z) (z->tag==TCONST)
271 #define ISERROR(z) (z->tag==TERROR)
272 #define ISPLUSOP(z) (z->tag==TEXPR && z->exprblock.opcode==OPPLUS)
273 #define ISSTAROP(z) (z->tag==TEXPR && z->exprblock.opcode==OPSTAR)
274 #define ISONE(z) (ISICON(z) && z->constblock.Const.ci==1)
275 #define INT(z) ONEOF(z, MSKINT|MSKCHAR) /* has INT storage in real life */
276 #define ICON(z) mkintcon( (ftnint)(z) )
278 /* NO66 -- F77 feature is being used
279 NOEXT -- F77 extension is being used */
281 #define NO66(s) if(no66flag) err66(s)
282 #define NOEXT(s) if(noextflag) errext(s)
284 /* round a up to the nearest multiple of b:
286 a = b * floor ( (a + (b - 1)) / b )*/
288 #define roundup(a,b) ( b * ( (a+b-1)/b) )