Return to stat.c CVS log

Up to [CSRG BSD Unix] / 42BSD / ucb / pascal / src

Annotation of 42BSD/ucb/pascal/src/stat.c, revision 1.1

1.1     ! root        1: /* Copyright (c) 1979 Regents of the University of California */
        !             2: 
        !             3: static char sccsid[] = "@(#)stat.c 1.12 9/5/83";
        !             4: 
        !             5: #include "whoami.h"
        !             6: #include "0.h"
        !             7: #include "tree.h"
        !             8: #include "objfmt.h"
        !             9: #ifdef PC
        !            10: #   include "pcops.h"
        !            11: #   include "pc.h"
        !            12: #endif PC
        !            13: #include "tmps.h"
        !            14: 
        !            15: int cntstat;
        !            16: short cnts = 3;
        !            17: #include "opcode.h"
        !            18: 
        !            19: /*
        !            20:  * Statement list
        !            21:  */
        !            22: statlist(r)
        !            23:        int *r;
        !            24: {
        !            25:        register *sl;
        !            26: 
        !            27:        for (sl=r; sl != NIL; sl=sl[2])
        !            28:                statement(sl[1]);
        !            29: }
        !            30: 
        !            31: /*
        !            32:  * Statement
        !            33:  */
        !            34: statement(r)
        !            35:        int *r;
        !            36: {
        !            37:        register *s;
        !            38:        register struct nl *snlp;
        !            39:        struct tmps soffset;
        !            40: 
        !            41:        s = r;
        !            42:        snlp = nlp;
        !            43:        soffset = sizes[cbn].curtmps;
        !            44: top:
        !            45:        if (cntstat) {
        !            46:                cntstat = 0;
        !            47:                putcnt();
        !            48:        }
        !            49:        if (s == NIL)
        !            50:                return;
        !            51:        line = s[1];
        !            52:        if (s[0] == T_LABEL) {
        !            53:                labeled(s[2]);
        !            54:                s = s[3];
        !            55:                noreach = 0;
        !            56:                cntstat = 1;
        !            57:                goto top;
        !            58:        }
        !            59:        if (noreach) {
        !            60:                noreach = 0;
        !            61:                warning();
        !            62:                error("Unreachable statement");
        !            63:        }
        !            64:        switch (s[0]) {
        !            65:                case T_PCALL:
        !            66:                        putline();
        !            67: #                      ifdef OBJ
        !            68:                            proc(s);
        !            69: #                      endif OBJ
        !            70: #                      ifdef PC
        !            71:                            pcproc( s );
        !            72: #                      endif PC
        !            73:                        break;
        !            74:                case T_ASGN:
        !            75:                        putline();
        !            76:                        asgnop(s);
        !            77:                        break;
        !            78:                case T_GOTO:
        !            79:                        putline();
        !            80:                        gotoop(s[2]);
        !            81:                        noreach = 1;
        !            82:                        cntstat = 1;
        !            83:                        break;
        !            84:                default:
        !            85:                        level++;
        !            86:                        switch (s[0]) {
        !            87:                                default:
        !            88:                                        panic("stat");
        !            89:                                case T_IF:
        !            90:                                case T_IFEL:
        !            91:                                        ifop(s);
        !            92:                                        break;
        !            93:                                case T_WHILE:
        !            94:                                        whilop(s);
        !            95:                                        noreach = 0;
        !            96:                                        break;
        !            97:                                case T_REPEAT:
        !            98:                                        repop(s);
        !            99:                                        break;
        !           100:                                case T_FORU:
        !           101:                                case T_FORD:
        !           102:                                        forop(s);
        !           103:                                        noreach = 0;
        !           104:                                        break;
        !           105:                                case T_BLOCK:
        !           106:                                        statlist(s[2]);
        !           107:                                        break;
        !           108:                                case T_CASE:
        !           109:                                        putline();
        !           110: #                                      ifdef OBJ
        !           111:                                            caseop(s);
        !           112: #                                      endif OBJ
        !           113: #                                      ifdef PC
        !           114:                                            pccaseop( s );
        !           115: #                                      endif PC
        !           116:                                        break;
        !           117:                                case T_WITH:
        !           118:                                        withop(s);
        !           119:                                        break;
        !           120:                        }
        !           121:                        --level;
        !           122:                        if (gotos[cbn])
        !           123:                                ungoto();
        !           124:                        break;
        !           125:        }
        !           126:        /*
        !           127:         * Free the temporary name list entries defined in
        !           128:         * expressions, e.g. STRs, and WITHPTRs from withs.
        !           129:         */
        !           130:        nlfree(snlp);
        !           131:            /*
        !           132:             *  free any temporaries allocated for this statement
        !           133:             *  these come from strings and sets.
        !           134:             */
        !           135:        tmpfree(&soffset);
        !           136: }
        !           137: 
        !           138: ungoto()
        !           139: {
        !           140:        register struct nl *p;
        !           141: 
        !           142:        for (p = gotos[cbn]; p != NIL; p = p->chain)
        !           143:                if ((p->nl_flags & NFORWD) != 0) {
        !           144:                        if (p->value[NL_GOLEV] != NOTYET)
        !           145:                                if (p->value[NL_GOLEV] > level)
        !           146:                                        p->value[NL_GOLEV] = level;
        !           147:                } else
        !           148:                        if (p->value[NL_GOLEV] != DEAD)
        !           149:                                if (p->value[NL_GOLEV] > level)
        !           150:                                        p->value[NL_GOLEV] = DEAD;
        !           151: }
        !           152: 
        !           153: putcnt()
        !           154: {
        !           155: 
        !           156:        if (monflg == 0) {
        !           157:                return;
        !           158:        }
        !           159:        inccnt( getcnt() );
        !           160: }
        !           161: 
        !           162: int
        !           163: getcnt()
        !           164:     {
        !           165:        
        !           166:        return ++cnts;
        !           167:     }
        !           168: 
        !           169: inccnt( counter )
        !           170:     int        counter;
        !           171:     {
        !           172: 
        !           173: #      ifdef OBJ
        !           174:            put(2, O_COUNT, counter );
        !           175: #      endif OBJ
        !           176: #      ifdef PC
        !           177:            putRV( PCPCOUNT , 0 , counter * sizeof (long) , NGLOBAL , P2INT );
        !           178:            putleaf( P2ICON , 1 , 0 , P2INT , 0 );
        !           179:            putop( P2ASG P2PLUS , P2INT );
        !           180:            putdot( filename , line );
        !           181: #      endif PC
        !           182:     }
        !           183: 
        !           184: putline()
        !           185: {
        !           186: 
        !           187: #      ifdef OBJ
        !           188:            if (opt('p') != 0)
        !           189:                    put(2, O_LINO, line);
        !           190: 
        !           191:            /*
        !           192:             * put out line number information for pdx
        !           193:             */
        !           194:            lineno(line);
        !           195: 
        !           196: #      endif OBJ
        !           197: #      ifdef PC
        !           198:            static lastline;
        !           199: 
        !           200:            if ( line != lastline ) {
        !           201:                stabline( line );
        !           202:                lastline = line;
        !           203:            }
        !           204:            if ( opt( 'p' ) ) {
        !           205:                if ( opt('t') ) {
        !           206:                    putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
        !           207:                            , "_LINO" );
        !           208:                    putop( P2UNARY P2CALL , P2INT );
        !           209:                    putdot( filename , line );
        !           210:                } else {
        !           211:                    putRV( STMTCOUNT , 0 , 0 , NGLOBAL , P2INT );
        !           212:                    putleaf( P2ICON , 1 , 0 , P2INT , 0 );
        !           213:                    putop( P2ASG P2PLUS , P2INT );
        !           214:                    putdot( filename , line );
        !           215:                }
        !           216:            }
        !           217: #      endif PC
        !           218: }
        !           219: 
        !           220: /*
        !           221:  * With varlist do stat
        !           222:  *
        !           223:  * With statement requires an extra word
        !           224:  * in automatic storage for each level of withing.
        !           225:  * These indirect pointers are initialized here, and
        !           226:  * the scoping effect of the with statement occurs
        !           227:  * because lookup examines the field names of the records
        !           228:  * associated with the WITHPTRs on the withlist.
        !           229:  */
        !           230: withop(s)
        !           231:        int *s;
        !           232: {
        !           233:        register *p;
        !           234:        register struct nl *r;
        !           235:        struct nl       *tempnlp;
        !           236:        int *swl;
        !           237: 
        !           238:        putline();
        !           239:        swl = withlist;
        !           240:        for (p = s[2]; p != NIL; p = p[2]) {
        !           241:                    /*
        !           242:                     *  no one uses the allocated temporary namelist entry,
        !           243:                     *  since we have to use it before we know its type;
        !           244:                     *  but we use its runtime location for the with pointer.
        !           245:                     */
        !           246:                tempnlp = tmpalloc(sizeof(int *), nl + TPTR, REGOK);
        !           247: #              ifdef OBJ
        !           248:                    put(2, O_LV | cbn <<8+INDX, tempnlp -> value[ NL_OFFS ] );
        !           249: #              endif OBJ
        !           250: #              ifdef PC
        !           251:                    putRV( 0 , cbn , tempnlp -> value[ NL_OFFS ] ,
        !           252:                            tempnlp -> extra_flags , P2PTR|P2STRTY );
        !           253: #              endif PC
        !           254:                r = lvalue(p[1], MOD , LREQ );
        !           255:                if (r == NIL)
        !           256:                        continue;
        !           257:                if (r->class != RECORD) {
        !           258:                        error("Variable in with statement refers to %s, not to a record", nameof(r));
        !           259:                        continue;
        !           260:                }
        !           261:                r = defnl(0, WITHPTR, r, tempnlp -> value[ NL_OFFS ] );
        !           262: #              ifdef PC
        !           263:                    r -> extra_flags |= tempnlp -> extra_flags;
        !           264: #              endif PC
        !           265:                r->nl_next = withlist;
        !           266:                withlist = r;
        !           267: #              ifdef OBJ
        !           268:                    put(1, PTR_AS);
        !           269: #              endif OBJ
        !           270: #              ifdef PC
        !           271:                    putop( P2ASSIGN , P2PTR|P2STRTY );
        !           272:                    putdot( filename , line );
        !           273: #              endif PC
        !           274:        }
        !           275:        statement(s[3]);
        !           276:        withlist = swl;
        !           277: }
        !           278: 
        !           279: extern flagwas;
        !           280: /*
        !           281:  * var := expr
        !           282:  */
        !           283: asgnop(r)
        !           284:        int *r;
        !           285: {
        !           286:        register struct nl *p;
        !           287:        register *av;
        !           288: 
        !           289:        if (r == NIL)
        !           290:                return (NIL);
        !           291:        /*
        !           292:         * Asgnop's only function is
        !           293:         * to handle function variable
        !           294:         * assignments.  All other assignment
        !           295:         * stuff is handled by asgnop1.
        !           296:         * the if below checks for unqualified lefthandside:
        !           297:         * necessary for fvars.
        !           298:         */
        !           299:        av = r[2];
        !           300:        if (av != NIL && av[0] == T_VAR && av[3] == NIL) {
        !           301:                p = lookup1(av[2]);
        !           302:                if (p != NIL)
        !           303:                        p->nl_flags = flagwas;
        !           304:                if (p != NIL && p->class == FVAR) {
        !           305:                        /*
        !           306:                         * Give asgnop1 the func
        !           307:                         * which is the chain of
        !           308:                         * the FVAR.
        !           309:                         */
        !           310:                        p->nl_flags |= NUSED|NMOD;
        !           311:                        p = p->chain;
        !           312:                        if (p == NIL) {
        !           313:                                rvalue(r[3], NIL , RREQ );
        !           314:                                return;
        !           315:                        }
        !           316: #                      ifdef OBJ
        !           317:                            put(2, O_LV | bn << 8+INDX, (int)p->value[NL_OFFS]);
        !           318:                            if (isa(p->type, "i") && width(p->type) == 1)
        !           319:                                    asgnop1(r, nl+T2INT);
        !           320:                            else
        !           321:                                    asgnop1(r, p->type);
        !           322: #                      endif OBJ
        !           323: #                      ifdef PC
        !           324:                                /*
        !           325:                                 * this should be the lvalue of the fvar,
        !           326:                                 * but since the second pass knows to use
        !           327:                                 * the address of the left operand of an
        !           328:                                 * assignment, what i want here is an rvalue.
        !           329:                                 * see note in funchdr about fvar allocation.
        !           330:                                 */
        !           331:                            p = p -> ptr[ NL_FVAR ];
        !           332:                            putRV( p -> symbol , bn , p -> value[ NL_OFFS ] ,
        !           333:                                    p -> extra_flags , p2type( p -> type ) );
        !           334:                            asgnop1( r , p -> type );
        !           335: #                      endif PC
        !           336:                        return;
        !           337:                }
        !           338:        }
        !           339:        asgnop1(r, NIL);
        !           340: }
        !           341: 
        !           342: /*
        !           343:  * Asgnop1 handles all assignments.
        !           344:  * If p is not nil then we are assigning
        !           345:  * to a function variable, otherwise
        !           346:  * we look the variable up ourselves.
        !           347:  */
        !           348: struct nl *
        !           349: asgnop1(r, p)
        !           350:        int *r;
        !           351:        register struct nl *p;
        !           352: {
        !           353:        register struct nl *p1;
        !           354:        int w;
        !           355: 
        !           356:        if (r == NIL)
        !           357:                return (NIL);
        !           358:        if (p == NIL) {
        !           359: #          ifdef OBJ
        !           360:                p = lvalue(r[2], MOD|ASGN|NOUSE , LREQ );
        !           361:                w = width(p);
        !           362: #          endif OBJ
        !           363: #          ifdef PC
        !           364:                    /*
        !           365:                     * since the second pass knows that it should reference
        !           366:                     * the lefthandside of asignments, what i need here is
        !           367:                     * an rvalue.
        !           368:                     */
        !           369:                p = lvalue( r[2] , MOD|ASGN|NOUSE , RREQ );
        !           370: #          endif PC
        !           371:            if ( p == NIL ) {
        !           372:                rvalue( r[3] , NIL , RREQ );
        !           373:                return NIL;
        !           374:            }
        !           375:        }
        !           376: #      ifdef OBJ
        !           377:            /*
        !           378:             * assigning to the return value, which is at least
        !           379:             * of width two since it resides on the stack
        !           380:             */
        !           381:            else {
        !           382:                w = width(p);
        !           383:                if (w < 2)
        !           384:                    w = 2;
        !           385:            }
        !           386:            p1 = rvalue(r[3], p , RREQ );
        !           387: #      endif OBJ
        !           388: #      ifdef PC
        !           389:                /*
        !           390:                 *      if this is a scalar assignment,
        !           391:                 *          then i want to rvalue the righthandside.
        !           392:                 *      if this is a structure assignment,
        !           393:                 *          then i want an lvalue to the righthandside.
        !           394:                 *  that's what the intermediate form sez.
        !           395:                 */
        !           396:            switch ( classify( p ) ) {
        !           397:                case TINT:
        !           398:                case TCHAR:
        !           399:                case TBOOL:
        !           400:                case TSCAL:
        !           401:                    precheck( p , "_RANG4" , "_RSNG4" );
        !           402:                case TDOUBLE:
        !           403:                case TPTR:
        !           404:                    p1 = rvalue( r[3] , p , RREQ );
        !           405:                    break;
        !           406:                default:
        !           407:                    p1 = rvalue( r[3] , p , LREQ );
        !           408:                    break;
        !           409:            }
        !           410: #      endif PC
        !           411:        if (p1 == NIL)
        !           412:                return (NIL);
        !           413:        if (incompat(p1, p, r[3])) {
        !           414:                cerror("Type of expression clashed with type of variable in assignment");
        !           415:                return (NIL);
        !           416:        }
        !           417: #      ifdef OBJ
        !           418:            switch (classify(p)) {
        !           419:                    case TINT:
        !           420:                    case TBOOL:
        !           421:                    case TCHAR:
        !           422:                    case TSCAL:
        !           423:                            rangechk(p, p1);
        !           424:                            gen(O_AS2, O_AS2, w, width(p1));
        !           425:                            break;
        !           426:                    case TDOUBLE:
        !           427:                    case TPTR:
        !           428:                            gen(O_AS2, O_AS2, w, width(p1));
        !           429:                            break;
        !           430:                    default:
        !           431:                            put(2, O_AS, w);
        !           432:                            break;
        !           433:            }
        !           434: #      endif OBJ
        !           435: #      ifdef PC
        !           436:            switch (classify(p)) {
        !           437:                    case TINT:
        !           438:                    case TBOOL:
        !           439:                    case TCHAR:
        !           440:                    case TSCAL:
        !           441:                            postcheck(p, p1);
        !           442:                            sconv(p2type(p1), p2type(p));
        !           443:                            putop( P2ASSIGN , p2type( p ) );
        !           444:                            putdot( filename , line );
        !           445:                            break;
        !           446:                    case TPTR:
        !           447:                            putop( P2ASSIGN , p2type( p ) );
        !           448:                            putdot( filename , line );
        !           449:                            break;
        !           450:                    case TDOUBLE:
        !           451:                            sconv(p2type(p1), p2type(p));
        !           452:                            putop( P2ASSIGN , p2type( p ) );
        !           453:                            putdot( filename , line );
        !           454:                            break;
        !           455:                    default:
        !           456:                            putstrop(P2STASG, ADDTYPE(p2type(p), P2PTR),
        !           457:                                        lwidth(p), align(p));
        !           458:                            putdot( filename , line );
        !           459:                            break;
        !           460:            }
        !           461: #      endif PC
        !           462:        return (p);     /* Used by for statement */
        !           463: }
        !           464: 
        !           465: /*
        !           466:  * if expr then stat [ else stat ]
        !           467:  */
        !           468: ifop(r)
        !           469:        int *r;
        !           470: {
        !           471:        register struct nl *p;
        !           472:        register l1, l2;        /* l1 is start of else, l2 is end of else */
        !           473:        int goc;
        !           474:        bool nr;
        !           475: 
        !           476:        goc = gocnt;
        !           477:        if (r == NIL)
        !           478:                return;
        !           479:        putline();
        !           480:        p = rvalue(r[2], NIL , RREQ );
        !           481:        if (p == NIL) {
        !           482:                statement(r[3]);
        !           483:                noreach = 0;
        !           484:                statement(r[4]);
        !           485:                noreach = 0;
        !           486:                return;
        !           487:        }
        !           488:        if (isnta(p, "b")) {
        !           489:                error("Type of expression in if statement must be Boolean, not %s", nameof(p));
        !           490:                statement(r[3]);
        !           491:                noreach = 0;
        !           492:                statement(r[4]);
        !           493:                noreach = 0;
        !           494:                return;
        !           495:        }
        !           496: #      ifdef OBJ
        !           497:            l1 = put(2, O_IF, getlab());
        !           498: #      endif OBJ
        !           499: #      ifdef PC
        !           500:            l1 = getlab();
        !           501:            putleaf( P2ICON , l1 , 0 , P2INT , 0 );
        !           502:            putop( P2CBRANCH , P2INT );
        !           503:            putdot( filename , line );
        !           504: #      endif PC
        !           505:        putcnt();
        !           506:        statement(r[3]);
        !           507:        nr = noreach;
        !           508:        if (r[4] != NIL) {
        !           509:                /*
        !           510:                 * else stat
        !           511:                 */
        !           512:                --level;
        !           513:                ungoto();
        !           514:                ++level;
        !           515: #              ifdef OBJ
        !           516:                    l2 = put(2, O_TRA, getlab());
        !           517: #              endif OBJ
        !           518: #              ifdef PC
        !           519:                    l2 = getlab();
        !           520:                    putjbr( l2 );
        !           521: #              endif PC
        !           522:                patch(l1);
        !           523:                noreach = 0;
        !           524:                statement(r[4]);
        !           525:                noreach = (noreach && nr);
        !           526:                l1 = l2;
        !           527:        } else
        !           528:                noreach = 0;
        !           529:        patch(l1);
        !           530:        if (goc != gocnt)
        !           531:                putcnt();
        !           532: }
        !           533: 
        !           534: /*
        !           535:  * while expr do stat
        !           536:  */
        !           537: whilop(r)
        !           538:        int *r;
        !           539: {
        !           540:        register struct nl *p;
        !           541:        register l1, l2;
        !           542:        int goc;
        !           543: 
        !           544:        goc = gocnt;
        !           545:        if (r == NIL)
        !           546:                return;
        !           547:        putlab(l1 = getlab());
        !           548:        putline();
        !           549:        p = rvalue(r[2], NIL , RREQ );
        !           550:        if (p == NIL) {
        !           551:                statement(r[3]);
        !           552:                noreach = 0;
        !           553:                return;
        !           554:        }
        !           555:        if (isnta(p, "b")) {
        !           556:                error("Type of expression in while statement must be Boolean, not %s", nameof(p));
        !           557:                statement(r[3]);
        !           558:                noreach = 0;
        !           559:                return;
        !           560:        }
        !           561:        l2 = getlab();
        !           562: #      ifdef OBJ
        !           563:            put(2, O_IF, l2);
        !           564: #      endif OBJ
        !           565: #      ifdef PC
        !           566:            putleaf( P2ICON , l2 , 0 , P2INT , 0 );
        !           567:            putop( P2CBRANCH , P2INT );
        !           568:            putdot( filename , line );
        !           569: #      endif PC
        !           570:        putcnt();
        !           571:        statement(r[3]);
        !           572: #      ifdef OBJ
        !           573:            put(2, O_TRA, l1);
        !           574: #      endif OBJ
        !           575: #      ifdef PC
        !           576:            putjbr( l1 );
        !           577: #      endif PC
        !           578:        patch(l2);
        !           579:        if (goc != gocnt)
        !           580:                putcnt();
        !           581: }
        !           582: 
        !           583: /*
        !           584:  * repeat stat* until expr
        !           585:  */
        !           586: repop(r)
        !           587:        int *r;
        !           588: {
        !           589:        register struct nl *p;
        !           590:        register l;
        !           591:        int goc;
        !           592: 
        !           593:        goc = gocnt;
        !           594:        if (r == NIL)
        !           595:                return;
        !           596:        l = putlab(getlab());
        !           597:        putcnt();
        !           598:        statlist(r[2]);
        !           599:        line = r[1];
        !           600:        p = rvalue(r[3], NIL , RREQ );
        !           601:        if (p == NIL)
        !           602:                return;
        !           603:        if (isnta(p,"b")) {
        !           604:                error("Until expression type must be Boolean, not %s, in repeat statement", nameof(p));
        !           605:                return;
        !           606:        }
        !           607: #      ifdef OBJ
        !           608:            put(2, O_IF, l);
        !           609: #      endif OBJ
        !           610: #      ifdef PC
        !           611:            putleaf( P2ICON , l , 0 , P2INT , 0 );
        !           612:            putop( P2CBRANCH , P2INT );
        !           613:            putdot( filename , line );
        !           614: #      endif PC
        !           615:        if (goc != gocnt)
        !           616:                putcnt();
        !           617: }

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