# 2.11BSD#431 - /usr/src/ucb/PORT/pascal/src/forop.c

##### Functions

    forop             X

       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

- in /usr/src/ucb/PORT/pascal/src/stat.c line 109

#### 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: 1257 |