X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ffloat-tran.lisp;h=68c1ccd745356a71de1dfec45cec7a47c9953798;hb=f7faed97898dd0e94a18b0d1fca03aaa0fe24ab0;hp=882cc7004e298e9f28709cabdb8bd0ee989a0f79;hpb=d9d7c988fc80bd12698ba7440979dea2d93d7a97;p=sbcl.git diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp index 882cc70..68c1ccd 100644 --- a/src/compiler/float-tran.lisp +++ b/src/compiler/float-tran.lisp @@ -102,10 +102,36 @@ ;;;; float accessors (defknown make-single-float ((signed-byte 32)) single-float - (movable foldable flushable)) + (movable flushable)) (defknown make-double-float ((signed-byte 32) (unsigned-byte 32)) double-float - (movable foldable flushable)) + (movable flushable)) + +#-sb-xc-host +(deftransform make-single-float ((bits) + ((signed-byte 32))) + "Conditional constant folding" + (unless (constant-lvar-p bits) + (give-up-ir1-transform)) + (let* ((bits (lvar-value bits)) + (float (make-single-float bits))) + (when (float-nan-p float) + (give-up-ir1-transform)) + float)) + +#-sb-xc-host +(deftransform make-double-float ((hi lo) + ((signed-byte 32) (unsigned-byte 32))) + "Conditional constant folding" + (unless (and (constant-lvar-p hi) + (constant-lvar-p lo)) + (give-up-ir1-transform)) + (let* ((hi (lvar-value hi)) + (lo (lvar-value lo)) + (float (make-double-float hi lo))) + (when (float-nan-p float) + (give-up-ir1-transform)) + float)) (defknown single-float-bits (single-float) (signed-byte 32) (movable foldable flushable)) @@ -305,8 +331,11 @@ ;; problem, but in the context of evaluated and compiled (+ ) ;; giving different result if we fail to check for this. (or (not (csubtypep x (specifier-type 'integer))) + #!+x86 (csubtypep x (specifier-type `(integer ,most-negative-exactly-single-float-fixnum - ,most-positive-exactly-single-float-fixnum))))) + ,most-positive-exactly-single-float-fixnum))) + #!-x86 + (csubtypep x (specifier-type 'fixnum)))) ;;; Do some stuff to recognize when the loser is doing mixed float and ;;; rational arithmetic, or different float types, and fix it up. If @@ -922,11 +951,9 @@ (int-hi (if hi (ceiling (type-bound-number hi)) '*)) - (f-lo (if lo - (bound-func #'float lo) + (f-lo (or (bound-func #'float lo) '*)) - (f-hi (if hi - (bound-func #'float hi) + (f-hi (or (bound-func #'float hi) '*))) (specifier-type `(or (rational ,int-lo ,int-hi) (single-float ,f-lo, f-hi))))) @@ -956,11 +983,9 @@ (int-hi (if hi (ceiling (type-bound-number hi)) '*)) - (f-lo (if lo - (bound-func #'float lo) + (f-lo (or (bound-func #'float lo) '*)) - (f-hi (if hi - (bound-func #'float hi) + (f-hi (or (bound-func #'float hi) '*))) (specifier-type `(or (rational ,int-lo ,int-hi) (single-float ,f-lo, f-hi)))))