From dc47746daf73c65126a80b723ad52b8327b06960 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Fri, 21 Oct 2005 12:21:24 +0000 Subject: [PATCH] 0.9.5.82: Commit band-aid fix for compiler float / ROUND-NUMERIC-BOUND problem, and document the real problem --- BUGS | 12 ++++++++++ src/code/late-type.lisp | 3 ++- tests/compiler.impure.lisp | 56 ++++++++++++++++++++++++++++++++++++++++++++ tests/compiler.pure.lisp | 5 ++++ version.lisp-expr | 2 +- 5 files changed, 76 insertions(+), 2 deletions(-) diff --git a/BUGS b/BUGS index 1c750b4..87c19e6 100644 --- a/BUGS +++ b/BUGS @@ -2122,3 +2122,15 @@ WORKAROUND: SB-PCL::SPECIALIZER-APPLICABLE-USING-TYPE-P cannot handle the second argument (UNSIGNED-BYTE 8). + +389: + (reported several times on sbcl-devel, by Rick Taube, Brian Rowe and + others) + + ROUND-NUMERIC-BOUND assumes that float types always have a FORMAT + specifying whether they're SINGLE or DOUBLE. This is true for types + computed by the type system itself, but the compiler type derivation + short-circuits this and constructs non-canonical types. A temporary + fix was made to ROUND-NUMERIC-BOUND for the sbcl-0.9.6 release, but + the right fix is to remove the abstraction violation in the + compiler's type deriver. diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index 08adf4d..abe32f2 100644 --- a/src/code/late-type.lisp +++ b/src/code/late-type.lisp @@ -2118,7 +2118,8 @@ used for a COMPLEX component.~:@>" nil)) (t (if (<= most-negative-single-float cx most-positive-single-float) - (coerce cx format) + ;; FIXME: bug #389 + (coerce cx (or format 'single-float)) nil))))) (if (consp x) (list res) res))))) nil)) diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp index dd6a23b..45d030b 100644 --- a/tests/compiler.impure.lisp +++ b/tests/compiler.impure.lisp @@ -1067,4 +1067,60 @@ (test f2 42 (1+ most-positive-fixnum)))) (assert (= e-count 4))))) +;;; bug #389 (Rick Taube sbcl-devel) +(defun bes-jn (unn ux) + (let ((nn unn) (x ux)) + (let* ((n (floor (abs nn))) + (besn + (if (= n 0) + (bes-j0 x) + (if (= n 1) + (bes-j1 x) + (if (zerop x) + 0.0 + (let ((iacc 40) + (ans 0.0) + (bigno 1.0e+10) + (bigni 1.0e-10)) + (if (> (abs x) n) + (do ((tox (/ 2.0 (abs x))) + (bjm (bes-j0 (abs x))) + (bj (bes-j1 (abs x))) + (j 1 (+ j 1)) + (bjp 0.0)) + ((= j n) (setf ans bj)) + (setf bjp (- (* j tox bj) bjm)) + (setf bjm bj) + (setf bj bjp)) + (let ((tox (/ 2.0 (abs x))) + (m + (* 2 + (floor + (/ (+ n (sqrt (* iacc n))) + 2)))) + (jsum 0.0) + (bjm 0.0) + (sum 0.0) + (bjp 0.0) + (bj 1.0)) + (do ((j m (- j 1))) + ((= j 0)) + (setf bjm (- (* j tox bj) bjp)) + (setf bjp bj) + (setf bj bjm) + (when (> (abs bj) bigno) + (setf bj (* bj bigni)) + (setf bjp (* bjp bigni)) + (setf ans (* ans bigni)) + (setf sum (* sum bigni))) + (if (not (= 0 jsum)) (incf sum bj)) + (setf jsum (- 1 jsum)) + (if (= j n) (setf ans bjp))) + (setf sum (- (* 2.0 sum) bj)) + (setf ans (/ ans sum)))) + (if (and (minusp x) (oddp n)) + (- ans) + ans))))))) + (if (and (minusp nn) (oddp nn)) (- besn) besn)))) + ;;; success diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index 38de3f6..c58eb9e 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -1883,3 +1883,8 @@ new))) (declare (ignore fun warnings failure)) (assert (not failure))) + +;;; bug #389: "0.0 can't be converted to type NIL." (Brian Rowe +;;; sbcl-devel) +(compile nil '(lambda (x y a b c) + (- y (* (signum x) (sqrt (abs (- (* b x) c))))))) diff --git a/version.lisp-expr b/version.lisp-expr index bd59d21..302dda0 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.9.5.81" +"0.9.5.82" -- 1.7.10.4