BSD 4_4 release
[unix-history] / usr / src / usr.bin / pascal / src / stat.c
index f9612c4..337e579 100644 (file)
@@ -1,43 +1,78 @@
-/* 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.
+ */
 
 
-static char sccsid[] = "@(#)stat.c 1.8 %G%";
+#ifndef lint
+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 "pc.h"
 #endif PC
+#include "tmps.h"
 
 int cntstat;
 short cnts = 3;
 #include "opcode.h"
 
 int cntstat;
 short cnts = 3;
 #include "opcode.h"
+#include "tree_ty.h"
 
 /*
  * Statement list
  */
 statlist(r)
 
 /*
  * Statement list
  */
 statlist(r)
-       int *r;
+       struct tnode *r;
 {
 {
-       register *sl;
+       register struct tnode *sl;
 
 
-       for (sl=r; sl != NIL; sl=sl[2])
-               statement(sl[1]);
+       for (sl=r; sl != TR_NIL; sl=sl->list_node.next)
+               statement(sl->list_node.list);
 }
 
 /*
  * Statement
  */
 statement(r)
 }
 
 /*
  * Statement
  */
 statement(r)
-       int *r;
+       struct tnode *r;
 {
 {
-       register *s;
+       register struct tnode *tree_node;
        register struct nl *snlp;
        struct tmps soffset;
 
        register struct nl *snlp;
        struct tmps soffset;
 
-       s = r;
+       tree_node = r;
        snlp = nlp;
        soffset = sizes[cbn].curtmps;
 top:
        snlp = nlp;
        soffset = sizes[cbn].curtmps;
 top:
@@ -45,76 +80,76 @@ top:
                cntstat = 0;
                putcnt();
        }
                cntstat = 0;
                putcnt();
        }
-       if (s == NIL)
+       if (tree_node == TR_NIL)
                return;
                return;
-       line = s[1];
-       if (s[0] == T_LABEL) {
-               labeled(s[2]);
-               s = s[3];
-               noreach = 0;
+       line = tree_node->lined.line_no; 
+       if (tree_node->tag == T_LABEL) {
+               labeled(tree_node->label_node.lbl_ptr);
+               tree_node = tree_node->label_node.stmnt;
+               noreach = FALSE;
                cntstat = 1;
                goto top;
        }
        if (noreach) {
                cntstat = 1;
                goto top;
        }
        if (noreach) {
-               noreach = 0;
+               noreach = FALSE;
                warning();
                error("Unreachable statement");
        }
                warning();
                error("Unreachable statement");
        }
