1spec: dcl 2 | common 3 | external 4 | intrinsic 5 | equivalence 6 | data 7 | implicit 8 | namelist 9 | SSAVE 10 { NO66("SAVE statement"); 11 saveall = YES; } 12 | SSAVE savelist 13 { NO66("SAVE statement"); } 14 | SFORMAT 15 { fmtstmt(thislabel); setfmt(thislabel); } 16 | SPARAM in_dcl SLPAR paramlist SRPAR 17 { NO66("PARAMETER statement"); } 18 ; 19 20dcl: type opt_comma name in_dcl new_dcl dims lengspec 21 { settype($3, $1, $7); 22 if(ndim>0) setbound($3,ndim,dims); 23 } 24 | dcl SCOMMA name dims lengspec 25 { settype($3, $1, $5); 26 if(ndim>0) setbound($3,ndim,dims); 27 } 28 | dcl SSLASHD datainit vallist SSLASHD 29 { if (new_dcl == 2) { 30 err("attempt to give DATA in type-declaration"); 31 new_dcl = 1; 32 } 33 } 34 ; 35 36new_dcl: { new_dcl = 2; } ; 37 38type: typespec lengspec 39 { varleng = $2; } 40 ; 41 42typespec: typename 43 { varleng = ($1<0 || ONEOF($1,M(TYLOGICAL)|M(TYLONG)) 44 ? 0 : typesize[$1]); 45 vartype = $1; } 46 ; 47 48typename: SINTEGER { $$ = TYLONG; } 49 | SREAL { $$ = tyreal; } 50 | SCOMPLEX { ++complex_seen; $$ = tycomplex; } 51 | SDOUBLE { $$ = TYDREAL; } 52 | SDCOMPLEX { ++dcomplex_seen; NOEXT("DOUBLE COMPLEX statement"); $$ = TYDCOMPLEX; } 53 | SLOGICAL { $$ = TYLOGICAL; } 54 | SCHARACTER { NO66("CHARACTER statement"); $$ = TYCHAR; } 55 | SUNDEFINED { $$ = TYUNKNOWN; } 56 | SDIMENSION { $$ = TYUNKNOWN; } 57 | SAUTOMATIC { NOEXT("AUTOMATIC statement"); $$ = - STGAUTO; } 58 | SSTATIC { NOEXT("STATIC statement"); $$ = - STGBSS; } 59 | SBYTE { $$ = TYINT1; } 60 ; 61 62lengspec: 63 { $$ = varleng; } 64 | SSTAR intonlyon expr intonlyoff 65 { 66 expptr p; 67 p = $3; 68 NO66("length specification *n"); 69 if( ! ISICON(p) || p->constblock.Const.ci <= 0 ) 70 { 71 $$ = 0; 72 dclerr("length must be a positive integer constant", 73 NPNULL); 74 } 75 else { 76 if (vartype == TYCHAR) 77 $$ = p->constblock.Const.ci; 78 else switch((int)p->constblock.Const.ci) { 79 case 1: $$ = 1; break; 80 case 2: $$ = typesize[TYSHORT]; break; 81 case 4: $$ = typesize[TYLONG]; break; 82 case 8: $$ = typesize[TYDREAL]; break; 83 case 16: $$ = typesize[TYDCOMPLEX]; break; 84 default: 85 dclerr("invalid length",NPNULL); 86 $$ = varleng; 87 } 88 } 89 } 90 | SSTAR intonlyon SLPAR SSTAR SRPAR intonlyoff 91 { NO66("length specification *(*)"); $$ = -1; } 92 ; 93 94common: SCOMMON in_dcl var 95 { incomm( $$ = comblock("") , $3 ); } 96 | SCOMMON in_dcl comblock var 97 { $$ = $3; incomm($3, $4); } 98 | common opt_comma comblock opt_comma var 99 { $$ = $3; incomm($3, $5); } 100 | common SCOMMA var 101 { incomm($1, $3); } 102 ; 103 104comblock: SCONCAT 105 { $$ = comblock(""); } 106 | SSLASH SNAME SSLASH 107 { $$ = comblock(token); } 108 ; 109 110external: SEXTERNAL in_dcl name 111 { setext($3); } 112 | external SCOMMA name 113 { setext($3); } 114 ; 115 116intrinsic: SINTRINSIC in_dcl name 117 { NO66("INTRINSIC statement"); setintr($3); } 118 | intrinsic SCOMMA name 119 { setintr($3); } 120 ; 121 122equivalence: SEQUIV in_dcl equivset 123 | equivalence SCOMMA equivset 124 ; 125 126equivset: SLPAR equivlist SRPAR 127 { 128 struct Equivblock *p; 129 if(nequiv >= maxequiv) 130 many("equivalences", 'q', maxequiv); 131 p = & eqvclass[nequiv++]; 132 p->eqvinit = NO; 133 p->eqvbottom = 0; 134 p->eqvtop = 0; 135 p->equivs = $2; 136 } 137 ; 138 139equivlist: lhs 140 { $$=ALLOC(Eqvchain); 141 $$->eqvitem.eqvlhs = primchk($1); 142 } 143 | equivlist SCOMMA lhs 144 { $$=ALLOC(Eqvchain); 145 $$->eqvitem.eqvlhs = primchk($3); 146 $$->eqvnextp = $1; 147 } 148 ; 149 150data: SDATA in_data datalist 151 | data opt_comma datalist 152 ; 153 154in_data: 155 { if(parstate == OUTSIDE) 156 { 157 newproc(); 158 startproc(ESNULL, CLMAIN); 159 } 160 if(parstate < INDATA) 161 { 162 enddcl(); 163 parstate = INDATA; 164 datagripe = 1; 165 } 166 } 167 ; 168 169datalist: datainit datavarlist SSLASH datapop vallist SSLASH 170 { ftnint junk; 171 if(nextdata(&junk) != NULL) 172 err("too few initializers"); 173 frdata($2); 174 frrpl(); 175 } 176 ; 177 178datainit: /* nothing */ { frchain(&datastack); curdtp = 0; } ; 179 180datapop: /* nothing */ { pop_datastack(); } ; 181 182vallist: { toomanyinit = NO; } val 183 | vallist SCOMMA val 184 ; 185 186val: value 187 { dataval(ENULL, $1); } 188 | simple SSTAR value 189 { dataval($1, $3); } 190 ; 191 192value: simple 193 | addop simple 194 { if( $1==OPMINUS && ISCONST($2) ) 195 consnegop((Constp)$2); 196 $$ = $2; 197 } 198 | complex_const 199 ; 200 201savelist: saveitem 202 | savelist SCOMMA saveitem 203 ; 204 205saveitem: name 206 { int k; 207 $1->vsave = YES; 208 k = $1->vstg; 209 if( ! ONEOF(k, M(STGUNKNOWN)|M(STGBSS)|M(STGINIT)) ) 210 dclerr("can only save static variables", $1); 211 } 212 | comblock 213 ; 214 215paramlist: paramitem 216 | paramlist SCOMMA paramitem 217 ; 218 219paramitem: name SEQUALS expr 220 { if($1->vclass == CLUNKNOWN) 221 make_param((struct Paramblock *)$1, $3); 222 else dclerr("cannot make into parameter", $1); 223 } 224 ; 225 226var: name dims 227 { if(ndim>0) setbound($1, ndim, dims); } 228 ; 229 230datavar: lhs 231 { Namep np; 232 struct Primblock *pp = (struct Primblock *)$1; 233 int tt = $1->tag; 234 if (tt != TPRIM) { 235 if (tt == TCONST) 236 err("parameter in data statement"); 237 else 238 erri("tag %d in data statement",tt); 239 $$ = 0; 240 err_lineno = lineno; 241 break; 242 } 243 np = pp -> namep; 244 vardcl(np); 245 if ((pp->fcharp || pp->lcharp) 246 && (np->vtype != TYCHAR || np->vdim)) 247 sserr(np); 248 if(np->vstg == STGCOMMON) 249 extsymtab[np->vardesc.varno].extinit = YES; 250 else if(np->vstg==STGEQUIV) 251 eqvclass[np->vardesc.varno].eqvinit = YES; 252 else if(np->vstg!=STGINIT && np->vstg!=STGBSS) { 253 errstr(np->vstg == STGARG 254 ? "Dummy argument \"%.60s\" in data statement." 255 : "Cannot give data to \"%.75s\"", 256 np->fvarname); 257 $$ = 0; 258 err_lineno = lineno; 259 break; 260 } 261 $$ = mkchain((char *)$1, CHNULL); 262 } 263 | SLPAR datavarlist SCOMMA dospec SRPAR 264 { chainp p; struct Impldoblock *q; 265 pop_datastack(); 266 q = ALLOC(Impldoblock); 267 q->tag = TIMPLDO; 268 (q->varnp = (Namep) ($4->datap))->vimpldovar = 1; 269 p = $4->nextp; 270 if(p) { q->implb = (expptr)(p->datap); p = p->nextp; } 271 if(p) { q->impub = (expptr)(p->datap); p = p->nextp; } 272 if(p) { q->impstep = (expptr)(p->datap); } 273 frchain( & ($4) ); 274 $$ = mkchain((char *)q, CHNULL); 275 q->datalist = hookup($2, $$); 276 } 277 ; 278 279datavarlist: datavar 280 { if (!datastack) 281 curdtp = 0; 282 datastack = mkchain((char *)curdtp, datastack); 283 curdtp = $1; curdtelt = 0; 284 } 285 | datavarlist SCOMMA datavar 286 { $$ = hookup($1, $3); } 287 ; 288 289dims: 290 { ndim = 0; } 291 | SLPAR dimlist SRPAR 292 ; 293 294dimlist: { ndim = 0; } dim 295 | dimlist SCOMMA dim 296 ; 297 298dim: ubound 299 { 300 if(ndim == maxdim) 301 err("too many dimensions"); 302 else if(ndim < maxdim) 303 { dims[ndim].lb = 0; 304 dims[ndim].ub = $1; 305 } 306 ++ndim; 307 } 308 | expr SCOLON ubound 309 { 310 if(ndim == maxdim) 311 err("too many dimensions"); 312 else if(ndim < maxdim) 313 { dims[ndim].lb = $1; 314 dims[ndim].ub = $3; 315 } 316 ++ndim; 317 } 318 ; 319 320ubound: SSTAR 321 { $$ = 0; } 322 | expr 323 ; 324 325labellist: label 326 { nstars = 1; labarray[0] = $1; } 327 | labellist SCOMMA label 328 { if(nstars < maxlablist) labarray[nstars++] = $3; } 329 ; 330 331label: SICON 332 { $$ = execlab( convci(toklen, token) ); } 333 ; 334 335implicit: SIMPLICIT in_dcl implist 336 { NO66("IMPLICIT statement"); } 337 | implicit SCOMMA implist 338 ; 339 340implist: imptype SLPAR letgroups SRPAR 341 | imptype 342 { if (vartype != TYUNKNOWN) 343 dclerr("-- expected letter range",NPNULL); 344 setimpl(vartype, varleng, 'a', 'z'); } 345 ; 346 347imptype: { needkwd = 1; } type 348 /* { vartype = $2; } */ 349 ; 350 351letgroups: letgroup 352 | letgroups SCOMMA letgroup 353 ; 354 355letgroup: letter 356 { setimpl(vartype, varleng, $1, $1); } 357 | letter SMINUS letter 358 { setimpl(vartype, varleng, $1, $3); } 359 ; 360 361letter: SNAME 362 { if(toklen!=1 || token[0]<'a' || token[0]>'z') 363 { 364 dclerr("implicit item must be single letter", NPNULL); 365 $$ = 0; 366 } 367 else $$ = token[0]; 368 } 369 ; 370 371namelist: SNAMELIST 372 | namelist namelistentry 373 ; 374 375namelistentry: SSLASH name SSLASH namelistlist 376 { 377 if($2->vclass == CLUNKNOWN) 378 { 379 $2->vclass = CLNAMELIST; 380 $2->vtype = TYINT; 381 $2->vstg = STGBSS; 382 $2->varxptr.namelist = $4; 383 $2->vardesc.varno = ++lastvarno; 384 } 385 else dclerr("cannot be a namelist name", $2); 386 } 387 ; 388 389namelistlist: name 390 { $$ = mkchain((char *)$1, CHNULL); } 391 | namelistlist SCOMMA name 392 { $$ = hookup($1, mkchain((char *)$3, CHNULL)); } 393 ; 394 395in_dcl: 396 { switch(parstate) 397 { 398 case OUTSIDE: newproc(); 399 startproc(ESNULL, CLMAIN); 400 case INSIDE: parstate = INDCL; 401 case INDCL: break; 402 403 case INDATA: 404 if (datagripe) { 405 errstr( 406 "Statement order error: declaration after DATA", 407 CNULL); 408 datagripe = 0; 409 } 410 break; 411 412 default: 413 dclerr("declaration among executables", NPNULL); 414 } 415 } 416 ; 417