# 2.11BSD#431 - /usr/src/ucb/pascal/pi/stat.c

##### Functions

    asgnop            X
    asgnop1           X
    asrtop            X
    forop             X
    ifop              X
    putcnt            X
    putline           X
    repop             X
    statement         X
    statlist          X
    ungoto            X
    whilop            X
    withop            X

##### Variables

    cnts              X
    cntstat           X

       1: /*	@(#)stat.c	2.2	SCCS id keyword	*/
       2: /* Copyright (c) 1979 Regents of the University of California */
       3: #
       4: /*
       5:  * pi - Pascal interpreter code translator
       6:  *
       7:  * Charles Haley, Bill Joy UCB
       8:  * Version 1.2 November 1978
       9:  */
      10:
      11: #include "whoami"
      12: #include "0.h"
      13: #include "tree.h"
      14:
      15: int cntstat;
      16: short cnts = 2;
      17: #include "opcode.h"
      18:
      19: /*
      20:  * Statement list
      21:  */
      22: statlist(r)
      23:     int *r;
      24: {
      25:     register *sl;
      26:
      27:     for (sl=r; sl != NIL; sl=sl[2])
      28:         statement(sl[1]);
      29: }
      30:
      31: /*
      32:  * Statement
      33:  */
      34: statement(r)
      35:     int *r;
      36: {
      37:     register *s;
      38:     register struct nl *snlp;
      39:
      40:     s = r;
      41:     snlp = nlp;
      42: top:
      43:     if (cntstat) {
      44:         cntstat = 0;
      45:         putcnt();
      46:     }
      47:     if (s == NIL)
      48:         return;
      49:     line = s[1];
      50:     if (s[0] == T_LABEL) {
      51:         labeled(s[2]);
      52:         s = s[3];
      53:         noreach = 0;
      54:         cntstat = 1;
      55:         goto top;
      56:     }
      57:     if (noreach) {
      58:         noreach = 0;
      59:         warning();
      60:         error("Unreachable statement");
      61:     }
      62:     switch (s[0]) {
      63:         case T_PCALL:
      64:             putline();
      65:             proc(s);
      66:             break;
      67:         case T_ASGN:
      68:             putline();
      69:             asgnop(s);
      70:             break;
      71:         case T_GOTO:
      72:             putline();
      73:             gotoop(s[2]);
      74:             noreach = 1;
      75:             cntstat = 1;
      76:             break;
      77:         default:
      78:             level++;
      79:             switch (s[0]) {
      80:                 default:
      81:                     panic("stat");
      82:                 case T_IF:
      83:                 case T_IFEL:
      84:                     ifop(s);
      85:                     break;
      86:                 case T_WHILE:
      87:                     whilop(s);
      88:                     noreach = 0;
      89:                     break;
      90:                 case T_REPEAT:
      91:                     repop(s);
      92:                     break;
      93:                 case T_FORU:
      94:                 case T_FORD:
      95:                     forop(s);
      96:                     noreach = 0;
      97:                     break;
      98:                 case T_BLOCK:
      99:                     statlist(s[2]);
     100:                     break;
     101:                 case T_CASE:
     102:                     putline();
     103:                     caseop(s);
     104:                     break;
     105:                 case T_WITH:
     106:                     withop(s);
     107:                     break;
     108:                 case T_ASRT:
     109:                     putline();
     110:                     asrtop(s);
     111:                     break;
     112:             }
     113:             --level;
     114:             if (gotos[cbn])
     115:                 ungoto();
     116:             break;
     117:     }
     118:     /*
     119: 	 * Free the temporary name list entries defined in
     120: 	 * expressions, e.g. STRs, and WITHPTRs from withs.
     121: 	 */
     122:     nlfree(snlp);
     123: }
     124:
     125: ungoto()
     126: {
     127:     register struct nl *p;
     128:
     129:     for (p = gotos[cbn]; p != NIL; p = p->chain)
     130:         if ((p->nl_flags & NFORWD) != 0) {
     131:             if (p->value[NL_GOLEV] != NOTYET)
     132:                 if (p->value[NL_GOLEV] > level)
     133:                     p->value[NL_GOLEV] = level;
     134:         } else
     135:             if (p->value[NL_GOLEV] != DEAD)
     136:                 if (p->value[NL_GOLEV] > level)
     137:                     p->value[NL_GOLEV] = DEAD;
     138: }
     139:
     140: putcnt()
     141: {
     142:
     143:     if (monflg == 0)
     144:         return;
     145:     cnts++;
     146:     put2(O_COUNT, cnts);
     147: }
     148:
     149: putline()
     150: {
     151:
     152:     if (opt('p') != 0)
     153:         put2(O_LINO, line);
     154: }
     155:
     156: /*
     157:  * With varlist do stat
     158:  *
     159:  * With statement requires an extra word
     160:  * in automatic storage for each level of withing.
     161:  * These indirect pointers are initialized here, and
     162:  * the scoping effect of the with statement occurs
     163:  * because lookup examines the field names of the records
     164:  * associated with the WITHPTRs on the withlist.
     165:  */
     166: withop(s)
     167:     int *s;
     168: {
     169:     register *p;
     170:     register struct nl *r;
     171:     int i;
     172:     int *swl;
     173:     long soffset;
     174:
     175:     putline();
     176:     swl = withlist;
     177:     soffset = sizes[cbn].om_off;
     178:     for (p = s[2]; p != NIL; p = p[2]) {
     179:         sizes[cbn].om_off -= sizeof ( int * );
     180:         put2(O_LV | cbn <<9, i = sizes[cbn].om_off);
     181:         r = lvalue(p[1], MOD);
     182:         if (r == NIL)
     183:             continue;
     184:         if (r->class != RECORD) {
     185:             error("Variable in with statement refers to %s, not to a record", nameof(r));
     186:             continue;
     187:         }
     188:         r = defnl(0, WITHPTR, r, i);
     189:         r->nl_next = withlist;
     190:         withlist = r;
     191: #ifdef  VAX
     192:         put1 ( O_AS4 );
     193: #else
     194:         put1(O_AS2);
     195: #endif
     196:     }
     197:     if (sizes[cbn].om_off < sizes[cbn].om_max)
     198:         sizes[cbn].om_max = sizes[cbn].om_off;
     199:     statement(s[3]);
     200:     sizes[cbn].om_off = soffset;
     201:     withlist = swl;
     202: }
     203:
     204: extern  flagwas;
     205: /*
     206:  * var := expr
     207:  */
     208: asgnop(r)
     209:     int *r;
     210: {
     211:     register struct nl *p;
     212:     register *av;
     213:
     214:     if (r == NIL)
     215:         return (NIL);
     216:     /*
     217: 	 * Asgnop's only function is
     218: 	 * to handle function variable
     219: 	 * assignments.  All other assignment
     220: 	 * stuff is handled by asgnop1.
     221: 	 */
     222:     av = r[2];
     223:     if (av != NIL && av[0] == T_VAR && av[3] == NIL) {
     224:         p = lookup1(av[2]);
     225:         if (p != NIL)
     226:             p->nl_flags = flagwas;
     227:         if (p != NIL && p->class == FVAR) {
     228:             /*
     229: 			 * Give asgnop1 the func
     230: 			 * which is the chain of
     231: 			 * the FVAR.
     232: 			 */
     233:             p->nl_flags |= NUSED|NMOD;
     234:             p = p->chain;
     235:             if (p == NIL) {
     236:                 rvalue(r[3], NIL);
     237:                 return;
     238:             }
     239:             put2(O_LV | bn << 9, p->value[NL_OFFS]);
     240:             if (isa(p->type, "i") && width(p->type) == 1)
     241:                 asgnop1(r, nl+T2INT);
     242:             else
     243:                 asgnop1(r, p->type);
     244:             return;
     245:         }
     246:     }
     247:     asgnop1(r, NIL);
     248: }
     249:
     250: /*
     251:  * Asgnop1 handles all assignments.
     252:  * If p is not nil then we are assigning
     253:  * to a function variable, otherwise
     254:  * we look the variable up ourselves.
     255:  */
     256: struct nl *
     257: asgnop1(r, p)
     258:     int *r;
     259:     register struct nl *p;
     260: {
     261:     register struct nl *p1;
     262:
     263:     if (r == NIL)
     264:         return (NIL);
     265:     if (p == NIL) {
     266:         p = lvalue(r[2], MOD|ASGN|NOUSE);
     267:         if (p == NIL) {
     268:             rvalue(r[3], NIL);
     269:             return (NIL);
     270:         }
     271:     }
     272:     p1 = rvalue(r[3], p);
     273:     if (p1 == NIL)
     274:         return (NIL);
     275:     if (incompat(p1, p, r[3])) {
     276:         cerror("Type of expression clashed with type of variable in assignment");
     277:         return (NIL);
     278:     }
     279:     switch (classify(p)) {
     280:         case TBOOL:
     281:         case TCHAR:
     282:         case TINT:
     283:         case TSCAL:
     284:             rangechk(p, p1);
     285:         case TDOUBLE:
     286:         case TPTR:
     287:             gen(O_AS2, O_AS2, width(p), width(p1));
     288:             break;
     289:         default:
     290:             put2(O_AS, width(p));
     291:     }
     292:     return (p); /* Used by for statement */
     293: }
     294:
     295: /*
     296:  * for var := expr [down]to expr do stat
     297:  */
     298: forop(r)
     299:     int *r;
     300: {
     301:     register struct nl *t1, *t2;
     302:     int l1, l2, l3;
     303:     long soffset;
     304:     register op;
     305:     struct nl *p;
     306:     int *rr, goc, i;
     307:
     308:     p = NIL;
     309:     goc = gocnt;
     310:     if (r == NIL)
     311:         goto aloha;
     312:     putline();
     313:     /*
     314: 	 * Start with assignment
     315: 	 * of initial value to for variable
     316: 	 */
     317:     t1 = asgnop1(r[2], NIL);
     318:     if (t1 == NIL) {
     319:         rvalue(r[3], NIL);
     320:         statement(r[4]);
     321:         goto aloha;
     322:     }
     323:     rr = r[2];      /* Assignment */
     324:     rr = rr[2];     /* Lhs variable */
     325:     if (rr[3] != NIL) {
     326:         error("For variable must be unqualified");
     327:         rvalue(r[3], NIL);
     328:         statement(r[4]);
     329:         goto aloha;
     330:     }
     331:     p = lookup(rr[2]);
     332:     p->value[NL_FORV] = 1;
     333:     if (isnta(t1, "bcis")) {
     334:         error("For variables cannot be %ss", nameof(t1));
     335:         statement(r[4]);
     336:         goto aloha;
     337:     }
     338:     /*
     339: 	 * Allocate automatic
     340: 	 * space for limit variable
     341: 	 */
     342:     sizes[cbn].om_off -= 4;
     343:     if (sizes[cbn].om_off < sizes[cbn].om_max)
     344:         sizes[cbn].om_max = sizes[cbn].om_off;
     345:     i = sizes[cbn].om_off;
     346:     /*
     347: 	 * Initialize the limit variable
     348: 	 */
     349:     put2(O_LV | cbn<<9, i);
     350:     t2 = rvalue(r[3], NIL);
     351:     if (incompat(t2, t1, r[3])) {
     352:         cerror("Limit type clashed with index type in 'for' statement");
     353:         statement(r[4]);
     354:         goto aloha;
     355:     }
     356:     put1(width(t2) <= 2 ? O_AS24 : O_AS4);
     357:     /*
     358: 	 * See if we can skip the loop altogether
     359: 	 */
     360:     rr = r[2];
     361:     if (rr != NIL)
     362:         rvalue(rr[2], NIL);
     363:     put2(O_RV4 | cbn<<9, i);
     364:     gen(NIL, r[0] == T_FORU ? T_LE : T_GE, width(t1), 4);
     365:     /*
     366: 	 * L1 will be patched to skip the body of the loop.
     367: 	 * L2 marks the top of the loop when we go around.
     368: 	 */
     369:     put2(O_IF, (l1 = getlab()));
     370:     putlab(l2 = getlab());
     371:     putcnt();
     372:     statement(r[4]);
     373:     /*
     374: 	 * now we see if we get to go again
     375: 	 */
     376:     if (opt('t') == 0) {
     377:         /*
     378: 		 * Easy if we dont have to test
     379: 		 */
     380:         put2(O_RV4 | cbn<<9, i);
     381:         if (rr != NIL)
     382:             lvalue(rr[2], MOD);
     383:         put2((r[0] == T_FORU ? O_FOR1U : O_FOR1D) + (width(t1) >> 1), l2);
     384:     } else {
     385:         line = r[1];
     386:         putline();
     387:         if (rr != NIL)
     388:             rvalue(rr[2], NIL);
     389:         put2(O_RV4 | cbn << 9, i);
     390:         gen(NIL, (r[0] == T_FORU ? T_LT : T_GT), width(t1), 4);
     391:         l3 = put2(O_IF, getlab());
     392:         lvalue((int *) rr[2], MOD);
     393:         rvalue(rr[2], NIL);
     394:         put2(O_CON2, 1);
     395:         t2 = gen(NIL, r[0] == T_FORU ? T_ADD: T_SUB, width(t1), 2);
     396:         rangechk(t1, t2);   /* The point of all this */
     397:         gen(O_AS2, O_AS2, width(t1), width(t2));
     398:         put2(O_TRA, l2);
     399:         patch(l3);
     400:     }
     401:     sizes[cbn].om_off += 4;
     402:     patch(l1);
     403: aloha:
     404:     noreach = 0;
     405:     if (p != NIL)
     406:         p->value[NL_FORV] = 0;
     407:     if (goc != gocnt)
     408:         putcnt();
     409: }
     410:
     411: /*
     412:  * if expr then stat [ else stat ]
     413:  */
     414: ifop(r)
     415:     int *r;
     416: {
     417:     register struct nl *p;
     418:     register l1, l2;
     419:     int nr, goc;
     420:
     421:     goc = gocnt;
     422:     if (r == NIL)
     423:         return;
     424:     putline();
     425:     p = rvalue(r[2], NIL);
     426:     if (p == NIL) {
     427:         statement(r[3]);
     428:         noreach = 0;
     429:         statement(r[4]);
     430:         noreach = 0;
     431:         return;
     432:     }
     433:     if (isnta(p, "b")) {
     434:         error("Type of expression in if statement must be Boolean, not %s", nameof(p));
     435:         statement(r[3]);
     436:         noreach = 0;
     437:         statement(r[4]);
     438:         noreach = 0;
     439:         return;
     440:     }
     441:     l1 = put2(O_IF, getlab());
     442:     putcnt();
     443:     statement(r[3]);
     444:     nr = noreach;
     445:     if (r[4] != NIL) {
     446:         /*
     447: 		 * else stat
     448: 		 */
     449:         --level;
     450:         ungoto();
     451:         ++level;
     452:         l2 = put2(O_TRA, getlab());
     453:         patch(l1);
     454:         noreach = 0;
     455:         statement(r[4]);
     456:         noreach &= nr;
     457:         l1 = l2;
     458:     } else
     459:         noreach = 0;
     460:     patch(l1);
     461:     if (goc != gocnt)
     462:         putcnt();
     463: }
     464:
     465: /*
     466:  * while expr do stat
     467:  */
     468: whilop(r)
     469:     int *r;
     470: {
     471:     register struct nl *p;
     472:     register l1, l2;
     473:     int goc;
     474:
     475:     goc = gocnt;
     476:     if (r == NIL)
     477:         return;
     478:     putlab(l1 = getlab());
     479:     putline();
     480:     p = rvalue(r[2], NIL);
     481:     if (p == NIL) {
     482:         statement(r[3]);
     483:         noreach = 0;
     484:         return;
     485:     }
     486:     if (isnta(p, "b")) {
     487:         error("Type of expression in while statement must be Boolean, not %s", nameof(p));
     488:         statement(r[3]);
     489:         noreach = 0;
     490:         return;
     491:     }
     492:     put2(O_IF, (l2 = getlab()));
     493:     putcnt();
     494:     statement(r[3]);
     495:     put2(O_TRA, l1);
     496:     patch(l2);
     497:     if (goc != gocnt)
     498:         putcnt();
     499: }
     500:
     501: /*
     502:  * repeat stat* until expr
     503:  */
     504: repop(r)
     505:     int *r;
     506: {
     507:     register struct nl *p;
     508:     register l;
     509:     int goc;
     510:
     511:     goc = gocnt;
     512:     if (r == NIL)
     513:         return;
     514:     l = putlab(getlab());
     515:     putcnt();
     516:     statlist(r[2]);
     517:     line = r[1];
     518:     p = rvalue(r[3], NIL);
     519:     if (p == NIL)
     520:         return;
     521:     if (isnta(p,"b")) {
     522:         error("Until expression type must be Boolean, not %s, in repeat statement", nameof(p));
     523:         return;
     524:     }
     525:     put2(O_IF, l);
     526:     if (goc != gocnt)
     527:         putcnt();
     528: }
     529:
     530: /*
     531:  * assert expr
     532:  */
     533: asrtop(r)
     534:     register int *r;
     535: {
     536:     register struct nl *q;
     537:
     538:     if (opt('s')) {
     539:         standard();
     540:         error("Assert statement is non-standard");
     541:     }
     542:     if (!opt('t'))
     543:         return;
     544:     r = r[2];
     545:     q = rvalue((int *) r, NLNIL);
     546:     if (q == NIL)
     547:         return;
     548:     if (isnta(q, "b"))
     549:         error("Assert expression must be Boolean, not %ss", nameof(q));
     550:     put1(O_ASRT);
     551: }

