1.0.17.6: fix bug introduced by 1.0.7.3

[sbcl.git] / src / code / early-extensions.lisp

diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp
index 9337589..a77d82e 100644 (file)
--- a/src/code/early-extensions.lisp
+++ b/src/code/early-extensions.lisp
@@ -1254,8 +1254,8 @@ to :INTERPRET, an interpreter will be used.")
 ;;; so take care with this one...
 (defmacro dx-let (bindings &body forms)
   `(locally
-       #-sb-xc-host
-       (declare (optimize sb!c::stack-allocate-dynamic-extent))
+       (declare (optimize #-sb-xc-host sb!c::stack-allocate-dynamic-extent
+                          #-sb-xc-host sb!c::stack-allocate-value-cells))
      (let ,bindings
        (declare (dynamic-extent ,@(mapcar (lambda (bind)
                                             (if (consp bind)
@@ -1264,3 +1264,28 @@ to :INTERPRET, an interpreter will be used.")
                                           bindings)))
        ,@forms)))
 
+(in-package "SB!KERNEL")
+
+(defun fp-zero-p (x)
+  (typecase x
+    (single-float (zerop x))
+    (double-float (zerop x))
+    #!+long-float
+    (long-float (zerop x))
+    (t nil)))
+
+(defun neg-fp-zero (x)
+  (etypecase x
+    (single-float
+     (if (eql x 0.0f0)
+         (make-unportable-float :single-float-negative-zero)
+         0.0f0))
+    (double-float
+     (if (eql x 0.0d0)
+         (make-unportable-float :double-float-negative-zero)
+         0.0d0))
+    #!+long-float
+    (long-float
+     (if (eql x 0.0l0)
+         (make-unportable-float :long-float-negative-zero)
+         0.0l0))))