From ea208fc259bf0558f56bfecba4c9c807f32e41f8 Mon Sep 17 00:00:00 2001
From: gerd <gerd>
Date: Thu, 11 Sep 2003 11:39:07 +0000
Subject: [PATCH] 	(compile nil '(lambda (x) (declare (bit x)) (+ x
 #xf0000000))) 	 => internal compiler error

	Reported by Paul Dietz.

	* src/compiler/x86/insts.lisp (valid-displacement-p): New function.
	* src/compiler/x86/arith.lisp (fast-+-c/unsigned=>unsigned): Use it.
---
 compiler/x86/arith.lisp | 10 ++++++----
 compiler/x86/insts.lisp |  5 ++++-
 2 files changed, 10 insertions(+), 5 deletions(-)

diff --git a/compiler/x86/arith.lisp b/compiler/x86/arith.lisp
index e5eceebba..04a3ffd0b 100644
--- a/compiler/x86/arith.lisp
+++ b/compiler/x86/arith.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/arith.lisp,v 1.15 2003/08/03 11:27:45 gerd Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/arith.lisp,v 1.16 2003/09/11 11:39:07 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -321,14 +321,16 @@
   (:result-types unsigned-num)
   (:note "inline (unsigned-byte 32) arithmetic")
   (:generator 4
-    (cond ((and (sc-is x unsigned-reg) (sc-is r unsigned-reg)
-		(not (location= x r)))
+    (cond ((and (sc-is x unsigned-reg)
+		(sc-is r unsigned-reg)
+		(not (location= x r))
+		(valid-displacement-p y))
 	   (inst lea r (make-ea :dword :base x :disp y)))
 	  (t
 	   (move r x)
 	   (if (= y 1)
 	       (inst inc r)
-	     (inst add r y))))))
+	       (inst add r y))))))
 
 
 ;;;; Special logand cases: (logand signed unsigned) => unsigned
diff --git a/compiler/x86/insts.lisp b/compiler/x86/insts.lisp
index 2fd617034..dda179ee8 100644
--- a/compiler/x86/insts.lisp
+++ b/compiler/x86/insts.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/insts.lisp,v 1.30 2003/04/26 12:53:24 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/insts.lisp,v 1.31 2003/09/11 11:39:07 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -89,6 +89,9 @@
   (scale 1 :type (member 1 2 4 8))
   (disp 0 :type (or (signed-byte 32) fixup)))
 
+(defun valid-displacement-p (x)
+  (typep x '(or (signed-byte 32) fixup)))
+
 (defun %print-ea (ea stream depth)
   (declare (ignore depth))
   (cond ((or *print-escape* *print-readably*)
-- 
GitLab