Re: file i/o of binary data

[Doug Cutting <cutting@parc.xerox.com>]

  Date:	Wed, 29 Jan 1992 11:31:15 -0800
  From:	serafini@nas.nasa.gov (David B. Serafini)

  I'd like to be able to do i/o (read and write) on a file containing
  binary (not text) data, specifically, integers and single and double
  precision floats.

We've written the following code which reads and writes IEEE
single-precision floating point numbers.  It is portable, provided
that your Common Lisp implementation uses this representation for the
type single-float.  It should be a simple matter to code something
similar for doubles.  Note that this may not work for all IEEE values
(e.g. denormalized, infinities, etc.).

Franz folks: is there some (non-portable) way to construct
floating-point numbers given the bytes that compose them?

#-ieee-floating-point
(warn "non-IEEE floating point.  SINGLE-FLOAT i/o may not work.")

(defun single-float-write (single-float stream)
;;; Write SINGLE-FLOAT on STREAM in IEEE single-precision float format
  (declare (type single-float single-float))
  (multiple-value-bind (signif expon sign)
      (integer-decode-float
       ;; in Lucid all floats are IEEE double-precision
       #+lucid (lcl:round-to-single-precision single-float)
       #-lucid single-float)

    (declare (type (unsigned-byte 24) signif)
	     (type (signed-byte 8) expon)
	     (type (signed-byte 1) sign))

    (when (< signif (expt 2 23))
      (setq expon (- (+ 127 23))))

    (byte16-write
     (logior (the (unsigned-byte 16) (ash (if (minusp sign) 1 0) 15))
	     (the (unsigned-byte 15) (ash (the byte8 (+ expon 127 23)) 7))
	     (ldb (byte 7 16) signif))
     stream)
    (byte16-write (ldb (byte 16 0) signif) stream)))

(defun single-float-read (stream)
;;; read an IEEE single-precision float from STREAM
  (let* ((hi-16 (byte16-read stream))
	 (sign (ldb (byte 1 15) hi-16))
	 (exponent (ldb (byte 8 7) hi-16))
	 (lo-16 (byte16-read stream))
	 (signif (logior (if (= exponent 0) 0 (ash 1 23))
			 (the (unsigned-byte 23)
			      (ash (ldb (byte 7 0) hi-16) 16))
			 lo-16))
	 (float (if (zerop exponent)
		    (if (zerop signif)
			0.0
			(scale-float (float signif) (- exponent 126 23)))
		    (scale-float (float signif) (- exponent 127 23)))))
    (declare (type (unsigned-byte 16) hi-16 lo-16)
	     (type (unsigned-byte 24) signif)
	     (type (signed-byte 8) exponent)
	     (type (unsigned-byte 1) sign)
	     (type single-float float))
    (if (zerop sign) float (- float))))

(defun byte16-write (byte16 stream)
;;; Writes a BYTE16 on STREAM for reading by BYTE16-READ
  (declare (type (unsigned-byte 16) byte16)
	   (optimize (speed 3) (safety 0)))
  (write-byte (ldb (byte 8 8) byte16) stream)
  (write-byte (ldb (byte 8 0) byte16) stream))

(defun byte16-read (stream)
;;; reads & returns a byte16 from STREAM as written by BYTE16-WRITE
  (declare (optimize (speed 3) (safety 0)))
  (the (unsigned-byte 16)
       (logior (the (unsigned-byte 16) (ash (read-byte stream) 8))
	       (read-byte stream))))