Return to yyid.c CVS log

Up to [CSRG BSD Unix] / 40BSD / cmd / pxp

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

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