1*14732Sthien 22187Smckusick /* Copyright (c) 1979 Regents of the University of California */ 32187Smckusick 4*14732Sthien #ifndef lint 5*14732Sthien static char sccsid[] = "@(#)forop.c 1.16 2/28/83"; 6*14732Sthien #endif 72187Smckusick 82187Smckusick #include "whoami.h" 92187Smckusick #include "0.h" 102187Smckusick #include "opcode.h" 112187Smckusick #include "tree.h" 122187Smckusick #include "objfmt.h" 132187Smckusick #ifdef PC 142187Smckusick # include "pc.h" 152187Smckusick # include "pcops.h" 162187Smckusick #endif PC 1711335Speter #include "tmps.h" 18*14732Sthien #include "tree_ty.h" 193371Speter 202187Smckusick /* 2110798Speter * for-statements. 2210798Speter * 2310798Speter * the relevant quote from the standard: 6.8.3.9: 2410798Speter * ``The control-variable shall be an entire-variable whose identifier 2510798Speter * is declared in the variable-declaration-part of the block closest- 2610798Speter * containing the for-statement. The control-variable shall possess 2710798Speter * an ordinal-type, and the initial-value and the final-value shall be 2810798Speter * of a type compatible with this type. The statement of a for-statement 2910798Speter * shall not contain an assigning-reference to the control-variable 3010798Speter * of the for-statement. The value of the final-value shall be 3110798Speter * assignment-compatible with the control-variable when the initial-value 3210798Speter * is assigned to the control-variable. After a for-statement is 3310798Speter * executed (other than being left by a goto-statement leading out of it) 3410798Speter * the control-variable shall be undefined. Apart from the restrictions 3510798Speter * imposed by these requirements, the for-statement 3610798Speter * for v := e1 to e2 do body 3710798Speter * shall be equivalent to 3810798Speter * begin 3910798Speter * temp1 := e1; 4010798Speter * temp2 := e2; 4110798Speter * if temp1 <= temp2 then begin 4210798Speter * v := temp1; 4310798Speter * body; 4410798Speter * while v <> temp2 do begin 4510798Speter * v := succ(v); 4610798Speter * body; 4710798Speter * end 4810798Speter * end 4910798Speter * end 5010798Speter * where temp1 and temp2 denote auxiliary variables that the program 5110798Speter * does not otherwise contain, and that possess the type possessed by 5210798Speter * the variable v if that type is not a subrange-type; otherwise the 5310798Speter * host type possessed by the variable v.'' 5410798Speter * 5510798Speter * The Berkeley Pascal systems try to do all that without duplicating 5610798Speter * the body, and shadowing the control-variable in (possibly) a 5710798Speter * register variable. 5810798Speter * 592187Smckusick * arg here looks like: 602187Smckusick * arg[0] T_FORU or T_FORD 612187Smckusick * [1] lineof "for" 622187Smckusick * [2] [0] T_ASGN 632187Smckusick * [1] lineof ":=" 642187Smckusick * [2] [0] T_VAR 652187Smckusick * [1] lineof id 662187Smckusick * [2] char * to id 672187Smckusick * [3] qualifications 682187Smckusick * [3] initial expression 692187Smckusick * [3] termination expression 702187Smckusick * [4] statement 712187Smckusick */ 72*14732Sthien forop( tree_node) 73*14732Sthien struct tnode *tree_node; 742187Smckusick { 75*14732Sthien struct tnode *lhs; 76*14732Sthien VAR_NODE *lhs_node; 77*14732Sthien FOR_NODE *f_node; 782187Smckusick struct nl *forvar; 792187Smckusick struct nl *fortype; 8010666Speter #ifdef PC 8110798Speter int forp2type; 8210666Speter #endif PC 8310666Speter int forwidth; 84*14732Sthien struct tnode *init_node; 852187Smckusick struct nl *inittype; 863836Speter struct nl *initnlp; /* initial value namelist entry */ 87*14732Sthien struct tnode *term_node; 882187Smckusick struct nl *termtype; 893836Speter struct nl *termnlp; /* termination value namelist entry */ 9010798Speter struct nl *shadownlp; /* namelist entry for the shadow */ 91*14732Sthien struct tnode *stat_node; 922187Smckusick int goc; /* saved gocnt */ 932187Smckusick int again; /* label at the top of the loop */ 942187Smckusick int after; /* label after the end of the loop */ 9510798Speter struct nl saved_nl; /* saved namelist entry for loop var */ 962187Smckusick 972187Smckusick goc = gocnt; 98*14732Sthien forvar = NLNIL; 99*14732Sthien if ( tree_node == TR_NIL ) { 1002187Smckusick goto byebye; 1012187Smckusick } 102*14732Sthien f_node = &(tree_node->for_node); 103*14732Sthien if ( f_node->init_asg == TR_NIL ) { 1042187Smckusick goto byebye; 1052187Smckusick } 106*14732Sthien line = f_node->line_no; 1072187Smckusick putline(); 108*14732Sthien lhs = f_node->init_asg->asg_node.lhs_var; 109*14732Sthien init_node = f_node->init_asg->asg_node.rhs_expr; 110*14732Sthien term_node = f_node->term_expr; 111*14732Sthien stat_node = f_node->for_stmnt; 112*14732Sthien if (lhs == TR_NIL) { 1133278Smckusic nogood: 1143584Speter if (forvar != NIL) { 1153584Speter forvar->value[ NL_FORV ] = FORVAR; 1163584Speter } 117*14732Sthien (void) rvalue( init_node , NLNIL , RREQ ); 118*14732Sthien (void) rvalue( term_node , NLNIL , RREQ ); 119*14732Sthien statement( stat_node ); 1202187Smckusick goto byebye; 1212187Smckusick } 122*14732Sthien else lhs_node = &(lhs->var_node); 1232187Smckusick /* 1242187Smckusick * and this marks the variable as used!!! 1252187Smckusick */ 126*14732Sthien forvar = lookup( lhs_node->cptr ); 1272187Smckusick if ( forvar == NIL ) { 1283278Smckusic goto nogood; 1292187Smckusick } 13010798Speter saved_nl = *forvar; 131*14732Sthien if ( lhs_node->qual != TR_NIL ) { 1323278Smckusic error("For variable %s must be unqualified", forvar->symbol); 1333278Smckusic goto nogood; 1343278Smckusic } 1353278Smckusic if (forvar->class == WITHPTR) { 136*14732Sthien error("For variable %s cannot be an element of a record", 137*14732Sthien lhs_node->cptr); 1383278Smckusic goto nogood; 1393278Smckusic } 1403836Speter if ( opt('s') && 1413836Speter ( ( bn != cbn ) || 1423836Speter #ifdef OBJ 143*14732Sthien (whereis(forvar->value[NL_OFFS], 0) == PARAMVAR) 1443836Speter #endif OBJ 1453836Speter #ifdef PC 146*14732Sthien (whereis(forvar->value[NL_OFFS], forvar->extra_flags) 1473836Speter == PARAMVAR ) 1483836Speter #endif PC 1493836Speter ) ) { 1503278Smckusic standard(); 1513278Smckusic error("For variable %s must be declared in the block in which it is used", forvar->symbol); 1523278Smckusic } 1532187Smckusick /* 1542187Smckusick * find out the type of the loop variable 1552187Smckusick */ 1562187Smckusick codeoff(); 1572187Smckusick fortype = lvalue( lhs , MOD , RREQ ); 1582187Smckusick codeon(); 159*14732Sthien if ( fortype == NLNIL ) { 1603278Smckusic goto nogood; 1612187Smckusick } 1622187Smckusick if ( isnta( fortype , "bcis" ) ) { 1633278Smckusic error("For variable %s cannot be %ss", forvar->symbol, nameof( fortype ) ); 1643278Smckusic goto nogood; 1652187Smckusick } 1663584Speter if ( forvar->value[ NL_FORV ] & FORVAR ) { 1673584Speter error("Can't modify the for variable %s in the range of the loop", forvar->symbol); 168*14732Sthien forvar = NLNIL; 1693584Speter goto nogood; 1703584Speter } 17110798Speter forwidth = lwidth(fortype); 17210798Speter # ifdef PC 17310798Speter forp2type = p2type(fortype); 17410798Speter # endif PC 1752187Smckusick /* 17610798Speter * allocate temporaries for the initial and final expressions 17710798Speter * and maybe a register to shadow the for variable. 1782187Smckusick */ 179*14732Sthien initnlp = tmpalloc((long) sizeof(long), nl+T4INT, NOREG); 180*14732Sthien termnlp = tmpalloc((long) sizeof(long), nl+T4INT, NOREG); 181*14732Sthien shadownlp = tmpalloc((long) forwidth, fortype, REGOK); 1822187Smckusick # ifdef PC 1832187Smckusick /* 1842187Smckusick * compute and save the initial expression 1852187Smckusick */ 186*14732Sthien putRV((char *) 0 , cbn , initnlp -> value[ NL_OFFS ] , 18710798Speter initnlp -> extra_flags , P2INT ); 1882187Smckusick # endif PC 1892187Smckusick # ifdef OBJ 190*14732Sthien (void) put(2, O_LV | cbn<<8+INDX, initnlp -> value[ NL_OFFS ] ); 1912187Smckusick # endif OBJ 192*14732Sthien inittype = rvalue( init_node , fortype , RREQ ); 193*14732Sthien if ( incompat( inittype , fortype , init_node ) ) { 1942187Smckusick cerror("Type of initial expression clashed with index type in 'for' statement"); 195*14732Sthien if (forvar != NLNIL) { 1963584Speter forvar->value[ NL_FORV ] = FORVAR; 1973584Speter } 198*14732Sthien (void) rvalue( term_node , NLNIL , RREQ ); 199*14732Sthien statement( stat_node ); 2002187Smckusick goto byebye; 2012187Smckusick } 2022187Smckusick # ifdef PC 20310798Speter sconv(p2type(inittype), P2INT); 20410798Speter putop( P2ASSIGN , P2INT ); 2052187Smckusick putdot( filename , line ); 2062187Smckusick /* 2072187Smckusick * compute and save the termination expression 2082187Smckusick */ 209*14732Sthien putRV((char *) 0 , cbn , termnlp -> value[ NL_OFFS ] , 21010798Speter termnlp -> extra_flags , P2INT ); 2112187Smckusick # endif PC 2122187Smckusick # ifdef OBJ 213*14732Sthien (void) gen(O_AS2, O_AS2, sizeof(long), width(inittype)); 2142187Smckusick /* 2152187Smckusick * compute and save the termination expression 2162187Smckusick */ 217*14732Sthien (void) put(2, O_LV | cbn<<8+INDX, termnlp -> value[ NL_OFFS ] ); 2182187Smckusick # endif OBJ 219*14732Sthien termtype = rvalue( term_node , fortype , RREQ ); 220*14732Sthien if ( incompat( termtype , fortype , term_node ) ) { 2212187Smckusick cerror("Type of limit expression clashed with index type in 'for' statement"); 222*14732Sthien if (forvar != NLNIL) { 2233584Speter forvar->value[ NL_FORV ] = FORVAR; 2243584Speter } 225*14732Sthien statement( stat_node ); 2262187Smckusick goto byebye; 2272187Smckusick } 2282187Smckusick # ifdef PC 22910798Speter sconv(p2type(termtype), P2INT); 23010798Speter putop( P2ASSIGN , P2INT ); 2312187Smckusick putdot( filename , line ); 2322187Smckusick /* 2332187Smckusick * we can skip the loop altogether if !( init <= term ) 2342187Smckusick */ 235*14732Sthien after = (int) getlab(); 236*14732Sthien putRV((char *) 0 , cbn , initnlp -> value[ NL_OFFS ] , 23710798Speter initnlp -> extra_flags , P2INT ); 238*14732Sthien putRV((char *) 0 , cbn , termnlp -> value[ NL_OFFS ] , 23910798Speter termnlp -> extra_flags , P2INT ); 240*14732Sthien putop( ( tree_node->tag == T_FORU ? P2LE : P2GE ) , P2INT ); 241*14732Sthien putleaf( P2ICON , after , 0 , P2INT, (char *) 0 ); 2422187Smckusick putop( P2CBRANCH , P2INT ); 2432187Smckusick putdot( filename , line ); 2442187Smckusick /* 24510798Speter * okay, so we have to execute the loop body, 24610798Speter * but first, if checking is on, 24710798Speter * check that the termination expression 24810798Speter * is assignment compatible with the control-variable. 24910798Speter */ 25010798Speter if (opt('t')) { 25110798Speter precheck(fortype, "_RANG4", "_RSNG4"); 252*14732Sthien putRV((char *) 0, cbn, termnlp -> value[NL_OFFS], 25310798Speter termnlp -> extra_flags, P2INT); 25410798Speter postcheck(fortype, nl+T4INT); 25510798Speter putdot(filename, line); 25610798Speter } 25710798Speter /* 25810798Speter * assign the initial expression to the shadow 25910798Speter * checking the assignment if necessary. 26010798Speter */ 261*14732Sthien putRV((char *) 0, cbn, shadownlp -> value[NL_OFFS], 26210798Speter shadownlp -> extra_flags, forp2type); 26310798Speter if (opt('t')) { 26410798Speter precheck(fortype, "_RANG4", "_RSNG4"); 265*14732Sthien putRV((char *) 0, cbn, initnlp -> value[NL_OFFS], 26610798Speter initnlp -> extra_flags, P2INT); 26710798Speter postcheck(fortype, nl+T4INT); 26810798Speter } else { 269*14732Sthien putRV((char *) 0, cbn, initnlp -> value[NL_OFFS], 27010798Speter initnlp -> extra_flags, P2INT); 27110798Speter } 27210798Speter sconv(P2INT, forp2type); 27310798Speter putop(P2ASSIGN, forp2type); 27410798Speter putdot(filename, line); 27510798Speter /* 2763278Smckusic * put down the label at the top of the loop 2773278Smckusic */ 278*14732Sthien again = (int) getlab(); 279*14732Sthien (void) putlab((char *) again ); 2803278Smckusic /* 28110798Speter * each time through the loop 28210798Speter * assign the shadow to the for variable. 2832187Smckusick */ 284*14732Sthien (void) lvalue(lhs, NOUSE, RREQ); 285*14732Sthien putRV((char *) 0, cbn, shadownlp -> value[NL_OFFS], 28610798Speter shadownlp -> extra_flags, forp2type); 28710798Speter putop(P2ASSIGN, forp2type); 28810798Speter putdot(filename, line); 2892187Smckusick # endif PC 2902187Smckusick # ifdef OBJ 291*14732Sthien (void) gen(O_AS2, O_AS2, sizeof(long), width(termtype)); 2922187Smckusick /* 2932187Smckusick * we can skip the loop altogether if !( init <= term ) 2942187Smckusick */ 295*14732Sthien (void) put(2, O_RV4 | cbn<<8+INDX, initnlp -> value[ NL_OFFS ] ); 296*14732Sthien (void) put(2, O_RV4 | cbn<<8+INDX, termnlp -> value[ NL_OFFS ] ); 297*14732Sthien (void) gen(NIL, tree_node->tag == T_FORU ? T_LE : T_GE, sizeof(long), 29810798Speter sizeof(long)); 299*14732Sthien after = (int) getlab(); 300*14732Sthien (void) put(2, O_IF, after); 3012187Smckusick /* 30210798Speter * okay, so we have to execute the loop body, 30310798Speter * but first, if checking is on, 30410798Speter * check that the termination expression 30510798Speter * is assignment compatible with the control-variable. 30610798Speter */ 30710798Speter if (opt('t')) { 308*14732Sthien (void) put(2, O_LV | cbn<<8+INDX, shadownlp -> value[ NL_OFFS ] ); 309*14732Sthien (void) put(2, O_RV4 | cbn<<8+INDX, termnlp -> value[ NL_OFFS ] ); 31010798Speter rangechk(fortype, nl+T4INT); 311*14732Sthien (void) gen(O_AS2, O_AS2, forwidth, sizeof(long)); 31210798Speter } 31310798Speter /* 31410798Speter * assign the initial expression to the shadow 31510798Speter * checking the assignment if necessary. 31610798Speter */ 317*14732Sthien (void) put(2, O_LV | cbn<<8+INDX, shadownlp -> value[ NL_OFFS ] ); 318*14732Sthien (void) put(2, O_RV4 | cbn<<8+INDX, initnlp -> value[ NL_OFFS ] ); 31910798Speter rangechk(fortype, nl+T4INT); 320*14732Sthien (void) gen(O_AS2, O_AS2, forwidth, sizeof(long)); 32110798Speter /* 3223278Smckusic * put down the label at the top of the loop 3233278Smckusic */ 324*14732Sthien again = (int) getlab(); 325*14732Sthien (void) putlab( (char *) again ); 3263278Smckusic /* 32710798Speter * each time through the loop 32810798Speter * assign the shadow to the for variable. 3292187Smckusick */ 330*14732Sthien (void) lvalue(lhs, NOUSE, RREQ); 331*14732Sthien (void) stackRV(shadownlp); 332*14732Sthien (void) gen(O_AS2, O_AS2, forwidth, sizeof(long)); 3332187Smckusick # endif OBJ 3342187Smckusick /* 3353584Speter * shadowing the real for variable 33610798Speter * with the shadow temporary: 33710798Speter * save the real for variable flags (including nl_block). 33810798Speter * replace them with the shadow's offset, 33910798Speter * and mark the for variable as being a for variable. 3403584Speter */ 34110842Smckusick shadownlp -> nl_flags |= NLFLAGS(forvar -> nl_flags); 34210798Speter *forvar = *shadownlp; 34310798Speter forvar -> symbol = saved_nl.symbol; 34410798Speter forvar -> nl_next = saved_nl.nl_next; 34510798Speter forvar -> type = saved_nl.type; 3463584Speter forvar -> value[ NL_FORV ] = FORVAR; 3473584Speter /* 3482187Smckusick * and don't forget ... 3492187Smckusick */ 3503278Smckusic putcnt(); 351*14732Sthien statement( stat_node ); 3522187Smckusick /* 3532187Smckusick * wasn't that fun? do we get to do it again? 3542187Smckusick * we don't do it again if ( !( forvar < limit ) ) 3552187Smckusick * pretend we were doing this at the top of the loop 3562187Smckusick */ 357*14732Sthien line = f_node->line_no; 3582187Smckusick # ifdef PC 3592187Smckusick if ( opt( 'p' ) ) { 3602187Smckusick if ( opt('t') ) { 3612187Smckusick putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) 3622187Smckusick , "_LINO" ); 3632187Smckusick putop( P2UNARY P2CALL , P2INT ); 3642187Smckusick putdot( filename , line ); 3652187Smckusick } else { 3663836Speter putRV( STMTCOUNT , 0 , 0 , NGLOBAL , P2INT ); 367*14732Sthien putleaf( P2ICON , 1 , 0 , P2INT , (char *) 0 ); 3682187Smckusick putop( P2ASG P2PLUS , P2INT ); 3692187Smckusick putdot( filename , line ); 3702187Smckusick } 3712187Smckusick } 372*14732Sthien /*rvalue( lhs_node , NIL , RREQ );*/ 373*14732Sthien putRV( (char *) 0 , cbn , shadownlp -> value[ NL_OFFS ] , 37410798Speter shadownlp -> extra_flags , forp2type ); 37510798Speter sconv(forp2type, P2INT); 376*14732Sthien putRV( (char *) 0 , cbn , termnlp -> value[ NL_OFFS ] , 37710798Speter termnlp -> extra_flags , P2INT ); 378*14732Sthien putop( ( tree_node->tag == T_FORU ? P2LT : P2GT ) , P2INT ); 379*14732Sthien putleaf( P2ICON , after , 0 , P2INT , (char *) 0 ); 3802187Smckusick putop( P2CBRANCH , P2INT ); 3812187Smckusick putdot( filename , line ); 3822187Smckusick /* 3832187Smckusick * okay, so we have to do it again, 3842187Smckusick * but first, increment the for variable. 38510798Speter * no need to rangecheck it, since we checked the 38610798Speter * termination value before we started. 3872187Smckusick */ 3883836Speter /*lvalue( lhs , MOD , RREQ );*/ 389*14732Sthien putRV( (char *) 0 , cbn , shadownlp -> value[ NL_OFFS ] , 39010798Speter shadownlp -> extra_flags , forp2type ); 391*14732Sthien /*rvalue( lhs_node , NIL , RREQ );*/ 392*14732Sthien putRV( (char *) 0 , cbn , shadownlp -> value[ NL_OFFS ] , 39310798Speter shadownlp -> extra_flags , forp2type ); 39410798Speter sconv(forp2type, P2INT); 395*14732Sthien putleaf( P2ICON , 1 , 0 , P2INT , (char *) 0 ); 396*14732Sthien putop( ( tree_node->tag == T_FORU ? P2PLUS : P2MINUS ) , P2INT ); 39710798Speter sconv(P2INT, forp2type); 39810798Speter putop( P2ASSIGN , forp2type ); 3992187Smckusick putdot( filename , line ); 4002187Smckusick /* 4012187Smckusick * and do it all again 4022187Smckusick */ 403*14732Sthien putjbr( (long) again ); 4042187Smckusick /* 4052187Smckusick * and here we are 4062187Smckusick */ 407*14732Sthien (void) putlab( (char *) after ); 4082187Smckusick # endif PC 4092187Smckusick # ifdef OBJ 4102187Smckusick /* 4112187Smckusick * okay, so we have to do it again. 4122187Smckusick * Luckily we have a magic opcode which increments the 4132187Smckusick * index variable, checks the limit falling through if 41410798Speter * it has been reached, else updating the index variable, 41510798Speter * and returning to the top of the loop. 4162187Smckusick */ 4172649Speter putline(); 418*14732Sthien (void) put(2, O_RV4 | cbn<<8+INDX, termnlp -> value[ NL_OFFS ] ); 419*14732Sthien (void) put(2, O_LV | cbn<<8+INDX, shadownlp -> value[ NL_OFFS ] ); 420*14732Sthien (void) put(2, (tree_node->tag == T_FORU ? O_FOR1U : O_FOR1D) + (forwidth >> 1), 42110798Speter again); 4222187Smckusick /* 4232187Smckusick * and here we are 4242187Smckusick */ 425*14732Sthien patch( (PTR_DCL) after ); 4262187Smckusick # endif OBJ 4272187Smckusick byebye: 428*14732Sthien noreach = FALSE; 429*14732Sthien if (forvar != NLNIL) { 43010842Smckusick saved_nl.nl_flags |= NLFLAGS(forvar -> nl_flags) & (NUSED|NMOD); 43110798Speter *forvar = saved_nl; 4322187Smckusick } 4332187Smckusick if ( goc != gocnt ) { 4342187Smckusick putcnt(); 4352187Smckusick } 4362187Smckusick } 437