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