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