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