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