Return to type.c CVS log

Up to [CSRG BSD Unix] / 3BSD / cmd / pi

Annotation of 3BSD/cmd/pi/type.c, revision 1.1

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

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