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