smaller default dynamic-space size on GENCGC

[sbcl.git] / src / compiler / float-tran.lisp

diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp
index 882cc70..bd7e427 100644 (file)
--- 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))
@@ -922,11 +948,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 +980,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)))))