You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('') and can be up to 35 characters long.
138 lines
6.2 KiB
138 lines
6.2 KiB
;;; Functions for converting floating point numbers represented in


;;; IEEE 754 style to lisp numbers.


;;;


;;; See http://commonlisp.net/project/ieeefloats/


(inpackage :commonlisp)




(defpackage :ieeefloats


(:use :commonlisp)


(:export :makefloatconverters


:encodefloat32


:decodefloat32


:encodefloat64


:decodefloat64))




(inpackage :ieeefloats)




;; The following macro may look a bit overcomplicated to the casual


;; reader. The main culprit is the fact that NaN and infinity can be


;; optionally included, which adds a bunch of conditional parts.


;;


;; Assuming you already know more or less how floating point numbers


;; are typically represented, I'll try to elaborate a bit on the more


;; confusing parts, as marked by letters:


;;


;; (A) Exponents in IEEE floats are offset by half their range, for


;; example with 8 exponent bits a number with exponent 2 has 129


;; stored in its exponent field.


;;


;; (B) The maximum possible exponent is reserved for special cases


;; (NaN, infinity).


;;


;; (C) If the exponent fits in the exponentbits, we have to adjust


;; the significand for the hidden bit. Because decodefloat will


;; return a significand between 0 and 1, and we want one between 1


;; and 2 to be able to hide the hidden bit, we double it and then


;; subtract one (the hidden bit) before converting it to integer


;; representation (to adjust for this, 1 is subtracted from the


;; exponent earlier). When the exponent is too small, we set it to


;; zero (meaning no hidden bit, exponent of 1), and adjust the


;; significand downward to compensate for this.


;;


;; (D) Here the hidden bit is added. When the exponent is 0, there is


;; no hidden bit, and the exponent is interpreted as 1.


;;


;; (E) Here the exponent offset is subtracted, but also an extra


;; factor to account for the fact that the bits stored in the


;; significand are supposed to come after the 'decimal dot'.




(defmacro makefloatconverters (encodername


decodername


exponentbits


significandbits


supportnanandinfinityp)


"Writes an encoder and decoder function for floating point


numbers with the given amount of exponent and significand


bits (plus an extra sign bit). If supportnanandinfinityp is


true, the decoders will also understand these special cases. NaN


is represented as :notanumber, and the infinities as


:positiveinfinity and :negativeinfinity. Note that this means


that the in or output of these functions is not just floating


point numbers anymore, but also keywords."


(let* ((totalbits (+ 1 exponentbits significandbits))


(exponentoffset (1 (expt 2 (1 exponentbits)))) ; (A)


(signpart `(ldb (byte 1 ,(1 totalbits)) bits))


(exponentpart `(ldb (byte ,exponentbits ,significandbits) bits))


(significandpart `(ldb (byte ,significandbits 0) bits))


(nan supportnanandinfinityp)


(maxexponent (1 (expt 2 exponentbits)))) ; (B)


`(progn


(defun ,encodername (float)


,@(unless nan `((declare (type float float))))


(multiplevaluebind (sign significand exponent)


(cond ,@(when nan `(((eq float :notanumber)


(values 0 1 ,maxexponent))


((eq float :positiveinfinity)


(values 0 0 ,maxexponent))


((eq float :negativeinfinity)


(values 1 0 ,maxexponent))))


((zerop float)


(values 0 0 0))


(t


(multiplevaluebind (significand exponent sign) (decodefloat float)


(let ((exponent (+ (1 exponent) ,exponentoffset))


(sign (if (= sign 1.0) 0 1)))


(unless (< exponent ,(expt 2 exponentbits))


(error "Floating point overflow when encoding ~A." float))


(if (< exponent 0) ; (C)


(values sign (ash (round (* ,(expt 2 significandbits) significand)) exponent) 0)


(values sign (round (* ,(expt 2 significandbits) (1 (* significand 2)))) exponent))))))


(let ((bits 0))


(declare (type (unsignedbyte ,totalbits) bits))


(setf ,signpart sign


,exponentpart exponent


,significandpart significand)


bits)))




(defun ,decodername (bits)


(declare (type (unsignedbyte ,totalbits) bits))


(let* ((sign ,signpart)


(exponent ,exponentpart)


(significand ,significandpart))


,@(when nan `((when (= exponent ,maxexponent)


(returnfrom ,decodername


(cond ((not (zerop significand)) :notanumber)


((zerop sign) :positiveinfinity)


(t :negativeinfinity))))))


(if (zerop exponent) ; (D)


(setf exponent 1)


(setf (ldb (byte 1 ,significandbits) significand) 1))


(unless (zerop sign)


(setf significand ( significand)))


(scalefloat (float significand ,(if (> totalbits 32) 1.0d0 1.0))


( exponent ,(+ exponentoffset significandbits)))))))) ; (E)




;; And instances of the above for the common forms of floats.


(makefloatconverters encodefloat32 decodefloat32 8 23 nil)


(makefloatconverters encodefloat64 decodefloat64 11 52 nil)




;;; Copyright (c) 2006 Marijn Haverbeke


;;;


;;; This software is provided 'asis', without any express or implied


;;; warranty. In no event will the authors be held liable for any


;;; damages arising from the use of this software.


;;;


;;; Permission is granted to anyone to use this software for any


;;; purpose, including commercial applications, and to alter it and


;;; redistribute it freely, subject to the following restrictions:


;;;


;;; 1. The origin of this software must not be misrepresented; you must


;;; not claim that you wrote the original software. If you use this


;;; software in a product, an acknowledgment in the product


;;; documentation would be appreciated but is not required.


;;;


;;; 2. Altered source versions must be plainly marked as such, and must


;;; not be misrepresented as being the original software.


;;;


;;; 3. This notice may not be removed or altered from any source


;;; distribution.


