xref: /csrg-svn/usr.bin/pascal/src/forop.c (revision 3278)
1 /* Copyright (c) 1979 Regents of the University of California */
2 
3 static char sccsid[] = "@(#)forop.c 1.5 03/16/81";
4 
5 #include	"whoami.h"
6 #include	"0.h"
7 #include	"opcode.h"
8 #include	"tree.h"
9 #include	"objfmt.h"
10 #ifdef PC
11 #    include	"pc.h"
12 #    include	"pcops.h"
13 #endif PC
14     /*
15      *	forop for pc:
16      *	    this evaluates the initial and termination expressions,
17      *	    checks them to see if the loop executes at all, and then
18      *	    does the assignment and the loop.
19      *	arg here looks like:
20      *	arg[0]	T_FORU or T_FORD
21      *	   [1]	lineof "for"
22      *	   [2]	[0]	T_ASGN
23      *		[1]	lineof ":="
24      *		[2]	[0]	T_VAR
25      *			[1]	lineof id
26      *			[2]	char * to id
27      *			[3]	qualifications
28      *		[3]	initial expression
29      *	  [3]	termination expression
30      *	  [4]	statement
31      */
32 forop( arg )
33     int	*arg;
34     {
35 	int		*lhs;
36 	struct nl	*forvar;
37 	struct nl	*fortype;
38 	int		forctype;
39 	int		*init;
40 	struct nl	*inittype;
41 	int		initoff;
42 	int		*term;
43 	struct nl	*termtype;
44 	int		termoff;
45 	int		*stat;
46 	int		goc;		/* saved gocnt */
47 	int		again;		/* label at the top of the loop */
48 	int		after;		/* label after the end of the loop */
49 
50 	goc = gocnt;
51 	forvar = NIL;
52 	if ( arg == NIL ) {
53 	    goto byebye;
54 	}
55 	if ( arg[2] == NIL ) {
56 	    goto byebye;
57 	}
58 	line = arg[1];
59 	putline();
60 	lhs = ( (int *) arg[2] )[2];
61 	init = ( (int *) arg[2] )[3];
62 	term = arg[3];
63 	stat = arg[4];
64 	if (lhs == NIL) {
65 nogood:
66 	    rvalue( init , NIL , RREQ );
67 	    rvalue( term , NIL , RREQ );
68 	    statement( stat );
69 	    goto byebye;
70 	}
71 	    /*
72 	     * and this marks the variable as used!!!
73 	     */
74 	forvar = lookup( lhs[2] );
75 	if ( forvar == NIL ) {
76 	    goto nogood;
77 	}
78 	if ( lhs[3] != NIL ) {
79 	    error("For variable %s must be unqualified", forvar->symbol);
80 	    goto nogood;
81 	}
82 	if (forvar->class == WITHPTR) {
83 	    error("For variable %s cannot be an element of a record", lhs[2]);
84 	    goto nogood;
85 	}
86 	if (opt('s') &&
87 	    (bn != cbn || whereis(forvar->value[NL_OFFS]) == PARAMVAR)) {
88 	    standard();
89 	    error("For variable %s must be declared in the block in which it is used", forvar->symbol);
90 	}
91 	    /*
92 	     * find out the type of the loop variable
93 	     */
94 	codeoff();
95 	fortype = lvalue( lhs , MOD , RREQ );
96 	codeon();
97 	    /*
98 	     * mark the forvar so we can't change it during the loop
99 	     */
100 	if (forvar->value[NL_FORV]) {
101 	    error("Can't modify the for variable %s in the range of the loop", forvar->symbol);
102 	    forvar = NIL;
103 	    goto nogood;
104 	}
105 	forvar -> value[ NL_FORV ] = 1;
106 	if ( fortype == NIL ) {
107 	    goto nogood;
108 	}
109 	if ( isnta( fortype , "bcis" ) ) {
110 	    error("For variable %s cannot be %ss", forvar->symbol, nameof( fortype ) );
111 	    goto nogood;
112 	}
113 	    /*
114 	     * allocate space for the initial and termination expressions
115 	     */
116 	initoff = tmpalloc(sizeof(long), nl+T4INT, REGOK);
117 	forvar -> value[ NL_SOFFS ] = forvar -> value[ NL_OFFS ];
118 	forvar -> value[ NL_OFFS ] = initoff;
119 	forvar -> value[ NL_FORV ] = 3;
120 	termoff = tmpalloc(sizeof(long), nl+T4INT, REGOK);
121 #	ifdef PC
122 		/*
123 		 * compute and save the initial expression
124 		 */
125 	    forctype = p2type( fortype );
126 	    putRV( 0 , cbn , initoff , forctype );
127 #	endif PC
128 #	ifdef OBJ
129 	    put(2, O_LV | cbn<<8+INDX, initoff);
130 #	endif OBJ
131 	inittype = rvalue( init , fortype , RREQ );
132 	if ( incompat( inittype , fortype , init ) ) {
133 	    cerror("Type of initial expression clashed with index type in 'for' statement");
134 	    rvalue( term , NIL , RREQ );
135 	    statement( stat );
136 	    goto byebye;
137 	}
138 #	ifdef PC
139 	    putop( P2ASSIGN , forctype );
140 	    putdot( filename , line );
141 		/*
142 		 * compute and save the termination expression
143 		 */
144 	    putRV( 0 , cbn , termoff , forctype );
145 #	endif PC
146 #	ifdef OBJ
147 	    gen(O_AS2, O_AS2, sizeof(long), width(inittype));
148 		/*
149 		 * compute and save the termination expression
150 		 */
151 	    put(2, O_LV | cbn<<8+INDX, termoff);
152 #	endif OBJ
153 	termtype = rvalue( term , fortype , RREQ );
154 	if ( incompat( termtype , fortype , term ) ) {
155 	    cerror("Type of limit expression clashed with index type in 'for' statement");
156 	    statement( stat );
157 	    goto byebye;
158 	}
159 #	ifdef PC
160 	    putop( P2ASSIGN , forctype );
161 	    putdot( filename , line );
162 		/*
163 		 * we can skip the loop altogether if !( init <= term )
164 		 */
165 	    after = getlab();
166 	    putRV( 0 , cbn , initoff , forctype );
167 	    putRV( 0 , cbn , termoff , forctype );
168 	    putop( ( arg[0] == T_FORU ? P2LE : P2GE ) , forctype );
169 	    putleaf( P2ICON , after , 0 , P2INT , 0 );
170 	    putop( P2CBRANCH , P2INT );
171 	    putdot( filename , line );
172 		/*
173 		 * put down the label at the top of the loop
174 		 */
175 	    again = getlab();
176 	    putlab( again );
177 		/*
178 		 * okay, then we have to execute the body, but first,
179 		 * assign the initial expression to the for variable.
180 		 * see the note in asgnop1 about why this is an rvalue.
181 		 */
182 	    forvar -> value[ NL_OFFS ] = forvar -> value[ NL_SOFFS ];
183 	    rvalue( lhs , NIL , RREQ );
184 	    forvar -> value[ NL_OFFS ] = initoff;
185 	    if ( opt( 't' ) ) {
186 		precheck( fortype , "_RANG4" , "_RSNG4" );
187 	    }
188 	    putRV( 0 , cbn , initoff , forctype );
189 	    if ( opt( 't' ) ) {
190 		postcheck( fortype );
191 	    }
192 	    putop( P2ASSIGN , forctype );
193 	    putdot( filename , line );
194 #	endif PC
195 #	ifdef OBJ
196 	    gen(O_AS2, O_AS2, sizeof(long), width(termtype));
197 		/*
198 		 * we can skip the loop altogether if !( init <= term )
199 		 */
200 	    put(2, O_RV4 | cbn<<8+INDX, initoff);
201 	    put(2, O_RV4 | cbn<<8+INDX, termoff);
202 	    gen(NIL, arg[0] == T_FORU ? T_LE : T_GE, sizeof(long),
203 			sizeof(long));
204 	    after = getlab();
205 	    put(2, O_IF, after);
206 		/*
207 		 * put down the label at the top of the loop
208 		 */
209 	    again = getlab();
210 	    putlab( again );
211 		/*
212 		 * okay, then we have to execute the body, but first,
213 		 * assign the initial expression to the for variable.
214 		 */
215 	    forvar -> value[ NL_OFFS ] = forvar -> value[ NL_SOFFS ];
216 	    lvalue( lhs , NOUSE , LREQ );
217 	    put(2, O_RV4 | cbn<<8+INDX, initoff);
218 	    rangechk(fortype, nl+T4INT);
219 	    gen(O_AS2, O_AS2, width(fortype), sizeof(long));
220 	    forvar -> value[ NL_OFFS ] = initoff;
221 #	endif OBJ
222 	    /*
223 	     * and don't forget ...
224 	     */
225 	putcnt();
226 	statement( stat );
227 	    /*
228 	     * wasn't that fun?  do we get to do it again?
229 	     *	we don't do it again if ( !( forvar < limit ) )
230 	     *	pretend we were doing this at the top of the loop
231 	     */
232 	line = arg[ 1 ];
233 #	ifdef PC
234 	    if ( opt( 'p' ) ) {
235 		if ( opt('t') ) {
236 		    putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
237 			    , "_LINO" );
238 		    putop( P2UNARY P2CALL , P2INT );
239 		    putdot( filename , line );
240 		} else {
241 		    putRV( STMTCOUNT , 0 , 0 , P2INT );
242 		    putleaf( P2ICON , 1 , 0 , P2INT , 0 );
243 		    putop( P2ASG P2PLUS , P2INT );
244 		    putdot( filename , line );
245 		}
246 	    }
247 	    rvalue( lhs , NIL , RREQ );
248 	    putRV( 0 , cbn , termoff , forctype );
249 	    putop( ( arg[ 0 ] == T_FORU ? P2LT : P2GT ) , forctype );
250 	    putleaf( P2ICON , after , 0 , P2INT , 0 );
251 	    putop( P2CBRANCH , P2INT );
252 	    putdot( filename , line );
253 		/*
254 		 * okay, so we have to do it again,
255 		 * but first, increment the for variable.
256 		 * there it is again, an rvalue on the lhs of an assignment.
257 		 */
258 	    rvalue( lhs , NIL , RREQ );
259 	    if ( opt( 't' ) ) {
260 		precheck( fortype , "_RANG4" , "_RSNG4" );
261 	    }
262 	    rvalue( lhs , NIL , RREQ );
263 	    putleaf( P2ICON , 1 , 0 , forctype , 0 );
264 	    putop( ( arg[0] == T_FORU ? P2PLUS : P2MINUS ) , forctype );
265 	    if ( opt( 't' ) ) {
266 		postcheck( fortype );
267 	    }
268 	    putop( P2ASSIGN , forctype );
269 	    putdot( filename , line );
270 		/*
271 		 * and do it all again
272 		 */
273 	    putjbr( again );
274 		/*
275 		 * and here we are
276 		 */
277 	    putlab( after );
278 #	endif PC
279 #	ifdef OBJ
280 		/*
281 		 * okay, so we have to do it again.
282 		 * Luckily we have a magic opcode which increments the
283 		 * index variable, checks the limit falling through if
284 		 * it has been reached, else range checking the result
285 		 * updating the index variable, and returning to the top
286 		 * of the loop.
287 		 */
288 	    putline();
289 	    put(2, O_RV4 | cbn<<8+INDX, termoff);
290 	    lvalue(lhs, MOD, LREQ);
291 	    if (width(fortype) <= 2)
292 		    put(4, (arg[0] == T_FORU ? O_FOR1U : O_FOR1D) +
293 			    (width(fortype)>>1), (int)fortype->range[0],
294 			    (int)fortype->range[1], again);
295 	    else
296 		    put(4, (arg[0] == T_FORU ? O_FOR4U : O_FOR4D),
297 			    fortype->range[0], fortype->range[1], again);
298 		/*
299 		 * and here we are
300 		 */
301 	    patch( after );
302 #	endif OBJ
303 byebye:
304 	noreach = 0;
305 	if ( forvar != NIL ) {
306 	    if (forvar -> value[ NL_FORV ] > 1)
307 		forvar -> value[ NL_OFFS ] = forvar -> value[ NL_SOFFS ];
308 	    forvar -> value[ NL_FORV ] = 0;
309 	}
310 	if ( goc != gocnt ) {
311 	    putcnt();
312 	}
313     }
314