BSD 4_4 release

[unix-history] / usr / src / usr.bin / pascal / src / stat.c

diff --git a/usr/src/usr.bin/pascal/src/stat.c b/usr/src/usr.bin/pascal/src/stat.c
index 66bf24c..337e579 100644 (file)
--- a/usr/src/usr.bin/pascal/src/stat.c
+++ b/usr/src/usr.bin/pascal/src/stat.c
@@ -1,15 +1,46 @@
-/* Copyright (c) 1979 Regents of the University of California */
+/*-
+ * Copyright (c) 1980, 1993
+ *     The Regents of the University of California.  All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in the
+ *    documentation and/or other materials provided with the distribution.
+ * 3. All advertising materials mentioning features or use of this software
+ *    must display the following acknowledgement:
+ *     This product includes software developed by the University of
+ *     California, Berkeley and its contributors.
+ * 4. Neither the name of the University nor the names of its contributors
+ *    may be used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */

 
 #ifndef lint
 
 #ifndef lint

-static char sccsid[] = "@(#)stat.c 1.13 %G%";
-#endif
+static char sccsid[] = "@(#)stat.c     8.1 (Berkeley) 6/6/93";
+#endif /* not lint */

 
 #include "whoami.h"
 #include "0.h"
 #include "tree.h"
 #include "objfmt.h"
 #ifdef PC
 
 #include "whoami.h"
 #include "0.h"
 #include "tree.h"
 #include "objfmt.h"
 #ifdef PC

-#   include "pcops.h"
+#   include <pcc.h>

 #   include "pc.h"
 #endif PC
 #include "tmps.h"
 #   include "pc.h"
 #endif PC
 #include "tmps.h"


@@ -177,9 +208,9 @@ inccnt( counter )
            (void) put(2, O_COUNT, counter );
 #      endif OBJ
 #      ifdef PC
            (void) put(2, O_COUNT, counter );
 #      endif OBJ
 #      ifdef PC

-           putRV( PCPCOUNT , 0 , counter * sizeof (long) , NGLOBAL , P2INT );
-           putleaf( P2ICON , 1 , 0 , P2INT , (char *) 0 );
-           putop( P2ASG P2PLUS , P2INT );
+           putRV( PCPCOUNT , 0 , counter * sizeof (long) , NGLOBAL , PCCT_INT );
+           putleaf( PCC_ICON , 1 , 0 , PCCT_INT , (char *) 0 );
+           putop( PCCOM_ASG PCC_PLUS , PCCT_INT );

            putdot( filename , line );
 #      endif PC
     }
            putdot( filename , line );
 #      endif PC
     }


@@ -206,14 +237,14 @@ putline()
            }
            if ( opt( 'p' ) ) {
                if ( opt('t') ) {
            }
            if ( opt( 'p' ) ) {
                if ( opt('t') ) {

-                   putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
+                   putleaf( PCC_ICON , 0 , 0 , PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR )

                            , "_LINO" );
                            , "_LINO" );

-                   putop( P2UNARY P2CALL , P2INT );
+                   putop( PCCOM_UNARY PCC_CALL , PCCT_INT );

                    putdot( filename , line );
                } else {
                    putdot( filename , line );
                } else {

-                   putRV( STMTCOUNT , 0 , 0 , NGLOBAL , P2INT );
-                   putleaf( P2ICON , 1 , 0 , P2INT , (char *) 0 );
-                   putop( P2ASG P2PLUS , P2INT );
+                   putRV( STMTCOUNT , 0 , 0 , NGLOBAL , PCCT_INT );
+                   putleaf( PCC_ICON , 1 , 0 , PCCT_INT , (char *) 0 );
+                   putop( PCCOM_ASG PCC_PLUS , PCCT_INT );

                    putdot( filename , line );
                }
            }
                    putdot( filename , line );
                }
            }


@@ -240,6 +271,8 @@ withop(s)
 
        putline();
        swl = withlist;
 
        putline();
        swl = withlist;

