1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
;; Tests of float functions
(defpackage :float-tests
(:use :cl :lisp-unit))
(in-package "FLOAT-TESTS")
(define-test decode-float
(assert-true (funcall (compile nil #'(lambda (x)
(declare (type (double-float (0d0)) x))
(decode-float x)))
1d0)))
(define-test log2.interp
(loop for k from -1074 to 1023 do
(let ((x (scale-float 1d0 k)))
(assert-equalp k (log x 2)))))
(define-test log10.interp
(loop for k from 0 to 22 do
(let ((x (float (expt 10 k) 1d0)))
(assert-equalp k (log x 10)))))
(compile 'clog2
#'(lambda (x)
(declare (type (double-float (0d0)) x))
(log x 2)))
(compile 'clog10
#'(lambda (x)
(declare (type (double-float (0d0)) x))
(log x 10)))
(define-test log2.compiled
(loop for k from -1074 to 1023 do
(let ((x (scale-float 1d0 k)))
(assert-equalp k (clog2 x)))))
(define-test log10.compiled
(loop for k from 0 to 22 do
(let ((x (float (expt 10 k) 1d0)))
(assert-equalp k (clog10 x)))))
(define-test integer-decode-float.double
;; Generate 100 random denormal values and compare what
;; integer-decode-float returns against what it should return.
(dotimes (k 100)
(let ((x (random least-positive-normalized-double-float)))
(multiple-value-bind (hi lo)
(kernel:double-float-bits x)
;; Verify that the exponent is 0, which it must be for a
;; denormal number.
(assert-equal 0
(ldb vm:double-float-exponent-byte hi)
x)
;; Print out the fraction bits, and the bits returned by
;; INTEGER-DECODE-FLOAT. We could do this differently, but
;; this has the nice side effect of making it easy to see what
;; is expected and what went wrong.
(let* ((expected (format nil "~b~32,'0b" hi lo))
(actual (format nil "~b" (integer-decode-float x)))
(tail (subseq actual (length expected))))
;; If everything is working correctly, the beginning of the
;; actual bits must exactly match the expected bits.
(assert-true (every #'char=
expected
actual)
x
expected
actual)
;; And finally, the trailing part of the actual bits must be
;; all zeroes, but this is a denormal number.
(assert-true (every #'(lambda (c)
(char= c #\0))
tail)
x
tail))))))
(define-test scale-float.double
;; As a side-effect of fixing INTEGER-DECODE-FLOAT, SCALE-FLOAT
;; should return the correct values now when scaling
;; denormals. Check a few denormal values.
(dotimes (k 100)
(let* ((x (random least-positive-normalized-double-float))
(scaled (scale-float x 54))
(mult (* x (scale-float 1d0 54))))
;; The result of SCALE-FLOAT and the multiplication should be
;; exactly equal because the multiplication by 2^54 is exactly
;; representable.
(assert-equal scaled
mult
x
scaled
mult)))
;; Add the test caused the investigation of SCALE-FLOAT
(let* ((x 1d-310)
(scaled (scale-float x 54))
(mult (* x (scale-float 1d0 54))))
(assert-equal scaled
mult
x
scaled
mult)))
(define-test decode-float.double
;; As a side-effect of fixing INTEGER-DECODE-FLOAT, DECODE-FLOAT
;; should return the correct values now. We just spot check one
;; value here.
(dotimes (k 100)
(let ((x (random least-positive-normalized-double-float)))
(multiple-value-bind (f e)
(decode-float x)
(assert-equal x
(scale-float f e)
f
e)))))
(define-test float-traps-masked
;; inf-inf signals invalid, which is masked so the result is NaN.
(assert-true
(ext:float-nan-p
(ext:with-float-traps-masked (:invalid)
(- ext:double-float-positive-infinity
ext:double-float-positive-infinity))))
;; Divide-by-zero is masked so dividing by zero returns infinity
(assert-true
(ext:float-infinity-p
(ext:with-float-traps-masked (:divide-by-zero)
(/ 100d0 0d0))))
;; Overflow is masked so 100 * most-positive-double returns infinity
(assert-true
(ext:float-infinity-p
(ext:with-float-traps-masked (:overflow)
(* 100 most-negative-double-float)))))
|
