|
|
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: #include "opcode.h" ! 14: ! 15: /* ! 16: * The structure used to ! 17: * hold information about ! 18: * each case label. ! 19: */ ! 20: struct ct { ! 21: long clong; ! 22: int cline; ! 23: }; ! 24: ! 25: /* ! 26: * Caseop generates the ! 27: * pascal case statement code ! 28: */ ! 29: caseop(r) ! 30: int *r; ! 31: { ! 32: register struct nl *p; ! 33: register struct ct *ctab; ! 34: register *cs; ! 35: int *cl; ! 36: double low, high; ! 37: short *brtab; ! 38: char *brtab0; ! 39: char *csend; ! 40: int w, i, j, m, n; ! 41: int nr, goc; ! 42: ! 43: goc = gocnt; ! 44: /* ! 45: * Obtain selector attributes: ! 46: * p type ! 47: * w width ! 48: * low lwb(p) ! 49: * high upb(p) ! 50: */ ! 51: p = rvalue((int *) r[2], NLNIL); ! 52: if (p != NIL) { ! 53: if (isnta(p, "bcsi")) { ! 54: error("Case selectors cannot be %ss", nameof(p)); ! 55: p = NIL; ! 56: } else { ! 57: cl = p; ! 58: if (p->class != RANGE) ! 59: cl = p->type; ! 60: if (cl == NIL) ! 61: p = NIL; ! 62: else { ! 63: w = width(p); ! 64: #ifdef DEBUG ! 65: if (hp21mx) ! 66: w = 2; ! 67: #endif ! 68: low = cl->range[0]; ! 69: high = cl->range[1]; ! 70: } ! 71: } ! 72: } ! 73: /* ! 74: * Count # of cases ! 75: */ ! 76: n = 0; ! 77: for (cl = r[3]; cl != NIL; cl = cl[2]) { ! 78: cs = cl[1]; ! 79: if (cs == NIL) ! 80: continue; ! 81: for (cs = cs[2]; cs != NIL; cs = cs[2]) ! 82: n++; ! 83: } ! 84: /* ! 85: * Allocate case table space ! 86: */ ! 87: ctab = i = malloc(n * sizeof *ctab); ! 88: if (i == -1) { ! 89: error("Ran out of memory (case)"); ! 90: pexit(DIED); ! 91: } ! 92: /* ! 93: * Check the legality of the ! 94: * labels and count the number ! 95: * of good labels ! 96: */ ! 97: m = 0; ! 98: for (cl = r[3]; cl != NIL; cl = cl[2]) { ! 99: cs = cl[1]; ! 100: if (cs == NIL) ! 101: continue; ! 102: line = cs[1]; ! 103: for (cs = cs[2]; cs != NIL; cs = cs[2]) { ! 104: gconst(cs[1]); ! 105: if (p == NIL || con.ctype == NIL) ! 106: continue; ! 107: if (incompat(con.ctype, p, NIL)) { ! 108: cerror("Case label type clashed with case selector expression type"); ! 109: continue; ! 110: } ! 111: if (con.crval < low || con.crval > high) { ! 112: error("Case label out of range"); ! 113: continue; ! 114: } ! 115: ctab[m].clong = con.crval; ! 116: ctab[m].cline = line; ! 117: m++; ! 118: } ! 119: } ! 120: ! 121: /* ! 122: * Check for duplicate labels ! 123: */ ! 124: for (i = 0; i < m; i++) ! 125: for (j = 0; j < m; j++) ! 126: if (ctab[i].clong == ctab[j].clong) { ! 127: if (i == j) ! 128: continue; ! 129: if (j < i) ! 130: break; ! 131: error("Multiply defined label in case, lines %d and %d", ctab[i].cline, ctab[j].cline); ! 132: } ! 133: /* ! 134: * Put out case operator and ! 135: * leave space for the ! 136: * branch table ! 137: */ ! 138: if (p != NIL) { ! 139: put2(O_CASE1OP + (w >> 1), n); ! 140: brtab = brtab0 = lc; ! 141: putspace(n * 2); ! 142: put1(O_CASEBEG); ! 143: for (i=0; i<m; i++) ! 144: put( 3 , O_CASE1 + (w >> 1), ctab[i].clong); ! 145: put1(O_CASEEND); ! 146: } ! 147: csend = getlab(); ! 148: put2(O_TRA, csend); ! 149: /* ! 150: * Free the case ! 151: * table space. ! 152: */ ! 153: free(ctab); ! 154: /* ! 155: * Generate code for each ! 156: * statement. Patch branch ! 157: * table to beginning of each ! 158: * statement and follow each ! 159: * statement with a branch back ! 160: * to the TRA above. ! 161: */ ! 162: nr = 1; ! 163: for (cl = r[3]; cl != NIL; cl = cl[2]) { ! 164: cs = cl[1]; ! 165: if (cs == NIL) ! 166: continue; ! 167: if (p != NIL) ! 168: for (cs = cs[2]; cs != NIL; cs = cs[2]) { ! 169: patchfil(brtab - 1, lc - brtab0, 1); ! 170: brtab++; ! 171: } ! 172: cs = cl[1]; ! 173: putcnt(); ! 174: level++; ! 175: statement(cs[3]); ! 176: nr &= noreach; ! 177: noreach = 0; ! 178: put2(O_TRA, csend); ! 179: level--; ! 180: if (gotos[cbn]) ! 181: ungoto(); ! 182: } ! 183: /* ! 184: * Patch the termination branch ! 185: */ ! 186: patch(csend); ! 187: noreach = nr; ! 188: if (goc != gocnt) ! 189: putcnt(); ! 190: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.