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