1 ;;; Functions for converting floating point numbers represented in
2 ;;; IEEE 754 style to lisp numbers.
4 ;;; See http://common-lisp.net/project/ieee-floats/
6 (defpackage :cl-postgres-ieee-floats
8 (:export
:make-float-converters
14 (in-package :cl-postgres-ieee-floats
)
16 ;; The following macro may look a bit overcomplicated to the casual
17 ;; reader. The main culprit is the fact that NaN and infinity can be
18 ;; optionally included, which adds a bunch of conditional parts.
20 ;; Assuming you already know more or less how floating point numbers
21 ;; are typically represented, I'll try to elaborate a bit on the more
22 ;; confusing parts, as marked by letters:
24 ;; (A) Exponents in IEEE floats are offset by half their range, for
25 ;; example with 8 exponent bits a number with exponent 2 has 129
26 ;; stored in its exponent field.
28 ;; (B) The maximum possible exponent is reserved for special cases
31 ;; (C) If the exponent fits in the exponent-bits, we have to adjust
32 ;; the significand for the hidden bit. Because decode-float will
33 ;; return a significand between 0 and 1, and we want one between 1
34 ;; and 2 to be able to hide the hidden bit, we double it and then
35 ;; subtract one (the hidden bit) before converting it to integer
36 ;; representation (to adjust for this, 1 is subtracted from the
37 ;; exponent earlier). When the exponent is too small, we set it to
38 ;; zero (meaning no hidden bit, exponent of 1), and adjust the
39 ;; significand downward to compensate for this.
41 ;; (D) Here the hidden bit is added. When the exponent is 0, there is
42 ;; no hidden bit, and the exponent is interpreted as 1.
44 ;; (E) Here the exponent offset is subtracted, but also an extra
45 ;; factor to account for the fact that the bits stored in the
46 ;; significand are supposed to come after the 'decimal dot'.
48 (defmacro make-float-converters
(encoder-name
52 support-nan-and-infinity-p
)
53 "Writes an encoder and decoder function for floating point
54 numbers with the given amount of exponent and significand
55 bits (plus an extra sign bit). If support-nan-and-infinity-p is
56 true, the decoders will also understand these special cases. NaN
57 is represented as :not-a-number, and the infinities as
58 :positive-infinity and :negative-infinity. Note that this means
59 that the in- or output of these functions is not just floating
60 point numbers anymore, but also keywords."
61 (let* ((total-bits (+ 1 exponent-bits significand-bits
))
62 (exponent-offset (1- (expt 2 (1- exponent-bits
)))) ; (A)
63 (sign-part `(ldb (byte 1 ,(1- total-bits
)) bits
))
64 (exponent-part `(ldb (byte ,exponent-bits
,significand-bits
) bits
))
65 (significand-part `(ldb (byte ,significand-bits
0) bits
))
66 (nan support-nan-and-infinity-p
)
67 (max-exponent (1- (expt 2 exponent-bits
)))) ; (B)
69 (defun ,encoder-name
(float)
70 ,@(unless nan
`((declare (type float float
))))
71 (multiple-value-bind (sign significand exponent
)
72 (cond ,@(when nan
`(((eq float
:not-a-number
)
73 (values 0 1 ,max-exponent
))
74 ((eq float
:positive-infinity
)
75 (values 0 0 ,max-exponent
))
76 ((eq float
:negative-infinity
)
77 (values 1 0 ,max-exponent
))))
81 (multiple-value-bind (significand exponent sign
) (decode-float float
)
82 (let ((exponent (+ (1- exponent
) ,exponent-offset
))
83 (sign (if (= sign
1.0) 0 1)))
84 (unless (< exponent
,(expt 2 exponent-bits
))
85 (error "Floating point overflow when encoding ~A." float
))
86 (if (< exponent
0) ; (C)
87 (values sign
(ash (round (* ,(expt 2 significand-bits
) significand
)) exponent
) 0)
88 (values sign
(round (* ,(expt 2 significand-bits
) (1- (* significand
2)))) exponent
))))))
90 (declare (type (unsigned-byte ,total-bits
) bits
))
92 ,exponent-part exponent
93 ,significand-part significand
)
96 (defun ,decoder-name
(bits)
97 (declare (type (unsigned-byte ,total-bits
) bits
))
98 (let* ((sign ,sign-part
)
99 (exponent ,exponent-part
)
100 (significand ,significand-part
))
101 ,@(when nan
`((when (= exponent
,max-exponent
)
102 (return-from ,decoder-name
103 (cond ((not (zerop significand
)) :not-a-number
)
104 ((zerop sign
) :positive-infinity
)
105 (t :negative-infinity
))))))
106 (if (zerop exponent
) ; (D)
108 (setf (ldb (byte 1 ,significand-bits
) significand
) 1))
110 (setf significand
(- significand
)))
111 (scale-float (float significand
,(if (> total-bits
32) 1.0d0
1.0))
112 (- exponent
,(+ exponent-offset significand-bits
)))))))) ; (E)
114 ;; And instances of the above for the common forms of floats.
115 (make-float-converters encode-float32 decode-float32
8 23 nil
)
116 (make-float-converters encode-float64 decode-float64
11 52 nil
)
118 ;;; Copyright (c) 2006 Marijn Haverbeke
120 ;;; This software is provided 'as-is', without any express or implied
121 ;;; warranty. In no event will the authors be held liable for any
122 ;;; damages arising from the use of this software.
124 ;;; Permission is granted to anyone to use this software for any
125 ;;; purpose, including commercial applications, and to alter it and
126 ;;; redistribute it freely, subject to the following restrictions:
128 ;;; 1. The origin of this software must not be misrepresented; you must
129 ;;; not claim that you wrote the original software. If you use this
130 ;;; software in a product, an acknowledgment in the product
131 ;;; documentation would be appreciated but is not required.
133 ;;; 2. Altered source versions must be plainly marked as such, and must
134 ;;; not be misrepresented as being the original software.
136 ;;; 3. This notice may not be removed or altered from any source