BSD 4 release

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

diff --git a/usr/src/cmd/pi/conv.c b/usr/src/cmd/pi/conv.c
index 4bfca60..165ee80 100644 (file)
--- a/usr/src/cmd/pi/conv.c
+++ b/usr/src/cmd/pi/conv.c
@@ -1,16 +1,14 @@
 /* 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[] = "@(#)conv.c 1.1 8/27/80";
+
+#include "whoami.h"

 #ifdef PI
 #include "0.h"
 #include "opcode.h"
 #ifdef PI
 #include "0.h"
 #include "opcode.h"

+#ifdef PC
+#   include    "pcops.h"
+#endif PC

 
 #ifndef PI0
 /*
 
 #ifndef PI0
 /*


@@ -80,9 +78,9 @@ compat(p1, p2, t)
                        if (c2 == TDOUBLE)
                                return (1);
 #ifndef PI0
                        if (c2 == TDOUBLE)
                                return (1);
 #ifndef PI0

-                       if (c2 == TINT && divflg == 0) {
+                       if (c2 == TINT && divflg == 0 && t != NIL ) {

                                divchk= 1;
                                divchk= 1;

-                               c1 = classify(rvalue(t, NLNIL));
+                               c1 = classify(rvalue(t, NLNIL , RREQ ));

                                divchk = NIL;
                                if (c1 == TINT) {
                                        error("Type clash: real is incompatible with integer");
                                divchk = NIL;
                                if (c1 == TINT) {
                                        error("Type clash: real is incompatible with integer");


@@ -158,59 +156,154 @@ rangechk(p, q)
                return;
        if (q == NIL)
                return;
                return;
        if (q == NIL)
                return;

-       /*
-        * When op is 1 we are checking length
-        * 4 numbers against length 2 bounds,
-        * and adding it to the opcode forces
-        * generation of appropriate tests.
-        */
-       op = 0;
-       wq = width(q);
-       wrp = width(rp);
-       op = wq != wrp && (wq == 4 || wrp == 4);
-       if (rp->class == TYPE)
-               rp = rp->type;
-       switch (rp->class) {
-       case RANGE:
-               if (rp->range[0] != 0) {
-#                  ifndef DEBUG
-                       if (wrp <= 2)
-                               put3(O_RANG2+op, ( short ) rp->range[0],
-                                                ( short ) rp->range[1]);
-                       else if (rp != nl+T4INT)
-                               put(5, O_RANG4+op, rp->range[0], rp->range[1] );
-#                  else
-                       if (!hp21mx) {
-                               if (wrp <= 2)
-                                       put3(O_RANG2+op,( short ) rp->range[0],
-                                                       ( short ) rp->range[1]);
-                               else if (rp != nl+T4INT)
-                                       put(5,O_RANG4+op,rp->range[0],
-                                                        rp->range[1]);
-                       } else
-                               if (rp != nl+T2INT && rp != nl+T4INT)
-                                       put3(O_RANG2+op,( short ) rp->range[0],
-                                                       ( short ) rp->range[1]);
-#                  endif
+#      ifdef OBJ
+           /*
+            * When op is 1 we are checking length
+            * 4 numbers against length 2 bounds,
+            * and adding it to the opcode forces
+            * generation of appropriate tests.
+            */
+           op = 0;
+           wq = width(q);
+           wrp = width(rp);
+           op = wq != wrp && (wq == 4 || wrp == 4);
+           if (rp->class == TYPE)
+                   rp = rp->type;
+           switch (rp->class) {
+           case RANGE:
+                   if (rp->range[0] != 0) {
+#                  ifndef DEBUG
+                           if (wrp <= 2)
+                                   put(3, O_RANG2+op, ( short ) rp->range[0],
+                                                    ( short ) rp->range[1]);
+                           else if (rp != nl+T4INT)
+                                   put(3, O_RANG4+op, rp->range[0], rp->range[1] );
+#                  else
+                           if (!hp21mx) {
+                                   if (wrp <= 2)
+                                           put(3, O_RANG2+op,( short ) rp->range[0],
+                                                           ( short ) rp->range[1]);
+                                   else if (rp != nl+T4INT)
+                                           put(3, O_RANG4+op,rp->range[0],
+                                                            rp->range[1]);
+                           } else
+                                   if (rp != nl+T2INT && rp != nl+T4INT)
+                                           put(3, O_RANG2+op,( short ) rp->range[0],
+                                                           ( short ) rp->range[1]);
+#                  endif
+                       break;
+                   }
+                   /*
+                    * Range whose lower bounds are
+                    * zero can be treated as scalars.
+                    */
+           case SCAL:
+                   if (wrp <= 2)
+                           put(2, O_RSNG2+op, ( short ) rp->range[1]);
+                   else
+                           put( 2 , O_RSNG4+op, rp->range[1]);

                    break;
                    break;

-               }
+           default:
+                   panic("rangechk");
+           }
+#      endif OBJ
+#      ifdef PC

                /*
                /*

-                * Range whose lower bounds are
-                * zero can be treated as scalars.
+                * what i want to do is make this and some other stuff
+                * arguments to a function call, which will do the rangecheck,
+                * and return the value of the current expression, or abort
+                * if the rangecheck fails.
+                * probably i need one rangecheck routine to return each c-type
+                * of value.
+                * also, i haven't figured out what the `other stuff' is.

                 */
                 */

-       case SCAL:
-               if (wrp <= 2)
-                       put2(O_RSNG2+op, ( short ) rp->range[1]);
-               else
-                       put( 3 , O_RSNG4+op, rp->range[1]);
-               break;
-       default:
-               panic("rangechk");
-       }
+           putprintf( "#       call rangecheck" , 0 );
+#      endif PC

 }
 #endif
 #endif
 
 }
 #endif
 #endif
 