+       for (p = s->var_list; p != TR_NIL; p = p->list_node.next) {
+               tempnlp = tmpalloc((long) (sizeof(int *)), nl+TPTR, REGOK);

                    /*
                     *  no one uses the allocated temporary namelist entry,
                     *  since we have to use it before we know its type;
                    /*
                     *  no one uses the allocated temporary namelist entry,
                     *  since we have to use it before we know its type;


@@ -250,7 +283,7 @@ withop(s)
 #              endif OBJ
 #              ifdef PC
                    putRV( (char *) 0 , cbn , tempnlp -> value[ NL_OFFS ] ,
 #              endif OBJ
 #              ifdef PC
                    putRV( (char *) 0 , cbn , tempnlp -> value[ NL_OFFS ] ,

-                           tempnlp -> extra_flags , P2PTR|P2STRTY );
+                           tempnlp -> extra_flags , PCCTM_PTR|PCCT_STRTY );

 #              endif PC
                r = lvalue(p->list_node.list, MOD , LREQ );
                if (r == NLNIL)
 #              endif PC
                r = lvalue(p->list_node.list, MOD , LREQ );
                if (r == NLNIL)


@@ -269,7 +302,7 @@ withop(s)
                    (void) put(1, PTR_AS);
 #              endif OBJ
 #              ifdef PC
                    (void) put(1, PTR_AS);
 #              endif OBJ
 #              ifdef PC

-                   putop( P2ASSIGN , P2PTR|P2STRTY );
+                   putop( PCC_ASSIGN , PCCTM_PTR|PCCT_STRTY );

                    putdot( filename , line );
 #              endif PC
        }
                    putdot( filename , line );
 #              endif PC
        }


@@ -350,62 +383,83 @@ asgnop1(r, p)
        register struct nl *p;
 {
        register struct nl *p1;
        register struct nl *p;
 {
        register struct nl *p1;

+       int     clas;

 #ifdef OBJ
        int w;
 #ifdef OBJ
        int w;

-#endif
+#endif OBJ

 
 

+#ifdef OBJ

        if (p == NLNIL) {
        if (p == NLNIL) {

-#          ifdef OBJ
-               p = lvalue(r->lhs_var, MOD|ASGN|NOUSE , LREQ );
-               w = width(p);
-#          endif OBJ
-#          ifdef PC
-                   /*
-                    * since the second pass knows that it should reference
-                    * the lefthandside of asignments, what i need here is
-                    * an rvalue.
-                    */
-               p = lvalue( r->lhs_var , MOD|ASGN|NOUSE , RREQ );
-#          endif PC
+           p = lvalue(r->lhs_var, MOD|ASGN|NOUSE , LREQ );

            if ( p == NLNIL ) {
                (void) rvalue( r->rhs_expr , NLNIL , RREQ );
                return NLNIL;
            }
            if ( p == NLNIL ) {
                (void) rvalue( r->rhs_expr , NLNIL , RREQ );
                return NLNIL;
            }

-       }
-#      ifdef OBJ
+           w = width(p);
+       } else {

            /*
             * assigning to the return value, which is at least
             * of width two since it resides on the stack
             */
            /*
             * assigning to the return value, which is at least
             * of width two since it resides on the stack
             */

-           else {
-               w = width(p);
-               if (w < 2)
-                   w = 2;
-           }
+           w = width(p);
+           if (w < 2)
+               w = 2;
+       }
+       clas = classify(p);
+       if ((clas == TARY || clas == TSTR) && p->chain->class == CRANGE) {
+           p1 = lvalue(r->rhs_expr, p , LREQ ); /* SHOULD THIS BE rvalue? */
+       } else {

            p1 = rvalue(r->rhs_expr, p , RREQ );
            p1 = rvalue(r->rhs_expr, p , RREQ );

-#      endif OBJ
-#      ifdef PC
+       }
+#   endif OBJ
+#   ifdef PC
+       if (p == NLNIL) {
+           /* check for conformant array type */
+           codeoff();
+           p = rvalue(r->lhs_var, MOD|ASGN|NOUSE, LREQ);
+           codeon();
+           if (p == NLNIL) {
+               (void) rvalue(r->rhs_expr, NLNIL, RREQ);
+               return NLNIL;
+           }
+           clas = classify(p);
+           if ((clas == TARY || clas == TSTR) && p->chain->class == CRANGE) {
+               return pcasgconf(r, p);
+           } else {

                /*
                /*

-                *      if this is a scalar assignment,
-                *          then i want to rvalue the righthandside.
-                *      if this is a structure assignment,
-                *          then i want an lvalue to the righthandside.
-                *  that's what the intermediate form sez.
+                * since the second pass knows that it should reference
+                * the lefthandside of asignments, what i need here is
+                * an rvalue.

                 */
                 */

-           switch ( classify( p ) ) {
-               case TINT:
-               case TCHAR:
-               case TBOOL:
-               case TSCAL:
-                   precheck( p , "_RANG4" , "_RSNG4" );
-               case TDOUBLE:
-               case TPTR:
-                   p1 = rvalue( r->rhs_expr , p , RREQ );
-                   break;
-               default:
-                   p1 = rvalue( r->rhs_expr , p , LREQ );
-                   break;
+               p = lvalue( r->lhs_var , MOD|ASGN|NOUSE , RREQ );

            }
            }

+           if ( p == NLNIL ) {
+               (void) rvalue( r->rhs_expr , NLNIL , RREQ );
+               return NLNIL;
+           }
+       }
+           /*
+            *  if this is a scalar assignment,
+            *      then i want to rvalue the righthandside.
+            *  if this is a structure assignment,
+            *      then i want an lvalue to the righthandside.
+            *  that's what the intermediate form sez.
+            */
+       switch ( classify( p ) ) {
+           case TINT:
+           case TCHAR:
+           case TBOOL:
+           case TSCAL:
+               precheck( p , "_RANG4" , "_RSNG4" );
+               /* and fall through */
+           case TDOUBLE:
+           case TPTR:
+               p1 = rvalue( r->rhs_expr , p , RREQ );
+               break;
+           default:
+               p1 = rvalue( r->rhs_expr , p , LREQ );
+               break;
+       }

 #      endif PC
        if (p1 == NLNIL)
                return (NLNIL);
 #      endif PC
        if (p1 == NLNIL)
                return (NLNIL);


