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
asrtop defined in line 533; used 1 times
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
putline defined in line 149; used 10 times
repop defined in line 504; used 1 times
  • in line 91
statement defined in line 34; used 17 times
statlist defined in line 22; used 3 times
ungoto defined in line 125; used 3 times
whilop defined in line 468; used 1 times
  • in line 87
withop defined in line 166; used 1 times

Defined variables

cnts defined in line 16; used 2 times
cntstat defined in line 15; used 4 times
Last modified: 1981-07-10
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 3202
Valid CSS Valid XHTML 1.0 Strict