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