From c097c9c3d4ce2888c9f32477c95397c69e4f80aa Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Wed, 23 Feb 2005 08:31:18 +0000 Subject: [PATCH] 0.8.19.38: * Fix MISC.535: CONSTANT-LVAR-P looks through CASTs. * Workaround lack of recursion recognition in XC for PRINCIPAL-LVAR-USE. --- NEWS | 2 ++ OPTIMIZATIONS | 4 ++-- src/compiler/constraint.lisp | 2 +- src/compiler/ir1util.lisp | 11 +++++++---- tests/compiler.pure.lisp | 12 ++++++++++++ version.lisp-expr | 2 +- 6 files changed, 25 insertions(+), 8 deletions(-) diff --git a/NEWS b/NEWS index e745572..69c0616 100644 --- a/NEWS +++ b/NEWS @@ -62,6 +62,8 @@ changes in sbcl-0.8.20 (0.9alpha.0?) relative to sbcl-0.8.19: with one-dimensional arrays with fill pointers. ** TYPE-OF failed on a complex with an integer realpart and a RATIO imagpart. + ** compiler failure during type inference for the code of form + (IF (EQL X (THE ...)) ...) (MISC.535). changes in sbcl-0.8.19 relative to sbcl-0.8.18: * new port: SBCL now works in native 64-bit mode on x86-64/Linux diff --git a/OPTIMIZATIONS b/OPTIMIZATIONS index 53438ab..f17f2ee 100644 --- a/OPTIMIZATIONS +++ b/OPTIMIZATIONS @@ -187,9 +187,9 @@ stack-allocation of structures is impossible. -------------------------------------------------------------------------------- #21 (defun-with-dx foo () - (let ((dx (list (list 1 2) (list 3 4) + (let ((dx (list (list 1 2) (list 3 4)))) (declare (dynamic-extent dx)) - ...))))) + ...)) External list in DX is allocated on stack, but internal are not. -------------------------------------------------------------------------------- diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp index 5e61da0..ebe39ca 100644 --- a/src/compiler/constraint.lisp +++ b/src/compiler/constraint.lisp @@ -193,7 +193,7 @@ ((constant-lvar-p arg2) (add-complement-constraints if 'eql var1 (ref-leaf - (lvar-uses arg2)) + (principal-lvar-use arg2)) nil))))) ((< >) (let* ((arg1 (first args)) diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp index b62fb36..0efb8ae 100644 --- a/src/compiler/ir1util.lisp +++ b/src/compiler/ir1util.lisp @@ -63,10 +63,13 @@ (list uses)))) (defun principal-lvar-use (lvar) - (let ((use (lvar-uses lvar))) - (if (cast-p use) - (principal-lvar-use (cast-value use)) - use))) + (labels ((plu (lvar) + (declare (type lvar lvar)) + (let ((use (lvar-uses lvar))) + (if (cast-p use) + (plu (cast-value use)) + use)))) + (plu lvar))) ;;; Update lvar use information so that NODE is no longer a use of its ;;; LVAR. diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index 3381087..f4bc19c 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -1716,3 +1716,15 @@ (let ((b (make-array 64 :element-type 'bit :initial-element 0))) (setf (sbit b 63) 1) b))))) + +;;; MISC.535: compiler failure +(let ((c0 #c(4196.088977268509d0 -15943.3603515625d0))) + (assert (not (funcall + (compile + nil + `(lambda (p1 p2) + (declare (optimize speed (safety 1)) + (type (eql ,c0) p1) + (type number p2)) + (eql (the (complex double-float) p1) p2))) + c0 #c(12 612/979))))) diff --git a/version.lisp-expr b/version.lisp-expr index c9fe506..9effc16 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.19.37" +"0.8.19.38" -- 1.7.10.4