@@ -426,6 +480,23 @@ asgnop1(r, p)
                    case TPTR:
                            (void) gen(O_AS2, O_AS2, w, width(p1));
                            break;
                    case TPTR:
                            (void) gen(O_AS2, O_AS2, w, width(p1));
                            break;

+                   case TARY:
+                   case TSTR:
+                           if (p->chain->class == CRANGE) {
+                               /* conformant array assignment */
+                               p1 = p->chain;
+                               w = width(p1->type);
+                               putcbnds(p1, 1);
+                               putcbnds(p1, 0);
+                               gen(NIL, T_SUB, w, w);
+                               put(2, w > 2? O_CON24: O_CON2, 1);
+                               gen(NIL, T_ADD, w, w);
+                               putcbnds(p1, 2);
+                               gen(NIL, T_MULT, w, w);
+                               put(1, O_VAS);
+                               break;
+                           }
+                           /* else fall through */

                    default:
                            (void) put(2, O_AS, w);
                            break;
                    default:
                            (void) put(2, O_AS, w);
                            break;


@@ -439,20 +510,20 @@ asgnop1(r, p)
                    case TSCAL:
                            postcheck(p, p1);
                            sconv(p2type(p1), p2type(p));
                    case TSCAL:
                            postcheck(p, p1);
                            sconv(p2type(p1), p2type(p));

-                           putop( P2ASSIGN , p2type( p ) );
+                           putop( PCC_ASSIGN , p2type( p ) );

                            putdot( filename , line );
                            break;
                    case TPTR:
                            putdot( filename , line );
                            break;
                    case TPTR:

-                           putop( P2ASSIGN , p2type( p ) );
+                           putop( PCC_ASSIGN , p2type( p ) );

                            putdot( filename , line );
                            break;
                    case TDOUBLE:
                            sconv(p2type(p1), p2type(p));
                            putdot( filename , line );
                            break;
                    case TDOUBLE:
                            sconv(p2type(p1), p2type(p));

-                           putop( P2ASSIGN , p2type( p ) );
+                           putop( PCC_ASSIGN , p2type( p ) );

                            putdot( filename , line );
                            break;
                    default:
                            putdot( filename , line );
                            break;
                    default:

-                           putstrop(P2STASG, ADDTYPE(p2type(p), P2PTR),
+                           putstrop(PCC_STASG, PCCM_ADDTYPE(p2type(p), PCCTM_PTR),

                                        (int) lwidth(p), align(p));
                            putdot( filename , line );
                            break;
                                        (int) lwidth(p), align(p));
                            putdot( filename , line );
                            break;


