xref: /csrg-svn/usr.bin/pascal/src/forop.c (revision 2187)
1 /* Copyright (c) 1979 Regents of the University of California */
2 
3 static	char sccsid[] = "@(#)forop.c 1.1 01/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[3] != NIL ) {
65 	    error("For variable must be unqualified");
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 	    rvalue( init , NIL , RREQ );
77 	    rvalue( term , NIL , RREQ );
78 	    statement( stat );
79 	    goto byebye;
80 	}
81 	    /*
82 	     * find out the type of the loop variable
83 	     */
84 	codeoff();
85 	fortype = lvalue( lhs , MOD , RREQ );
86 	codeon();
87 	    /*
88 	     * mark the forvar so we can't change it during the loop
89 	     */
90 	forvar -> value[ NL_FORV ] = 1;
91 	if ( fortype == NIL ) {
92 	    rvalue( init , NIL , RREQ );
93 	    rvalue( term , NIL , RREQ );
94 	    statement( stat );
95 	    goto byebye;
96 	}
97 	if ( isnta( fortype , "bcis" ) ) {
98 	    error("For variables cannot be %ss" , nameof( fortype ) );
99 	    rvalue( init , NIL , RREQ );
100 	    rvalue( term , NIL , RREQ );
101 	    statement( stat );
102 	    goto byebye;
103 	}
104 	    /*
105 	     * allocate space for the initial and termination expressions
106 	     */
107 	sizes[cbn].om_off -= sizeof( long );
108 	initoff = sizes[cbn].om_off;
109 	sizes[cbn].om_off -= sizeof( long );
110 	termoff = sizes[cbn].om_off;
111 	if ( sizes[cbn].om_off < sizes[cbn].om_max ) {
112 	    sizes[cbn].om_max = sizes[cbn].om_off;
113 	}
114 #	ifdef PC
115 	    putlbracket( ftnno , -sizes[cbn].om_off );
116 		/*
117 		 * compute and save the initial expression
118 		 */
119 	    forctype = p2type( fortype );
120 	    putRV( 0 , cbn , initoff , forctype );
121 #	endif PC
122 #	ifdef OBJ
123 	    put(2, O_LV | cbn<<8+INDX, initoff);
124 #	endif OBJ
125 	inittype = rvalue( init , fortype , RREQ );
126 	if ( incompat( inittype , fortype , init ) ) {
127 	    cerror("Type of initial expression clashed with index type in 'for' statement");
128 	    rvalue( term , NIL , RREQ );
129 	    statement( stat );
130 	    goto byebye;
131 	}
132 #	ifdef PC
133 	    putop( P2ASSIGN , forctype );
134 	    putdot( filename , line );
135 		/*
136 		 * compute and save the termination expression
137 		 */
138 	    putRV( 0 , cbn , termoff , forctype );
139 #	endif PC
140 #	ifdef OBJ
141 	    put(1, width(inittype) <= 2 ? O_AS24 : O_AS4);
142 		/*
143 		 * compute and save the termination expression
144 		 */
145 	    put(2, O_LV | cbn<<8+INDX, termoff);
146 #	endif OBJ
147 	termtype = rvalue( term , fortype , RREQ );
148 	if ( incompat( termtype , fortype , term ) ) {
149 	    cerror("Type of limit expression clashed with index type in 'for' statement");
150 	    statement( stat );
151 	    goto byebye;
152 	}
153 #	ifdef PC
154 	    putop( P2ASSIGN , forctype );
155 	    putdot( filename , line );
156 		/*
157 		 * we can skip the loop altogether if !( init <= term )
158 		 */
159 	    after = getlab();
160 	    putRV( 0 , cbn , initoff , forctype );
161 	    putRV( 0 , cbn , termoff , forctype );
162 	    putop( ( arg[0] == T_FORU ? P2LE : P2GE ) , forctype );
163 	    putleaf( P2ICON , after , 0 , P2INT , 0 );
164 	    putop( P2CBRANCH , P2INT );
165 	    putdot( filename , line );
166 		/*
167 		 * okay, then we have to execute the body, but first,
168 		 * assign the initial expression to the for variable.
169 		 * see the note in asgnop1 about why this is an rvalue.
170 		 */
171 	    rvalue( lhs , NIL , RREQ );
172 	    if ( opt( 't' ) ) {
173 		precheck( fortype , "_RANG4" , "_RSNG4" );
174 	    }
175 	    putRV( 0 , cbn , initoff , forctype );
176 	    if ( opt( 't' ) ) {
177 		postcheck( fortype );
178 	    }
179 	    putop( P2ASSIGN , forctype );
180 	    putdot( filename , line );
181 #	endif PC
182 #	ifdef OBJ
183 	    put(1, width(termtype) <= 2 ? O_AS24 : O_AS4);
184 		/*
185 		 * we can skip the loop altogether if !( init <= term )
186 		 */
187 	    put(2, O_RV4 | cbn<<8+INDX, initoff);
188 	    put(2, O_RV4 | cbn<<8+INDX, termoff);
189 	    gen(NIL, arg[0] == T_FORU ? T_LE : T_GE, sizeof(long),
190 			sizeof(long));
191 	    after = getlab();
192 	    put(2, O_IF, after);
193 		/*
194 		 * okay, then we have to execute the body, but first,
195 		 * assign the initial expression to the for variable.
196 		 */
197 	    lvalue( lhs , NOUSE , LREQ );
198 	    put(2, O_RV4 | cbn<<8+INDX, initoff);
199 	    rangechk(fortype, nl+T4INT);
200 	    put(1, width(fortype) <= 2 ? O_AS42 : O_AS4);
201 #	endif OBJ
202 	/*
203 	 * put down the label at the top of the loop
204 	 */
205 	again = getlab();
206 	putlab( again );
207 	putcnt();
208 	    /*
209 	     * and don't forget ...
210 	     */
211 	statement( arg[ 4 ] );
212 	    /*
213 	     * wasn't that fun?  do we get to do it again?
214 	     *	we don't do it again if ( !( forvar < limit ) )
215 	     *	pretend we were doing this at the top of the loop
216 	     */
217 	line = arg[ 1 ];
218 #	ifdef PC
219 	    if ( opt( 'p' ) ) {
220 		if ( opt('t') ) {
221 		    putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
222 			    , "_LINO" );
223 		    putop( P2UNARY P2CALL , P2INT );
224 		    putdot( filename , line );
225 		} else {
226 		    putRV( STMTCOUNT , 0 , 0 , P2INT );
227 		    putleaf( P2ICON , 1 , 0 , P2INT , 0 );
228 		    putop( P2ASG P2PLUS , P2INT );
229 		    putdot( filename , line );
230 		}
231 	    }
232 	    rvalue( lhs , NIL , RREQ );
233 	    putRV( 0 , cbn , termoff , forctype );
234 	    putop( ( arg[ 0 ] == T_FORU ? P2LT : P2GT ) , forctype );
235 	    putleaf( P2ICON , after , 0 , P2INT , 0 );
236 	    putop( P2CBRANCH , P2INT );
237 	    putdot( filename , line );
238 		/*
239 		 * okay, so we have to do it again,
240 		 * but first, increment the for variable.
241 		 * there it is again, an rvalue on the lhs of an assignment.
242 		 */
243 	    rvalue( lhs , NIL , RREQ );
244 	    if ( opt( 't' ) ) {
245 		precheck( fortype , "_RANG4" , "_RSNG4" );
246 	    }
247 	    rvalue( lhs , NIL , RREQ );
248 	    putleaf( P2ICON , 1 , 0 , forctype , 0 );
249 	    putop( ( arg[0] == T_FORU ? P2PLUS : P2MINUS ) , forctype );
250 	    if ( opt( 't' ) ) {
251 		postcheck( fortype );
252 	    }
253 	    putop( P2ASSIGN , forctype );
254 	    putdot( filename , line );
255 		/*
256 		 * and do it all again
257 		 */
258 	    putjbr( again );
259 		/*
260 		 * and here we are
261 		 */
262 	    putlab( after );
263 		/*
264 		 * deallocate the initial and limit variables
265 		 */
266 	    sizes[cbn].om_off += 2 * ( sizeof( long ) );
267 	    putlbracket( ftnno , -sizes[cbn].om_off );
268 #	endif PC
269 #	ifdef OBJ
270 		/*
271 		 * okay, so we have to do it again.
272 		 * Luckily we have a magic opcode which increments the
273 		 * index variable, checks the limit falling through if
274 		 * it has been reached, else range checking the result
275 		 * updating the index variable, and returning to the top
276 		 * of the loop.
277 		 */
278 	    put(2, O_RV4 | cbn<<8+INDX, termoff);
279 	    lvalue(lhs, MOD, LREQ);
280 	    put(4, (arg[0] == T_FORU ? O_FOR1U : O_FOR1D) + (width(fortype)>>1),
281 		    fortype->range[0], fortype->range[1], again);
282 		/*
283 		 * and here we are
284 		 */
285 	    patch( after );
286 		/*
287 		 * deallocate the initial and limit variables
288 		 */
289 	    sizes[cbn].om_off += 2 * ( sizeof( long ) );
290 #	endif OBJ
291 byebye:
292 	noreach = 0;
293 	if ( forvar != NIL ) {
294 	    forvar -> value[ NL_FORV ] = 0;
295 	}
296 	if ( goc != gocnt ) {
297 	    putcnt();
298 	}
299     }
300