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

##### Functions

    postcset          X
    precset           X

##### Variables

    mask              X

##### Macros

    BITSPERBYTE       X
    BITSPERLONG       X
    COMPSETSZE        X
    CONSETS           X
    LG2BITSBYTE       X
    LG2BITSLONG       X
    MSKBITSBYTE       X
    MSKBITSLONG       X

       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

postcset defined in line 344; used 7 times

- in /usr/src/ucb/PORT/pascal/src/rval.c line 362-365(2), 379, 396, 909, 973-976(2)

precset defined in line 46; used 5 times

- in /usr/src/ucb/PORT/pascal/src/0.h line 728
- in /usr/src/ucb/PORT/pascal/src/rval.c line 358, 375, 905, 917

#### Defined variables

mask defined in line 313; used 3 times

- in line 387-389(2), 397

sccsid defined in line 8; never used

#### Defined macros

BITSPERBYTE defined in line 32; never used
BITSPERLONG defined in line 33; used 1 times

- in line 428

COMPSETSZE defined in line 30; used 3 times

- in line 110, 176, 358

CONSETS defined in line 29; used 6 times

- in line 172, 195, 218, 251, 309, 367

LG2BITSBYTE defined in line 34; used 2 times

- in line 403, 428

LG2BITSLONG defined in line 36; used 8 times

- in line 110, 176, 369, 383-385(2), 414, 427-430(2)

MSKBITSBYTE defined in line 35; used 1 times

- in line 403

MSKBITSLONG defined in line 37; used 2 times

- in line 384-386(2)

Last modified: 1985-06-05 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 1454 |