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