Bell 32V development

[unix-history] / usr / src / cmd / f77 / gram.dcl

spec:     dcl
       | common
       | external
       | intrinsic
       | equivalence
       | data
       | implicit
       | SSAVE
               { saveall = YES; }
       | SSAVE savelist
       | SFORMAT
               { fmtstmt(thislabel); setfmt(thislabel); }
       | SPARAM in_dcl SLPAR paramlist SRPAR
       ;

dcl:      type name in_dcl lengspec dims
               { settype($2, $1, $4);
                 if(ndim>0) setbound($2,ndim,dims);
               }
       | dcl SCOMMA name lengspec dims
               { settype($3, $1, $4);
                 if(ndim>0) setbound($3,ndim,dims);
               }
       ;

type:     typespec lengspec
               { varleng = $2; }
       ;

typespec:  typename
               { varleng = ($1<0 || $1==TYLONG ? 0 : typesize[$1]); }
       ;

typename:    SINTEGER   { $$ = TYLONG; }
       | SREAL         { $$ = TYREAL; }
       | SCOMPLEX      { $$ = TYCOMPLEX; }
       | SDOUBLE       { $$ = TYDREAL; }
       | SDCOMPLEX     { $$ = TYDCOMPLEX; }
       | SLOGICAL      { $$ = TYLOGICAL; }
       | SCHARACTER    { $$ = TYCHAR; }
       | SUNDEFINED    { $$ = TYUNKNOWN; }
       | SDIMENSION    { $$ = TYUNKNOWN; }
       | SAUTOMATIC    { $$ = - STGAUTO; }
       | SSTATIC       { $$ = - STGBSS; }
       ;

lengspec:
               { $$ = varleng; }
       | SSTAR expr
               {
                 if( ! ISICON($2) )
                       {
                       $$ = 0;
                       dclerr("length must be an integer constant", 0);
                       }
                 else $$ = $2->const.ci;
               }
       | SSTAR SLPAR SSTAR SRPAR
               { $$ = 0; }
       ;

common:   SCOMMON in_dcl var
               { incomm( $$ = comblock(0, 0) , $3 ); }
       | SCOMMON in_dcl comblock var
               { $$ = $3;  incomm($3, $4); }
       | common opt_comma comblock opt_comma var
               { $$ = $3;  incomm($3, $5); }
       | common SCOMMA var
               { incomm($1, $3); }
       ;

comblock:  SCONCAT
               { $$ = comblock(0, 0); }
       | SSLASH SNAME SSLASH
               { $$ = comblock(toklen, token); }
       ;

external: SEXTERNAL in_dcl name
               { setext($3); }
       | external SCOMMA name
               { setext($3); }
       ;

intrinsic:  SINTRINSIC in_dcl name
               { setintr($3); }
       | intrinsic SCOMMA name
               { setintr($3); }
       ;

equivalence:  SEQUIV in_dcl equivset
       | equivalence SCOMMA equivset
       ;

equivset:  SLPAR equivlist SRPAR
               {
               struct equivblock *p;
               if(nequiv >= MAXEQUIV)
                       fatal("too many equivalences");
               p  =  & eqvclass[nequiv++];
               p->eqvinit = 0;
               p->eqvbottom = 0;
               p->eqvtop = 0;
               p->equivs = $2;
               }
       ;

equivlist:  lhs
               { $$ = ALLOC(eqvchain); $$->eqvitem = $1; }
       | equivlist SCOMMA lhs
               { $$ = ALLOC(eqvchain); $$->eqvitem = $3; $$->nextp = $1; }
       ;

data:     SDATA in_data datalist
       | data opt_comma datalist
       ;

in_data:
               { if(parstate == OUTSIDE)
                       {
                       newproc();
                       startproc(0, CLMAIN);
                       }
                 if(parstate < INDATA)
                       {
                       enddcl();
                       parstate = INDATA;
                       }
               }
       ;

datalist:  datavarlist SSLASH vallist SSLASH
               { ftnint junk;
                 if(nextdata(&junk,&junk) != NULL)
                       {
                       err("too few initializers");
                       curdtp = NULL;
                       }
                 frdata($1);
                 frrpl();
               }
       ;

vallist:  { toomanyinit = NO; }  val
       | vallist SCOMMA val
       ;

val:      value
               { dataval(NULL, $1); }
       | simple SSTAR value
               { dataval($1, $3); }
       ;

