Annotation of 40BSD/cmd/pc0/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.1 8/27/80";
        !             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: 
        !            14: int cntstat;
        !            15: short cnts = 3;
        !            16: #include "opcode.h"
        !            17: 
        !            18: /*
        !            19:  * Statement list
        !            20:  */
        !            21: statlist(r)
        !            22:        int *r;
        !            23: {
        !            24:        register *sl;
        !            25: 
        !            26:        for (sl=r; sl != NIL; sl=sl[2])
        !            27:                statement(sl[1]);
        !            28: }
        !            29: 
        !            30: /*
        !            31:  * Statement
        !            32:  */
        !            33: statement(r)
        !            34:        int *r;
        !            35: {
        !            36:        register *s;
        !            37:        register struct nl *snlp;
        !            38:        long    soffset;
        !            39: 
        !            40:        s = r;
        !            41:        snlp = nlp;
        !            42:        soffset = sizes[ cbn ].om_off;
        !            43: top:
        !            44:        if (cntstat) {
        !            45:                cntstat = 0;
        !            46:                putcnt();
        !            47:        }
        !            48:        if (s == NIL)
        !            49:                return;
        !            50:        line = s[1];
        !            51:        if (s[0] == T_LABEL) {
        !            52:                labeled(s[2]);
        !            53:                s = s[3];
        !            54:                noreach = 0;
        !            55:                cntstat = 1;
        !            56:                goto top;
        !            57:        }
        !            58:        if (noreach) {
        !            59:                noreach = 0;
        !            60:                warning();
        !            61:                error("Unreachable statement");
        !            62:        }
        !            63:        switch (s[0]) {
        !            64:                case T_PCALL:
        !            65:                        putline();
        !            66: #                      ifdef OBJ
        !            67:                            proc(s);
        !            68: #                      endif OBJ
        !            69: #                      ifdef PC
        !            70:                            pcproc( s );
        !            71: #                      endif PC
        !            72:                        break;
        !            73:                case T_ASGN:
        !            74:                        putline();
        !            75:                        asgnop(s);
        !            76:                        break;
        !            77:                case T_GOTO:
        !            78:                        putline();
        !            79:                        gotoop(s[2]);
        !            80:                        noreach = 1;
        !            81:                        cntstat = 1;
        !            82:                        break;
        !            83:                default:
        !            84:                        level++;
        !            85:                        switch (s[0]) {
        !            86:                                default:
        !            87:                                        panic("stat");
        !            88:                                case T_IF:
        !            89:                                case T_IFEL:
        !            90:                                        ifop(s);
        !            91:                                        break;
        !            92:                                case T_WHILE:
        !            93:                                        whilop(s);
        !            94:                                        noreach = 0;
        !            95:                                        break;
        !            96:                                case T_REPEAT:
        !            97:                                        repop(s);
        !            98:                                        break;
        !            99:                                case T_FORU:
        !           100:                                case T_FORD:
        !           101: #                                      ifdef OBJ
        !           102:                                            forop(s);
        !           103: #                                      endif OBJ
        !           104: #                                      ifdef PC
        !           105:                                            pcforop( s );
        !           106: #                                      endif PC
        !           107:                                        noreach = 0;
        !           108:                                        break;
        !           109:                                case T_BLOCK:
        !           110:                                        statlist(s[2]);
        !           111:                                        break;
        !           112:                                case T_CASE:
        !           113:                                        putline();
        !           114: #                                      ifdef OBJ
        !           115:                                            caseop(s);
        !           116: #                                      endif OBJ
        !           117: #                                      ifdef PC
        !           118:                                            pccaseop( s );
        !           119: #                                      endif PC
        !           120:                                        break;
        !           121:                                case T_WITH:
        !           122:                                        withop(s);
        !           123:                                        break;
        !           124:                                case T_ASRT:
        !           125:                                        putline();
        !           126:                                        asrtop(s);
        !           127:                                        break;
        !           128:                        }
        !           129:                        --level;
        !           130:                        if (gotos[cbn])
        !           131:                                ungoto();
        !           132:                        break;
        !           133:        }
        !           134:        /*
        !           135:         * Free the temporary name list entries defined in
        !           136:         * expressions, e.g. STRs, and WITHPTRs from withs.
        !           137:         */
        !           138:        nlfree(snlp);
        !           139:            /*
        !           140:             *  free any temporaries allocated for this statement
        !           141:             *  these come from strings and sets.
        !           142:             */
        !           143:        if ( soffset != sizes[ cbn ].om_off ) {
        !           144:            sizes[ cbn ].om_off = soffset;
        !           145: #          ifdef PC
        !           146:                putlbracket( ftnno , -sizes[cbn].om_off );
        !           147: #          endif PC
        !           148:        }
        !           149: }
        !           150: 
        !           151: ungoto()
        !           152: {
        !           153:        register struct nl *p;
        !           154: 
        !           155:        for (p = gotos[cbn]; p != NIL; p = p->chain)
        !           156:                if ((p->nl_flags & NFORWD) != 0) {
        !           157:                        if (p->value[NL_GOLEV] != NOTYET)
        !           158:                                if (p->value[NL_GOLEV] > level)
        !           159:                                        p->value[NL_GOLEV] = level;
        !           160:                } else
        !           161:                        if (p->value[NL_GOLEV] != DEAD)
        !           162:                                if (p->value[NL_GOLEV] > level)
        !           163:                                        p->value[NL_GOLEV] = DEAD;
        !           164: }
        !           165: 
        !           166: putcnt()
        !           167: {
        !           168: 
        !           169:        if (monflg == 0) {
        !           170:                return;
        !           171:        }
        !           172:        inccnt( getcnt() );
        !           173: }
        !           174: 
        !           175: int
        !           176: getcnt()
        !           177:     {
        !           178:        
        !           179:        return ++cnts;
        !           180:     }
        !           181: 
        !           182: inccnt( counter )
        !           183:     int        counter;
        !           184:     {
        !           185: 
        !           186: #      ifdef OBJ
        !           187:            put2(O_COUNT, counter );
        !           188: #      endif OBJ
        !           189: #      ifdef PC
        !           190:            putRV( PCPCOUNT , 0 , counter * sizeof (long) , P2INT );
        !           191:            putleaf( P2ICON , 1 , 0 , P2INT , 0 );
        !           192:            putop( P2ASG P2PLUS , P2INT );
        !           193:            putdot( filename , line );
        !           194: #      endif PC
        !           195:     }
        !           196: 
        !           197: putline()
        !           198: {
        !           199: 
        !           200: #      ifdef OBJ
        !           201:            if (opt('p') != 0)
        !           202:                    put2(O_LINO, line);
        !           203: #      endif OBJ
        !           204: #      ifdef PC
        !           205:            static lastline;
        !           206: 
        !           207:            if ( line != lastline ) {
        !           208:                stabline( line );
        !           209:                lastline = line;
        !           210:            }
        !           211:            if ( opt( 'p' ) ) {
        !           212:                if ( opt('t') ) {
        !           213:                    putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
        !           214:                            , "_LINO" );
        !           215:                    putop( P2UNARY P2CALL , P2INT );
        !           216:                    putdot( filename , line );
        !           217:                } else {
        !           218:                    putRV( STMTCOUNT , 0 , 0 , P2INT );
        !           219:                    putleaf( P2ICON , 1 , 0 , P2INT , 0 );
        !           220:                    putop( P2ASG P2PLUS , P2INT );
        !           221:                    putdot( filename , line );
        !           222:                }
        !           223:            }
        !           224: #      endif PC
        !           225: }
        !           226: 
        !           227: /*
        !           228:  * With varlist do stat
        !           229:  *
        !           230:  * With statement requires an extra word
        !           231:  * in automatic storage for each level of withing.
        !           232:  * These indirect pointers are initialized here, and
        !           233:  * the scoping effect of the with statement occurs
        !           234:  * because lookup examines the field names of the records
        !           235:  * associated with the WITHPTRs on the withlist.
        !           236:  */
        !           237: withop(s)
        !           238:        int *s;
        !           239: {
        !           240:        register *p;
        !           241:        register struct nl *r;
        !           242:        int i;
        !           243:        int *swl;
        !           244:        long soffset;
        !           245: 
        !           246:        putline();
        !           247:        swl = withlist;
        !           248:        soffset = sizes[cbn].om_off;
        !           249:        for (p = s[2]; p != NIL; p = p[2]) {
        !           250:                i = sizes[cbn].om_off -= sizeof ( int * );
        !           251:                if (sizes[cbn].om_off < sizes[cbn].om_max)
        !           252:                        sizes[cbn].om_max = sizes[cbn].om_off;
        !           253: #              ifdef OBJ
        !           254:                    put2(O_LV | cbn <<8+INDX, i );
        !           255: #              endif OBJ
        !           256: #              ifdef PC
        !           257:                    putlbracket( ftnno , -sizes[cbn].om_off );
        !           258:                    putRV( 0 , cbn , i , P2PTR|P2STRTY );
        !           259: #              endif PC
        !           260:                r = lvalue(p[1], MOD , LREQ );
        !           261:                if (r == NIL)
        !           262:                        continue;
        !           263:                if (r->class != RECORD) {
        !           264:                        error("Variable in with statement refers to %s, not to a record", nameof(r));
        !           265:                        continue;
        !           266:                }
        !           267:                r = defnl(0, WITHPTR, r, i);
        !           268:                r->nl_next = withlist;
        !           269:                withlist = r;
        !           270: #              ifdef OBJ
        !           271:                    put(1, PTR_AS);
        !           272: #              endif OBJ
        !           273: #              ifdef PC
        !           274:                    putop( P2ASSIGN , P2PTR|P2STRTY );
        !           275:                    putdot( filename , line );
        !           276: #              endif PC
        !           277:        }
        !           278:        statement(s[3]);
        !           279:        sizes[cbn].om_off = soffset;
        !           280: #      ifdef PC
        !           281:            putlbracket( ftnno , -sizes[cbn].om_off );
        !           282: #      endif PC
        !           283:        withlist = swl;
        !           284: }
        !           285: 
        !           286: extern flagwas;
        !           287: /*
        !           288:  * var := expr
        !           289:  */
        !           290: asgnop(r)
        !           291:        int *r;
        !           292: {
        !           293:        register struct nl *p;
        !           294:        register *av;
        !           295: 
        !           296:        if (r == NIL)
        !           297:                return (NIL);
        !           298:        /*
        !           299:         * Asgnop's only function is
        !           300:         * to handle function variable
        !           301:         * assignments.  All other assignment
        !           302:         * stuff is handled by asgnop1.
        !           303:         * the if below checks for unqualified lefthandside:
        !           304:         * necessary for fvars.
        !           305:         */
        !           306:        av = r[2];
        !           307:        if (av != NIL && av[0] == T_VAR && av[3] == NIL) {
        !           308:                p = lookup1(av[2]);
        !           309:                if (p != NIL)
        !           310:                        p->nl_flags = flagwas;
        !           311:                if (p != NIL && p->class == FVAR) {
        !           312:                        /*
        !           313:                         * Give asgnop1 the func
        !           314:                         * which is the chain of
        !           315:                         * the FVAR.
        !           316:                         */
        !           317:                        p->nl_flags |= NUSED|NMOD;
        !           318:                        p = p->chain;
        !           319:                        if (p == NIL) {
        !           320:                                rvalue(r[3], NIL , RREQ );
        !           321:                                return;
        !           322:                        }
        !           323: #                      ifdef OBJ
        !           324:                            put2(O_LV | bn << 8+INDX, p->value[NL_OFFS]);
        !           325:                            if (isa(p->type, "i") && width(p->type) == 1)
        !           326:                                    asgnop1(r, nl+T2INT);
        !           327:                            else
        !           328:                                    asgnop1(r, p->type);
        !           329: #                      endif OBJ
        !           330: #                      ifdef PC
        !           331:                                /*
        !           332:                                 * this should be the lvalue of the fvar,
        !           333:                                 * but since the second pass knows to use
        !           334:                                 * the address of the left operand of an
        !           335:                                 * assignment, what i want here is an rvalue.
        !           336:                                 * see note in funchdr about fvar allocation.
        !           337:                                 */
        !           338:                            p = p -> ptr[ NL_FVAR ];
        !           339:                            putRV( p -> symbol , bn , p -> value[ NL_OFFS ]
        !           340:                                        , p2type( p -> type ) );
        !           341:                            asgnop1( r , p -> type );
        !           342: #                      endif PC
        !           343:                        return;
        !           344:                }
        !           345:        }
        !           346:        asgnop1(r, NIL);
        !           347: }
        !           348: 
        !           349: /*
        !           350:  * Asgnop1 handles all assignments.
        !           351:  * If p is not nil then we are assigning
        !           352:  * to a function variable, otherwise
        !           353:  * we look the variable up ourselves.
        !           354:  */
        !           355: struct nl *
        !           356: asgnop1(r, p)
        !           357:        int *r;
        !           358:        register struct nl *p;
        !           359: {
        !           360:        register struct nl *p1;
        !           361: 
        !           362:        if (r == NIL)
        !           363:                return (NIL);
        !           364:        if (p == NIL) {
        !           365: #          ifdef OBJ
        !           366:                p = lvalue(r[2], MOD|ASGN|NOUSE , LREQ );
        !           367: #          endif OBJ
        !           368: #          ifdef PC
        !           369:                    /*
        !           370:                     * since the second pass knows that it should reference
        !           371:                     * the lefthandside of asignments, what i need here is
        !           372:                     * an rvalue.
        !           373:                     */
        !           374:                p = lvalue( r[2] , MOD|ASGN|NOUSE , RREQ );
        !           375: #          endif PC
        !           376:            if ( p == NIL ) {
        !           377:                rvalue( r[3] , NIL , RREQ );
        !           378:                return NIL;
        !           379:            }
        !           380:        }
        !           381: #      ifdef OBJ
        !           382:            p1 = rvalue(r[3], p , RREQ );
        !           383: #      endif OBJ
        !           384: #      ifdef PC
        !           385:                /*
        !           386:                 *      if this is a scalar assignment,
        !           387:                 *          then i want to rvalue the righthandside.
        !           388:                 *      if this is a structure assignment,
        !           389:                 *          then i want an lvalue to the righthandside.
        !           390:                 *  that's what the intermediate form sez.
        !           391:                 */
        !           392:            switch ( classify( p ) ) {
        !           393:                case TINT:
        !           394:                case TCHAR:
        !           395:                case TBOOL:
        !           396:                case TSCAL:
        !           397:                    precheck( p , "_RANG4" , "_RSNG4" );
        !           398:                case TDOUBLE:
        !           399:                case TPTR:
        !           400:                    p1 = rvalue( r[3] , p , RREQ );
        !           401:                    break;
        !           402:                default:
        !           403:                    p1 = rvalue( r[3] , p , LREQ );
        !           404:                    break;
        !           405:            }
        !           406: #      endif PC
        !           407:        if (p1 == NIL)
        !           408:                return (NIL);
        !           409:        if (incompat(p1, p, r[3])) {
        !           410:                cerror("Type of expression clashed with type of variable in assignment");
        !           411:                return (NIL);
        !           412:        }
        !           413:        switch (classify(p)) {
        !           414:                case TINT:
        !           415:                case TBOOL:
        !           416:                case TCHAR:
        !           417:                case TSCAL:
        !           418: #                      ifdef OBJ
        !           419:                            rangechk(p, p1);
        !           420: #                      endif OBJ
        !           421: #                      ifdef PC
        !           422:                            postcheck( p );
        !           423: #                      endif PC
        !           424:                case TDOUBLE:
        !           425:                case TPTR:
        !           426: #                      ifdef OBJ
        !           427:                            gen(O_AS2, O_AS2, width(p), width(p1));
        !           428: #                      endif OBJ
        !           429: #                      ifdef PC
        !           430:                            putop( P2ASSIGN , p2type( p ) );
        !           431:                            putdot( filename , line );
        !           432: #                      endif PC
        !           433:                        break;
        !           434:                default:
        !           435: #                      ifdef OBJ
        !           436:                            put2(O_AS, width(p));
        !           437: #                      endif OBJ
        !           438: #                      ifdef PC
        !           439:                            putstrop( P2STASG , p2type( p )
        !           440:                                        , lwidth( p ) , align( p ) );
        !           441:                            putdot( filename , line );
        !           442: #                      endif PC
        !           443:        }
        !           444:        return (p);     /* Used by for statement */
        !           445: }
        !           446: 
        !           447: #ifdef OBJ
        !           448: /*
        !           449:  * for var := expr [down]to expr do stat
        !           450:  */
        !           451: forop(r)
        !           452:        int *r;
        !           453: {
        !           454:        register struct nl *t1, *t2;
        !           455:        int l1, l2, l3;
        !           456:        long soffset;
        !           457:        register op;
        !           458:        struct nl *p;
        !           459:        int *rr, goc, i;
        !           460: 
        !           461:        p = NIL;
        !           462:        goc = gocnt;
        !           463:        if (r == NIL)
        !           464:                goto aloha;
        !           465:        putline();
        !           466:        /*
        !           467:         * Start with assignment
        !           468:         * of initial value to for variable
        !           469:         */
        !           470:        t1 = asgnop1(r[2], NIL);
        !           471:        if (t1 == NIL) {
        !           472:                rvalue(r[3], NIL , RREQ );
        !           473:                statement(r[4]);
        !           474:                goto aloha;
        !           475:        }
        !           476:        rr = r[2];              /* Assignment */
        !           477:        rr = rr[2];             /* Lhs variable */
        !           478:        if (rr[3] != NIL) {
        !           479:                error("For variable must be unqualified");
        !           480:                rvalue(r[3], NIL , RREQ );
        !           481:                statement(r[4]);
        !           482:                goto aloha;
        !           483:        }
        !           484:        p = lookup(rr[2]);
        !           485:        p->value[NL_FORV] = 1;
        !           486:        if (isnta(t1, "bcis")) {
        !           487:                error("For variables cannot be %ss", nameof(t1));
        !           488:                statement(r[4]);
        !           489:                goto aloha;
        !           490:        }
        !           491:        /*
        !           492:         * Allocate automatic
        !           493:         * space for limit variable
        !           494:         */
        !           495:        sizes[cbn].om_off -= 4;
        !           496:        if (sizes[cbn].om_off < sizes[cbn].om_max)
        !           497:                sizes[cbn].om_max = sizes[cbn].om_off;
        !           498:        i = sizes[cbn].om_off;
        !           499:        /*
        !           500:         * Initialize the limit variable
        !           501:         */
        !           502:        put2(O_LV | cbn<<8+INDX, i);
        !           503:        t2 = rvalue(r[3], NIL , RREQ );
        !           504:        if (incompat(t2, t1, r[3])) {
        !           505:                cerror("Limit type clashed with index type in 'for' statement");
        !           506:                statement(r[4]);
        !           507:                goto aloha;
        !           508:        }
        !           509:        put1(width(t2) <= 2 ? O_AS24 : O_AS4);
        !           510:        /*
        !           511:         * See if we can skip the loop altogether
        !           512:         */
        !           513:        rr = r[2];
        !           514:        if (rr != NIL)
        !           515:                rvalue(rr[2], NIL , RREQ );
        !           516:        put2(O_RV4 | cbn<<8+INDX, i);
        !           517:        gen(NIL, r[0] == T_FORU ? T_LE : T_GE, width(t1), 4);
        !           518:        /*
        !           519:         * L1 will be patched to skip the body of the loop.
        !           520:         * L2 marks the top of the loop when we go around.
        !           521:         */
        !           522:        put2(O_IF, (l1 = getlab()));
        !           523:        putlab(l2 = getlab());
        !           524:        putcnt();
        !           525:        statement(r[4]);
        !           526:        /*
        !           527:         * now we see if we get to go again
        !           528:         */
        !           529:        if (opt('t') == 0) {
        !           530:                /*
        !           531:                 * Easy if we dont have to test
        !           532:                 */
        !           533:                put2(O_RV4 | cbn<<8+INDX, i);
        !           534:                if (rr != NIL)
        !           535:                        lvalue(rr[2], MOD , RREQ );
        !           536:                put2((r[0] == T_FORU ? O_FOR1U : O_FOR1D) + (width(t1) >> 1), l2);
        !           537:        } else {
        !           538:                line = r[1];
        !           539:                putline();
        !           540:                if (rr != NIL)
        !           541:                        rvalue(rr[2], NIL , RREQ );
        !           542:                put2(O_RV4 | cbn << 8+INDX, i);
        !           543:                gen(NIL, (r[0] == T_FORU ? T_LT : T_GT), width(t1), 4);
        !           544:                l3 = put2(O_IF, getlab());
        !           545:                lvalue((int *) rr[2], MOD , RREQ );
        !           546:                rvalue(rr[2], NIL , RREQ );
        !           547:                put2(O_CON2, 1);
        !           548:                t2 = gen(NIL, r[0] == T_FORU ? T_ADD: T_SUB, width(t1), 2);
        !           549:                rangechk(t1, t2);       /* The point of all this */
        !           550:                gen(O_AS2, O_AS2, width(t1), width(t2));
        !           551:                put2(O_TRA, l2);
        !           552:                patch(l3);
        !           553:        }
        !           554:        sizes[cbn].om_off += 4;
        !           555:        patch(l1);
        !           556: aloha:
        !           557:        noreach = 0;
        !           558:        if (p != NIL)
        !           559:                p->value[NL_FORV] = 0;
        !           560:        if (goc != gocnt)
        !           561:                putcnt();
        !           562: }
        !           563: #endif OBJ
        !           564: 
        !           565: /*
        !           566:  * if expr then stat [ else stat ]
        !           567:  */
        !           568: ifop(r)
        !           569:        int *r;
        !           570: {
        !           571:        register struct nl *p;
        !           572:        register l1, l2;        /* l1 is start of else, l2 is end of else */
        !           573:        int nr, goc;
        !           574: 
        !           575:        goc = gocnt;
        !           576:        if (r == NIL)
        !           577:                return;
        !           578:        putline();
        !           579:        p = rvalue(r[2], NIL , RREQ );
        !           580:        if (p == NIL) {
        !           581:                statement(r[3]);
        !           582:                noreach = 0;
        !           583:                statement(r[4]);
        !           584:                noreach = 0;
        !           585:                return;
        !           586:        }
        !           587:        if (isnta(p, "b")) {
        !           588:                error("Type of expression in if statement must be Boolean, not %s", nameof(p));
        !           589:                statement(r[3]);
        !           590:                noreach = 0;
        !           591:                statement(r[4]);
        !           592:                noreach = 0;
        !           593:                return;
        !           594:        }
        !           595: #      ifdef OBJ
        !           596:            l1 = put2(O_IF, getlab());
        !           597: #      endif OBJ
        !           598: #      ifdef PC
        !           599:            l1 = getlab();
        !           600:            putleaf( P2ICON , l1 , 0 , P2INT , 0 );
        !           601:            putop( P2CBRANCH , P2INT );
        !           602:            putdot( filename , line );
        !           603: #      endif PC
        !           604:        putcnt();
        !           605:        statement(r[3]);
        !           606:        nr = noreach;
        !           607:        if (r[4] != NIL) {
        !           608:                /*
        !           609:                 * else stat
        !           610:                 */
        !           611:                --level;
        !           612:                ungoto();
        !           613:                ++level;
        !           614: #              ifdef OBJ
        !           615:                    l2 = put2(O_TRA, getlab());
        !           616: #              endif OBJ
        !           617: #              ifdef PC
        !           618:                    l2 = getlab();
        !           619:                    putjbr( l2 );
        !           620: #              endif PC
        !           621:                patch(l1);
        !           622:                noreach = 0;
        !           623:                statement(r[4]);
        !           624:                noreach &= nr;
        !           625:                l1 = l2;
        !           626:        } else
        !           627:                noreach = 0;
        !           628:        patch(l1);
        !           629:        if (goc != gocnt)
        !           630:                putcnt();
        !           631: }
        !           632: 
        !           633: /*
        !           634:  * while expr do stat
        !           635:  */
        !           636: whilop(r)
        !           637:        int *r;
        !           638: {
        !           639:        register struct nl *p;
        !           640:        register l1, l2;
        !           641:        int goc;
        !           642: 
        !           643:        goc = gocnt;
        !           644:        if (r == NIL)
        !           645:                return;
        !           646:        putlab(l1 = getlab());
        !           647:        putline();
        !           648:        p = rvalue(r[2], NIL , RREQ );
        !           649:        if (p == NIL) {
        !           650:                statement(r[3]);
        !           651:                noreach = 0;
        !           652:                return;
        !           653:        }
        !           654:        if (isnta(p, "b")) {
        !           655:                error("Type of expression in while statement must be Boolean, not %s", nameof(p));
        !           656:                statement(r[3]);
        !           657:                noreach = 0;
        !           658:                return;
        !           659:        }
        !           660:        l2 = getlab();
        !           661: #      ifdef OBJ
        !           662:            put2(O_IF, l2);
        !           663: #      endif OBJ
        !           664: #      ifdef PC
        !           665:            putleaf( P2ICON , l2 , 0 , P2INT , 0 );
        !           666:            putop( P2CBRANCH , P2INT );
        !           667:            putdot( filename , line );
        !           668: #      endif PC
        !           669:        putcnt();
        !           670:        statement(r[3]);
        !           671: #      ifdef OBJ
        !           672:            put2(O_TRA, l1);
        !           673: #      endif OBJ
        !           674: #      ifdef PC
        !           675:            putjbr( l1 );
        !           676: #      endif PC
        !           677:        patch(l2);
        !           678:        if (goc != gocnt)
        !           679:                putcnt();
        !           680: }
        !           681: 
        !           682: /*
        !           683:  * repeat stat* until expr
        !           684:  */
        !           685: repop(r)
        !           686:        int *r;
        !           687: {
        !           688:        register struct nl *p;
        !           689:        register l;
        !           690:        int goc;
        !           691: 
        !           692:        goc = gocnt;
        !           693:        if (r == NIL)
        !           694:                return;
        !           695:        l = putlab(getlab());
        !           696:        putcnt();
        !           697:        statlist(r[2]);
        !           698:        line = r[1];
        !           699:        p = rvalue(r[3], NIL , RREQ );
        !           700:        if (p == NIL)
        !           701:                return;
        !           702:        if (isnta(p,"b")) {
        !           703:                error("Until expression type must be Boolean, not %s, in repeat statement", nameof(p));
        !           704:                return;
        !           705:        }
        !           706: #      ifdef OBJ
        !           707:            put2(O_IF, l);
        !           708: #      endif OBJ
        !           709: #      ifdef PC
        !           710:            putleaf( P2ICON , l , 0 , P2INT , 0 );
        !           711:            putop( P2CBRANCH , P2INT );
        !           712:            putdot( filename , line );
        !           713: #      endif PC
        !           714:        if (goc != gocnt)
        !           715:                putcnt();
        !           716: }
        !           717: 
        !           718: /*
        !           719:  * assert expr
        !           720:  */
        !           721: asrtop(r)
        !           722:        register int *r;
        !           723: {
        !           724:        register struct nl *q;
        !           725: 
        !           726:        if (opt('s')) {
        !           727:                standard();
        !           728:                error("Assert statement is non-standard");
        !           729:        }
        !           730:        if (!opt('t'))
        !           731:                return;
        !           732:        r = r[2];
        !           733: #      ifdef OBJ
        !           734:            q = rvalue((int *) r, NLNIL , RREQ );
        !           735: #      endif OBJ
        !           736: #      ifdef PC
        !           737:            putleaf( P2ICON , 0 , 0
        !           738:                    , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_ASRT" );
        !           739:            q = stkrval( r , NLNIL , RREQ );
        !           740: #      endif PC
        !           741:        if (q == NIL)
        !           742:                return;
        !           743:        if (isnta(q, "b"))
        !           744:                error("Assert expression must be Boolean, not %ss", nameof(q));
        !           745: #      ifdef OBJ
        !           746:            put1(O_ASRT);
        !           747: #      endif OBJ
        !           748: #      ifdef PC
        !           749:            putop( P2CALL , P2INT );
        !           750:            putdot( filename , line );
        !           751: #      endif PC
        !           752: }

unix.superglobalmegacorp.com

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