Return to forop.c CVS log

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

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

1.1     ! root        1: /* Copyright (c) 1979 Regents of the University of California */
        !             2: 
        !             3: static char sccsid[] = "@(#)forop.c 1.16 2/28/83";
        !             4: 
        !             5: #include       "whoami.h"
        !             6: #include       "0.h"
        !             7: #include       "opcode.h"
        !             8: #include       "tree.h"
        !             9: #include       "objfmt.h"
        !            10: #ifdef PC
        !            11: #    include   "pc.h"
        !            12: #    include   "pcops.h"
        !            13: #endif PC
        !            14: #include       "tmps.h"
        !            15: 
        !            16:     /*
        !            17:      * for-statements.
        !            18:      *
        !            19:      * the relevant quote from the standard:  6.8.3.9:
        !            20:      * ``The control-variable shall be an entire-variable whose identifier
        !            21:      * is declared in the variable-declaration-part of the block closest-
        !            22:      * containing the for-statement.  The control-variable shall possess
        !            23:      * an ordinal-type, and the initial-value and the final-value shall be
        !            24:      * of a type compatible with this type.  The statement of a for-statement
        !            25:      * shall not contain an assigning-reference to the control-variable
        !            26:      * of the for-statement.  The value of the final-value shall be 
        !            27:      * assignment-compatible with the control-variable when the initial-value
        !            28:      * is assigned to the control-variable.  After a for-statement is
        !            29:      * executed (other than being left by a goto-statement leading out of it)
        !            30:      * the control-variable shall be undefined.  Apart from the restrictions
        !            31:      * imposed by these requirements, the for-statement
        !            32:      *         for v := e1 to e2 do body
        !            33:      * shall be equivalent to
        !            34:      *         begin
        !            35:      *             temp1 := e1;
        !            36:      *             temp2 := e2;
        !            37:      *             if temp1 <= temp2 then begin
        !            38:      *                 v := temp1;
        !            39:      *                 body;
        !            40:      *                 while v <> temp2 do begin
        !            41:      *                     v := succ(v);
        !            42:      *                     body;
        !            43:      *                 end
        !            44:      *             end
        !            45:      *         end
        !            46:      * where temp1 and temp2 denote auxiliary variables that the program
        !            47:      * does not otherwise contain, and that possess the type possessed by
        !            48:      * the variable v if that type is not a subrange-type;  otherwise the
        !            49:      * host type possessed by the variable v.''
        !            50:      *
        !            51:      * The Berkeley Pascal systems try to do all that without duplicating
        !            52:      * the body, and shadowing the control-variable in (possibly) a
        !            53:      * register variable.
        !            54:      *
        !            55:      * arg here looks like:
        !            56:      * arg[0]  T_FORU or T_FORD
        !            57:      *    [1]  lineof "for"
        !            58:      *    [2]  [0]     T_ASGN
        !            59:      *         [1]     lineof ":="
        !            60:      *         [2]     [0]     T_VAR
        !            61:      *                 [1]     lineof id
        !            62:      *                 [2]     char * to id
        !            63:      *                 [3]     qualifications
        !            64:      *         [3]     initial expression
        !            65:      *   [3]   termination expression
        !            66:      *   [4]   statement
        !            67:      */
        !            68: forop( arg )
        !            69:     int        *arg;
        !            70:     {
        !            71:        int             *lhs;
        !            72:        struct nl       *forvar;
        !            73:        struct nl       *fortype;
        !            74: #ifdef PC
        !            75:        int             forp2type;
        !            76: #endif PC
        !            77:        int             forwidth;
        !            78:        int             *init;
        !            79:        struct nl       *inittype;
        !            80:        struct nl       *initnlp;       /* initial value namelist entry */
        !            81:        int             *term;
        !            82:        struct nl       *termtype;
        !            83:        struct nl       *termnlp;       /* termination value namelist entry */
        !            84:        struct nl       *shadownlp;     /* namelist entry for the shadow */
        !            85:        int             *stat;
        !            86:        int             goc;            /* saved gocnt */
        !            87:        int             again;          /* label at the top of the loop */
        !            88:        int             after;          /* label after the end of the loop */
        !            89:        struct nl       saved_nl;       /* saved namelist entry for loop var */
        !            90: 
        !            91:        goc = gocnt;
        !            92:        forvar = NIL;
        !            93:        if ( arg == NIL ) {
        !            94:            goto byebye;
        !            95:        }
        !            96:        if ( arg[2] == NIL ) {
        !            97:            goto byebye;
        !            98:        }
        !            99:        line = arg[1];
        !           100:        putline();
        !           101:        lhs = ( (int *) arg[2] )[2];
        !           102:        init = ( (int *) arg[2] )[3];
        !           103:        term = arg[3];
        !           104:        stat = arg[4];
        !           105:        if (lhs == NIL) {
        !           106: nogood:
        !           107:            if (forvar != NIL) {
        !           108:                forvar->value[ NL_FORV ] = FORVAR;
        !           109:            }
        !           110:            rvalue( init , NIL , RREQ );
        !           111:            rvalue( term , NIL , RREQ );
        !           112:            statement( stat );
        !           113:            goto byebye;
        !           114:        }
        !           115:            /*
        !           116:             * and this marks the variable as used!!!
        !           117:             */
        !           118:        forvar = lookup( lhs[2] );
        !           119:        if ( forvar == NIL ) {
        !           120:            goto nogood;
        !           121:        }
        !           122:        saved_nl = *forvar;
        !           123:        if ( lhs[3] != NIL ) {
        !           124:            error("For variable %s must be unqualified", forvar->symbol);
        !           125:            goto nogood;
        !           126:        }
        !           127:        if (forvar->class == WITHPTR) {
        !           128:            error("For variable %s cannot be an element of a record", lhs[2]);
        !           129:            goto nogood;
        !           130:        }
        !           131:        if ( opt('s') &&
        !           132:            ( ( bn != cbn ) ||
        !           133: #ifdef OBJ
        !           134:                (whereis(bn, forvar->value[NL_OFFS], 0) == PARAMVAR)
        !           135: #endif OBJ
        !           136: #ifdef PC
        !           137:                (whereis(bn, forvar->value[NL_OFFS], forvar->extra_flags)
        !           138:                    == PARAMVAR )
        !           139: #endif PC
        !           140:            ) ) {
        !           141:            standard();
        !           142:            error("For variable %s must be declared in the block in which it is used", forvar->symbol);
        !           143:        }
        !           144:            /*
        !           145:             * find out the type of the loop variable
        !           146:             */
        !           147:        codeoff();
        !           148:        fortype = lvalue( lhs , MOD , RREQ );
        !           149:        codeon();
        !           150:        if ( fortype == NIL ) {
        !           151:            goto nogood;
        !           152:        }
        !           153:        if ( isnta( fortype , "bcis" ) ) {
        !           154:            error("For variable %s cannot be %ss", forvar->symbol, nameof( fortype ) );
        !           155:            goto nogood;
        !           156:        }
        !           157:        if ( forvar->value[ NL_FORV ] & FORVAR ) {
        !           158:            error("Can't modify the for variable %s in the range of the loop", forvar->symbol);
        !           159:            forvar = NIL;
        !           160:            goto nogood;
        !           161:        }
        !           162:        forwidth = lwidth(fortype);
        !           163: #      ifdef PC
        !           164:            forp2type = p2type(fortype);
        !           165: #      endif PC
        !           166:            /*
        !           167:             *  allocate temporaries for the initial and final expressions
        !           168:             *  and maybe a register to shadow the for variable.
        !           169:             */
        !           170:        initnlp = tmpalloc(sizeof(long), nl+T4INT, NOREG);
        !           171:        termnlp = tmpalloc(sizeof(long), nl+T4INT, NOREG);
        !           172:        shadownlp = tmpalloc(forwidth, fortype, REGOK);
        !           173: #      ifdef PC
        !           174:                /*
        !           175:                 * compute and save the initial expression
        !           176:                 */
        !           177:            putRV( 0 , cbn , initnlp -> value[ NL_OFFS ] ,
        !           178:                    initnlp -> extra_flags , P2INT );
        !           179: #      endif PC
        !           180: #      ifdef OBJ
        !           181:            put(2, O_LV | cbn<<8+INDX, initnlp -> value[ NL_OFFS ] );
        !           182: #      endif OBJ
        !           183:        inittype = rvalue( init , fortype , RREQ );
        !           184:        if ( incompat( inittype , fortype , init ) ) {
        !           185:            cerror("Type of initial expression clashed with index type in 'for' statement");
        !           186:            if (forvar != NIL) {
        !           187:                forvar->value[ NL_FORV ] = FORVAR;
        !           188:            }
        !           189:            rvalue( term , NIL , RREQ );
        !           190:            statement( stat );
        !           191:            goto byebye;
        !           192:        }
        !           193: #      ifdef PC
        !           194:            sconv(p2type(inittype), P2INT);
        !           195:            putop( P2ASSIGN , P2INT );
        !           196:            putdot( filename , line );
        !           197:                /*
        !           198:                 * compute and save the termination expression
        !           199:                 */
        !           200:            putRV( 0 , cbn , termnlp -> value[ NL_OFFS ] ,
        !           201:                    termnlp -> extra_flags , P2INT );
        !           202: #      endif PC
        !           203: #      ifdef OBJ
        !           204:            gen(O_AS2, O_AS2, sizeof(long), width(inittype));
        !           205:                /*
        !           206:                 * compute and save the termination expression
        !           207:                 */
        !           208:            put(2, O_LV | cbn<<8+INDX, termnlp -> value[ NL_OFFS ] );
        !           209: #      endif OBJ
        !           210:        termtype = rvalue( term , fortype , RREQ );
        !           211:        if ( incompat( termtype , fortype , term ) ) {
        !           212:            cerror("Type of limit expression clashed with index type in 'for' statement");
        !           213:            if (forvar != NIL) {
        !           214:                forvar->value[ NL_FORV ] = FORVAR;
        !           215:            }
        !           216:            statement( stat );
        !           217:            goto byebye;
        !           218:        }
        !           219: #      ifdef PC
        !           220:            sconv(p2type(termtype), P2INT);
        !           221:            putop( P2ASSIGN , P2INT );
        !           222:            putdot( filename , line );
        !           223:                /*
        !           224:                 * we can skip the loop altogether if !( init <= term )
        !           225:                 */
        !           226:            after = getlab();
        !           227:            putRV( 0 , cbn , initnlp -> value[ NL_OFFS ] ,
        !           228:                    initnlp -> extra_flags , P2INT );
        !           229:            putRV( 0 , cbn , termnlp -> value[ NL_OFFS ] ,
        !           230:                    termnlp -> extra_flags , P2INT );
        !           231:            putop( ( arg[0] == T_FORU ? P2LE : P2GE ) , P2INT );
        !           232:            putleaf( P2ICON , after , 0 , P2INT , 0 );
        !           233:            putop( P2CBRANCH , P2INT );
        !           234:            putdot( filename , line );
        !           235:                /*
        !           236:                 * okay, so we have to execute the loop body,
        !           237:                 * but first, if checking is on,
        !           238:                 * check that the termination expression
        !           239:                 * is assignment compatible with the control-variable.
        !           240:                 */
        !           241:            if (opt('t')) {
        !           242:                precheck(fortype, "_RANG4", "_RSNG4");
        !           243:                putRV(0, cbn, termnlp -> value[NL_OFFS],
        !           244:                    termnlp -> extra_flags, P2INT);
        !           245:                postcheck(fortype, nl+T4INT);
        !           246:                putdot(filename, line);
        !           247:            }
        !           248:                /*
        !           249:                 * assign the initial expression to the shadow
        !           250:                 * checking the assignment if necessary.
        !           251:                 */
        !           252:            putRV(0, cbn, shadownlp -> value[NL_OFFS],
        !           253:                shadownlp -> extra_flags, forp2type);
        !           254:            if (opt('t')) {
        !           255:                precheck(fortype, "_RANG4", "_RSNG4");
        !           256:                putRV(0, cbn, initnlp -> value[NL_OFFS],
        !           257:                    initnlp -> extra_flags, P2INT);
        !           258:                postcheck(fortype, nl+T4INT);
        !           259:            } else {
        !           260:                putRV(0, cbn, initnlp -> value[NL_OFFS],
        !           261:                    initnlp -> extra_flags, P2INT);
        !           262:            }
        !           263:            sconv(P2INT, forp2type);
        !           264:            putop(P2ASSIGN, forp2type);
        !           265:            putdot(filename, line);
        !           266:                /*
        !           267:                 * put down the label at the top of the loop
        !           268:                 */
        !           269:            again = getlab();
        !           270:            putlab( again );
        !           271:                /*
        !           272:                 * each time through the loop
        !           273:                 * assign the shadow to the for variable.
        !           274:                 */
        !           275:            lvalue(lhs, NOUSE, RREQ);
        !           276:            putRV(0, cbn, shadownlp -> value[NL_OFFS],
        !           277:                    shadownlp -> extra_flags, forp2type);
        !           278:            putop(P2ASSIGN, forp2type);
        !           279:            putdot(filename, line);
        !           280: #      endif PC
        !           281: #      ifdef OBJ
        !           282:            gen(O_AS2, O_AS2, sizeof(long), width(termtype));
        !           283:                /*
        !           284:                 * we can skip the loop altogether if !( init <= term )
        !           285:                 */
        !           286:            put(2, O_RV4 | cbn<<8+INDX, initnlp -> value[ NL_OFFS ] );
        !           287:            put(2, O_RV4 | cbn<<8+INDX, termnlp -> value[ NL_OFFS ] );
        !           288:            gen(NIL, arg[0] == T_FORU ? T_LE : T_GE, sizeof(long),
        !           289:                        sizeof(long));
        !           290:            after = getlab();
        !           291:            put(2, O_IF, after);
        !           292:                /*
        !           293:                 * okay, so we have to execute the loop body,
        !           294:                 * but first, if checking is on,
        !           295:                 * check that the termination expression
        !           296:                 * is assignment compatible with the control-variable.
        !           297:                 */
        !           298:            if (opt('t')) {
        !           299:                put(2, O_LV | cbn<<8+INDX, shadownlp -> value[ NL_OFFS ] );
        !           300:                put(2, O_RV4 | cbn<<8+INDX, termnlp -> value[ NL_OFFS ] );
        !           301:                rangechk(fortype, nl+T4INT);
        !           302:                gen(O_AS2, O_AS2, forwidth, sizeof(long));
        !           303:            }
        !           304:                /*
        !           305:                 * assign the initial expression to the shadow
        !           306:                 * checking the assignment if necessary.
        !           307:                 */
        !           308:            put(2, O_LV | cbn<<8+INDX, shadownlp -> value[ NL_OFFS ] );
        !           309:            put(2, O_RV4 | cbn<<8+INDX, initnlp -> value[ NL_OFFS ] );
        !           310:            rangechk(fortype, nl+T4INT);
        !           311:            gen(O_AS2, O_AS2, forwidth, sizeof(long));
        !           312:                /*
        !           313:                 * put down the label at the top of the loop
        !           314:                 */
        !           315:            again = getlab();
        !           316:            putlab( again );
        !           317:                /*
        !           318:                 * each time through the loop
        !           319:                 * assign the shadow to the for variable.
        !           320:                 */
        !           321:            lvalue(lhs, NOUSE, RREQ);
        !           322:            stackRV(shadownlp);
        !           323:            gen(O_AS2, O_AS2, forwidth, sizeof(long));
        !           324: #      endif OBJ
        !           325:            /*
        !           326:             *  shadowing the real for variable
        !           327:             *  with the shadow temporary:
        !           328:             *  save the real for variable flags (including nl_block).
        !           329:             *  replace them with the shadow's offset,
        !           330:             *  and mark the for variable as being a for variable.
        !           331:             */
        !           332:        shadownlp -> nl_flags |= NLFLAGS(forvar -> nl_flags);
        !           333:        *forvar = *shadownlp;
        !           334:        forvar -> symbol = saved_nl.symbol;
        !           335:        forvar -> nl_next = saved_nl.nl_next;
        !           336:        forvar -> type = saved_nl.type;
        !           337:        forvar -> value[ NL_FORV ] = FORVAR;
        !           338:            /*
        !           339:             * and don't forget ...
        !           340:             */
        !           341:        putcnt();
        !           342:        statement( stat );
        !           343:            /*
        !           344:             * wasn't that fun?  do we get to do it again?
        !           345:             *  we don't do it again if ( !( forvar < limit ) )
        !           346:             *  pretend we were doing this at the top of the loop
        !           347:             */
        !           348:        line = arg[ 1 ];
        !           349: #      ifdef PC
        !           350:            if ( opt( 'p' ) ) {
        !           351:                if ( opt('t') ) {
        !           352:                    putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
        !           353:                            , "_LINO" );
        !           354:                    putop( P2UNARY P2CALL , P2INT );
        !           355:                    putdot( filename , line );
        !           356:                } else {
        !           357:                    putRV( STMTCOUNT , 0 , 0 , NGLOBAL , P2INT );
        !           358:                    putleaf( P2ICON , 1 , 0 , P2INT , 0 );
        !           359:                    putop( P2ASG P2PLUS , P2INT );
        !           360:                    putdot( filename , line );
        !           361:                }
        !           362:            }
        !           363:            /*rvalue( lhs , NIL , RREQ );*/
        !           364:            putRV( 0 , cbn , shadownlp -> value[ NL_OFFS ] ,
        !           365:                    shadownlp -> extra_flags , forp2type );
        !           366:            sconv(forp2type, P2INT);
        !           367:            putRV( 0 , cbn , termnlp -> value[ NL_OFFS ] ,
        !           368:                    termnlp -> extra_flags , P2INT );
        !           369:            putop( ( arg[ 0 ] == T_FORU ? P2LT : P2GT ) , P2INT );
        !           370:            putleaf( P2ICON , after , 0 , P2INT , 0 );
        !           371:            putop( P2CBRANCH , P2INT );
        !           372:            putdot( filename , line );
        !           373:                /*
        !           374:                 * okay, so we have to do it again,
        !           375:                 * but first, increment the for variable.
        !           376:                 * no need to rangecheck it, since we checked the
        !           377:                 * termination value before we started.
        !           378:                 */
        !           379:            /*lvalue( lhs , MOD , RREQ );*/
        !           380:            putRV( 0 , cbn , shadownlp -> value[ NL_OFFS ] ,
        !           381:                    shadownlp -> extra_flags , forp2type );
        !           382:            /*rvalue( lhs , NIL , RREQ );*/
        !           383:            putRV( 0 , cbn , shadownlp -> value[ NL_OFFS ] ,
        !           384:                    shadownlp -> extra_flags , forp2type );
        !           385:            sconv(forp2type, P2INT);
        !           386:            putleaf( P2ICON , 1 , 0 , P2INT , 0 );
        !           387:            putop( ( arg[0] == T_FORU ? P2PLUS : P2MINUS ) , P2INT );
        !           388:            sconv(P2INT, forp2type);
        !           389:            putop( P2ASSIGN , forp2type );
        !           390:            putdot( filename , line );
        !           391:                /*
        !           392:                 * and do it all again
        !           393:                 */
        !           394:            putjbr( again );
        !           395:                /*
        !           396:                 * and here we are
        !           397:                 */
        !           398:            putlab( after );
        !           399: #      endif PC
        !           400: #      ifdef OBJ
        !           401:                /*
        !           402:                 * okay, so we have to do it again.
        !           403:                 * Luckily we have a magic opcode which increments the
        !           404:                 * index variable, checks the limit falling through if
        !           405:                 * it has been reached, else updating the index variable,
        !           406:                 * and returning to the top of the loop.
        !           407:                 */
        !           408:            putline();
        !           409:            put(2, O_RV4 | cbn<<8+INDX, termnlp -> value[ NL_OFFS ] );
        !           410:            put(2, O_LV | cbn<<8+INDX, shadownlp -> value[ NL_OFFS ] );
        !           411:            put(2, (arg[0] == T_FORU ? O_FOR1U : O_FOR1D) + (forwidth >> 1),
        !           412:                    again);
        !           413:                /*
        !           414:                 * and here we are
        !           415:                 */
        !           416:            patch( after );
        !           417: #      endif OBJ
        !           418: byebye:
        !           419:        noreach = 0;
        !           420:        if (forvar != NIL) {
        !           421:            saved_nl.nl_flags |= NLFLAGS(forvar -> nl_flags) & (NUSED|NMOD);
        !           422:            *forvar = saved_nl;
        !           423:        }
        !           424:        if ( goc != gocnt ) {
        !           425:            putcnt();
        !           426:        }
        !           427:     }

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