cl-olefs

commit e5f0bdb5f38125c43b9af287d0a60608ba8d2cb7
parent a6cb3a29e41b31c21bf647e7474a8684c7dd55d2
Author: Stelian Ionescu <sionescu@cddr.org>
Date:   Wed, 20 Nov 2013 17:12:07 +0100

Implement DOUBLE-FLOAT-FROM-BITS using IEEE-FLOATS

Diffstat:
M
cl-olefs.asd
 | 
1
+
M
olefs.lisp
 | 
11
++++++++++-

2 files changed, 11 insertions(+), 1 deletion(-)
diff --git a/cl-olefs.asd b/cl-olefs.asd
@@ -32,6 +32,7 @@
   :author "Tomas Hlavaty <tom@logand.com>"
   :maintainer "Tomas Hlavaty <tom@logand.com>"
   :licence "MIT"
+  :depends-on (:ieee-floats)
   :serial t
   :components ((:file "package")
                (:file "cdef")
diff --git a/olefs.lisp b/olefs.lisp
@@ -22,6 +22,15 @@
 
 (in-package :olefs)
 
+(defun double-float-from-bits (high low)
+  (declare (optimize (speed 3) (debug 0))
+           (type (unsigned-byte 32) high low))
+  (let ((bignum 0))
+    (declare (type (unsigned-byte 64) bignum))
+    (setf (ldb (byte 32  0) bignum) low
+          (ldb (byte 32 32) bignum) high)
+    (ieee-floats:decode-float64 bignum)))
+
 (defmacro with-stream ((var stream) &body body)
   `(let ((,var ,stream))
      (unwind-protect (progn ,@body)
@@ -1510,7 +1519,7 @@
   (signed t :compute (not (zerop (logand 2 %dummy))))
   (value t :compute (let ((y (if signed
                                  (error "TODO") ;;(ash x -2)
-                                 (ccl::double-float-from-bits ;; TODO not ccl specific
+                                 (double-float-from-bits
                                   (logand #xfffffffc %dummy) 0))))
                       (if percent (/ y 100) y))))