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 intonlyon expr intonlyoff 50: { 51: if( ! ISICON($3) ) 52: { 53: $$ = 0; 54: error("length must be an integer constant", 0, 0, DCLERR); 55: } 56: else $$ = $3->const.ci; 57: } 58: | SSTAR intonlyon SLPAR SSTAR SRPAR intonlyoff 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: error("too many equivalences",0,0,FATAL); 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: error("too few initializers",0,0,ERR); 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: error("can only save static variables", $1, 0, DCLERR); 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 error("cannot make %s parameter", $1, 0, DCLERR); 188: } 189: ; 190: 191: var: name dims 192: { if(ndim>0) setbound($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: error("inconsistent storage classes", np, 0, DCLERR); 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: { if(nstars < MAXLABLIST) labarray[nstars++] = $3; } 259: ; 260: 261: label: labelval 262: { if($1->labinacc) 263: error("illegal branch to inner block, statement %s", 264: convic( (ftnint) ($1->stateno) ),0,WARN1); 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: error("implicit item must be single letter", 0, 0, DCLERR); 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: error("declaration among executables", 0, 0, DCLERR); 316: } 317: } 318: ;