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