#### Defined functions

asgnop defined in line 208; used 1 times

- in line 69

asgnop1 defined in line 256; used 5 times

- in line 241-247(3), 317
- in /usr/src/ucb/pascal/pi/0.h line 632

asrtop defined in line 533; used 1 times

- in line 110

forop defined in line 298; used 1 times

- in line 95

ifop defined in line 414; used 1 times

- in line 84

putcnt defined in line 140; used 12 times

- in line 45, 371, 408, 442, 462, 493-498(2), 515, 527
- in /usr/src/ucb/pascal/pi/case.c line 174, 190
- in /usr/src/ucb/pascal/pi/fdec.c line 219

putline defined in line 149; used 10 times

- in line 64-72(3), 102, 109, 175, 312, 386, 424, 479

repop defined in line 504; used 1 times

- in line 91

statement defined in line 34; used 17 times

- in line 28, 199, 320, 328, 335, 353, 372, 427-429(2), 435-437(2), 443, 455, 482, 488, 494
- in /usr/src/ucb/pascal/pi/case.c line 176

statlist defined in line 22; used 3 times

- in line 99, 516
- in /usr/src/ucb/pascal/pi/fdec.c line 378

ungoto defined in line 125; used 3 times

- in line 115, 450
- in /usr/src/ucb/pascal/pi/case.c line 182

whilop defined in line 468; used 1 times

- in line 87

withop defined in line 166; used 1 times

- in line 106

#### Defined variables

cnts defined in line 16; used 2 times

- in line 145-146(2)

cntstat defined in line 15; used 4 times

- in line 43-44(2), 54, 75

Last modified: 1981-07-10 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 1319 |