Coverage report: /home/ellis/comp/core/std/num/float.lisp

KindCoveredAll%
expression054 0.0
branch02 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; std/num/float.lisp --- Floating Point Numbers
2
 
3
 ;; IEEE 754 Floating Point encoding and decoding.
4
 
5
 ;;; Commentary:
6
 
7
 ;; This package provides default encoders for float32 and float64 as defined
8
 ;; by IEEE 754.
9
 
10
 ;; Note that the physical encoding is always represented as a fixnum.
11
 
12
 ;; To read/write from a file you must pass through a fixnum repr to bytes,
13
 ;; usually using octets-to-integer or integer-to-octets.
14
 
15
 ;;; Code:
16
 
17
 ;;; Functions for converting floating point numbers represented in
18
 ;;; IEEE 754 style to lisp numbers.
19
 ;;;
20
 ;;; See http://common-lisp.net/project/ieee-floats/
21
 
22
 (in-package :std/num)
23
 (declaim (optimize (speed 3)))
24
 
25
 ;; The following macro may look a bit overcomplicated to the casual
26
 ;; reader. The main culprit is the fact that NaN and infinity can be
27
 ;; optionally included, which adds a bunch of conditional parts.
28
 ;;
29
 ;; Assuming you already know more or less how floating point numbers
30
 ;; are typically represented, I'll try to elaborate a bit on the more
31
 ;; confusing parts, as marked by letters:
32
 ;;
33
 ;; (A) Exponents in IEEE floats are offset by half their range, for
34
 ;;     example with 8 exponent bits a number with exponent 2 has 129
35
 ;;     stored in its exponent field.
36
 ;;
37
 ;; (B) The maximum possible exponent is reserved for special cases
38
 ;;     (NaN, infinity).
39
 ;;
40
 ;; (C) If the exponent fits in the exponent-bits, we have to adjust
41
 ;;     the significand for the hidden bit. Because decode-float will
42
 ;;     return a significand between 0 and 1, and we want one between 1
43
 ;;     and 2 to be able to hide the hidden bit, we double it and then
44
 ;;     subtract one (the hidden bit) before converting it to integer
45
 ;;     representation (to adjust for this, 1 is subtracted from the
46
 ;;     exponent earlier). When the exponent is too small, we set it to
47
 ;;     zero (meaning no hidden bit, exponent of 1), and adjust the
48
 ;;     significand downward to compensate for this.
49
 ;;
50
 ;; (D) Here the hidden bit is added. When the exponent is 0, there is
51
 ;;     no hidden bit, and the exponent is interpreted as 1.
52
 ;;
53
 ;; (E) Here the exponent offset is subtracted, but also an extra
54
 ;;     factor to account for the fact that the bits stored in the
55
 ;;     significand are supposed to come after the 'decimal dot'.
56
 
