Return to lval.c CVS log

Up to [CSRG BSD Unix] / 43BSDReno / pgrm / pascal / src

Annotation of 43BSDReno/pgrm/pascal/src/lval.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[] = "@(#)lval.c     5.2 (Berkeley) 7/26/85";
        !             9: #endif not lint
        !            10: 
        !            11: #include "whoami.h"
        !            12: #include "0.h"
        !            13: #include "tree.h"
        !            14: #include "opcode.h"
        !            15: #include "objfmt.h"
        !            16: #include "tree_ty.h"
        !            17: #ifdef PC
        !            18: #   include    "pc.h"
        !            19: #   include    <pcc.h>
        !            20: #endif PC
        !            21: 
        !            22: extern int flagwas;
        !            23: /*
        !            24:  * Lvalue computes the address
        !            25:  * of a qualified name and
        !            26:  * leaves it on the stack.
        !            27:  * for pc, it can be asked for either an lvalue or an rvalue.
        !            28:  * the semantics are the same, only the code is different.
        !            29:  */
        !            30: /*ARGSUSED*/
        !            31: struct nl *
        !            32: lvalue(var, modflag , required )
        !            33:        struct tnode *var; 
        !            34:        int     modflag;
        !            35:        int     required;
        !            36: {
        !            37: #ifdef OBJ
        !            38:        register struct nl *p;
        !            39:        struct nl *firstp, *lastp;
        !            40:        register struct tnode *c, *co;
        !            41:        int f, o, s;
        !            42:        /*
        !            43:         * Note that the local optimizations
        !            44:         * done here for offsets would more
        !            45:         * appropriately be done in put.
        !            46:         */
        !            47:        struct tnode    tr;     /* T_FIELD */ 
        !            48:        struct tnode    *tr_ptr;
        !            49:        struct tnode    l_node;
        !            50: #endif
        !            51: 
        !            52:        if (var == TR_NIL) {
        !            53:                return (NLNIL);
        !            54:        }
        !            55:        if (nowexp(var)) {
        !            56:                return (NLNIL);
        !            57:        }
        !            58:        if (var->tag != T_VAR) {
        !            59:                error("Variable required");     /* Pass mesgs down from pt of call ? */
        !            60:                return (NLNIL);
        !            61:        }
        !            62: #      ifdef PC
        !            63:                /*
        !            64:                 *      pc requires a whole different control flow
        !            65:                 */
        !            66:            return pclvalue( var , modflag , required );
        !            67: #      endif PC
        !            68: #      ifdef OBJ
        !            69:                /*
        !            70:                 *      pi uses the rest of the function
        !            71:                 */
        !            72:        firstp = p = lookup(var->var_node.cptr);
        !            73:        if (p == NLNIL) {
        !            74:                return (NLNIL);
        !            75:        }
        !            76:        c = var->var_node.qual;
        !            77:        if ((modflag & NOUSE) && !lptr(c)) {
        !            78:                p->nl_flags = flagwas;
        !            79:        }
        !            80:        if (modflag & MOD) {
        !            81:                p->nl_flags |= NMOD;
        !            82:        }
        !            83:        /*
        !            84:         * Only possibilities for p->class here
        !            85:         * are the named classes, i.e. CONST, TYPE
        !            86:         * VAR, PROC, FUNC, REF, or a WITHPTR.
        !            87:         */
        !            88:        tr_ptr = &l_node;
        !            89:        switch (p->class) {
        !            90:                case WITHPTR:
        !            91:                        /*
        !            92:                         * Construct the tree implied by
        !            93:                         * the with statement
        !            94:                         */
        !            95:                        l_node.tag = T_LISTPP;
        !            96: 
        !            97:                        /* the cast has got to go but until the node is figured
        !            98:                           out it stays */
        !            99: 
        !           100:                        tr_ptr->list_node.list = (&tr);
        !           101:                        tr_ptr->list_node.next = var->var_node.qual;
        !           102:                        tr.tag = T_FIELD;
        !           103:                        tr.field_node.id_ptr = var->var_node.cptr;
        !           104:                        c = tr_ptr; /* c is a ptr to a tnode */
        !           105: #                      ifdef PTREE
        !           106:                            /*
        !           107:                             * mung var->fields to say which field this T_VAR is
        !           108:                             * for VarCopy
        !           109:                             */
        !           110: 
        !           111:                            /* problem! reclook returns struct nl* */
        !           112: 
        !           113:                            var->var_node.fields = reclook( p -> type , 
        !           114:                                            var->var_node.line_no );
        !           115: #                      endif
        !           116:                        /* and fall through */
        !           117:                case REF:
        !           118:                        /*
        !           119:                         * Obtain the indirect word
        !           120:                         * of the WITHPTR or REF
        !           121:                         * as the base of our lvalue
        !           122:                         */
        !           123:                        (void) put(2, PTR_RV | bn << 8+INDX , (int)p->value[0] );
        !           124:                        f = 0;          /* have an lv on stack */
        !           125:                        o = 0;
        !           126:                        break;
        !           127:                case VAR:
        !           128:                        if (p->type->class != CRANGE) {
        !           129:                            f = 1;              /* no lv on stack yet */
        !           130:                            o = p->value[0];
        !           131:                        } else {
        !           132:                            error("Conformant array bound %s found where variable required", p->symbol);
        !           133:                            return(NLNIL);
        !           134:                        }
        !           135:                        break;
        !           136:                default:
        !           137:                        error("%s %s found where variable required", classes[p->class], p->symbol);
        !           138:                        return (NLNIL);
        !           139:        }
        !           140:        /*
        !           141:         * Loop and handle each
        !           142:         * qualification on the name
        !           143:         */
        !           144:        if (c == TR_NIL && (modflag&ASGN) && ( p->value[NL_FORV] & FORVAR ) ) {
        !           145:                error("Can't modify the for variable %s in the range of the loop", p->symbol);
        !           146:                return (NLNIL);
        !           147:        }
        !           148:        s = 0;          /* subscripts seen */
        !           149:        for (; c != TR_NIL; c = c->list_node.next) {
        !           150:                co = c->list_node.list; /* co is a ptr to a tnode */
        !           151:                if (co == TR_NIL) {
        !           152:                        return (NLNIL);
        !           153:                }
        !           154:                lastp = p;
        !           155:                p = p->type;
        !           156:                if (p == NLNIL) {
        !           157:                        return (NLNIL);
        !           158:                }
        !           159:                /*
        !           160:                 * If we haven't seen enough subscripts, and the next
        !           161:                 * qualification isn't array reference, then it's an error.
        !           162:                 */
        !           163:                if (s && co->tag != T_ARY) {
        !           164:                        error("Too few subscripts (%d given, %d required)",
        !           165:                                s, p->value[0]);
        !           166:                }
        !           167:                switch (co->tag) {
        !           168:                        case T_PTR:
        !           169:                                /*
        !           170:                                 * Pointer qualification.
        !           171:                                 */
        !           172:                                lastp->nl_flags |= NUSED;
        !           173:                                if (p->class != PTR && p->class != FILET) {
        !           174:                                        error("^ allowed only on files and pointers, not on %ss", nameof(p));
        !           175:                                        goto bad;
        !           176:                                }
        !           177:                                if (f) {
        !           178:                                    if (p->class == FILET && bn != 0)
        !           179:                                        (void) put(2, O_LV | bn <<8+INDX , o );
        !           180:                                    else
        !           181:                                        /*
        !           182:                                         * this is the indirection from
        !           183:                                         * the address of the pointer 
        !           184:                                         * to the pointer itself.
        !           185:                                         * kirk sez:
        !           186:                                         * fnil doesn't want this.
        !           187:                                         * and does it itself for files
        !           188:                                         * since only it knows where the
        !           189:                                         * actual window is.
        !           190:                                         * but i have to do this for
        !           191:                                         * regular pointers.
        !           192:                                         * This is further complicated by
        !           193:                                         * the fact that global variables
        !           194:                                         * are referenced through pointers
        !           195:                                         * on the stack. Thus an RV on a
        !           196:                                         * global variable is the same as
        !           197:                                         * an LV of a non-global one ?!?
        !           198:                                         */
        !           199:                                        (void) put(2, PTR_RV | bn <<8+INDX , o );
        !           200:                                } else {
        !           201:                                        if (o) {
        !           202:                                            (void) put(2, O_OFF, o);
        !           203:                                        }
        !           204:                                        if (p->class != FILET || bn == 0)
        !           205:                                            (void) put(1, PTR_IND);
        !           206:                                }
        !           207:                                /*
        !           208:                                 * Pointer cannot be
        !           209:                                 * nil and file cannot
        !           210:                                 * be at end-of-file.
        !           211:                                 */
        !           212:                                (void) put(1, p->class == FILET ? O_FNIL : O_NIL);
        !           213:                                f = o = 0;
        !           214:                                continue;
        !           215:                        case T_ARGL:
        !           216:                                if (p->class != ARRAY) {
        !           217:                                        if (lastp == firstp) {
        !           218:                                                error("%s is a %s, not a function", var->var_node.cptr, classes[firstp->class]);
        !           219:                                        } else {
        !           220:                                                error("Illegal function qualificiation");
        !           221:                                        }
        !           222:                                        return (NLNIL);
        !           223:                                }
        !           224:                                recovered();
        !           225:                                error("Pascal uses [] for subscripting, not ()");
        !           226:                        case T_ARY:
        !           227:                                if (p->class != ARRAY) {
        !           228:                                        error("Subscripting allowed only on arrays, not on %ss", nameof(p));
        !           229:                                        goto bad;
        !           230:                                }
        !           231:                                if (f) {
        !           232:                                        if (bn == 0)
        !           233:                                                /*
        !           234:                                                 * global variables are
        !           235:                                                 * referenced through pointers
        !           236:                                                 * on the stack
        !           237:                                                 */
        !           238:                                                (void) put(2, PTR_RV | bn<<8+INDX, o);
        !           239:                                        else
        !           240:                                                (void) put(2, O_LV | bn<<8+INDX, o);
        !           241:                                } else {
        !           242:                                        if (o) {
        !           243:                                            (void) put(2, O_OFF, o);
        !           244:                                        }
        !           245:                                }
        !           246:                                switch(s = arycod(p,co->ary_node.expr_list,s)) {
        !           247:                                        /*
        !           248:                                         * This is the number of subscripts seen
        !           249:                                         */
        !           250:                                        case 0:
        !           251:                                                return (NLNIL);
        !           252:                                        case -1:
        !           253:                                                goto bad;
        !           254:                                }
        !           255:                                if (s == p->value[0]) {
        !           256:                                        s = 0;
        !           257:                                } else {
        !           258:                                        p = lastp;
        !           259:                                }
        !           260:                                f = o = 0;
        !           261:                                continue;
        !           262:                        case T_FIELD:
        !           263:                                /*
        !           264:                                 * Field names are just
        !           265:                                 * an offset with some 
        !           266:                                 * semantic checking.
        !           267:                                 */
        !           268:                                if (p->class != RECORD) {
        !           269:                                        error(". allowed only on records, not on %ss", nameof(p));
        !           270:                                        goto bad;
        !           271:                                }
        !           272:                                /* must define the field node!! */
        !           273:                                if (co->field_node.id_ptr == NIL) {
        !           274:                                        return (NLNIL);
        !           275:                                }
        !           276:                                p = reclook(p, co->field_node.id_ptr);
        !           277:                                if (p == NLNIL) {
        !           278:                                        error("%s is not a field in this record", co->field_node.id_ptr);
        !           279:                                        goto bad;
        !           280:                                }
        !           281: #                              ifdef PTREE
        !           282:                                    /*
        !           283:                                     * mung co[3] to indicate which field
        !           284:                                     * this is for SelCopy
        !           285:                                     */
        !           286:                                    co->field_node.nl_entry = p;
        !           287: #                              endif
        !           288:                                if (modflag & MOD) {
        !           289:                                        p->nl_flags |= NMOD;
        !           290:                                }
        !           291:                                if ((modflag & NOUSE) == 0 ||
        !           292:                                    lptr(c->list_node.next)) {
        !           293:                                /* figure out what kind of node c is !! */
        !           294:                                        p->nl_flags |= NUSED;
        !           295:                                }
        !           296:                                o += p->value[0];
        !           297:                                continue;
        !           298:                        default:
        !           299:                                panic("lval2");
        !           300:                }
        !           301:        }
        !           302:        if (s) {
        !           303:                error("Too few subscripts (%d given, %d required)",
        !           304:                        s, p->type->value[0]);
        !           305:                return NLNIL;
        !           306:        }
        !           307:        if (f) {
        !           308:                if (bn == 0)
        !           309:                        /*
        !           310:                         * global variables are referenced through
        !           311:                         * pointers on the stack
        !           312:                         */
        !           313:                        (void) put(2, PTR_RV | bn<<8+INDX, o);
        !           314:                else
        !           315:                        (void) put(2, O_LV | bn<<8+INDX, o);
        !           316:        } else {
        !           317:                if (o) {
        !           318:                    (void) put(2, O_OFF, o);
        !           319:                }
        !           320:        }
        !           321:        return (p->type);
        !           322: bad:
        !           323:        cerror("Error occurred on qualification of %s", var->var_node.cptr);
        !           324:        return (NLNIL);
        !           325: #      endif OBJ
        !           326: }
        !           327: 
        !           328: int lptr(c)
        !           329:        register struct tnode *c;
        !           330: {
        !           331:        register struct tnode *co;
        !           332: 
        !           333:        for (; c != TR_NIL; c = c->list_node.next) {
        !           334:                co = c->list_node.list;
        !           335:                if (co == TR_NIL) {
        !           336:                        return (NIL);
        !           337:                }
        !           338:                switch (co->tag) {
        !           339: 
        !           340:                case T_PTR:
        !           341:                        return (1);
        !           342:                case T_ARGL:
        !           343:                        return (0);
        !           344:                case T_ARY:
        !           345:                case T_FIELD:
        !           346:                        continue;
        !           347:                default:
        !           348:                        panic("lptr");
        !           349:                }
        !           350:        }
        !           351:        return (0);
        !           352: }
        !           353: 
        !           354: /*
        !           355:  * Arycod does the
        !           356:  * code generation
        !           357:  * for subscripting.
        !           358:  * n is the number of
        !           359:  * subscripts already seen
        !           360:  * (CLN 09/13/83)
        !           361:  */
        !           362: int arycod(np, el, n)
        !           363:        struct nl *np;
        !           364:        struct tnode *el;
        !           365:        int n;
        !           366: {
        !           367:        register struct nl *p, *ap;
        !           368:        long sub;
        !           369:        bool constsub;
        !           370:        extern bool constval();
        !           371:        int i, d;  /* v, v1;  these aren't used */
        !           372:        int w;
        !           373: 
        !           374:        p = np;
        !           375:        if (el == TR_NIL) {
        !           376:                return (0);
        !           377:        }
        !           378:        d = p->value[0];
        !           379:        for (i = 1; i <= n; i++) {
        !           380:                p = p->chain;
        !           381:        }
        !           382:        /*
        !           383:         * Check each subscript
        !           384:         */
        !           385:        for (i = n+1; i <= d; i++) {
        !           386:                if (el == TR_NIL) {
        !           387:                        return (i-1);
        !           388:                }
        !           389:                p = p->chain;
        !           390:                if (p == NLNIL)
        !           391:                        return (0);
        !           392:                if ((p->class != CRANGE) &&
        !           393:                        (constsub = constval(el->list_node.list))) {
        !           394:                    ap = con.ctype;
        !           395:                    sub = con.crval;
        !           396:                    if (sub < p->range[0] || sub > p->range[1]) {
        !           397:                        error("Subscript value of %D is out of range", (char *) sub);
        !           398:                        return (0);
        !           399:                    }
        !           400:                    sub -= p->range[0];
        !           401:                } else {
        !           402: #                  ifdef PC
        !           403:                        precheck( p , "_SUBSC" , "_SUBSCZ" );
        !           404: #                  endif PC
        !           405:                    ap = rvalue(el->list_node.list, NLNIL , RREQ );
        !           406:                    if (ap == NIL) {
        !           407:                            return (0);
        !           408:                    }
        !           409: #                  ifdef PC
        !           410:                        postcheck(p, ap);
        !           411:                        sconv(p2type(ap),PCCT_INT);
        !           412: #                  endif PC
        !           413:                }
        !           414:                if (incompat(ap, p->type, el->list_node.list)) {
        !           415:                        cerror("Array index type incompatible with declared index type");
        !           416:                        if (d != 1) {
        !           417:                                cerror("Error occurred on index number %d", (char *) i);
        !           418:                        }
        !           419:                        return (-1);
        !           420:                }
        !           421:                if (p->class == CRANGE) {
        !           422:                        constsub = FALSE;
        !           423:                } else {
        !           424:                        w = aryconst(np, i);
        !           425:                }
        !           426: #              ifdef OBJ
        !           427:                    if (constsub) {
        !           428:                        sub *= w;
        !           429:                        if (sub != 0) {
        !           430:                            w = bytes(sub, sub);
        !           431:                            (void) put(2, w <= 2 ? O_CON2 : O_CON4, sub);
        !           432:                            (void) gen(NIL, T_ADD, sizeof(char *), w);
        !           433:                        }
        !           434:                        el = el->list_node.next;
        !           435:                        continue;
        !           436:                    }
        !           437:                    if (p->class == CRANGE) {
        !           438:                        putcbnds(p, 0);
        !           439:                        putcbnds(p, 1);
        !           440:                        putcbnds(p, 2);
        !           441:                    } else if (opt('t') == 0) {
        !           442:                            switch (w) {
        !           443:                            case 8:
        !           444:                                    w = 6;
        !           445:                            case 4:
        !           446:                            case 2:
        !           447:                            case 1:
        !           448:                                    (void) put(2, (width(ap) != 4 ? O_INX2P2 : O_INX4P2) | (w & ~1) << 7, ( short ) p->range[0]);
        !           449:                                    el = el->list_node.next;
        !           450:                                    continue;
        !           451:                            }
        !           452:                    }
        !           453:                    if (p->class == CRANGE) {
        !           454:                        if (width(p) == 4) {
        !           455:                            put(1, width(ap) != 4 ? O_VINX42 : O_VINX4);
        !           456:                        } else {
        !           457:                            put(1, width(ap) != 4 ? O_VINX2 : O_VINX24);
        !           458:                        }
        !           459:                    } else {
        !           460:                        put(4, width(ap) != 4 ? O_INX2 : O_INX4, w,
        !           461:                            (short)p->range[0], (short)(p->range[1]));
        !           462:                    }
        !           463:                    el = el->list_node.next;
        !           464:                    continue;
        !           465: #              endif OBJ
        !           466: #              ifdef PC
        !           467:                        /*
        !           468:                         *      subtract off the lower bound
        !           469:                         */
        !           470:                    if (constsub) {
        !           471:                        sub *= w;
        !           472:                        if (sub != 0) {
        !           473:                            putleaf( PCC_ICON , (int) sub , 0 , PCCT_INT , (char *) 0 );
        !           474:                            putop(PCC_PLUS, PCCM_ADDTYPE(p2type(np->type), PCCTM_PTR));
        !           475:                        }
        !           476:                        el = el->list_node.next;
        !           477:                        continue;
        !           478:                    }
        !           479:                    if (p->class == CRANGE) {
        !           480:                        /*
        !           481:                         *      if conformant array, subtract off lower bound
        !           482:                         */
        !           483:                        ap = p->nptr[0];
        !           484:                        putRV(ap->symbol, (ap->nl_block & 037), ap->value[0], 
        !           485:                                ap->extra_flags, p2type( ap ) );
        !           486:                        putop( PCC_MINUS, PCCT_INT );
        !           487:                        /*
        !           488:                         *      and multiply by the width of the elements
        !           489:                         */
        !           490:                        ap = p->nptr[2];
        !           491:                        putRV( 0 , (ap->nl_block & 037), ap->value[0], 
        !           492:                                ap->extra_flags, p2type( ap ) );
        !           493:                        putop( PCC_MUL , PCCT_INT );
        !           494:                    } else {
        !           495:                        if ( p -> range[ 0 ] != 0 ) {
        !           496:                            putleaf( PCC_ICON , (int) p -> range[0] , 0 , PCCT_INT , (char *) 0 );
        !           497:                            putop( PCC_MINUS , PCCT_INT );
        !           498:                        }
        !           499:                            /*
        !           500:                             *  multiply by the width of the elements
        !           501:                             */
        !           502:                        if ( w != 1 ) {
        !           503:                            putleaf( PCC_ICON , w , 0 , PCCT_INT , (char *) 0 );
        !           504:                            putop( PCC_MUL , PCCT_INT );
        !           505:                        }
        !           506:                    }
        !           507:                        /*
        !           508:                         *      and add it to the base address
        !           509:                         */
        !           510:                    putop( PCC_PLUS , PCCM_ADDTYPE( p2type( np -> type ) , PCCTM_PTR ) );
        !           511:                el = el->list_node.next;
        !           512: #              endif PC
        !           513:        }
        !           514:        if (el != TR_NIL) {
        !           515:            if (np->type->class != ARRAY) {
        !           516:                do {
        !           517:                        el = el->list_node.next;
        !           518:                        i++;
        !           519:                } while (el != TR_NIL);
        !           520:                error("Too many subscripts (%d given, %d required)", (char *) (i-1), (char *) d);
        !           521:                return (-1);
        !           522:            } else {
        !           523:                return(arycod(np->type, el, d));
        !           524:            }
        !           525:        }
        !           526:        return (d);
        !           527: }
        !           528: 
        !           529: #ifdef OBJ
        !           530: /*
        !           531:  * Put out the conformant array bounds (lower bound, upper bound or width)
        !           532:  * for conformant array type ctype.
        !           533:  * The value of i determines which is being put
        !           534:  * i = 0: lower bound, i=1: upper bound, i=2: width
        !           535:  */
        !           536: putcbnds(ctype, i)
        !           537: struct nl *ctype;
        !           538: int i;
        !           539: {
        !           540:        switch(width(ctype->type)) {
        !           541:            case 1:
        !           542:                put(2, O_RV1 | (ctype->nl_block & 037) << 8+INDX,
        !           543:                        (int)ctype->nptr[i]->value[0]);
        !           544:                break;
        !           545:            case 2:
        !           546:                put(2, O_RV2 | (ctype->nl_block & 037) << 8+INDX,
        !           547:                        (int)ctype->nptr[i]->value[0]);
        !           548:                break;
        !           549:            case 4:
        !           550:            default:
        !           551:                put(2, O_RV4 | (ctype->nl_block & 037) << 8+INDX,
        !           552:                        (int)ctype->nptr[i]->value[0]);
        !           553:        }
        !           554: }
        !           555: #endif OBJ

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