+#ifdef PC
+    /*
+     * if type p requires a range check,
+     *     then put out the name of the checking function
+     * for the beginning of a function call which is completed by postcheck.
+     *  (name1 is for a full check; name2 assumes a lower bound of zero)
+     */
+precheck( p , name1 , name2 )
+    struct nl  *p;
+    char       *name1 , *name2;
+    {
+
+       if ( opt( 't' ) == 0 ) {
+           return;
+       }
+       if ( p == NIL ) {
+           return;
+       }
+       if ( p -> class == TYPE ) {
+           p = p -> type;
+       }
+       switch ( p -> class ) {
+           case RANGE:
+               if ( p != nl + T4INT ) {
+                   putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
+                           , p -> range[0] != 0 ? name1 : name2 );
+               }
+               break;
+           case SCAL:
+                   /*
+                    *  how could a scalar ever be out of range?
+                    */
+               break;
+           default:
+               panic( "precheck" );
+               break;
+       }
+    }
+
+    /*
+     * if type p requires a range check,
+     *     then put out the rest of the arguments of to the checking function
+     * a call to which was started by precheck.
+     * the first argument is what is being rangechecked (put out by rvalue),
+     * the second argument is the lower bound of the range,
+     * the third argument is the upper bound of the range.
+     */
+postcheck( p )
+    struct nl  *p;
+    {
+
+       if ( opt( 't' ) == 0 ) {
+           return;
+       }
+       if ( p == NIL ) {
+           return;
+       }
+       if ( p -> class == TYPE ) {
+           p = p -> type;
+       }
+       switch ( p -> class ) {
+           case RANGE:
+               if ( p != nl + T4INT ) {
+                   if (p -> range[0] != 0 ) {
+                       putleaf( P2ICON , p -> range[0] , 0 , P2INT , 0 );
+                       putop( P2LISTOP , P2INT );
+                   }
+                   putleaf( P2ICON , p -> range[1] , 0 , P2INT , 0 );
+                   putop( P2LISTOP , P2INT );
+                   putop( P2CALL , P2INT );
+               }
+               break;
+           case SCAL:
+               break;
+           default:
+               panic( "postcheck" );
+               break;
+       }
+    }
+#endif PC
+

 #ifdef DEBUG
 conv(dub)
        int *dub;
 #ifdef DEBUG
 conv(dub)
        int *dub;