57
 (defmacro make-float-converters (encoder-name
58
                                  decoder-name
59
                                  exponent-bits
60
                                  significand-bits
61
                                  support-nan-and-infinity-p)
62
   "Writes an encoder and decoder function for floating point
63
 numbers with the given amount of exponent and significand
64
 bits (plus an extra sign bit). If support-nan-and-infinity-p is
65
 true, the decoders will also understand these special cases. NaN
66
 is represented as :not-a-number, and the infinities as 
67
 :positive-infinity and :negative-infinity. Note that this means
68
 that the in- or output of these functions is not just floating
69
 point numbers anymore, but also keywords."
70
   (declare (boolean support-nan-and-infinity-p)
71
            (fixnum exponent-bits significand-bits))
72
   (let* ((total-bits (+ 1 exponent-bits significand-bits))
73
          (exponent-offset (1- (expt 2 (1- exponent-bits)))) ; (A)
74
          (sign-part `(ldb (byte 1 ,(1- total-bits)) bits))
75
          (exponent-part `(ldb (byte ,exponent-bits ,significand-bits) bits))
76
          (significand-part `(ldb (byte ,significand-bits 0) bits))
77
          (nan support-nan-and-infinity-p)
78
          (max-exponent (1- (expt 2 exponent-bits)))) ; (B)
79
     `(progn
80
        (defun ,encoder-name (float)
81
          ,(format nil "Encoding a float value with ~A exponent and ~A significand bits (plus an extra sign bit)."
82
                   exponent-bits significand-bits)
83
          ,@(unless nan `((declare (float float))))
84
          (multiple-value-bind (sign significand exponent)
85
              (cond ,@(when nan `(((eq float :not-a-number)
86
                                   (values 0 1 ,max-exponent))
87
                                  ((eq float :positive-infinity)
88
                                   (values 0 0 ,max-exponent))
89
                                  ((eq float :negative-infinity)
90
                                   (values 1 0 ,max-exponent))))
91
                    (t
92
                     (multiple-value-bind (significand exponent sign) (decode-float float)
93
                       (let ((exponent (if (= 0 significand)
94
                                           exponent
95
                                           (+ (1- exponent) ,exponent-offset)))
96
                             (sign (if (= sign 1.0) 0 1)))
97
                         (unless (< exponent ,(expt 2 exponent-bits))
98
                           (error "Floating point overflow when encoding ~A." float))
99
                         (if (<= exponent 0) ; (C)
100
                             (values sign (ash (round (* ,(expt 2 significand-bits) significand)) exponent) 0)
101
                             (values sign (round (* ,(expt 2 significand-bits) (1- (* significand 2)))) exponent))))))
102
            (let ((bits 0))
103
              (declare (type (unsigned-byte ,total-bits) bits))
104
              (setf ,sign-part sign
105
                    ,exponent-part exponent
106
                    ,significand-part significand)
107
              bits)))
108
 
109
        (defun ,decoder-name (bits)
110
          ,(format nil "Decode a float value with ~A exponent and ~A significand bits (plus an extra sign bit)."
111
                   exponent-bits significand-bits)
112
          (declare (type (unsigned-byte ,total-bits) bits))
113
          (let* ((sign ,sign-part)
114
                 (exponent ,exponent-part)
115
                 (significand ,significand-part))
116
            ,@(when nan `((when (= exponent ,max-exponent)
117
                            (return-from ,decoder-name 
118
                              (cond ((not (zerop significand)) :not-a-number)
119
                                    ((zerop sign) :positive-infinity)
120
                                    (t :negative-infinity))))))
121
            (if (zerop exponent)         ; (D)
122
                (setf exponent 1)
123
                (setf (ldb (byte 1 ,significand-bits) significand) 1))
124
            (let ((float-significand (float significand ,(if (> total-bits 32) 1.0d0 1.0f0))))
125
              (scale-float (if (zerop sign) float-significand (- float-significand))
126
                           (- exponent ,(+ exponent-offset significand-bits))))))))) ; (E)
127
 
128
 ;; And instances of the above for the common forms of floats.
129
 (declaim (inline encode-float32 decode-float32 encode-float64 decode-float64))
130
 (make-float-converters encode-float32 decode-float32 8 23 nil)
131
 (make-float-converters encode-float64 decode-float64 11 52 nil)
132
 
133
 ;;; Copyright (c) 2006 Marijn Haverbeke
134
 ;;;
135
 ;;; This software is provided 'as-is', without any express or implied
136
 ;;; warranty. In no event will the authors be held liable for any
137
 ;;; damages arising from the use of this software.
138
 ;;;
139
 ;;; Permission is granted to anyone to use this software for any
140
 ;;; purpose, including commercial applications, and to alter it and
141
 ;;; redistribute it freely, subject to the following restrictions:
142
 ;;;
143
 ;;; 1. The origin of this software must not be misrepresented; you must
144
 ;;;    not claim that you wrote the original software. If you use this
145
 ;;;    software in a product, an acknowledgment in the product
146
 ;;;    documentation would be appreciated but is not required.
147
 ;;;
148
 ;;; 2. Altered source versions must be plainly marked as such, and must
149
 ;;;    not be misrepresented as being the original software.
150
 ;;;
151
 ;;; 3. This notice may not be removed or altered from any source
152
 ;;;    distribution.