BSD 4 release

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

%{
#	include "defs"

#ifdef SDB
#	include <a.out.h>
char *stabline();
#	ifdef UCBVAXASM
		char *stabdline();
#	endif

#	ifndef N_SO
#		include <stab.h>
#	endif
#endif

static int nstars;
static int ndim;
static int vartype;
static ftnint varleng;
static struct { expptr lb, ub; } dims[MAXDIM+1];
static struct Labelblock *labarray[MAXLABLIST];
static int lastwasbranch = NO;
static int thiswasbranch = NO;
extern ftnint yystno;
extern flag intonly;

ftnint convci();
double convcd();
Addrp nextdata();
expptr mklogcon(), mkaddcon(), mkrealcon(), mkstrcon(), mkbitcon();
expptr mkcxcon();
struct Listblock *mklist();
struct Listblock *mklist();
struct Impldoblock *mkiodo();
struct Extsym *comblock();

%}

/* Specify precedences and associativities. */

%union	{
	int ival;
	char *charpval;
	chainp chval;
	tagptr tagval;
	expptr expval;
	struct Labelblock *labval;
	struct Nameblock *namval;
	struct Eqvchain *eqvval;
	struct Extsym *extval;
	}

%left SCOMMA
%nonassoc SCOLON
%right SEQUALS
%left SEQV SNEQV
%left SOR
%left SAND
%left SNOT
%nonassoc SLT SGT SLE SGE SEQ SNE
%left SCONCAT
%left SPLUS SMINUS
%left SSTAR SSLASH
%right SPOWER

%start program
%type <labval> thislabel label assignlabel
%type <tagval> other inelt
%type <ival> lengspec type typespec typename dcl letter addop relop stop nameeq
%type <charpval> filename
%type <chval> datavar datavarlist namelistlist funarglist funargs dospec
%type <chval> callarglist arglist args exprlist inlist outlist out2 substring
%type <namval> name arg call var
%type <expval> lhs expr uexpr opt_expr fexpr unpar_fexpr
%type <expval> ubound simple value callarg complex_const simple_const bit_const
%type <extval> common comblock entryname progname
%type <eqvval> equivlist

%%

program:
	| program stat SEOS
	;

stat:	  thislabel  entry
		{ lastwasbranch = NO; }
	| thislabel  spec
	| thislabel  exec
		{ if($1 && ($1->labelno==dorange))
			enddo($1->labelno);
		  if(lastwasbranch && thislabel==NULL)
			warn("statement cannot be reached");
		  lastwasbranch = thiswasbranch;
		  thiswasbranch = NO;
		  if($1)
			{
			if($1->labtype == LABFORMAT)
				err("label already that of a format");
			else
				$1->labtype = LABEXEC;
			}
		}
	| thislabel SINCLUDE filename
		{ doinclude( $3 ); }
	| thislabel  SEND  end_spec
		{ lastwasbranch = NO;  endproc(); }
	| thislabel SUNKNOWN
		{ execerr("unclassifiable statement", CNULL);  flline(); };
	| error
		{ flline();  needkwd = NO;  inioctl = NO; 
		  yyerrok; yyclearin; }
	;

thislabel:  SLABEL
		{
#ifdef SDB
		char buff[10];
		if( sdbflag )
			{
#	ifdef UCBVAXASM
			p2pass( stabdline(N_SLINE, lineno) );
#	else
			sprintf(buff,"LL%d", ++dbglabel);
			p2pass( stabline(0, N_SLINE, lineno, buff) );
			p2pi("LL%d:\n", dbglabel);
#	endif
			}
#endif

		if(yystno != 0)
			{
			$$ = thislabel =  mklabel(yystno);
			if( ! headerdone )
				puthead(CNULL, procclass);
			if(thislabel->labdefined)
				execerr("label %s already defined",
					convic(thislabel->stateno) );
			else	{
				if(thislabel->blklevel!=0 && thislabel->blklevel<blklevel
				    && thislabel->labtype!=LABFORMAT)
					warn1("there is a branch to label %s from outside block",
					      convic( (ftnint) (thislabel->stateno) ) );
				thislabel->blklevel = blklevel;
				thislabel->labdefined = YES;
				if(thislabel->labtype != LABFORMAT)
					putlabel(thislabel->labelno);
				}
			}
		else    $$ = thislabel = NULL;
		}
	;

entry:	  SPROGRAM new_proc progname
		   {startproc($3, CLMAIN); }
	| SBLOCK new_proc progname
		{ if($3) NO66("named BLOCKDATA");
		  startproc($3, CLBLOCK); }
	| SSUBROUTINE new_proc entryname arglist
		{ entrypt(CLPROC, TYSUBR, (ftnint) 0,  $3, $4); }
	| SFUNCTION new_proc entryname arglist
		{ entrypt(CLPROC, TYUNKNOWN, (ftnint) 0, $3, $4); }
	| type SFUNCTION new_proc entryname arglist
		{ entrypt(CLPROC, $1, varleng, $4, $5); }
	| SENTRY entryname arglist
		 { if(parstate==OUTSIDE || procclass==CLMAIN
			|| procclass==CLBLOCK)
				execerr("misplaced entry statement", CNULL);
		  entrypt(CLENTRY, 0, (ftnint) 0, $2, $3);
		}
	;

new_proc:
		{ newproc(); }
	;

entryname:  name
		{ $$ = newentry($1); }
	;

name:	  SNAME
		{ $$ = mkname(toklen, token); }
	;

progname:		{ $$ = NULL; }
	| entryname
	;

arglist:
		{ $$ = 0; }
	| SLPAR SRPAR
		{ NO66(" () argument list");
		  $$ = 0; }
	| SLPAR args SRPAR
		{$$ = $2; }
	;

args:	  arg
		{ $$ = ($1 ? mkchain($1,CHNULL) : CHNULL ); }
	| args SCOMMA arg
		{ if($3) $1 = $$ = hookup($1, mkchain($3,CHNULL)); }
	;

arg:	  name
		{ if($1->vstg!=STGUNKNOWN && $1->vstg!=STGARG)
			dclerr("name declared as argument after use", $1);
		  $1->vstg = STGARG;
		}
	| SSTAR
		{ NO66("altenate return argument");
		  $$ = 0;  substars = YES; }
	;



filename:   SHOLLERITH
		{
		char *s;
		s = copyn(toklen+1, token);
		s[toklen] = '\0';
		$$ = s;
		}
	;