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