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