dcls1: dcl1 | dcls1 EOS | dcls1 EOS dcl1 { $$ = (int *)hookup($1,$3); } ; dcl1: dcl | varlist ; dcl: attrs vars { attvars($1,$2); $$ = $2; } | attrs LBRACK dcls1 RBRACK { attvars($1,$3); $$ = $3; } | INITIAL initlist { $$ = 0; } | IMPLICIT letton implist lettoff { $$ = 0; } | EQUIVALENCE equivsets { $$ = 0; } | EQUIVALENCE equivlist { mkequiv($2); $$ = 0; } ; dcls: dcl | dcls EOS | dcls EOS dcl { $$ = (int *)hookup($1,$3); } ; initlist: init | initlist COMMA init ; init: lhs ASGNOP {ininit = YES; } expr = { ininit = NO; mkinit($1,$4); frexpr($1); } ; implist: impgroup | implist COMMA impgroup; ; impgroup: impspec { setimpl(imptype, 'a', 'z'); } | impspec LPAR impsets RPAR ; impspec: specs { imptype = ((struct atblock *)$1)->attype; cfree($1); } ; impsets: impset | impsets COMMA impset ; impset: LETTER { setimpl(imptype, $1, $1); } | LETTER ADDOP LETTER { setimpl(imptype, $1, $3); } ; equivsets: equivset | equivsets COMMA equivset ; equivset: LPAR equivlist RPAR { mkequiv($2); } ; equivlist: lhs COMMA lhs { $$ = (int *)mkchain($1, mkchain($3,CHNULL)); } | equivlist COMMA lhs { $$ = (int *)hookup($1, mkchain($3,CHNULL)); } ; attrs: attr | attrs attr { attatt($1,$2); } ; attr: spec dim { ((struct atblock *)$1)->atdim = $2; } | array dim { $$ = (int *)ALLOC(atblock); ((struct atblock *)$$)->atdim = $2; } ; dim: { $$ = 0; } | dimbound ; dimbound: LPAR { inbound = 1; } bounds RPAR { inbound = 0; $$ = arrays = (int *)mkchain($3,arrays); } ; bounds: bound | bounds COMMA bound { hookup($1,$3); } ; bound: ubound { $$ = (int *)ALLOC(dimblock); ((struct dimblock *)$$)->lowerb = 0; ((struct dimblock *)$$)->upperb = $1; } | expr COLON ubound { $$ = (int *)ALLOC(dimblock); ((struct dimblock *)$$)->lowerb = $1; ((struct dimblock *)$$)->upperb = $3; } ; ubound: expr | MULTOP { $$ = 0; } ; vars: { $$ = 0; } | varlist ; varlist: var | varlist COMMA var { hookup($1,$3); } ; var: varname dim { if($2!=0) if(((struct exprblock /*|| struct varblock */ *)$1)->vdim==0) ((struct exprblock /*|| struct varblock */ *)$1)->vdim = $2; else if(!eqdim($2,((struct exprblock /*|| struct varblock */ *)$1)->vdim)) dclerr("multiple dimension", ((struct stentry *)$1)->namep); $$ = (int *)mkchain($1,CHNULL); } | varname dim ASGNOP { ininit = YES; } expr { ininit = NO; if($3!=OPASGN) dclerr("illegal initialization operator", ((struct stentry *)((struct defblock /*|| struct labelblock|| struct varblock|| struct keyblock|| struct typeblock */ *)$1)->sthead)->namep); if($2!=0) if(((struct exprblock /*|| struct varblock */ *)$1)->vdim==0) ((struct exprblock /*|| struct varblock */ *)$1)->vdim = $2; else if(!eqdim($2,((struct exprblock /*|| struct varblock */ *)$1)->vdim)) dclerr("multiple dimension", ((struct stentry *)((struct defblock /*|| struct labelblock|| struct varblock|| struct keyblock|| struct typeblock */ *)$1)->sthead)->namep); if($5!=0 && ((struct varblock *)$1)->vinit!=0) dclerr("multiple initialization", ((struct stentry *)((struct defblock /*|| struct labelblock|| struct varblock|| struct keyblock|| struct typeblock */ *)$1)->sthead)->namep); ((struct varblock *)$1)->vinit = $5; $$ = (int *)mkchain($1,CHNULL); } ; varname: NAME { $$ = mkvar($1); } ; specs: specarray | specs specarray { attatt($1,$2); } ; specarray: spec | array dimbound { $$ = (int *)ALLOC(atblock); ((struct atblock *)$$)->atdim = $2; } ; spec: sclass { $$ = (int *)ALLOC(atblock); if($1 == CLEXT) ((struct atblock *)$$)->atext = 1; ((struct atblock *)$$)->atclass = $1; } | comclass contnu { $$ = (int *)ALLOC(atblock); ((struct atblock *)$$)->atclass = CLCOMMON; ((struct atblock *)$$)->atcommon = $1; } | stype { $$ = (int *)ALLOC(atblock); ((struct atblock *)$$)->attype = $1; } | CHARACTER LPAR expr RPAR { $$ = (int *)ALLOC(atblock); ((struct atblock *)$$)->attype = TYCHAR; ((struct atblock *)$$)->attypep = $3; } | FIELD LPAR bound RPAR { $$ = (int *)ALLOC(atblock); ((struct atblock *)$$)->attype = TYFIELD; ((struct atblock *)$$)->attypep = mkfield($3); } | deftype { $$ = (int *)ALLOC(atblock); ((struct atblock *)$$)->attype = TYSTRUCT; ((struct atblock *)$$)->attypep = $1; } | prec { $$ = (int *)ALLOC(atblock); ((struct atblock *)$$)->atprec = $1; } ; sclass: AUTOMATIC { $$ = CLAUTO; fprintf(diagfile,"AUTOMATIC not yet implemented\n"); } | STATIC { $$ = CLSTAT; } | INTERNAL { $$ = CLSTAT; } | VALUE { $$ = CLVALUE; fprintf(diagfile, "VALUE not yet implemented\n"); } | EXTERNAL { $$ = CLEXT; } ; comclass: COMMON LPAR comneed comname RPAR { $$ = $4; } | COMMON MULTOP comneed comname MULTOP { $$ = $4; } ; comneed: { comneed = 1; } ; comname: { $$ = mkcomm(""); } | COMNAME ; stype: INTEGER { $$ = TYINT; } | REAL { $$ = TYREAL; } | COMPLEX { $$ = TYCOMPLEX; } | LOGICAL { $$ = TYLOG; } | DOUBLE PRECISION { $$ = TYLREAL; /* holdover from Fortran */ } | DOUBLEPRECISION { $$ = TYLREAL; /* holdover from Fortran */ } ; deftype: STRUCTNAME { $$ = ((struct stentry *)$1)->varp; } | STRUCT structname contnu Struct { $$ = mkstruct($2,$4); } | STRUCT Struct { $$ = mkstruct(PNULL,$2); } ; structname: NAME { if(((struct stentry *)$1)->varp && ((struct headbits *)((struct stentry *)$1)->varp)->blklevel<blklevel) hide($1); ((struct headbits *)$1)->tag = TSTRUCT; } | STRUCTNAME { if(((struct stentry *)$1)->varp) if(((struct headbits *)((struct stentry *)$1)->varp)->blklevel<blklevel) hide($1); else dclerr("multiple declaration for type %s", ((struct stentry *)$1)->namep); } ; Struct: LBRACK { ++instruct; } dcls { --instruct; } RBRACK EOS { $$ = $3; prevv = -1; } ; array: ARRAY | DIMENSION ; prec: LONG { $$ = 1; } | SHORT { $$ = 0; } ;