xref: /csrg-svn/usr.bin/pascal/src/forop.c (revision 3278)
12187Smckusick /* Copyright (c) 1979 Regents of the University of California */
22187Smckusick 
3*3278Smckusic static char sccsid[] = "@(#)forop.c 1.5 03/16/81";
42187Smckusick 
52187Smckusick #include	"whoami.h"
62187Smckusick #include	"0.h"
72187Smckusick #include	"opcode.h"
82187Smckusick #include	"tree.h"
92187Smckusick #include	"objfmt.h"
102187Smckusick #ifdef PC
112187Smckusick #    include	"pc.h"
122187Smckusick #    include	"pcops.h"
132187Smckusick #endif PC
142187Smckusick     /*
152187Smckusick      *	forop for pc:
162187Smckusick      *	    this evaluates the initial and termination expressions,
172187Smckusick      *	    checks them to see if the loop executes at all, and then
182187Smckusick      *	    does the assignment and the loop.
192187Smckusick      *	arg here looks like:
202187Smckusick      *	arg[0]	T_FORU or T_FORD
212187Smckusick      *	   [1]	lineof "for"
222187Smckusick      *	   [2]	[0]	T_ASGN
232187Smckusick      *		[1]	lineof ":="
242187Smckusick      *		[2]	[0]	T_VAR
252187Smckusick      *			[1]	lineof id
262187Smckusick      *			[2]	char * to id
272187Smckusick      *			[3]	qualifications
282187Smckusick      *		[3]	initial expression
292187Smckusick      *	  [3]	termination expression
302187Smckusick      *	  [4]	statement
312187Smckusick      */
322187Smckusick forop( arg )
332187Smckusick     int	*arg;
342187Smckusick     {
352187Smckusick 	int		*lhs;
362187Smckusick 	struct nl	*forvar;
372187Smckusick 	struct nl	*fortype;
382187Smckusick 	int		forctype;
392187Smckusick 	int		*init;
402187Smckusick 	struct nl	*inittype;
412187Smckusick 	int		initoff;
422187Smckusick 	int		*term;
432187Smckusick 	struct nl	*termtype;
442187Smckusick 	int		termoff;
452187Smckusick 	int		*stat;
462187Smckusick 	int		goc;		/* saved gocnt */
472187Smckusick 	int		again;		/* label at the top of the loop */
482187Smckusick 	int		after;		/* label after the end of the loop */
492187Smckusick 
502187Smckusick 	goc = gocnt;
512187Smckusick 	forvar = NIL;
522187Smckusick 	if ( arg == NIL ) {
532187Smckusick 	    goto byebye;
542187Smckusick 	}
552187Smckusick 	if ( arg[2] == NIL ) {
562187Smckusick 	    goto byebye;
572187Smckusick 	}
582187Smckusick 	line = arg[1];
592187Smckusick 	putline();
602187Smckusick 	lhs = ( (int *) arg[2] )[2];
612187Smckusick 	init = ( (int *) arg[2] )[3];
622187Smckusick 	term = arg[3];
632187Smckusick 	stat = arg[4];
64*3278Smckusic 	if (lhs == NIL) {
65*3278Smckusic nogood:
662187Smckusick 	    rvalue( init , NIL , RREQ );
672187Smckusick 	    rvalue( term , NIL , RREQ );
682187Smckusick 	    statement( stat );
692187Smckusick 	    goto byebye;
702187Smckusick 	}
712187Smckusick 	    /*
722187Smckusick 	     * and this marks the variable as used!!!
732187Smckusick 	     */
742187Smckusick 	forvar = lookup( lhs[2] );
752187Smckusick 	if ( forvar == NIL ) {
76*3278Smckusic 	    goto nogood;
772187Smckusick 	}
78*3278Smckusic 	if ( lhs[3] != NIL ) {
79*3278Smckusic 	    error("For variable %s must be unqualified", forvar->symbol);
80*3278Smckusic 	    goto nogood;
81*3278Smckusic 	}
82*3278Smckusic 	if (forvar->class == WITHPTR) {
83*3278Smckusic 	    error("For variable %s cannot be an element of a record", lhs[2]);
84*3278Smckusic 	    goto nogood;
85*3278Smckusic 	}
86*3278Smckusic 	if (opt('s') &&
87*3278Smckusic 	    (bn != cbn || whereis(forvar->value[NL_OFFS]) == PARAMVAR)) {
88*3278Smckusic 	    standard();
89*3278Smckusic 	    error("For variable %s must be declared in the block in which it is used", forvar->symbol);
90*3278Smckusic 	}
912187Smckusick 	    /*
922187Smckusick 	     * find out the type of the loop variable
932187Smckusick 	     */
942187Smckusick 	codeoff();
952187Smckusick 	fortype = lvalue( lhs , MOD , RREQ );
962187Smckusick 	codeon();
972187Smckusick 	    /*
982187Smckusick 	     * mark the forvar so we can't change it during the loop
992187Smckusick 	     */
100*3278Smckusic 	if (forvar->value[NL_FORV]) {
101*3278Smckusic 	    error("Can't modify the for variable %s in the range of the loop", forvar->symbol);
102*3278Smckusic 	    forvar = NIL;
103*3278Smckusic 	    goto nogood;
104*3278Smckusic 	}
1052187Smckusick 	forvar -> value[ NL_FORV ] = 1;
1062187Smckusick 	if ( fortype == NIL ) {
107*3278Smckusic 	    goto nogood;
1082187Smckusick 	}
1092187Smckusick 	if ( isnta( fortype , "bcis" ) ) {
110*3278Smckusic 	    error("For variable %s cannot be %ss", forvar->symbol, nameof( fortype ) );
111*3278Smckusic 	    goto nogood;
1122187Smckusick 	}
1132187Smckusick 	    /*
1142187Smckusick 	     * allocate space for the initial and termination expressions
1152187Smckusick 	     */
1163230Smckusic 	initoff = tmpalloc(sizeof(long), nl+T4INT, REGOK);
117*3278Smckusic 	forvar -> value[ NL_SOFFS ] = forvar -> value[ NL_OFFS ];
118*3278Smckusic 	forvar -> value[ NL_OFFS ] = initoff;
119*3278Smckusic 	forvar -> value[ NL_FORV ] = 3;
1203230Smckusic 	termoff = tmpalloc(sizeof(long), nl+T4INT, REGOK);
1212187Smckusick #	ifdef PC
1222187Smckusick 		/*
1232187Smckusick 		 * compute and save the initial expression
1242187Smckusick 		 */
1252187Smckusick 	    forctype = p2type( fortype );
1262187Smckusick 	    putRV( 0 , cbn , initoff , forctype );
1272187Smckusick #	endif PC
1282187Smckusick #	ifdef OBJ
1292187Smckusick 	    put(2, O_LV | cbn<<8+INDX, initoff);
1302187Smckusick #	endif OBJ
1312187Smckusick 	inittype = rvalue( init , fortype , RREQ );
1322187Smckusick 	if ( incompat( inittype , fortype , init ) ) {
1332187Smckusick 	    cerror("Type of initial expression clashed with index type in 'for' statement");
1342187Smckusick 	    rvalue( term , NIL , RREQ );
1352187Smckusick 	    statement( stat );
1362187Smckusick 	    goto byebye;
1372187Smckusick 	}
1382187Smckusick #	ifdef PC
1392187Smckusick 	    putop( P2ASSIGN , forctype );
1402187Smckusick 	    putdot( filename , line );
1412187Smckusick 		/*
1422187Smckusick 		 * compute and save the termination expression
1432187Smckusick 		 */
1442187Smckusick 	    putRV( 0 , cbn , termoff , forctype );
1452187Smckusick #	endif PC
1462187Smckusick #	ifdef OBJ
1473083Smckusic 	    gen(O_AS2, O_AS2, sizeof(long), width(inittype));
1482187Smckusick 		/*
1492187Smckusick 		 * compute and save the termination expression
1502187Smckusick 		 */
1512187Smckusick 	    put(2, O_LV | cbn<<8+INDX, termoff);
1522187Smckusick #	endif OBJ
1532187Smckusick 	termtype = rvalue( term , fortype , RREQ );
1542187Smckusick 	if ( incompat( termtype , fortype , term ) ) {
1552187Smckusick 	    cerror("Type of limit expression clashed with index type in 'for' statement");
1562187Smckusick 	    statement( stat );
1572187Smckusick 	    goto byebye;
1582187Smckusick 	}
1592187Smckusick #	ifdef PC
1602187Smckusick 	    putop( P2ASSIGN , forctype );
1612187Smckusick 	    putdot( filename , line );
1622187Smckusick 		/*
1632187Smckusick 		 * we can skip the loop altogether if !( init <= term )
1642187Smckusick 		 */
1652187Smckusick 	    after = getlab();
1662187Smckusick 	    putRV( 0 , cbn , initoff , forctype );
1672187Smckusick 	    putRV( 0 , cbn , termoff , forctype );
1682187Smckusick 	    putop( ( arg[0] == T_FORU ? P2LE : P2GE ) , forctype );
1692187Smckusick 	    putleaf( P2ICON , after , 0 , P2INT , 0 );
1702187Smckusick 	    putop( P2CBRANCH , P2INT );
1712187Smckusick 	    putdot( filename , line );
1722187Smckusick 		/*
173*3278Smckusic 		 * put down the label at the top of the loop
174*3278Smckusic 		 */
175*3278Smckusic 	    again = getlab();
176*3278Smckusic 	    putlab( again );
177*3278Smckusic 		/*
1782187Smckusick 		 * okay, then we have to execute the body, but first,
1792187Smckusick 		 * assign the initial expression to the for variable.
1802187Smckusick 		 * see the note in asgnop1 about why this is an rvalue.
1812187Smckusick 		 */
182*3278Smckusic 	    forvar -> value[ NL_OFFS ] = forvar -> value[ NL_SOFFS ];
1832187Smckusick 	    rvalue( lhs , NIL , RREQ );
184*3278Smckusic 	    forvar -> value[ NL_OFFS ] = initoff;
1852187Smckusick 	    if ( opt( 't' ) ) {
1862187Smckusick 		precheck( fortype , "_RANG4" , "_RSNG4" );
1872187Smckusick 	    }
1882187Smckusick 	    putRV( 0 , cbn , initoff , forctype );
1892187Smckusick 	    if ( opt( 't' ) ) {
1902187Smckusick 		postcheck( fortype );
1912187Smckusick 	    }
1922187Smckusick 	    putop( P2ASSIGN , forctype );
1932187Smckusick 	    putdot( filename , line );
1942187Smckusick #	endif PC
1952187Smckusick #	ifdef OBJ
1963083Smckusic 	    gen(O_AS2, O_AS2, sizeof(long), width(termtype));
1972187Smckusick 		/*
1982187Smckusick 		 * we can skip the loop altogether if !( init <= term )
1992187Smckusick 		 */
2002187Smckusick 	    put(2, O_RV4 | cbn<<8+INDX, initoff);
2012187Smckusick 	    put(2, O_RV4 | cbn<<8+INDX, termoff);
2022187Smckusick 	    gen(NIL, arg[0] == T_FORU ? T_LE : T_GE, sizeof(long),
2032187Smckusick 			sizeof(long));
2042187Smckusick 	    after = getlab();
2052187Smckusick 	    put(2, O_IF, after);
2062187Smckusick 		/*
207*3278Smckusic 		 * put down the label at the top of the loop
208*3278Smckusic 		 */
209*3278Smckusic 	    again = getlab();
210*3278Smckusic 	    putlab( again );
211*3278Smckusic 		/*
2122187Smckusick 		 * okay, then we have to execute the body, but first,
2132187Smckusick 		 * assign the initial expression to the for variable.
2142187Smckusick 		 */
215*3278Smckusic 	    forvar -> value[ NL_OFFS ] = forvar -> value[ NL_SOFFS ];
2162187Smckusick 	    lvalue( lhs , NOUSE , LREQ );
2172187Smckusick 	    put(2, O_RV4 | cbn<<8+INDX, initoff);
2182187Smckusick 	    rangechk(fortype, nl+T4INT);
2193083Smckusic 	    gen(O_AS2, O_AS2, width(fortype), sizeof(long));
220*3278Smckusic 	    forvar -> value[ NL_OFFS ] = initoff;
2212187Smckusick #	endif OBJ
2222187Smckusick 	    /*
2232187Smckusick 	     * and don't forget ...
2242187Smckusick 	     */
225*3278Smckusic 	putcnt();
226*3278Smckusic 	statement( stat );
2272187Smckusick 	    /*
2282187Smckusick 	     * wasn't that fun?  do we get to do it again?
2292187Smckusick 	     *	we don't do it again if ( !( forvar < limit ) )
2302187Smckusick 	     *	pretend we were doing this at the top of the loop
2312187Smckusick 	     */
2322187Smckusick 	line = arg[ 1 ];
2332187Smckusick #	ifdef PC
2342187Smckusick 	    if ( opt( 'p' ) ) {
2352187Smckusick 		if ( opt('t') ) {
2362187Smckusick 		    putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
2372187Smckusick 			    , "_LINO" );
2382187Smckusick 		    putop( P2UNARY P2CALL , P2INT );
2392187Smckusick 		    putdot( filename , line );
2402187Smckusick 		} else {
2412187Smckusick 		    putRV( STMTCOUNT , 0 , 0 , P2INT );
2422187Smckusick 		    putleaf( P2ICON , 1 , 0 , P2INT , 0 );
2432187Smckusick 		    putop( P2ASG P2PLUS , P2INT );
2442187Smckusick 		    putdot( filename , line );
2452187Smckusick 		}
2462187Smckusick 	    }
2472187Smckusick 	    rvalue( lhs , NIL , RREQ );
2482187Smckusick 	    putRV( 0 , cbn , termoff , forctype );
2492187Smckusick 	    putop( ( arg[ 0 ] == T_FORU ? P2LT : P2GT ) , forctype );
2502187Smckusick 	    putleaf( P2ICON , after , 0 , P2INT , 0 );
2512187Smckusick 	    putop( P2CBRANCH , P2INT );
2522187Smckusick 	    putdot( filename , line );
2532187Smckusick 		/*
2542187Smckusick 		 * okay, so we have to do it again,
2552187Smckusick 		 * but first, increment the for variable.
2562187Smckusick 		 * there it is again, an rvalue on the lhs of an assignment.
2572187Smckusick 		 */
2582187Smckusick 	    rvalue( lhs , NIL , RREQ );
2592187Smckusick 	    if ( opt( 't' ) ) {
2602187Smckusick 		precheck( fortype , "_RANG4" , "_RSNG4" );
2612187Smckusick 	    }
2622187Smckusick 	    rvalue( lhs , NIL , RREQ );
2632187Smckusick 	    putleaf( P2ICON , 1 , 0 , forctype , 0 );
2642187Smckusick 	    putop( ( arg[0] == T_FORU ? P2PLUS : P2MINUS ) , forctype );
2652187Smckusick 	    if ( opt( 't' ) ) {
2662187Smckusick 		postcheck( fortype );
2672187Smckusick 	    }
2682187Smckusick 	    putop( P2ASSIGN , forctype );
2692187Smckusick 	    putdot( filename , line );
2702187Smckusick 		/*
2712187Smckusick 		 * and do it all again
2722187Smckusick 		 */
2732187Smckusick 	    putjbr( again );
2742187Smckusick 		/*
2752187Smckusick 		 * and here we are
2762187Smckusick 		 */
2772187Smckusick 	    putlab( after );
2782187Smckusick #	endif PC
2792187Smckusick #	ifdef OBJ
2802187Smckusick 		/*
2812187Smckusick 		 * okay, so we have to do it again.
2822187Smckusick 		 * Luckily we have a magic opcode which increments the
2832187Smckusick 		 * index variable, checks the limit falling through if
2842187Smckusick 		 * it has been reached, else range checking the result
2852187Smckusick 		 * updating the index variable, and returning to the top
2862187Smckusick 		 * of the loop.
2872187Smckusick 		 */
2882649Speter 	    putline();
2892187Smckusick 	    put(2, O_RV4 | cbn<<8+INDX, termoff);
2902187Smckusick 	    lvalue(lhs, MOD, LREQ);
2913083Smckusic 	    if (width(fortype) <= 2)
2923083Smckusic 		    put(4, (arg[0] == T_FORU ? O_FOR1U : O_FOR1D) +
2933083Smckusic 			    (width(fortype)>>1), (int)fortype->range[0],
2943083Smckusic 			    (int)fortype->range[1], again);
2953083Smckusic 	    else
2963083Smckusic 		    put(4, (arg[0] == T_FORU ? O_FOR4U : O_FOR4D),
2973083Smckusic 			    fortype->range[0], fortype->range[1], again);
2982187Smckusick 		/*
2992187Smckusick 		 * and here we are
3002187Smckusick 		 */
3012187Smckusick 	    patch( after );
3022187Smckusick #	endif OBJ
3032187Smckusick byebye:
3042187Smckusick 	noreach = 0;
3052187Smckusick 	if ( forvar != NIL ) {
306*3278Smckusic 	    if (forvar -> value[ NL_FORV ] > 1)
307*3278Smckusic 		forvar -> value[ NL_OFFS ] = forvar -> value[ NL_SOFFS ];
3082187Smckusick 	    forvar -> value[ NL_FORV ] = 0;
3092187Smckusick 	}
3102187Smckusick 	if ( goc != gocnt ) {
3112187Smckusick 	    putcnt();
3122187Smckusick 	}
3132187Smckusick     }
314