Return to clas.c CVS log

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

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

1.1     ! root        1: /* Copyright (c) 1979 Regents of the University of California */
        !             2: 
        !             3: static char sccsid[] = "@(#)clas.c 1.6 11/11/82";
        !             4: 
        !             5: #include "whoami.h"
        !             6: #include "0.h"
        !             7: #include "tree.h"
        !             8: 
        !             9: /*
        !            10:  * This is the array of class
        !            11:  * names for the classes returned
        !            12:  * by classify.  The order of the 
        !            13:  * classes is the same as the base
        !            14:  * of the namelist, with special
        !            15:  * negative index entries for structures,
        !            16:  * scalars, pointers, sets and strings
        !            17:  * to be collapsed into.
        !            18:  */
        !            19: char   *clnxxxx[] =
        !            20: {
        !            21:        "file",                 /* -7   TFILE */
        !            22:        "record",               /* -6   TREC */
        !            23:        "array",                /* -5   TARY */
        !            24:        "scalar",               /* -4   TSCAL */
        !            25:        "pointer",              /* -3   TPTR */
        !            26:        "set",                  /* -2   TSET */
        !            27:        "string",               /* -1   TSTR */
        !            28:        "SNARK",                /*  0   NIL */
        !            29:        "Boolean",              /*  1   TBOOL */
        !            30:        "char",                 /*  2   TCHAR */
        !            31:        "integer",              /*  3   TINT */
        !            32:        "real",                 /*  4   TREAL */
        !            33:        "\"nil\"",              /*  5   TNIL */
        !            34: };
        !            35: 
        !            36: char **clnames = &clnxxxx[-(TFIRST)];
        !            37: 
        !            38: /*
        !            39:  * Classify takes a pointer
        !            40:  * to a type and returns one
        !            41:  * of several interesting group
        !            42:  * classifications for easy use.
        !            43:  */
        !            44: classify(p1)
        !            45:        struct nl *p1;
        !            46: {
        !            47:        register struct nl *p;
        !            48: 
        !            49:        p = p1;
        !            50: swit:
        !            51:        if (p == NIL) {
        !            52:                nocascade();
        !            53:                return (NIL);
        !            54:        }
        !            55:        if (p == &nl[TSTR])
        !            56:                return (TSTR);
        !            57:        if ( p == &nl[ TSET ] ) {
        !            58:            return TSET;
        !            59:        }
        !            60:        switch (p->class) {
        !            61:                case PTR:
        !            62:                        return (TPTR);
        !            63:                case ARRAY:
        !            64:                        if (p->type == nl+T1CHAR)
        !            65:                                return (TSTR);
        !            66:                        return (TARY);
        !            67:                case STR:
        !            68:                        return (TSTR);
        !            69:                case SET:
        !            70:                        return (TSET);
        !            71:                case RANGE:
        !            72:                        p = p->type;
        !            73:                        goto swit;
        !            74:                case TYPE:
        !            75:                        if (p <= nl+TLAST)
        !            76:                                return (p - nl);
        !            77:                        panic("clas2");
        !            78:                case FILET:
        !            79:                        return (TFILE);
        !            80:                case RECORD:
        !            81:                        return (TREC);
        !            82:                case SCAL:
        !            83:                        return (TSCAL);
        !            84:                default:
        !            85:                        panic("clas");
        !            86:        }
        !            87: }
        !            88: 
        !            89: #ifndef        PI0
        !            90: /*
        !            91:  * Is p a text file?
        !            92:  */
        !            93: text(p)
        !            94:        struct nl *p;
        !            95: {
        !            96: 
        !            97:        return (p != NIL && p->class == FILET && p->type == nl+T1CHAR);
        !            98: }
        !            99: #endif
        !           100: 
        !           101: /*
        !           102:  * Scalar returns a pointer to
        !           103:  * the the base scalar type of
        !           104:  * its argument if its argument
        !           105:  * is a SCALar else NIL.
        !           106:  */
        !           107: scalar(p1)
        !           108:        struct nl *p1;
        !           109: {
        !           110:        register struct nl *p;
        !           111: 
        !           112:        p = p1;
        !           113:        if (p == NIL)
        !           114:                return (NIL);
        !           115:        if (p->class == RANGE)
        !           116:                p = p->type;
        !           117:        if (p == NIL)
        !           118:                return (NIL);
        !           119:        return (p->class == SCAL ? p : NIL);
        !           120: }
        !           121: 
        !           122: /*
        !           123:  * Isa tells whether p
        !           124:  * is one of a group of
        !           125:  * namelist classes.  The
        !           126:  * classes wanted are specified
        !           127:  * by the characters in s.
        !           128:  * (Note that s would more efficiently,
        !           129:  * if less clearly, be given by a mask.)
        !           130:  */
        !           131: isa(p, s)
        !           132:        register struct nl *p;
        !           133:        char *s;
        !           134: {
        !           135:        register i;
        !           136:        register char *cp;
        !           137: 
        !           138:        if (p == NIL)
        !           139:                return (NIL);
        !           140:        /*
        !           141:         * map ranges down to
        !           142:         * the base type
        !           143:         */
        !           144:        if (p->class == RANGE)
        !           145:                p = p->type;
        !           146:        /*
        !           147:         * the following character/class
        !           148:         * associations are made:
        !           149:         *
        !           150:         *      s       scalar
        !           151:         *      b       Boolean
        !           152:         *      c       character
        !           153:         *      i       integer
        !           154:         *      d       double (real)
        !           155:         *      t       set
        !           156:         */
        !           157:        switch (p->class) {
        !           158:                case SET:
        !           159:                        i = TDOUBLE+1;
        !           160:                        break;
        !           161:                case SCAL:
        !           162:                        i = 0;
        !           163:                        break;
        !           164:                default:
        !           165:                        i = p - nl;
        !           166:        }
        !           167:        if (i >= 0 && i <= TDOUBLE+1) {
        !           168:                i = "sbcidt"[i];
        !           169:                cp = s;
        !           170:                while (*cp)
        !           171:                        if (*cp++ == i)
        !           172:                                return (1);
        !           173:        }
        !           174:        return (NIL);
        !           175: }
        !           176: 
        !           177: /*
        !           178:  * Isnta is !isa
        !           179:  */
        !           180: isnta(p, s)
        !           181: {
        !           182: 
        !           183:        return (!isa(p, s));
        !           184: }
        !           185: 
        !           186: /*
        !           187:  * "shorthand"
        !           188:  */
        !           189: nameof(p)
        !           190: {
        !           191: 
        !           192:        return (clnames[classify(p)]);
        !           193: }
        !           194: 
        !           195: #ifndef PI0
        !           196: nowexp(r)
        !           197:        int *r;
        !           198: {
        !           199:        if (r[0] == T_WEXP) {
        !           200:                if (r[2] == NIL)
        !           201:                        error("Oct/hex allowed only on writeln/write calls");
        !           202:                else
        !           203:                        error("Width expressions allowed only in writeln/write calls");
        !           204:                return (1);
        !           205:        }
        !           206:        return (NIL);
        !           207: }
        !           208: #endif
        !           209: 
        !           210:     /*
        !           211:      * is a variable a local, a formal parameter, or a global?
        !           212:      * all this from just the offset:
        !           213:      *     globals are at levels 0 or 1
        !           214:      *     positives are parameters
        !           215:      *     negative evens are locals
        !           216:      */
        !           217: whereis( level , offset , other_flags )
        !           218:     int                level;
        !           219:     int                offset;
        !           220:     char       other_flags;
        !           221: {
        !           222:     
        !           223: #   ifdef OBJ
        !           224:        return ( offset >= 0 ? PARAMVAR : LOCALVAR );
        !           225: #   endif OBJ
        !           226: #   ifdef PC
        !           227:        switch ( other_flags & ( NGLOBAL | NPARAM | NLOCAL | NNLOCAL) ) {
        !           228:            case NGLOBAL:
        !           229:                return GLOBALVAR;
        !           230:            case NPARAM:
        !           231:                return PARAMVAR;
        !           232:            case NNLOCAL:
        !           233:                return NAMEDLOCALVAR;
        !           234:            case NLOCAL:
        !           235:                return LOCALVAR;
        !           236:            default:
        !           237:                panic( "whereis" );
        !           238:        }
        !           239: #   endif PC
        !           240: }

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