|
|
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: ! 13: /* ! 14: * Declare variables of a var part. DPOFF1 is ! 15: * the local variable storage for all prog/proc/func ! 16: * modules aside from the block mark. The total size ! 17: * of all the local variables is entered into the ! 18: * size array. ! 19: */ ! 20: varbeg() ! 21: { ! 22: ! 23: #ifndef PI1 ! 24: if (parts & VPRT) ! 25: error("All variables must be declared in one var part"); ! 26: parts |= VPRT; ! 27: #endif ! 28: #ifndef PI0 ! 29: sizes[cbn].om_max = sizes[cbn].om_off = -DPOFF1; ! 30: #endif ! 31: forechain = NIL; ! 32: #ifdef PI0 ! 33: send(REVVBEG); ! 34: #endif ! 35: } ! 36: ! 37: var(vline, vidl, vtype) ! 38: #ifdef PI0 ! 39: int vline, *vidl, *vtype; ! 40: { ! 41: register struct nl *np; ! 42: register int *vl; ! 43: ! 44: np = gtype(vtype); ! 45: line = vline; ! 46: for (vl = vidl; vl != NIL; vl = vl[2]) ! 47: enter(defnl(vl[1], VAR, np, 0)); ! 48: send(REVVAR, vline, vidl, vtype); ! 49: } ! 50: #else ! 51: int vline; ! 52: register int *vidl; ! 53: int *vtype; ! 54: { ! 55: register struct nl *np; ! 56: register struct om *op; ! 57: long w; ! 58: int o2; ! 59: int *ovidl = vidl; ! 60: ! 61: np = gtype(vtype); ! 62: line = vline; ! 63: w = (lwidth(np) + 1) &~ 1; ! 64: op = &sizes[cbn]; ! 65: for (; vidl != NIL; vidl = vidl[2]) { ! 66: op->om_off -= w; ! 67: o2 = op->om_off; ! 68: enter(defnl(vidl[1], VAR, np, o2)); ! 69: } ! 70: # ifdef PTREE ! 71: { ! 72: pPointer *Vars; ! 73: pPointer Var = VarDecl( ovidl , vtype ); ! 74: ! 75: pSeize( PorFHeader[ nesting ] ); ! 76: Vars = &( pDEF( PorFHeader[ nesting ] ).PorFVars ); ! 77: *Vars = ListAppend( *Vars , Var ); ! 78: pRelease( PorFHeader[ nesting ] ); ! 79: } ! 80: # endif ! 81: } ! 82: #endif ! 83: ! 84: varend() ! 85: { ! 86: ! 87: foredecl(); ! 88: #ifndef PI0 ! 89: sizes[cbn].om_max = sizes[cbn].om_off; ! 90: #else ! 91: send(REVVEND); ! 92: #endif ! 93: } ! 94: ! 95: /* ! 96: * Evening ! 97: */ ! 98: even(w) ! 99: register int w; ! 100: { ! 101: if (w < 0) ! 102: return (w & ~1); ! 103: return ((w+1) & ~1); ! 104: } ! 105: ! 106: /* ! 107: * Find the width of a type in bytes. ! 108: */ ! 109: width(np) ! 110: struct nl *np; ! 111: { ! 112: ! 113: return (lwidth(np)); ! 114: } ! 115: ! 116: long lwidth(np) ! 117: struct nl *np; ! 118: { ! 119: register struct nl *p; ! 120: long w; ! 121: ! 122: p = np; ! 123: if (p == NIL) ! 124: return (0); ! 125: loop: ! 126: switch (p->class) { ! 127: case TYPE: ! 128: switch (nloff(p)) { ! 129: case TNIL: ! 130: return (2); ! 131: case TSTR: ! 132: case TSET: ! 133: panic("width"); ! 134: default: ! 135: p = p->type; ! 136: goto loop; ! 137: } ! 138: case ARRAY: ! 139: return (aryconst(p, 0)); ! 140: case PTR: ! 141: case FILET: ! 142: return ( sizeof ( int * ) ); ! 143: case RANGE: ! 144: if (p->type == nl+TDOUBLE) ! 145: #ifdef DEBUG ! 146: return (hp21mx ? 4 : 8); ! 147: #else ! 148: return (8); ! 149: #endif ! 150: case SCAL: ! 151: return (bytes(p->range[0], p->range[1])); ! 152: case SET: ! 153: setran(p->type); ! 154: return ( (set.uprbp>>3) + 1); ! 155: case STR: ! 156: case RECORD: ! 157: return ( p->value[NL_OFFS] ); ! 158: default: ! 159: panic("wclass"); ! 160: } ! 161: } ! 162: ! 163: /* ! 164: * Return the width of an element ! 165: * of a n time subscripted np. ! 166: */ ! 167: long aryconst(np, n) ! 168: struct nl *np; ! 169: int n; ! 170: { ! 171: register struct nl *p; ! 172: long s, d; ! 173: ! 174: if ((p = np) == NIL) ! 175: return (NIL); ! 176: if (p->class != ARRAY) ! 177: panic("ary"); ! 178: s = width(p->type); ! 179: /* ! 180: * Arrays of anything but characters are word aligned. ! 181: */ ! 182: if (s & 1) ! 183: if (s != 1) ! 184: s++; ! 185: /* ! 186: * Skip the first n subscripts ! 187: */ ! 188: while (n >= 0) { ! 189: p = p->chain; ! 190: n--; ! 191: } ! 192: /* ! 193: * Sum across remaining subscripts. ! 194: */ ! 195: while (p != NIL) { ! 196: if (p->class != RANGE && p->class != SCAL) ! 197: panic("aryran"); ! 198: d = p->range[1] - p->range[0] + 1; ! 199: s *= d; ! 200: p = p->chain; ! 201: } ! 202: return (s); ! 203: } ! 204: ! 205: /* ! 206: * Find the lower bound of a set, and also its size in bits. ! 207: */ ! 208: setran(q) ! 209: struct nl *q; ! 210: { ! 211: register lb, ub; ! 212: register struct nl *p; ! 213: ! 214: p = q; ! 215: if (p == NIL) ! 216: return (NIL); ! 217: lb = p->range[0]; ! 218: ub = p->range[1]; ! 219: if (p->class != RANGE && p->class != SCAL) ! 220: panic("setran"); ! 221: set.lwrb = lb; ! 222: /* set.(upperbound prime) = number of bits - 1; */ ! 223: set.uprbp = ub-lb; ! 224: } ! 225: ! 226: /* ! 227: * Return the number of bytes required to hold an arithmetic quantity ! 228: */ ! 229: bytes(lb, ub) ! 230: long lb, ub; ! 231: { ! 232: ! 233: #ifndef DEBUG ! 234: if (lb < -32768 || ub > 32767) ! 235: return (4); ! 236: else if (lb < -128 || ub > 127) ! 237: return (2); ! 238: #else ! 239: if (!hp21mx && (lb < -32768 || ub > 32767)) ! 240: return (4); ! 241: if (lb < -128 || ub > 127) ! 242: return (2); ! 243: #endif ! 244: else ! 245: return (1); ! 246: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.