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