BSD 4 release

[unix-history] / usr / src / cmd / pi / cset.c

diff --git a/usr/src/cmd/pi/cset.c b/usr/src/cmd/pi/cset.c
index 0e3af24..e150a2d 100644 (file)
--- a/usr/src/cmd/pi/cset.c
+++ b/usr/src/cmd/pi/cset.c
@@ -1,35 +1,61 @@
 /* Copyright (c) 1979 Regents of the University of California */
 /* Copyright (c) 1979 Regents of the University of California */

-#
-/*
- * pi - Pascal interpreter code translator
- *
- * Charles Haley, Bill Joy UCB
- * Version 1.2 November 1978
- */

 
 

-#include "whoami"
+static char sccsid[] = "@(#)cset.c 1.2 10/19/80";
+
+#include "whoami.h"

 #include "0.h"
 #include "tree.h"
 #include "opcode.h"
 #include "0.h"
 #include "tree.h"
 #include "opcode.h"

+#include "objfmt.h"
+#include "pc.h"
+#include "pcops.h"

 
 /*
 
 /*

- * Constant set constructor.
- * settype is the type of the
- * set if we think that we know it
- * if not we try our damndest to figure
- * out what the type should be.
+ *     rummage through a `constant' set (i.e. anything within [ ]'s) tree
+ *     and decide if this is a compile time constant set or a runtime set.
+ *     this information is returned in a structure passed from the caller.
+ *     while rummaging, this also reorders the tree so that all ranges
+ *     preceed all singletons.

  */
  */

