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