1 /*-
2 * Copyright (c) 1980, 1993
3 * The Regents of the University of California. All rights reserved.
4 *
5 * %sccs.include.redist.c%
6 */
7
8 #ifndef lint
9 static char sccsid[] = "@(#)stat.c 8.1 (Berkeley) 06/06/93";
10 #endif /* not lint */
11
12 #include "whoami.h"
13 #include "0.h"
14 #include "tree.h"
15 #include "objfmt.h"
16 #ifdef PC
17 # include <pcc.h>
18 # include "pc.h"
19 #endif PC
20 #include "tmps.h"
21
22 int cntstat;
23 short cnts = 3;
24 #include "opcode.h"
25 #include "tree_ty.h"
26
27 /*
28 * Statement list
29 */
30 statlist(r)
31 struct tnode *r;
32 {
33 register struct tnode *sl;
34
35 for (sl=r; sl != TR_NIL; sl=sl->list_node.next)
36 statement(sl->list_node.list);
37 }
38
39 /*
40 * Statement
41 */
42 statement(r)
43 struct tnode *r;
44 {
45 register struct tnode *tree_node;
46 register struct nl *snlp;
47 struct tmps soffset;
48
49 tree_node = r;
50 snlp = nlp;
51 soffset = sizes[cbn].curtmps;
52 top:
53 if (cntstat) {
54 cntstat = 0;
55 putcnt();
56 }
57 if (tree_node == TR_NIL)
58 return;
59 line = tree_node->lined.line_no;
60 if (tree_node->tag == T_LABEL) {
61 labeled(tree_node->label_node.lbl_ptr);
62 tree_node = tree_node->label_node.stmnt;
63 noreach = FALSE;
64 cntstat = 1;
65 goto top;
66 }
67 if (noreach) {
68 noreach = FALSE;
69 warning();
70 error("Unreachable statement");
71 }
72 switch (tree_node->tag) {
73 case T_PCALL:
74 putline();
75 # ifdef OBJ
76 proc(tree_node);
77 # endif OBJ
78 # ifdef PC
79 pcproc( tree_node );
80 # endif PC
81 break;
82 case T_ASGN:
83 putline();
84 asgnop(&(tree_node->asg_node));
85 break;
86 case T_GOTO:
87 putline();
88 gotoop(tree_node->goto_node.lbl_ptr);
89 noreach = TRUE;
90 cntstat = 1;
91 break;
92 default:
93 level++;
94 switch (tree_node->tag) {
95 default:
96 panic("stat");
97 case T_IF:
98 case T_IFEL:
99 ifop(&(tree_node->if_node));
100 break;
101 case T_WHILE:
102 whilop(&(tree_node->whi_cas));
103 noreach = FALSE;
104 break;
105 case T_REPEAT:
106 repop(&(tree_node->repeat));
107 break;
108 case T_FORU:
109 case T_FORD:
110 forop(tree_node);
111 noreach = FALSE;
112 break;
113 case T_BLOCK:
114 statlist(tree_node->stmnt_blck.stmnt_list);
115 break;
116 case T_CASE:
117 putline();
118 # ifdef OBJ
119 caseop(&(tree_node->whi_cas));
120 # endif OBJ
121 # ifdef PC
122 pccaseop(&(tree_node->whi_cas));
123 # endif PC
124 break;
125 case T_WITH:
126 withop(&(tree_node->with_node));
127 break;
128 }
129 --level;
130 if (gotos[cbn])
131 ungoto();
132 break;
133 }
134 /*
135 * Free the temporary name list entries defined in
136 * expressions, e.g. STRs, and WITHPTRs from withs.
137 */
138 nlfree(snlp);
139 /*
140 * free any temporaries allocated for this statement
141 * these come from strings and sets.
142 */
143 tmpfree(&soffset);
144 }
145
ungoto()146 ungoto()
147 {
148 register struct nl *p;
149
150 for (p = gotos[cbn]; p != NLNIL; p = p->chain)
151 if ((p->nl_flags & NFORWD) != 0) {
152 if (p->value[NL_GOLEV] != NOTYET)
153 if (p->value[NL_GOLEV] > level)
154 p->value[NL_GOLEV] = level;
155 } else
156 if (p->value[NL_GOLEV] != DEAD)
157 if (p->value[NL_GOLEV] > level)
158 p->value[NL_GOLEV] = DEAD;
159 }
160
putcnt()161 putcnt()
162 {
163
164 if (monflg == FALSE) {
165 return;
166 }
167 inccnt( getcnt() );
168 }
169
170 int
getcnt()171 getcnt()
172 {
173
174 return ++cnts;
175 }
176
inccnt(counter)177 inccnt( counter )
178 int counter;
179 {
180
181 # ifdef OBJ
182 (void) put(2, O_COUNT, counter );
183 # endif OBJ
184 # ifdef PC
185 putRV( PCPCOUNT , 0 , counter * sizeof (long) , NGLOBAL , PCCT_INT );
186 putleaf( PCC_ICON , 1 , 0 , PCCT_INT , (char *) 0 );
187 putop( PCCOM_ASG PCC_PLUS , PCCT_INT );
188 putdot( filename , line );
189 # endif PC
190 }
191
putline()192 putline()
193 {
194
195 # ifdef OBJ
196 if (opt('p') != 0)
197 (void) put(2, O_LINO, line);
198
199 /*
200 * put out line number information for pdx
201 */
202 lineno(line);
203
204 # endif OBJ
205 # ifdef PC
206 static lastline;
207
208 if ( line != lastline ) {
209 stabline( line );
210 lastline = line;
211 }
212 if ( opt( 'p' ) ) {
213 if ( opt('t') ) {
214 putleaf( PCC_ICON , 0 , 0 , PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR )
215 , "_LINO" );
216 putop( PCCOM_UNARY PCC_CALL , PCCT_INT );
217 putdot( filename , line );
218 } else {
219 putRV( STMTCOUNT , 0 , 0 , NGLOBAL , PCCT_INT );
220 putleaf( PCC_ICON , 1 , 0 , PCCT_INT , (char *) 0 );
221 putop( PCCOM_ASG PCC_PLUS , PCCT_INT );
222 putdot( filename , line );
223 }
224 }
225 # endif PC
226 }
227
228 /*
229 * With varlist do stat
230 *
231 * With statement requires an extra word
232 * in automatic storage for each level of withing.
233 * These indirect pointers are initialized here, and
234 * the scoping effect of the with statement occurs
235 * because lookup examines the field names of the records
236 * associated with the WITHPTRs on the withlist.
237 */
withop(s)238 withop(s)
239 WITH_NODE *s;
240 {
241 register struct tnode *p;
242 register struct nl *r;
243 struct nl *tempnlp;
244 struct nl *swl;
245
246 putline();
247 swl = withlist;
248 for (p = s->var_list; p != TR_NIL; p = p->list_node.next) {
249 tempnlp = tmpalloc((long) (sizeof(int *)), nl+TPTR, REGOK);
250 /*
251 * no one uses the allocated temporary namelist entry,
252 * since we have to use it before we know its type;
253 * but we use its runtime location for the with pointer.
254 */
255 # ifdef OBJ
256 (void) put(2, O_LV | cbn <<8+INDX, tempnlp -> value[ NL_OFFS ] );
257 # endif OBJ
258 # ifdef PC
259 putRV( (char *) 0 , cbn , tempnlp -> value[ NL_OFFS ] ,
260 tempnlp -> extra_flags , PCCTM_PTR|PCCT_STRTY );
261 # endif PC
262 r = lvalue(p->list_node.list, MOD , LREQ );
263 if (r == NLNIL)
264 continue;
265 if (r->class != RECORD) {
266 error("Variable in with statement refers to %s, not to a record", nameof(r));
267 continue;
268 }
269 r = defnl((char *) 0, WITHPTR, r, tempnlp -> value[ NL_OFFS ] );
270 # ifdef PC
271 r -> extra_flags |= tempnlp -> extra_flags;
272 # endif PC
273 r->nl_next = withlist;
274 withlist = r;
275 # ifdef OBJ
276 (void) put(1, PTR_AS);
277 # endif OBJ
278 # ifdef PC
279 putop( PCC_ASSIGN , PCCTM_PTR|PCCT_STRTY );
280 putdot( filename , line );
281 # endif PC
282 }
283 statement(s->stmnt);
284 withlist = swl;
285 }
286
287 extern flagwas;
288 /*
289 * var := expr
290 */
asgnop(r)291 asgnop(r)
292 ASG_NODE *r;
293 {
294 register struct nl *p;
295 register struct tnode *av;
296
297 /*
298 * Asgnop's only function is
299 * to handle function variable
300 * assignments. All other assignment
301 * stuff is handled by asgnop1.
302 * the if below checks for unqualified lefthandside:
303 * necessary for fvars.
304 */
305 av = r->lhs_var;
306 if (av != TR_NIL && av->tag == T_VAR && av->var_node.qual == TR_NIL) {
307 p = lookup1(av->var_node.cptr);
308 if (p != NLNIL)
309 p->nl_flags = flagwas;
310 if (p != NLNIL && p->class == FVAR) {
311 /*
312 * Give asgnop1 the func
313 * which is the chain of
314 * the FVAR.
315 */
316 p->nl_flags |= NUSED|NMOD;
317 p = p->chain;
318 if (p == NLNIL) {
319 p = rvalue(r->rhs_expr, NLNIL , RREQ );
320 return;
321 }
322 # ifdef OBJ
323 (void) put(2, O_LV | bn << 8+INDX, (int)p->value[NL_OFFS]);
324 if (isa(p->type, "i") && width(p->type) == 1)
325 (void) asgnop1(r, nl+T2INT);
326 else
327 (void) asgnop1(r, p->type);
328 # endif OBJ
329 # ifdef PC
330 /*
331 * this should be the lvalue of the fvar,
332 * but since the second pass knows to use
333 * the address of the left operand of an
334 * assignment, what i want here is an rvalue.
335 * see note in funchdr about fvar allocation.
336 */
337 p = p -> ptr[ NL_FVAR ];
338 putRV( p -> symbol , bn , p -> value[ NL_OFFS ] ,
339 p -> extra_flags , p2type( p -> type ) );
340 (void) asgnop1( r , p -> type );
341 # endif PC
342 return;
343 }
344 }
345 (void) asgnop1(r, NLNIL);
346 }
347
348 /*
349 * Asgnop1 handles all assignments.
350 * If p is not nil then we are assigning
351 * to a function variable, otherwise
352 * we look the variable up ourselves.
353 */
354 struct nl *
asgnop1(r,p)355 asgnop1(r, p)
356 ASG_NODE *r;
357 register struct nl *p;
358 {
359 register struct nl *p1;
360 int clas;
361 #ifdef OBJ
362 int w;
363 #endif OBJ
364
365 #ifdef OBJ
366 if (p == NLNIL) {
367 p = lvalue(r->lhs_var, MOD|ASGN|NOUSE , LREQ );
368 if ( p == NLNIL ) {
369 (void) rvalue( r->rhs_expr , NLNIL , RREQ );
370 return NLNIL;
371 }
372 w = width(p);
373 } else {
374 /*
375 * assigning to the return value, which is at least
376 * of width two since it resides on the stack
377 */
378 w = width(p);
379 if (w < 2)
380 w = 2;
381 }
382 clas = classify(p);
383 if ((clas == TARY || clas == TSTR) && p->chain->class == CRANGE) {
384 p1 = lvalue(r->rhs_expr, p , LREQ ); /* SHOULD THIS BE rvalue? */
385 } else {
386 p1 = rvalue(r->rhs_expr, p , RREQ );
387 }
388 # endif OBJ
389 # ifdef PC
390 if (p == NLNIL) {
391 /* check for conformant array type */
392 codeoff();
393 p = rvalue(r->lhs_var, MOD|ASGN|NOUSE, LREQ);
394 codeon();
395 if (p == NLNIL) {
396 (void) rvalue(r->rhs_expr, NLNIL, RREQ);
397 return NLNIL;
398 }
399 clas = classify(p);
400 if ((clas == TARY || clas == TSTR) && p->chain->class == CRANGE) {
401 return pcasgconf(r, p);
402 } else {
403 /*
404 * since the second pass knows that it should reference
405 * the lefthandside of asignments, what i need here is
406 * an rvalue.
407 */
408 p = lvalue( r->lhs_var , MOD|ASGN|NOUSE , RREQ );
409 }
410 if ( p == NLNIL ) {
411 (void) rvalue( r->rhs_expr , NLNIL , RREQ );
412 return NLNIL;
413 }
414 }
415 /*
416 * if this is a scalar assignment,
417 * then i want to rvalue the righthandside.
418 * if this is a structure assignment,
419 * then i want an lvalue to the righthandside.
420 * that's what the intermediate form sez.
421 */
422 switch ( classify( p ) ) {
423 case TINT:
424 case TCHAR:
425 case TBOOL:
426 case TSCAL:
427 precheck( p , "_RANG4" , "_RSNG4" );
428 /* and fall through */
429 case TDOUBLE:
430 case TPTR:
431 p1 = rvalue( r->rhs_expr , p , RREQ );
432 break;
433 default:
434 p1 = rvalue( r->rhs_expr , p , LREQ );
435 break;
436 }
437 # endif PC
438 if (p1 == NLNIL)
439 return (NLNIL);
440 if (incompat(p1, p, r->rhs_expr)) {
441 cerror("Type of expression clashed with type of variable in assignment");
442 return (NLNIL);
443 }
444 # ifdef OBJ
445 switch (classify(p)) {
446 case TINT:
447 case TBOOL:
448 case TCHAR:
449 case TSCAL:
450 rangechk(p, p1);
451 (void) gen(O_AS2, O_AS2, w, width(p1));
452 break;
453 case TDOUBLE:
454 case TPTR:
455 (void) gen(O_AS2, O_AS2, w, width(p1));
456 break;
457 case TARY:
458 case TSTR:
459 if (p->chain->class == CRANGE) {
460 /* conformant array assignment */
461 p1 = p->chain;
462 w = width(p1->type);
463 putcbnds(p1, 1);
464 putcbnds(p1, 0);
465 gen(NIL, T_SUB, w, w);
466 put(2, w > 2? O_CON24: O_CON2, 1);
467 gen(NIL, T_ADD, w, w);
468 putcbnds(p1, 2);
469 gen(NIL, T_MULT, w, w);
470 put(1, O_VAS);
471 break;
472 }
473 /* else fall through */
474 default:
475 (void) put(2, O_AS, w);
476 break;
477 }
478 # endif OBJ
479 # ifdef PC
480 switch (classify(p)) {
481 case TINT:
482 case TBOOL:
483 case TCHAR:
484 case TSCAL:
485 postcheck(p, p1);
486 sconv(p2type(p1), p2type(p));
487 putop( PCC_ASSIGN , p2type( p ) );
488 putdot( filename , line );
489 break;
490 case TPTR:
491 putop( PCC_ASSIGN , p2type( p ) );
492 putdot( filename , line );
493 break;
494 case TDOUBLE:
495 sconv(p2type(p1), p2type(p));
496 putop( PCC_ASSIGN , p2type( p ) );
497 putdot( filename , line );
498 break;
499 default:
500 putstrop(PCC_STASG, PCCM_ADDTYPE(p2type(p), PCCTM_PTR),
501 (int) lwidth(p), align(p));
502 putdot( filename , line );
503 break;
504 }
505 # endif PC
506 return (p); /* Used by for statement */
507 }
508
509 #ifdef PC
510 /*
511 * assignment to conformant arrays. Since these are variable length,
512 * we use blkcpy() to perform the assignment.
513 * blkcpy(rhs, lhs, (upper - lower + 1) * width)
514 */
515 struct nl *
pcasgconf(r,p)516 pcasgconf(r, p)
517 register ASG_NODE *r;
518 struct nl *p;
519 {
520 struct nl *p1;
521
522 if (r == (ASG_NODE *) TR_NIL || p == NLNIL)
523 return NLNIL;
524 putleaf( PCC_ICON , 0 , 0 , PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR) , "_blkcpy" );
525 p1 = rvalue( r->rhs_expr , p , LREQ );
526 if (p1 == NLNIL)
527 return NLNIL;
528 p = lvalue( r->lhs_var , MOD|ASGN|NOUSE , LREQ );
529 if (p == NLNIL)
530 return NLNIL;
531 putop(PCC_CM, PCCT_INT);
532 /* upper bound */
533 p1 = p->chain->nptr[1];
534 putRV(p1->symbol, (p1->nl_block & 037), p1->value[0],
535 p1->extra_flags, p2type( p1 ) );
536 /* minus lower bound */
537 p1 = p->chain->nptr[0];
538 putRV(p1->symbol, (p1->nl_block & 037), p1->value[0],
539 p1->extra_flags, p2type( p1 ) );
540 putop( PCC_MINUS, PCCT_INT );
541 /* add one */
542 putleaf(PCC_ICON, 1, 0, PCCT_INT, 0);
543 putop( PCC_PLUS, PCCT_INT );
544 /* and multiply by the width */
545 p1 = p->chain->nptr[2];
546 putRV(p1->symbol, (p1->nl_block & 037), p1->value[0],
547 p1->extra_flags, p2type( p1 ) );
548 putop( PCC_MUL , PCCT_INT );
549 putop(PCC_CM, PCCT_INT);
550 putop(PCC_CALL, PCCT_INT);
551 putdot( filename , line);
552 return p;
553 }
554 #endif PC
555
556 /*
557 * if expr then stat [ else stat ]
558 */
ifop(if_n)559 ifop(if_n)
560 IF_NODE *if_n;
561 {
562 register struct nl *p;
563 register l1, l2; /* l1 is start of else, l2 is end of else */
564 int goc;
565 bool nr;
566
567 goc = gocnt;
568 putline();
569 p = rvalue(if_n->cond_expr, NLNIL , RREQ );
570 if (p == NIL) {
571 statement(if_n->then_stmnt);
572 noreach = FALSE;
573 statement(if_n->else_stmnt);
574 noreach = FALSE;
575 return;
576 }
577 if (isnta(p, "b")) {
578 error("Type of expression in if statement must be Boolean, not %s", nameof(p));
579 statement(if_n->then_stmnt);
580 noreach = FALSE;
581 statement(if_n->else_stmnt);
582 noreach = FALSE;
583 return;
584 }
585 # ifdef OBJ
586 l1 = put(2, O_IF, getlab());
587 # endif OBJ
588 # ifdef PC
589 l1 = (int) getlab();
590 putleaf( PCC_ICON , l1 , 0 , PCCT_INT , (char *) 0 );
591 putop( PCC_CBRANCH , PCCT_INT );
592 putdot( filename , line );
593 # endif PC
594 putcnt();
595 statement(if_n->then_stmnt);
596 nr = noreach;
597 if (if_n->else_stmnt != TR_NIL) {
598 /*
599 * else stat
600 */
601 --level;
602 ungoto();
603 ++level;
604 # ifdef OBJ
605 l2 = put(2, O_TRA, getlab());
606 # endif OBJ
607 # ifdef PC
608 l2 = (int) getlab();
609 putjbr( (long) l2 );
610 # endif PC
611 patch((PTR_DCL)l1);
612 noreach = FALSE;
613 statement(if_n->else_stmnt);
614 noreach = (noreach && nr)?TRUE:FALSE;
615 l1 = l2;
616 } else
617 noreach = FALSE;
618 patch((PTR_DCL)l1);
619 if (goc != gocnt)
620 putcnt();
621 }
622
623 /*
624 * while expr do stat
625 */
whilop(w_node)626 whilop(w_node)
627 WHI_CAS *w_node;
628 {
629 register struct nl *p;
630 register char *l1, *l2;
631 int goc;
632
633 goc = gocnt;
634 l1 = getlab();
635 (void) putlab(l1);
636 putline();
637 p = rvalue(w_node->expr, NLNIL , RREQ );
638 if (p == NLNIL) {
639 statement(w_node->stmnt_list);
640 noreach = FALSE;
641 return;
642 }
643 if (isnta(p, "b")) {
644 error("Type of expression in while statement must be Boolean, not %s", nameof(p));
645 statement(w_node->stmnt_list);
646 noreach = FALSE;
647 return;
648 }
649 l2 = getlab();
650 # ifdef OBJ
651 (void) put(2, O_IF, l2);
652 # endif OBJ
653 # ifdef PC
654 putleaf( PCC_ICON , (int) l2 , 0 , PCCT_INT , (char *) 0 );
655 putop( PCC_CBRANCH , PCCT_INT );
656 putdot( filename , line );
657 # endif PC
658 putcnt();
659 statement(w_node->stmnt_list);
660 # ifdef OBJ
661 (void) put(2, O_TRA, l1);
662 # endif OBJ
663 # ifdef PC
664 putjbr( (long) l1 );
665 # endif PC
666 patch((PTR_DCL) l2);
667 if (goc != gocnt)
668 putcnt();
669 }
670
671 /*
672 * repeat stat* until expr
673 */
repop(r)674 repop(r)
675 REPEAT *r;
676 {
677 register struct nl *p;
678 register l;
679 int goc;
680
681 goc = gocnt;
682 l = (int) putlab(getlab());
683 putcnt();
684 statlist(r->stmnt_list);
685 line = r->line_no;
686 p = rvalue(r->term_expr, NLNIL , RREQ );
687 if (p == NLNIL)
688 return;
689 if (isnta(p,"b")) {
690 error("Until expression type must be Boolean, not %s, in repeat statement", nameof(p));
691 return;
692 }
693 # ifdef OBJ
694 (void) put(2, O_IF, l);
695 # endif OBJ
696 # ifdef PC
697 putleaf( PCC_ICON , l , 0 , PCCT_INT , (char *) 0 );
698 putop( PCC_CBRANCH , PCCT_INT );
699 putdot( filename , line );
700 # endif PC
701 if (goc != gocnt)
702 putcnt();
703 }
704