Return to cset.c CVS log

Up to [CSRG BSD Unix] / 43BSDReno / pgrm / pascal / src

Annotation of 43BSDReno/pgrm/pascal/src/cset.c, revision 1.1

1.1     ! root        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: }

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