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