Return to cset.c CVS log

Up to [CSRG BSD Unix] / 42BSD / ucb / pascal / src

Annotation of 42BSD/ucb/pascal/src/cset.c, revision 1.1

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

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.