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