Bell 32V release

[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);
			}
		}
	;