floating-point-bits

I came across the chapter in the LW UG about TYPED-AREF-VECTOR and 
friends. It reminded me of a project a long time ago where I wanted to 
stream real-time floating-point data over a TCP communication link to an 
analysis client. I came up with code to pack/unpack FP data. Maybe 
someone would find it useful.

;;; fp-bits.lisp

;;;;;;;;;;;;;;;;;;;;;;
(defun single-float-bits (fpn)
   (declare (type single-float fpn))
   ;; 1.5 == 0x3fc00000
   ;; signif  #x0c00000
   ;; expon -23
   (multiple-value-bind (signif expon sign)
       (integer-decode-float fpn)
     (let* ((sgn (if (minusp sign) 1 0))
            (exp (+ 127 expon 23)) ; 23 bits?
            (man (ldb (byte 23 0) signif)) ; 0x400000
            (bits exp))
       (setf bits (dpb sgn (byte 1 31) bits)
             bits (dpb exp (byte 8 23) bits)
             bits (dpb man (byte 23 0) bits))
       bits)))

(defun make-single-float (bits)
   (declare (type (unsigned-byte 32) bits))
   (let* ((sgn (ldb (byte 1 31) bits))
          (exp (ldb (byte 8 23) bits))
          (mant (ldb (byte 23 0) bits))
          (signif (logior mant #x800000)) ; (ash 1 23)
          (sign (if (= sgn 1) -1f0 1f0))
          (expon(- exp 150)))
     (float-sign sign (scale-float (float signif) expon))))

(defun double-float-bits (dfn)
   (declare (type double-float dfn))
   (multiple-value-bind (signif expon sign)
       (integer-decode-float #+()decode-float dfn)
     (let* ((sgn (if (minusp sign) 1 0))
            (exp (+ 1023 expon 51 )) ; ?
            (man (ldb (byte 52 0) signif))
            (bits exp))
       (setf bits (dpb sgn (byte 1 63) bits)
             bits (dpb exp (byte 11 52) bits)
             bits (dpb man (byte 52 0) bits))
       bits)))

(defun make-double-float (bits)
   (declare (type (unsigned-byte 32) bits))
   (let* ((sgn  (ldb (byte  1 63) bits))
          (exp  (ldb (byte 11 52) bits))
          (mant (ldb (byte 52 0) bits))
          (signif (logior mant (ash 1 52)))
          (sign (if (= sgn 1) -1d0 1d0))
          (expon(- exp 1023 51)))
     (float-sign sign (scale-float (float signif) expon))))

;;;;;;;;;;;;

_______________________________________________
Lisp Hug - the mailing list for LispWorks users
[email protected]
http://www.lispworks.com/support/lisp-hug.html