2.11BSD#431 - /usr/src/ucb/PORT/pascal/src/cset.c

   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) 6/5/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: }

Defined functions

Defined variables

Defined macros