BSD 4_3_Net_2 release

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

diff --git a/usr/src/usr.bin/pascal/src/rval.c b/usr/src/usr.bin/pascal/src/rval.c
index 6a85a8f..669e181 100644 (file)
--- a/usr/src/usr.bin/pascal/src/rval.c
+++ b/usr/src/usr.bin/pascal/src/rval.c
@@ -1,6 +1,39 @@
-/* Copyright (c) 1979 Regents of the University of California */
+/*-
+ * Copyright (c) 1980 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[] = "@(#)rval.c 1.13 %G%";
+#ifndef lint
+static char sccsid[] = "@(#)rval.c     5.3 (Berkeley) 4/16/91";
+#endif /* not lint */

 
 #include "whoami.h"
 #include "0.h"
 
 #include "whoami.h"
 #include "0.h"


@@ -9,8 +42,10 @@ static char sccsid[] = "@(#)rval.c 1.13 %G%";
 #include "objfmt.h"
 #ifdef PC
 #   include    "pc.h"
 #include "objfmt.h"
 #ifdef PC
 #   include    "pc.h"

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

 #endif PC
 #endif PC

+#include "tmps.h"
+#include "tree_ty.h"

 
 extern char *opnames[];
 
 
 extern char *opnames[];
 


@@ -31,34 +66,42 @@ short nssetline = 0;
                                "_RELSLE" , "_RELSGE"
                            };
     long       relops[] =  {   
                                "_RELSLE" , "_RELSGE"
                            };
     long       relops[] =  {   

-                               P2EQ , P2NE ,
-                               P2LT , P2GT ,
-                               P2LE , P2GE 
+                               PCC_EQ , PCC_NE ,
+                               PCC_LT , PCC_GT ,
+                               PCC_LE , PCC_GE 

                            };
                            };

-    long       mathop[] =  {   P2MUL , P2PLUS , P2MINUS };
+    long       mathop[] =  {   PCC_MUL , PCC_PLUS , PCC_MINUS };

     char       *setop[] =  {   "_MULT" , "_ADDT" , "_SUBT" };
 #endif PC
 /*
  * Rvalue - an expression.
  *
  * Contype is the type that the caller would prefer, nand is important
     char       *setop[] =  {   "_MULT" , "_ADDT" , "_SUBT" };
 #endif PC
 /*
  * Rvalue - an expression.
  *
  * Contype is the type that the caller would prefer, nand is important

- * if constant sets or constant strings are involved, the latter
- * because of string padding.
+ * if constant strings are involved, because of string padding.

  * required is a flag whether an lvalue or an rvalue is required.
  * only VARs and structured things can have gt their lvalue this way.
  */
  * required is a flag whether an lvalue or an rvalue is required.
  * only VARs and structured things can have gt their lvalue this way.
  */

+/*ARGSUSED*/

 struct nl *
 rvalue(r, contype , required )
 struct nl *
 rvalue(r, contype , required )

