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