Return to clas.c CVS log

Up to [CSRG BSD Unix] / 43BSDTahoe / ucb / pascal / src

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

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