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: }
|
Last modified: 1981-07-10
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 3453 |
|