1 /* Copyright (c) 1979 Regents of the University of California */ 2 3 #ifndef lint 4 static char sccsid[] = "@(#)conv.c 2.2 03/20/85"; 5 #endif 6 7 #include "whoami.h" 8 #ifdef PI 9 #include "0.h" 10 #include "opcode.h" 11 #ifdef PC 12 # include <pcc.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 || rp->class == CRANGE) 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 CRANGE: 253 putleaf( PCC_ICON , 0 , 0 , PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR ) 254 , name1); 255 break; 256 case RANGE: 257 if ( p != nl + T4INT ) { 258 putleaf( PCC_ICON , 0 , 0 , 259 PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR ), 260 p -> range[0] != 0 ? name1 : name2 ); 261 } 262 break; 263 case SCAL: 264 /* 265 * how could a scalar ever be out of range? 266 */ 267 break; 268 default: 269 panic( "precheck" ); 270 break; 271 } 272 } 273 274 /* 275 * if type p requires a range check, 276 * then put out the rest of the arguments of to the checking function 277 * a call to which was started by precheck. 278 * the first argument is what is being rangechecked (put out by rvalue), 279 * the second argument is the lower bound of the range, 280 * the third argument is the upper bound of the range. 281 */ 282 postcheck(need, have) 283 struct nl *need; 284 struct nl *have; 285 { 286 struct nl *p; 287 288 if ( opt( 't' ) == 0 ) { 289 return; 290 } 291 if ( need == NIL ) { 292 return; 293 } 294 if ( need -> class == TYPE ) { 295 need = need -> type; 296 } 297 switch ( need -> class ) { 298 case RANGE: 299 if ( need != nl + T4INT ) { 300 sconv(p2type(have), PCCT_INT); 301 if (need -> range[0] != 0 ) { 302 putleaf( PCC_ICON , (int) need -> range[0] , 0 , PCCT_INT , 303 (char *) 0 ); 304 putop( PCC_CM , PCCT_INT ); 305 } 306 putleaf( PCC_ICON , (int) need -> range[1] , 0 , PCCT_INT , 307 (char *) 0 ); 308 putop( PCC_CM , PCCT_INT ); 309 putop( PCC_CALL , PCCT_INT ); 310 sconv(PCCT_INT, p2type(have)); 311 } 312 break; 313 case CRANGE: 314 sconv(p2type(have), PCCT_INT); 315 p = need->nptr[0]; 316 putRV(p->symbol, (p->nl_block & 037), p->value[0], 317 p->extra_flags, p2type( p ) ); 318 putop( PCC_CM , PCCT_INT ); 319 p = need->nptr[1]; 320 putRV(p->symbol, (p->nl_block & 037), p->value[0], 321 p->extra_flags, p2type( p ) ); 322 putop( PCC_CM , PCCT_INT ); 323 putop( PCC_CALL , PCCT_INT ); 324 sconv(PCCT_INT, p2type(have)); 325 break; 326 case SCAL: 327 break; 328 default: 329 panic( "postcheck" ); 330 break; 331 } 332 } 333 #endif PC 334 335 #ifdef DEBUG 336 conv(dub) 337 int *dub; 338 { 339 int newfp[2]; 340 double *dp = ((double *) dub); 341 long *lp = ((long *) dub); 342 register int exp; 343 long mant; 344 345 newfp[0] = dub[0] & 0100000; 346 newfp[1] = 0; 347 if (*dp == 0.0) 348 goto ret; 349 exp = ((dub[0] >> 7) & 0377) - 0200; 350 if (exp < 0) { 351 newfp[1] = 1; 352 exp = -exp; 353 } 354 if (exp > 63) 355 exp = 63; 356 dub[0] &= ~0177600; 357 dub[0] |= 0200; 358 mant = *lp; 359 mant <<= 8; 360 if (newfp[0]) 361 mant = -mant; 362 newfp[0] |= (mant >> 17) & 077777; 363 newfp[1] |= (((int) (mant >> 1)) & 0177400) | (exp << 1); 364 ret: 365 dub[0] = newfp[0]; 366 dub[1] = newfp[1]; 367 } 368 #endif 369