From 80d37651bc4cba800bbf2ba38ea720d734fbae4a Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Fri, 3 Oct 2003 10:20:31 +0000 Subject: [PATCH] 0.8.4.4: Fix bignum/bignum ASH bug (PFD sbcl-devel 2003-09-22) ... one-liner fix, yum yum Add SIGNUM derive-type optimizer ... not strictly necessary any more as we now ignore errors when deriving types, but since I wrote it, why not? --- NEWS | 4 ++++ src/code/bignum.lisp | 2 +- src/compiler/srctran.lisp | 48 ++++++++++++++++++++++++++++++++++++++++++----- tests/arith.pure.lisp | 4 ++++ version.lisp-expr | 2 +- 5 files changed, 53 insertions(+), 7 deletions(-) diff --git a/NEWS b/NEWS index 729dd09cd..9ab2e1f69 100644 --- a/NEWS +++ b/NEWS @@ -2117,12 +2117,16 @@ changes in sbcl-0.8.5 relative to sbcl-0.8.4: * fix bug 214: algorithm for noting rejected templates is now more similar to that of template seletion. (also reported by rydis on #lisp) + * compiler enhancement: SIGNUM is now better able to derive the type + of its result. * fixed some bugs revealed by Paul Dietz' test suite: ** incorrect optimization of TRUNCATE for a positive first argument and negative second. ** compiler failure in let-convertion during flushing dead code. ** compiler failure while deriving type of TRUNCATE on an interval, containing 0. + ** ASH of a negative bignum by a negative bignum count now returns + -1, not 0. planned incompatible changes in 0.8.x: * (not done yet, but planned:) When the profiling interface settles diff --git a/src/code/bignum.lisp b/src/code/bignum.lisp index 03f23377a..c0606e65f 100644 --- a/src/code/bignum.lisp +++ b/src/code/bignum.lisp @@ -749,7 +749,7 @@ (%normalize-bignum res res-len)) res))))) ((> count bignum-len) - 0) + (if (%bignum-0-or-plusp bignum bignum-len) 0 -1)) ;; Since a FIXNUM should be big enough to address anything in ;; memory, including arrays of bits, and since arrays of bits ;; take up about the same space as corresponding fixnums, there diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index e43395ad3..fe7f950a8 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -1022,10 +1022,9 @@ (if member-fun (with-float-traps-masked (:underflow :overflow :divide-by-zero) - (make-member-type - :members (list - (funcall member-fun - (first (member-type-members x)))))) + (specifier-type + `(eql ,(funcall member-fun + (first (member-type-members x)))))) ;; Otherwise convert to a numeric type. (let ((result-type-list (funcall derive-fun (convert-member-type x)))) @@ -1075,7 +1074,7 @@ :format (type-of result) :complexp :real)) (t - (make-member-type :members (list result)))))) + (specifier-type `(eql ,result)))))) ((and (member-type-p x) (numeric-type-p y)) (let* ((x (convert-member-type x)) (y (if convert-type (convert-numeric-type y) y)) @@ -2301,6 +2300,45 @@ (defoptimizer (values derive-type) ((&rest values)) (make-values-type :required (mapcar #'lvar-type values))) + +(defun signum-derive-type-aux (type) + (if (eq (numeric-type-complexp type) :complex) + (let* ((format (case (numeric-type-class type) + ((integer rational) 'single-float) + (t (numeric-type-format type)))) + (bound-format (or format 'float))) + (make-numeric-type :class 'float + :format format + :complexp :complex + :low (coerce -1 bound-format) + :high (coerce 1 bound-format))) + (let* ((interval (numeric-type->interval type)) + (range-info (interval-range-info interval)) + (contains-0-p (interval-contains-p 0 interval)) + (class (numeric-type-class type)) + (format (numeric-type-format type)) + (one (coerce 1 (or format class 'real))) + (zero (coerce 0 (or format class 'real))) + (minus-one (coerce -1 (or format class 'real))) + (plus (make-numeric-type :class class :format format + :low one :high one)) + (minus (make-numeric-type :class class :format format + :low minus-one :high minus-one)) + ;; KLUDGE: here we have a fairly horrible hack to deal + ;; with the schizophrenia in the type derivation engine. + ;; The problem is that the type derivers reinterpret + ;; numeric types as being exact; so (DOUBLE-FLOAT 0d0 + ;; 0d0) within the derivation mechanism doesn't include + ;; -0d0. Ugh. So force it in here, instead. + (zero (make-numeric-type :class class :format format + :low (- zero) :high zero))) + (case range-info + (+ (if contains-0-p (type-union plus zero) plus)) + (- (if contains-0-p (type-union minus zero) minus)) + (t (type-union minus zero plus)))))) + +(defoptimizer (signum derive-type) ((num)) + (one-arg-derive-type num #'signum-derive-type-aux nil)) ;;;; byte operations ;;;; diff --git a/tests/arith.pure.lisp b/tests/arith.pure.lisp index 6e13aeaf7..959e2c100 100644 --- a/tests/arith.pure.lisp +++ b/tests/arith.pure.lisp @@ -199,3 +199,7 @@ ((89 125 16) (ASH A (MIN 18 -706))) (T (DPB -3 (BYTE 30 30) -1))))))) (assert (= (funcall fn 1227072 -529823 -18 -792831) -2147483649))) + +;;; ASH of a negative bignum by a bignum count would erroneously +;;; return 0 prior to sbcl-0.8.4.4 +(assert (= (ash (1- most-negative-fixnum) (1- most-negative-fixnum)) -1)) diff --git a/version.lisp-expr b/version.lisp-expr index 6c8ea3c71..c029261d5 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.4.3" +"0.8.4.4" -- 2.11.4.GIT