|
|
1.1 ! root 1: dcls1: dcl1 ! 2: | dcls1 EOS ! 3: | dcls1 EOS dcl1 ! 4: { $$ = (int *)hookup($1,$3); } ! 5: ; ! 6: ! 7: dcl1: dcl ! 8: | varlist ! 9: ; ! 10: ! 11: dcl: attrs vars ! 12: { attvars($1,$2); $$ = $2; } ! 13: | attrs LBRACK dcls1 RBRACK ! 14: { attvars($1,$3); $$ = $3; } ! 15: | INITIAL initlist ! 16: { $$ = 0; } ! 17: | IMPLICIT letton implist lettoff ! 18: { $$ = 0; } ! 19: | EQUIVALENCE equivsets ! 20: { $$ = 0; } ! 21: | EQUIVALENCE equivlist ! 22: { mkequiv($2); $$ = 0; } ! 23: ; ! 24: ! 25: dcls: dcl ! 26: | dcls EOS ! 27: | dcls EOS dcl ! 28: { $$ = (int *)hookup($1,$3); } ! 29: ; ! 30: ! 31: initlist: init ! 32: | initlist COMMA init ! 33: ; ! 34: ! 35: init: lhs ASGNOP {ininit = YES; } expr ! 36: = { ininit = NO; mkinit($1,$4); frexpr($1); } ! 37: ; ! 38: ! 39: implist: impgroup ! 40: | implist COMMA impgroup; ! 41: ; ! 42: ! 43: impgroup: impspec ! 44: { setimpl(imptype, 'a', 'z'); } ! 45: | impspec LPAR impsets RPAR ! 46: ; ! 47: ! 48: impspec: specs ! 49: { imptype = ((struct atblock *)$1)->attype; cfree($1); } ! 50: ; ! 51: ! 52: impsets: impset ! 53: | impsets COMMA impset ! 54: ; ! 55: ! 56: impset: LETTER ! 57: { setimpl(imptype, $1, $1); } ! 58: | LETTER ADDOP LETTER ! 59: { setimpl(imptype, $1, $3); } ! 60: ; ! 61: ! 62: equivsets: equivset ! 63: | equivsets COMMA equivset ! 64: ; ! 65: ! 66: equivset: LPAR equivlist RPAR ! 67: { mkequiv($2); } ! 68: ; ! 69: ! 70: equivlist: lhs COMMA lhs ! 71: { $$ = (int *)mkchain($1, mkchain($3,CHNULL)); } ! 72: | equivlist COMMA lhs ! 73: { $$ = (int *)hookup($1, mkchain($3,CHNULL)); } ! 74: ; ! 75: ! 76: attrs: attr ! 77: | attrs attr { attatt($1,$2); } ! 78: ; ! 79: ! 80: attr: spec dim { ((struct atblock *)$1)->atdim = $2; } ! 81: | array dim { $$ = (int *)ALLOC(atblock); ((struct atblock *)$$)->atdim = $2; } ! 82: ; ! 83: ! 84: dim: { $$ = 0; } ! 85: | dimbound ! 86: ; ! 87: ! 88: dimbound: LPAR { inbound = 1; } bounds RPAR ! 89: { inbound = 0; $$ = arrays = (int *)mkchain($3,arrays); } ! 90: ; ! 91: ! 92: bounds: bound ! 93: | bounds COMMA bound { hookup($1,$3); } ! 94: ; ! 95: ! 96: bound: ubound ! 97: { ! 98: $$ = (int *)ALLOC(dimblock); ! 99: ((struct dimblock *)$$)->lowerb = 0; ! 100: ((struct dimblock *)$$)->upperb = $1; ! 101: } ! 102: | expr COLON ubound ! 103: { ! 104: $$ = (int *)ALLOC(dimblock); ! 105: ((struct dimblock *)$$)->lowerb = $1; ! 106: ((struct dimblock *)$$)->upperb = $3; ! 107: } ! 108: ; ! 109: ! 110: ubound: expr ! 111: | MULTOP { $$ = 0; } ! 112: ; ! 113: ! 114: vars: { $$ = 0; } ! 115: | varlist ! 116: ; ! 117: ! 118: varlist: var ! 119: | varlist COMMA var { hookup($1,$3); } ! 120: ; ! 121: ! 122: var: varname dim ! 123: { ! 124: if($2!=0) ! 125: if(((struct exprblock /*|| struct varblock */ *)$1)->vdim==0) ! 126: ((struct exprblock /*|| struct varblock */ *)$1)->vdim = $2; ! 127: else if(!eqdim($2,((struct exprblock /*|| struct varblock */ *)$1)->vdim)) ! 128: dclerr("multiple dimension", ((struct stentry *)$1)->namep); ! 129: $$ = (int *)mkchain($1,CHNULL); ! 130: } ! 131: | varname dim ASGNOP { ininit = YES; } expr ! 132: { ! 133: ininit = NO; ! 134: if($3!=OPASGN) ! 135: dclerr("illegal initialization operator", ((struct stentry *)((struct defblock /*|| struct labelblock|| struct varblock|| struct keyblock|| struct typeblock */ *)$1)->sthead)->namep); ! 136: if($2!=0) ! 137: if(((struct exprblock /*|| struct varblock */ *)$1)->vdim==0) ! 138: ((struct exprblock /*|| struct varblock */ *)$1)->vdim = $2; ! 139: else if(!eqdim($2,((struct exprblock /*|| struct varblock */ *)$1)->vdim)) ! 140: dclerr("multiple dimension", ((struct stentry *)((struct defblock /*|| struct labelblock|| struct varblock|| struct keyblock|| struct typeblock */ *)$1)->sthead)->namep); ! 141: if($5!=0 && ((struct varblock *)$1)->vinit!=0) ! 142: dclerr("multiple initialization", ((struct stentry *)((struct defblock /*|| struct labelblock|| struct varblock|| struct keyblock|| struct typeblock */ *)$1)->sthead)->namep); ! 143: ((struct varblock *)$1)->vinit = $5; ! 144: $$ = (int *)mkchain($1,CHNULL); ! 145: } ! 146: ; ! 147: ! 148: varname: NAME ! 149: { $$ = mkvar($1); } ! 150: ; ! 151: ! 152: ! 153: specs: specarray ! 154: | specs specarray { attatt($1,$2); } ! 155: ; ! 156: ! 157: specarray: spec ! 158: | array dimbound ! 159: { $$ = (int *)ALLOC(atblock); ((struct atblock *)$$)->atdim = $2; } ! 160: ; ! 161: ! 162: spec: sclass ! 163: { ! 164: $$ = (int *)ALLOC(atblock); ! 165: if($1 == CLEXT) ! 166: ((struct atblock *)$$)->atext = 1; ! 167: ((struct atblock *)$$)->atclass = $1; ! 168: } ! 169: | comclass contnu ! 170: { ! 171: $$ = (int *)ALLOC(atblock); ! 172: ((struct atblock *)$$)->atclass = CLCOMMON; ! 173: ((struct atblock *)$$)->atcommon = $1; ! 174: } ! 175: | stype ! 176: { $$ = (int *)ALLOC(atblock); ((struct atblock *)$$)->attype = $1; } ! 177: | CHARACTER LPAR expr RPAR ! 178: { $$ = (int *)ALLOC(atblock); ((struct atblock *)$$)->attype = TYCHAR; ((struct atblock *)$$)->attypep = $3; } ! 179: | FIELD LPAR bound RPAR ! 180: { $$ = (int *)ALLOC(atblock); ((struct atblock *)$$)->attype = TYFIELD; ! 181: ((struct atblock *)$$)->attypep = mkfield($3); } ! 182: | deftype ! 183: { $$ = (int *)ALLOC(atblock); ((struct atblock *)$$)->attype = TYSTRUCT; ! 184: ((struct atblock *)$$)->attypep = $1; } ! 185: | prec ! 186: { $$ = (int *)ALLOC(atblock); ((struct atblock *)$$)->atprec = $1; } ! 187: ; ! 188: ! 189: sclass: AUTOMATIC { $$ = CLAUTO; ! 190: fprintf(diagfile,"AUTOMATIC not yet implemented\n"); } ! 191: | STATIC { $$ = CLSTAT; } ! 192: | INTERNAL { $$ = CLSTAT; } ! 193: | VALUE { $$ = CLVALUE; ! 194: fprintf(diagfile, "VALUE not yet implemented\n"); } ! 195: | EXTERNAL { $$ = CLEXT; } ! 196: ; ! 197: ! 198: comclass: COMMON LPAR comneed comname RPAR ! 199: { $$ = $4; } ! 200: | COMMON MULTOP comneed comname MULTOP ! 201: { $$ = $4; } ! 202: ; ! 203: ! 204: comneed: { comneed = 1; } ! 205: ; ! 206: ! 207: comname: { $$ = mkcomm(""); } ! 208: | COMNAME ! 209: ; ! 210: ! 211: stype: INTEGER { $$ = TYINT; } ! 212: | REAL { $$ = TYREAL; } ! 213: | COMPLEX { $$ = TYCOMPLEX; } ! 214: | LOGICAL { $$ = TYLOG; } ! 215: | DOUBLE PRECISION ! 216: { $$ = TYLREAL; /* holdover from Fortran */ } ! 217: | DOUBLEPRECISION ! 218: { $$ = TYLREAL; /* holdover from Fortran */ } ! 219: ; ! 220: ! 221: deftype: STRUCTNAME ! 222: { $$ = ((struct stentry *)$1)->varp; } ! 223: | STRUCT structname contnu Struct ! 224: { $$ = mkstruct($2,$4); } ! 225: | STRUCT Struct ! 226: { $$ = mkstruct(PNULL,$2); } ! 227: ; ! 228: ! 229: structname: NAME ! 230: { if(((struct stentry *)$1)->varp && ((struct headbits *)((struct stentry *)$1)->varp)->blklevel<blklevel) ! 231: hide($1); ! 232: ((struct headbits *)$1)->tag = TSTRUCT; ! 233: } ! 234: | STRUCTNAME ! 235: { if(((struct stentry *)$1)->varp) ! 236: if(((struct headbits *)((struct stentry *)$1)->varp)->blklevel<blklevel) ! 237: hide($1); ! 238: else dclerr("multiple declaration for type %s", ((struct stentry *)$1)->namep); ! 239: } ! 240: ; ! 241: ! 242: Struct: LBRACK { ++instruct; } dcls { --instruct; } RBRACK EOS ! 243: { $$ = $3; prevv = -1; } ! 244: ; ! 245: ! 246: array: ARRAY ! 247: | DIMENSION ! 248: ; ! 249: ! 250: prec: LONG { $$ = 1; } ! 251: | SHORT { $$ = 0; } ! 252: ;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.