|
|
researchv10 Norman
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; }
;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.