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