114732Sthien 22187Smckusick /* Copyright (c) 1979 Regents of the University of California */ 32187Smckusick 414732Sthien #ifndef lint 5*18459Sralph static char sccsid[] = "@(#)forop.c 2.2 (Berkeley) 85/03/20"; 614732Sthien #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" 15*18459Sralph # include <pcc.h> 162187Smckusick #endif PC 1711335Speter #include "tmps.h" 1814732Sthien #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 */ 7214732Sthien forop( tree_node) 7314732Sthien struct tnode *tree_node; 742187Smckusick { 7514732Sthien struct tnode *lhs; 7614732Sthien VAR_NODE *lhs_node; 7714732Sthien FOR_NODE *f_node; 782187Smckusick struct nl *forvar; 792187Smckusick struct nl *fortype; 8010666Speter #ifdef PC 8110798Speter int forp2type; 8210666Speter #endif PC 8310666Speter int forwidth; 8414732Sthien struct tnode *init_node; 852187Smckusick struct nl *inittype; 863836Speter struct nl *initnlp; /* initial value namelist entry */ 8714732Sthien 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 */ 9114732Sthien 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; 9814732Sthien forvar = NLNIL; 9914732Sthien if ( tree_node == TR_NIL ) { 1002187Smckusick goto byebye; 1012187Smckusick } 10214732Sthien f_node = &(tree_node->for_node); 10314732Sthien if ( f_node->init_asg == TR_NIL ) { 1042187Smckusick goto byebye; 1052187Smckusick } 10614732Sthien line = f_node->line_no; 1072187Smckusick putline(); 10814732Sthien lhs = f_node->init_asg->asg_node.lhs_var; 10914732Sthien init_node = f_node->init_asg->asg_node.rhs_expr; 11014732Sthien term_node = f_node->term_expr; 11114732Sthien stat_node = f_node->for_stmnt; 11214732Sthien if (lhs == TR_NIL) { 1133278Smckusic nogood: 1143584Speter if (forvar != NIL) { 1153584Speter forvar->value[ NL_FORV ] = FORVAR; 1163584Speter } 11714732Sthien (void) rvalue( init_node , NLNIL , RREQ ); 11814732Sthien (void) rvalue( term_node , NLNIL , RREQ ); 11914732Sthien statement( stat_node ); 1202187Smckusick goto byebye; 1212187Smckusick } 12214732Sthien else lhs_node = &(lhs->var_node); 1232187Smckusick /* 1242187Smckusick * and this marks the variable as used!!! 1252187Smckusick */ 12614732Sthien forvar = lookup( lhs_node->cptr ); 1272187Smckusick if ( forvar == NIL ) { 1283278Smckusic goto nogood; 1292187Smckusick } 13010798Speter saved_nl = *forvar; 13114732Sthien 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) { 13614732Sthien error("For variable %s cannot be an element of a record", 13714732Sthien lhs_node->cptr); 1383278Smckusic goto nogood; 1393278Smckusic } 1403836Speter if ( opt('s') && 1413836Speter ( ( bn != cbn ) || 1423836Speter #ifdef OBJ 14314732Sthien (whereis(forvar->value[NL_OFFS], 0) == PARAMVAR) 1443836Speter #endif OBJ 1453836Speter #ifdef PC 14614732Sthien (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(); 15914732Sthien 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); 16814732Sthien 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 */ 17914732Sthien initnlp = tmpalloc((long) sizeof(long), nl+T4INT, NOREG); 18014732Sthien termnlp = tmpalloc((long) sizeof(long), nl+T4INT, NOREG); 18114732Sthien shadownlp = tmpalloc((long) forwidth, fortype, REGOK); 1822187Smckusick # ifdef PC 1832187Smckusick /* 1842187Smckusick * compute and save the initial expression 1852187Smckusick */ 18614732Sthien putRV((char *) 0 , cbn , initnlp -> value[ NL_OFFS ] , 187*18459Sralph initnlp -> extra_flags , PCCT_INT ); 1882187Smckusick # endif PC 1892187Smckusick # ifdef OBJ 19014732Sthien (void) put(2, O_LV | cbn<<8+INDX, initnlp -> value[ NL_OFFS ] ); 1912187Smckusick # endif OBJ 19214732Sthien inittype = rvalue( init_node , fortype , RREQ ); 19314732Sthien if ( incompat( inittype , fortype , init_node ) ) { 1942187Smckusick cerror("Type of initial expression clashed with index type in 'for' statement"); 19514732Sthien if (forvar != NLNIL) { 1963584Speter forvar->value[ NL_FORV ] = FORVAR; 1973584Speter } 19814732Sthien (void) rvalue( term_node , NLNIL , RREQ ); 19914732Sthien statement( stat_node ); 2002187Smckusick goto byebye; 2012187Smckusick } 2022187Smckusick # ifdef PC 203*18459Sralph sconv(p2type(inittype), PCCT_INT); 204*18459Sralph putop( PCC_ASSIGN , PCCT_INT ); 2052187Smckusick putdot( filename , line ); 2062187Smckusick /* 2072187Smckusick * compute and save the termination expression 2082187Smckusick */ 20914732Sthien putRV((char *) 0 , cbn , termnlp -> value[ NL_OFFS ] , 210*18459Sralph termnlp -> extra_flags , PCCT_INT ); 2112187Smckusick # endif PC 2122187Smckusick # ifdef OBJ 21314732Sthien (void) gen(O_AS2, O_AS2, sizeof(long), width(inittype)); 2142187Smckusick /* 2152187Smckusick * compute and save the termination expression 2162187Smckusick */ 21714732Sthien (void) put(2, O_LV | cbn<<8+INDX, termnlp -> value[ NL_OFFS ] ); 2182187Smckusick # endif OBJ 21914732Sthien termtype = rvalue( term_node , fortype , RREQ ); 22014732Sthien if ( incompat( termtype , fortype , term_node ) ) { 2212187Smckusick cerror("Type of limit expression clashed with index type in 'for' statement"); 22214732Sthien if (forvar != NLNIL) { 2233584Speter forvar->value[ NL_FORV ] = FORVAR; 2243584Speter } 22514732Sthien statement( stat_node ); 2262187Smckusick goto byebye; 2272187Smckusick } 2282187Smckusick # ifdef PC 229*18459Sralph sconv(p2type(termtype), PCCT_INT); 230*18459Sralph putop( PCC_ASSIGN , PCCT_INT ); 2312187Smckusick putdot( filename , line ); 2322187Smckusick /* 2332187Smckusick * we can skip the loop altogether if !( init <= term ) 2342187Smckusick */ 23514732Sthien after = (int) getlab(); 23614732Sthien putRV((char *) 0 , cbn , initnlp -> value[ NL_OFFS ] , 237*18459Sralph initnlp -> extra_flags , PCCT_INT ); 23814732Sthien putRV((char *) 0 , cbn , termnlp -> value[ NL_OFFS ] , 239*18459Sralph termnlp -> extra_flags , PCCT_INT ); 240*18459Sralph putop( ( tree_node->tag == T_FORU ? PCC_LE : PCC_GE ) , PCCT_INT ); 241*18459Sralph putleaf( PCC_ICON , after , 0 , PCCT_INT, (char *) 0 ); 242*18459Sralph putop( PCC_CBRANCH , PCCT_INT ); 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"); 25214732Sthien putRV((char *) 0, cbn, termnlp -> value[NL_OFFS], 253*18459Sralph termnlp -> extra_flags, PCCT_INT); 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 */ 26114732Sthien putRV((char *) 0, cbn, shadownlp -> value[NL_OFFS], 26210798Speter shadownlp -> extra_flags, forp2type); 26310798Speter if (opt('t')) { 26410798Speter precheck(fortype, "_RANG4", "_RSNG4"); 26514732Sthien putRV((char *) 0, cbn, initnlp -> value[NL_OFFS], 266*18459Sralph initnlp -> extra_flags, PCCT_INT); 26710798Speter postcheck(fortype, nl+T4INT); 26810798Speter } else { 26914732Sthien putRV((char *) 0, cbn, initnlp -> value[NL_OFFS], 270*18459Sralph initnlp -> extra_flags, PCCT_INT); 27110798Speter } 272*18459Sralph sconv(PCCT_INT, forp2type); 273*18459Sralph putop(PCC_ASSIGN, forp2type); 27410798Speter putdot(filename, line); 27510798Speter /* 2763278Smckusic * put down the label at the top of the loop 2773278Smckusic */ 27814732Sthien again = (int) getlab(); 27914732Sthien (void) putlab((char *) again ); 2803278Smckusic /* 28110798Speter * each time through the loop 28210798Speter * assign the shadow to the for variable. 2832187Smckusick */ 28414732Sthien (void) lvalue(lhs, NOUSE, RREQ); 28514732Sthien putRV((char *) 0, cbn, shadownlp -> value[NL_OFFS], 28610798Speter shadownlp -> extra_flags, forp2type); 287*18459Sralph putop(PCC_ASSIGN, forp2type); 28810798Speter putdot(filename, line); 2892187Smckusick # endif PC 2902187Smckusick # ifdef OBJ 29114732Sthien (void) gen(O_AS2, O_AS2, sizeof(long), width(termtype)); 2922187Smckusick /* 2932187Smckusick * we can skip the loop altogether if !( init <= term ) 2942187Smckusick */ 29514732Sthien (void) put(2, O_RV4 | cbn<<8+INDX, initnlp -> value[ NL_OFFS ] ); 29614732Sthien (void) put(2, O_RV4 | cbn<<8+INDX, termnlp -> value[ NL_OFFS ] ); 29714732Sthien (void) gen(NIL, tree_node->tag == T_FORU ? T_LE : T_GE, sizeof(long), 29810798Speter sizeof(long)); 29914732Sthien after = (int) getlab(); 30014732Sthien (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')) { 30814732Sthien (void) put(2, O_LV | cbn<<8+INDX, shadownlp -> value[ NL_OFFS ] ); 30914732Sthien (void) put(2, O_RV4 | cbn<<8+INDX, termnlp -> value[ NL_OFFS ] ); 31010798Speter rangechk(fortype, nl+T4INT); 31114732Sthien (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 */ 31714732Sthien (void) put(2, O_LV | cbn<<8+INDX, shadownlp -> value[ NL_OFFS ] ); 31814732Sthien (void) put(2, O_RV4 | cbn<<8+INDX, initnlp -> value[ NL_OFFS ] ); 31910798Speter rangechk(fortype, nl+T4INT); 32014732Sthien (void) gen(O_AS2, O_AS2, forwidth, sizeof(long)); 32110798Speter /* 3223278Smckusic * put down the label at the top of the loop 3233278Smckusic */ 32414732Sthien again = (int) getlab(); 32514732Sthien (void) putlab( (char *) again ); 3263278Smckusic /* 32710798Speter * each time through the loop 32810798Speter * assign the shadow to the for variable. 3292187Smckusick */ 33014732Sthien (void) lvalue(lhs, NOUSE, RREQ); 33114732Sthien (void) stackRV(shadownlp); 33214732Sthien (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(); 35114732Sthien 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 */ 35714732Sthien line = f_node->line_no; 3582187Smckusick # ifdef PC 3592187Smckusick if ( opt( 'p' ) ) { 3602187Smckusick if ( opt('t') ) { 361*18459Sralph putleaf( PCC_ICON , 0 , 0 , PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR ) 3622187Smckusick , "_LINO" ); 363*18459Sralph putop( PCCOM_UNARY PCC_CALL , PCCT_INT ); 3642187Smckusick putdot( filename , line ); 3652187Smckusick } else { 366*18459Sralph putRV( STMTCOUNT , 0 , 0 , NGLOBAL , PCCT_INT ); 367*18459Sralph putleaf( PCC_ICON , 1 , 0 , PCCT_INT , (char *) 0 ); 368*18459Sralph putop( PCCOM_ASG PCC_PLUS , PCCT_INT ); 3692187Smckusick putdot( filename , line ); 3702187Smckusick } 3712187Smckusick } 37214732Sthien /*rvalue( lhs_node , NIL , RREQ );*/ 37314732Sthien putRV( (char *) 0 , cbn , shadownlp -> value[ NL_OFFS ] , 37410798Speter shadownlp -> extra_flags , forp2type ); 375*18459Sralph sconv(forp2type, PCCT_INT); 37614732Sthien putRV( (char *) 0 , cbn , termnlp -> value[ NL_OFFS ] , 377*18459Sralph termnlp -> extra_flags , PCCT_INT ); 378*18459Sralph putop( ( tree_node->tag == T_FORU ? PCC_LT : PCC_GT ) , PCCT_INT ); 379*18459Sralph putleaf( PCC_ICON , after , 0 , PCCT_INT , (char *) 0 ); 380*18459Sralph putop( PCC_CBRANCH , PCCT_INT ); 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 );*/ 38914732Sthien putRV( (char *) 0 , cbn , shadownlp -> value[ NL_OFFS ] , 39010798Speter shadownlp -> extra_flags , forp2type ); 39114732Sthien /*rvalue( lhs_node , NIL , RREQ );*/ 39214732Sthien putRV( (char *) 0 , cbn , shadownlp -> value[ NL_OFFS ] , 39310798Speter shadownlp -> extra_flags , forp2type ); 394*18459Sralph sconv(forp2type, PCCT_INT); 395*18459Sralph putleaf( PCC_ICON , 1 , 0 , PCCT_INT , (char *) 0 ); 396*18459Sralph putop( ( tree_node->tag == T_FORU ? PCC_PLUS : PCC_MINUS ) , PCCT_INT ); 397*18459Sralph sconv(PCCT_INT, forp2type); 398*18459Sralph putop( PCC_ASSIGN , forp2type ); 3992187Smckusick putdot( filename , line ); 4002187Smckusick /* 4012187Smckusick * and do it all again 4022187Smckusick */ 40314732Sthien putjbr( (long) again ); 4042187Smckusick /* 4052187Smckusick * and here we are 4062187Smckusick */ 40714732Sthien (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(); 41814732Sthien (void) put(2, O_RV4 | cbn<<8+INDX, termnlp -> value[ NL_OFFS ] ); 41914732Sthien (void) put(2, O_LV | cbn<<8+INDX, shadownlp -> value[ NL_OFFS ] ); 42014732Sthien (void) put(2, (tree_node->tag == T_FORU ? O_FOR1U : O_FOR1D) + (forwidth >> 1), 42110798Speter again); 4222187Smckusick /* 4232187Smckusick * and here we are 4242187Smckusick */ 42514732Sthien patch( (PTR_DCL) after ); 4262187Smckusick # endif OBJ 4272187Smckusick byebye: 42814732Sthien noreach = FALSE; 42914732Sthien 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