From: Alexey Dejneka Date: Sun, 3 Aug 2003 11:32:29 +0000 (+0000) Subject: 0.8.2.14: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=1c91b0bc7eb814af6a8c58a99a83a024716138e8;p=sbcl.git 0.8.2.14: * DERIVE-TYPE optimizer for AREF does not try to put a type assertion on its result; * fix type declaration for INTEGER-DECODE-FLOAT; * cross-compiler vertions of MAKE-{SINGLE,DOUBLE}-FLOAT now work with denormalized numbers; ... since this change causes bootstrapping problems under previous versions of SBCL, replace a reference to LEAST-POSITIVE-DOUBLE-FLOAT with a code, constructing this number. --- diff --git a/BUGS b/BUGS index 19ac95c..9e5139a 100644 --- a/BUGS +++ b/BUGS @@ -1058,6 +1058,9 @@ WORKAROUND: (list x y))) (funcall (eval #'foo) 1))) +269: + SCALE-FLOAT should accept any integer for its second argument. + DEFUNCT CATEGORIES OF BUGS IR1-#: These labels were used for bugs related to the old IR1 interpreter. diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 4311813..cbe768d 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1079,8 +1079,10 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "FDEFINITION-OBJECT" "FDOCUMENTATION" "FILENAME" "FIND-AND-INIT-OR-CHECK-LAYOUT" - "FLOAT-EXPONENT" "FLOAT-FORMAT-DIGITS" "FLOAT-FORMAT-NAME" - "FLOAT-FORMAT-MAX" "FLOATING-POINT-EXCEPTION" + "FLOAT-EXPONENT" + "FLOAT-FORMAT-DIGITS" "FLOAT-FORMAT-NAME" "FLOAT-FORMAT-MAX" + "FLOAT-INT-EXPONENT" + "FLOATING-POINT-EXCEPTION" "FORM" "FORMAT-CONTROL" "*FREE-INTERRUPT-CONTEXT-INDEX*" "FUNCALLABLE-INSTANCE-P" diff --git a/src/code/cross-float.lisp b/src/code/cross-float.lisp index e0b2eb0..f7b995e 100644 --- a/src/code/cross-float.lisp +++ b/src/code/cross-float.lisp @@ -214,13 +214,18 @@ ;; IEEE float special cases ((zerop bits) 0.0) ((= bits #x-80000000) -0.0) - (t (let ((sign (ecase (ldb (byte 1 31) bits) - (0 1.0) - (1 -1.0))) - (expt (- (ldb (byte 8 23) bits) 127)) - (mant (* (logior (ldb (byte 23 0) bits) - (ash 1 23)) - (expt 0.5 23)))) + (t (let* ((sign (ecase (ldb (byte 1 31) bits) + (0 1.0) + (1 -1.0))) + (iexpt (ldb (byte 8 23) bits)) + (expt (if (zerop iexpt) ; denormalized + -126 + (- iexpt 127))) + (mant (* (logior (ldb (byte 23 0) bits) + (if (zerop iexpt) + 0 + (ash 1 23))) + (expt 0.5 23)))) (* sign (kludge-opaque-expt 2.0 expt) mant))))) (defun make-double-float (hi lo) @@ -232,9 +237,14 @@ (sign (ecase (ldb (byte 1 63) bits) (0 1.0d0) (1 -1.0d0))) - (expt (- (ldb (byte 11 52) bits) 1023)) + (iexpt (ldb (byte 11 52) bits)) + (expt (if (zerop iexpt) ; denormalized + -1022 + (- iexpt 1023))) (mant (* (logior (ldb (byte 52 0) bits) - (ash 1 52)) + (if (zerop iexpt) + 0 + (ash 1 52))) (expt 0.5d0 52)))) (* sign (kludge-opaque-expt 2.0d0 expt) mant))))) diff --git a/src/code/float.lisp b/src/code/float.lisp index be7a92c..14c1a79 100644 --- a/src/code/float.lisp +++ b/src/code/float.lisp @@ -56,12 +56,12 @@ (defconstant least-negative-short-float least-negative-single-float) (defconstant least-positive-double-float (double-from-bits 0 0 1)) #!-long-float -(defconstant least-positive-long-float least-positive-double-float) +(defconstant least-positive-long-float (double-from-bits 0 0 1)) #!+(and long-float x86) (defconstant least-positive-long-float (long-from-bits 0 0 1)) (defconstant least-negative-double-float (double-from-bits 1 0 1)) #!-long-float -(defconstant least-negative-long-float least-negative-double-float) +(defconstant least-negative-long-float (double-from-bits 1 0 1)) #!+(and long-float x86) (defconstant least-negative-long-float (long-from-bits 1 0 1)) diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp index 8f43179..fa3e7aa 100644 --- a/src/compiler/array-tran.lisp +++ b/src/compiler/array-tran.lisp @@ -91,11 +91,6 @@ (defoptimizer (aref derive-type) ((array &rest indices) node) (assert-array-rank array (length indices)) - ;; If the node continuation has a single use then assert its type. - (let ((cont (node-cont node))) - (when (= (length (find-uses cont)) 1) - (assert-continuation-type cont (extract-upgraded-element-type array) - (lexenv-policy (node-lexenv node))))) (extract-upgraded-element-type array)) (defoptimizer (%aset derive-type) ((array &rest stuff)) diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index 3043940..8d6a0d7 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -342,7 +342,7 @@ (defknown decode-float (float) (values float float-exponent float) (movable foldable flushable explicit-check)) (defknown scale-float (float float-exponent) float - (movable foldable flushable explicit-check)) + (movable foldable unsafely-flushable explicit-check)) (defknown float-radix (float) float-radix (movable foldable flushable explicit-check)) (defknown float-sign (float &optional float) float @@ -350,7 +350,7 @@ (defknown (float-digits float-precision) (float) float-digits (movable foldable flushable explicit-check)) (defknown integer-decode-float (float) - (values integer float-exponent (member -1 1)) + (values integer float-int-exponent (member -1 1)) (movable foldable flushable explicit-check)) (defknown complex (real &optional real) number diff --git a/src/compiler/generic/vm-type.lisp b/src/compiler/generic/vm-type.lisp index f432393..7782457 100644 --- a/src/compiler/generic/vm-type.lisp +++ b/src/compiler/generic/vm-type.lisp @@ -43,6 +43,9 @@ #!-long-float `(integer 0 ,sb!vm:double-float-digits) #!+long-float `(integer 0 ,sb!vm:long-float-digits)) (sb!xc:deftype float-radix () '(integer 2 2)) +(sb!xc:deftype float-int-exponent () + #!-long-float 'double-float-int-exponent + #!+long-float 'long-float-int-exponent) ;;; a code for BOOLE (sb!xc:deftype boole-code () '(unsigned-byte 4)) diff --git a/src/compiler/knownfun.lisp b/src/compiler/knownfun.lisp index 8d96138..6be6b40 100644 --- a/src/compiler/knownfun.lisp +++ b/src/compiler/knownfun.lisp @@ -63,6 +63,9 @@ unsafely-flushable ;; may be moved with impunity. Has no side effects except possibly ;; consing, and is affected only by its arguments. + ;; + ;; Since it is not used now, its distribution in fndb.lisp is + ;; mere random; use with caution. movable ;; The function is a true predicate likely to be open-coded. Convert ;; any non-conditional uses into (IF T NIL). Not usually diff --git a/tests/float.pure.lisp b/tests/float.pure.lisp index d287b4a..c957c9f 100644 --- a/tests/float.pure.lisp +++ b/tests/float.pure.lisp @@ -52,3 +52,15 @@ (assert (typep (nth-value 1 (ignore-errors (funcall (fdefinition 'float-radix) "notfloat"))) 'type-error)) + +;;; Before 0.8.2.14 the cross compiler failed to work with +;;; denormalized numbers +(when (subtypep 'single-float 'short-float) + (assert (eql least-positive-single-float least-positive-short-float))) + +#+nil ; bug 269 +(let ((f (eval 'least-positive-double-float))) + (assert (eql (multiple-value-bind (signif expon sign) + (integer-decode-float f) + (scale-float (float signif f) expon)) + f))) diff --git a/version.lisp-expr b/version.lisp-expr index 99c8197..47e996b 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.2.13" +"0.8.2.14"