1 /*- 2 * Copyright (c) 1980, 1993 3 * The Regents of the University of California. All rights reserved. 4 * 5 * %sccs.include.redist.c% 6 */ 7 8 #ifndef lint 9 static char sccsid[] = "@(#)forop.c 8.1 (Berkeley) 06/06/93"; 10 #endif /* not lint */ 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" 19 # include <pcc.h> 20 #endif PC 21 #include "tmps.h" 22 #include "tree_ty.h" 23 24 /* 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 * 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 */ 76 forop( tree_node) 77 struct tnode *tree_node; 78 { 79 struct tnode *lhs; 80 VAR_NODE *lhs_node; 81 FOR_NODE *f_node; 82 struct nl *forvar; 83 struct nl *fortype; 84 #ifdef PC 85 int forp2type; 86 #endif PC 87 int forwidth; 88 struct tnode *init_node; 89 struct nl *inittype; 90 struct nl *initnlp; /* initial value namelist entry */ 91 struct tnode *term_node; 92 struct nl *termtype; 93 struct nl *termnlp; /* termination value namelist entry */ 94 struct nl *shadownlp; /* namelist entry for the shadow */ 95 struct tnode *stat_node; 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 */ 99 struct nl saved_nl; /* saved namelist entry for loop var */ 100 101 goc = gocnt; 102 forvar = NLNIL; 103 if ( tree_node == TR_NIL ) { 104 goto byebye; 105 } 106 f_node = &(tree_node->for_node); 107 if ( f_node->init_asg == TR_NIL ) { 108 goto byebye; 109 } 110 line = f_node->line_no; 111 putline(); 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) { 117 nogood: 118 if (forvar != NIL) { 119 forvar->value[ NL_FORV ] = FORVAR; 120 } 121 (void) rvalue( init_node , NLNIL , RREQ ); 122 (void) rvalue( term_node , NLNIL , RREQ ); 123 statement( stat_node ); 124 goto byebye; 125 } 126 else lhs_node = &(lhs->var_node); 127 /* 128 * and this marks the variable as used!!! 129 */ 130 forvar = lookup( lhs_node->cptr ); 131 if ( forvar == NIL ) { 132 goto nogood; 133 } 134 saved_nl = *forvar; 135 if ( lhs_node->qual != TR_NIL ) { 136 error("For variable %s must be unqualified", forvar->symbol); 137 goto nogood; 138 } 139 if (forvar->class == WITHPTR) { 140 error("For variable %s cannot be an element of a record", 141 lhs_node->cptr); 142 goto nogood; 143 } 144 if ( opt('s') && 145 ( ( bn != cbn ) || 146 #ifdef OBJ 147 (whereis(forvar->value[NL_OFFS], 0) == PARAMVAR) 148 #endif OBJ 149 #ifdef PC 150 (whereis(forvar->value[NL_OFFS], forvar->extra_flags) 151 == PARAMVAR ) 152 #endif PC 153 ) ) { 154 standard(); 155 error("For variable %s must be declared in the block in which it is used", forvar->symbol); 156 } 157 /* 158 * find out the type of the loop variable 159 */ 160 codeoff(); 161 fortype = lvalue( lhs , MOD , RREQ ); 162 codeon(); 163 if ( fortype == NLNIL ) { 164 goto nogood; 165 } 166 if ( isnta( fortype , "bcis" ) ) { 167 error("For variable %s cannot be %ss", forvar->symbol, nameof( fortype ) ); 168 goto nogood; 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); 172 forvar = NLNIL; 173 goto nogood; 174 } 175 forwidth = lwidth(fortype); 176 # ifdef PC 177 forp2type = p2type(fortype); 178 # endif PC 179 /* 180 * allocate temporaries for the initial and final expressions 181 * and maybe a register to shadow the for variable. 182 */ 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); 186 # ifdef PC 187 /* 188 * compute and save the initial expression 189 */ 190 putRV((char *) 0 , cbn , initnlp -> value[ NL_OFFS ] , 191 initnlp -> extra_flags , PCCT_INT ); 192 # endif PC 193 # ifdef OBJ 194 (void) put(2, O_LV | cbn<<8+INDX, initnlp -> value[ NL_OFFS ] ); 195 # endif OBJ 196 inittype = rvalue( init_node , fortype , RREQ ); 197 if ( incompat( inittype , fortype , init_node ) ) { 198 cerror("Type of initial expression clashed with index type in 'for' statement"); 199 if (forvar != NLNIL) { 200 forvar->value[ NL_FORV ] = FORVAR; 201 } 202 (void) rvalue( term_node , NLNIL , RREQ ); 203 statement( stat_node ); 204 goto byebye; 205 } 206 # ifdef PC 207 sconv(p2type(inittype), PCCT_INT); 208 putop( PCC_ASSIGN , PCCT_INT ); 209 putdot( filename , line ); 210 /* 211 * compute and save the termination expression 212 */ 213 putRV((char *) 0 , cbn , termnlp -> value[ NL_OFFS ] , 214 termnlp -> extra_flags , PCCT_INT ); 215 # endif PC 216 # ifdef OBJ 217 (void) gen(O_AS2, O_AS2, sizeof(long), width(inittype)); 218 /* 219 * compute and save the termination expression 220 */ 221 (void) put(2, O_LV | cbn<<8+INDX, termnlp -> value[ NL_OFFS ] ); 222 # endif OBJ 223 termtype = rvalue( term_node , fortype , RREQ ); 224 if ( incompat( termtype , fortype , term_node ) ) { 225 cerror("Type of limit expression clashed with index type in 'for' statement"); 226 if (forvar != NLNIL) { 227 forvar->value[ NL_FORV ] = FORVAR; 228 } 229 statement( stat_node ); 230 goto byebye; 231 } 232 # ifdef PC 233 sconv(p2type(termtype), PCCT_INT); 234 putop( PCC_ASSIGN , PCCT_INT ); 235 putdot( filename , line ); 236 /* 237 * we can skip the loop altogether if !( init <= term ) 238 */ 239 after = (int) getlab(); 240 putRV((char *) 0 , cbn , initnlp -> value[ NL_OFFS ] , 241 initnlp -> extra_flags , PCCT_INT ); 242 putRV((char *) 0 , cbn , termnlp -> value[ NL_OFFS ] , 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 ); 247 putdot( filename , line ); 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"); 256 putRV((char *) 0, cbn, termnlp -> value[NL_OFFS], 257 termnlp -> extra_flags, PCCT_INT); 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 */ 265 putRV((char *) 0, cbn, shadownlp -> value[NL_OFFS], 266 shadownlp -> extra_flags, forp2type); 267 if (opt('t')) { 268 precheck(fortype, "_RANG4", "_RSNG4"); 269 putRV((char *) 0, cbn, initnlp -> value[NL_OFFS], 270 initnlp -> extra_flags, PCCT_INT); 271 postcheck(fortype, nl+T4INT); 272 } else { 273 putRV((char *) 0, cbn, initnlp -> value[NL_OFFS], 274 initnlp -> extra_flags, PCCT_INT); 275 } 276 sconv(PCCT_INT, forp2type); 277 putop(PCC_ASSIGN, forp2type); 278 putdot(filename, line); 279 /* 280 * put down the label at the top of the loop 281 */ 282 again = (int) getlab(); 283 (void) putlab((char *) again ); 284 /* 285 * each time through the loop 286 * assign the shadow to the for variable. 287 */ 288 (void) lvalue(lhs, NOUSE, RREQ); 289 putRV((char *) 0, cbn, shadownlp -> value[NL_OFFS], 290 shadownlp -> extra_flags, forp2type); 291 putop(PCC_ASSIGN, forp2type); 292 putdot(filename, line); 293 # endif PC 294 # ifdef OBJ 295 (void) gen(O_AS2, O_AS2, sizeof(long), width(termtype)); 296 /* 297 * we can skip the loop altogether if !( init <= term ) 298 */ 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), 302 sizeof(long)); 303 after = (int) getlab(); 304 (void) put(2, O_IF, after); 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')) { 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 ] ); 314 rangechk(fortype, nl+T4INT); 315 (void) gen(O_AS2, O_AS2, forwidth, sizeof(long)); 316 } 317 /* 318 * assign the initial expression to the shadow 319 * checking the assignment if necessary. 320 */ 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 ] ); 323 rangechk(fortype, nl+T4INT); 324 (void) gen(O_AS2, O_AS2, forwidth, sizeof(long)); 325 /* 326 * put down the label at the top of the loop 327 */ 328 again = (int) getlab(); 329 (void) putlab( (char *) again ); 330 /* 331 * each time through the loop 332 * assign the shadow to the for variable. 333 */ 334 (void) lvalue(lhs, NOUSE, RREQ); 335 (void) stackRV(shadownlp); 336 (void) gen(O_AS2, O_AS2, forwidth, sizeof(long)); 337 # endif OBJ 338 /* 339 * shadowing the real for variable 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. 344 */ 345 shadownlp -> nl_flags |= NLFLAGS(forvar -> nl_flags); 346 *forvar = *shadownlp; 347 forvar -> symbol = saved_nl.symbol; 348 forvar -> nl_next = saved_nl.nl_next; 349 forvar -> type = saved_nl.type; 350 forvar -> value[ NL_FORV ] = FORVAR; 351 /* 352 * and don't forget ... 353 */ 354 putcnt(); 355 statement( stat_node ); 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 */ 361 line = f_node->line_no; 362 # ifdef PC 363 if ( opt( 'p' ) ) { 364 if ( opt('t') ) { 365 putleaf( PCC_ICON , 0 , 0 , PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR ) 366 , "_LINO" ); 367 putop( PCCOM_UNARY PCC_CALL , PCCT_INT ); 368 putdot( filename , line ); 369 } else { 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 ); 373 putdot( filename , line ); 374 } 375 } 376 /*rvalue( lhs_node , NIL , RREQ );*/ 377 putRV( (char *) 0 , cbn , shadownlp -> value[ NL_OFFS ] , 378 shadownlp -> extra_flags , forp2type ); 379 sconv(forp2type, PCCT_INT); 380 putRV( (char *) 0 , cbn , termnlp -> value[ NL_OFFS ] , 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 ); 385 putdot( filename , line ); 386 /* 387 * okay, so we have to do it again, 388 * but first, increment the for variable. 389 * no need to rangecheck it, since we checked the 390 * termination value before we started. 391 */ 392 /*lvalue( lhs , MOD , RREQ );*/ 393 putRV( (char *) 0 , cbn , shadownlp -> value[ NL_OFFS ] , 394 shadownlp -> extra_flags , forp2type ); 395 /*rvalue( lhs_node , NIL , RREQ );*/ 396 putRV( (char *) 0 , cbn , shadownlp -> value[ NL_OFFS ] , 397 shadownlp -> extra_flags , forp2type ); 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 ); 403 putdot( filename , line ); 404 /* 405 * and do it all again 406 */ 407 putjbr( (long) again ); 408 /* 409 * and here we are 410 */ 411 (void) putlab( (char *) after ); 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 418 * it has been reached, else updating the index variable, 419 * and returning to the top of the loop. 420 */ 421 putline(); 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), 425 again); 426 /* 427 * and here we are 428 */ 429 patch( (PTR_DCL) after ); 430 # endif OBJ 431 byebye: 432 noreach = FALSE; 433 if (forvar != NLNIL) { 434 saved_nl.nl_flags |= NLFLAGS(forvar -> nl_flags) & (NUSED|NMOD); 435 *forvar = saved_nl; 436 } 437 if ( goc != gocnt ) { 438 putcnt(); 439 } 440 } 441