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 3dee038..669e181 100644 (file)
--- a/usr/src/usr.bin/pascal/src/rval.c
+++ b/usr/src/usr.bin/pascal/src/rval.c
@@ -1,8 +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.
+ */

 
 #ifndef lint
 
 #ifndef lint

-static char sccsid[] = "@(#)rval.c 2.3 %G%";
-#endif
+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"


@@ -588,6 +619,7 @@ cstrng:
                        codeoff();
                        contype = rvalue( r->expr_node.lhs, p1 , LREQ );
                        codeon();
                        codeoff();
                        contype = rvalue( r->expr_node.lhs, p1 , LREQ );
                        codeon();

+                       if ( contype == NLNIL ) {

                            return NLNIL;
                        }
                            /*
                            return NLNIL;
                        }
                            /*


@@ -644,6 +676,13 @@ cstrng:
                p = rvalue(r->expr_node.lhs, NLNIL , RREQ );
 #              ifdef PC
                    sconv(p2type(p), PCCT_INT);
                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
 #              endif PC
                p1 = rvalue(r->expr_node.rhs, NLNIL , RREQ );
 #              ifdef PC


@@ -663,8 +702,39 @@ cstrng:
                    return (gen(NIL, r->tag, width(p), width(p1)));
 #              endif OBJ
 #              ifdef PC
                    return (gen(NIL, r->tag, width(p), width(p1)));
 #              endif OBJ
 #              ifdef PC

+#              ifndef tahoe

                    putop( r->tag == T_DIV ? PCC_DIV : PCC_MOD , PCCT_INT );
                    return ( nl + T4INT );
                    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 );
+#              endif tahoe

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