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