-struct nl *
-cset(r, settype, x)
-       int *r;
-       struct nl *settype;
-       int x;
+bool
+precset( r , settype , csetp )
+       int             *r;
+       struct nl       *settype;
+       struct csetstr  *csetp;

 {
 {

-       register *e;
-       register struct nl *t, *exptype;
-       int n, *el;
+       register int            *e;
+       register struct nl      *t;
+       register struct nl      *exptype;
+       register int            *el;
+       register int            *pairp;
+       register int            *singp;
+       int                     *ip;
+       long                    lower;
+       long                    upper;
+       long                    rangeupper;
+       bool                    setofint;

 
 

-       if (settype == NIL) {
+       csetp -> csettype = NIL;
+       csetp -> paircnt = 0;
+       csetp -> singcnt = 0;
+       csetp -> comptime = TRUE;
+       setofint = FALSE;
+       if ( settype != NIL ) {
+           if ( settype -> class == SET ) {
+                   /*
+                    *  the easy case, we are told the type of the set.
+                    */
+               exptype = settype -> type;
+           } else {
+                   /*
+                    *  we are told the type, but it's not a set
+                    *  supposedly possible if someone tries
+                    *  e.g string context [1,2] = 'abc'
+                    */
+               error("Constant set involved in non set context");
+               return csetp -> comptime;
+           }
+       } else {

                /*
                 * So far we have no indication
                 * of what the set type should be.
                /*
                 * So far we have no indication
                 * of what the set type should be.


@@ -37,19 +63,39 @@ cset(r, settype, x)
                 * The type of the constant set
                 * by evaluating one of its members.
                 */
                 * The type of the constant set
                 * by evaluating one of its members.
                 */

-               e = r[2];
-               if (e == NIL)
-                       return (nl+TSET);       /* tenative for [] */
-               e = e[1];
-               if (e == NIL)
-                       return (NIL);
-               if (e[0] == T_RANG)
-                       e = e[1];
-               codeoff();
-               t = rvalue(e, NIL);
-               codeon();
-               if (t == NIL)
-                       return (NIL);
+           e = r[2];
+           if (e == NIL) {
+                   /*
+                    *  tentative for [], return type of `intset'
+                    */
+               settype = lookup( intset );
+               if ( settype == NIL ) {
+                   panic( "empty set" );
+               }
+               settype = settype -> type;
+               if ( settype == NIL ) {
+                   return csetp -> comptime;
+               }
+               if ( isnta( settype , "t" ) ) {
+                   error("Set default type \"intset\" is not a set");
+                   return csetp -> comptime;
+               }
+               csetp -> csettype = settype;
+               return csetp -> comptime;
+           }
+           e = e[1];
+           if (e == NIL) {
+               return csetp -> comptime;
+           }
+           if (e[0] == T_RANG) {
+                   e = e[1];
+           }
+           codeoff();
+           t = rvalue(e, NIL , RREQ );
+           codeon();
+           if (t == NIL) {
+               return csetp -> comptime;
+           }

                /*
                 * The type of the set, settype, is
                 * deemed to be a set of the base type
                /*
                 * The type of the set, settype, is
                 * deemed to be a set of the base type


@@ -59,84 +105,309 @@ cset(r, settype, x)
                 * and use "intset"'s current scoped
                 * type instead.
                 */
                 * and use "intset"'s current scoped
                 * type instead.
                 */

-               if (isa(t, "r")) {
-                       error("Sets may not have 'real' elements");
-                       return (NIL);
-               }
-               if (isnta(t, "bcsi")) {
-                       error("Set elements must be scalars, not %ss", nameof(t));
-                       return (NIL);
-               }
-               if (isa(t, "i")) {
-                       settype = lookup(intset);
-                       if (settype == NIL)
-                               panic("intset");
-                       settype = settype->type;
-                       if (settype == NIL)
-                               return (NIL);
-                       if (isnta(settype, "t")) {
-                               error("Set default type \"intset\" is not a set");
-                               return (NIL);
-                       }
-                       exptype = settype->type;
-               } else {
+           if (isa(t, "r")) {
+                   error("Sets may not have 'real' elements");
+                   return csetp -> comptime;
+           }
+           if (isnta(t, "bcsi")) {
+                   error("Set elements must be scalars, not %ss", nameof(t));
+                   return csetp -> comptime;
+           }
+           if (isa(t, "i")) {
+                   settype = lookup(intset);
+                   if (settype == NIL)
+                           panic("intset");
+                   settype = settype->type;
+                   if (settype == NIL)
+                           return csetp -> comptime;
+                   if (isnta(settype, "t")) {
+                           error("Set default type \"intset\" is not a set");
+                           return csetp -> comptime;
+                   }
+                   exptype = settype->type;
+                       /*
+                        *      say we are doing an intset
+                        *      but, if we get out of range errors for intset
+                        *      we punt constructing the set at compile time.
+                        */
+                   setofint = TRUE;
+           } else {

                        exptype = t->type;
                        if (exptype == NIL)
                        exptype = t->type;
                        if (exptype == NIL)

-                               return (NIL);
+                               return csetp -> comptime;

                        if (exptype->class != RANGE)
                                exptype = exptype->type;
                        settype = defnl(0, SET, exptype, 0);
                        if (exptype->class != RANGE)
                                exptype = exptype->type;
                        settype = defnl(0, SET, exptype, 0);

-               }
-       } else {
-               if (settype->class != SET) {
-                       /*
-                        * e.g string context [1,2] = 'abc'
-                        */
-                       error("Constant set involved in non set context");
-                       return (NIL);
-               }
-               exptype = settype->type;
+           }

        }
        }

-       if (x == NIL)
-               put2(O_PUSH, -width(settype));
-       n = 0;
-       for (el=r[2]; el; el=el[2]) {
-               n++;
+       csetp -> csettype = settype;
+       setran( exptype );
+       lower = set.lwrb;
+       upper = set.lwrb + set.uprbp;
+       pairp = NIL;
+       singp = NIL;
+       codeoff();
+       while ( el = r[2] ) {

                e = el[1];
                e = el[1];

-               if (e == NIL)
-                       return (NIL);
+               if (e == NIL) {
+                           /*
+                            *  don't hang this one anywhere.
+                            */
+                       csetp -> csettype = NIL;
+                       r[2] = el[2];
+                       continue;
+               }

                if (e[0] == T_RANG) {
                if (e[0] == T_RANG) {

-                       t = rvalue(e[2], NIL);
-                       if (t == NIL) {
-                               rvalue(e[1], NIL);
-                               continue;
+                       if ( csetp -> comptime && constval( e[2] ) ) {
+                           t = con.ctype;
+                           if ( ((long)con.crval) < lower || ((long)con.crval) > upper ) {
+                               if ( setofint ) {
+                                   csetp -> comptime = FALSE;
+                               } else {
+                                   error("Range upper bound of %d out of set bounds" , ((long)con.crval) );
+                                   csetp -> csettype = NIL;
+                               }
+                           }
+                           rangeupper = ((long)con.crval);
+                       } else {
+                           csetp -> comptime = FALSE;
+                           t = rvalue(e[2], NIL , RREQ );
+                           if (t == NIL) {
+                                   rvalue(e[1], NIL , RREQ );
+                                   goto pairhang;
+                           }

                        }
                        }

-                       if (incompat(t, exptype, e[2]))
+                       if (incompat(t, exptype, e[2])) {

                                cerror("Upper bound of element type clashed with set type in constant set");
                                cerror("Upper bound of element type clashed with set type in constant set");

-                       else
-                               convert(t, nl+T2INT);
-                       t = rvalue(e[1], NIL);
-                       if (t == NIL)
-                               continue;
-                       if (incompat(t, exptype, e[1]))
+                       }
+                       if ( csetp -> comptime && constval( e[1] ) ) {
+                           t = con.ctype;
+                           if ( ((long)con.crval) < lower || ((long)con.crval) > upper ) {
+                               if ( setofint ) {
+                                   csetp -> comptime = FALSE;
+                               } else {
+                                   error("Range lower bound of %d out of set bounds" , ((long)con.crval) );
+                                   csetp -> csettype = NIL;
+                               }
+                           }
+                       } else {
+                           csetp -> comptime = FALSE;
+                           t = rvalue(e[1], NIL , RREQ );
+                           if (t == NIL) {
+                                   goto pairhang;
+                           }
+                       }
+                       if (incompat(t, exptype, e[1])) {

                                cerror("Lower bound of element type clashed with set type in constant set");
                                cerror("Lower bound of element type clashed with set type in constant set");

-                       else
-                               convert(t, nl+T2INT);
+                       }
+pairhang:
+                           /*
+                            *  remove this range from the tree list and 
+                            *  hang it on the pairs list.
+                            */
+                       ip = el[2];
+                       el[2] = pairp;
+                       pairp = r[2];
+                       r[2] = ip;
+                       csetp -> paircnt++;

                } else {
                } else {

-                       t = rvalue((int *) e, NLNIL);
-                       if (t == NIL)
-                               continue;
-                       if (incompat(t, exptype, e))
+                       if ( csetp -> comptime && constval( e ) ) {
+                           t = con.ctype;
+                           if ( ((long)con.crval) < lower || ((long)con.crval) > upper ) {
+                               if ( setofint ) {
+                                   csetp -> comptime = FALSE;
+                               } else {
+                                   error("Value of %d out of set bounds" , ((long)con.crval) );
+                                   csetp -> csettype = NIL;
+                               }
+                           }
+                       } else {
+                           csetp -> comptime = FALSE;
+                           t = rvalue((int *) e, NLNIL , RREQ );
+                           if (t == NIL) {
+                                   goto singhang;
+                           }
+                       }
+                       if (incompat(t, exptype, e)) {

                                cerror("Element type clashed with set type in constant set");
                                cerror("Element type clashed with set type in constant set");

-                       else
-                               convert(t, nl+T2INT);
-                       put1(O_SDUP);
+                       }
+singhang:
+                           /*
+                            *  take this expression off the tree list and
+                            *  hang it on the list of singletons.
+                            */
+                       ip = el[2];
+                       el[2] = singp;
+                       singp = r[2];
+                       r[2] = ip;
+                       csetp -> singcnt++;
+               }
+       }
+       codeon();
+#      ifdef PC
+           if ( pairp != NIL ) {
+               for ( el = pairp ; el[2] != NIL ; el = el[2] ) /* void */;
+               el[2] = singp;
+               r[2] = pairp;
+           } else {
+               r[2] = singp;
+           }
+#      endif PC
+#      ifdef OBJ
+           if ( singp != NIL ) {
+               for ( el = singp ; el[2] != NIL ; el = el[2] ) /* void */;
+               el[2] = pairp;
+               r[2] = singp;
+           } else {
+               r[2] = pairp;
+           }
+#      endif OBJ
+       if ( csetp -> csettype == NIL ) {
+           csetp -> comptime = TRUE;
+       }
+       return csetp -> comptime;
+}
+
+#define        BITSPERLONG     ( sizeof( long ) * BITSPERBYTE )
+    /*
+     * mask[i] has the low i bits turned off.
+     */
+long   mask[] = {      
+                   0xffffffff , 0xfffffffe , 0xfffffffc , 0xfffffff8 ,
+                   0xfffffff0 , 0xffffffe0 , 0xffffffc0 , 0xffffff80 ,
+                   0xffffff00 , 0xfffffe00 , 0xfffffc00 , 0xfffff800 ,
+                   0xfffff000 , 0xffffe000 , 0xffffc000 , 0xffff8000 ,
+                   0xffff0000 , 0xfffe0000 , 0xfffc0000 , 0xfff80000 ,
+                   0xfff00000 , 0xffe00000 , 0xffc00000 , 0xff800000 ,
+                   0xff000000 , 0xfe000000 , 0xfc000000 , 0xf8000000 ,
+                   0xf0000000 , 0xe0000000 , 0xc0000000 , 0x80000000 ,
+                   0x00000000
+                };
+    /*
+     * given a csetstr, either
+     *     put out a compile time constant set and an lvalue to it.
+     * or
+     *     put out rvalues for the singletons and the pairs
+     *     and counts of each.
+     */
+postcset( r , csetp )
+    int                        *r;
+    struct csetstr     *csetp;
+    {
+       register int    *el;
+       register int    *e;
+       int             lower;
+       int             upper;
+       int             lowerdiv;
+       int             lowermod;
+       int             upperdiv;
+       int             uppermod;
+       int             label;
+       long            *lp;
+       long            *limit;
+       long            tempset[ ( MAXSET / BITSPERLONG ) + 1 ];
+       long            temp;
+       char            labelname[ BUFSIZ ];
+
+       if ( csetp -> comptime ) {
+           setran( ( csetp -> csettype ) -> type );
+           limit = &tempset[ ( set.uprbp / BITSPERLONG ) + 1 ];
+           for ( lp = &tempset[0] ; lp < limit ; lp++ ) {
+               *lp = 0;
+           }
+           for ( el = r[2] ; el != NIL ; el = el[2] ) {
+               e = el[1];
+               if ( e[0] == T_RANG ) {
+                   constval( e[1] );
+                   lower = (long) con.crval;
+                   constval( e[2] );
+                   upper = (long) con.crval;
+                   if ( upper < lower ) {
+                       continue;
+                   }
+                   lowerdiv = ( lower - set.lwrb ) / BITSPERLONG;
+                   lowermod = ( lower - set.lwrb ) % BITSPERLONG;
+                   upperdiv = ( upper - set.lwrb ) / BITSPERLONG;
+                   uppermod = ( upper - set.lwrb ) % BITSPERLONG;
+                   temp = mask[ lowermod ];
+                   if ( lowerdiv == upperdiv ) {
+                       temp &= ~mask[ uppermod + 1 ];
+                   }
+                   tempset[ lowerdiv ] |= temp;
+                   limit = &tempset[ upperdiv-1 ];
+                   for ( lp = &tempset[ lowerdiv+1 ] ; lp <= limit ; lp++ ) {
+                       *lp |= ~0;
+                   }
+                   if ( lowerdiv != upperdiv ) {
+                       tempset[ upperdiv ] |= ~mask[ uppermod + 1 ];
+                   }
+               } else {
+                   constval( e );
+                   lowerdiv = ( ((long)con.crval) - set.lwrb ) / BITSPERLONG;
+                   lowermod = ( ((long)con.crval) - set.lwrb ) % BITSPERLONG;
+                   tempset[ lowerdiv ] |= ( 1 << lowermod );
+               }
+           }
+           if ( cgenflg )
+               return;
+#          ifdef PC
+               putprintf( "    .data" , 0 );
+               putprintf( "    .align 2" , 0 );
+               label = getlab();
+               putlab( label );
+               lp = &( tempset[0] );
+               limit = &tempset[ ( set.uprbp / BITSPERLONG ) + 1 ];
+               while ( lp < limit ) {
+                   putprintf( "        .long   0x%x" , 1 , *lp ++ );
+                   for ( temp = 2 ; ( temp <= 8 ) && lp < limit ; temp ++ ) {
+                       putprintf( ",0x%x" , 1 , *lp++ );
+                   }
+                   putprintf( "" , 0 );
+               }
+               putprintf( "    .text" , 0 );
+               sprintf( labelname , PREFIXFORMAT , LABELPREFIX , label );
+               putleaf( P2ICON , 0 , 0 , P2PTR | P2STRTY , labelname );
+#          endif PC
+#          ifdef OBJ
+               put( 2, O_CON, (set.uprbp / BITSPERLONG + 1) *
+                                (BITSPERLONG / BITSPERBYTE));
+               lp = &( tempset[0] );
+               limit = &tempset[ ( set.uprbp / BITSPERLONG ) + 1 ];
+               while ( lp < limit ) {
+                   put( 2, O_CASE4, *lp ++);
+               }
+#          endif OBJ
+       } else {
+#          ifdef PC
+               putleaf( P2ICON , csetp -> paircnt , 0 , P2INT , 0 );
+               putop( P2LISTOP , P2INT );
+               putleaf( P2ICON , csetp -> singcnt , 0 , P2INT , 0 );
+               putop( P2LISTOP , P2INT );
+               for ( el = r[2] ; el != NIL ; el = el[2] ) {
+                   e = el[1];
+                   if ( e[0] == T_RANG ) {
+                       rvalue( e[2] , NIL , RREQ );
+                       putop( P2LISTOP , P2INT );
+                       rvalue( e[1] , NIL , RREQ );
+                       putop( P2LISTOP , P2INT );
+                   } else {
+                       rvalue( e , NIL , RREQ );
+                       putop( P2LISTOP , P2INT );
+                   }
+               }
+#          endif PC
+#          ifdef OBJ
+               for ( el = r[2] ; el != NIL ; el = el[2] ) {
+                   e = el[1];
+                   if ( e[0] == T_RANG ) {
+                       stkrval( e[2] , NIL , RREQ );
+                       stkrval( e[1] , NIL , RREQ );
+                   } else {
+                       stkrval( e , NIL , RREQ );
+                   }

                }
                }

+               put( 2 , O_CON24 , csetp -> singcnt );
+               put( 2 , O_CON24 , csetp -> paircnt );
+#          endif OBJ

        }
        }

-       if (x == NIL) {
-               setran(exptype);
-               put(4, O_CTTOT, n, set.lwrb, set.uprbp);
-       } else
-               put2(O_CON2, n);
-       return (settype);

 }
 }