Return to lval.c CVS log

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

Annotation of 41BSD/cmd/pi/lval.c, revision 1.1

1.1     ! root        1: /* Copyright (c) 1979 Regents of the University of California */
        !             2: 
        !             3: static char sccsid[] = "@(#)lval.c 1.1 8/27/80";
        !             4: 
        !             5: #include "whoami.h"
        !             6: #include "0.h"
        !             7: #include "tree.h"
        !             8: #include "opcode.h"
        !             9: #include "objfmt.h"
        !            10: #ifdef PC
        !            11: #   include    "pc.h"
        !            12: #   include    "pcops.h"
        !            13: #endif PC
        !            14: 
        !            15: extern int flagwas;
        !            16: /*
        !            17:  * Lvalue computes the address
        !            18:  * of a qualified name and
        !            19:  * leaves it on the stack.
        !            20:  * for pc, it can be asked for either an lvalue or an rvalue.
        !            21:  * the semantics are the same, only the code is different.
        !            22:  */
        !            23: struct nl *
        !            24: lvalue(r, modflag , required )
        !            25:        int *r, modflag;
        !            26:        int     required;
        !            27: {
        !            28:        register struct nl *p;
        !            29:        struct nl *firstp, *lastp;
        !            30:        register *c, *co;
        !            31:        int f, o;
        !            32:        /*
        !            33:         * Note that the local optimizations
        !            34:         * done here for offsets would more
        !            35:         * appropriately be done in put.
        !            36:         */
        !            37:        int tr[2], trp[3];
        !            38: 
        !            39:        if (r == NIL) {
        !            40:                return (NIL);
        !            41:        }
        !            42:        if (nowexp(r)) {
        !            43:                return (NIL);
        !            44:        }
        !            45:        if (r[0] != T_VAR) {
        !            46:                error("Variable required");     /* Pass mesgs down from pt of call ? */
        !            47:                return (NIL);
        !            48:        }
        !            49: #      ifdef PC
        !            50:                /*
        !            51:                 *      pc requires a whole different control flow
        !            52:                 */
        !            53:            return pclvalue( r , modflag , required );
        !            54: #      endif PC
        !            55:        firstp = p = lookup(r[2]);
        !            56:        if (p == NIL) {
        !            57:                return (NIL);
        !            58:        }
        !            59:        c = r[3];
        !            60:        if ((modflag & NOUSE) && !lptr(c)) {
        !            61:                p->nl_flags = flagwas;
        !            62:        }
        !            63:        if (modflag & MOD) {
        !            64:                p->nl_flags |= NMOD;
        !            65:        }
        !            66:        /*
        !            67:         * Only possibilities for p->class here
        !            68:         * are the named classes, i.e. CONST, TYPE
        !            69:         * VAR, PROC, FUNC, REF, or a WITHPTR.
        !            70:         */
        !            71:        switch (p->class) {
        !            72:                case WITHPTR:
        !            73:                        /*
        !            74:                         * Construct the tree implied by
        !            75:                         * the with statement
        !            76:                         */
        !            77:                        trp[0] = T_LISTPP;
        !            78:                        trp[1] = tr;
        !            79:                        trp[2] = r[3];
        !            80:                        tr[0] = T_FIELD;
        !            81:                        tr[1] = r[2];
        !            82:                        c = trp;
        !            83: #                      ifdef PTREE
        !            84:                            /*
        !            85:                             * mung r[4] to say which field this T_VAR is
        !            86:                             * for VarCopy
        !            87:                             */
        !            88:                            r[4] = reclook( p -> type , r[2] );
        !            89: #                      endif
        !            90:                        /* and fall through */
        !            91:                case REF:
        !            92:                        /*
        !            93:                         * Obtain the indirect word
        !            94:                         * of the WITHPTR or REF
        !            95:                         * as the base of our lvalue
        !            96:                         */
        !            97:                        put(2, PTR_RV | bn << 8+INDX , p->value[0] );
        !            98:                        f = 0;          /* have an lv on stack */
        !            99:                        o = 0;
        !           100:                        break;
        !           101:                case VAR:
        !           102:                        f = 1;          /* no lv on stack yet */
        !           103:                        o = p->value[0];
        !           104:                        break;
        !           105:                default:
        !           106:                        error("%s %s found where variable required", classes[p->class], p->symbol);
        !           107:                        return (NIL);
        !           108:        }
        !           109:        /*
        !           110:         * Loop and handle each
        !           111:         * qualification on the name
        !           112:         */
        !           113:        if (c == NIL && (modflag&ASGN) && p->value[NL_FORV]) {
        !           114:                error("Can't modify the for variable %s in the range of the loop", p->symbol);
        !           115:                return (NIL);
        !           116:        }
        !           117:        for (; c != NIL; c = c[2]) {
        !           118:                co = c[1];
        !           119:                if (co == NIL) {
        !           120:                        return (NIL);
        !           121:                }
        !           122:                lastp = p;
        !           123:                p = p->type;
        !           124:                if (p == NIL) {
        !           125:                        return (NIL);
        !           126:                }
        !           127:                switch (co[0]) {
        !           128:                        case T_PTR:
        !           129:                                /*
        !           130:                                 * Pointer qualification.
        !           131:                                 */
        !           132:                                lastp->nl_flags |= NUSED;
        !           133:                                if (p->class != PTR && p->class != FILET) {
        !           134:                                        error("^ allowed only on files and pointers, not on %ss", nameof(p));
        !           135:                                        goto bad;
        !           136:                                }
        !           137:                                if (f) {
        !           138:                                    put(2, PTR_RV | bn <<8+INDX , o );
        !           139:                                } else {
        !           140:                                        if (o) {
        !           141:                                            put2(O_OFF, o);
        !           142:                                        }
        !           143:                                        put(1, PTR_IND);
        !           144:                                }
        !           145:                                /*
        !           146:                                 * Pointer cannot be
        !           147:                                 * nil and file cannot
        !           148:                                 * be at end-of-file.
        !           149:                                 */
        !           150:                                put1(p->class == FILET ? O_FNIL : O_NIL);
        !           151:                                f = o = 0;
        !           152:                                continue;
        !           153:                        case T_ARGL:
        !           154:                                if (p->class != ARRAY) {
        !           155:                                        if (lastp == firstp) {
        !           156:                                                error("%s is a %s, not a function", r[2], classes[firstp->class]);
        !           157:                                        } else {
        !           158:                                                error("Illegal function qualificiation");
        !           159:                                        }
        !           160:                                        return (NIL);
        !           161:                                }
        !           162:                                recovered();
        !           163:                                error("Pascal uses [] for subscripting, not ()");
        !           164:                        case T_ARY:
        !           165:                                if (p->class != ARRAY) {
        !           166:                                        error("Subscripting allowed only on arrays, not on %ss", nameof(p));
        !           167:                                        goto bad;
        !           168:                                }
        !           169:                                if (f) {
        !           170:                                        put2(O_LV | bn<<8+INDX, o);
        !           171:                                } else {
        !           172:                                        if (o) {
        !           173:                                            put2(O_OFF, o);
        !           174:                                        }
        !           175:                                }
        !           176:                                switch (arycod(p, co[1])) {
        !           177:                                        case 0:
        !           178:                                                return (NIL);
        !           179:                                        case -1:
        !           180:                                                goto bad;
        !           181:                                }
        !           182:                                f = o = 0;
        !           183:                                continue;
        !           184:                        case T_FIELD:
        !           185:                                /*
        !           186:                                 * Field names are just
        !           187:                                 * an offset with some 
        !           188:                                 * semantic checking.
        !           189:                                 */
        !           190:                                if (p->class != RECORD) {
        !           191:                                        error(". allowed only on records, not on %ss", nameof(p));
        !           192:                                        goto bad;
        !           193:                                }
        !           194:                                if (co[1] == NIL) {
        !           195:                                        return (NIL);
        !           196:                                }
        !           197:                                p = reclook(p, co[1]);
        !           198:                                if (p == NIL) {
        !           199:                                        error("%s is not a field in this record", co[1]);
        !           200:                                        goto bad;
        !           201:                                }
        !           202: #                              ifdef PTREE
        !           203:                                    /*
        !           204:                                     * mung co[3] to indicate which field
        !           205:                                     * this is for SelCopy
        !           206:                                     */
        !           207:                                    co[3] = p;
        !           208: #                              endif
        !           209:                                if (modflag & MOD) {
        !           210:                                        p->nl_flags |= NMOD;
        !           211:                                }
        !           212:                                if ((modflag & NOUSE) == 0 || lptr(c[2])) {
        !           213:                                        p->nl_flags |= NUSED;
        !           214:                                }
        !           215:                                o += p->value[0];
        !           216:                                continue;
        !           217:                        default:
        !           218:                                panic("lval2");
        !           219:                }
        !           220:        }
        !           221:        if (f) {
        !           222:                put2(O_LV | bn<<8+INDX, o);
        !           223:        } else {
        !           224:                if (o) {
        !           225:                    put2(O_OFF, o);
        !           226:                }
        !           227:        }
        !           228:        return (p->type);
        !           229: bad:
        !           230:        cerror("Error occurred on qualification of %s", r[2]);
        !           231:        return (NIL);
        !           232: }
        !           233: 
        !           234: lptr(c)
        !           235:        register int *c;
        !           236: {
        !           237:        register int *co;
        !           238: 
        !           239:        for (; c != NIL; c = c[2]) {
        !           240:                co = c[1];
        !           241:                if (co == NIL) {
        !           242:                        return (NIL);
        !           243:                }
        !           244:                switch (co[0]) {
        !           245: 
        !           246:                case T_PTR:
        !           247:                        return (1);
        !           248:                case T_ARGL:
        !           249:                        return (0);
        !           250:                case T_ARY:
        !           251:                case T_FIELD:
        !           252:                        continue;
        !           253:                default:
        !           254:                        panic("lptr");
        !           255:                }
        !           256:        }
        !           257:        return (0);
        !           258: }
        !           259: 
        !           260: /*
        !           261:  * Arycod does the
        !           262:  * code generation
        !           263:  * for subscripting.
        !           264:  */
        !           265: arycod(np, el)
        !           266:        struct nl *np;
        !           267:        int *el;
        !           268: {
        !           269:        register struct nl *p, *ap;
        !           270:        int i, d, v, v1;
        !           271:        int w;
        !           272: 
        !           273:        p = np;
        !           274:        if (el == NIL) {
        !           275:                return (0);
        !           276:        }
        !           277:        d = p->value[0];
        !           278:        /*
        !           279:         * Check each subscript
        !           280:         */
        !           281:        for (i = 1; i <= d; i++) {
        !           282:                if (el == NIL) {
        !           283:                        error("Too few subscripts (%d given, %d required)", i-1, d);
        !           284:                        return (-1);
        !           285:                }
        !           286:                p = p->chain;
        !           287: #              ifdef PC
        !           288:                    precheck( p , "_SUBSC" , "_SUBSCZ" );
        !           289: #              endif PC
        !           290:                ap = rvalue(el[1], NLNIL , RREQ );
        !           291:                if (ap == NIL) {
        !           292:                        return (0);
        !           293:                }
        !           294: #              ifdef PC
        !           295:                    postcheck( p );
        !           296: #              endif PC
        !           297:                if (incompat(ap, p->type, el[1])) {
        !           298:                        cerror("Array index type incompatible with declared index type");
        !           299:                        if (d != 1) {
        !           300:                                cerror("Error occurred on index number %d", i);
        !           301:                        }
        !           302:                        return (-1);
        !           303:                }
        !           304:                w = aryconst(np, i);
        !           305: #              ifdef OBJ
        !           306:                    if (opt('t') == 0) {
        !           307:                            switch (w) {
        !           308:                            case 8:
        !           309:                                    w = 6;
        !           310:                            case 4:
        !           311:                            case 2:
        !           312:                            case 1:
        !           313:                                    put2((width(ap) != 4 ? O_INX2P2 : O_INX4P2) | (w & ~1) << 7, ( short ) p->range[0]);
        !           314:                                    el = el[2];
        !           315:                                    continue;
        !           316:                            }
        !           317:                    }
        !           318:                    put(4, width(ap) != 4 ? O_INX2 : O_INX4,w,( short ) p->range[0],
        !           319:                           ( short ) ( p->range[1] - p->range[0] ) );
        !           320: #              endif OBJ
        !           321: #              ifdef PC
        !           322:                        /*
        !           323:                         *      subtract off the lower bound
        !           324:                         */
        !           325:                    if ( p -> range[ 0 ] != 0 ) {
        !           326:                        putleaf( P2ICON , p -> range[0] , 0 , P2INT , 0 );
        !           327:                        putop( P2MINUS , P2INT );
        !           328:                    }
        !           329:                        /*
        !           330:                         *      multiply by the width of the elements
        !           331:                         */
        !           332:                    if ( w != 1 ) {
        !           333:                        putleaf( P2ICON , w , 0 , P2INT , 0 );
        !           334:                        putop( P2MUL , P2INT );
        !           335:                    }
        !           336:                        /*
        !           337:                         *      and add it to the base address
        !           338:                         */
        !           339:                    putop( P2PLUS , ADDTYPE( p2type( np -> type ) , P2PTR ) );
        !           340: #              endif PC
        !           341:                el = el[2];
        !           342:        }
        !           343:        if (el != NIL) {
        !           344:                do {
        !           345:                        el = el[2];
        !           346:                        i++;
        !           347:                } while (el != NIL);
        !           348:                error("Too many subscripts (%d given, %d required)", i-1, d);
        !           349:                return (-1);
        !           350:        }
        !           351:        return (1);
        !           352: }

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