diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp index 187d17b139509eab90ad79ecb693837a6c296a35..5fbc2e03b79247dde76990d2fb9e5736d3d7b524 100644 --- a/src/compiler/float-tran.lisp +++ b/src/compiler/float-tran.lisp @@ -2014,6 +2014,89 @@ (specifier-type `(complex ,(or (numeric-type-format arg) 'float)))) #'cis)) +;;; Derive the result types of DECODE-FLOAT + +(defun decode-float-frac-derive-type-aux (arg) + ;; The fraction part of DECODE-FLOAT is always a subset of the + ;; interval [0.5, 1), even for subnormals. While possible to derive + ;; a tighter bound in some cases, we don't. Just return that + ;; interval of the approriate type when possible. If not, just use + ;; float. + (if (numeric-type-format arg) + (specifier-type `(,(numeric-type-format arg) + ,(coerce 1/2 (numeric-type-format arg)) + (,(coerce 1 (numeric-type-format arg))))) + (specifier-type '(float 0.5 (1.0))))) + +(defun decode-float-exp-derive-type-aux (arg) + ;; Derive the exponent part of the float. It's always an integer + ;; type. + (flet ((calc-exp (x) + (when x + (nth-value 1 (decode-float x)))) + (min-exp () + ;; Use decode-float on 0 of the appropriate type to find + ;; the min exponent. If we don't know the actual number + ;; format, use double, which has the widest range + ;; (including double-double-float). + (if (numeric-type-format arg) + (nth-value 1 (decode-float (coerce 0 (numeric-type-format arg)))) + (nth-value 1 (decode-float (coerce 0 'double-float))))) + (max-exp () + ;; Use decode-float on the most postive number of the + ;; appropriate type to find the max exponent. If we don't + ;; know the actual number format, use double, which has the + ;; widest range (including double-double-float). + (if (eq (numeric-type-format arg) 'single-float) + (nth-value 1 (decode-float most-positive-single-float)) + (nth-value 1 (decode-float most-positive-double-float))))) + (let* ((lo (or (bound-func #'calc-exp + (numeric-type-low arg)) + (min-exp))) + (hi (or (bound-func #'calc-exp + (numeric-type-high arg)) + (max-exp)))) + (specifier-type `(integer ,(or lo '*) ,(or hi '*)))))) + +(defun decode-float-sign-derive-type-aux (arg) + ;; Derive the sign of the float. + (flet ((calc-sign (x) + (when x + (nth-value 2 (decode-float x))))) + (let* ((lo (bound-func #'calc-sign + (numeric-type-low arg))) + (hi (bound-func #'calc-sign + (numeric-type-high arg)))) + (if (numeric-type-format arg) + (specifier-type `(,(numeric-type-format arg) + ;; If lo or high bounds are NIL, use -1 + ;; or 1 of the appropriate type instead. + ,(or lo (coerce -1 (numeric-type-format arg))) + ,(or hi (coerce 1 (numeric-type-format arg))))) + (specifier-type '(or (member 1f0 -1f0 + 1d0 -1d0 + #+double-double 1w0 + #+double-double -1w0))))))) + +(defoptimizer (decode-float derive-type) ((num)) + (let ((f (one-arg-derive-type num + #'(lambda (arg) + (decode-float-frac-derive-type-aux arg)) + #'(lambda (arg) + (nth-value 0 (decode-float arg))))) + (e (one-arg-derive-type num + #'(lambda (arg) + (decode-float-exp-derive-type-aux arg)) + #'(lambda (arg) + (nth-value 1 (decode-float arg))))) + (s (one-arg-derive-type num + #'(lambda (arg) + (decode-float-sign-derive-type-aux arg)) + #'(lambda (arg) + (nth-value 2 (decode-float arg)))))) + (make-values-type :required (list f + e + s)))) ;;; Support for double-double floats ;;; diff --git a/src/general-info/release-20f.txt b/src/general-info/release-20f.txt index 4077097b82eddbd44d5b53c52a8b70675bf54e53..dd1cf1b0a0cef41d1bb2a509d336e56adf067618 100644 --- a/src/general-info/release-20f.txt +++ b/src/general-info/release-20f.txt @@ -28,6 +28,7 @@ New in this release: lowercase letters when needed. * Micro-optimize KERNEL:DOUBLE-FLOAT-BITS for x86/sse2. * Add micro-optimization for unary FTRUNCATE for x86/sse2. + * Compiler can derive the types of the results of DECODE-FLOAT. * ANSI compliance fixes: