00001 #define PDP11 4
00002 
00003 #define BIGGEST_CHAR    0x7f            /* Assumes 32-bit arithmetic */
00004 #define BIGGEST_SHORT   0x7fff          /* Assumes 32-bit arithmetic */
00005 #define BIGGEST_LONG    0x7fffffff      /* Assumes 32-bit arithmetic */
00006 
00007 #define M(x) (1<<x)     /* Mask (x) returns 2^x */
00008 
00009 #define ALLOC(x)        (struct x *) ckalloc((int)sizeof(struct x))
00010 #define ALLEXPR         (expptr) ckalloc((int)sizeof(union Expression) )
00011 typedef int *ptr;
00012 typedef char *charptr;
00013 typedef FILE *FILEP;
00014 typedef int flag;
00015 typedef char field;     /* actually need only 4 bits */
00016 typedef long int ftnint;
00017 #define LOCAL static
00018 
00019 #define NO 0
00020 #define YES 1
00021 
00022 #define CNULL (char *) 0        /* Character string null */
00023 #define PNULL (ptr) 0
00024 #define CHNULL (chainp) 0       /* Chain null */
00025 #define ENULL (expptr) 0
00026 
00027 
00028 /* BAD_MEMNO - used to distinguish between long string constants and other
00029    constants in the table */
00030 
00031 #define BAD_MEMNO -32768
00032 
00033 
00034 /* block tag values -- syntactic stuff */
00035 
00036 #define TNAME 1
00037 #define TCONST 2
00038 #define TEXPR 3
00039 #define TADDR 4
00040 #define TPRIM 5         /* Primitive datum - should not appear in an
00041                            expptr variable, it should have already been
00042                            identified */
00043 #define TLIST 6
00044 #define TIMPLDO 7
00045 #define TERROR 8
00046 
00047 
00048 /* parser states - order is important, since there are several tests for
00049    state < INDATA   */
00050 
00051 #define OUTSIDE 0
00052 #define INSIDE 1
00053 #define INDCL 2
00054 #define INDATA 3
00055 #define INEXEC 4
00056 
00057 /* procedure classes */
00058 
00059 #define PROCMAIN 1
00060 #define PROCBLOCK 2
00061 #define PROCSUBR 3
00062 #define PROCFUNCT 4
00063 
00064 
00065 /* storage classes -- vstg values.  BSS and INIT are used in the later
00066    merge pass over identifiers; and they are entered differently into the
00067    symbol table */
00068 
00069 #define STGUNKNOWN 0
00070 #define STGARG 1        /* adjustable dimensions */
00071 #define STGAUTO 2       /* for stack references */
00072 #define STGBSS 3        /* uninitialized storage (normal variables) */
00073 #define STGINIT 4       /* initialized storage */
00074 #define STGCONST 5
00075 #define STGEXT 6        /* external storage */
00076 #define STGINTR 7       /* intrinsic (late decision) reference.  See
00077                            chapter 5 of the Fortran 77 standard */
00078 #define STGSTFUNCT 8
00079 #define STGCOMMON 9
00080 #define STGEQUIV 10
00081 #define STGREG 11       /* register - the outermost DO loop index will be
00082                            in a register (because the compiler is one
00083                            pass, it can't know where the innermost loop is
00084                            */
00085 #define STGLENG 12
00086 #define STGNULL 13
00087 #define STGMEMNO 14     /* interemediate-file pointer to constant table */
00088 
00089 /* name classes -- vclass values, also   procclass   values */
00090 
00091 #define CLUNKNOWN 0
00092 #define CLPARAM 1       /* Parameter - macro definition */
00093 #define CLVAR 2         /* variable */
00094 #define CLENTRY 3
00095 #define CLMAIN 4
00096 #define CLBLOCK 5
00097 #define CLPROC 6
00098 #define CLNAMELIST 7    /* in data with this tag, the   vdcldone   flag should
00099                            be ignored (according to vardcl()) */
00100 
00101 
00102 /* vprocclass values -- there is some overlap with the vclass values given
00103    above */
00104 
00105 #define PUNKNOWN 0
00106 #define PEXTERNAL 1
00107 #define PINTRINSIC 2
00108 #define PSTFUNCT 3
00109 #define PTHISPROC 4     /* here to allow recursion - further distinction
00110                            is given in the CL tag (those just above).
00111                            This applies to the presence of the name of a
00112                            function used within itself.  The function name
00113                            means either call the function again, or assign
00114                            some value to the storage allocated to the
00115                            function's return value. */
00116 
00117 /* control stack codes - these are part of a state machine which handles
00118    the nesting of blocks (i.e. what to do about the ELSE statement) */
00119 
00120 #define CTLDO 1
00121 #define CTLIF 2
00122 #define CTLELSE 3
00123 #define CTLIFX 4
00124 
00125 
00126 /* operators for both Fortran input and C output.  They are common because
00127    so many are shared between the trees */
00128 
00129 #define OPPLUS 1
00130 #define OPMINUS 2
00131 #define OPSTAR 3
00132 #define OPSLASH 4
00133 #define OPPOWER 5
00134 #define OPNEG 6
00135 #define OPOR 7
00136 #define OPAND 8
00137 #define OPEQV 9
00138 #define OPNEQV 10
00139 #define OPNOT 11
00140 #define OPCONCAT 12
00141 #define OPLT 13
00142 #define OPEQ 14
00143 #define OPGT 15
00144 #define OPLE 16
00145 #define OPNE 17
00146 #define OPGE 18
00147 #define OPCALL 19
00148 #define OPCCALL 20
00149 #define OPASSIGN 21
00150 #define OPPLUSEQ 22
00151 #define OPSTAREQ 23
00152 #define OPCONV 24
00153 #define OPLSHIFT 25
00154 #define OPMOD 26
00155 #define OPCOMMA 27
00156 #define OPQUEST 28
00157 #define OPCOLON 29
00158 #define OPABS 30
00159 #define OPMIN 31
00160 #define OPMAX 32
00161 #define OPADDR 33
00162 #define OPCOMMA_ARG 34
00163 #define OPBITOR 35
00164 #define OPBITAND 36
00165 #define OPBITXOR 37
00166 #define OPBITNOT 38
00167 #define OPRSHIFT 39
00168 #define OPWHATSIN 40            /* dereferencing operator */
00169 #define OPMINUSEQ 41            /* assignment operators */
00170 #define OPSLASHEQ 42
00171 #define OPMODEQ 43
00172 #define OPLSHIFTEQ 44
00173 #define OPRSHIFTEQ 45
00174 #define OPBITANDEQ 46
00175 #define OPBITXOREQ 47
00176 #define OPBITOREQ 48
00177 #define OPPREINC 49             /* Preincrement (++x) operator */
00178 #define OPPREDEC 50             /* Predecrement (--x) operator */
00179 #define OPDOT 51                /* structure field reference */
00180 #define OPARROW 52              /* structure pointer field reference */
00181 #define OPNEG1 53               /* simple negation under forcedouble */
00182 #define OPDMIN 54               /* min(a,b) macro under forcedouble */
00183 #define OPDMAX 55               /* max(a,b) macro under forcedouble */
00184 #define OPASSIGNI 56            /* assignment for inquire stmt */
00185 #define OPIDENTITY 57           /* for turning TADDR into TEXPR */
00186 #define OPCHARCAST 58           /* for casting to char * (in I/O stmts) */
00187 #define OPDABS 59               /* abs macro under forcedouble */
00188 #define OPMIN2 60               /* min(a,b) macro */
00189 #define OPMAX2 61               /* max(a,b) macro */
00190 #define OPBITTEST 62            /* btest */
00191 #define OPBITCLR 63             /* ibclr */
00192 #define OPBITSET 64             /* ibset */
00193 #define OPQBITCLR 65            /* ibclr, integer*8 */
00194 #define OPQBITSET 66            /* ibset, integer*8 */
00195 #define OPBITBITS 67            /* ibits */
00196 #define OPBITSH 68              /* ishft */
00197 #define OPBITSHC 69             /* ishftc */
00198 
00199 /* label type codes -- used with the ASSIGN statement */
00200 
00201 #define LABUNKNOWN 0
00202 #define LABEXEC 1
00203 #define LABFORMAT 2
00204 #define LABOTHER 3
00205 
00206 
00207 /* INTRINSIC function codes*/
00208 
00209 #define INTREND 0
00210 #define INTRCONV 1
00211 #define INTRMIN 2
00212 #define INTRMAX 3
00213 #define INTRGEN 4       /* General intrinsic, e.g. cos v. dcos, zcos, ccos */
00214 #define INTRSPEC 5
00215 #define INTRBOOL 6
00216 #define INTRCNST 7      /* constants, e.g. bigint(1.0) v. bigint (1d0) */
00217 #define INTRBGEN 8      /* bit manipulation */
00218 
00219 
00220 /* I/O statement codes - these all form Integer Constants, and are always
00221    reevaluated */
00222 
00223 #define IOSTDIN ICON(5)
00224 #define IOSTDOUT ICON(6)
00225 #define IOSTDERR ICON(0)
00226 
00227 #define IOSBAD (-1)
00228 #define IOSPOSITIONAL 0
00229 #define IOSUNIT 1
00230 #define IOSFMT 2
00231 
00232 #define IOINQUIRE 1
00233 #define IOOPEN 2
00234 #define IOCLOSE 3
00235 #define IOREWIND 4
00236 #define IOBACKSPACE 5
00237 #define IOENDFILE 6
00238 #define IOREAD 7
00239 #define IOWRITE 8
00240 
00241 
00242 /* User name tags -- these identify the form of the original identifier
00243    stored in a   struct Addrblock   structure (in the   user   field). */
00244 
00245 #define UNAM_UNKNOWN 0          /* Not specified */
00246 #define UNAM_NAME 1             /* Local symbol, store in the hash table */
00247 #define UNAM_IDENT 2            /* Character string not stored elsewhere */
00248 #define UNAM_EXTERN 3           /* External reference; check symbol table
00249                                    using   memno   as index */
00250 #define UNAM_CONST 4            /* Constant value */
00251 #define UNAM_CHARP 5            /* pointer to string */
00252 #define UNAM_REF 6              /* subscript reference with -s */
00253 
00254 
00255 #define IDENT_LEN 31            /* Maximum length user.ident */
00256 #define MAXNAMELEN 50           /* Maximum Fortran name length */
00257 
00258 /* type masks - TYLOGICAL defined in   ftypes   */
00259 
00260 #define MSKLOGICAL      M(TYLOGICAL)|M(TYLOGICAL1)|M(TYLOGICAL2)
00261 #define MSKADDR M(TYADDR)
00262 #define MSKCHAR M(TYCHAR)
00263 #ifdef TYQUAD
00264 #define MSKINT  M(TYINT1)|M(TYSHORT)|M(TYLONG)|M(TYQUAD)
00265 #else
00266 #define MSKINT  M(TYINT1)|M(TYSHORT)|M(TYLONG)
00267 #endif
00268 #define MSKREAL M(TYREAL)|M(TYDREAL)    /* DREAL means Double Real */
00269 #define MSKCOMPLEX      M(TYCOMPLEX)|M(TYDCOMPLEX)
00270 #define MSKSTATIC (M(STGINIT)|M(STGBSS)|M(STGCOMMON)|M(STGEQUIV)|M(STGCONST))
00271 
00272 /* miscellaneous macros */
00273 
00274 /* ONEOF (x, y) -- x is the number of one of the OR'ed masks in y (i.e., x is
00275    the log of one of the OR'ed masks in y) */
00276 
00277 #define ONEOF(x,y) (M(x) & (y))
00278 #define ISCOMPLEX(z) ONEOF(z, MSKCOMPLEX)
00279 #define ISREAL(z) ONEOF(z, MSKREAL)
00280 #define ISNUMERIC(z) ONEOF(z, MSKINT|MSKREAL|MSKCOMPLEX)
00281 #define ISICON(z) (z->tag==TCONST && ISINT(z->constblock.vtype))
00282 #define ISLOGICAL(z) ONEOF(z, MSKLOGICAL)
00283 
00284 /* ISCHAR assumes that   z   has some kind of structure, i.e. is not null */
00285 
00286 #define ISCHAR(z) (z->headblock.vtype==TYCHAR)
00287 #define ISINT(z)   ONEOF(z, MSKINT)     /*   z   is a tag, i.e. a mask number */
00288 #define ISCONST(z) (z->tag==TCONST)
00289 #define ISERROR(z) (z->tag==TERROR)
00290 #define ISPLUSOP(z) (z->tag==TEXPR && z->exprblock.opcode==OPPLUS)
00291 #define ISSTAROP(z) (z->tag==TEXPR && z->exprblock.opcode==OPSTAR)
00292 #define ISONE(z) (ISICON(z) && z->constblock.Const.ci==1)
00293 #define INT(z) ONEOF(z, MSKINT|MSKCHAR) /* has INT storage in real life */
00294 #define ICON(z) mkintcon( (ftnint)(z) )
00295 
00296 /* NO66 -- F77 feature is being used
00297    NOEXT -- F77 extension is being used */
00298 
00299 #define NO66(s) if(no66flag) err66(s)
00300 #define NOEXT(s)        if(noextflag) errext(s)