Commit | Line | Data |
---|---|---|
0fc6e47b KB |
1 | /*- |
2 | * Copyright (c) 1980 The Regents of the University of California. | |
3 | * All rights reserved. | |
4 | * | |
5 | * %sccs.include.redist.c% | |
1259848a | 6 | */ |
fc927a33 | 7 | |
72fbef68 | 8 | #ifndef lint |
0fc6e47b KB |
9 | static char sccsid[] = "@(#)forop.c 5.2 (Berkeley) %G%"; |
10 | #endif /* not lint */ | |
fc927a33 KM |
11 | |
12 | #include "whoami.h" | |
13 | #include "0.h" | |
14 | #include "opcode.h" | |
15 | #include "tree.h" | |
16 | #include "objfmt.h" | |
17 | #ifdef PC | |
18 | # include "pc.h" | |
c60bfb0d | 19 | # include <pcc.h> |
fc927a33 | 20 | #endif PC |
f763caa4 | 21 | #include "tmps.h" |
72fbef68 | 22 | #include "tree_ty.h" |
6cd6118b | 23 | |
fc927a33 | 24 | /* |
64c3971c PK |
25 | * for-statements. |
26 | * | |
27 | * the relevant quote from the standard: 6.8.3.9: | |
28 | * ``The control-variable shall be an entire-variable whose identifier | |
29 | * is declared in the variable-declaration-part of the block closest- | |
30 | * containing the for-statement. The control-variable shall possess | |
31 | * an ordinal-type, and the initial-value and the final-value shall be | |
32 | * of a type compatible with this type. The statement of a for-statement | |
33 | * shall not contain an assigning-reference to the control-variable | |
34 | * of the for-statement. The value of the final-value shall be | |
35 | * assignment-compatible with the control-variable when the initial-value | |
36 | * is assigned to the control-variable. After a for-statement is | |
37 | * executed (other than being left by a goto-statement leading out of it) | |
38 | * the control-variable shall be undefined. Apart from the restrictions | |
39 | * imposed by these requirements, the for-statement | |
40 | * for v := e1 to e2 do body | |
41 | * shall be equivalent to | |
42 | * begin | |
43 | * temp1 := e1; | |
44 | * temp2 := e2; | |
45 | * if temp1 <= temp2 then begin | |
46 | * v := temp1; | |
47 | * body; | |
48 | * while v <> temp2 do begin | |
49 | * v := succ(v); | |
50 | * body; | |
51 | * end | |
52 | * end | |
53 | * end | |
54 | * where temp1 and temp2 denote auxiliary variables that the program | |
55 | * does not otherwise contain, and that possess the type possessed by | |
56 | * the variable v if that type is not a subrange-type; otherwise the | |
57 | * host type possessed by the variable v.'' | |
58 | * | |
59 | * The Berkeley Pascal systems try to do all that without duplicating | |
60 | * the body, and shadowing the control-variable in (possibly) a | |
61 | * register variable. | |
62 | * | |
fc927a33 KM |
63 | * arg here looks like: |
64 | * arg[0] T_FORU or T_FORD | |
65 | * [1] lineof "for" | |
66 | * [2] [0] T_ASGN | |
67 | * [1] lineof ":=" | |
68 | * [2] [0] T_VAR | |
69 | * [1] lineof id | |
70 | * [2] char * to id | |
71 | * [3] qualifications | |
72 | * [3] initial expression | |
73 | * [3] termination expression | |
74 | * [4] statement | |
75 | */ | |
72fbef68 RT |
76 | forop( tree_node) |
77 | struct tnode *tree_node; | |
fc927a33 | 78 | { |
72fbef68 RT |
79 | struct tnode *lhs; |
80 | VAR_NODE *lhs_node; | |
81 | FOR_NODE *f_node; | |
fc927a33 KM |
82 | struct nl *forvar; |
83 | struct nl *fortype; | |
6d680443 | 84 | #ifdef PC |
64c3971c | 85 | int forp2type; |
6d680443 PK |
86 | #endif PC |
87 | int forwidth; | |
72fbef68 | 88 | struct tnode *init_node; |
fc927a33 | 89 | struct nl *inittype; |
1f43951f | 90 | struct nl *initnlp; /* initial value namelist entry */ |
72fbef68 | 91 | struct tnode *term_node; |
fc927a33 | 92 | struct nl *termtype; |
1f43951f | 93 | struct nl *termnlp; /* termination value namelist entry */ |
64c3971c | 94 | struct nl *shadownlp; /* namelist entry for the shadow */ |
72fbef68 | 95 | struct tnode *stat_node; |
fc927a33 KM |
96 | int goc; /* saved gocnt */ |
97 | int again; /* label at the top of the loop */ | |
98 | int after; /* label after the end of the loop */ | |
64c3971c | 99 | struct nl saved_nl; /* saved namelist entry for loop var */ |
fc927a33 KM |
100 | |
101 | goc = gocnt; | |
72fbef68 RT |
102 | forvar = NLNIL; |
103 | if ( tree_node == TR_NIL ) { | |
fc927a33 KM |
104 | goto byebye; |
105 | } | |
72fbef68 RT |
106 | f_node = &(tree_node->for_node); |
107 | if ( f_node->init_asg == TR_NIL ) { | |
fc927a33 KM |
108 | goto byebye; |
109 | } | |
72fbef68 | 110 | line = f_node->line_no; |
fc927a33 | 111 | putline(); |
72fbef68 RT |
112 | lhs = f_node->init_asg->asg_node.lhs_var; |
113 | init_node = f_node->init_asg->asg_node.rhs_expr; | |
114 | term_node = f_node->term_expr; | |
115 | stat_node = f_node->for_stmnt; | |
116 | if (lhs == TR_NIL) { | |
4cadac06 | 117 | nogood: |
b401cf0d PK |
118 | if (forvar != NIL) { |
119 | forvar->value[ NL_FORV ] = FORVAR; | |
120 | } | |
72fbef68 RT |
121 | (void) rvalue( init_node , NLNIL , RREQ ); |
122 | (void) rvalue( term_node , NLNIL , RREQ ); | |
123 | statement( stat_node ); | |
fc927a33 KM |
124 | goto byebye; |
125 | } | |
72fbef68 | 126 | else lhs_node = &(lhs->var_node); |
fc927a33 KM |
127 | /* |
128 | * and this marks the variable as used!!! | |
129 | */ | |
72fbef68 | 130 | forvar = lookup( lhs_node->cptr ); |
fc927a33 | 131 | if ( forvar == NIL ) { |
4cadac06 KM |
132 | goto nogood; |
133 | } | |
64c3971c | 134 | saved_nl = *forvar; |
72fbef68 | 135 | if ( lhs_node->qual != TR_NIL ) { |
4cadac06 KM |
136 | error("For variable %s must be unqualified", forvar->symbol); |
137 | goto nogood; | |
138 | } | |
139 | if (forvar->class == WITHPTR) { | |
72fbef68 RT |
140 | error("For variable %s cannot be an element of a record", |
141 | lhs_node->cptr); | |
4cadac06 KM |
142 | goto nogood; |
143 | } | |
1f43951f PK |
144 | if ( opt('s') && |
145 | ( ( bn != cbn ) || | |
146 | #ifdef OBJ | |
72fbef68 | 147 | (whereis(forvar->value[NL_OFFS], 0) == PARAMVAR) |
1f43951f PK |
148 | #endif OBJ |
149 | #ifdef PC | |
72fbef68 | 150 | (whereis(forvar->value[NL_OFFS], forvar->extra_flags) |
1f43951f PK |
151 | == PARAMVAR ) |
152 | #endif PC | |
153 | ) ) { | |
4cadac06 KM |
154 | standard(); |
155 | error("For variable %s must be declared in the block in which it is used", forvar->symbol); | |
fc927a33 KM |
156 | } |
157 | /* | |
158 | * find out the type of the loop variable | |
159 | */ | |
160 | codeoff(); | |
161 | fortype = lvalue( lhs , MOD , RREQ ); | |
162 | codeon(); | |
72fbef68 | 163 | if ( fortype == NLNIL ) { |
4cadac06 | 164 | goto nogood; |
fc927a33 KM |
165 | } |
166 | if ( isnta( fortype , "bcis" ) ) { | |
4cadac06 KM |
167 | error("For variable %s cannot be %ss", forvar->symbol, nameof( fortype ) ); |
168 | goto nogood; | |
b401cf0d PK |
169 | } |
170 | if ( forvar->value[ NL_FORV ] & FORVAR ) { | |
171 | error("Can't modify the for variable %s in the range of the loop", forvar->symbol); | |
72fbef68 | 172 | forvar = NLNIL; |
b401cf0d | 173 | goto nogood; |
fc927a33 | 174 | } |
64c3971c PK |
175 | forwidth = lwidth(fortype); |
176 | # ifdef PC | |
177 | forp2type = p2type(fortype); | |
178 | # endif PC | |
fc927a33 | 179 | /* |
64c3971c PK |
180 | * allocate temporaries for the initial and final expressions |
181 | * and maybe a register to shadow the for variable. | |
fc927a33 | 182 | */ |
72fbef68 RT |
183 | initnlp = tmpalloc((long) sizeof(long), nl+T4INT, NOREG); |
184 | termnlp = tmpalloc((long) sizeof(long), nl+T4INT, NOREG); | |
185 | shadownlp = tmpalloc((long) forwidth, fortype, REGOK); | |
fc927a33 | 186 | # ifdef PC |
fc927a33 KM |
187 | /* |
188 | * compute and save the initial expression | |
189 | */ | |
72fbef68 | 190 | putRV((char *) 0 , cbn , initnlp -> value[ NL_OFFS ] , |
c60bfb0d | 191 | initnlp -> extra_flags , PCCT_INT ); |
fc927a33 KM |
192 | # endif PC |
193 | # ifdef OBJ | |
72fbef68 | 194 | (void) put(2, O_LV | cbn<<8+INDX, initnlp -> value[ NL_OFFS ] ); |
fc927a33 | 195 | # endif OBJ |
72fbef68 RT |
196 | inittype = rvalue( init_node , fortype , RREQ ); |
197 | if ( incompat( inittype , fortype , init_node ) ) { | |
fc927a33 | 198 | cerror("Type of initial expression clashed with index type in 'for' statement"); |
72fbef68 | 199 | if (forvar != NLNIL) { |
b401cf0d PK |
200 | forvar->value[ NL_FORV ] = FORVAR; |
201 | } | |
72fbef68 RT |
202 | (void) rvalue( term_node , NLNIL , RREQ ); |
203 | statement( stat_node ); | |
fc927a33 KM |
204 | goto byebye; |
205 | } | |
206 | # ifdef PC | |
c60bfb0d RC |
207 | sconv(p2type(inittype), PCCT_INT); |
208 | putop( PCC_ASSIGN , PCCT_INT ); | |
fc927a33 KM |
209 | putdot( filename , line ); |
210 | /* | |
211 | * compute and save the termination expression | |
212 | */ | |
72fbef68 | 213 | putRV((char *) 0 , cbn , termnlp -> value[ NL_OFFS ] , |
c60bfb0d | 214 | termnlp -> extra_flags , PCCT_INT ); |
fc927a33 KM |
215 | # endif PC |
216 | # ifdef OBJ | |
72fbef68 | 217 | (void) gen(O_AS2, O_AS2, sizeof(long), width(inittype)); |
fc927a33 KM |
218 | /* |
219 | * compute and save the termination expression | |
220 | */ | |
72fbef68 | 221 | (void) put(2, O_LV | cbn<<8+INDX, termnlp -> value[ NL_OFFS ] ); |
fc927a33 | 222 | # endif OBJ |
72fbef68 RT |
223 | termtype = rvalue( term_node , fortype , RREQ ); |
224 | if ( incompat( termtype , fortype , term_node ) ) { | |
fc927a33 | 225 | cerror("Type of limit expression clashed with index type in 'for' statement"); |
72fbef68 | 226 | if (forvar != NLNIL) { |
b401cf0d PK |
227 | forvar->value[ NL_FORV ] = FORVAR; |
228 | } | |
72fbef68 | 229 | statement( stat_node ); |
fc927a33 KM |
230 | goto byebye; |
231 | } | |
232 | # ifdef PC | |
c60bfb0d RC |
233 | sconv(p2type(termtype), PCCT_INT); |
234 | putop( PCC_ASSIGN , PCCT_INT ); | |
fc927a33 KM |
235 | putdot( filename , line ); |
236 | /* | |
237 | * we can skip the loop altogether if !( init <= term ) | |
238 | */ | |
72fbef68 RT |
239 | after = (int) getlab(); |
240 | putRV((char *) 0 , cbn , initnlp -> value[ NL_OFFS ] , | |
c60bfb0d | 241 | initnlp -> extra_flags , PCCT_INT ); |
72fbef68 | 242 | putRV((char *) 0 , cbn , termnlp -> value[ NL_OFFS ] , |
c60bfb0d RC |
243 | termnlp -> extra_flags , PCCT_INT ); |
244 | putop( ( tree_node->tag == T_FORU ? PCC_LE : PCC_GE ) , PCCT_INT ); | |
245 | putleaf( PCC_ICON , after , 0 , PCCT_INT, (char *) 0 ); | |
246 | putop( PCC_CBRANCH , PCCT_INT ); | |
fc927a33 | 247 | putdot( filename , line ); |
64c3971c PK |
248 | /* |
249 | * okay, so we have to execute the loop body, | |
250 | * but first, if checking is on, | |
251 | * check that the termination expression | |
252 | * is assignment compatible with the control-variable. | |
253 | */ | |
254 | if (opt('t')) { | |
255 | precheck(fortype, "_RANG4", "_RSNG4"); | |
72fbef68 | 256 | putRV((char *) 0, cbn, termnlp -> value[NL_OFFS], |
c60bfb0d | 257 | termnlp -> extra_flags, PCCT_INT); |
64c3971c PK |
258 | postcheck(fortype, nl+T4INT); |
259 | putdot(filename, line); | |
260 | } | |
261 | /* | |
262 | * assign the initial expression to the shadow | |
263 | * checking the assignment if necessary. | |
264 | */ | |
72fbef68 | 265 | putRV((char *) 0, cbn, shadownlp -> value[NL_OFFS], |
64c3971c PK |
266 | shadownlp -> extra_flags, forp2type); |
267 | if (opt('t')) { | |
268 | precheck(fortype, "_RANG4", "_RSNG4"); | |
72fbef68 | 269 | putRV((char *) 0, cbn, initnlp -> value[NL_OFFS], |
c60bfb0d | 270 | initnlp -> extra_flags, PCCT_INT); |
64c3971c PK |
271 | postcheck(fortype, nl+T4INT); |
272 | } else { | |
72fbef68 | 273 | putRV((char *) 0, cbn, initnlp -> value[NL_OFFS], |
c60bfb0d | 274 | initnlp -> extra_flags, PCCT_INT); |
64c3971c | 275 | } |
c60bfb0d RC |
276 | sconv(PCCT_INT, forp2type); |
277 | putop(PCC_ASSIGN, forp2type); | |
64c3971c | 278 | putdot(filename, line); |
4cadac06 KM |
279 | /* |
280 | * put down the label at the top of the loop | |
281 | */ | |
72fbef68 RT |
282 | again = (int) getlab(); |
283 | (void) putlab((char *) again ); | |
fc927a33 | 284 | /* |
64c3971c PK |
285 | * each time through the loop |
286 | * assign the shadow to the for variable. | |
fc927a33 | 287 | */ |
72fbef68 RT |
288 | (void) lvalue(lhs, NOUSE, RREQ); |
289 | putRV((char *) 0, cbn, shadownlp -> value[NL_OFFS], | |
64c3971c | 290 | shadownlp -> extra_flags, forp2type); |
c60bfb0d | 291 | putop(PCC_ASSIGN, forp2type); |
64c3971c | 292 | putdot(filename, line); |
fc927a33 KM |
293 | # endif PC |
294 | # ifdef OBJ | |
72fbef68 | 295 | (void) gen(O_AS2, O_AS2, sizeof(long), width(termtype)); |
fc927a33 KM |
296 | /* |
297 | * we can skip the loop altogether if !( init <= term ) | |
298 | */ | |
72fbef68 RT |
299 | (void) put(2, O_RV4 | cbn<<8+INDX, initnlp -> value[ NL_OFFS ] ); |
300 | (void) put(2, O_RV4 | cbn<<8+INDX, termnlp -> value[ NL_OFFS ] ); | |
301 | (void) gen(NIL, tree_node->tag == T_FORU ? T_LE : T_GE, sizeof(long), | |
64c3971c | 302 | sizeof(long)); |
72fbef68 RT |
303 | after = (int) getlab(); |
304 | (void) put(2, O_IF, after); | |
64c3971c PK |
305 | /* |
306 | * okay, so we have to execute the loop body, | |
307 | * but first, if checking is on, | |
308 | * check that the termination expression | |
309 | * is assignment compatible with the control-variable. | |
310 | */ | |
311 | if (opt('t')) { | |
72fbef68 RT |
312 | (void) put(2, O_LV | cbn<<8+INDX, shadownlp -> value[ NL_OFFS ] ); |
313 | (void) put(2, O_RV4 | cbn<<8+INDX, termnlp -> value[ NL_OFFS ] ); | |
64c3971c | 314 | rangechk(fortype, nl+T4INT); |
72fbef68 | 315 | (void) gen(O_AS2, O_AS2, forwidth, sizeof(long)); |
64c3971c PK |
316 | } |
317 | /* | |
318 | * assign the initial expression to the shadow | |
319 | * checking the assignment if necessary. | |
320 | */ | |
72fbef68 RT |
321 | (void) put(2, O_LV | cbn<<8+INDX, shadownlp -> value[ NL_OFFS ] ); |
322 | (void) put(2, O_RV4 | cbn<<8+INDX, initnlp -> value[ NL_OFFS ] ); | |
64c3971c | 323 | rangechk(fortype, nl+T4INT); |
72fbef68 | 324 | (void) gen(O_AS2, O_AS2, forwidth, sizeof(long)); |
4cadac06 KM |
325 | /* |
326 | * put down the label at the top of the loop | |
327 | */ | |
72fbef68 RT |
328 | again = (int) getlab(); |
329 | (void) putlab( (char *) again ); | |
fc927a33 | 330 | /* |
64c3971c PK |
331 | * each time through the loop |
332 | * assign the shadow to the for variable. | |
fc927a33 | 333 | */ |
72fbef68 RT |
334 | (void) lvalue(lhs, NOUSE, RREQ); |
335 | (void) stackRV(shadownlp); | |
336 | (void) gen(O_AS2, O_AS2, forwidth, sizeof(long)); | |
fc927a33 | 337 | # endif OBJ |
b401cf0d PK |
338 | /* |
339 | * shadowing the real for variable | |
64c3971c PK |
340 | * with the shadow temporary: |
341 | * save the real for variable flags (including nl_block). | |
342 | * replace them with the shadow's offset, | |
343 | * and mark the for variable as being a for variable. | |
b401cf0d | 344 | */ |
2450af84 | 345 | shadownlp -> nl_flags |= NLFLAGS(forvar -> nl_flags); |
64c3971c PK |
346 | *forvar = *shadownlp; |
347 | forvar -> symbol = saved_nl.symbol; | |
348 | forvar -> nl_next = saved_nl.nl_next; | |
349 | forvar -> type = saved_nl.type; | |
b401cf0d | 350 | forvar -> value[ NL_FORV ] = FORVAR; |
fc927a33 KM |
351 | /* |
352 | * and don't forget ... | |
353 | */ | |
4cadac06 | 354 | putcnt(); |
72fbef68 | 355 | statement( stat_node ); |
fc927a33 KM |
356 | /* |
357 | * wasn't that fun? do we get to do it again? | |
358 | * we don't do it again if ( !( forvar < limit ) ) | |
359 | * pretend we were doing this at the top of the loop | |
360 | */ | |
72fbef68 | 361 | line = f_node->line_no; |
fc927a33 KM |
362 | # ifdef PC |
363 | if ( opt( 'p' ) ) { | |
364 | if ( opt('t') ) { | |
c60bfb0d | 365 | putleaf( PCC_ICON , 0 , 0 , PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR ) |
fc927a33 | 366 | , "_LINO" ); |
c60bfb0d | 367 | putop( PCCOM_UNARY PCC_CALL , PCCT_INT ); |
fc927a33 KM |
368 | putdot( filename , line ); |
369 | } else { | |
c60bfb0d RC |
370 | putRV( STMTCOUNT , 0 , 0 , NGLOBAL , PCCT_INT ); |
371 | putleaf( PCC_ICON , 1 , 0 , PCCT_INT , (char *) 0 ); | |
372 | putop( PCCOM_ASG PCC_PLUS , PCCT_INT ); | |
fc927a33 KM |
373 | putdot( filename , line ); |
374 | } | |
375 | } | |
72fbef68 RT |
376 | /*rvalue( lhs_node , NIL , RREQ );*/ |
377 | putRV( (char *) 0 , cbn , shadownlp -> value[ NL_OFFS ] , | |
64c3971c | 378 | shadownlp -> extra_flags , forp2type ); |
c60bfb0d | 379 | sconv(forp2type, PCCT_INT); |
72fbef68 | 380 | putRV( (char *) 0 , cbn , termnlp -> value[ NL_OFFS ] , |
c60bfb0d RC |
381 | termnlp -> extra_flags , PCCT_INT ); |
382 | putop( ( tree_node->tag == T_FORU ? PCC_LT : PCC_GT ) , PCCT_INT ); | |
383 | putleaf( PCC_ICON , after , 0 , PCCT_INT , (char *) 0 ); | |
384 | putop( PCC_CBRANCH , PCCT_INT ); | |
fc927a33 KM |
385 | putdot( filename , line ); |
386 | /* | |
387 | * okay, so we have to do it again, | |
388 | * but first, increment the for variable. | |
64c3971c PK |
389 | * no need to rangecheck it, since we checked the |
390 | * termination value before we started. | |
fc927a33 | 391 | */ |
1f43951f | 392 | /*lvalue( lhs , MOD , RREQ );*/ |
72fbef68 | 393 | putRV( (char *) 0 , cbn , shadownlp -> value[ NL_OFFS ] , |
64c3971c | 394 | shadownlp -> extra_flags , forp2type ); |
72fbef68 RT |
395 | /*rvalue( lhs_node , NIL , RREQ );*/ |
396 | putRV( (char *) 0 , cbn , shadownlp -> value[ NL_OFFS ] , | |
64c3971c | 397 | shadownlp -> extra_flags , forp2type ); |
c60bfb0d RC |
398 | sconv(forp2type, PCCT_INT); |
399 | putleaf( PCC_ICON , 1 , 0 , PCCT_INT , (char *) 0 ); | |
400 | putop( ( tree_node->tag == T_FORU ? PCC_PLUS : PCC_MINUS ) , PCCT_INT ); | |
401 | sconv(PCCT_INT, forp2type); | |
402 | putop( PCC_ASSIGN , forp2type ); | |
fc927a33 KM |
403 | putdot( filename , line ); |
404 | /* | |
405 | * and do it all again | |
406 | */ | |
72fbef68 | 407 | putjbr( (long) again ); |
fc927a33 KM |
408 | /* |
409 | * and here we are | |
410 | */ | |
72fbef68 | 411 | (void) putlab( (char *) after ); |
fc927a33 KM |
412 | # endif PC |
413 | # ifdef OBJ | |
414 | /* | |
415 | * okay, so we have to do it again. | |
416 | * Luckily we have a magic opcode which increments the | |
417 | * index variable, checks the limit falling through if | |
64c3971c PK |
418 | * it has been reached, else updating the index variable, |
419 | * and returning to the top of the loop. | |
fc927a33 | 420 | */ |
e617a722 | 421 | putline(); |
72fbef68 RT |
422 | (void) put(2, O_RV4 | cbn<<8+INDX, termnlp -> value[ NL_OFFS ] ); |
423 | (void) put(2, O_LV | cbn<<8+INDX, shadownlp -> value[ NL_OFFS ] ); | |
424 | (void) put(2, (tree_node->tag == T_FORU ? O_FOR1U : O_FOR1D) + (forwidth >> 1), | |
64c3971c | 425 | again); |
fc927a33 KM |
426 | /* |
427 | * and here we are | |
428 | */ | |
72fbef68 | 429 | patch( (PTR_DCL) after ); |
fc927a33 KM |
430 | # endif OBJ |
431 | byebye: | |
72fbef68 RT |
432 | noreach = FALSE; |
433 | if (forvar != NLNIL) { | |
2450af84 | 434 | saved_nl.nl_flags |= NLFLAGS(forvar -> nl_flags) & (NUSED|NMOD); |
64c3971c | 435 | *forvar = saved_nl; |
fc927a33 KM |
436 | } |
437 | if ( goc != gocnt ) { | |
438 | putcnt(); | |
439 | } | |
440 | } |