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