1 ;;;; This file contains the definitions of float-specific number
2 ;;;; support (other than irrational stuff, which is in irrat.) There is
3 ;;;; code in here that assumes there are only two float formats: IEEE
4 ;;;; single and double. (LONG-FLOAT support has been added, but bugs
5 ;;;; may still remain due to old code which assumes this dichotomy.)
7 ;;;; This software is part of the SBCL system. See the README file for
10 ;;;; This software is derived from the CMU CL system, which was
11 ;;;; written at Carnegie Mellon University and released into the
12 ;;;; public domain. The software is in the public domain and is
13 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
14 ;;;; files for more information.
16 (in-package "SB!KERNEL")
20 (eval-when (:compile-toplevel :load-toplevel :execute)
22 ;;; These functions let us create floats from bits with the
23 ;;; significand uniformly represented as an integer. This is less
24 ;;; efficient for double floats, but is more convenient when making
25 ;;; special values, etc.
26 (defun single-from-bits (sign exp sig)
27 (declare (type bit sign) (type (unsigned-byte 24) sig)
28 (type (unsigned-byte 8) exp))
30 (dpb exp sb!vm:single-float-exponent-byte
31 (dpb sig sb!vm:single-float-significand-byte
32 (if (zerop sign) 0 -1)))))
33 (defun double-from-bits (sign exp sig)
34 (declare (type bit sign) (type (unsigned-byte 53) sig)
35 (type (unsigned-byte 11) exp))
36 (make-double-float (dpb exp sb!vm:double-float-exponent-byte
38 sb!vm:double-float-significand-byte
39 (if (zerop sign) 0 -1)))
40 (ldb (byte 32 0) sig)))
41 #!+(and long-float x86)
42 (defun long-from-bits (sign exp sig)
43 (declare (type bit sign) (type (unsigned-byte 64) sig)
44 (type (unsigned-byte 15) exp))
45 (make-long-float (logior (ash sign 15) exp)
46 (ldb (byte 32 32) sig)
47 (ldb (byte 32 0) sig)))
53 (defconstant least-positive-single-float (single-from-bits 0 0 1))
54 (defconstant least-positive-short-float (single-from-bits 0 0 1))
55 (defconstant least-negative-single-float (single-from-bits 1 0 1))
56 (defconstant least-negative-short-float (single-from-bits 1 0 1))
57 (defconstant least-positive-double-float (double-from-bits 0 0 1))
59 (defconstant least-positive-long-float (double-from-bits 0 0 1))
60 #!+(and long-float x86)
61 (defconstant least-positive-long-float (long-from-bits 0 0 1))
62 (defconstant least-negative-double-float (double-from-bits 1 0 1))
64 (defconstant least-negative-long-float (double-from-bits 1 0 1))
65 #!+(and long-float x86)
66 (defconstant least-negative-long-float (long-from-bits 1 0 1))
68 (defconstant least-positive-normalized-single-float
69 (single-from-bits 0 sb!vm:single-float-normal-exponent-min 0))
70 (defconstant least-positive-normalized-short-float
71 least-positive-normalized-single-float)
72 (defconstant least-negative-normalized-single-float
73 (single-from-bits 1 sb!vm:single-float-normal-exponent-min 0))
74 (defconstant least-negative-normalized-short-float
75 least-negative-normalized-single-float)
76 (defconstant least-positive-normalized-double-float
77 (double-from-bits 0 sb!vm:double-float-normal-exponent-min 0))
79 (defconstant least-positive-normalized-long-float
80 least-positive-normalized-double-float)
81 #!+(and long-float x86)
82 (defconstant least-positive-normalized-long-float
83 (long-from-bits 0 sb!vm:long-float-normal-exponent-min
84 (ash sb!vm:long-float-hidden-bit 32)))
85 (defconstant least-negative-normalized-double-float
86 (double-from-bits 1 sb!vm:double-float-normal-exponent-min 0))
88 (defconstant least-negative-normalized-long-float
89 least-negative-normalized-double-float)
90 #!+(and long-float x86)
91 (defconstant least-negative-normalized-long-float
92 (long-from-bits 1 sb!vm:long-float-normal-exponent-min
93 (ash sb!vm:long-float-hidden-bit 32)))
95 (defconstant most-positive-single-float
96 (single-from-bits 0 sb!vm:single-float-normal-exponent-max
97 (ldb sb!vm:single-float-significand-byte -1)))
98 (defconstant most-positive-short-float most-positive-single-float)
99 (defconstant most-negative-single-float
100 (single-from-bits 1 sb!vm:single-float-normal-exponent-max
101 (ldb sb!vm:single-float-significand-byte -1)))
102 (defconstant most-negative-short-float most-negative-single-float)
103 (defconstant most-positive-double-float
104 (double-from-bits 0 sb!vm:double-float-normal-exponent-max
105 (ldb (byte sb!vm:double-float-digits 0) -1)))
107 (defconstant most-positive-long-float most-positive-double-float)
108 #!+(and long-float x86)
109 (defconstant most-positive-long-float
110 (long-from-bits 0 sb!vm:long-float-normal-exponent-max
111 (ldb (byte sb!vm:long-float-digits 0) -1)))
112 (defconstant most-negative-double-float
113 (double-from-bits 1 sb!vm:double-float-normal-exponent-max
114 (ldb (byte sb!vm:double-float-digits 0) -1)))
116 (defconstant most-negative-long-float most-negative-double-float)
117 #!+(and long-float x86)
118 (defconstant most-negative-long-float
119 (long-from-bits 1 sb!vm:long-float-normal-exponent-max
120 (ldb (byte sb!vm:long-float-digits 0) -1)))
122 ;;; We don't want to do these DEFCONSTANTs at cross-compilation time,
123 ;;; because the cross-compilation host might not support floating
124 ;;; point infinities. Putting them inside a LET removes
125 ;;; toplevel-formness, so that any EVAL-WHEN trickiness in the
126 ;;; DEFCONSTANT forms is suppressed.
128 ;;; Note that it might be worth performing a similar MAKE-LOAD-FORM
129 ;;; trick as with -0.0 (see the UNPORTABLE-FLOAT structure). CSR,
132 (defconstant single-float-positive-infinity
133 (single-from-bits 0 (1+ sb!vm:single-float-normal-exponent-max) 0))
134 (defconstant short-float-positive-infinity
135 (single-from-bits 0 (1+ sb!vm:single-float-normal-exponent-max) 0))
136 (defconstant single-float-negative-infinity
137 (single-from-bits 1 (1+ sb!vm:single-float-normal-exponent-max) 0))
138 (defconstant short-float-negative-infinity
139 (single-from-bits 1 (1+ sb!vm:single-float-normal-exponent-max) 0))
140 (defconstant double-float-positive-infinity
141 (double-from-bits 0 (1+ sb!vm:double-float-normal-exponent-max) 0))
143 (defconstant long-float-positive-infinity
144 (double-from-bits 0 (1+ sb!vm:double-float-normal-exponent-max) 0))
145 #!+(and long-float x86)
146 (defconstant long-float-positive-infinity
147 (long-from-bits 0 (1+ sb!vm:long-float-normal-exponent-max)
148 (ash sb!vm:long-float-hidden-bit 32)))
149 (defconstant double-float-negative-infinity
150 (double-from-bits 1 (1+ sb!vm:double-float-normal-exponent-max) 0))
152 (defconstant long-float-negative-infinity
153 (double-from-bits 1 (1+ sb!vm:double-float-normal-exponent-max) 0))
154 #!+(and long-float x86)
155 (defconstant long-float-negative-infinity
156 (long-from-bits 1 (1+ sb!vm:long-float-normal-exponent-max)
157 (ash sb!vm:long-float-hidden-bit 32)))
158 ) ; LET-to-suppress-possible-EVAL-WHENs
160 (defconstant single-float-epsilon
161 (single-from-bits 0 (- sb!vm:single-float-bias
162 (1- sb!vm:single-float-digits)) 1))
163 (defconstant short-float-epsilon single-float-epsilon)
164 (defconstant single-float-negative-epsilon
165 (single-from-bits 0 (- sb!vm:single-float-bias sb!vm:single-float-digits) 1))
166 (defconstant short-float-negative-epsilon single-float-negative-epsilon)
167 (defconstant double-float-epsilon
168 (double-from-bits 0 (- sb!vm:double-float-bias
169 (1- sb!vm:double-float-digits)) 1))
171 (defconstant long-float-epsilon double-float-epsilon)
172 #!+(and long-float x86)
173 (defconstant long-float-epsilon
174 (long-from-bits 0 (- sb!vm:long-float-bias (1- sb!vm:long-float-digits))
175 (+ 1 (ash sb!vm:long-float-hidden-bit 32))))
176 (defconstant double-float-negative-epsilon
177 (double-from-bits 0 (- sb!vm:double-float-bias sb!vm:double-float-digits) 1))
179 (defconstant long-float-negative-epsilon double-float-negative-epsilon)
180 #!+(and long-float x86)
181 (defconstant long-float-negative-epsilon
182 (long-from-bits 0 (- sb!vm:long-float-bias sb!vm:long-float-digits)
183 (+ 1 (ash sb!vm:long-float-hidden-bit 32))))