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