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:     }

Defined functions

forop defined in line 76; used 1 times

Defined variables

sccsid defined in line 8; never used
Last modified: 1985-06-05
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 1621
Valid CSS Valid XHTML 1.0 Strict