X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffloat.lisp;h=cc2b750968db13dd0c7d6612f5cc06c499c0a92a;hb=41ed816c7915806abca6b09ecd2136458f27adcc;hp=ee9dacdddfbe7b772bc6d14b2a0b3a8d1ed01099;hpb=106e6fe2df729b6027718f6f056721a95c047c17;p=sbcl.git diff --git a/src/code/float.lisp b/src/code/float.lisp index ee9dacd..cc2b750 100644 --- a/src/code/float.lisp +++ b/src/code/float.lisp @@ -34,7 +34,8 @@ (declare (type bit sign) (type (unsigned-byte 53) sig) (type (unsigned-byte 11) exp)) (make-double-float (dpb exp sb!vm:double-float-exponent-byte - (dpb (ash sig -32) sb!vm:double-float-significand-byte + (dpb (ash sig -32) + sb!vm:double-float-significand-byte (if (zerop sign) 0 -1))) (ldb (byte 32 0) sig))) #!+(and long-float x86) @@ -363,7 +364,7 @@ (t (values (logior sig sb!vm:single-float-hidden-bit) biased sign))))) -;;; Like INTEGER-DECODE-SINGLE-DENORM, only doubly so. +;;; like INTEGER-DECODE-SINGLE-DENORM, only doubly so (defun integer-decode-double-denorm (x) (declare (type double-float x)) (let* ((high-bits (double-float-high-bits (abs x))) @@ -395,7 +396,7 @@ (truly-the fixnum (- biased extra-bias)) sign))))) -;;; Like INTEGER-DECODE-SINGLE-FLOAT, only doubly so. +;;; like INTEGER-DECODE-SINGLE-FLOAT, only doubly so (defun integer-decode-double-float (x) (declare (double-float x)) (let* ((abs (abs x)) @@ -527,7 +528,7 @@ bits)) biased sign))))) -;;; Like DECODE-SINGLE-DENORM, only doubly so. +;;; like DECODE-SINGLE-DENORM, only doubly so (defun decode-double-denorm (x) (declare (double-float x)) (multiple-value-bind (sig exp sign) (integer-decode-double-denorm x) @@ -540,7 +541,7 @@ (truly-the fixnum (+ exp sb!vm:double-float-digits)) (float sign x)))) -;;; Like DECODE-SINGLE-FLOAT, only doubly so. +;;; like DECODE-SINGLE-FLOAT, only doubly so (defun decode-double-float (x) (declare (double-float x)) (let* ((abs (abs x))