Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Float numbers input-output

109 views
Skip to first unread message

alexey...@gmail.com

unread,
Nov 12, 2006, 12:44:00 PM11/12/06
to
I needed to read/write binary float numbers recently and the stuff I
found on the net was either too complicated for me or subtly wrong (for
example, many examples get underflow wrong). Just in case some one
needs it here is the code with tests (using lisp-unit). Ugly and slow,
but (I hope) correct. Flame is welcome, especially regarding macrology
in tests file. I am still a beginner after couple of years using Lisp
for about 15 minutes a day.

;io-utils.lisp
(in-package :common-lisp-user)
(defpackage :io-utils
(:use :common-lisp )
(:export "IEEE-754-TO-FLOAT-64"
"IEEE-754-TO-FLOAT-32"
"FLOAT-32-TO-IEEE-754"
"FLOAT-64-TO-IEEE-754"
"READ-U4-BIGENDIAN"
"READ-U4-LITTLEENDIAN"
"READ-U2-BIGENDIAN"
"READ-FLOAT32-BIGENDIAN"
"READ-FLOAT32-LITTLEENDIAN"
))


; see http://babbage.cs.qc.edu/IEEE-754/

(in-package :io-utils)

(defun read-u2 (in)
(let ((u2 0))
(setf (ldb (byte 8 8) u2) (read-byte in))
(setf (ldb (byte 8 0) u2) (read-byte in))
u2))


(defun read-u4-littleendian (in)
(let ((u4 0))
(setf (ldb (byte 8 24) u4) (read-byte in))
(setf (ldb (byte 8 16) u4) (read-byte in))
(setf (ldb (byte 8 8) u4) (read-byte in))
(setf (ldb (byte 8 0) u4) (read-byte in))
u4))

(defun read-u4-bigendian (in)
(let ((u4 0))
(setf (ldb (byte 8 0) u4) (read-byte in))
(setf (ldb (byte 8 8) u4) (read-byte in))
(setf (ldb (byte 8 16) u4) (read-byte in))
(setf (ldb (byte 8 24) u4) (read-byte in))
u4))


(defmacro gen-ieee-encoding (name type exponent-bits mantissa-bits)
`(progn

(defun ,(intern (format nil "~A-TO-IEEE-754" name)) (float)
(multiple-value-bind (significand expon sgn)
(integer-decode-float float)
(let* ((slen (integer-length significand))
(delta (- slen ,(1+ mantissa-bits)))
(sgn-norm (ash significand delta))
(ex (- (+ ,(+ mantissa-bits (1- (expt 2 (1- exponent-bits))) )
expon)
delta))
(output (if (minusp sgn) (dpb 1 (byte 1 ,(+ mantissa-bits
exponent-bits)) 0)
0))
(final (if (not (plusp ex))
(dpb (ldb (byte ,mantissa-bits 0) (ash sgn-norm (1- ex)))
(byte ,mantissa-bits 0) output)
;; or else .
(dpb (ldb (byte ,mantissa-bits 0) sgn-norm) (byte
,mantissa-bits 0)
(dpb ex (byte ,exponent-bits ,mantissa-bits) output)))))
final)))


(defun ,(intern (format nil "IEEE-754-TO-~A" name)) (ieee)
(let* ((ex (ldb (byte ,exponent-bits ,mantissa-bits) ieee))
(sig (ldb (byte ,mantissa-bits 0) ieee))
(significand (if (zerop ex)
(ash sig 1)
(dpb 1 (byte 1 ,mantissa-bits) sig)))
(ssigned (if (logbitp ,(+ exponent-bits mantissa-bits) ieee)
(- significand)
significand))

(aval
(scale-float (coerce ssigned ,type)
(- ex
,(+ (1- (expt 2 (1- exponent-bits)))
(1- mantissa-bits)
1
) ))))
aval))
))


(gen-ieee-encoding float-32 'single-float 8 23)
(gen-ieee-encoding float-64 'double-float 11 52)


(defun read-float32-bigendian (in)
(ieee-754-to-float-32 (read-u4-bigendian in)))

(defun read-float32-littleendian (in)
(ieee-754-to-float-32 (read-u4-littleendian in)))


; second file -- tests
;tests.lisp
(in-package :common-lisp-user)

(defpackage :io-tests
(:use :common-lisp :io-utils :lisp-unit))

(in-package :io-tests )
(defmacro f32-to-hex (hex flt)
`(assert-equal ,hex (format nil "~X" (float-32-to-ieee-754 ,flt))))
(defmacro hex-to-f32 (hex flt)
`(assert-equal (ieee-754-to-float-32 (parse-integer ,hex :radix 16))
,flt))

(defmacro f64-to-hex (hex flt)
`(assert-equal ,hex (format nil "~X" (float-64-to-ieee-754 ,flt))))
(defmacro hex-to-f64 (hex flt)
`(assert-equal (ieee-754-to-float-64 (parse-integer ,hex :radix 16))
,flt))

(eval-when (:compile-toplevel :load-toplevel)
(defparameter *testf32* '("3F800000" 1.0
"BF800000" -1.0
"A4FB11E" 9.9999995e-33
"3FC00000" 1.5
"2C9" 1.0e-42
"749DC5AD" 9.999999e31
"43AC8000" 345.0
"47A39100" 83746.0
"47" 9.9492191e-44
"6CE3EE" 9.9999994e-39
"AE397" 9.9999881e-40
))
(defparameter *testf64*
'("37D5C72FB1552D83" 1.0d-39
"1A56E1FC2F8F359" 1.0d-300
"7E8" 1.0d-320
"7E37E43C8800759C" 1.0d300
"6979CE4AE6ED0F27" 1.23456789d+200
"4A551E3E787F1976" 1.23456789d+50
)
))

(defmacro to-float-32 ( )
`(define-test hex-to-f32-test
,@(loop for (hex flt) on *testf32* by #'cddr collect `(hex-to-f32
,hex ,flt))))

(defmacro from-float-32 ( )
`(define-test f32-to-hex-test
,@(loop for (hex flt) on *testf32* by #'cddr collect `(f32-to-hex
,hex ,flt))))

(defmacro to-float-64 ( )
`(define-test hex-to-f64-test
,@(loop for (hex flt) on *testf64* by #'cddr collect `(hex-to-f64
,hex ,flt))))

(defmacro from-float-64 ( )
`(define-test f64-to-hex-test
,@(loop for (hex flt) on *testf64* by #'cddr collect `(f64-to-hex
,hex ,flt))))


; see examples here http://babbage.cs.qc.edu/IEEE-754/


(to-float-32)
(from-float-32)

(to-float-64)
(from-float-64)

0 new messages