| 1 | #define PDP11 4 |
| 2 | |
| 3 | #define BIGGEST_CHAR 0x7f /* Assumes 32-bit arithmetic */ |
| 4 | #define BIGGEST_SHORT 0x7fff /* Assumes 32-bit arithmetic */ |
| 5 | #define BIGGEST_LONG 0x7fffffff /* Assumes 32-bit arithmetic */ |
| 6 | |
| 7 | #define M(x) (1<<x) /* Mask (x) returns 2^x */ |
| 8 | |
| 9 | #define ALLOC(x) (struct x *) ckalloc((int)sizeof(struct x)) |
| 10 | #define ALLEXPR (expptr) ckalloc((int)sizeof(union Expression) ) |
| 11 | typedef int *ptr; |
| 12 | typedef char *charptr; |
| 13 | typedef FILE *FILEP; |
| 14 | typedef int flag; |
| 15 | typedef char field; /* actually need only 4 bits */ |
| 16 | typedef long int ftnint; |
| 17 | #define LOCAL static |
| 18 | |
| 19 | #define NO 0 |
| 20 | #define YES 1 |
| 21 | |
| 22 | #define CNULL (char *) 0 /* Character string null */ |
| 23 | #define PNULL (ptr) 0 |
| 24 | #define CHNULL (chainp) 0 /* Chain null */ |
| 25 | #define ENULL (expptr) 0 |
| 26 | |
| 27 | |
| 28 | /* BAD_MEMNO - used to distinguish between long string constants and other |
| 29 | constants in the table */ |
| 30 | |
| 31 | #define BAD_MEMNO -32768 |
| 32 | |
| 33 | |
| 34 | /* block tag values -- syntactic stuff */ |
| 35 | |
| 36 | #define TNAME 1 |
| 37 | #define TCONST 2 |
| 38 | #define TEXPR 3 |
| 39 | #define TADDR 4 |
| 40 | #define TPRIM 5 /* Primitive datum - should not appear in an |
| 41 | expptr variable, it should have already been |
| 42 | identified */ |
| 43 | #define TLIST 6 |
| 44 | #define TIMPLDO 7 |
| 45 | #define TERROR 8 |
| 46 | |
| 47 | |
| 48 | /* parser states - order is important, since there are several tests for |
| 49 | state < INDATA */ |
| 50 | |
| 51 | #define OUTSIDE 0 |
| 52 | #define INSIDE 1 |
| 53 | #define INDCL 2 |
| 54 | #define INDATA 3 |
| 55 | #define INEXEC 4 |
| 56 | |
| 57 | /* procedure classes */ |
| 58 | |
| 59 | #define PROCMAIN 1 |
| 60 | #define PROCBLOCK 2 |
| 61 | #define PROCSUBR 3 |
| 62 | #define PROCFUNCT 4 |
| 63 | |
| 64 | |
| 65 | /* storage classes -- vstg values. BSS and INIT are used in the later |
| 66 | merge pass over identifiers; and they are entered differently into the |
| 67 | symbol table */ |
| 68 | |
| 69 | #define STGUNKNOWN 0 |
| 70 | #define STGARG 1 /* adjustable dimensions */ |
| 71 | #define STGAUTO 2 /* for stack references */ |
| 72 | #define STGBSS 3 /* uninitialized storage (normal variables) */ |
| 73 | #define STGINIT 4 /* initialized storage */ |
| 74 | #define STGCONST 5 |
| 75 | #define STGEXT 6 /* external storage */ |
| 76 | #define STGINTR 7 /* intrinsic (late decision) reference. See |
| 77 | chapter 5 of the Fortran 77 standard */ |
| 78 | #define STGSTFUNCT 8 |
| 79 | #define STGCOMMON 9 |
| 80 | #define STGEQUIV 10 |
| 81 | #define STGREG 11 /* register - the outermost DO loop index will be |
| 82 | in a register (because the compiler is one |
| 83 | pass, it can't know where the innermost loop is |
| 84 | */ |
| 85 | #define STGLENG 12 |
| 86 | #define STGNULL 13 |
| 87 | #define STGMEMNO 14 /* interemediate-file pointer to constant table */ |
| 88 | |
| 89 | /* name classes -- vclass values, also procclass values */ |
| 90 | |
| 91 | #define CLUNKNOWN 0 |
| 92 | #define CLPARAM 1 /* Parameter - macro definition */ |
| 93 | #define CLVAR 2 /* variable */ |
| 94 | #define CLENTRY 3 |
| 95 | #define CLMAIN 4 |
| 96 | #define CLBLOCK 5 |
| 97 | #define CLPROC 6 |
| 98 | #define CLNAMELIST 7 /* in data with this tag, the vdcldone flag should |
| 99 | be ignored (according to vardcl()) */ |
| 100 | |
| 101 | |
| 102 | /* vprocclass values -- there is some overlap with the vclass values given |
| 103 | above */ |
| 104 | |
| 105 | #define PUNKNOWN 0 |
| 106 | #define PEXTERNAL 1 |
| 107 | #define PINTRINSIC 2 |
| 108 | #define PSTFUNCT 3 |
| 109 | #define PTHISPROC 4 /* here to allow recursion - further distinction |
| 110 | is given in the CL tag (those just above). |
| 111 | This applies to the presence of the name of a |
| 112 | function used within itself. The function name |
| 113 | means either call the function again, or assign |
| 114 | some value to the storage allocated to the |
| 115 | function's return value. */ |
| 116 | |
| 117 | /* control stack codes - these are part of a state machine which handles |
| 118 | the nesting of blocks (i.e. what to do about the ELSE statement) */ |
| 119 | |
| 120 | #define CTLDO 1 |
| 121 | #define CTLIF 2 |
| 122 | #define CTLELSE 3 |
| 123 | #define CTLIFX 4 |
| 124 | |
| 125 | |
| 126 | /* operators for both Fortran input and C output. They are common because |
| 127 | so many are shared between the trees */ |
| 128 | |
| 129 | #define OPPLUS 1 |
| 130 | #define OPMINUS 2 |
| 131 | #define OPSTAR 3 |
| 132 | #define OPSLASH 4 |
| 133 | #define OPPOWER 5 |
| 134 | #define OPNEG 6 |
| 135 | #define OPOR 7 |
| 136 | #define OPAND 8 |
| 137 | #define OPEQV 9 |
| 138 | #define OPNEQV 10 |
| 139 | #define OPNOT 11 |
| 140 | #define OPCONCAT 12 |
| 141 | #define OPLT 13 |
| 142 | #define OPEQ 14 |
| 143 | #define OPGT 15 |
| 144 | #define OPLE 16 |
| 145 | #define OPNE 17 |
| 146 | #define OPGE 18 |
| 147 | #define OPCALL 19 |
| 148 | #define OPCCALL 20 |
| 149 | #define OPASSIGN 21 |
| 150 | #define OPPLUSEQ 22 |
| 151 | #define OPSTAREQ 23 |
| 152 | #define OPCONV 24 |
| 153 | #define OPLSHIFT 25 |
| 154 | #define OPMOD 26 |
| 155 | #define OPCOMMA 27 |
| 156 | #define OPQUEST 28 |
| 157 | #define OPCOLON 29 |
| 158 | #define OPABS 30 |
| 159 | #define OPMIN 31 |
| 160 | #define OPMAX 32 |
| 161 | #define OPADDR 33 |
| 162 | #define OPCOMMA_ARG 34 |
| 163 | #define OPBITOR 35 |
| 164 | #define OPBITAND 36 |
| 165 | #define OPBITXOR 37 |
| 166 | #define OPBITNOT 38 |
| 167 | #define OPRSHIFT 39 |
| 168 | #define OPWHATSIN 40 /* dereferencing operator */ |
| 169 | #define OPMINUSEQ 41 /* assignment operators */ |
| 170 | #define OPSLASHEQ 42 |
| 171 | #define OPMODEQ 43 |
| 172 | #define OPLSHIFTEQ 44 |
| 173 | #define OPRSHIFTEQ 45 |
| 174 | #define OPBITANDEQ 46 |
| 175 | #define OPBITXOREQ 47 |
| 176 | #define OPBITOREQ 48 |
| 177 | #define OPPREINC 49 /* Preincrement (++x) operator */ |
| 178 | #define OPPREDEC 50 /* Predecrement (--x) operator */ |
| 179 | #define OPDOT 51 /* structure field reference */ |
| 180 | #define OPARROW 52 /* structure pointer field reference */ |
| 181 | #define OPNEG1 53 /* simple negation under forcedouble */ |
| 182 | #define OPDMIN 54 /* min(a,b) macro under forcedouble */ |
| 183 | #define OPDMAX 55 /* max(a,b) macro under forcedouble */ |
| 184 | #define OPASSIGNI 56 /* assignment for inquire stmt */ |
| 185 | #define OPIDENTITY 57 /* for turning TADDR into TEXPR */ |
| 186 | #define OPCHARCAST 58 /* for casting to char * (in I/O stmts) */ |
| 187 | #define OPDABS 59 /* abs macro under forcedouble */ |
| 188 | #define OPMIN2 60 /* min(a,b) macro */ |
| 189 | #define OPMAX2 61 /* max(a,b) macro */ |
| 190 | |
| 191 | /* label type codes -- used with the ASSIGN statement */ |
| 192 | |
| 193 | #define LABUNKNOWN 0 |
| 194 | #define LABEXEC 1 |
| 195 | #define LABFORMAT 2 |
| 196 | #define LABOTHER 3 |
| 197 | |
| 198 | |
| 199 | /* INTRINSIC function codes*/ |
| 200 | |
| 201 | #define INTREND 0 |
| 202 | #define INTRCONV 1 |
| 203 | #define INTRMIN 2 |
| 204 | #define INTRMAX 3 |
| 205 | #define INTRGEN 4 /* General intrinsic, e.g. cos v. dcos, zcos, ccos */ |
| 206 | #define INTRSPEC 5 |
| 207 | #define INTRBOOL 6 |
| 208 | #define INTRCNST 7 /* constants, e.g. bigint(1.0) v. bigint (1d0) */ |
| 209 | |
| 210 | |
| 211 | /* I/O statement codes - these all form Integer Constants, and are always |
| 212 | reevaluated */ |
| 213 | |
| 214 | #define IOSTDIN ICON(5) |
| 215 | #define IOSTDOUT ICON(6) |
| 216 | #define IOSTDERR ICON(0) |
| 217 | |
| 218 | #define IOSBAD (-1) |
| 219 | #define IOSPOSITIONAL 0 |
| 220 | #define IOSUNIT 1 |
| 221 | #define IOSFMT 2 |
| 222 | |
| 223 | #define IOINQUIRE 1 |
| 224 | #define IOOPEN 2 |
| 225 | #define IOCLOSE 3 |
| 226 | #define IOREWIND 4 |
| 227 | #define IOBACKSPACE 5 |
| 228 | #define IOENDFILE 6 |
| 229 | #define IOREAD 7 |
| 230 | #define IOWRITE 8 |
| 231 | |
| 232 | |
| 233 | /* User name tags -- these identify the form of the original identifier |
| 234 | stored in a struct Addrblock structure (in the user field). */ |
| 235 | |
| 236 | #define UNAM_UNKNOWN 0 /* Not specified */ |
| 237 | #define UNAM_NAME 1 /* Local symbol, store in the hash table */ |
| 238 | #define UNAM_IDENT 2 /* Character string not stored elsewhere */ |
| 239 | #define UNAM_EXTERN 3 /* External reference; check symbol table |
| 240 | using memno as index */ |
| 241 | #define UNAM_CONST 4 /* Constant value */ |
| 242 | #define UNAM_CHARP 5 /* pointer to string */ |
| 243 | #define UNAM_REF 6 /* subscript reference with -s */ |
| 244 | |
| 245 | |
| 246 | #define IDENT_LEN 31 /* Maximum length user.ident */ |
| 247 | |
| 248 | /* type masks - TYLOGICAL defined in ftypes */ |
| 249 | |
| 250 | #define MSKLOGICAL M(TYLOGICAL)|M(TYLOGICAL1)|M(TYLOGICAL2) |
| 251 | #define MSKADDR M(TYADDR) |
| 252 | #define MSKCHAR M(TYCHAR) |
| 253 | #ifdef TYQUAD |
| 254 | #define MSKINT M(TYINT1)|M(TYSHORT)|M(TYLONG)|M(TYQUAD) |
| 255 | #else |
| 256 | #define MSKINT M(TYINT1)|M(TYSHORT)|M(TYLONG) |
| 257 | #endif |
| 258 | #define MSKREAL M(TYREAL)|M(TYDREAL) /* DREAL means Double Real */ |
| 259 | #define MSKCOMPLEX M(TYCOMPLEX)|M(TYDCOMPLEX) |
| 260 | #define MSKSTATIC (M(STGINIT)|M(STGBSS)|M(STGCOMMON)|M(STGEQUIV)|M(STGCONST)) |
| 261 | |
| 262 | /* miscellaneous macros */ |
| 263 | |
| 264 | /* ONEOF (x, y) -- x is the number of one of the OR'ed masks in y (i.e., x is |
| 265 | the log of one of the OR'ed masks in y) */ |
| 266 | |
| 267 | #define ONEOF(x,y) (M(x) & (y)) |
| 268 | #define ISCOMPLEX(z) ONEOF(z, MSKCOMPLEX) |
| 269 | #define ISREAL(z) ONEOF(z, MSKREAL) |
| 270 | #define ISNUMERIC(z) ONEOF(z, MSKINT|MSKREAL|MSKCOMPLEX) |
| 271 | #define ISICON(z) (z->tag==TCONST && ISINT(z->constblock.vtype)) |
| 272 | #define ISLOGICAL(z) ONEOF(z, MSKLOGICAL) |
| 273 | |
| 274 | /* ISCHAR assumes that z has some kind of structure, i.e. is not null */ |
| 275 | |
| 276 | #define ISCHAR(z) (z->headblock.vtype==TYCHAR) |
| 277 | #define ISINT(z) ONEOF(z, MSKINT) /* z is a tag, i.e. a mask number */ |
| 278 | #define ISCONST(z) (z->tag==TCONST) |
| 279 | #define ISERROR(z) (z->tag==TERROR) |
| 280 | #define ISPLUSOP(z) (z->tag==TEXPR && z->exprblock.opcode==OPPLUS) |
| 281 | #define ISSTAROP(z) (z->tag==TEXPR && z->exprblock.opcode==OPSTAR) |
| 282 | #define ISONE(z) (ISICON(z) && z->constblock.Const.ci==1) |
| 283 | #define INT(z) ONEOF(z, MSKINT|MSKCHAR) /* has INT storage in real life */ |
| 284 | #define ICON(z) mkintcon( (ftnint)(z) ) |
| 285 | |
| 286 | /* NO66 -- F77 feature is being used |
| 287 | NOEXT -- F77 extension is being used */ |
| 288 | |
| 289 | #define NO66(s) if(no66flag) err66(s) |
| 290 | #define NOEXT(s) if(noextflag) errext(s) |
| 291 | |
| 292 | /* round a up to the nearest multiple of b: |
| 293 | |
| 294 | a = b * floor ( (a + (b - 1)) / b )*/ |
| 295 | |
| 296 | #define roundup(a,b) ( b * ( (a+b-1)/b) ) |