-       int *r;
+       struct tnode *r;

        struct nl *contype;
        int     required;
 {
        register struct nl *p, *p1;
        register struct nl *q;
        struct nl *contype;
        int     required;
 {
        register struct nl *p, *p1;
        register struct nl *q;

-       int c, c1, *rt, w, g;
+       int c, c1, w;
+#ifdef OBJ
+       int g;
+#endif
+       struct tnode *rt;

        char *cp, *cp1, *opname;
        long l;
        char *cp, *cp1, *opname;
        long l;

-       double f;
+       union
+       {
+           long plong[2];
+           double pdouble;
+       }f;

        extern int      flagwas;
        struct csetstr  csetd;
 #      ifdef PC
        extern int      flagwas;
        struct csetstr  csetd;
 #      ifdef PC


@@ -67,31 +110,31 @@ rvalue(r, contype , required )
            struct nl   *tempnlp;
 #      endif PC
 
            struct nl   *tempnlp;
 #      endif PC
 

-       if (r == NIL)
-               return (NIL);
+       if (r == TR_NIL)
+               return (NLNIL);

        if (nowexp(r))
        if (nowexp(r))

-               return (NIL);
+               return (NLNIL);

        /*
         * Pick up the name of the operation
         * for future error messages.
         */
        /*
         * Pick up the name of the operation
         * for future error messages.
         */

-       if (r[0] <= T_IN)
-               opname = opnames[r[0]];
+       if (r->tag <= T_IN)
+               opname = opnames[r->tag];

 
        /*
         * The root of the tree tells us what sort of expression we have.
         */
 
        /*
         * The root of the tree tells us what sort of expression we have.
         */

-       switch (r[0]) {
+       switch (r->tag) {

 
        /*
         * The constant nil
         */
        case T_NIL:
 #              ifdef OBJ
 
        /*
         * The constant nil
         */
        case T_NIL:
 #              ifdef OBJ

-                   put(2, O_CON2, 0);
+                   (void) put(2, O_CON2, 0);

 #              endif OBJ
 #              ifdef PC
 #              endif OBJ
 #              ifdef PC

-                   putleaf( P2ICON , 0 , 0 , P2PTR|P2UNDEF , 0 );
+                   putleaf( PCC_ICON , 0 , 0 , PCCTM_PTR|PCCT_UNDEF , (char *) 0 );

 #              endif PC
                return (nl+TNIL);
 
 #              endif PC
                return (nl+TNIL);
 


@@ -107,9 +150,9 @@ rvalue(r, contype , required )
 #          endif PC
 
        case T_VAR:
 #          endif PC
 
        case T_VAR:

-               p = lookup(r[2]);
-               if (p == NIL || p->class == BADUSE)
-                       return (NIL);
+               p = lookup(r->var_node.cptr);
+               if (p == NLNIL || p->class == BADUSE)
+                       return (NLNIL);

                switch (p->class) {
                    case VAR:
                            /*
                switch (p->class) {
                    case VAR:
                            /*


@@ -118,32 +161,32 @@ rvalue(r, contype , required )
                             * the rvalue by a
                             * lvalue and an ind.
                             */
                             * the rvalue by a
                             * lvalue and an ind.
                             */

-                           if (r[3] != NIL)
+                           if (r->var_node.qual != TR_NIL)

                                    goto ind;
                            q = p->type;
                            if (q == NIL)
                                    goto ind;
                            q = p->type;
                            if (q == NIL)

-                                   return (NIL);
+                                   return (NLNIL);

 #                          ifdef OBJ
                                w = width(q);
                                switch (w) {
                                    case 8:
 #                          ifdef OBJ
                                w = width(q);
                                switch (w) {
                                    case 8:

-                                       put(2, O_RV8 | bn << 8+INDX,
+                                       (void) put(2, O_RV8 | bn << 8+INDX,

                                                (int)p->value[0]);
                                        break;
                                    case 4:
                                                (int)p->value[0]);
                                        break;
                                    case 4:

-                                       put(2, O_RV4 | bn << 8+INDX,
+                                       (void) put(2, O_RV4 | bn << 8+INDX,

                                                (int)p->value[0]);
                                        break;
                                    case 2:
                                                (int)p->value[0]);
                                        break;
                                    case 2:

-                                       put(2, O_RV2 | bn << 8+INDX,
+                                       (void) put(2, O_RV2 | bn << 8+INDX,

                                                (int)p->value[0]);
                                        break;
                                    case 1:
                                                (int)p->value[0]);
                                        break;
                                    case 1:

-                                       put(2, O_RV1 | bn << 8+INDX,
+                                       (void) put(2, O_RV1 | bn << 8+INDX,

                                                (int)p->value[0]);
                                        break;
                                    default:
                                                (int)p->value[0]);
                                        break;
                                    default:

-                                       put(3, O_RV | bn << 8+INDX,
+                                       (void) put(3, O_RV | bn << 8+INDX,

                                                (int)p->value[0], w);
                                }
 #                         endif OBJ
                                                (int)p->value[0], w);
                                }
 #                         endif OBJ


@@ -168,47 +211,47 @@ rvalue(r, contype , required )
 ind:
                            q = lvalue(r, NOFLAGS , LREQ );
                            if (q == NIL)
 ind:
                            q = lvalue(r, NOFLAGS , LREQ );
                            if (q == NIL)

-                                   return (NIL);
+                                   return (NLNIL);

 #                          ifdef OBJ
                                w = width(q);
                                switch (w) {
                                    case 8:
 #                          ifdef OBJ
                                w = width(q);
                                switch (w) {
                                    case 8:

-                                           put(1, O_IND8);
+                                           (void) put(1, O_IND8);

                                            break;
                                    case 4:
                                            break;
                                    case 4:

-                                           put(1, O_IND4);
+                                           (void) put(1, O_IND4);

                                            break;
                                    case 2:
                                            break;
                                    case 2:

-                                           put(1, O_IND2);
+                                           (void) put(1, O_IND2);

                                            break;
                                    case 1:
                                            break;
                                    case 1:

-                                           put(1, O_IND1);
+                                           (void) put(1, O_IND1);

                                            break;
                                    default:
                                            break;
                                    default:

-                                           put(2, O_IND, w);
+                                           (void) put(2, O_IND, w);

                                }
 #                          endif OBJ
 #                          ifdef PC
                                if ( required == RREQ ) {
                                }
 #                          endif OBJ
 #                          ifdef PC
                                if ( required == RREQ ) {

-                                   putop( P2UNARY P2MUL , p2type( q ) );
+                                   putop( PCCOM_UNARY PCC_MUL , p2type( q ) );

                                }
 #                          endif PC
                            return (q);
 
                    case CONST:
                                }
 #                          endif PC
                            return (q);
 
                    case CONST:

-                           if (r[3] != NIL) {
-                               error("%s is a constant and cannot be qualified", r[2]);
-                               return (NIL);
+                           if (r->var_node.qual != TR_NIL) {
+                               error("%s is a constant and cannot be qualified", r->var_node.cptr);
+                               return (NLNIL);

                            }
                            q = p->type;
                            }
                            q = p->type;

-                           if (q == NIL)
-                                   return (NIL);
+                           if (q == NLNIL)
+                                   return (NLNIL);

                            if (q == nl+TSTR) {
                                    /*
                                     * Find the size of the string
                                     * constant if needed.
                                     */
                            if (q == nl+TSTR) {
                                    /*
                                     * Find the size of the string
                                     * constant if needed.
                                     */

-                                   cp = p->ptr[0];
+                                   cp = (char *) p->ptr[0];

 cstrng:
                                    cp1 = cp;
                                    for (c = 0; *cp++; c++)
 cstrng:
                                    cp1 = cp;
                                    for (c = 0; *cp++; c++)


@@ -217,12 +260,12 @@ cstrng:
                                    if (contype != NIL && !opt('s')) {
                                            if (width(contype) < c && classify(contype) == TSTR) {
                                                    error("Constant string too long");
                                    if (contype != NIL && !opt('s')) {
                                            if (width(contype) < c && classify(contype) == TSTR) {
                                                    error("Constant string too long");

-                                                   return (NIL);
+                                                   return (NLNIL);

                                            }
                                            w = width(contype);
                                    }
 #                                  ifdef OBJ
                                            }
                                            w = width(contype);
                                    }
 #                                  ifdef OBJ

-                                       put(2, O_CONG, w);
+                                       (void) put(2, O_CONG, w);

                                        putstr(cp1, w - c);
 #                                  endif OBJ
 #                                  ifdef PC
                                        putstr(cp1, w - c);
 #                                  endif OBJ
 #                                  ifdef PC


@@ -234,17 +277,17 @@ cstrng:
                                     * width.
                                     * cleaned out by stat.
                                     */
                                     * width.
                                     * cleaned out by stat.
                                     */

-                                   q = defnl(0, STR, 0, w);
+                                   q = defnl((char *) 0, STR, NLNIL, w);

                                    q->type = q;
                                    return (q);
                            }
                            if (q == nl+T1CHAR) {
 #                                  ifdef OBJ
                                    q->type = q;
                                    return (q);
                            }
                            if (q == nl+T1CHAR) {
 #                                  ifdef OBJ

-                                       put(2, O_CONC, (int)p->value[0]);
+                                       (void) put(2, O_CONC, (int)p->value[0]);

 #                                  endif OBJ
 #                                  ifdef PC
 #                                  endif OBJ
 #                                  ifdef PC

-                                       putleaf( P2ICON , p -> value[0] , 0
-                                               , P2CHAR , 0 );
+                                       putleaf( PCC_ICON , p -> value[0] , 0
+                                               , PCCT_CHAR , (char *) 0 );

 #                                  endif PC
                                    return (q);
                            }
 #                                  endif PC
                                    return (q);
                            }


@@ -255,20 +298,20 @@ cstrng:
                            case 8:
 #ifndef DEBUG
 #                                  ifdef OBJ
                            case 8:
 #ifndef DEBUG
 #                                  ifdef OBJ

-                                       put(2, O_CON8, p->real);
+                                       (void) put(2, O_CON8, p->real);

 #                                  endif OBJ
 #                                  ifdef PC
                                        putCON8( p -> real );
 #                                  endif PC
 #else
                                    if (hp21mx) {
 #                                  endif OBJ
 #                                  ifdef PC
                                        putCON8( p -> real );
 #                                  endif PC
 #else
                                    if (hp21mx) {

-                                           f = p->real;
-                                           conv(&f);
-                                           l = f.plong;
-                                           put(2, O_CON4, l);
+                                           f.pdouble = p->real;
+                                           conv((int *) (&f.pdouble));
+                                           l = f.plong[1];
+                                           (void) put(2, O_CON4, l);

                                    } else
 #                                          ifdef OBJ
                                    } else
 #                                          ifdef OBJ

-                                               put(2, O_CON8, p->real);
+                                               (void) put(2, O_CON8, p->real);

 #                                          endif OBJ
 #                                          ifdef PC
                                                putCON8( p -> real );
 #                                          endif OBJ
 #                                          ifdef PC
                                                putCON8( p -> real );


@@ -277,35 +320,29 @@ cstrng:
                                    break;
                            case 4:
 #                                  ifdef OBJ
                                    break;
                            case 4:
 #                                  ifdef OBJ

-                                       put(2, O_CON4, p->range[0]);
+                                       (void) put(2, O_CON4, p->range[0]);

 #                                  endif OBJ
 #                                  ifdef PC
 #                                  endif OBJ
 #                                  ifdef PC

-                                       putleaf( P2ICON , p -> range[0] , 0
-                                               , P2INT , 0 );
+                                       putleaf( PCC_ICON , (int) p->range[0] , 0
+                                               , PCCT_INT , (char *) 0 );

 #                                  endif PC
                                    break;
                            case 2:
 #                                  ifdef OBJ
 #                                  endif PC
                                    break;
                            case 2:
 #                                  ifdef OBJ

-                                       put(2, O_CON2, (short)p->range[0]);
+                                       (void) put(2, O_CON2, (short)p->range[0]);

 #                                  endif OBJ
 #                                  ifdef PC
 #                                  endif OBJ
 #                                  ifdef PC

-                                           /*
-                                            * make short constants ints
-                                            */
-                                       putleaf( P2ICON , (short) p -> range[0]
-                                               , 0 , P2INT , 0 );
+                                       putleaf( PCC_ICON , (short) p -> range[0]
+                                               , 0 , PCCT_SHORT , (char *) 0 );

 #                                  endif PC
                                    break;
                            case 1:
 #                                  ifdef OBJ
 #                                  endif PC
                                    break;
                            case 1:
 #                                  ifdef OBJ

-                                       put(2, O_CON1, p->value[0]);
+                                       (void) put(2, O_CON1, p->value[0]);

 #                                  endif OBJ
 #                                  ifdef PC
 #                                  endif OBJ
 #                                  ifdef PC

-                                           /*
-                                            * make char constants ints
-                                            */
-                                       putleaf( P2ICON , p -> value[0] , 0
-                                               , P2INT , 0 );
+                                       putleaf( PCC_ICON , p -> value[0] , 0
+                                               , PCCT_CHAR , (char *) 0 );

 #                                  endif PC
                                    break;
                            default:
 #                                  endif PC
                                    break;
                            default:


@@ -318,12 +355,12 @@ cstrng:
                            /*
                             * Function call with no arguments.
                             */
                            /*
                             * Function call with no arguments.
                             */

-                           if (r[3]) {
+                           if (r->var_node.qual != TR_NIL) {

                                    error("Can't qualify a function result value");
                                    error("Can't qualify a function result value");

-                                   return (NIL);
+                                   return (NLNIL);

                            }
 #                          ifdef OBJ
                            }
 #                          ifdef OBJ

-                               return (funccod((int *) r));
+                               return (funccod(r));

 #                          endif OBJ
 #                          ifdef PC
                                return (pcfunccod( r ));
 #                          endif OBJ
 #                          ifdef PC
                                return (pcfunccod( r ));


@@ -331,12 +368,12 @@ cstrng:
 
                    case TYPE:
                            error("Type names (e.g. %s) allowed only in declarations", p->symbol);
 
                    case TYPE:
                            error("Type names (e.g. %s) allowed only in declarations", p->symbol);

-                           return (NIL);
+                           return (NLNIL);

 
                    case PROC:
                    case FPROC:
                            error("Procedure %s found where expression required", p->symbol);
 
                    case PROC:
                    case FPROC:
                            error("Procedure %s found where expression required", p->symbol);

-                           return (NIL);
+                           return (NLNIL);

                    default:
                            panic("rvid");
                }
                    default:
                            panic("rvid");
                }


@@ -347,16 +384,16 @@ cstrng:
 #              ifdef OBJ
                    if ( precset( r , contype , &csetd ) ) {
                        if ( csetd.csettype == NIL ) {
 #              ifdef OBJ
                    if ( precset( r , contype , &csetd ) ) {
                        if ( csetd.csettype == NIL ) {

-                           return NIL;
+                           return (NLNIL);

                        }
                        postcset( r , &csetd );
                    } else {
                        }
                        postcset( r , &csetd );
                    } else {

-                       put( 2, O_PUSH, -lwidth(csetd.csettype));
+                       (void) put( 2, O_PUSH, -lwidth(csetd.csettype));

                        postcset( r , &csetd );
                        setran( ( csetd.csettype ) -> type );
                        postcset( r , &csetd );
                        setran( ( csetd.csettype ) -> type );

-                       put( 2, O_CON24, set.uprbp);
-                       put( 2, O_CON24, set.lwrb);
-                       put( 2, O_CTTOT,
+                       (void) put( 2, O_CON24, set.uprbp);
+                       (void) put( 2, O_CON24, set.lwrb);
+                       (void) put( 2, O_CTTOT,

                                (int)(4 + csetd.singcnt + 2 * csetd.paircnt));
                    }
                    return csetd.csettype;
                                (int)(4 + csetd.singcnt + 2 * csetd.paircnt));
                    }
                    return csetd.csettype;


@@ -364,27 +401,27 @@ cstrng:
 #              ifdef PC
                    if ( precset( r , contype , &csetd ) ) {
                        if ( csetd.csettype == NIL ) {
 #              ifdef PC
                    if ( precset( r , contype , &csetd ) ) {
                        if ( csetd.csettype == NIL ) {

-                           return NIL;
+                           return (NLNIL);

                        }
                        postcset( r , &csetd );
                    } else {
                        }
                        postcset( r , &csetd );
                    } else {

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

                                , "_CTTOT" );
                        /*
                         *      allocate a temporary and use it
                         */
                        tempnlp = tmpalloc(lwidth(csetd.csettype),
                                csetd.csettype, NOREG);
                                , "_CTTOT" );
                        /*
                         *      allocate a temporary and use it
                         */
                        tempnlp = tmpalloc(lwidth(csetd.csettype),
                                csetd.csettype, NOREG);

-                       putLV( 0 , cbn , tempnlp -> value[ NL_OFFS ] ,
-                               tempnlp -> extra_flags , P2PTR|P2STRTY );
+                       putLV( (char *) 0 , cbn , tempnlp -> value[ NL_OFFS ] ,
+                               tempnlp -> extra_flags , PCCTM_PTR|PCCT_STRTY );

                        setran( ( csetd.csettype ) -> type );
                        setran( ( csetd.csettype ) -> type );

-                       putleaf( P2ICON , set.lwrb , 0 , P2INT , 0 );
-                       putop( P2LISTOP , P2INT );
-                       putleaf( P2ICON , set.uprbp , 0 , P2INT , 0 );
-                       putop( P2LISTOP , P2INT );
+                       putleaf( PCC_ICON , set.lwrb , 0 , PCCT_INT , (char *) 0 );
+                       putop( PCC_CM , PCCT_INT );
+                       putleaf( PCC_ICON , set.uprbp , 0 , PCCT_INT , (char *) 0 );
+                       putop( PCC_CM , PCCT_INT );

                        postcset( r , &csetd );
                        postcset( r , &csetd );

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

                    }
                    return csetd.csettype;
 #              endif PC
                    }
                    return csetd.csettype;
 #              endif PC


@@ -394,99 +431,110 @@ cstrng:
         */
        case T_PLUS:
        case T_MINUS:
         */
        case T_PLUS:
        case T_MINUS:

-               q = rvalue(r[2], NIL , RREQ );
-               if (q == NIL)
-                       return (NIL);
+               q = rvalue(r->un_expr.expr, NLNIL , RREQ );
+               if (q == NLNIL)
+                       return (NLNIL);

                if (isnta(q, "id")) {
                        error("Operand of %s must be integer or real, not %s", opname, nameof(q));
                if (isnta(q, "id")) {
                        error("Operand of %s must be integer or real, not %s", opname, nameof(q));

-                       return (NIL);
+                       return (NLNIL);

                }
                }

-               if (r[0] == T_MINUS) {
+               if (r->tag == T_MINUS) {

 #                  ifdef OBJ
 #                  ifdef OBJ

-                       put(1, O_NEG2 + (width(q) >> 2));
+                       (void) put(1, O_NEG2 + (width(q) >> 2));
+                       return (isa(q, "d") ? q : nl+T4INT);

 #                  endif OBJ
 #                  ifdef PC
 #                  endif OBJ
 #                  ifdef PC

-                       putop( P2UNARY P2MINUS , p2type( q ) );
+                       if (isa(q, "i")) {
+                           sconv(p2type(q), PCCT_INT);
+                           putop( PCCOM_UNARY PCC_MINUS, PCCT_INT);
+                           return nl+T4INT;
+                       }
+                       putop( PCCOM_UNARY PCC_MINUS, PCCT_DOUBLE);
+                       return nl+TDOUBLE;

 #                  endif PC
 #                  endif PC

-                   return (isa(q, "d") ? q : nl+T4INT);

                }
                return (q);
 
        case T_NOT:
                }
                return (q);
 
        case T_NOT:

-               q = rvalue(r[2], NIL , RREQ );
-               if (q == NIL)
-                       return (NIL);
+               q = rvalue(r->un_expr.expr, NLNIL , RREQ );
+               if (q == NLNIL)
+                       return (NLNIL);

                if (isnta(q, "b")) {
                        error("not must operate on a Boolean, not %s", nameof(q));
                if (isnta(q, "b")) {
                        error("not must operate on a Boolean, not %s", nameof(q));

-                       return (NIL);
+                       return (NLNIL);

                }
 #              ifdef OBJ
                }
 #              ifdef OBJ

-                   put(1, O_NOT);
+                   (void) put(1, O_NOT);

 #              endif OBJ
 #              ifdef PC
 #              endif OBJ
 #              ifdef PC

-                   putop( P2NOT , P2INT );
+                   sconv(p2type(q), PCCT_INT);
+                   putop( PCC_NOT , PCCT_INT);
+                   sconv(PCCT_INT, p2type(q));

 #              endif PC
                return (nl+T1BOOL);
 
        case T_AND:
        case T_OR:
 #              endif PC
                return (nl+T1BOOL);
 
        case T_AND:
        case T_OR:

-               p = rvalue(r[2], NIL , RREQ );
-               p1 = rvalue(r[3], NIL , RREQ );
-               if (p == NIL || p1 == NIL)
-                       return (NIL);
+               p = rvalue(r->expr_node.lhs, NLNIL , RREQ );
+#              ifdef PC
+                   sconv(p2type(p),PCCT_INT);
+#              endif PC
+               p1 = rvalue(r->expr_node.rhs, NLNIL , RREQ );
+#              ifdef PC
+                   sconv(p2type(p1),PCCT_INT);
+#              endif PC
+               if (p == NLNIL || p1 == NLNIL)
+                       return (NLNIL);

                if (isnta(p, "b")) {
                        error("Left operand of %s must be Boolean, not %s", opname, nameof(p));
                if (isnta(p, "b")) {
                        error("Left operand of %s must be Boolean, not %s", opname, nameof(p));

-                       return (NIL);
+                       return (NLNIL);

                }
                if (isnta(p1, "b")) {
                        error("Right operand of %s must be Boolean, not %s", opname, nameof(p1));
                }
                if (isnta(p1, "b")) {
                        error("Right operand of %s must be Boolean, not %s", opname, nameof(p1));

-                       return (NIL);
+                       return (NLNIL);

                }
 #              ifdef OBJ
                }
 #              ifdef OBJ

-                   put(1, r[0] == T_AND ? O_AND : O_OR);
+                   (void) put(1, r->tag == T_AND ? O_AND : O_OR);

 #              endif OBJ
 #              ifdef PC
                        /*
                         * note the use of & and | rather than && and ||
                         * to force evaluation of all the expressions.
                         */
 #              endif OBJ
 #              ifdef PC
                        /*
                         * note the use of & and | rather than && and ||
                         * to force evaluation of all the expressions.
                         */

-                   putop( r[ 0 ] == T_AND ? P2AND : P2OR , P2INT );
+                   putop( r->tag == T_AND ? PCC_AND : PCC_OR , PCCT_INT );
+                   sconv(PCCT_INT, p2type(p));

 #              endif PC
                return (nl+T1BOOL);
 
        case T_DIVD:
 #              ifdef OBJ
 #              endif PC
                return (nl+T1BOOL);
 
        case T_DIVD:
 #              ifdef OBJ

-                   p = rvalue(r[2], NIL , RREQ );
-                   p1 = rvalue(r[3], NIL , RREQ );
+                   p = rvalue(r->expr_node.lhs, NLNIL , RREQ );
+                   p1 = rvalue(r->expr_node.rhs, NLNIL , RREQ );

 #              endif OBJ
 #              ifdef PC
                        /*
                         *      force these to be doubles for the divide
                         */
 #              endif OBJ
 #              ifdef PC
                        /*
                         *      force these to be doubles for the divide
                         */

-                   p = rvalue( r[ 2 ] , NIL , RREQ );
-                   if ( isnta( p , "d" ) ) {
-                       putop( P2SCONV , P2DOUBLE );
-                   }
-                   p1 = rvalue( r[ 3 ] , NIL , RREQ );
-                   if ( isnta( p1 , "d" ) ) {
-                       putop( P2SCONV , P2DOUBLE );
-                   }
+                   p = rvalue( r->expr_node.lhs , NLNIL , RREQ );
+                   sconv(p2type(p), PCCT_DOUBLE);
+                   p1 = rvalue( r->expr_node.rhs , NLNIL , RREQ );
+                   sconv(p2type(p1), PCCT_DOUBLE);

 #              endif PC
 #              endif PC

-               if (p == NIL || p1 == NIL)
-                       return (NIL);
+               if (p == NLNIL || p1 == NLNIL)
+                       return (NLNIL);

                if (isnta(p, "id")) {
                        error("Left operand of / must be integer or real, not %s", nameof(p));
                if (isnta(p, "id")) {
                        error("Left operand of / must be integer or real, not %s", nameof(p));

-                       return (NIL);
+                       return (NLNIL);

                }
                if (isnta(p1, "id")) {
                        error("Right operand of / must be integer or real, not %s", nameof(p1));
                }
                if (isnta(p1, "id")) {
                        error("Right operand of / must be integer or real, not %s", nameof(p1));

-                       return (NIL);
+                       return (NLNIL);

                }
 #              ifdef OBJ
                }
 #              ifdef OBJ

-                   return gen(NIL, r[0], width(p), width(p1));
+                   return gen(NIL, r->tag, width(p), width(p1));

 #              endif OBJ
 #              ifdef PC
 #              endif OBJ
 #              ifdef PC

-                   putop( P2DIV , P2DOUBLE );
+                   putop( PCC_DIV , PCCT_DOUBLE );

                    return nl + TDOUBLE;
 #              endif PC
 
                    return nl + TDOUBLE;
 #              endif PC
 


@@ -495,36 +543,47 @@ cstrng:
        case T_SUB:
 #              ifdef OBJ
                    /*
        case T_SUB:
 #              ifdef OBJ
                    /*

-                    * If the context hasn't told us the type
-                    * and a constant set is present
-                    * we need to infer the type 
-                    * before generating code.
+                    * get the type of the right hand side.
+                    * if it turns out to be a set,
+                    * use that type when getting
+                    * the type of the left hand side.
+                    * and then use the type of the left hand side
+                    * when generating code.
+                    * this will correctly decide the type of any
+                    * empty sets in the tree, since if the empty set 
+                    * is on the left hand side it will inherit
+                    * the type of the right hand side,
+                    * and if it's on the right hand side, its type (intset)
+                    * will be overridden by the type of the left hand side.
+                    * this is an awful lot of tree traversing, 
+                    * but it works.

                     */
                     */

-                   if ( contype == NIL ) {
-                           codeoff();
-                           contype = rvalue( r[3] , NIL , RREQ );
-                           codeon();
-                           if ( contype == lookup( intset ) -> type ) {
-                               codeoff();
-                               contype = rvalue( r[2] , NIL , RREQ );
-                               codeon();
-                           }
+                   codeoff();
+                   p1 = rvalue( r->expr_node.rhs , NLNIL , RREQ );
+                   codeon();
+                   if ( p1 == NLNIL ) {
+                       return NLNIL;

                    }
                    }

-                   if ( contype == NIL ) {
-                       return NIL;
+                   if (isa(p1, "t")) {
+                       codeoff();
+                       contype = rvalue(r->expr_node.lhs, p1, RREQ);
+                       codeon();
+                       if (contype == NLNIL) {
+                           return NLNIL;
+                       }

                    }
                    }

-                   p = rvalue( r[2] , contype , RREQ );
-                   p1 = rvalue( r[3] , p , RREQ );
-                   if ( p == NIL || p1 == NIL )
-                           return NIL;
+                   p = rvalue( r->expr_node.lhs , contype , RREQ );
+                   p1 = rvalue( r->expr_node.rhs , p , RREQ );
+                   if ( p == NLNIL || p1 == NLNIL )
+                           return NLNIL;

                    if (isa(p, "id") && isa(p1, "id"))
                    if (isa(p, "id") && isa(p1, "id"))

-                       return (gen(NIL, r[0], width(p), width(p1)));
+                       return (gen(NIL, r->tag, width(p), width(p1)));

                    if (isa(p, "t") && isa(p1, "t")) {
                            if (p != p1) {
                                    error("Set types of operands of %s must be identical", opname);
                    if (isa(p, "t") && isa(p1, "t")) {
                            if (p != p1) {
                                    error("Set types of operands of %s must be identical", opname);

-                                   return (NIL);
+                                   return (NLNIL);

                            }
                            }

-                           gen(TSET, r[0], width(p), 0);
+                           (void) gen(TSET, r->tag, width(p), 0);

                            return (p);
                    }
 #              endif OBJ
                            return (p);
                    }
 #              endif OBJ


@@ -532,75 +591,59 @@ cstrng:
                        /*
                         * the second pass can't do
                         *      long op double  or  double op long
                        /*
                         * the second pass can't do
                         *      long op double  or  double op long

-                        * so we have to know the type of both operands
-                        * also, it gets tricky for sets, which are done
-                        * by function calls.
+                        * so we have to know the type of both operands.
+                        * also, see the note for obj above on determining
+                        * the type of empty sets.

                         */
                    codeoff();
                         */
                    codeoff();

-                   p1 = rvalue( r[ 3 ] , contype , RREQ );
+                   p1 = rvalue(r->expr_node.rhs, NLNIL, RREQ);

                    codeon();
                    if ( isa( p1 , "id" ) ) {
                    codeon();
                    if ( isa( p1 , "id" ) ) {

-                       p = rvalue( r[ 2 ] , contype , RREQ );
-                       if ( ( p == NIL ) || ( p1 == NIL ) ) {
-                           return NIL;
-                       }
-                       if ( isa( p , "i" ) && isa( p1 , "d" ) ) {
-                           putop( P2SCONV , P2DOUBLE );
-                       }
-                       p1 = rvalue( r[ 3 ] , contype , RREQ );
-                       if ( isa( p , "d" ) && isa( p1 , "i" ) ) {
-                           putop( P2SCONV , P2DOUBLE );
+                       p = rvalue( r->expr_node.lhs , contype , RREQ );
+                       if ( ( p == NLNIL ) || ( p1 == NLNIL ) ) {
+                           return NLNIL;

                        }
                        }

+                       tuac(p, p1, &rettype, (int *) (&ctype));
+                       p1 = rvalue( r->expr_node.rhs , contype , RREQ );
+                       tuac(p1, p, &rettype, (int *) (&ctype));

                        if ( isa( p , "id" ) ) {
                        if ( isa( p , "id" ) ) {

-                           if ( isa( p , "d" ) || isa( p1 , "d" ) ) {
-                               ctype = P2DOUBLE;
-                               rettype = nl + TDOUBLE;
-                           } else {
-                               ctype = P2INT;
-                               rettype = nl + T4INT;
-                           }
-                           putop( mathop[ r[0] - T_MULT ] , ctype );
+                           putop( (int) mathop[r->tag - T_MULT], (int) ctype);

                            return rettype;
                        }
                    }
                    if ( isa( p1 , "t" ) ) {
                            return rettype;
                        }
                    }
                    if ( isa( p1 , "t" ) ) {

-                       putleaf( P2ICON , 0 , 0
-                           , ADDTYPE( ADDTYPE( P2PTR | P2STRTY , P2FTN )
-                                       , P2PTR )
-                           , setop[ r[0] - T_MULT ] );
-                       if ( contype == NIL ) {
-                           contype = p1;
-                           if ( contype == lookup( intset ) -> type ) {
-                               codeoff();
-                               contype = rvalue( r[2] , NIL , LREQ );
-                               codeon();
-                           }
-                       }
-                       if ( contype == NIL ) {
-                           return NIL;
+                       putleaf( PCC_ICON , 0 , 0
+                           , PCCM_ADDTYPE( PCCM_ADDTYPE( PCCTM_PTR | PCCT_STRTY , PCCTM_FTN )
+                                       , PCCTM_PTR )
+                           , setop[ r->tag - T_MULT ] );
+                       codeoff();
+                       contype = rvalue( r->expr_node.lhs, p1 , LREQ );
+                       codeon();
+                       if ( contype == NLNIL ) {
+                           return NLNIL;

                        }
                            /*
                             *  allocate a temporary and use it
                             */
                        tempnlp = tmpalloc(lwidth(contype), contype, NOREG);
                        }
                            /*
                             *  allocate a temporary and use it
                             */
                        tempnlp = tmpalloc(lwidth(contype), contype, NOREG);

-                       putLV( 0 , cbn , tempnlp -> value[ NL_OFFS ] ,
-                               tempnlp -> extra_flags , P2PTR|P2STRTY );
-                       p = rvalue( r[2] , contype , LREQ );
+                       putLV((char *) 0 , cbn , tempnlp -> value[ NL_OFFS ] ,
+                               tempnlp -> extra_flags , PCCTM_PTR|PCCT_STRTY );
+                       p = rvalue( r->expr_node.lhs , contype , LREQ );

                        if ( isa( p , "t" ) ) {
                        if ( isa( p , "t" ) ) {

-                           putop( P2LISTOP , P2INT );
-                           if ( p == NIL || p1 == NIL ) {
-                               return NIL;
+                           putop( PCC_CM , PCCT_INT );
+                           if ( p == NLNIL || p1 == NLNIL ) {
+                               return NLNIL;

                            }
                            }

-                           p1 = rvalue( r[3] , p , LREQ );
+                           p1 = rvalue( r->expr_node.rhs , p , LREQ );

                            if ( p != p1 ) {
                                error("Set types of operands of %s must be identical", opname);
                            if ( p != p1 ) {
                                error("Set types of operands of %s must be identical", opname);

-                               return NIL;
+                               return NLNIL;

                            }
                            }

-                           putop( P2LISTOP , P2INT );
-                           putleaf( P2ICON , lwidth( p1 ) / sizeof( long ) , 0
-                                   , P2INT , 0 );
-                           putop( P2LISTOP , P2INT );
-                           putop( P2CALL , P2PTR | P2STRTY );
+                           putop( PCC_CM , PCCT_INT );
+                           putleaf( PCC_ICON , (int) (lwidth(p1)) / sizeof( long ) , 0
+                                   , PCCT_INT , (char *) 0 );
+                           putop( PCC_CM , PCCT_INT );
+                           putop( PCC_CALL , PCCTM_PTR | PCCT_STRTY );

                            return p;
                        }
                    }
                            return p;
                        }
                    }


@@ -608,46 +651,90 @@ cstrng:
                            /*
                             *  find type of left operand for error message.
                             */
                            /*
                             *  find type of left operand for error message.
                             */

-                       p = rvalue( r[2] , contype , RREQ );
+                       p = rvalue( r->expr_node.lhs , contype , RREQ );

                    }
                        /*
                         *      don't give spurious error messages.
                         */
                    }
                        /*
                         *      don't give spurious error messages.
                         */

