cl-olefs

OLE File System tools for Common Lisp
git clone https://logand.com/git/cl-olefs.git/
Log | Files | Refs

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:
Mcl-olefs.asd | 1+
Molefs.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))))