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