-                   if ( p == NIL || p1 == NIL ) {
-                       return NIL;
+                   if ( p == NLNIL || p1 == NLNIL ) {
+                       return NLNIL;

                    }
 #              endif PC
                if (isnta(p, "idt")) {
                        error("Left operand of %s must be integer, real or set, not %s", opname, nameof(p));
                    }
 #              endif PC
                if (isnta(p, "idt")) {
                        error("Left operand of %s must be integer, real or set, not %s", opname, nameof(p));

-                       return (NIL);
+                       return (NLNIL);

                }
                if (isnta(p1, "idt")) {
                        error("Right operand of %s must be integer, real or set, not %s", opname, nameof(p1));
                }
                if (isnta(p1, "idt")) {
                        error("Right operand of %s must be integer, real or set, not %s", opname, nameof(p1));

-                       return (NIL);
+                       return (NLNIL);

                }
                error("Cannot mix sets with integers and reals as operands of %s", opname);
                }
                error("Cannot mix sets with integers and reals as operands of %s", opname);

-               return (NIL);
+               return (NLNIL);

 
        case T_MOD:
        case T_DIV:
 
        case T_MOD:
        case T_DIV:

-               p = rvalue(r[2], NIL , RREQ );
-               p1 = rvalue(r[3], NIL , RREQ );
-               if (p == NIL || p1 == NIL)
-                       return (NIL);
+               p = rvalue(r->expr_node.lhs, NLNIL , RREQ );
+#              ifdef PC
+                   sconv(p2type(p), PCCT_INT);
+#              ifdef tahoe
+                   /* prepare for ediv workaround, see below. */
+                   if (r->tag == T_MOD) {
+                       (void) rvalue(r->expr_node.lhs, NLNIL, RREQ);
+                       sconv(p2type(p), PCCT_INT);
+                   }
+#              endif tahoe
+#              endif PC
+               p1 = rvalue(r->expr_node.rhs, NLNIL , RREQ );
+#              ifdef PC
+                   sconv(p2type(p1), PCCT_INT);
+#              endif PC
+               if (p == NLNIL || p1 == NLNIL)
+                       return (NLNIL);

                if (isnta(p, "i")) {
                        error("Left operand of %s must be integer, not %s", opname, nameof(p));
                if (isnta(p, "i")) {
                        error("Left operand of %s must be integer, not %s", opname, nameof(p));

-                       return (NIL);
+                       return (NLNIL);

                }
                if (isnta(p1, "i")) {
                        error("Right operand of %s must be integer, not %s", opname, nameof(p1));
                }
                if (isnta(p1, "i")) {
                        error("Right operand of %s must be integer, not %s", opname, nameof(p1));

-                       return (NIL);
+                       return (NLNIL);

                }
 #              ifdef OBJ
                }
 #              ifdef OBJ

