![[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] / 43BSDTahoe / ucb / pascal / src|
Return to conv.c CVS log | Up to [CSRG BSD Unix] / 43BSDTahoe / ucb / pascal / src |
1.1 ! root 1: /* ! 2: * Copyright (c) 1980 Regents of the University of California. ! 3: * All rights reserved. The Berkeley software License Agreement ! 4: * specifies the terms and conditions for redistribution. ! 5: */ ! 6: ! 7: #ifndef lint ! 8: static char sccsid[] = "@(#)conv.c 5.1 (Berkeley) 6/5/85"; ! 9: #endif not lint ! 10: ! 11: #include "whoami.h" ! 12: #ifdef PI ! 13: #include "0.h" ! 14: #include "opcode.h" ! 15: #ifdef PC ! 16: # include <pcc.h> ! 17: #endif PC ! 18: #include "tree_ty.h" ! 19: ! 20: #ifndef PC ! 21: #ifndef PI0 ! 22: /* ! 23: * Convert a p1 into a p2. ! 24: * Mostly used for different ! 25: * length integers and "to real" conversions. ! 26: */ ! 27: convert(p1, p2) ! 28: struct nl *p1, *p2; ! 29: { ! 30: if (p1 == NLNIL || p2 == NLNIL) ! 31: return; ! 32: switch (width(p1) - width(p2)) { ! 33: case -7: ! 34: case -6: ! 35: (void) put(1, O_STOD); ! 36: return; ! 37: case -4: ! 38: (void) put(1, O_ITOD); ! 39: return; ! 40: case -3: ! 41: case -2: ! 42: (void) put(1, O_STOI); ! 43: return; ! 44: case -1: ! 45: case 0: ! 46: case 1: ! 47: return; ! 48: case 2: ! 49: case 3: ! 50: (void) put(1, O_ITOS); ! 51: return; ! 52: default: ! 53: panic("convert"); ! 54: } ! 55: } ! 56: #endif ! 57: #endif PC ! 58: ! 59: /* ! 60: * Compat tells whether ! 61: * p1 and p2 are compatible ! 62: * types for an assignment like ! 63: * context, i.e. value parameters, ! 64: * indicies for 'in', etc. ! 65: */ ! 66: compat(p1, p2, t) ! 67: struct nl *p1, *p2; ! 68: struct tnode *t; ! 69: { ! 70: register c1, c2; ! 71: ! 72: c1 = classify(p1); ! 73: if (c1 == NIL) ! 74: return (NIL); ! 75: c2 = classify(p2); ! 76: if (c2 == NIL) ! 77: return (NIL); ! 78: switch (c1) { ! 79: case TBOOL: ! 80: case TCHAR: ! 81: if (c1 == c2) ! 82: return (1); ! 83: break; ! 84: case TINT: ! 85: if (c2 == TINT) ! 86: return (1); ! 87: case TDOUBLE: ! 88: if (c2 == TDOUBLE) ! 89: return (1); ! 90: #ifndef PI0 ! 91: if (c2 == TINT && divflg == FALSE && t != TR_NIL ) { ! 92: divchk= TRUE; ! 93: c1 = classify(rvalue(t, NLNIL , RREQ )); ! 94: divchk = FALSE; ! 95: if (c1 == TINT) { ! 96: error("Type clash: real is incompatible with integer"); ! 97: cerror("This resulted because you used '/' which always returns real rather"); ! 98: cerror("than 'div' which divides integers and returns integers"); ! 99: divflg = TRUE; ! 100: return (NIL); ! 101: } ! 102: } ! 103: #endif ! 104: break; ! 105: case TSCAL: ! 106: if (c2 != TSCAL) ! 107: break; ! 108: if (scalar(p1) != scalar(p2)) { ! 109: derror("Type clash: non-identical scalar types"); ! 110: return (NIL); ! 111: } ! 112: return (1); ! 113: case TSTR: ! 114: if (c2 != TSTR) ! 115: break; ! 116: if (width(p1) != width(p2)) { ! 117: derror("Type clash: unequal length strings"); ! 118: return (NIL); ! 119: } ! 120: return (1); ! 121: case TNIL: ! 122: if (c2 != TPTR) ! 123: break; ! 124: return (1); ! 125: case TFILE: ! 126: if (c1 != c2) ! 127: break; ! 128: derror("Type clash: files not allowed in this context"); ! 129: return (NIL); ! 130: default: ! 131: if (c1 != c2) ! 132: break; ! 133: if (p1 != p2) { ! 134: derror("Type clash: non-identical %s types", clnames[c1]); ! 135: return (NIL); ! 136: } ! 137: if (p1->nl_flags & NFILES) { ! 138: derror("Type clash: %ss with file components not allowed in this context", clnames[c1]); ! 139: return (NIL); ! 140: } ! 141: return (1); ! 142: } ! 143: derror("Type clash: %s is incompatible with %s", clnames[c1], clnames[c2]); ! 144: return (NIL); ! 145: } ! 146: ! 147: #ifndef PI0 ! 148: #ifndef PC ! 149: /* ! 150: * Rangechk generates code to ! 151: * check if the type p on top ! 152: * of the stack is in range for ! 153: * assignment to a variable ! 154: * of type q. ! 155: */ ! 156: rangechk(p, q) ! 157: struct nl *p, *q; ! 158: { ! 159: register struct nl *rp; ! 160: #ifdef OBJ ! 161: register op; ! 162: int wq, wrp; ! 163: #endif ! 164: ! 165: if (opt('t') == 0) ! 166: return; ! 167: rp = p; ! 168: if (rp == NIL) ! 169: return; ! 170: if (q == NIL) ! 171: return; ! 172: # ifdef OBJ ! 173: /* ! 174: * When op is 1 we are checking length ! 175: * 4 numbers against length 2 bounds, ! 176: * and adding it to the opcode forces ! 177: * generation of appropriate tests. ! 178: */ ! 179: op = 0; ! 180: wq = width(q); ! 181: wrp = width(rp); ! 182: op = wq != wrp && (wq == 4 || wrp == 4); ! 183: if (rp->class == TYPE || rp->class == CRANGE) ! 184: rp = rp->type; ! 185: switch (rp->class) { ! 186: case RANGE: ! 187: if (rp->range[0] != 0) { ! 188: # ifndef DEBUG ! 189: if (wrp <= 2) ! 190: (void) put(3, O_RANG2+op, ( short ) rp->range[0], ! 191: ( short ) rp->range[1]); ! 192: else if (rp != nl+T4INT) ! 193: (void) put(3, O_RANG4+op, rp->range[0], rp->range[1] ); ! 194: # else ! 195: if (!hp21mx) { ! 196: if (wrp <= 2) ! 197: (void) put(3, O_RANG2+op,( short ) rp->range[0], ! 198: ( short ) rp->range[1]); ! 199: else if (rp != nl+T4INT) ! 200: (void) put(3, O_RANG4+op,rp->range[0], ! 201: rp->range[1]); ! 202: } else ! 203: if (rp != nl+T2INT && rp != nl+T4INT) ! 204: (void) put(3, O_RANG2+op,( short ) rp->range[0], ! 205: ( short ) rp->range[1]); ! 206: # endif ! 207: break; ! 208: } ! 209: /* ! 210: * Range whose lower bounds are ! 211: * zero can be treated as scalars. ! 212: */ ! 213: case SCAL: ! 214: if (wrp <= 2) ! 215: (void) put(2, O_RSNG2+op, ( short ) rp->range[1]); ! 216: else ! 217: (void) put( 2 , O_RSNG4+op, rp->range[1]); ! 218: break; ! 219: default: ! 220: panic("rangechk"); ! 221: } ! 222: # endif OBJ ! 223: # ifdef PC ! 224: /* ! 225: * pc uses precheck() and postcheck(). ! 226: */ ! 227: panic("rangechk()"); ! 228: # endif PC ! 229: } ! 230: #endif ! 231: #endif ! 232: #endif ! 233: ! 234: #ifdef PC ! 235: /* ! 236: * if type p requires a range check, ! 237: * then put out the name of the checking function ! 238: * for the beginning of a function call which is completed by postcheck. ! 239: * (name1 is for a full check; name2 assumes a lower bound of zero) ! 240: */ ! 241: precheck( p , name1 , name2 ) ! 242: struct nl *p; ! 243: char *name1 , *name2; ! 244: { ! 245: ! 246: if ( opt( 't' ) == 0 ) { ! 247: return; ! 248: } ! 249: if ( p == NIL ) { ! 250: return; ! 251: } ! 252: if ( p -> class == TYPE ) { ! 253: p = p -> type; ! 254: } ! 255: switch ( p -> class ) { ! 256: case CRANGE: ! 257: putleaf( PCC_ICON , 0 , 0 , PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR ) ! 258: , name1); ! 259: break; ! 260: case RANGE: ! 261: if ( p != nl + T4INT ) { ! 262: putleaf( PCC_ICON , 0 , 0 , ! 263: PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR ), ! 264: p -> range[0] != 0 ? name1 : name2 ); ! 265: } ! 266: break; ! 267: case SCAL: ! 268: /* ! 269: * how could a scalar ever be out of range? ! 270: */ ! 271: break; ! 272: default: ! 273: panic( "precheck" ); ! 274: break; ! 275: } ! 276: } ! 277: ! 278: /* ! 279: * if type p requires a range check, ! 280: * then put out the rest of the arguments of to the checking function ! 281: * a call to which was started by precheck. ! 282: * the first argument is what is being rangechecked (put out by rvalue), ! 283: * the second argument is the lower bound of the range, ! 284: * the third argument is the upper bound of the range. ! 285: */ ! 286: postcheck(need, have) ! 287: struct nl *need; ! 288: struct nl *have; ! 289: { ! 290: struct nl *p; ! 291: ! 292: if ( opt( 't' ) == 0 ) { ! 293: return; ! 294: } ! 295: if ( need == NIL ) { ! 296: return; ! 297: } ! 298: if ( need -> class == TYPE ) { ! 299: need = need -> type; ! 300: } ! 301: switch ( need -> class ) { ! 302: case RANGE: ! 303: if ( need != nl + T4INT ) { ! 304: sconv(p2type(have), PCCT_INT); ! 305: if (need -> range[0] != 0 ) { ! 306: putleaf( PCC_ICON , (int) need -> range[0] , 0 , PCCT_INT , ! 307: (char *) 0 ); ! 308: putop( PCC_CM , PCCT_INT ); ! 309: } ! 310: putleaf( PCC_ICON , (int) need -> range[1] , 0 , PCCT_INT , ! 311: (char *) 0 ); ! 312: putop( PCC_CM , PCCT_INT ); ! 313: putop( PCC_CALL , PCCT_INT ); ! 314: sconv(PCCT_INT, p2type(have)); ! 315: } ! 316: break; ! 317: case CRANGE: ! 318: sconv(p2type(have), PCCT_INT); ! 319: p = need->nptr[0]; ! 320: putRV(p->symbol, (p->nl_block & 037), p->value[0], ! 321: p->extra_flags, p2type( p ) ); ! 322: putop( PCC_CM , PCCT_INT ); ! 323: p = need->nptr[1]; ! 324: putRV(p->symbol, (p->nl_block & 037), p->value[0], ! 325: p->extra_flags, p2type( p ) ); ! 326: putop( PCC_CM , PCCT_INT ); ! 327: putop( PCC_CALL , PCCT_INT ); ! 328: sconv(PCCT_INT, p2type(have)); ! 329: break; ! 330: case SCAL: ! 331: break; ! 332: default: ! 333: panic( "postcheck" ); ! 334: break; ! 335: } ! 336: } ! 337: #endif PC ! 338: ! 339: #ifdef DEBUG ! 340: conv(dub) ! 341: int *dub; ! 342: { ! 343: int newfp[2]; ! 344: double *dp = ((double *) dub); ! 345: long *lp = ((long *) dub); ! 346: register int exp; ! 347: long mant; ! 348: ! 349: newfp[0] = dub[0] & 0100000; ! 350: newfp[1] = 0; ! 351: if (*dp == 0.0) ! 352: goto ret; ! 353: exp = ((dub[0] >> 7) & 0377) - 0200; ! 354: if (exp < 0) { ! 355: newfp[1] = 1; ! 356: exp = -exp; ! 357: } ! 358: if (exp > 63) ! 359: exp = 63; ! 360: dub[0] &= ~0177600; ! 361: dub[0] |= 0200; ! 362: mant = *lp; ! 363: mant <<= 8; ! 364: if (newfp[0]) ! 365: mant = -mant; ! 366: newfp[0] |= (mant >> 17) & 077777; ! 367: newfp[1] |= (((int) (mant >> 1)) & 0177400) | (exp << 1); ! 368: ret: ! 369: dub[0] = newfp[0]; ! 370: dub[1] = newfp[1]; ! 371: } ! 372: #endif
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.