Return to type.c CVS log

Up to [CSRG BSD Unix] / 40BSD / cmd / pc0

Annotation of 40BSD/cmd/pc0/type.c, revision 1.1

1.1     ! root        1: /* Copyright (c) 1979 Regents of the University of California */
        !             2: 
        !             3: static char sccsid[] = "@(#)type.c 1.4 9/4/80";
        !             4: 
        !             5: #include "whoami.h"
        !             6: #include "0.h"
        !             7: #include "tree.h"
        !             8: #include "objfmt.h"
        !             9: 
        !            10: /*
        !            11:  * Type declaration part
        !            12:  */
        !            13: typebeg()
        !            14: {
        !            15: 
        !            16: /*
        !            17:  * this allows for multiple
        !            18:  * declaration parts unless
        !            19:  * standard option has been
        !            20:  * specified.
        !            21:  * If routine segment is being
        !            22:  * compiled, do level one processing.
        !            23:  */
        !            24: 
        !            25: #ifndef PI1
        !            26:        if (!progseen)
        !            27:                level1();
        !            28:        if ( parts[ cbn ] & ( VPRT | RPRT ) ) {
        !            29:            if ( opt( 's' ) ) {
        !            30:                standard();
        !            31:            } else {
        !            32:                warning();
        !            33:            }
        !            34:            error("Type declarations should precede var and routine declarations");
        !            35:        }
        !            36:        if (parts[ cbn ] & TPRT) {
        !            37:            if ( opt( 's' ) ) {
        !            38:                standard();
        !            39:            } else {
        !            40:                warning();
        !            41:            }
        !            42:            error("All types should be declared in one type part");
        !            43:        }
        !            44:        parts[ cbn ] |= TPRT;
        !            45: #endif
        !            46:        /*
        !            47:         * Forechain is the head of a list of types that
        !            48:         * might be self referential.  We chain them up and
        !            49:         * process them later.
        !            50:         */
        !            51:        forechain = NIL;
        !            52: #ifdef PI0
        !            53:        send(REVTBEG);
        !            54: #endif
        !            55: }
        !            56: 
        !            57: type(tline, tid, tdecl)
        !            58:        int tline;
        !            59:        char *tid;
        !            60:        register int *tdecl;
        !            61: {
        !            62:        register struct nl *np;
        !            63: 
        !            64:        np = gtype(tdecl);
        !            65:        line = tline;
        !            66: #ifndef PI0
        !            67:        enter(defnl(tid, TYPE, np, 0))->nl_flags |= NMOD;
        !            68: #else
        !            69:        enter(defnl(tid, TYPE, np, 0));
        !            70:        send(REVTYPE, tline, tid, tdecl);
        !            71: #endif
        !            72: 
        !            73: #ifdef PC
        !            74:        if (cbn == 1) {
        !            75:            stabgtype( tid , line );
        !            76:        }
        !            77: #endif PC
        !            78: 
        !            79: #      ifdef PTREE
        !            80:            {
        !            81:                pPointer Type = TypeDecl( tid , tdecl );
        !            82:                pPointer *Types;
        !            83: 
        !            84:                pSeize( PorFHeader[ nesting ] );
        !            85:                Types = &( pDEF( PorFHeader[ nesting ] ).PorFTypes );
        !            86:                *Types = ListAppend( *Types , Type );
        !            87:                pRelease( PorFHeader[ nesting ] );
        !            88:            }
        !            89: #      endif
        !            90: }
        !            91: 
        !            92: typeend()
        !            93: {
        !            94: 
        !            95: #ifdef PI0
        !            96:        send(REVTEND);
        !            97: #endif
        !            98:        foredecl();
        !            99: }
        !           100: 
        !           101: /*
        !           102:  * Return a type pointer (into the namelist)
        !           103:  * from a parse tree for a type, building
        !           104:  * namelist entries as needed.
        !           105:  */
        !           106: struct nl *
        !           107: gtype(r)
        !           108:        register int *r;
        !           109: {
        !           110:        register struct nl *np;
        !           111:        register char *cp;
        !           112:        register int oline, w;
        !           113: 
        !           114:        if (r == NIL)
        !           115:                return (NIL);
        !           116:        oline = line;
        !           117:        if (r[0] != T_ID)
        !           118:                oline = line = r[1];
        !           119:        switch (r[0]) {
        !           120:                default:
        !           121:                        panic("type");
        !           122:                case T_TYID:
        !           123:                        r++;
        !           124:                case T_ID:
        !           125:                        np = lookup(r[1]);
        !           126:                        if (np == NIL)
        !           127:                                break;
        !           128:                        if (np->class != TYPE) {
        !           129: #ifndef PI1
        !           130:                                error("%s is a %s, not a type as required", r[1], classes[np->class]);
        !           131: #endif
        !           132:                                np = NIL;
        !           133:                                break;
        !           134:                        }
        !           135:                        np = np->type;
        !           136:                        break;
        !           137:                case T_TYSCAL:
        !           138:                        np = tyscal(r);
        !           139:                        break;
        !           140:                case T_TYRANG:
        !           141:                        np = tyrang(r);
        !           142:                        break;
        !           143:                case T_TYPTR:
        !           144:                        np = defnl(0, PTR, 0, 0 );
        !           145:                        np -> ptr[0] = r[2];
        !           146:                        np->nl_next = forechain;
        !           147:                        forechain = np;
        !           148:                        break;
        !           149:                case T_TYPACK:
        !           150:                        np = gtype(r[2]);
        !           151:                        break;
        !           152:                case T_TYARY:
        !           153:                        np = tyary(r);
        !           154:                        break;
        !           155:                case T_TYREC:
        !           156:                        np = tyrec(r[2], 0);
        !           157: #                      ifdef PTREE
        !           158:                                /*
        !           159:                                 * mung T_TYREC[3] to point to the record
        !           160:                                 * for RecTCopy
        !           161:                                 */
        !           162:                            r[3] = np;
        !           163: #                      endif
        !           164:                        break;
        !           165:                case T_TYFILE:
        !           166:                        np = gtype(r[2]);
        !           167:                        if (np == NIL)
        !           168:                                break;
        !           169: #ifndef PI1
        !           170:                        if (np->nl_flags & NFILES)
        !           171:                                error("Files cannot be members of files");
        !           172: #endif
        !           173:                        np = defnl(0, FILET, np, 0);
        !           174:                        np->nl_flags |= NFILES;
        !           175:                        break;
        !           176:                case T_TYSET:
        !           177:                        np = gtype(r[2]);
        !           178:                        if (np == NIL)
        !           179:                                break;
        !           180:                        if (np->type == nl+TDOUBLE) {
        !           181: #ifndef PI1
        !           182:                                error("Set of real is not allowed");
        !           183: #endif
        !           184:                                np = NIL;
        !           185:                                break;
        !           186:                        }
        !           187:                        if (np->class != RANGE && np->class != SCAL) {
        !           188: #ifndef PI1
        !           189:                                error("Set type must be range or scalar, not %s", nameof(np));
        !           190: #endif
        !           191:                                np = NIL;
        !           192:                                break;
        !           193:                        }
        !           194: #ifndef PI1
        !           195:                        if (width(np) > 2)
        !           196:                                error("Implementation restriction: sets must be indexed by 16 bit quantities");
        !           197: #endif
        !           198:                        np = defnl(0, SET, np, 0);
        !           199:                        break;
        !           200:        }
        !           201:        line = oline;
        !           202:        w = lwidth(np);
        !           203:        if (w >= TOOMUCH) {
        !           204:                error("Storage requirement of %s exceeds the implementation limit of %d by %d bytes",
        !           205:                        nameof(np), TOOMUCH-1, w-TOOMUCH+1);
        !           206:                np = NIL;
        !           207:        }
        !           208:        return (np);
        !           209: }
        !           210: 
        !           211: /*
        !           212:  * Scalar (enumerated) types
        !           213:  */
        !           214: tyscal(r)
        !           215:        int *r;
        !           216: {
        !           217:        register struct nl *np, *op, *zp;
        !           218:        register *v;
        !           219:        int i;
        !           220: 
        !           221:        np = defnl(0, SCAL, 0, 0);
        !           222:        np->type = np;
        !           223:        v = r[2];
        !           224:        if (v == NIL)
        !           225:                return (NIL);
        !           226:        i = -1;
        !           227:        zp = np;
        !           228:        for (; v != NIL; v = v[2]) {
        !           229:                op = enter(defnl(v[1], CONST, np, ++i));
        !           230: #ifndef PI0
        !           231:                op->nl_flags |= NMOD;
        !           232: #endif
        !           233:                op->value[1] = i;
        !           234:                zp->chain = op;
        !           235:                zp = op;
        !           236:        }
        !           237:        np->range[1] = i;
        !           238:        return (np);
        !           239: }
        !           240: 
        !           241: /*
        !           242:  * Declare a subrange.
        !           243:  */
        !           244: tyrang(r)
        !           245:        register int *r;
        !           246: {
        !           247:        register struct nl *lp, *hp;
        !           248:        double high;
        !           249:        int c, c1;
        !           250: 
        !           251:        gconst(r[3]);
        !           252:        hp = con.ctype;
        !           253:        high = con.crval;
        !           254:        gconst(r[2]);
        !           255:        lp = con.ctype;
        !           256:        if (lp == NIL || hp == NIL)
        !           257:                return (NIL);
        !           258:        if (norange(lp) || norange(hp))
        !           259:                return (NIL);
        !           260:        c = classify(lp);
        !           261:        c1 = classify(hp);
        !           262:        if (c != c1) {
        !           263: #ifndef PI1
        !           264:                error("Can't mix %ss and %ss in subranges", nameof(lp), nameof(hp));
        !           265: #endif
        !           266:                return (NIL);
        !           267:        }
        !           268:        if (c == TSCAL && scalar(lp) != scalar(hp)) {
        !           269: #ifndef PI1
        !           270:                error("Scalar types must be identical in subranges");
        !           271: #endif
        !           272:                return (NIL);
        !           273:        }
        !           274:        if (con.crval > high) {
        !           275: #ifndef PI1
        !           276:                error("Range lower bound exceeds upper bound");
        !           277: #endif
        !           278:                return (NIL);
        !           279:        }
        !           280:        lp = defnl(0, RANGE, hp->type, 0);
        !           281:        lp->range[0] = con.crval;
        !           282:        lp->range[1] = high;
        !           283:        return (lp);
        !           284: }
        !           285: 
        !           286: norange(p)
        !           287:        register struct nl *p;
        !           288: {
        !           289:        if (isa(p, "d")) {
        !           290: #ifndef PI1
        !           291:                error("Subrange of real is not allowed");
        !           292: #endif
        !           293:                return (1);
        !           294:        }
        !           295:        if (isnta(p, "bcsi")) {
        !           296: #ifndef PI1
        !           297:                error("Subrange bounds must be Boolean, character, integer or scalar, not %s", nameof(p));
        !           298: #endif
        !           299:                return (1);
        !           300:        }
        !           301:        return (0);
        !           302: }
        !           303: 
        !           304: /*
        !           305:  * Declare arrays and chain together the dimension specification
        !           306:  */
        !           307: struct nl *
        !           308: tyary(r)
        !           309:        int *r;
        !           310: {
        !           311:        struct nl *np;
        !           312:        register *tl;
        !           313:        register struct nl *tp, *ltp;
        !           314:        int i;
        !           315: 
        !           316:        tp = gtype(r[3]);
        !           317:        if (tp == NIL)
        !           318:                return (NIL);
        !           319:        np = defnl(0, ARRAY, tp, 0);
        !           320:        np->nl_flags |= (tp->nl_flags) & NFILES;
        !           321:        ltp = np;
        !           322:        i = 0;
        !           323:        for (tl = r[2]; tl != NIL; tl = tl[2]) {
        !           324:                tp = gtype(tl[1]);
        !           325:                if (tp == NIL) {
        !           326:                        np = NIL;
        !           327:                        continue;
        !           328:                }
        !           329:                if (tp->class == RANGE && tp->type == nl+TDOUBLE) {
        !           330: #ifndef PI1
        !           331:                        error("Index type for arrays cannot be real");
        !           332: #endif
        !           333:                        np = NIL;
        !           334:                        continue;
        !           335:                }
        !           336:                if (tp->class != RANGE && tp->class != SCAL) {
        !           337: #ifndef PI1
        !           338:                        error("Array index type is a %s, not a range or scalar as required", classes[tp->class]);
        !           339: #endif
        !           340:                        np = NIL;
        !           341:                        continue;
        !           342:                }
        !           343:                if (tp->class == RANGE && bytes(tp->range[0], tp->range[1]) > 2) {
        !           344: #ifndef PI1
        !           345:                        error("Value of dimension specifier too large or small for this implementation");
        !           346: #endif
        !           347:                        continue;
        !           348:                }
        !           349:                tp = nlcopy(tp);
        !           350:                i++;
        !           351:                ltp->chain = tp;
        !           352:                ltp = tp;
        !           353:        }
        !           354:        if (np != NIL)
        !           355:                np->value[0] = i;
        !           356:        return (np);
        !           357: }
        !           358: 
        !           359: /*
        !           360:  * Delayed processing for pointers to
        !           361:  * allow self-referential and mutually
        !           362:  * recursive pointer constructs.
        !           363:  */
        !           364: foredecl()
        !           365: {
        !           366:        register struct nl *p, *q;
        !           367: 
        !           368:        for (p = forechain; p != NIL; p = p->nl_next) {
        !           369:                if (p->class == PTR && p -> ptr[0] != 0)
        !           370:                {
        !           371:                        p->type = gtype(p -> ptr[0]);
        !           372: #ifndef PI1
        !           373:                        if (p->type != NIL && ( ( p->type )->nl_flags & NFILES))
        !           374:                                error("Files cannot be members of dynamic structures");
        !           375: #endif
        !           376: #                      ifdef PTREE
        !           377:                        {
        !           378:                            if ( pUSE( p -> inTree ).PtrTType == pNIL ) {
        !           379:                                pPointer        PtrTo = tCopy( p -> ptr[0] );
        !           380: 
        !           381:                                pDEF( p -> inTree ).PtrTType = PtrTo;
        !           382:                            }
        !           383:                        }
        !           384: #                      endif
        !           385:                        p -> ptr[0] = 0;
        !           386:                }
        !           387:        }
        !           388: }

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