-                   return (gen(NIL, r[0], width(p), width(p1)));
+                   return (gen(NIL, r->tag, width(p), width(p1)));

 #              endif OBJ
 #              ifdef PC
 #              endif OBJ
 #              ifdef PC

-                   putop( r[ 0 ] == T_DIV ? P2DIV : P2MOD , P2INT );
+#              ifndef tahoe
+                   putop( r->tag == T_DIV ? PCC_DIV : PCC_MOD , PCCT_INT );
+                   return ( nl + T4INT );
+#              else tahoe
+                   putop( PCC_DIV , PCCT_INT );
+                   if (r->tag == T_MOD) {
+                   /*
+                    * avoid f1 bug: PCC_MOD would generate an 'ediv',
+                    * which would reuire too many registers to evaluate
+                    * things like
+                    * var i:boolean;j:integer; i := (j+1) = (j mod 2);
+                    * so, instead of
+                    *                PCC_MOD
+                    *                  / \
+                    *                 p   p1
+                    * we put
+                    *                  PCC_MINUS
+                    *                    /   \
+                    *                   p   PCC_MUL               
+                    *                        /   \
+                    *                    PCC_DIV  p1
+                    *                      / \
+                    *                     p  p1
+                    *
+                    * we already have put p, p, p1, PCC_DIV. and now...
+                    */
+                           rvalue(r->expr_node.rhs, NLNIL , RREQ );
+                           sconv(p2type(p1), PCCT_INT);
+                           putop( PCC_MUL, PCCT_INT );
+                           putop( PCC_MINUS, PCCT_INT );
+                   }

                    return ( nl + T4INT );
                    return ( nl + T4INT );

