1 /* Copyright (c) 1979 Regents of the University of California */ 2 3 static char sccsid[] = "@(#)cset.c 1.7 02/01/83"; 4 5 #include "whoami.h" 6 #include "0.h" 7 #include "tree.h" 8 #include "opcode.h" 9 #include "objfmt.h" 10 #ifdef PC 11 #include "pc.h" 12 #include "pcops.h" 13 #include "align.h" 14 #endif PC 15 16 /* 17 * CONSETS causes compile time constant sets to be constructed here. 18 * 19 * COMPSETSZE defines the maximum number of longs to be used in 20 * constant set construction 21 */ 22 #define CONSETS 23 #define COMPSETSZE 10 24 25 #define BITSPERBYTE 8 26 #define BITSPERLONG 32 27 #define LG2BITSBYTE 3 28 #define MSKBITSBYTE 0x07 29 #define LG2BITSLONG 5 30 #define MSKBITSLONG 0x1f 31 32 /* 33 * rummage through a `constant' set (i.e. anything within [ ]'s) tree 34 * and decide if this is a compile time constant set or a runtime set. 35 * this information is returned in a structure passed from the caller. 36 * while rummaging, this also reorders the tree so that all ranges 37 * preceed all singletons. 38 */ 39 bool 40 precset( r , settype , csetp ) 41 int *r; 42 struct nl *settype; 43 struct csetstr *csetp; 44 { 45 register int *e; 46 register struct nl *t; 47 register struct nl *exptype; 48 register int *el; 49 register int *pairp; 50 register int *singp; 51 int *ip; 52 int lower; 53 int upper; 54 bool setofint; 55 56 csetp -> csettype = NIL; 57 csetp -> paircnt = 0; 58 csetp -> singcnt = 0; 59 csetp -> comptime = TRUE; 60 setofint = FALSE; 61 if ( settype != NIL ) { 62 if ( settype -> class == SET ) { 63 /* 64 * the easy case, we are told the type of the set. 65 */ 66 exptype = settype -> type; 67 } else { 68 /* 69 * we are told the type, but it's not a set 70 * supposedly possible if someone tries 71 * e.g string context [1,2] = 'abc' 72 */ 73 error("Constant set involved in non set context"); 74 return csetp -> comptime; 75 } 76 } else { 77 /* 78 * So far we have no indication 79 * of what the set type should be. 80 * We "look ahead" and try to infer 81 * The type of the constant set 82 * by evaluating one of its members. 83 */ 84 e = r[2]; 85 if (e == NIL) { 86 /* 87 * tentative for [], return type of `intset' 88 */ 89 settype = lookup( intset ); 90 if ( settype == NIL ) { 91 panic( "empty set" ); 92 } 93 settype = settype -> type; 94 if ( settype == NIL ) { 95 return csetp -> comptime; 96 } 97 if ( isnta( settype , "t" ) ) { 98 error("Set default type \"intset\" is not a set"); 99 return csetp -> comptime; 100 } 101 csetp -> csettype = settype; 102 setran( settype -> type ); 103 if (((set.uprbp + 1) >> LG2BITSLONG) >= COMPSETSZE) 104 csetp -> comptime = FALSE; 105 return csetp -> comptime; 106 } 107 e = e[1]; 108 if (e == NIL) { 109 return csetp -> comptime; 110 } 111 if (e[0] == T_RANG) { 112 e = e[1]; 113 } 114 codeoff(); 115 t = rvalue(e, NIL , RREQ ); 116 codeon(); 117 if (t == NIL) { 118 return csetp -> comptime; 119 } 120 /* 121 * The type of the set, settype, is 122 * deemed to be a set of the base type 123 * of t, which we call exptype. If, 124 * however, this would involve a 125 * "set of integer", we cop out 126 * and use "intset"'s current scoped 127 * type instead. 128 */ 129 if (isa(t, "r")) { 130 error("Sets may not have 'real' elements"); 131 return csetp -> comptime; 132 } 133 if (isnta(t, "bcsi")) { 134 error("Set elements must be scalars, not %ss", nameof(t)); 135 return csetp -> comptime; 136 } 137 if (isa(t, "i")) { 138 settype = lookup(intset); 139 if (settype == NIL) 140 panic("intset"); 141 settype = settype->type; 142 if (settype == NIL) 143 return csetp -> comptime; 144 if (isnta(settype, "t")) { 145 error("Set default type \"intset\" is not a set"); 146 return csetp -> comptime; 147 } 148 exptype = settype->type; 149 /* 150 * say we are doing an intset 151 * but, if we get out of range errors for intset 152 * we punt constructing the set at compile time. 153 */ 154 setofint = TRUE; 155 } else { 156 exptype = t->type; 157 if (exptype == NIL) 158 return csetp -> comptime; 159 if (exptype->class != RANGE) 160 exptype = exptype->type; 161 settype = defnl(0, SET, exptype, 0); 162 } 163 } 164 csetp -> csettype = settype; 165 # ifndef CONSETS 166 csetp -> comptime = FALSE; 167 # endif CONSETS 168 setran( exptype ); 169 if (((set.uprbp + 1) >> LG2BITSLONG) >= COMPSETSZE) 170 csetp -> comptime = FALSE; 171 lower = set.lwrb; 172 upper = set.lwrb + set.uprbp; 173 pairp = NIL; 174 singp = NIL; 175 codeoff(); 176 while ( el = r[2] ) { 177 e = el[1]; 178 if (e == NIL) { 179 /* 180 * don't hang this one anywhere. 181 */ 182 csetp -> csettype = NIL; 183 r[2] = el[2]; 184 continue; 185 } 186 if (e[0] == T_RANG) { 187 if ( csetp -> comptime && constval( e[2] ) ) { 188 #ifdef CONSETS 189 t = con.ctype; 190 if ( con.crval < lower || con.crval > upper ) { 191 if ( setofint ) { 192 csetp -> comptime = FALSE; 193 } else { 194 error("Range upper bound of %D out of set bounds" , ((long)con.crval) ); 195 csetp -> csettype = NIL; 196 } 197 } 198 #endif CONSETS 199 } else { 200 csetp -> comptime = FALSE; 201 t = rvalue(e[2], NIL , RREQ ); 202 if (t == NIL) { 203 rvalue(e[1], NIL , RREQ ); 204 goto pairhang; 205 } 206 } 207 if (incompat(t, exptype, e[2])) { 208 cerror("Upper bound of element type clashed with set type in constant set"); 209 } 210 if ( csetp -> comptime && constval( e[1] ) ) { 211 #ifdef CONSETS 212 t = con.ctype; 213 if ( con.crval < lower || con.crval > upper ) { 214 if ( setofint ) { 215 csetp -> comptime = FALSE; 216 } else { 217 error("Range lower bound of %D out of set bounds" , ((long)con.crval) ); 218 csetp -> csettype = NIL; 219 } 220 } 221 #endif CONSETS 222 } else { 223 csetp -> comptime = FALSE; 224 t = rvalue(e[1], NIL , RREQ ); 225 if (t == NIL) { 226 goto pairhang; 227 } 228 } 229 if (incompat(t, exptype, e[1])) { 230 cerror("Lower bound of element type clashed with set type in constant set"); 231 } 232 pairhang: 233 /* 234 * remove this range from the tree list and 235 * hang it on the pairs list. 236 */ 237 ip = el[2]; 238 el[2] = pairp; 239 pairp = r[2]; 240 r[2] = ip; 241 csetp -> paircnt++; 242 } else { 243 if ( csetp -> comptime && constval( e ) ) { 244 #ifdef CONSETS 245 t = con.ctype; 246 if ( con.crval < lower || con.crval > upper ) { 247 if ( setofint ) { 248 csetp -> comptime = FALSE; 249 } else { 250 error("Value of %D out of set bounds" , ((long)con.crval) ); 251 csetp -> csettype = NIL; 252 } 253 } 254 #endif CONSETS 255 } else { 256 csetp -> comptime = FALSE; 257 t = rvalue((int *) e, NLNIL , RREQ ); 258 if (t == NIL) { 259 goto singhang; 260 } 261 } 262 if (incompat(t, exptype, e)) { 263 cerror("Element type clashed with set type in constant set"); 264 } 265 singhang: 266 /* 267 * take this expression off the tree list and 268 * hang it on the list of singletons. 269 */ 270 ip = el[2]; 271 el[2] = singp; 272 singp = r[2]; 273 r[2] = ip; 274 csetp -> singcnt++; 275 } 276 } 277 codeon(); 278 # ifdef PC 279 if ( pairp != NIL ) { 280 for ( el = pairp ; el[2] != NIL ; el = el[2] ) /* void */; 281 el[2] = singp; 282 r[2] = pairp; 283 } else { 284 r[2] = singp; 285 } 286 # endif PC 287 # ifdef OBJ 288 if ( singp != NIL ) { 289 for ( el = singp ; el[2] != NIL ; el = el[2] ) /* void */; 290 el[2] = pairp; 291 r[2] = singp; 292 } else { 293 r[2] = pairp; 294 } 295 # endif OBJ 296 if ( csetp -> csettype == NIL ) { 297 csetp -> comptime = TRUE; 298 } 299 return csetp -> comptime; 300 } 301 302 #ifdef CONSETS 303 /* 304 * mask[i] has the low i bits turned off. 305 */ 306 long mask[] = { 307 # ifdef DEC11 308 0xffffffff , 0xfffffffe , 0xfffffffc , 0xfffffff8 , 309 0xfffffff0 , 0xffffffe0 , 0xffffffc0 , 0xffffff80 , 310 0xffffff00 , 0xfffffe00 , 0xfffffc00 , 0xfffff800 , 311 0xfffff000 , 0xffffe000 , 0xffffc000 , 0xffff8000 , 312 0xffff0000 , 0xfffe0000 , 0xfffc0000 , 0xfff80000 , 313 0xfff00000 , 0xffe00000 , 0xffc00000 , 0xff800000 , 314 0xff000000 , 0xfe000000 , 0xfc000000 , 0xf8000000 , 315 0xf0000000 , 0xe0000000 , 0xc0000000 , 0x80000000 , 316 0x00000000 317 # else 318 0xffffffff , 0xfeffffff , 0xfcffffff , 0xf8ffffff , 319 0xf0ffffff , 0xe0ffffff , 0xc0ffffff , 0x80ffffff , 320 0x00ffffff , 0x00feffff , 0x00fcffff , 0x00f8ffff , 321 0x00f0ffff , 0x00e0ffff , 0x00c0ffff , 0x0080ffff , 322 0x0000ffff , 0x0000feff , 0x0000fcff , 0x0000f8ff , 323 0x0000f0ff , 0x0000e0ff , 0x0000c0ff , 0x000080ff , 324 0x000000ff , 0x000000fe , 0x000000fc , 0x000000f8 , 325 0x000000f0 , 0x000000e0 , 0x000000c0 , 0x00000080 , 326 0x00000000 327 # endif DEC11 328 }; 329 /* 330 * given a csetstr, either 331 * put out a compile time constant set and an lvalue to it. 332 * or 333 * put out rvalues for the singletons and the pairs 334 * and counts of each. 335 */ 336 #endif CONSETS 337 postcset( r , csetp ) 338 int *r; 339 struct csetstr *csetp; 340 { 341 register int *el; 342 register int *e; 343 int lower; 344 int upper; 345 int lowerdiv; 346 int lowermod; 347 int upperdiv; 348 int uppermod; 349 int label; 350 long *lp; 351 long *limit; 352 long tempset[ COMPSETSZE ]; 353 long temp; 354 char *cp; 355 # ifdef PC 356 char labelname[ BUFSIZ ]; 357 # endif PC 358 359 if ( csetp -> comptime ) { 360 #ifdef CONSETS 361 setran( ( csetp -> csettype ) -> type ); 362 limit = &tempset[ ( set.uprbp >> LG2BITSLONG ) + 1 ]; 363 for ( lp = &tempset[0] ; lp < limit ; lp++ ) { 364 *lp = 0; 365 } 366 for ( el = r[2] ; el != NIL ; el = el[2] ) { 367 e = el[1]; 368 if ( e[0] == T_RANG ) { 369 constval( e[1] ); 370 lower = con.crval; 371 constval( e[2] ); 372 upper = con.crval; 373 if ( upper < lower ) { 374 continue; 375 } 376 lowerdiv = ( lower - set.lwrb ) >> LG2BITSLONG; 377 lowermod = ( lower - set.lwrb ) & MSKBITSLONG; 378 upperdiv = ( upper - set.lwrb ) >> LG2BITSLONG; 379 uppermod = ( upper - set.lwrb ) & MSKBITSLONG; 380 temp = mask[ lowermod ]; 381 if ( lowerdiv == upperdiv ) { 382 temp &= ~mask[ uppermod + 1 ]; 383 } 384 tempset[ lowerdiv ] |= temp; 385 limit = &tempset[ upperdiv-1 ]; 386 for ( lp = &tempset[ lowerdiv+1 ] ; lp <= limit ; lp++ ) { 387 *lp |= 0xffffffff; 388 } 389 if ( lowerdiv != upperdiv ) { 390 tempset[ upperdiv ] |= ~mask[ uppermod + 1 ]; 391 } 392 } else { 393 constval( e ); 394 temp = con.crval - set.lwrb; 395 cp = (char *)tempset; 396 cp[temp >> LG2BITSBYTE] |= (1 << (temp & MSKBITSBYTE)); 397 } 398 } 399 if ( !CGENNING ) 400 return; 401 # ifdef PC 402 label = getlab(); 403 putprintf(" .data" , 0 ); 404 aligndot(A_SET); 405 putlab( label ); 406 lp = &( tempset[0] ); 407 limit = &tempset[ ( set.uprbp >> LG2BITSLONG ) + 1 ]; 408 while (lp < limit) { 409 putprintf(" .long 0x%x", 1, *lp++); 410 for (temp = 2 ; temp <= 8 && lp < limit ; temp++) { 411 putprintf(",0x%x", 1, *lp++); 412 } 413 putprintf("", 0); 414 } 415 putprintf(" .text", 0); 416 sprintf( labelname , PREFIXFORMAT , LABELPREFIX , label ); 417 putleaf( P2ICON , 0 , 0 , P2PTR | P2STRTY , labelname ); 418 # endif PC 419 # ifdef OBJ 420 put(2, O_CON, (int)(((set.uprbp >> LG2BITSLONG) + 1) * 421 (BITSPERLONG >> LG2BITSBYTE))); 422 lp = &( tempset[0] ); 423 limit = &tempset[ ( set.uprbp >> LG2BITSLONG ) + 1 ]; 424 while ( lp < limit ) { 425 put(2, O_CASE4, *lp ++); 426 } 427 # endif OBJ 428 #else 429 panic("const cset"); 430 #endif CONSETS 431 } else { 432 # ifdef PC 433 putleaf( P2ICON , csetp -> paircnt , 0 , P2INT , 0 ); 434 putop( P2LISTOP , P2INT ); 435 putleaf( P2ICON , csetp -> singcnt , 0 , P2INT , 0 ); 436 putop( P2LISTOP , P2INT ); 437 for ( el = r[2] ; el != NIL ; el = el[2] ) { 438 e = el[1]; 439 if ( e[0] == T_RANG ) { 440 rvalue( e[2] , NIL , RREQ ); 441 putop( P2LISTOP , P2INT ); 442 rvalue( e[1] , NIL , RREQ ); 443 putop( P2LISTOP , P2INT ); 444 } else { 445 rvalue( e , NIL , RREQ ); 446 putop( P2LISTOP , P2INT ); 447 } 448 } 449 # endif PC 450 # ifdef OBJ 451 for ( el = r[2] ; el != NIL ; el = el[2] ) { 452 e = el[1]; 453 if ( e[0] == T_RANG ) { 454 stkrval( e[1] , NIL , RREQ ); 455 stkrval( e[2] , NIL , RREQ ); 456 } else { 457 stkrval( e , NIL , RREQ ); 458 } 459 } 460 put(2 , O_CON24 , (int)csetp -> singcnt ); 461 put(2 , O_CON24 , (int)csetp -> paircnt ); 462 # endif OBJ 463 } 464 } 465