Return to yyid.c CVS log

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

Annotation of 3BSD/cmd/pi/yyid.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.1 February 1978
        !             8:  *
        !             9:  *
        !            10:  * pxp - Pascal execution profiler
        !            11:  *
        !            12:  * Bill Joy UCB
        !            13:  * Version 1.1 February 1978
        !            14:  */
        !            15: 
        !            16: #include "whoami"
        !            17: #include "0.h"
        !            18: #include "yy.h"
        !            19: 
        !            20: #ifdef PI
        !            21: extern int *yypv;
        !            22: /*
        !            23:  * Determine whether the identifier whose name
        !            24:  * is "cp" can possibly be a kind, which is a
        !            25:  * namelist class.  We look through the symbol
        !            26:  * table for the first instance of cp as a non-field,
        !            27:  * and at all instances of cp as a field.
        !            28:  * If any of these are ok, we return true, else false.
        !            29:  * It would be much better to handle with's correctly,
        !            30:  * even to just know whether we are in a with at all.
        !            31:  *
        !            32:  * Note that we don't disallow constants on the lhs of assignment.
        !            33:  */
        !            34: identis(cp, kind)
        !            35:        register char *cp;
        !            36:        int kind;
        !            37: {
        !            38:        register struct nl *p;
        !            39:        int i;
        !            40: 
        !            41:        /*
        !            42:         * Cp is NIL when error recovery inserts it.
        !            43:         */
        !            44:        if (cp == NIL)
        !            45:                return (1);
        !            46: 
        !            47:        /*
        !            48:         * Record kind we want for possible later use by yyrecover
        !            49:         */
        !            50:        yyidwant = kind;
        !            51:        yyidhave = NIL;
        !            52:        i = ( (int) cp ) & 077;
        !            53:        for (p = disptab[i]; p != NIL; p = p->nl_next)
        !            54:                if (p->symbol == cp) {
        !            55:                        if (yyidok(p, kind))
        !            56:                                goto gotit;
        !            57:                        if (p->class != FIELD && p->class != BADUSE)
        !            58:                                break;
        !            59:                }
        !            60:        if (p != NIL)
        !            61:                for (p = p->nl_next; p != NIL; p = p->nl_next)
        !            62:                        if (p->symbol == cp && p->class == FIELD && yyidok(p, kind))
        !            63:                                goto gotit;
        !            64:        return (0);
        !            65: gotit:
        !            66:        if (p->class == BADUSE && !Recovery) {
        !            67:                yybadref(p, OY.Yyeline);
        !            68:                yypv[0] = NIL;
        !            69:        }
        !            70:        return (1);
        !            71: }
        !            72: 
        !            73: /*
        !            74:  * A bad reference to the identifier cp on line
        !            75:  * line and use implying the addition of kindmask
        !            76:  * to the mask of kind information.
        !            77:  */
        !            78: yybaduse(cp, line, kindmask)
        !            79:        register char *cp;
        !            80:        int line, kindmask;
        !            81: {
        !            82:        register struct nl *p, *oldp;
        !            83:        int i;
        !            84: 
        !            85:        i = ( (int) cp ) & 077;
        !            86:        for (p = disptab[i]; p != NIL; p = p->nl_next)
        !            87:                if (p->symbol == cp)
        !            88:                        break;
        !            89:        oldp = p;
        !            90:        if (p == NIL || p->class != BADUSE)
        !            91:                p = enter(defnl(cp, BADUSE, 0, 0));
        !            92:        p->value[NL_KINDS] =| kindmask;
        !            93:        yybadref(p, line);
        !            94:        return (oldp);
        !            95: }
        !            96: 
        !            97:     /*
        !            98:      * ud is initialized so that esavestr will allocate
        !            99:      * sizeof ( struct udinfo ) bytes for the 'real' struct udinfo
        !           100:      */
        !           101: struct udinfo ud = { ~0 , ~0 , 0};
        !           102: /*
        !           103:  * Record a reference to an undefined identifier,
        !           104:  * or one which is improperly used.
        !           105:  */
        !           106: yybadref(p, line)
        !           107:        register struct nl *p;
        !           108:        int line;
        !           109: {
        !           110:        register struct udinfo *udp;
        !           111: 
        !           112:        if (p->chain != NIL && p->chain->ud_line == line)
        !           113:                return;
        !           114:        udp = esavestr(&ud);
        !           115:        udp->ud_line = line;
        !           116:        udp->ud_next = p->chain;
        !           117:        p->chain = udp;
        !           118: }
        !           119: 
        !           120: #define        varkinds        ((1<<CONST)|(1<<VAR)|(1<<REF)|(1<<ARRAY)|(1<<PTR)|(1<<RECORD)|(1<<FIELD)|(1<<FUNC)|(1<<FVAR))
        !           121: /*
        !           122:  * Is the symbol in the p entry of the namelist
        !           123:  * even possibly a kind kind?  If not, update
        !           124:  * what we have based on this encounter.
        !           125:  */
        !           126: yyidok(p, kind)
        !           127:        register struct nl *p;
        !           128:        int kind;
        !           129: {
        !           130: 
        !           131:        if (p->class == BADUSE) {
        !           132:                if (kind == VAR)
        !           133:                        return (p->value[0] & varkinds);
        !           134:                return (p->value[0] & (1 << kind));
        !           135:        }
        !           136:        if (yyidok1(p, kind))
        !           137:                return (1);
        !           138:        if (yyidhave != NIL)
        !           139:                yyidhave = IMPROPER;
        !           140:        else
        !           141:                yyidhave = p->class;
        !           142:        return (0);
        !           143: }
        !           144: 
        !           145: yyidok1(p, kind)
        !           146:        register struct nl *p;
        !           147:        int kind;
        !           148: {
        !           149:        int i;
        !           150: 
        !           151:        switch (kind) {
        !           152:                case FUNC:
        !           153:                        if (p->class == FVAR)
        !           154:                                return(1);
        !           155:                case CONST:
        !           156:                case TYPE:
        !           157:                case PROC:
        !           158:                case FIELD:
        !           159:                        return (p->class == kind);
        !           160:                case VAR:
        !           161:                        return (p->class == CONST || yyisvar(p, NIL));
        !           162:                case ARRAY:
        !           163:                case RECORD:
        !           164:                        return (yyisvar(p, kind));
        !           165:                case PTRFILE:
        !           166:                        return (yyisvar(p, PTR) || yyisvar(p, FILET));
        !           167:        }
        !           168: }
        !           169: 
        !           170: yyisvar(p, class)
        !           171:        register struct nl *p;
        !           172:        int class;
        !           173: {
        !           174: 
        !           175:        switch (p->class) {
        !           176:                case FIELD:
        !           177:                case VAR:
        !           178:                case REF:
        !           179:                case FVAR:
        !           180:                /*
        !           181:                 * We would prefer to return
        !           182:                 * parameterless functions only.
        !           183:                 */
        !           184:                case FUNC:
        !           185:                        return (class == NIL || (p->type != NIL && p->type->class == class));
        !           186:        }
        !           187:        return (0);
        !           188: }
        !           189: #endif
        !           190: #ifdef PXP
        !           191: #ifndef DEBUG
        !           192: identis()
        !           193: {
        !           194: 
        !           195:        return (1);
        !           196: }
        !           197: #endif
        !           198: #ifdef DEBUG
        !           199: extern char *classes[];
        !           200: 
        !           201: char   kindchars[]     "UCTVAQRDPF";
        !           202: /*
        !           203:  * Fake routine "identis" for pxp when testing error recovery.
        !           204:  * Looks at letters in variable names to answer questions
        !           205:  * about attributes.  Mapping is
        !           206:  *     C       const_id
        !           207:  *     T       type_id
        !           208:  *     V       var_id          also if any of AQRDF
        !           209:  *     A       array_id
        !           210:  *     Q       ptr_id
        !           211:  *     R       record_id
        !           212:  *     D       field_id        D for "dot"
        !           213:  *     P       proc_id
        !           214:  *     F       func_id
        !           215:  */
        !           216: identis(cp, kind)
        !           217:        register char *cp;
        !           218:        int kind;
        !           219: {
        !           220:        register char *dp;
        !           221:        char kindch;
        !           222: 
        !           223:        /*
        !           224:         * Don't do anything unless -T
        !           225:         */
        !           226:        if (!typetest)
        !           227:                return (1);
        !           228: 
        !           229:        /*
        !           230:         * Inserted symbols are always correct
        !           231:         */
        !           232:        if (cp == NIL)
        !           233:                return (1);
        !           234:        /*
        !           235:         * Set up the names for error messages
        !           236:         */
        !           237:        yyidwant = classes[kind];
        !           238:        for (dp = kindchars; *dp; dp++)
        !           239:                if (any(cp, *dp)) {
        !           240:                        yyidhave = classes[dp - kindchars];
        !           241:                        break;
        !           242:                }
        !           243: 
        !           244:        /*
        !           245:         * U in the name means undefined
        !           246:         */
        !           247:        if (any(cp, 'U'))
        !           248:                return (0);
        !           249: 
        !           250:        kindch = kindchars[kind];
        !           251:        if (kindch == 'V')
        !           252:                for (dp = "AQRDF"; *dp; dp++)
        !           253:                        if (any(cp, *dp))
        !           254:                                return (1);
        !           255:        return (any(cp, kindch));
        !           256: }
        !           257: #endif
        !           258: #endif

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