@@ -461,6 +532,53 @@ asgnop1(r, p)
        return (p);     /* Used by for statement */
 }
 
        return (p);     /* Used by for statement */
 }
 

+#ifdef PC
+/*
+ * assignment to conformant arrays.  Since these are variable length,
+ *     we use blkcpy() to perform the assignment.
+ *     blkcpy(rhs, lhs, (upper - lower + 1) * width)
+ */
+struct nl *
+pcasgconf(r, p)
+       register ASG_NODE *r;
+       struct nl *p;
+{
+       struct nl *p1;
+
+       if (r == (ASG_NODE *) TR_NIL || p == NLNIL)
+               return NLNIL;
+       putleaf( PCC_ICON , 0 , 0 , PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR) , "_blkcpy" );
+       p1 = rvalue( r->rhs_expr , p , LREQ );
+       if (p1 == NLNIL)
+               return NLNIL;
+       p = lvalue( r->lhs_var , MOD|ASGN|NOUSE , LREQ );
+       if (p == NLNIL)
+               return NLNIL;
+       putop(PCC_CM, PCCT_INT);
+               /* upper bound */
+       p1 = p->chain->nptr[1];
+       putRV(p1->symbol, (p1->nl_block & 037), p1->value[0],
+           p1->extra_flags, p2type( p1 ) );
+               /* minus lower bound */
+       p1 = p->chain->nptr[0];
+       putRV(p1->symbol, (p1->nl_block & 037), p1->value[0],
+           p1->extra_flags, p2type( p1 ) );
+       putop( PCC_MINUS, PCCT_INT );
+               /* add one */
+       putleaf(PCC_ICON, 1, 0, PCCT_INT, 0);
+       putop( PCC_PLUS, PCCT_INT );
+               /* and multiply by the width */
+       p1 = p->chain->nptr[2];
+       putRV(p1->symbol, (p1->nl_block & 037), p1->value[0],
+           p1->extra_flags, p2type( p1 ) );
+       putop( PCC_MUL , PCCT_INT );
+       putop(PCC_CM, PCCT_INT);
+       putop(PCC_CALL, PCCT_INT);
+       putdot( filename , line);
+       return p;
+}
+#endif PC
+

 /*
  * if expr then stat [ else stat ]
  */
 /*
  * if expr then stat [ else stat ]
  */


@@ -495,8 +613,8 @@ ifop(if_n)
 #      endif OBJ
 #      ifdef PC
            l1 = (int) getlab();
 #      endif OBJ
 #      ifdef PC
            l1 = (int) getlab();

-           putleaf( P2ICON , l1 , 0 , P2INT , (char *) 0 );
-           putop( P2CBRANCH , P2INT );
+           putleaf( PCC_ICON , l1 , 0 , PCCT_INT , (char *) 0 );
+           putop( PCC_CBRANCH , PCCT_INT );

            putdot( filename , line );
 #      endif PC
        putcnt();
            putdot( filename , line );
 #      endif PC
        putcnt();


@@ -559,8 +677,8 @@ whilop(w_node)
            (void) put(2, O_IF, l2);
 #      endif OBJ
 #      ifdef PC
            (void) put(2, O_IF, l2);
 #      endif OBJ
 #      ifdef PC

-           putleaf( P2ICON , (int) l2 , 0 , P2INT , (char *) 0 );
-           putop( P2CBRANCH , P2INT );
+           putleaf( PCC_ICON , (int) l2 , 0 , PCCT_INT , (char *) 0 );
+           putop( PCC_CBRANCH , PCCT_INT );

            putdot( filename , line );
 #      endif PC
        putcnt();
            putdot( filename , line );
 #      endif PC
        putcnt();


@@ -602,8 +720,8 @@ repop(r)
            (void) put(2, O_IF, l);
 #      endif OBJ
 #      ifdef PC
            (void) put(2, O_IF, l);
 #      endif OBJ
 #      ifdef PC

-           putleaf( P2ICON , l , 0 , P2INT , (char *) 0 );
-           putop( P2CBRANCH , P2INT );
+           putleaf( PCC_ICON , l , 0 , PCCT_INT , (char *) 0 );
+           putop( PCC_CBRANCH , PCCT_INT );

            putdot( filename , line );
 #      endif PC
        if (goc != gocnt)
            putdot( filename , line );
 #      endif PC
        if (goc != gocnt)