-       switch (s[0]) {
+       switch (tree_node->tag) {
                case T_PCALL:
                        putline();
 #                      ifdef OBJ
                case T_PCALL:
                        putline();
 #                      ifdef OBJ
-                           proc(s);
+                           proc(tree_node);
 #                      endif OBJ
 #                      ifdef PC
 #                      endif OBJ
 #                      ifdef PC
-                           pcproc( s );
+                           pcproc( tree_node );
 #                      endif PC
                        break;
                case T_ASGN:
                        putline();
 #                      endif PC
                        break;
                case T_ASGN:
                        putline();
-                       asgnop(s);
+                       asgnop(&(tree_node->asg_node));
                        break;
                case T_GOTO:
                        putline();
                        break;
                case T_GOTO:
                        putline();
-                       gotoop(s[2]);
-                       noreach = 1;
+                       gotoop(tree_node->goto_node.lbl_ptr);
+                       noreach = TRUE;
                        cntstat = 1;
                        break;
                default:
                        level++;
                        cntstat = 1;
                        break;
                default:
                        level++;
-                       switch (s[0]) {
+                       switch (tree_node->tag) {
                                default:
                                        panic("stat");
                                case T_IF:
                                case T_IFEL:
                                default:
                                        panic("stat");
                                case T_IF:
                                case T_IFEL:
-                                       ifop(s);
+                                       ifop(&(tree_node->if_node));
                                        break;
                                case T_WHILE:
                                        break;
                                case T_WHILE:
-                                       whilop(s);
-                                       noreach = 0;
+                                       whilop(&(tree_node->whi_cas));
+                                       noreach = FALSE;
                                        break;
                                case T_REPEAT:
                                        break;
                                case T_REPEAT:
-                                       repop(s);
+                                       repop(&(tree_node->repeat));
                                        break;
                                case T_FORU:
                                case T_FORD:
                                        break;
                                case T_FORU:
                                case T_FORD:
-                                       forop(s);
-                                       noreach = 0;
+                                       forop(tree_node);
+                                       noreach = FALSE;
                                        break;
                                case T_BLOCK:
                                        break;
                                case T_BLOCK:
-                                       statlist(s[2]);
+                                       statlist(tree_node->stmnt_blck.stmnt_list);
                                        break;
                                case T_CASE:
                                        putline();
 #                                      ifdef OBJ
                                        break;
                                case T_CASE:
                                        putline();
 #                                      ifdef OBJ
-                                           caseop(s);
+                                           caseop(&(tree_node->whi_cas));
 #                                      endif OBJ
 #                                      ifdef PC
 #                                      endif OBJ
 #                                      ifdef PC
-                                           pccaseop( s );
+                                           pccaseop(&(tree_node->whi_cas));
 #                                      endif PC
                                        break;
                                case T_WITH:
 #                                      endif PC
                                        break;
                                case T_WITH:
-                                       withop(s);
+                                       withop(&(tree_node->with_node));
                                        break;
                        }
                        --level;
                                        break;
                        }
                        --level;
@@ -138,7 +173,7 @@ ungoto()
 {
        register struct nl *p;
 
 {
        register struct nl *p;
 
-       for (p = gotos[cbn]; p != NIL; p = p->chain)
+       for (p = gotos[cbn]; p != NLNIL; p = p->chain)
                if ((p->nl_flags & NFORWD) != 0) {
                        if (p->value[NL_GOLEV] != NOTYET)
                                if (p->value[NL_GOLEV] > level)
                if ((p->nl_flags & NFORWD) != 0) {
                        if (p->value[NL_GOLEV] != NOTYET)
                                if (p->value[NL_GOLEV] > level)
@@ -152,7 +187,7 @@ ungoto()
 putcnt()
 {
 
 putcnt()
 {
 
-       if (monflg == 0) {
+       if (monflg == FALSE) {
                return;
        }
        inccnt( getcnt() );
                return;
        }
        inccnt( getcnt() );
@@ -170,12 +205,12 @@ inccnt( counter )
     {
 
 #      ifdef OBJ
     {
 
 #      ifdef OBJ
-           put(2, O_COUNT, counter );
+           (void) put(2, O_COUNT, counter );
 #      endif OBJ
 #      ifdef PC
 #      endif OBJ
 #      ifdef PC
-           putRV( PCPCOUNT , 0 , counter * sizeof (long) , NGLOBAL , P2INT );
-           putleaf( P2ICON , 1 , 0 , P2INT , 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
     }
@@ -185,7 +220,7 @@ putline()
 
 #      ifdef OBJ
            if (opt('p') != 0)
 
 #      ifdef OBJ
            if (opt('p') != 0)
-                   put(2, O_LINO, line);
+                   (void) put(2, O_LINO, line);
 
            /*
             * put out line number information for pdx
 
            /*
             * put out line number information for pdx
@@ -202,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 , 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 );
                }
            }
@@ -227,46 +262,51 @@ putline()
  * associated with the WITHPTRs on the withlist.
  */
 withop(s)
  * associated with the WITHPTRs on the withlist.
  */
 withop(s)
-       int *s;
+       WITH_NODE *s;
 {
 {
-       register *p;
+       register struct tnode *p;
        register struct nl *r;
        struct nl       *tempnlp;
        register struct nl *r;
        struct nl       *tempnlp;
-       int *swl;
+       struct nl *swl;
 
        putline();
        swl = withlist;
 
        putline();
        swl = withlist;
-       for (p = s[2]; p != NIL; p = p[2]) {
-               tempnlp = tmpalloc(sizeof(int *), INT_TYP, REGOK);
+       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;
+                    *  but we use its runtime location for the with pointer.
+                    */
 #              ifdef OBJ
 #              ifdef OBJ
-                   put(2, O_LV | cbn <<8+INDX, tempnlp -> value[ NL_OFFS ] );
+                   (void) put(2, O_LV | cbn <<8+INDX, tempnlp -> value[ NL_OFFS ] );
 #              endif OBJ
 #              ifdef PC
 #              endif OBJ
 #              ifdef PC
-                   putRV( 0 , cbn , tempnlp -> value[ NL_OFFS ] ,
-                           tempnlp -> extra_flags , P2PTR|P2STRTY );
+                   putRV( (char *) 0 , cbn , tempnlp -> value[ NL_OFFS ] ,
+                           tempnlp -> extra_flags , PCCTM_PTR|PCCT_STRTY );
 #              endif PC
 #              endif PC
-               r = lvalue(p[1], MOD , LREQ );
-               if (r == NIL)
+               r = lvalue(p->list_node.list, MOD , LREQ );
+               if (r == NLNIL)
                        continue;
                if (r->class != RECORD) {
                        error("Variable in with statement refers to %s, not to a record", nameof(r));
                        continue;
                }
                        continue;
                if (r->class != RECORD) {
                        error("Variable in with statement refers to %s, not to a record", nameof(r));
                        continue;
                }
-               r = defnl(0, WITHPTR, r, tempnlp -> value[ NL_OFFS ] );
+               r = defnl((char *) 0, WITHPTR, r, tempnlp -> value[ NL_OFFS ] );
 #              ifdef PC
                    r -> extra_flags |= tempnlp -> extra_flags;
 #              endif PC
                r->nl_next = withlist;
                withlist = r;
 #              ifdef OBJ
 #              ifdef PC
                    r -> extra_flags |= tempnlp -> extra_flags;
 #              endif PC
                r->nl_next = withlist;
                withlist = r;
 #              ifdef OBJ
-                   put(1, PTR_AS);
+                   (void) put(1, PTR_AS);
 #              endif OBJ
 #              ifdef PC
 #              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
        }
-       statement(s[3]);
+       statement(s->stmnt);
        withlist = swl;
 }
 
        withlist = swl;
 }
 
@@ -275,13 +315,11 @@ extern    flagwas;
  * var := expr
  */
 asgnop(r)
  * var := expr
  */
 asgnop(r)
-       int *r;
+       ASG_NODE *r;
 {
        register struct nl *p;
 {
        register struct nl *p;
-       register *av;
+       register struct tnode *av;
 
 
-       if (r == NIL)
-               return (NIL);
        /*
         * Asgnop's only function is
         * to handle function variable
        /*
         * Asgnop's only function is
         * to handle function variable
@@ -290,12 +328,12 @@ asgnop(r)
         * the if below checks for unqualified lefthandside:
         * necessary for fvars.
         */
         * the if below checks for unqualified lefthandside:
         * necessary for fvars.
         */
-       av = r[2];
-       if (av != NIL && av[0] == T_VAR && av[3] == NIL) {
-               p = lookup1(av[2]);
-               if (p != NIL)
+       av = r->lhs_var;
+       if (av != TR_NIL && av->tag == T_VAR && av->var_node.qual == TR_NIL) {
+               p = lookup1(av->var_node.cptr);
+               if (p != NLNIL)
                        p->nl_flags = flagwas;
                        p->nl_flags = flagwas;
-               if (p != NIL && p->class == FVAR) {
+               if (p != NLNIL && p->class == FVAR) {
                        /*
                         * Give asgnop1 the func
                         * which is the chain of
                        /*
                         * Give asgnop1 the func
                         * which is the chain of
@@ -303,16 +341,16 @@ asgnop(r)
                         */
                        p->nl_flags |= NUSED|NMOD;
                        p = p->chain;
                         */
                        p->nl_flags |= NUSED|NMOD;
                        p = p->chain;
-                       if (p == NIL) {
-                               rvalue(r[3], NIL , RREQ );
+                       if (p == NLNIL) {
+                               p = rvalue(r->rhs_expr, NLNIL , RREQ );
                                return;
                        }
 #                      ifdef OBJ
                                return;
                        }
 #                      ifdef OBJ
-                           put(2, O_LV | bn << 8+INDX, (int)p->value[NL_OFFS]);
+                           (void) put(2, O_LV | bn << 8+INDX, (int)p->value[NL_OFFS]);
                            if (isa(p->type, "i") && width(p->type) == 1)
                            if (isa(p->type, "i") && width(p->type) == 1)
-                                   asgnop1(r, nl+T2INT);
+                                   (void) asgnop1(r, nl+T2INT);
                            else
                            else
-                                   asgnop1(r, p->type);
+                                   (void) asgnop1(r, p->type);
 #                      endif OBJ
 #                      ifdef PC
                                /*
 #                      endif OBJ
 #                      ifdef PC
                                /*
@@ -325,12 +363,12 @@ asgnop(r)
                            p = p -> ptr[ NL_FVAR ];
                            putRV( p -> symbol , bn , p -> value[ NL_OFFS ] ,
                                    p -> extra_flags , p2type( p -> type ) );
                            p = p -> ptr[ NL_FVAR ];
                            putRV( p -> symbol , bn , p -> value[ NL_OFFS ] ,
                                    p -> extra_flags , p2type( p -> type ) );
-                           asgnop1( r , p -> type );
+                           (void) asgnop1( r , p -> type );
 #                      endif PC
                        return;
                }
        }
 #                      endif PC
                        return;
                }
        }
-       asgnop1(r, NIL);
+       (void) asgnop1(r, NLNIL);
 }
 
 /*
 }
 
 /*
@@ -341,72 +379,93 @@ asgnop(r)
  */
 struct nl *
 asgnop1(r, p)
  */
 struct nl *
 asgnop1(r, p)
-       int *r;
+       ASG_NODE *r;
        register struct nl *p;
 {
        register struct nl *p1;
        register struct nl *p;
 {
        register struct nl *p1;
+       int     clas;
+#ifdef OBJ
        int w;
        int w;
+#endif OBJ
 
 
-       if (r == NIL)
-               return (NIL);
-       if (p == NIL) {
-#          ifdef OBJ
-               p = lvalue(r[2], 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[2] , MOD|ASGN|NOUSE , RREQ );
-#          endif PC
-           if ( p == NIL ) {
-               rvalue( r[3] , NIL , RREQ );
-               return NIL;
+#ifdef OBJ
+       if (p == NLNIL) {
+           p = lvalue(r->lhs_var, MOD|ASGN|NOUSE , LREQ );
+           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 );
+       }
+#   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;
            }
            }
-           p1 = rvalue(r[3], p , RREQ );
-#      endif OBJ
-#      ifdef PC
+           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[3] , p , RREQ );
-                   break;
-               default:
-                   p1 = rvalue( r[3] , 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
 #      endif PC
-       if (p1 == NIL)
-               return (NIL);
-       if (incompat(p1, p, r[3])) {
+       if (p1 == NLNIL)
+               return (NLNIL);
+       if (incompat(p1, p, r->rhs_expr)) {
                cerror("Type of expression clashed with type of variable in assignment");
                cerror("Type of expression clashed with type of variable in assignment");
-               return (NIL);
+               return (NLNIL);
        }
 #      ifdef OBJ
            switch (classify(p)) {
        }
 #      ifdef OBJ
            switch (classify(p)) {
@@ -415,14 +474,31 @@ asgnop1(r, p)
                    case TCHAR:
                    case TSCAL:
                            rangechk(p, p1);
                    case TCHAR:
                    case TSCAL:
                            rangechk(p, p1);
-                           gen(O_AS2, O_AS2, w, width(p1));
+                           (void) gen(O_AS2, O_AS2, w, width(p1));
                            break;
                    case TDOUBLE:
                    case TPTR:
                            break;
                    case TDOUBLE:
                    case TPTR:
-                           gen(O_AS2, O_AS2, w, width(p1));
+                           (void) gen(O_AS2, O_AS2, w, width(p1));
                            break;
                            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:
                    default:
-                           put(2, O_AS, w);
+                           (void) put(2, O_AS, w);
                            break;
            }
 #      endif OBJ
                            break;
            }
 #      endif OBJ
@@ -432,24 +508,23 @@ asgnop1(r, p)
                    case TBOOL:
                    case TCHAR:
                    case TSCAL:
                    case TBOOL:
                    case TCHAR:
                    case TSCAL:
-                           postcheck( p );
-                           putop( P2ASSIGN , p2type( p ) );
+                           postcheck(p, p1);
+                           sconv(p2type(p1), 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:
                            putdot( filename , line );
                            break;
                    case TDOUBLE:
-                           if (isnta(p1,"d")) {
-                               putop( P2SCONV , P2DOUBLE );
-                           }
-                           putop( P2ASSIGN , p2type( p ) );
+                           sconv(p2type(p1), p2type(p));
+                           putop( PCC_ASSIGN , p2type( p ) );
                            putdot( filename , line );
                            break;
                    default:
                            putdot( filename , line );
                            break;
                    default:
-                           putstrop( P2STASG , p2type( p )
-                                       , lwidth( p ) , align( p ) );
+                           putstrop(PCC_STASG, PCCM_ADDTYPE(p2type(p), PCCTM_PTR),
+                                       (int) lwidth(p), align(p));
                            putdot( filename , line );
                            break;
            }
                            putdot( filename , line );
                            break;
            }
@@ -457,11 +532,58 @@ 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 ]
  */
-ifop(r)
-       int *r;
+ifop(if_n)
+       IF_NODE *if_n;
 {
        register struct nl *p;
        register l1, l2;        /* l1 is start of else, l2 is end of else */
 {
        register struct nl *p;
        register l1, l2;        /* l1 is start of else, l2 is end of else */
@@ -469,38 +591,36 @@ ifop(r)
        bool nr;
 
        goc = gocnt;
        bool nr;
 
        goc = gocnt;
-       if (r == NIL)
-               return;
        putline();
        putline();
-       p = rvalue(r[2], NIL , RREQ );
+       p = rvalue(if_n->cond_expr, NLNIL , RREQ );
        if (p == NIL) {
        if (p == NIL) {
-               statement(r[3]);
-               noreach = 0;
-               statement(r[4]);
-               noreach = 0;
+               statement(if_n->then_stmnt);
+               noreach = FALSE;
+               statement(if_n->else_stmnt);
+               noreach = FALSE;
                return;
        }
        if (isnta(p, "b")) {
                error("Type of expression in if statement must be Boolean, not %s", nameof(p));
                return;
        }
        if (isnta(p, "b")) {
                error("Type of expression in if statement must be Boolean, not %s", nameof(p));
-               statement(r[3]);
-               noreach = 0;
-               statement(r[4]);
-               noreach = 0;
+               statement(if_n->then_stmnt);
+               noreach = FALSE;
+               statement(if_n->else_stmnt);
+               noreach = FALSE;
                return;
        }
 #      ifdef OBJ
            l1 = put(2, O_IF, getlab());
 #      endif OBJ
 #      ifdef PC
                return;
        }
 #      ifdef OBJ
            l1 = put(2, O_IF, getlab());
 #      endif OBJ
 #      ifdef PC
-           l1 = getlab();
-           putleaf( P2ICON , l1 , 0 , P2INT , 0 );
-           putop( P2CBRANCH , P2INT );
+           l1 = (int) getlab();
+           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();
-       statement(r[3]);
+       statement(if_n->then_stmnt);
        nr = noreach;
        nr = noreach;
-       if (r[4] != NIL) {
+       if (if_n->else_stmnt != TR_NIL) {
                /*
                 * else stat
                 */
                /*
                 * else stat
                 */
@@ -511,17 +631,17 @@ ifop(r)
                    l2 = put(2, O_TRA, getlab());
 #              endif OBJ
 #              ifdef PC
                    l2 = put(2, O_TRA, getlab());
 #              endif OBJ
 #              ifdef PC
-                   l2 = getlab();
-                   putjbr( l2 );
+                   l2 = (int) getlab();
+                   putjbr( (long) l2 );
 #              endif PC
 #              endif PC
-               patch(l1);
-               noreach = 0;
-               statement(r[4]);
-               noreach = (noreach && nr);
+               patch((PTR_DCL)l1);
+               noreach = FALSE;
+               statement(if_n->else_stmnt);
+               noreach = (noreach && nr)?TRUE:FALSE;
                l1 = l2;
        } else
                l1 = l2;
        } else
-               noreach = 0;
-       patch(l1);
+               noreach = FALSE;
+       patch((PTR_DCL)l1);
        if (goc != gocnt)
                putcnt();
 }
        if (goc != gocnt)
                putcnt();
 }
@@ -529,48 +649,47 @@ ifop(r)
 /*
  * while expr do stat
  */
 /*
  * while expr do stat
  */
-whilop(r)
-       int *r;
+whilop(w_node)
+       WHI_CAS *w_node;
 {
        register struct nl *p;
 {
        register struct nl *p;
-       register l1, l2;
+       register char *l1, *l2;
        int goc;
 
        goc = gocnt;
        int goc;
 
        goc = gocnt;
-       if (r == NIL)
-               return;
-       putlab(l1 = getlab());
+       l1 = getlab();
+       (void) putlab(l1);
        putline();
        putline();
-       p = rvalue(r[2], NIL , RREQ );
-       if (p == NIL) {
-               statement(r[3]);
-               noreach = 0;
+       p = rvalue(w_node->expr, NLNIL , RREQ );
+       if (p == NLNIL) {
+               statement(w_node->stmnt_list);
+               noreach = FALSE;
                return;
        }
        if (isnta(p, "b")) {
                error("Type of expression in while statement must be Boolean, not %s", nameof(p));
                return;
        }
        if (isnta(p, "b")) {
                error("Type of expression in while statement must be Boolean, not %s", nameof(p));
-               statement(r[3]);
-               noreach = 0;
+               statement(w_node->stmnt_list);
+               noreach = FALSE;
                return;
        }
        l2 = getlab();
 #      ifdef OBJ
                return;
        }
        l2 = getlab();
 #      ifdef OBJ
-           put(2, O_IF, l2);
+           (void) put(2, O_IF, l2);
 #      endif OBJ
 #      ifdef PC
 #      endif OBJ
 #      ifdef PC
-           putleaf( P2ICON , l2 , 0 , P2INT , 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();
-       statement(r[3]);
+       statement(w_node->stmnt_list);
 #      ifdef OBJ
 #      ifdef OBJ
-           put(2, O_TRA, l1);
+           (void) put(2, O_TRA, l1);
 #      endif OBJ
 #      ifdef PC
 #      endif OBJ
 #      ifdef PC
-           putjbr( l1 );
+           putjbr( (long) l1 );
 #      endif PC
 #      endif PC
-       patch(l2);
+       patch((PTR_DCL) l2);
        if (goc != gocnt)
                putcnt();
 }
        if (goc != gocnt)
                putcnt();
 }
@@ -579,32 +698,30 @@ whilop(r)
  * repeat stat* until expr
  */
 repop(r)
  * repeat stat* until expr
  */
 repop(r)
-       int *r;
+       REPEAT *r;
 {
        register struct nl *p;
        register l;
        int goc;
 
        goc = gocnt;
 {
        register struct nl *p;
        register l;
        int goc;
 
        goc = gocnt;
-       if (r == NIL)
-               return;
-       l = putlab(getlab());
+       l = (int) putlab(getlab());
        putcnt();
        putcnt();
-       statlist(r[2]);
-       line = r[1];
-       p = rvalue(r[3], NIL , RREQ );
-       if (p == NIL)
+       statlist(r->stmnt_list);
+       line = r->line_no;
+       p = rvalue(r->term_expr, NLNIL , RREQ );
+       if (p == NLNIL)
                return;
        if (isnta(p,"b")) {
                error("Until expression type must be Boolean, not %s, in repeat statement", nameof(p));
                return;
        }
 #      ifdef OBJ
                return;
        if (isnta(p,"b")) {
                error("Until expression type must be Boolean, not %s, in repeat statement", nameof(p));
                return;
        }
 #      ifdef OBJ
-           put(2, O_IF, l);
+           (void) put(2, O_IF, l);
 #      endif OBJ
 #      ifdef PC
 #      endif OBJ
 #      ifdef PC
-           putleaf( P2ICON , l , 0 , P2INT , 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)