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