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