Annotation of 41BSD/cmd/pi/stat.c, revision 1.1.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.