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) 06/05/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 373