| 1 | spec: dcl |
| 2 | | common |
| 3 | | external |
| 4 | | intrinsic |
| 5 | | equivalence |
| 6 | | data |
| 7 | | implicit |
| 8 | | SSAVE |
| 9 | { saveall = YES; } |
| 10 | | SSAVE savelist |
| 11 | | SFORMAT |
| 12 | { fmtstmt(thislabel); setfmt(thislabel); } |
| 13 | | SPARAM in_dcl SLPAR paramlist SRPAR |
| 14 | ; |
| 15 | |
| 16 | dcl: type name in_dcl lengspec dims |
| 17 | { settype($2, $1, $4); |
| 18 | if(ndim>0) setbound($2,ndim,dims); |
| 19 | } |
| 20 | | dcl SCOMMA name lengspec dims |
| 21 | { settype($3, $1, $4); |
| 22 | if(ndim>0) setbound($3,ndim,dims); |
| 23 | } |
| 24 | ; |
| 25 | |
| 26 | type: typespec lengspec |
| 27 | { varleng = $2; } |
| 28 | ; |
| 29 | |
| 30 | typespec: typename |
| 31 | { varleng = ($1<0 || $1==TYLONG ? 0 : typesize[$1]); } |
| 32 | ; |
| 33 | |
| 34 | typename: SINTEGER { $$ = TYLONG; } |
| 35 | | SREAL { $$ = TYREAL; } |
| 36 | | SCOMPLEX { $$ = TYCOMPLEX; } |
| 37 | | SDOUBLE { $$ = TYDREAL; } |
| 38 | | SDCOMPLEX { $$ = TYDCOMPLEX; } |
| 39 | | SLOGICAL { $$ = TYLOGICAL; } |
| 40 | | SCHARACTER { $$ = TYCHAR; } |
| 41 | | SUNDEFINED { $$ = TYUNKNOWN; } |
| 42 | | SDIMENSION { $$ = TYUNKNOWN; } |
| 43 | | SAUTOMATIC { $$ = - STGAUTO; } |
| 44 | | SSTATIC { $$ = - STGBSS; } |
| 45 | ; |
| 46 | |
| 47 | lengspec: |
| 48 | { $$ = varleng; } |
| 49 | | SSTAR expr |
| 50 | { |
| 51 | if( ! ISICON($2) ) |
| 52 | { |
| 53 | $$ = 0; |
| 54 | dclerr("length must be an integer constant", 0); |
| 55 | } |
| 56 | else $$ = $2->const.ci; |
| 57 | } |
| 58 | | SSTAR SLPAR SSTAR SRPAR |
| 59 | { $$ = 0; } |
| 60 | ; |
| 61 | |
| 62 | common: SCOMMON in_dcl var |
| 63 | { incomm( $$ = comblock(0, 0) , $3 ); } |
| 64 | | SCOMMON in_dcl comblock var |
| 65 | { $$ = $3; incomm($3, $4); } |
| 66 | | common opt_comma comblock opt_comma var |
| 67 | { $$ = $3; incomm($3, $5); } |
| 68 | | common SCOMMA var |
| 69 | { incomm($1, $3); } |
| 70 | ; |
| 71 | |
| 72 | comblock: SCONCAT |
| 73 | { $$ = comblock(0, 0); } |
| 74 | | SSLASH SNAME SSLASH |
| 75 | { $$ = comblock(toklen, token); } |
| 76 | ; |
| 77 | |
| 78 | external: SEXTERNAL in_dcl name |
| 79 | { setext($3); } |
| 80 | | external SCOMMA name |
| 81 | { setext($3); } |
| 82 | ; |
| 83 | |
| 84 | intrinsic: SINTRINSIC in_dcl name |
| 85 | { setintr($3); } |
| 86 | | intrinsic SCOMMA name |
| 87 | { setintr($3); } |
| 88 | ; |
| 89 | |
| 90 | equivalence: SEQUIV in_dcl equivset |
| 91 | | equivalence SCOMMA equivset |
| 92 | ; |
| 93 | |
| 94 | equivset: SLPAR equivlist SRPAR |
| 95 | { |
| 96 | struct equivblock *p; |
| 97 | if(nequiv >= MAXEQUIV) |
| 98 | fatal("too many equivalences"); |
| 99 | p = & eqvclass[nequiv++]; |
| 100 | p->eqvinit = 0; |
| 101 | p->eqvbottom = 0; |
| 102 | p->eqvtop = 0; |
| 103 | p->equivs = $2; |
| 104 | } |
| 105 | ; |
| 106 | |
| 107 | equivlist: lhs |
| 108 | { $$ = ALLOC(eqvchain); $$->eqvitem = $1; } |
| 109 | | equivlist SCOMMA lhs |
| 110 | { $$ = ALLOC(eqvchain); $$->eqvitem = $3; $$->nextp = $1; } |
| 111 | ; |
| 112 | |
| 113 | data: SDATA in_data datalist |
| 114 | | data opt_comma datalist |
| 115 | ; |
| 116 | |
| 117 | in_data: |
| 118 | { if(parstate == OUTSIDE) |
| 119 | { |
| 120 | newproc(); |
| 121 | startproc(0, CLMAIN); |
| 122 | } |
| 123 | if(parstate < INDATA) |
| 124 | { |
| 125 | enddcl(); |
| 126 | parstate = INDATA; |
| 127 | } |
| 128 | } |
| 129 | ; |
| 130 | |
| 131 | datalist: datavarlist SSLASH vallist SSLASH |
| 132 | { ftnint junk; |
| 133 | if(nextdata(&junk,&junk) != NULL) |
| 134 | { |
| 135 | err("too few initializers"); |
| 136 | curdtp = NULL; |
| 137 | } |
| 138 | frdata($1); |
| 139 | frrpl(); |
| 140 | } |
| 141 | ; |
| 142 | |
| 143 | vallist: { toomanyinit = NO; } val |
| 144 | | vallist SCOMMA val |
| 145 | ; |
| 146 | |
| 147 | val: value |
| 148 | { dataval(NULL, $1); } |
| 149 | | simple SSTAR value |
| 150 | { dataval($1, $3); } |
| 151 | ; |
| 152 | |
| 153 | value: simple |
| 154 | | addop simple |
| 155 | { if( $1==OPMINUS && ISCONST($2) ) |
| 156 | consnegop($2); |
| 157 | $$ = $2; |
| 158 | } |
| 159 | | complex_const |
| 160 | | bit_const |
| 161 | ; |
| 162 | |
| 163 | savelist: saveitem |
| 164 | | savelist SCOMMA saveitem |
| 165 | ; |
| 166 | |
| 167 | saveitem: name |
| 168 | { int k; |
| 169 | $1->vsave = 1; |
| 170 | k = $1->vstg; |
| 171 | if( ! ONEOF(k, M(STGUNKNOWN)|M(STGBSS)|M(STGINIT)) ) |
| 172 | dclerr("can only save static variables", $1); |
| 173 | } |
| 174 | | comblock |
| 175 | { $1->extsave = 1; } |
| 176 | ; |
| 177 | |
| 178 | paramlist: paramitem |
| 179 | | paramlist SCOMMA paramitem |
| 180 | ; |
| 181 | |
| 182 | paramitem: name SEQUALS expr |
| 183 | { if($1->vclass == CLUNKNOWN) |
| 184 | { $1->vclass = CLPARAM; |
| 185 | $1->paramval = $3; |
| 186 | } |
| 187 | else dclerr("cannot make %s parameter", $1); |
| 188 | } |
| 189 | ; |
| 190 | |
| 191 | var: name dims |
| 192 | { if(ndim>0) setbounds($1, ndim, dims); } |
| 193 | ; |
| 194 | |
| 195 | datavar: lhs |
| 196 | { ptr np; |
| 197 | vardcl(np = $1->namep); |
| 198 | if(np->vstg == STGBSS) |
| 199 | np->vstg = STGINIT; |
| 200 | else if(np->vstg == STGCOMMON) |
| 201 | extsymtab[np->vardesc.varno].extinit = YES; |
| 202 | else if(np->vstg==STGEQUIV) |
| 203 | eqvclass[np->vardesc.varno].eqvinit = YES; |
| 204 | else if(np->vstg != STGINIT) |
| 205 | dclerr("inconsistent storage classes", np); |
| 206 | $$ = mkchain($1, 0); |
| 207 | } |
| 208 | | SLPAR datavarlist SCOMMA dospec SRPAR |
| 209 | { chainp p; struct impldoblock *q; |
| 210 | q = ALLOC(impldoblock); |
| 211 | q->tag = TIMPLDO; |
| 212 | q->varnp = $4->datap; |
| 213 | p = $4->nextp; |
| 214 | if(p) { q->implb = p->datap; p = p->nextp; } |
| 215 | if(p) { q->impub = p->datap; p = p->nextp; } |
| 216 | if(p) { q->impstep = p->datap; p = p->nextp; } |
| 217 | frchain( & ($4) ); |
| 218 | $$ = mkchain(q, 0); |
| 219 | q->datalist = hookup($2, $$); |
| 220 | } |
| 221 | ; |
| 222 | |
| 223 | datavarlist: datavar |
| 224 | { curdtp = $1; curdtelt = 0; } |
| 225 | | datavarlist SCOMMA datavar |
| 226 | { $$ = hookup($1, $3); } |
| 227 | ; |
| 228 | |
| 229 | dims: |
| 230 | { ndim = 0; } |
| 231 | | SLPAR dimlist SRPAR |
| 232 | ; |
| 233 | |
| 234 | dimlist: { ndim = 0; } dim |
| 235 | | dimlist SCOMMA dim |
| 236 | ; |
| 237 | |
| 238 | dim: ubound |
| 239 | { dims[ndim].lb = 0; |
| 240 | dims[ndim].ub = $1; |
| 241 | ++ndim; |
| 242 | } |
| 243 | | expr SCOLON ubound |
| 244 | { dims[ndim].lb = $1; |
| 245 | dims[ndim].ub = $3; |
| 246 | ++ndim; |
| 247 | } |
| 248 | ; |
| 249 | |
| 250 | ubound: SSTAR |
| 251 | { $$ = 0; } |
| 252 | | expr |
| 253 | ; |
| 254 | |
| 255 | labellist: label |
| 256 | { nstars = 1; labarray[0] = $1; } |
| 257 | | labellist SCOMMA label |
| 258 | { labarray[nstars++] = $3; } |
| 259 | ; |
| 260 | |
| 261 | label: labelval |
| 262 | { if($1->labinacc) |
| 263 | warn1("illegal branch to inner block, statement %s", |
| 264 | convic( (ftnint) ($1->stateno) )); |
| 265 | else if($1->labdefined == NO) |
| 266 | $1->blklevel = blklevel; |
| 267 | $1->labused = YES; |
| 268 | } |
| 269 | ; |
| 270 | |
| 271 | labelval: SICON |
| 272 | { $$ = mklabel( convci(toklen, token) ); } |
| 273 | ; |
| 274 | |
| 275 | implicit: SIMPLICIT in_dcl implist |
| 276 | | implicit SCOMMA implist |
| 277 | ; |
| 278 | |
| 279 | implist: imptype SLPAR letgroups SRPAR |
| 280 | ; |
| 281 | |
| 282 | imptype: { needkwd = 1; } type |
| 283 | { vartype = $2; } |
| 284 | ; |
| 285 | |
| 286 | letgroups: letgroup |
| 287 | | letgroups SCOMMA letgroup |
| 288 | ; |
| 289 | |
| 290 | letgroup: letter |
| 291 | { setimpl(vartype, varleng, $1, $1); } |
| 292 | | letter SMINUS letter |
| 293 | { setimpl(vartype, varleng, $1, $3); } |
| 294 | ; |
| 295 | |
| 296 | letter: SNAME |
| 297 | { if(toklen!=1 || token[0]<'a' || token[0]>'z') |
| 298 | { |
| 299 | dclerr("implicit item must be single letter", 0); |
| 300 | $$ = 0; |
| 301 | } |
| 302 | else $$ = token[0]; |
| 303 | } |
| 304 | ; |
| 305 | |
| 306 | in_dcl: |
| 307 | { switch(parstate) |
| 308 | { |
| 309 | case OUTSIDE: newproc(); |
| 310 | startproc(0, CLMAIN); |
| 311 | case INSIDE: parstate = INDCL; |
| 312 | case INDCL: break; |
| 313 | |
| 314 | default: |
| 315 | dclerr("declaration among executables", 0); |
| 316 | } |
| 317 | } |
| 318 | ; |