+#              endif tahoe

 #              endif PC
 
        case T_EQ:
 #              endif PC
 
        case T_EQ:


@@ -663,12 +750,14 @@ cstrng:
                 * a type if possible.  Since constant strings can
                 * always masquerade as identifiers, this is always
                 * necessary.
                 * a type if possible.  Since constant strings can
                 * always masquerade as identifiers, this is always
                 * necessary.

+                * see the note in the obj section of case T_MULT above
+                * for the determination of the base type of empty sets.

                 */
                codeoff();
                 */
                codeoff();

-               p1 = rvalue(r[3], NIL , RREQ );
+               p1 = rvalue(r->expr_node.rhs, NLNIL , RREQ );

                codeon();
                codeon();

-               if (p1 == NIL)
-                       return (NIL);
+               if (p1 == NLNIL)
+                       return (NLNIL);

                contype = p1;
 #              ifdef OBJ
                    if (p1->class == STR) {
                contype = p1;
 #              ifdef OBJ
                    if (p1->class == STR) {


@@ -680,20 +769,19 @@ cstrng:
                             * we get this length here.
                             */
                            codeoff();
                             * we get this length here.
                             */
                            codeoff();

-                           p = rvalue(r[2], NIL , RREQ );
+                           p = rvalue(r->expr_node.lhs, NLNIL , RREQ );

                            codeon();
                            codeon();

-                           if (p == NIL)
-                                   return (NIL);
+                           if (p == NLNIL)
+                                   return (NLNIL);

                            if (width(p) > width(p1))
                                    contype = p;
                            if (width(p) > width(p1))
                                    contype = p;

-                   } else if ( isa( p1 , "t" ) ) {
-                       if ( contype == lookup( intset ) -> type ) {
-                           codeoff();
-                           contype = rvalue( r[2] , NIL , RREQ );
-                           codeon();
-                           if ( contype == NIL ) {
-                               return NIL;
-                           }
+                   }
+                   if (isa(p1, "t")) {
+                       codeoff();
+                       contype = rvalue(r->expr_node.lhs, p1, RREQ);
+                       codeon();
+                       if (contype == NLNIL) {
+                           return NLNIL;

                        }
                    }
                    /*
                        }
                    }
                    /*


@@ -701,20 +789,20 @@ cstrng:
                     * the operands of the relational
                     * operation.
                     */
                     * the operands of the relational
                     * operation.
                     */

-                   p = rvalue(r[2], contype , RREQ );
-                   if (p == NIL)
-                           return (NIL);
-                   p1 = rvalue(r[3], p , RREQ );
-                   if (p1 == NIL)
-                           return (NIL);
+                   p = rvalue(r->expr_node.lhs, contype , RREQ );
+                   if (p == NLNIL)
+                           return (NLNIL);
+                   p1 = rvalue(r->expr_node.rhs, p , RREQ );
+                   if (p1 == NLNIL)
+                           return (NLNIL);

 #              endif OBJ
 #              ifdef PC
                    c1 = classify( p1 );
                    if ( c1 == TSET || c1 == TSTR || c1 == TREC ) {
 #              endif OBJ
 #              ifdef PC
                    c1 = classify( p1 );
                    if ( c1 == TSET || c1 == TSTR || c1 == TREC ) {

-                       putleaf( P2ICON , 0 , 0
-                               , ADDTYPE( P2FTN | P2INT , P2PTR )
-                               , c1 == TSET  ? relts[ r[0] - T_EQ ]
-                                             : relss[ r[0] - T_EQ ] );
+                       putleaf( PCC_ICON , 0 , 0
+                               , PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR )
+                               , c1 == TSET  ? relts[ r->tag - T_EQ ]
+                                             : relss[ r->tag - T_EQ ] );

                            /*
                             *  for [] and strings, comparisons are done on
                             *  the maximum width of the two sides.
                            /*
                             *  for [] and strings, comparisons are done on
                             *  the maximum width of the two sides.


@@ -724,74 +812,71 @@ cstrng:
                             */
                        if ( c1 == TSTR ) {
                            codeoff();
                             */
                        if ( c1 == TSTR ) {
                            codeoff();

-                           p = rvalue( r[ 2 ] , NIL , LREQ );
+                           p = rvalue( r->expr_node.lhs , NLNIL , LREQ );

                            codeon();
                            codeon();

-                           if ( p == NIL ) {
-                               return NIL;
+                           if ( p == NLNIL ) {
+                               return NLNIL;

                            }
                            if ( lwidth( p ) > lwidth( p1 ) ) {
                                contype = p;
                            }
                        } else if ( c1 == TSET ) {
                            }
                            if ( lwidth( p ) > lwidth( p1 ) ) {
                                contype = p;
                            }
                        } else if ( c1 == TSET ) {

-                           if ( contype == lookup( intset ) -> type ) {
-                               codeoff();
-                               p = rvalue( r[ 2 ] , NIL , LREQ );
-                               codeon();
-                               if ( p == NIL ) {
-                                   return NIL;
-                               }
-                               contype = p;
+                           codeoff();
+                           contype = rvalue(r->expr_node.lhs, p1, LREQ);
+                           codeon();
+                           if (contype == NLNIL) {
+                               return NLNIL;

                            }
                        } 
                            /*
                             *  put out the width of the comparison.
                             */
                            }
                        } 
                            /*
                             *  put out the width of the comparison.
                             */

-                       putleaf( P2ICON , lwidth( contype ) , 0 , P2INT , 0 );
+                       putleaf(PCC_ICON, (int) lwidth(contype), 0, PCCT_INT, (char *) 0);

                            /*
                             *  and the left hand side,
                             *  for sets, strings, records
                             */
                            /*
                             *  and the left hand side,
                             *  for sets, strings, records
                             */

-                       p = rvalue( r[ 2 ] , contype , LREQ );
-                       if ( p == NIL ) {
-                           return NIL;
+                       p = rvalue( r->expr_node.lhs , contype , LREQ );
+                       if ( p == NLNIL ) {
+                           return NLNIL;

                        }
                        }

-                       putop( P2LISTOP , P2INT );
-                       p1 = rvalue( r[ 3 ] , p , LREQ );
-                       if ( p1 == NIL ) {
-                           return NIL;
+                       putop( PCC_CM , PCCT_INT );
+                       p1 = rvalue( r->expr_node.rhs , p , LREQ );
+                       if ( p1 == NLNIL ) {
+                           return NLNIL;

                        }
                        }

-                       putop( P2LISTOP , P2INT );
-                       putop( P2CALL , P2INT );
+                       putop( PCC_CM , PCCT_INT );
+                       putop( PCC_CALL , PCCT_INT );

                    } else {
                            /*
                             *  the easy (scalar or error) case
                             */
                    } else {
                            /*
                             *  the easy (scalar or error) case
                             */

-                       p = rvalue( r[ 2 ] , contype , RREQ );
-                       if ( p == NIL ) {
-                           return NIL;
+                       p = rvalue( r->expr_node.lhs , contype , RREQ );
+                       if ( p == NLNIL ) {
+                           return NLNIL;

                        }
                            /*
                             * since the second pass can't do
                             *  long op double  or  double op long
                             * we may have to do some coercing.
                             */
                        }
                            /*
                             * since the second pass can't do
                             *  long op double  or  double op long
                             * we may have to do some coercing.
                             */

-                       if ( isa( p , "i" ) && isa( p1 , "d" ) ) {
-                           putop( P2SCONV , P2DOUBLE );
+                       tuac(p, p1, &rettype, (int *) (&ctype));
+                       p1 = rvalue( r->expr_node.rhs , p , RREQ );
+                       if ( p1 == NLNIL ) {
+                           return NLNIL;

                        }
                        }

-                       p1 = rvalue( r[ 3 ] , p , RREQ );
-                       if ( p1 == NIL ) {
-                           return NIL;
-                       }
-                       if ( isa( p , "d" ) && isa( p1 , "i" ) )
-                           putop( P2SCONV , P2DOUBLE );
-                       putop( relops[ r[0] - T_EQ ] , P2INT );
+                       tuac(p1, p, &rettype, (int *) (&ctype));
+                       putop((int) relops[ r->tag - T_EQ ] , PCCT_INT );
+                       sconv(PCCT_INT, PCCT_CHAR);

                    }
 #              endif PC
                c = classify(p);
                c1 = classify(p1);
                if (nocomp(c) || nocomp(c1))
                    }
 #              endif PC
                c = classify(p);
                c1 = classify(p1);
                if (nocomp(c) || nocomp(c1))

-                       return (NIL);
-               g = NIL;
+                       return (NLNIL);
+#              ifdef OBJ
+                   g = NIL;
+#              endif

                switch (c) {
                        case TBOOL:
                        case TCHAR:
                switch (c) {
                        case TBOOL:
                        case TCHAR:


@@ -813,7 +898,7 @@ cstrng:
                                if (c1 != TSET)
                                        goto clash;
                                if ( opt( 's' ) &&
                                if (c1 != TSET)
                                        goto clash;
                                if ( opt( 's' ) &&

-                                   ( ( r[0] == T_LT ) || ( r[0] == T_GT ) ) &&
+                                   ( ( r->tag == T_LT) || (r->tag == T_GT) ) &&

                                    ( line != nssetline ) ) {
                                    nssetline = line;
                                    standard();
                                    ( line != nssetline ) ) {
                                    nssetline = line;
                                    standard();


@@ -821,7 +906,9 @@ cstrng:
                                }
                                if (p != p1)
                                        goto nonident;
                                }
                                if (p != p1)
                                        goto nonident;

-                               g = TSET;
+#                              ifdef OBJ
+                                   g = TSET;
+#                              endif

                                break;
                        case TREC:
                                if ( c1 != TREC ) {
                                break;
                        case TREC:
                                if ( c1 != TREC ) {


@@ -830,130 +917,137 @@ cstrng:
                                if ( p != p1 ) {
                                    goto nonident;
                                }
                                if ( p != p1 ) {
                                    goto nonident;
                                }

-                               if (r[0] != T_EQ && r[0] != T_NE) {
+                               if (r->tag != T_EQ && r->tag != T_NE) {

                                        error("%s not allowed on records - only allow = and <>" , opname );
                                        error("%s not allowed on records - only allow = and <>" , opname );

-                                       return (NIL);
+                                       return (NLNIL);

                                }
                                }

-                               g = TREC;
+#                              ifdef OBJ
+                                   g = TREC;
+#                              endif

                                break;
                        case TPTR:
                        case TNIL:
                                if (c1 != TPTR && c1 != TNIL)
                                        goto clash;
                                break;
                        case TPTR:
                        case TNIL:
                                if (c1 != TPTR && c1 != TNIL)
                                        goto clash;

-                               if (r[0] != T_EQ && r[0] != T_NE) {
+                               if (r->tag != T_EQ && r->tag != T_NE) {

                                        error("%s not allowed on pointers - only allow = and <>" , opname );
                                        error("%s not allowed on pointers - only allow = and <>" , opname );

-                                       return (NIL);
+                                       return (NLNIL);

                                }
                                }

+                               if (p != nl+TNIL && p1 != nl+TNIL && p != p1)
+                                       goto nonident;

                                break;
                        case TSTR:
                                if (c1 != TSTR)
                                        goto clash;
                                if (width(p) != width(p1)) {
                                        error("Strings not same length in %s comparison", opname);
                                break;
                        case TSTR:
                                if (c1 != TSTR)
                                        goto clash;
                                if (width(p) != width(p1)) {
                                        error("Strings not same length in %s comparison", opname);

-                                       return (NIL);
+                                       return (NLNIL);

                                }
                                }

-                               g = TSTR;
+#                              ifdef OBJ
+                                   g = TSTR;
+#                              endif OBJ

                                break;
                        default:
                                panic("rval2");
                }
 #              ifdef OBJ
                                break;
                        default:
                                panic("rval2");
                }
 #              ifdef OBJ

-                   return (gen(g, r[0], width(p), width(p1)));
+                   return (gen(g, r->tag, width(p), width(p1)));

 #              endif OBJ
 #              ifdef PC
                    return nl + TBOOL;
 #              endif PC
 clash:
                error("%ss and %ss cannot be compared - operator was %s", clnames[c], clnames[c1], opname);
 #              endif OBJ
 #              ifdef PC
                    return nl + TBOOL;
 #              endif PC
 clash:
                error("%ss and %ss cannot be compared - operator was %s", clnames[c], clnames[c1], opname);

-               return (NIL);
+               return (NLNIL);

 nonident:
                error("%s types must be identical in comparisons - operator was %s", clnames[c1], opname);
 nonident:
                error("%s types must be identical in comparisons - operator was %s", clnames[c1], opname);

-               return (NIL);
+               return (NLNIL);

 
        case T_IN:
 
        case T_IN:

-           rt = r[3];
+           rt = r->expr_node.rhs;

 #          ifdef OBJ
 #          ifdef OBJ

-               if (rt != NIL && rt[0] == T_CSET) {
-                       precset( rt , NIL , &csetd );
+               if (rt != TR_NIL && rt->tag == T_CSET) {
+                       (void) precset( rt , NLNIL , &csetd );

                        p1 = csetd.csettype;
                        p1 = csetd.csettype;

-                       if (p1 == NIL)
-                           return NIL;
+                       if (p1 == NLNIL)
+                           return NLNIL;

                        postcset( rt, &csetd);
                    } else {
                        postcset( rt, &csetd);
                    } else {

-                       p1 = stkrval(r[3], NIL , RREQ );
-                       rt = NIL;
+                       p1 = stkrval(r->expr_node.rhs, NLNIL , (long) RREQ );
+                       rt = TR_NIL;

                    }
 #              endif OBJ
 #              ifdef PC
                    }
 #              endif OBJ
 #              ifdef PC

-                   if (rt != NIL && rt[0] == T_CSET) {
-                       if ( precset( rt , NIL , &csetd ) ) {
-                           putleaf( P2ICON , 0 , 0
-                                   , ADDTYPE( P2FTN | P2INT , P2PTR )
+                   if (rt != TR_NIL && rt->tag == T_CSET) {
+                       if ( precset( rt , NLNIL , &csetd ) ) {
+                           putleaf( PCC_ICON , 0 , 0
+                                   , PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR )

                                    , "_IN" );
                        } else {
                                    , "_IN" );
                        } else {

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

                                    , "_INCT" );
                        }
                        p1 = csetd.csettype;
                        if (p1 == NIL)
                                    , "_INCT" );
                        }
                        p1 = csetd.csettype;
                        if (p1 == NIL)

-                           return NIL;
+                           return NLNIL;

                    } else {
                    } else {

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

                                , "_IN" );
                        codeoff();
                                , "_IN" );
                        codeoff();

