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