value:    simple
       | addop simple
               { if( $1==OPMINUS && ISCONST($2) )
                       consnegop($2);
                 $$ = $2;
               }
       | complex_const
       | bit_const
       ;

savelist: saveitem
       | savelist SCOMMA saveitem
       ;

saveitem: name
               { int k;
                 $1->vsave = 1;
                 k = $1->vstg;
               if( ! ONEOF(k, M(STGUNKNOWN)|M(STGBSS)|M(STGINIT)) )
                       dclerr("can only save static variables", $1);
               }
       | comblock
               { $1->extsave = 1; }
       ;

paramlist:  paramitem
       | paramlist SCOMMA paramitem
       ;

paramitem:  name SEQUALS expr
               { if($1->vclass == CLUNKNOWN)
                       { $1->vclass = CLPARAM;
                         $1->paramval = $3;
                       }
                 else dclerr("cannot make %s parameter", $1);
               }
       ;

var:      name dims
               { if(ndim>0) setbounds($1, ndim, dims); }
       ;

datavar:          lhs
               { ptr np;
                 vardcl(np = $1->namep);
                 if(np->vstg == STGBSS)
                       np->vstg = STGINIT;
                 else if(np->vstg == STGCOMMON)
                       extsymtab[np->vardesc.varno].extinit = YES;
                 else if(np->vstg==STGEQUIV)
                       eqvclass[np->vardesc.varno].eqvinit = YES;
                 else if(np->vstg != STGINIT)
                       dclerr("inconsistent storage classes", np);
                 $$ = mkchain($1, 0);
               }
       | SLPAR datavarlist SCOMMA dospec SRPAR
               { chainp p; struct impldoblock *q;
               q = ALLOC(impldoblock);
               q->tag = TIMPLDO;
               q->varnp = $4->datap;
               p = $4->nextp;
               if(p)  { q->implb = p->datap; p = p->nextp; }
               if(p)  { q->impub = p->datap; p = p->nextp; }
               if(p)  { q->impstep = p->datap; p = p->nextp; }
               frchain( & ($4) );
               $$ = mkchain(q, 0);
               q->datalist = hookup($2, $$);
               }
       ;

datavarlist: datavar
               { curdtp = $1; curdtelt = 0; }
       | datavarlist SCOMMA datavar
               { $$ = hookup($1, $3); }
       ;

dims:
               { ndim = 0; }
       | SLPAR dimlist SRPAR
       ;

dimlist:   { ndim = 0; }   dim
       | dimlist SCOMMA dim
       ;

dim:      ubound
               { dims[ndim].lb = 0;
                 dims[ndim].ub = $1;
                 ++ndim;
               }
       | expr SCOLON ubound
               { dims[ndim].lb = $1;
                 dims[ndim].ub = $3;
                 ++ndim;
               }
       ;

ubound:   SSTAR
               { $$ = 0; }
       | expr
       ;

labellist: label
               { nstars = 1; labarray[0] = $1; }
       | labellist SCOMMA label
               { labarray[nstars++] = $3; }
       ;

label:    labelval
               { if($1->labinacc)
                       warn1("illegal branch to inner block, statement %s",
                               convic( (ftnint) ($1->stateno) ));
                 else if($1->labdefined == NO)
                       $1->blklevel = blklevel;
                 $1->labused = YES;
               }
       ;

labelval:   SICON
               { $$ = mklabel( convci(toklen, token) ); }
       ;

implicit:  SIMPLICIT in_dcl implist
       | implicit SCOMMA implist
       ;

implist:  imptype SLPAR letgroups SRPAR
       ;

imptype:   { needkwd = 1; } type
               { vartype = $2; }
       ;

letgroups: letgroup
       | letgroups SCOMMA letgroup
       ;

letgroup:  letter
               { setimpl(vartype, varleng, $1, $1); }
       | letter SMINUS letter
               { setimpl(vartype, varleng, $1, $3); }
       ;

letter:  SNAME
               { if(toklen!=1 || token[0]<'a' || token[0]>'z')
                       {
                       dclerr("implicit item must be single letter", 0);
                       $$ = 0;
                       }
                 else $$ = token[0];
               }
       ;

in_dcl:
               { switch(parstate)      
                       {
                       case OUTSIDE:   newproc();
                                       startproc(0, CLMAIN);
                       case INSIDE:    parstate = INDCL;
                       case INDCL:     break;

                       default:
                               dclerr("declaration among executables", 0);
                       }
               }
       ;