Return to forop.c CVS log

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

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

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

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