Return to clas.c CVS log

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

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

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