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