1/*-
2 * Copyright (c) 1980 The Regents of the University of California.
3 * All rights reserved.
4 *
5 * %sccs.include.proprietary.c%
6 *
7 *	@(#)gram.exec	5.3 (Berkeley) 04/12/91
8 */
9
10/*
11 * gram.exec
12 *
13 * Grammar for executable statements, f77 compiler pass 1, 4.2 BSD.
14 *
15 * University of Utah CS Dept modification history:
16 *
17 * $Log:	gram.exec,v $
18 * Revision 5.2  85/12/18  20:17:38  donn
19 * Modified end_spec to insist on parser state INEXEC after seeing an
20 * executable statement.  This allows us to limit statement functions to
21 * parser state INDATA.
22 *
23 * Revision 5.1  85/08/10  03:47:22  donn
24 * 4.3 alpha
25 *
26 * Revision 3.1  84/10/13  00:36:41  donn
27 * Installed Jerry Berkman's version; preserved comment header.
28 *
29 * Revision 1.3  84/08/06  18:38:43  donn
30 * Fixed a bug in Jerry Berkman's label fixes which caused the same label to
31 * be generated twice for some types of logical IF statements.
32 *
33 * Revision 1.2  84/08/04  21:09:57  donn
34 * Added fixes from Jerry Berkman to allow proper ASSIGNS from format
35 * statement numbers.
36 *
37 */
38
39exec:	  iffable
40	| SDO end_spec intonlyon label intonlyoff opt_comma dospec
41		{
42		if( !do_name_err ) {
43		   if($4->labdefined)
44			execerr("no backward DO loops", CNULL);
45		   $4->blklevel = blklevel+1;
46		   exdo($4->labelno, $7);
47		   }
48		}
49	| logif iffable
50		{ exendif();  thiswasbranch = NO; }
51	| logif STHEN
52	| SELSEIF end_spec SLPAR expr SRPAR STHEN
53		{ exelif($4); lastwasbranch = NO; }
54	| SELSE end_spec
55		{ exelse(); lastwasbranch = NO; }
56	| SENDIF end_spec
57		{ exendif(); lastwasbranch = NO; }
58	;
59
60logif:	  SLOGIF end_spec SLPAR expr SRPAR
61		{ exif($4); }
62	;
63
64dospec:	  name SEQUALS exprlist
65		{ if( $1->vclass != CLPARAM ) {
66			$$ = mkchain($1, $3);
67			do_name_err = 0;
68		  } else {
69			err("symbolic constant not allowed as DO variable");
70		 	do_name_err = 1;
71		  }
72		}
73	;
74
75iffable:  let lhs SEQUALS expr
76		{ exequals($2, $4); }
77	| SASSIGN end_spec assignlabel STO name
78		{ if( $5->vclass != CLPARAM ) {
79			exassign($5, $3);
80		  } else {
81			err("can only assign to a variable");
82		  }
83		}
84	| SCONTINUE end_spec
85	| goto
86	| io
87		{ inioctl = NO; }
88	| SARITHIF end_spec SLPAR expr SRPAR label SCOMMA label SCOMMA label
89		{ exarif($4, $6, $8, $10);  thiswasbranch = YES; }
90	| call
91		{ excall($1, PNULL, 0, labarray); }
92	| call SLPAR SRPAR
93		{ excall($1, PNULL, 0, labarray); }
94	| call SLPAR callarglist SRPAR
95		{ if(nstars < MAXLABLIST)
96			excall($1, mklist($3), nstars, labarray);
97		  else
98			err("too many alternate returns");
99		}
100	| SRETURN end_spec opt_expr
101		{ exreturn($3);  thiswasbranch = YES; }
102	| stop end_spec opt_expr
103		{ exstop($1, $3);  thiswasbranch = $1; }
104	;
105
106assignlabel:   SICON
107		{ $$ = mklabel( convci(toklen, token) ); }
108	;
109
110let:	  SLET
111		{ if(parstate == OUTSIDE)
112			{
113			newproc();
114			startproc(PNULL, CLMAIN);
115			}
116		  if( yystno != 0 && thislabel->labtype != LABFORMAT)
117			if (optimflag)
118				optbuff (SKLABEL, 0, thislabel->labelno, 1);
119			else
120				putlabel(thislabel->labelno);
121		}
122	;
123
124goto:	  SGOTO end_spec label
125		{ exgoto($3);  thiswasbranch = YES; }
126	| SASGOTO end_spec name
127		{ if( $3->vclass != CLPARAM ) {
128			exasgoto($3);  thiswasbranch = YES;
129		  } else {
130			err("must go to label or assigned variable");
131		  }
132		}
133	| SASGOTO end_spec name opt_comma SLPAR labellist SRPAR
134		{ if( $3->vclass != CLPARAM ) {
135			exasgoto($3);  thiswasbranch = YES;
136		  } else {
137			err("must go to label or assigned variable");
138		  }
139		}
140	| SCOMPGOTO end_spec SLPAR labellist SRPAR opt_comma expr
141		{ if(nstars < MAXLABLIST)
142			if (optimflag)
143			    optbuff (SKCMGOTO, fixtype($7), nstars, labarray);
144			else
145			    putcmgo (fixtype($7), nstars, labarray);
146		  else
147			err("computed GOTO list too long");
148		}
149	;
150
151opt_comma:
152	| SCOMMA
153	;
154
155call:	  SCALL end_spec name
156		{ nstars = 0; $$ = $3; }
157	;
158
159callarglist:  callarg
160		{ $$ = ($1 ? mkchain($1,CHNULL) : CHNULL); }
161	| callarglist SCOMMA callarg
162		{ if($3)
163			if($1) $$ = hookup($1, mkchain($3,CHNULL));
164			else $$ = mkchain($3,CHNULL);
165		  else
166			$$ = $1;
167		}
168	;
169
170callarg:  expr
171	| SSTAR label
172		{ if(nstars<MAXLABLIST) labarray[nstars++] = $2; $$ = 0; }
173	;
174
175stop:	  SPAUSE
176		{ $$ = 0; }
177	| SSTOP
178		{ $$ = 1; }
179	;
180
181exprlist:  expr
182		{ $$ = mkchain($1, CHNULL); }
183	| exprlist SCOMMA expr
184		{ $$ = hookup($1, mkchain($3,CHNULL) ); }
185	;
186
187end_spec:
188		{ if(parstate == OUTSIDE)
189			{
190			newproc();
191			startproc(PNULL, CLMAIN);
192			}
193		  if(parstate < INDATA) enddcl();
194		  parstate = INEXEC;
195		  if( yystno != 0 && thislabel->labtype != LABFORMAT)
196			if (optimflag)
197				optbuff (SKLABEL, 0, thislabel->labelno, 1);
198			else
199				putlabel(thislabel->labelno);
200		  yystno = 0;
201		}
202	;
203
204intonlyon:
205		{ intonly = YES; }
206	;
207
208intonlyoff:
209		{ intonly = NO; }
210	;
211