-                       p1 = rvalue(r[3], NIL , LREQ );
+                       p1 = rvalue(r->expr_node.rhs, NLNIL , LREQ );

                        codeon();
                    }
 #              endif PC
                        codeon();
                    }
 #              endif PC

-               p = stkrval(r[2], NIL , RREQ );
+               p = stkrval(r->expr_node.lhs, NLNIL , (long) RREQ );

                if (p == NIL || p1 == NIL)
                if (p == NIL || p1 == NIL)

-                       return (NIL);
-               if (p1->class != SET) {
+                       return (NLNIL);
+               if (p1->class != (char) SET) {

                        error("Right operand of 'in' must be a set, not %s", nameof(p1));
                        error("Right operand of 'in' must be a set, not %s", nameof(p1));

-                       return (NIL);
+                       return (NLNIL);

                }
                }

-               if (incompat(p, p1->type, r[2])) {
+               if (incompat(p, p1->type, r->expr_node.lhs)) {

                        cerror("Index type clashed with set component type for 'in'");
                        cerror("Index type clashed with set component type for 'in'");

-                       return (NIL);
+                       return (NLNIL);

                }
                setran(p1->type);
 #              ifdef OBJ
                }
                setran(p1->type);
 #              ifdef OBJ

-                   if (rt == NIL || csetd.comptime)
-                           put(4, O_IN, width(p1), set.lwrb, set.uprbp);
+                   if (rt == TR_NIL || csetd.comptime)
+                           (void) put(4, O_IN, width(p1), set.lwrb, set.uprbp);

                    else
                    else

