![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to forop.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 42BSD / ucb / pascal / src|
Return to forop.c CVS log | Up to [CSRG BSD Unix] / 42BSD / ucb / pascal / src |
1.1 root 1: /* Copyright (c) 1979 Regents of the University of California */
2:
3: static char sccsid[] = "@(#)forop.c 1.16 2/28/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: #include "tmps.h"
15:
16: /*
17: * for-statements.
18: *
19: * the relevant quote from the standard: 6.8.3.9:
20: * ``The control-variable shall be an entire-variable whose identifier
21: * is declared in the variable-declaration-part of the block closest-
22: * containing the for-statement. The control-variable shall possess
23: * an ordinal-type, and the initial-value and the final-value shall be
24: * of a type compatible with this type. The statement of a for-statement
25: * shall not contain an assigning-reference to the control-variable
26: * of the for-statement. The value of the final-value shall be
27: * assignment-compatible with the control-variable when the initial-value
28: * is assigned to the control-variable. After a for-statement is
29: * executed (other than being left by a goto-statement leading out of it)
30: * the control-variable shall be undefined. Apart from the restrictions
31: * imposed by these requirements, the for-statement
32: * for v := e1 to e2 do body
33: * shall be equivalent to
34: * begin
35: * temp1 := e1;
36: * temp2 := e2;
37: * if temp1 <= temp2 then begin
38: * v := temp1;
39: * body;
40: * while v <> temp2 do begin
41: * v := succ(v);
42: * body;
43: * end
44: * end
45: * end
46: * where temp1 and temp2 denote auxiliary variables that the program
47: * does not otherwise contain, and that possess the type possessed by
48: * the variable v if that type is not a subrange-type; otherwise the
49: * host type possessed by the variable v.''
50: *
51: * The Berkeley Pascal systems try to do all that without duplicating
52: * the body, and shadowing the control-variable in (possibly) a
53: * register variable.
54: *
55: * arg here looks like:
56: * arg[0] T_FORU or T_FORD
57: * [1] lineof "for"
58: * [2] [0] T_ASGN
59: * [1] lineof ":="
60: * [2] [0] T_VAR
61: * [1] lineof id
62: * [2] char * to id
63: * [3] qualifications
64: * [3] initial expression
65: * [3] termination expression
66: * [4] statement
67: */
68: forop( arg )
69: int *arg;
70: {
71: int *lhs;
72: struct nl *forvar;
73: struct nl *fortype;
74: #ifdef PC
75: int forp2type;
76: #endif PC
77: int forwidth;
78: int *init;
79: struct nl *inittype;
80: struct nl *initnlp; /* initial value namelist entry */
81: int *term;
82: struct nl *termtype;
83: struct nl *termnlp; /* termination value namelist entry */
84: struct nl *shadownlp; /* namelist entry for the shadow */
85: int *stat;
86: int goc; /* saved gocnt */
87: int again; /* label at the top of the loop */
88: int after; /* label after the end of the loop */
89: struct nl saved_nl; /* saved namelist entry for loop var */
90:
91: goc = gocnt;
92: forvar = NIL;
93: if ( arg == NIL ) {
94: goto byebye;
95: }
96: if ( arg[2] == NIL ) {
97: goto byebye;
98: }
99: line = arg[1];
100: putline();
101: lhs = ( (int *) arg[2] )[2];
102: init = ( (int *) arg[2] )[3];
103: term = arg[3];
104: stat = arg[4];
105: if (lhs == NIL) {
106: nogood:
107: if (forvar != NIL) {
108: forvar->value[ NL_FORV ] = FORVAR;
109: }
110: rvalue( init , NIL , RREQ );
111: rvalue( term , NIL , RREQ );
112: statement( stat );
113: goto byebye;
114: }
115: /*
116: * and this marks the variable as used!!!
117: */
118: forvar = lookup( lhs[2] );
119: if ( forvar == NIL ) {
120: goto nogood;
121: }
122: saved_nl = *forvar;
123: if ( lhs[3] != NIL ) {
124: error("For variable %s must be unqualified", forvar->symbol);
125: goto nogood;
126: }
127: if (forvar->class == WITHPTR) {
128: error("For variable %s cannot be an element of a record", lhs[2]);
129: goto nogood;
130: }
131: if ( opt('s') &&
132: ( ( bn != cbn ) ||
133: #ifdef OBJ
134: (whereis(bn, forvar->value[NL_OFFS], 0) == PARAMVAR)
135: #endif OBJ
136: #ifdef PC
137: (whereis(bn, forvar->value[NL_OFFS], forvar->extra_flags)
138: == PARAMVAR )
139: #endif PC
140: ) ) {
141: standard();
142: error("For variable %s must be declared in the block in which it is used", forvar->symbol);
143: }
144: /*
145: * find out the type of the loop variable
146: */
147: codeoff();
148: fortype = lvalue( lhs , MOD , RREQ );
149: codeon();
150: if ( fortype == NIL ) {
151: goto nogood;
152: }
153: if ( isnta( fortype , "bcis" ) ) {
154: error("For variable %s cannot be %ss", forvar->symbol, nameof( fortype ) );
155: goto nogood;
156: }
157: if ( forvar->value[ NL_FORV ] & FORVAR ) {
158: error("Can't modify the for variable %s in the range of the loop", forvar->symbol);
159: forvar = NIL;
160: goto nogood;
161: }
162: forwidth = lwidth(fortype);
163: # ifdef PC
164: forp2type = p2type(fortype);
165: # endif PC
166: /*
167: * allocate temporaries for the initial and final expressions
168: * and maybe a register to shadow the for variable.
169: */
170: initnlp = tmpalloc(sizeof(long), nl+T4INT, NOREG);
171: termnlp = tmpalloc(sizeof(long), nl+T4INT, NOREG);
172: shadownlp = tmpalloc(forwidth, fortype, REGOK);
173: # ifdef PC
174: /*
175: * compute and save the initial expression
176: */
177: putRV( 0 , cbn , initnlp -> value[ NL_OFFS ] ,
178: initnlp -> extra_flags , P2INT );
179: # endif PC
180: # ifdef OBJ
181: put(2, O_LV | cbn<<8+INDX, initnlp -> value[ NL_OFFS ] );
182: # endif OBJ
183: inittype = rvalue( init , fortype , RREQ );
184: if ( incompat( inittype , fortype , init ) ) {
185: cerror("Type of initial expression clashed with index type in 'for' statement");
186: if (forvar != NIL) {
187: forvar->value[ NL_FORV ] = FORVAR;
188: }
189: rvalue( term , NIL , RREQ );
190: statement( stat );
191: goto byebye;
192: }
193: # ifdef PC
194: sconv(p2type(inittype), P2INT);
195: putop( P2ASSIGN , P2INT );
196: putdot( filename , line );
197: /*
198: * compute and save the termination expression
199: */
200: putRV( 0 , cbn , termnlp -> value[ NL_OFFS ] ,
201: termnlp -> extra_flags , P2INT );
202: # endif PC
203: # ifdef OBJ
204: gen(O_AS2, O_AS2, sizeof(long), width(inittype));
205: /*
206: * compute and save the termination expression
207: */
208: put(2, O_LV | cbn<<8+INDX, termnlp -> value[ NL_OFFS ] );
209: # endif OBJ
210: termtype = rvalue( term , fortype , RREQ );
211: if ( incompat( termtype , fortype , term ) ) {
212: cerror("Type of limit expression clashed with index type in 'for' statement");
213: if (forvar != NIL) {
214: forvar->value[ NL_FORV ] = FORVAR;
215: }
216: statement( stat );
217: goto byebye;
218: }
219: # ifdef PC
220: sconv(p2type(termtype), P2INT);
221: putop( P2ASSIGN , P2INT );
222: putdot( filename , line );
223: /*
224: * we can skip the loop altogether if !( init <= term )
225: */
226: after = getlab();
227: putRV( 0 , cbn , initnlp -> value[ NL_OFFS ] ,
228: initnlp -> extra_flags , P2INT );
229: putRV( 0 , cbn , termnlp -> value[ NL_OFFS ] ,
230: termnlp -> extra_flags , P2INT );
231: putop( ( arg[0] == T_FORU ? P2LE : P2GE ) , P2INT );
232: putleaf( P2ICON , after , 0 , P2INT , 0 );
233: putop( P2CBRANCH , P2INT );
234: putdot( filename , line );
235: /*
236: * okay, so we have to execute the loop body,
237: * but first, if checking is on,
238: * check that the termination expression
239: * is assignment compatible with the control-variable.
240: */
241: if (opt('t')) {
242: precheck(fortype, "_RANG4", "_RSNG4");
243: putRV(0, cbn, termnlp -> value[NL_OFFS],
244: termnlp -> extra_flags, P2INT);
245: postcheck(fortype, nl+T4INT);
246: putdot(filename, line);
247: }
248: /*
249: * assign the initial expression to the shadow
250: * checking the assignment if necessary.
251: */
252: putRV(0, cbn, shadownlp -> value[NL_OFFS],
253: shadownlp -> extra_flags, forp2type);
254: if (opt('t')) {
255: precheck(fortype, "_RANG4", "_RSNG4");
256: putRV(0, cbn, initnlp -> value[NL_OFFS],
257: initnlp -> extra_flags, P2INT);
258: postcheck(fortype, nl+T4INT);
259: } else {
260: putRV(0, cbn, initnlp -> value[NL_OFFS],
261: initnlp -> extra_flags, P2INT);
262: }
263: sconv(P2INT, forp2type);
264: putop(P2ASSIGN, forp2type);
265: putdot(filename, line);
266: /*
267: * put down the label at the top of the loop
268: */
269: again = getlab();
270: putlab( again );
271: /*
272: * each time through the loop
273: * assign the shadow to the for variable.
274: */
275: lvalue(lhs, NOUSE, RREQ);
276: putRV(0, cbn, shadownlp -> value[NL_OFFS],
277: shadownlp -> extra_flags, forp2type);
278: putop(P2ASSIGN, forp2type);
279: putdot(filename, line);
280: # endif PC
281: # ifdef OBJ
282: gen(O_AS2, O_AS2, sizeof(long), width(termtype));
283: /*
284: * we can skip the loop altogether if !( init <= term )
285: */
286: put(2, O_RV4 | cbn<<8+INDX, initnlp -> value[ NL_OFFS ] );
287: put(2, O_RV4 | cbn<<8+INDX, termnlp -> value[ NL_OFFS ] );
288: gen(NIL, arg[0] == T_FORU ? T_LE : T_GE, sizeof(long),
289: sizeof(long));
290: after = getlab();
291: put(2, O_IF, after);
292: /*
293: * okay, so we have to execute the loop body,
294: * but first, if checking is on,
295: * check that the termination expression
296: * is assignment compatible with the control-variable.
297: */
298: if (opt('t')) {
299: put(2, O_LV | cbn<<8+INDX, shadownlp -> value[ NL_OFFS ] );
300: put(2, O_RV4 | cbn<<8+INDX, termnlp -> value[ NL_OFFS ] );
301: rangechk(fortype, nl+T4INT);
302: gen(O_AS2, O_AS2, forwidth, sizeof(long));
303: }
304: /*
305: * assign the initial expression to the shadow
306: * checking the assignment if necessary.
307: */
308: put(2, O_LV | cbn<<8+INDX, shadownlp -> value[ NL_OFFS ] );
309: put(2, O_RV4 | cbn<<8+INDX, initnlp -> value[ NL_OFFS ] );
310: rangechk(fortype, nl+T4INT);
311: gen(O_AS2, O_AS2, forwidth, sizeof(long));
312: /*
313: * put down the label at the top of the loop
314: */
315: again = getlab();
316: putlab( again );
317: /*
318: * each time through the loop
319: * assign the shadow to the for variable.
320: */
321: lvalue(lhs, NOUSE, RREQ);
322: stackRV(shadownlp);
323: gen(O_AS2, O_AS2, forwidth, sizeof(long));
324: # endif OBJ
325: /*
326: * shadowing the real for variable
327: * with the shadow temporary:
328: * save the real for variable flags (including nl_block).
329: * replace them with the shadow's offset,
330: * and mark the for variable as being a for variable.
331: */
332: shadownlp -> nl_flags |= NLFLAGS(forvar -> nl_flags);
333: *forvar = *shadownlp;
334: forvar -> symbol = saved_nl.symbol;
335: forvar -> nl_next = saved_nl.nl_next;
336: forvar -> type = saved_nl.type;
337: forvar -> value[ NL_FORV ] = FORVAR;
338: /*
339: * and don't forget ...
340: */
341: putcnt();
342: statement( stat );
343: /*
344: * wasn't that fun? do we get to do it again?
345: * we don't do it again if ( !( forvar < limit ) )
346: * pretend we were doing this at the top of the loop
347: */
348: line = arg[ 1 ];
349: # ifdef PC
350: if ( opt( 'p' ) ) {
351: if ( opt('t') ) {
352: putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
353: , "_LINO" );
354: putop( P2UNARY P2CALL , P2INT );
355: putdot( filename , line );
356: } else {
357: putRV( STMTCOUNT , 0 , 0 , NGLOBAL , P2INT );
358: putleaf( P2ICON , 1 , 0 , P2INT , 0 );
359: putop( P2ASG P2PLUS , P2INT );
360: putdot( filename , line );
361: }
362: }
363: /*rvalue( lhs , NIL , RREQ );*/
364: putRV( 0 , cbn , shadownlp -> value[ NL_OFFS ] ,
365: shadownlp -> extra_flags , forp2type );
366: sconv(forp2type, P2INT);
367: putRV( 0 , cbn , termnlp -> value[ NL_OFFS ] ,
368: termnlp -> extra_flags , P2INT );
369: putop( ( arg[ 0 ] == T_FORU ? P2LT : P2GT ) , P2INT );
370: putleaf( P2ICON , after , 0 , P2INT , 0 );
371: putop( P2CBRANCH , P2INT );
372: putdot( filename , line );
373: /*
374: * okay, so we have to do it again,
375: * but first, increment the for variable.
376: * no need to rangecheck it, since we checked the
377: * termination value before we started.
378: */
379: /*lvalue( lhs , MOD , RREQ );*/
380: putRV( 0 , cbn , shadownlp -> value[ NL_OFFS ] ,
381: shadownlp -> extra_flags , forp2type );
382: /*rvalue( lhs , NIL , RREQ );*/
383: putRV( 0 , cbn , shadownlp -> value[ NL_OFFS ] ,
384: shadownlp -> extra_flags , forp2type );
385: sconv(forp2type, P2INT);
386: putleaf( P2ICON , 1 , 0 , P2INT , 0 );
387: putop( ( arg[0] == T_FORU ? P2PLUS : P2MINUS ) , P2INT );
388: sconv(P2INT, forp2type);
389: putop( P2ASSIGN , forp2type );
390: putdot( filename , line );
391: /*
392: * and do it all again
393: */
394: putjbr( again );
395: /*
396: * and here we are
397: */
398: putlab( after );
399: # endif PC
400: # ifdef OBJ
401: /*
402: * okay, so we have to do it again.
403: * Luckily we have a magic opcode which increments the
404: * index variable, checks the limit falling through if
405: * it has been reached, else updating the index variable,
406: * and returning to the top of the loop.
407: */
408: putline();
409: put(2, O_RV4 | cbn<<8+INDX, termnlp -> value[ NL_OFFS ] );
410: put(2, O_LV | cbn<<8+INDX, shadownlp -> value[ NL_OFFS ] );
411: put(2, (arg[0] == T_FORU ? O_FOR1U : O_FOR1D) + (forwidth >> 1),
412: again);
413: /*
414: * and here we are
415: */
416: patch( after );
417: # endif OBJ
418: byebye:
419: noreach = 0;
420: if (forvar != NIL) {
421: saved_nl.nl_flags |= NLFLAGS(forvar -> nl_flags) & (NUSED|NMOD);
422: *forvar = saved_nl;
423: }
424: if ( goc != gocnt ) {
425: putcnt();
426: }
427: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.