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