-                           put(2, O_INCT,
+                           (void) put(2, O_INCT,

                                (int)(3 + csetd.singcnt + 2*csetd.paircnt));
 #              endif OBJ
 #              ifdef PC
                                (int)(3 + csetd.singcnt + 2*csetd.paircnt));
 #              endif OBJ
 #              ifdef PC

-                   if ( rt == NIL || rt[0] != T_CSET ) {
-                       putleaf( P2ICON , set.lwrb , 0 , P2INT , 0 );
-                       putop( P2LISTOP , P2INT );
-                       putleaf( P2ICON , set.uprbp , 0 , P2INT , 0 );
-                       putop( P2LISTOP , P2INT );
-                       p1 = rvalue( r[3] , NIL , LREQ );
-                       if ( p1 == NIL ) {
-                           return NIL;
+                   if ( rt == TR_NIL || rt->tag != T_CSET ) {
+                       putleaf( PCC_ICON , set.lwrb , 0 , PCCT_INT , (char *) 0 );
+                       putop( PCC_CM , PCCT_INT );
+                       putleaf( PCC_ICON , set.uprbp , 0 , PCCT_INT , (char *) 0 );
+                       putop( PCC_CM , PCCT_INT );
+                       p1 = rvalue( r->expr_node.rhs , NLNIL , LREQ );
+                       if ( p1 == NLNIL ) {
+                           return NLNIL;

                        }
                        }

-                       putop( P2LISTOP , P2INT );
+                       putop( PCC_CM , PCCT_INT );

                    } else if ( csetd.comptime ) {
                    } else if ( csetd.comptime ) {

-                       putleaf( P2ICON , set.lwrb , 0 , P2INT , 0 );
-                       putop( P2LISTOP , P2INT );
-                       putleaf( P2ICON , set.uprbp , 0 , P2INT , 0 );
-                       putop( P2LISTOP , P2INT );
-                       postcset( r[3] , &csetd );
-                       putop( P2LISTOP , P2INT );
+                       putleaf( PCC_ICON , set.lwrb , 0 , PCCT_INT , (char *) 0 );
+                       putop( PCC_CM , PCCT_INT );
+                       putleaf( PCC_ICON , set.uprbp , 0 , PCCT_INT , (char *) 0 );
+                       putop( PCC_CM , PCCT_INT );
+                       postcset( r->expr_node.rhs , &csetd );
+                       putop( PCC_CM , PCCT_INT );

                    } else {
                    } else {

-                       postcset( r[3] , &csetd );
+                       postcset( r->expr_node.rhs , &csetd );

                    }
                    }

