![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to conv.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 conv.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: #ifdef PI ! 12: #include "0.h" ! 13: #include "opcode.h" ! 14: ! 15: #ifndef PI0 ! 16: /* ! 17: * Convert a p1 into a p2. ! 18: * Mostly used for different ! 19: * length integers and "to real" conversions. ! 20: */ ! 21: convert(p1, p2) ! 22: struct nl *p1, *p2; ! 23: { ! 24: if (p1 == NIL || p2 == NIL) ! 25: return; ! 26: switch (width(p1) - width(p2)) { ! 27: case -7: ! 28: case -6: ! 29: put1(O_STOD); ! 30: return; ! 31: case -4: ! 32: put1(O_ITOD); ! 33: return; ! 34: case -3: ! 35: case -2: ! 36: put1(O_STOI); ! 37: return; ! 38: case -1: ! 39: case 0: ! 40: case 1: ! 41: return; ! 42: case 2: ! 43: case 3: ! 44: put1(O_ITOS); ! 45: return; ! 46: default: ! 47: panic("convert"); ! 48: } ! 49: } ! 50: #endif ! 51: ! 52: /* ! 53: * Compat tells whether ! 54: * p1 and p2 are compatible ! 55: * types for an assignment like ! 56: * context, i.e. value parameters, ! 57: * indicies for 'in', etc. ! 58: */ ! 59: compat(p1, p2, t) ! 60: struct nl *p1, *p2; ! 61: { ! 62: register c1, c2; ! 63: ! 64: c1 = classify(p1); ! 65: if (c1 == NIL) ! 66: return (NIL); ! 67: c2 = classify(p2); ! 68: if (c2 == NIL) ! 69: return (NIL); ! 70: switch (c1) { ! 71: case TBOOL: ! 72: case TCHAR: ! 73: if (c1 == c2) ! 74: return (1); ! 75: break; ! 76: case TINT: ! 77: if (c2 == TINT) ! 78: return (1); ! 79: case TDOUBLE: ! 80: if (c2 == TDOUBLE) ! 81: return (1); ! 82: #ifndef PI0 ! 83: if (c2 == TINT && divflg == 0) { ! 84: divchk= 1; ! 85: c1 = classify(rvalue(t, NLNIL)); ! 86: divchk = NIL; ! 87: if (c1 == TINT) { ! 88: error("Type clash: real is incompatible with integer"); ! 89: cerror("This resulted because you used '/' which always returns real rather"); ! 90: cerror("than 'div' which divides integers and returns integers"); ! 91: divflg = 1; ! 92: return (NIL); ! 93: } ! 94: } ! 95: #endif ! 96: break; ! 97: case TSCAL: ! 98: if (c2 != TSCAL) ! 99: break; ! 100: if (scalar(p1) != scalar(p2)) { ! 101: derror("Type clash: non-identical scalar types"); ! 102: return (NIL); ! 103: } ! 104: return (1); ! 105: case TSTR: ! 106: if (c2 != TSTR) ! 107: break; ! 108: if (width(p1) != width(p2)) { ! 109: derror("Type clash: unequal length strings"); ! 110: return (NIL); ! 111: } ! 112: return (1); ! 113: case TNIL: ! 114: if (c2 != TPTR) ! 115: break; ! 116: return (1); ! 117: case TFILE: ! 118: if (c1 != c2) ! 119: break; ! 120: derror("Type clash: files not allowed in this context"); ! 121: return (NIL); ! 122: default: ! 123: if (c1 != c2) ! 124: break; ! 125: if (p1 != p2) { ! 126: derror("Type clash: non-identical %s types", clnames[c1]); ! 127: return (NIL); ! 128: } ! 129: if (p1->nl_flags & NFILES) { ! 130: derror("Type clash: %ss with file components not allowed in this context", clnames[c1]); ! 131: return (NIL); ! 132: } ! 133: return (1); ! 134: } ! 135: derror("Type clash: %s is incompatible with %s", clnames[c1], clnames[c2]); ! 136: return (NIL); ! 137: } ! 138: ! 139: #ifndef PI0 ! 140: /* ! 141: * Rangechk generates code to ! 142: * check if the type p on top ! 143: * of the stack is in range for ! 144: * assignment to a variable ! 145: * of type q. ! 146: */ ! 147: rangechk(p, q) ! 148: struct nl *p, *q; ! 149: { ! 150: register struct nl *rp; ! 151: register op; ! 152: int wq, wrp; ! 153: ! 154: if (opt('t') == 0) ! 155: return; ! 156: rp = p; ! 157: if (rp == NIL) ! 158: return; ! 159: if (q == NIL) ! 160: return; ! 161: /* ! 162: * When op is 1 we are checking length ! 163: * 4 numbers against length 2 bounds, ! 164: * and adding it to the opcode forces ! 165: * generation of appropriate tests. ! 166: */ ! 167: op = 0; ! 168: wq = width(q); ! 169: wrp = width(rp); ! 170: op = wq != wrp && (wq == 4 || wrp == 4); ! 171: if (rp->class == TYPE) ! 172: rp = rp->type; ! 173: switch (rp->class) { ! 174: case RANGE: ! 175: if (rp->range[0] != 0) { ! 176: # ifndef DEBUG ! 177: if (wrp <= 2) ! 178: put3(O_RANG2+op, ( short ) rp->range[0], ! 179: ( short ) rp->range[1]); ! 180: else if (rp != nl+T4INT) ! 181: put(5, O_RANG4+op, rp->range[0], rp->range[1] ); ! 182: # else ! 183: if (!hp21mx) { ! 184: if (wrp <= 2) ! 185: put3(O_RANG2+op,( short ) rp->range[0], ! 186: ( short ) rp->range[1]); ! 187: else if (rp != nl+T4INT) ! 188: put(5,O_RANG4+op,rp->range[0], ! 189: rp->range[1]); ! 190: } else ! 191: if (rp != nl+T2INT && rp != nl+T4INT) ! 192: put3(O_RANG2+op,( short ) rp->range[0], ! 193: ( short ) rp->range[1]); ! 194: # endif ! 195: break; ! 196: } ! 197: /* ! 198: * Range whose lower bounds are ! 199: * zero can be treated as scalars. ! 200: */ ! 201: case SCAL: ! 202: if (wrp <= 2) ! 203: put2(O_RSNG2+op, ( short ) rp->range[1]); ! 204: else ! 205: put( 3 , O_RSNG4+op, rp->range[1]); ! 206: break; ! 207: default: ! 208: panic("rangechk"); ! 209: } ! 210: } ! 211: #endif ! 212: #endif ! 213: ! 214: #ifdef DEBUG ! 215: conv(dub) ! 216: int *dub; ! 217: { ! 218: int newfp[2]; ! 219: double *dp = dub; ! 220: long *lp = dub; ! 221: register int exp; ! 222: long mant; ! 223: ! 224: newfp[0] = dub[0] & 0100000; ! 225: newfp[1] = 0; ! 226: if (*dp == 0.0) ! 227: goto ret; ! 228: exp = ((dub[0] >> 7) & 0377) - 0200; ! 229: if (exp < 0) { ! 230: newfp[1] = 1; ! 231: exp = -exp; ! 232: } ! 233: if (exp > 63) ! 234: exp = 63; ! 235: dub[0] &= ~0177600; ! 236: dub[0] |= 0200; ! 237: mant = *lp; ! 238: mant <<= 8; ! 239: if (newfp[0]) ! 240: mant = -mant; ! 241: newfp[0] |= (mant >> 17) & 077777; ! 242: newfp[1] |= (((int) (mant >> 1)) & 0177400) | (exp << 1); ! 243: ret: ! 244: dub[0] = newfp[0]; ! 245: dub[1] = newfp[1]; ! 246: } ! 247: #endif
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.