Raymond Toy pushed to branch master at cmucl / cmucl
Commits:
-
9fee7762
by Raymond Toy at 2024-03-08T15:52:35+00:00
-
8faafb32
by Raymond Toy at 2024-03-08T15:52:37+00:00
3 changed files:
Changes:
| ... | ... | @@ -1137,7 +1137,8 @@ |
| 1137 | 1137 | (floatit (ash bits -1))
|
| 1138 | 1138 | #+nil
|
| 1139 | 1139 | (progn
|
| 1140 | - (format t "1: f0, f1 = ~A ~A~%" f0 f1)
|
|
| 1140 | + (format t "x = ~A~%" x)
|
|
| 1141 | + (format t "1: f0, f1 = ~A~%" f0)
|
|
| 1141 | 1142 | (format t " scale = ~A~%" (1+ scale)))
|
| 1142 | 1143 |
|
| 1143 | 1144 | (scale-float f0 (1+ scale))))
|
| ... | ... | @@ -1146,14 +1147,30 @@ |
| 1146 | 1147 | (floatit bits)
|
| 1147 | 1148 | #+nil
|
| 1148 | 1149 | (progn
|
| 1149 | - (format t "2: f0, f1 = ~A ~A~%" f0 f1)
|
|
| 1150 | + (format t "2: f0, f1 = ~A~%" f0)
|
|
| 1150 | 1151 | (format t " scale = ~A~%" scale)
|
| 1151 | - (format t "scale-float f0 = ~A~%" (scale-float f0 scale))
|
|
| 1152 | - (when f1
|
|
| 1153 | - (format t "scale-float f1 = ~A~%"
|
|
| 1154 | - (scale-float f1 (- scale 53)))))
|
|
| 1155 | -
|
|
| 1156 | - (scale-float f0 scale))))))
|
|
| 1152 | + (format t "scale-float f0 = ~A~%" (scale-float f0 scale)))
|
|
| 1153 | + (let ((min-exponent
|
|
| 1154 | + ;; Compute the min (unbiased) exponent
|
|
| 1155 | + (ecase format
|
|
| 1156 | + (single-float
|
|
| 1157 | + (- vm:single-float-normal-exponent-min
|
|
| 1158 | + vm:single-float-bias
|
|
| 1159 | + vm:single-float-digits))
|
|
| 1160 | + (double-float
|
|
| 1161 | + (- vm:double-float-normal-exponent-min
|
|
| 1162 | + vm:double-float-bias
|
|
| 1163 | + vm:double-float-digits)))))
|
|
| 1164 | + ;; F0 is always between 0.5 and 1. If
|
|
| 1165 | + ;; SCALE is the min exponent, we have a
|
|
| 1166 | + ;; denormal number just less than the
|
|
| 1167 | + ;; least-positive float. We want to
|
|
| 1168 | + ;; return the least-positive-float so
|
|
| 1169 | + ;; multiply F0 by 2 (without adjusting
|
|
| 1170 | + ;; SCALE) to get the nearest float.
|
|
| 1171 | + (if (= scale min-exponent)
|
|
| 1172 | + (scale-float (* 2 f0) scale)
|
|
| 1173 | + (scale-float f0 scale))))))))
|
|
| 1157 | 1174 | (floatit (bits)
|
| 1158 | 1175 | (let ((sign (if plusp 0 1)))
|
| 1159 | 1176 | (case format
|
| ... | ... | @@ -44,6 +44,8 @@ public domain. |
| 44 | 44 | * ~~#266~~ Support "~user" in namestrings
|
| 45 | 45 | * ~~#271~~ Update ASDF to 3.3.7
|
| 46 | 46 | * ~~#272~~ Move scavenge code for static vectors to its own function
|
| 47 | + * ~~#277~~ `float-ratio-float` returns least postive float for
|
|
| 48 | + ratios closer to that than zero.
|
|
| 47 | 49 | * Other changes:
|
| 48 | 50 | * Improvements to the PCL implementation of CLOS:
|
| 49 | 51 | * Changes to building procedure:
|
| ... | ... | @@ -136,5 +136,49 @@ |
| 136 | 136 | (ext:with-float-traps-masked (:overflow)
|
| 137 | 137 | (* 100 most-negative-double-float)))))
|
| 138 | 138 | |
| 139 | -
|
|
| 140 | - |
|
| \ No newline at end of file | ||
| 139 | +(define-test float-ratio.single
|
|
| 140 | + (:tag :issues)
|
|
| 141 | + ;; least-positive-single-float is 1.4012985e-45. Let's test with
|
|
| 142 | + ;; some rationals from 7/10*10^-45 to 1.41*10^-45 to make sure they
|
|
| 143 | + ;; return 0 or least-positive-single-float
|
|
| 144 | + (let ((expo (expt 10 -45)))
|
|
| 145 | + ;; Need to make sure underflows are masked.
|
|
| 146 | + (kernel::with-float-traps-masked (:underflow)
|
|
| 147 | + ;; 7/10*10^-45 is just under halfway between 0 and least-positive,
|
|
| 148 | + ;; so the answer is 0.
|
|
| 149 | + (assert-equal 0f0 (kernel::float-ratio-float (* 7/10 expo) 'single-float))
|
|
| 150 | + |
|
| 151 | + ;; These are all more than half way to
|
|
| 152 | + ;; least-positive-single-float, so they should return that.
|
|
| 153 | + (assert-equal least-positive-single-float
|
|
| 154 | + (kernel::float-ratio-float (* 8/10 expo) 'single-float))
|
|
| 155 | + (assert-equal least-positive-single-float
|
|
| 156 | + (kernel::float-ratio-float (* 1 expo) 'single-float))
|
|
| 157 | + (assert-equal least-positive-single-float
|
|
| 158 | + (kernel::float-ratio-float (* 14/10 expo) 'single-float))
|
|
| 159 | + (assert-equal least-positive-single-float
|
|
| 160 | + (kernel::float-ratio-float (* 2 expo) 'single-float)))))
|
|
| 161 | + |
|
| 162 | +(define-test float-ratio.double
|
|
| 163 | + (:tag :issues)
|
|
| 164 | + ;; least-positive-double-float is 4.9406564584124654d-324. Let's
|
|
| 165 | + ;; test with some rationals from about 2*10^-324 to 4.94*10^-324 to make
|
|
| 166 | + ;; sure they return 0 or least-positive-double-float
|
|
| 167 | + (let ((expo (expt 10 -324)))
|
|
| 168 | + ;; Need to make sure underflows are masked.
|
|
| 169 | + (kernel::with-float-traps-masked (:underflow)
|
|
| 170 | + ;; 247/100*10^-324 is just under halfway between 0 and least-positive,
|
|
| 171 | + ;; so the answer is 0.
|
|
| 172 | + (assert-equal 0d0 (kernel::float-ratio-float (* 247/100 expo) 'double-float))
|
|
| 173 | + |
|
| 174 | + ;; These are all more than half way to
|
|
| 175 | + ;; least-positive-double-float, so they should return that.
|
|
| 176 | + (assert-equal least-positive-double-float
|
|
| 177 | + (kernel::float-ratio-float (* 248/100 expo) 'double-float))
|
|
| 178 | + (assert-equal least-positive-double-float
|
|
| 179 | + (kernel::float-ratio-float (* 4 expo) 'double-float))
|
|
| 180 | + (assert-equal least-positive-double-float
|
|
| 181 | + (kernel::float-ratio-float (* 494/100 expo) 'double-float))
|
|
| 182 | + (assert-equal least-positive-double-float
|
|
| 183 | + (kernel::float-ratio-float (* 988/100 expo) 'double-float)))))
|
|
| 184 | + |