-                   putop( P2CALL , P2INT );
+                   putop( PCC_CALL , PCCT_INT );
+                   sconv(PCCT_INT, PCCT_CHAR);

 #              endif PC
                return (nl+T1BOOL);
        default:
 #              endif PC
                return (nl+T1BOOL);
        default:

-               if (r[2] == NIL)
-                       return (NIL);
-               switch (r[0]) {
+               if (r->expr_node.lhs == TR_NIL)
+                       return (NLNIL);
+               switch (r->tag) {

                default:
                        panic("rval3");
 
                default:
                        panic("rval3");
 


@@ -962,49 +1056,54 @@ nonident:
                 * An octal number
                 */
                case T_BINT:
                 * An octal number
                 */
                case T_BINT:

-                       f = a8tol(r[2]);
+                       f.pdouble = a8tol(r->const_node.cptr);

                        goto conint;
        
                /*
                 * A decimal number
                 */
                case T_INT:
                        goto conint;
        
                /*
                 * A decimal number
                 */
                case T_INT:

-                       f = atof(r[2]);
+                       f.pdouble = atof(r->const_node.cptr);

 conint:
 conint:

-                       if (f > MAXINT || f < MININT) {
+                       if (f.pdouble > MAXINT || f.pdouble < MININT) {

                                error("Constant too large for this implementation");
                                error("Constant too large for this implementation");

-                               return (NIL);
-                       }
-                       l = f;
-                       if (bytes(l, l) <= 2) {
-#                              ifdef OBJ
-                                   put(2, O_CON2, ( short ) l);
-#                              endif OBJ
-#                              ifdef PC
-                                       /*
-                                        * short constants are ints
-                                        */
-                                   putleaf( P2ICON , l , 0 , P2INT , 0 );
-#                              endif PC
-                               return (nl+T2INT);
+                               return (NLNIL);

                        }
                        }

+                       l = f.pdouble;

 #                      ifdef OBJ
 #                      ifdef OBJ

-                           put(2, O_CON4, l); 
+                           if (bytes(l, l) <= 2) {
+                                   (void) put(2, O_CON2, ( short ) l);
+                                   return (nl+T2INT);
+                           }
+                           (void) put(2, O_CON4, l); 
+                           return (nl+T4INT);

 #                      endif OBJ
 #                      ifdef PC
 #                      endif OBJ
 #                      ifdef PC

-                           putleaf( P2ICON , l , 0 , P2INT , 0 );
+                           switch (bytes(l, l)) {
+                               case 1:
+                                   putleaf(PCC_ICON, (int) l, 0, PCCT_CHAR, 
+                                               (char *) 0);
+                                   return nl+T1INT;
+                               case 2:
+                                   putleaf(PCC_ICON, (int) l, 0, PCCT_SHORT, 
+                                               (char *) 0);
+                                   return nl+T2INT;
+                               case 4:
+                                   putleaf(PCC_ICON, (int) l, 0, PCCT_INT,
+                                               (char *) 0);
+                                   return nl+T4INT;
+                           }

 #                      endif PC
 #                      endif PC

-                       return (nl+T4INT);

        
                /*
                 * A floating point number
                 */
                case T_FINT:
 #                      ifdef OBJ
        
                /*
                 * A floating point number
                 */
                case T_FINT:
 #                      ifdef OBJ

-                           put(2, O_CON8, atof(r[2]));
+                           (void) put(2, O_CON8, atof(r->const_node.cptr));

 #                      endif OBJ
 #                      ifdef PC
 #                      endif OBJ
 #                      ifdef PC

-                           putCON8( atof( r[2] ) );
+                           putCON8( atof( r->const_node.cptr ) );

 #                      endif PC
                        return (nl+TDOUBLE);
        
 #                      endif PC
                        return (nl+TDOUBLE);
        


@@ -1014,13 +1113,14 @@ conint:
                 * no constant string of length one.
                 */
                case T_STRNG:
                 * no constant string of length one.
                 */
                case T_STRNG:

-                       cp = r[2];
+                       cp = r->const_node.cptr;

                        if (cp[1] == 0) {
 #                              ifdef OBJ
                        if (cp[1] == 0) {
 #                              ifdef OBJ

-                                   put(2, O_CONC, cp[0]);
+                                   (void) put(2, O_CONC, cp[0]);

 #                              endif OBJ
 #                              ifdef PC
 #                              endif OBJ
 #                              ifdef PC

-                                   putleaf( P2ICON , cp[0] , 0 , P2CHAR , 0 );
+                                   putleaf( PCC_ICON , cp[0] , 0 , PCCT_CHAR ,
+                                               (char *) 0 );

 #                              endif PC
                                return (nl+T1CHAR);
                        }
 #                              endif PC
                                return (nl+T1CHAR);
                        }


@@ -1064,11 +1164,13 @@ nocomp(c)
      * as a side effect this fills in the con structure that gconst uses.
      * this returns TRUE or FALSE.
      */
      * as a side effect this fills in the con structure that gconst uses.
      * this returns TRUE or FALSE.
      */

+
+bool 

 constval(r)
 constval(r)

-       register int *r;
+       register struct tnode *r;

 {
        register struct nl *np;
 {
        register struct nl *np;

-       register *cn;
+       register struct tnode *cn;

        char *cp;
        int negd, sgnd;
        long ci;
        char *cp;
        int negd, sgnd;
        long ci;


@@ -1080,9 +1182,9 @@ loop:
            /*
             *  cn[2] is nil if error recovery generated a T_STRNG
             */
            /*
             *  cn[2] is nil if error recovery generated a T_STRNG
             */

-       if (cn == NIL || cn[2] == NIL)
+       if (cn == TR_NIL || cn->expr_node.lhs == TR_NIL)

                return FALSE;
                return FALSE;

-       switch (cn[0]) {
+       switch (cn->tag) {

                default:
                        return FALSE;
                case T_MINUS:
                default:
                        return FALSE;
                case T_MINUS:


@@ -1090,7 +1192,7 @@ loop:
                        /* and fall through */
                case T_PLUS:
                        sgnd++;
                        /* and fall through */
                case T_PLUS:
                        sgnd++;

-                       cn = cn[2];
+                       cn = cn->un_expr.expr;

                        goto loop;
                case T_NIL:
                        con.cpval = NIL;
                        goto loop;
                case T_NIL:
                        con.cpval = NIL;


@@ -1099,11 +1201,11 @@ loop:
                        con.ctype = nl + TNIL;
                        break;
                case T_VAR:
                        con.ctype = nl + TNIL;
                        break;
                case T_VAR:

-                       np = lookup(cn[2]);
-                       if (np == NIL || np->class != CONST) {
+                       np = lookup(cn->var_node.cptr);
+                       if (np == NLNIL || np->class != CONST) {

                                return FALSE;
                        }
                                return FALSE;
                        }

-                       if ( cn[3] != NIL ) {
+                       if ( cn->var_node.qual != TR_NIL ) {

                                return FALSE;
                        }
                        con.ctype = np->type;
                                return FALSE;
                        }
                        con.ctype = np->type;


@@ -1121,7 +1223,7 @@ loop:
                                        con.crval = con.cival;
                                        break;
                                case TSTR:
                                        con.crval = con.cival;
                                        break;
                                case TSTR:

-                                       con.cpval = np->ptr[0];
+                                       con.cpval = (char *) np->ptr[0];

                                        break;
                                default:
                                        con.ctype = NIL;
                                        break;
                                default:
                                        con.ctype = NIL;


@@ -1129,10 +1231,10 @@ loop:
                        }
                        break;
                case T_BINT:
                        }
                        break;
                case T_BINT:

-                       con.crval = a8tol(cn[2]);
+                       con.crval = a8tol(cn->const_node.cptr);

                        goto restcon;
                case T_INT:
                        goto restcon;
                case T_INT:

-                       con.crval = atof(cn[2]);
+                       con.crval = atof(cn->const_node.cptr);

                        if (con.crval > MAXINT || con.crval < MININT) {
                                derror("Constant too large for this implementation");
                                con.crval = 0;
                        if (con.crval > MAXINT || con.crval < MININT) {
                                derror("Constant too large for this implementation");
                                con.crval = 0;


@@ -1148,10 +1250,10 @@ restcon:
                        break;
                case T_FINT:
                        con.ctype = nl+TDOUBLE;
                        break;
                case T_FINT:
                        con.ctype = nl+TDOUBLE;

-                       con.crval = atof(cn[2]);
+                       con.crval = atof(cn->const_node.cptr);

                        break;
                case T_STRNG:
                        break;
                case T_STRNG:

-                       cp = cn[2];
+                       cp = cn->const_node.cptr;

                        if (cp[1] == 0) {
                                con.ctype = nl+T1CHAR;
                                con.cival = cp[0];
                        if (cp[1] == 0) {
                                con.ctype = nl+T1CHAR;
                                con.cival = cp[0];