From b634c0670fb17aaaedb0c2ae6b5445cd2bcd359b Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Mon, 18 Aug 2008 20:38:20 +0000
Subject: [PATCH] Don't want to skip modular arith stuff if the result is known
 to fit in a fixnum.  Consider the case where x and y are fixnums in

    (logand (* x y) 255)

The compiler knows the result must be 8 bits long, but we need to do
modular arithmetic because the (* x y) can be longer than 32 bits.

Thus, only skip the modular arithmetic stuff if both args are known to
be fixnums.
---
 compiler/srctran.lisp | 17 ++++++++++-------
 1 file changed, 10 insertions(+), 7 deletions(-)

diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp
index 205774d0c..43e6d65c1 100644
--- a/compiler/srctran.lisp
+++ b/compiler/srctran.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.165 2008/08/13 14:17:45 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.166 2008/08/18 20:38:20 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -3903,14 +3903,17 @@
                    (numberp high)
                    (>= low 0))
           (let ((width (integer-length high)))
-	    ;; If the result of LOGAND would fit in a fixnum, we don't
-	    ;; need to do anything.  This allows the any fixnum vops
-	    ;; to run.  However, if the result won't fit in a fixnum,
-	    ;; look to see if we can apply modular arithmetic.
+	    ;; If both arguments of LOGAND would fit in a fixnum, we
+	    ;; don't need to do anything.  This allows the any fixnum
+	    ;; vops to run.  However, if the result won't fit in a
+	    ;; fixnum, look to see if we can apply modular arithmetic.
 	    ;;
 	    ;; Is this right?
-            (when (and (< (integer-length most-positive-fixnum)
-			  width)
+            (when (and (not
+			(and (csubtypep (continuation-type x)
+					(specifier-type 'fixnum))
+			     (csubtypep (continuation-type y)
+					(specifier-type 'fixnum))))
 		       (some (lambda (x)
 			       (<= width x))
 			     *modular-funs-widths*))
-- 
GitLab