![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to gram.dcl CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / f77|
Return to gram.dcl CVS log | Up to [Research Unix] / researchv10no / cmd / f77 |
1.1 ! root 1: spec: 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: ! 20: dcl: type opt_comma name in_dcl dims lengspec ! 21: { settype($3, $1, $6); ! 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: ; ! 29: ! 30: type: typespec lengspec ! 31: { varleng = $2; } ! 32: ; ! 33: ! 34: typespec: typename ! 35: { varleng = ($1<0 || $1==TYLONG ? 0 : typesize[$1]); } ! 36: ; ! 37: ! 38: typename: SINTEGER { $$ = TYLONG; } ! 39: | SREAL { $$ = TYREAL; } ! 40: | SCOMPLEX { ++complex_seen; $$ = TYCOMPLEX; } ! 41: | SDOUBLE { $$ = TYDREAL; } ! 42: | SDCOMPLEX { ++dcomplex_seen; NOEXT("DOUBLE COMPLEX statement"); $$ = TYDCOMPLEX; } ! 43: | SLOGICAL { $$ = TYLOGICAL; } ! 44: | SCHARACTER { NO66("CHARACTER statement"); $$ = TYCHAR; } ! 45: | SUNDEFINED { $$ = TYUNKNOWN; } ! 46: | SDIMENSION { $$ = TYUNKNOWN; } ! 47: | SAUTOMATIC { NOEXT("AUTOMATIC statement"); $$ = - STGAUTO; } ! 48: | SSTATIC { NOEXT("STATIC statement"); $$ = - STGBSS; } ! 49: ; ! 50: ! 51: lengspec: ! 52: { $$ = varleng; } ! 53: | SSTAR intonlyon expr intonlyoff ! 54: { ! 55: expptr p; ! 56: p = $3; ! 57: NO66("length specification *n"); ! 58: if( ! ISICON(p) || p->constblock.Const.ci<0 ) ! 59: { ! 60: $$ = 0; ! 61: dclerr("length must be a positive integer constant", ! 62: PNULL); ! 63: } ! 64: else $$ = p->constblock.Const.ci; ! 65: } ! 66: | SSTAR intonlyon SLPAR SSTAR SRPAR intonlyoff ! 67: { NO66("length specification *(*)"); $$ = -1; } ! 68: ; ! 69: ! 70: common: SCOMMON in_dcl var ! 71: { incomm( $$ = comblock(0, CNULL) , $3 ); } ! 72: | SCOMMON in_dcl comblock var ! 73: { $$ = $3; incomm($3, $4); } ! 74: | common opt_comma comblock opt_comma var ! 75: { $$ = $3; incomm($3, $5); } ! 76: | common SCOMMA var ! 77: { incomm($1, $3); } ! 78: ; ! 79: ! 80: comblock: SCONCAT ! 81: { $$ = comblock(0, CNULL); } ! 82: | SSLASH SNAME SSLASH ! 83: { $$ = comblock(toklen, token); } ! 84: ; ! 85: ! 86: external: SEXTERNAL in_dcl name ! 87: { setext($3); } ! 88: | external SCOMMA name ! 89: { setext($3); } ! 90: ; ! 91: ! 92: intrinsic: SINTRINSIC in_dcl name ! 93: { NO66("INTRINSIC statement"); setintr($3); } ! 94: | intrinsic SCOMMA name ! 95: { setintr($3); } ! 96: ; ! 97: ! 98: equivalence: SEQUIV in_dcl equivset ! 99: | equivalence SCOMMA equivset ! 100: ; ! 101: ! 102: equivset: SLPAR equivlist SRPAR ! 103: { ! 104: struct Equivblock *p; ! 105: if(nequiv >= maxequiv) ! 106: many("equivalences", 'q', maxequiv); ! 107: p = & eqvclass[nequiv++]; ! 108: p->eqvinit = NO; ! 109: p->eqvbottom = 0; ! 110: p->eqvtop = 0; ! 111: p->equivs = $2; ! 112: } ! 113: ; ! 114: ! 115: equivlist: lhs ! 116: { $$=ALLOC(Eqvchain); ! 117: $$->eqvitem.eqvlhs = (struct Primblock *)$1; ! 118: } ! 119: | equivlist SCOMMA lhs ! 120: { $$=ALLOC(Eqvchain); ! 121: $$->eqvitem.eqvlhs = (struct Primblock *) $3; ! 122: $$->eqvnextp = $1; ! 123: } ! 124: ; ! 125: ! 126: data: SDATA in_data datalist ! 127: | data opt_comma datalist ! 128: ; ! 129: ! 130: in_data: ! 131: { if(parstate == OUTSIDE) ! 132: { ! 133: newproc(); ! 134: startproc(PNULL, CLMAIN); ! 135: } ! 136: if(parstate < INDATA) ! 137: { ! 138: enddcl(); ! 139: parstate = INDATA; ! 140: } ! 141: } ! 142: ; ! 143: ! 144: datalist: datainit datavarlist SSLASH datapop vallist SSLASH ! 145: { ftnint junk; ! 146: if(nextdata(&junk,&junk) != NULL) ! 147: err("too few initializers"); ! 148: frdata($2); ! 149: frrpl(); ! 150: } ! 151: ; ! 152: ! 153: datainit: /* nothing */ { frchain(&datastack); curdtp = 0; } ! 154: ! 155: datapop: /* nothing */ { pop_datastack(); } ! 156: ! 157: vallist: { toomanyinit = NO; } val ! 158: | vallist SCOMMA val ! 159: ; ! 160: ! 161: val: value ! 162: { dataval(PNULL, $1); } ! 163: | simple SSTAR value ! 164: { dataval($1, $3); } ! 165: ; ! 166: ! 167: value: simple ! 168: | addop simple ! 169: { if( $1==OPMINUS && ISCONST($2) ) ! 170: consnegop($2); ! 171: $$ = $2; ! 172: } ! 173: | complex_const ! 174: | bit_const ! 175: ; ! 176: ! 177: savelist: saveitem ! 178: | savelist SCOMMA saveitem ! 179: ; ! 180: ! 181: saveitem: name ! 182: { int k; ! 183: $1->vsave = YES; ! 184: k = $1->vstg; ! 185: if( ! ONEOF(k, M(STGUNKNOWN)|M(STGBSS)|M(STGINIT)) ) ! 186: dclerr("can only save static variables", $1); ! 187: } ! 188: | comblock ! 189: { $1->extsave = 1; } ! 190: ; ! 191: ! 192: paramlist: paramitem ! 193: | paramlist SCOMMA paramitem ! 194: ; ! 195: ! 196: paramitem: name SEQUALS expr ! 197: { if($1->vclass == CLUNKNOWN) ! 198: make_param($1, $3); ! 199: /* was... ! 200: { $1->vclass = CLPARAM; ! 201: ( (struct Paramblock *) ($1) )->paramval = $3; ! 202: } ! 203: */ ! 204: else dclerr("cannot make %s parameter", $1); ! 205: } ! 206: ; ! 207: ! 208: var: name dims ! 209: { if(ndim>0) setbound($1, ndim, dims); } ! 210: ; ! 211: ! 212: datavar: lhs ! 213: { Namep np; ! 214: np = ( (struct Primblock *) $1) -> namep; ! 215: vardcl(np); ! 216: if(np->vstg == STGCOMMON) ! 217: extsymtab[np->vardesc.varno].extinit = YES; ! 218: else if(np->vstg==STGEQUIV) ! 219: eqvclass[np->vardesc.varno].eqvinit = YES; ! 220: else if(np->vstg!=STGINIT && np->vstg!=STGBSS) ! 221: dclerr("inconsistent storage classes", np); ! 222: $$ = mkchain($1, CHNULL); ! 223: } ! 224: | SLPAR datavarlist SCOMMA dospec SRPAR ! 225: { chainp p; struct Impldoblock *q; ! 226: pop_datastack(); ! 227: q = ALLOC(Impldoblock); ! 228: q->tag = TIMPLDO; ! 229: (q->varnp = (Namep) ($4->datap))->vimpldovar = !(bugwarn & 2); ! 230: p = $4->nextp; ! 231: if(p) { q->implb = (expptr)(p->datap); p = p->nextp; } ! 232: if(p) { q->impub = (expptr)(p->datap); p = p->nextp; } ! 233: if(p) { q->impstep = (expptr)(p->datap); p = p->nextp; } ! 234: frchain( & ($4) ); ! 235: $$ = mkchain(q, CHNULL); ! 236: q->datalist = hookup($2, $$); ! 237: } ! 238: ; ! 239: ! 240: datavarlist: datavar ! 241: { if (!datastack) ! 242: curdtp = 0; ! 243: datastack = mkchain((tagptr)curdtp, datastack); ! 244: curdtp = $1; curdtelt = 0; ! 245: } ! 246: | datavarlist SCOMMA datavar ! 247: { $$ = hookup($1, $3); } ! 248: ; ! 249: ! 250: dims: ! 251: { ndim = 0; } ! 252: | SLPAR dimlist SRPAR ! 253: ; ! 254: ! 255: dimlist: { ndim = 0; } dim ! 256: | dimlist SCOMMA dim ! 257: ; ! 258: ! 259: dim: ubound ! 260: { if(ndim == maxdim) ! 261: err("too many dimensions"); ! 262: else if(ndim < maxdim) ! 263: { dims[ndim].lb = 0; ! 264: dims[ndim].ub = $1; ! 265: } ! 266: ++ndim; ! 267: } ! 268: | expr SCOLON ubound ! 269: { if(ndim == maxdim) ! 270: err("too many dimensions"); ! 271: else if(ndim < maxdim) ! 272: { dims[ndim].lb = $1; ! 273: dims[ndim].ub = $3; ! 274: } ! 275: ++ndim; ! 276: } ! 277: ; ! 278: ! 279: ubound: SSTAR ! 280: { $$ = 0; } ! 281: | expr ! 282: ; ! 283: ! 284: labellist: label ! 285: { nstars = 1; labarray[0] = $1; } ! 286: | labellist SCOMMA label ! 287: { if(nstars < MAXLABLIST) labarray[nstars++] = $3; } ! 288: ; ! 289: ! 290: label: SICON ! 291: { $$ = execlab( convci(toklen, token) ); } ! 292: ; ! 293: ! 294: implicit: SIMPLICIT in_dcl implist ! 295: { NO66("IMPLICIT statement"); } ! 296: | implicit SCOMMA implist ! 297: ; ! 298: ! 299: implist: imptype SLPAR letgroups SRPAR ! 300: ; ! 301: ! 302: imptype: { needkwd = 1; } type ! 303: { vartype = $2; } ! 304: ; ! 305: ! 306: letgroups: letgroup ! 307: | letgroups SCOMMA letgroup ! 308: ; ! 309: ! 310: letgroup: letter ! 311: { setimpl(vartype, varleng, $1, $1); } ! 312: | letter SMINUS letter ! 313: { setimpl(vartype, varleng, $1, $3); } ! 314: ; ! 315: ! 316: letter: SNAME ! 317: { if(toklen!=1 || token[0]<'a' || token[0]>'z') ! 318: { ! 319: dclerr("implicit item must be single letter", PNULL); ! 320: $$ = 0; ! 321: } ! 322: else $$ = token[0]; ! 323: } ! 324: ; ! 325: ! 326: namelist: SNAMELIST ! 327: | namelist namelistentry ! 328: ; ! 329: ! 330: namelistentry: SSLASH name SSLASH namelistlist ! 331: { ! 332: if($2->vclass == CLUNKNOWN) ! 333: { ! 334: $2->vclass = CLNAMELIST; ! 335: $2->vtype = TYINT; ! 336: $2->vstg = STGINIT; ! 337: $2->varxptr.namelist = $4; ! 338: $2->vardesc.varno = ++lastvarno; ! 339: } ! 340: else dclerr("cannot be a namelist name", $2); ! 341: } ! 342: ; ! 343: ! 344: namelistlist: name ! 345: { $$ = mkchain($1, CHNULL); } ! 346: | namelistlist SCOMMA name ! 347: { $$ = hookup($1, mkchain($3, CHNULL)); } ! 348: ; ! 349: ! 350: in_dcl: ! 351: { switch(parstate) ! 352: { ! 353: case OUTSIDE: newproc(); ! 354: startproc(PNULL, CLMAIN); ! 355: case INSIDE: parstate = INDCL; ! 356: case INDCL: break; ! 357: ! 358: default: ! 359: dclerr("declaration among executables", PNULL); ! 360: } ! 361: } ! 362: ;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.