1%{
2
3#include "defines.h"
4#include "defs.h"
5
6static int nstars;
7static int ndim;
8static int vartype;
9static ftnint varleng;
10struct uux dims[8];
11static struct labelblock *labarray[100];
12static int lastwasbranch = NO;
13static int thiswasbranch = NO;
14
15%}
16
17/* Specify precedences and associativies. */
18
19%left SCOMMA
20%nonassoc SCOLON
21%right SEQUALS
22%left SEQV SNEQV
23%left SOR
24%left SAND
25%left SNOT
26%nonassoc SLT SGT SLE SGE SEQ SNE
27%left SCONCAT
28%left SPLUS SMINUS
29%left SSTAR SSLASH
30%right SPOWER
31
32%union {
33	struct labelblock *label;
34	struct extsym *extsym;
35
36	bigptr bigptr;
37	chainp chainp;
38
39	ftnint fint;
40	char *str;
41	char token;
42	int num;
43}
44
45%type <label>	thislabel label labelval
46%type <str>	filename
47%type <num>	SLABEL type dcl typename addop relop
48		stop nameeq
49%type <extsym>	progname entryname common comblock
50%type <bigptr>	name var call lhs simple inelt other bit_const
51		value simple_const complex_const arg
52%type <chainp>	args datavarlist datavar dospec funarglist funargs exprlist
53		callarglist inlist outlist out2 equivlist arglist
54%type <fint>	lengspec
55%type <token>	letter
56%type <bigptr>	uexpr callarg opt_expr unpar_fexpr ubound expr fexpr
57
58%%
59
60program:
61	| program stat SEOS
62	;
63
64stat:	  thislabel entry
65		{ lastwasbranch = NO; }
66	| thislabel  spec
67	| thislabel  exec
68		{ if($1 && ($1->labelno==dorange))
69			enddo($1->labelno);
70		  if(lastwasbranch && thislabel==NULL)
71			warn1("statement cannot be reached");
72		  lastwasbranch = thiswasbranch;
73		  thiswasbranch = NO;
74		}
75	| thislabel SINCLUDE filename
76		{ doinclude( $3 ); }
77	| thislabel  SEND  end_spec
78		{ lastwasbranch = NO;  endproc(); }
79	| thislabel SUNKNOWN
80		{ execerr("unclassifiable statement", 0);  flline(); }
81	| error
82		{ flline();  needkwd = NO;  inioctl = NO;
83		  yyerrok; yyclearin; }
84	;
85
86thislabel:  SLABEL
87		{
88		if($1)
89			{
90			$$ = thislabel =  mklabel( (ftnint) $1);
91			if( ! headerdone )
92				puthead(NULL);
93			if(thislabel->labdefined)
94				execerr("label %s already defined",
95					convic(thislabel->stateno) );
96			else	{
97				if(thislabel->blklevel!=0 && thislabel->blklevel<blklevel
98				    && thislabel->labtype!=LABFORMAT)
99					warn1("there is a branch to label %s from outside block",
100					      convic( (ftnint) (thislabel->stateno) ) );
101				thislabel->blklevel = blklevel;
102				thislabel->labdefined = YES;
103				if(thislabel->labtype != LABFORMAT)
104					putlabel(thislabel->labelno);
105				}
106			}
107		else    $$ = thislabel = NULL;
108		}
109	;
110
111entry:	  SPROGRAM new_proc progname
112		{ startproc($3, CLMAIN); }
113	| SBLOCK new_proc progname
114		{ startproc($3, CLBLOCK); }
115	| SSUBROUTINE new_proc entryname arglist
116		{ entrypt(CLPROC, TYSUBR, (ftnint) 0,  $3, $4); }
117	| SFUNCTION new_proc entryname arglist
118		{ entrypt(CLPROC, TYUNKNOWN, (ftnint) 0, $3, $4); }
119	| type SFUNCTION new_proc entryname arglist
120		{ entrypt(CLPROC, $1, varleng, $4, $5); }
121	| SENTRY entryname arglist
122		{ if(parstate==OUTSIDE || procclass==CLMAIN
123			|| procclass==CLBLOCK)
124				execerr("misplaced entry statement", 0);
125		  entrypt(CLENTRY, 0, (ftnint) 0, $2, $3);
126		}
127	;
128
129new_proc:
130		{ newproc(); }
131	;
132
133entryname:  name
134		{ $$ = newentry($1); }
135	;
136
137name:	  SFNAME
138		{ $$ = mkname(toklen, token); }
139	;
140
141progname:		{ $$ = NULL; }
142	| entryname
143	;
144
145arglist:
146		{ $$ = 0; }
147	| SLPAR SRPAR
148		{ $$ = 0; }
149	| SLPAR args SRPAR
150		{$$ = $2; }
151	;
152
153args:	  arg
154		{ $$ = ($1 ? mkchain($1,0) : 0 ); }
155	| args SCOMMA arg
156		{ if($3) $1 = $$ = hookup($1, mkchain($3,0)); }
157	;
158
159arg:	  name
160		{ $1->vstg = STGARG; }
161	| SSTAR
162		{ $$ = 0;  substars = YES; }
163	;
164
165
166
167filename:   SHOLLERITH
168		{
169		char *s;
170		s = copyn(toklen+1, token);
171		s[toklen] = '\0';
172		$$ = s;
173		}
174	;
175