Raymond Toy pushed to branch master at cmucl / cmucl

Commits: 9fee7762 by Raymond Toy at 2024-03-08T15:52:35+00:00 Fix #277: return least-positive float for rationals close to it

- - - - - 8faafb32 by Raymond Toy at 2024-03-08T15:52:37+00:00 Merge branch 'issue-277-float-ratio-float-least-positive-float' into 'master'

Fix #277: return least-positive float for rationals close to it

Closes #277

See merge request cmucl/cmucl!191 - - - - -

3 changed files:

- src/code/float.lisp - src/general-info/release-21f.md - tests/float.lisp

Changes:

===================================== src/code/float.lisp ===================================== @@ -1137,7 +1137,8 @@ (floatit (ash bits -1)) #+nil (progn - (format t "1: f0, f1 = ~A ~A~%" f0 f1) + (format t "x = ~A~%" x) + (format t "1: f0, f1 = ~A~%" f0) (format t " scale = ~A~%" (1+ scale))) (scale-float f0 (1+ scale)))) @@ -1146,14 +1147,30 @@ (floatit bits) #+nil (progn - (format t "2: f0, f1 = ~A ~A~%" f0 f1) + (format t "2: f0, f1 = ~A~%" f0) (format t " scale = ~A~%" scale) - (format t "scale-float f0 = ~A~%" (scale-float f0 scale)) - (when f1 - (format t "scale-float f1 = ~A~%" - (scale-float f1 (- scale 53))))) - - (scale-float f0 scale)))))) + (format t "scale-float f0 = ~A~%" (scale-float f0 scale))) + (let ((min-exponent + ;; Compute the min (unbiased) exponent + (ecase format + (single-float + (- vm:single-float-normal-exponent-min + vm:single-float-bias + vm:single-float-digits)) + (double-float + (- vm:double-float-normal-exponent-min + vm:double-float-bias + vm:double-float-digits))))) + ;; F0 is always between 0.5 and 1. If + ;; SCALE is the min exponent, we have a + ;; denormal number just less than the + ;; least-positive float. We want to + ;; return the least-positive-float so + ;; multiply F0 by 2 (without adjusting + ;; SCALE) to get the nearest float. + (if (= scale min-exponent) + (scale-float (* 2 f0) scale) + (scale-float f0 scale)))))))) (floatit (bits) (let ((sign (if plusp 0 1))) (case format

===================================== src/general-info/release-21f.md ===================================== @@ -44,6 +44,8 @@ public domain. * ~~#266~~ Support "~user" in namestrings * ~~#271~~ Update ASDF to 3.3.7 * ~~#272~~ Move scavenge code for static vectors to its own function + * ~~#277~~ `float-ratio-float` returns least postive float for + ratios closer to that than zero. * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure:

===================================== tests/float.lisp ===================================== @@ -136,5 +136,49 @@ (ext:with-float-traps-masked (:overflow) (* 100 most-negative-double-float)))))

- - \ No newline at end of file +(define-test float-ratio.single + (:tag :issues) + ;; least-positive-single-float is 1.4012985e-45. Let's test with + ;; some rationals from 7/10*10^-45 to 1.41*10^-45 to make sure they + ;; return 0 or least-positive-single-float + (let ((expo (expt 10 -45))) + ;; Need to make sure underflows are masked. + (kernel::with-float-traps-masked (:underflow) + ;; 7/10*10^-45 is just under halfway between 0 and least-positive, + ;; so the answer is 0. + (assert-equal 0f0 (kernel::float-ratio-float (* 7/10 expo) 'single-float)) + + ;; These are all more than half way to + ;; least-positive-single-float, so they should return that. + (assert-equal least-positive-single-float + (kernel::float-ratio-float (* 8/10 expo) 'single-float)) + (assert-equal least-positive-single-float + (kernel::float-ratio-float (* 1 expo) 'single-float)) + (assert-equal least-positive-single-float + (kernel::float-ratio-float (* 14/10 expo) 'single-float)) + (assert-equal least-positive-single-float + (kernel::float-ratio-float (* 2 expo) 'single-float))))) + +(define-test float-ratio.double + (:tag :issues) + ;; least-positive-double-float is 4.9406564584124654d-324. Let's + ;; test with some rationals from about 2*10^-324 to 4.94*10^-324 to make + ;; sure they return 0 or least-positive-double-float + (let ((expo (expt 10 -324))) + ;; Need to make sure underflows are masked. + (kernel::with-float-traps-masked (:underflow) + ;; 247/100*10^-324 is just under halfway between 0 and least-positive, + ;; so the answer is 0. + (assert-equal 0d0 (kernel::float-ratio-float (* 247/100 expo) 'double-float)) + + ;; These are all more than half way to + ;; least-positive-double-float, so they should return that. + (assert-equal least-positive-double-float + (kernel::float-ratio-float (* 248/100 expo) 'double-float)) + (assert-equal least-positive-double-float + (kernel::float-ratio-float (* 4 expo) 'double-float)) + (assert-equal least-positive-double-float + (kernel::float-ratio-float (* 494/100 expo) 'double-float)) + (assert-equal least-positive-double-float + (kernel::float-ratio-float (* 988/100 expo) 'double-float))))) +

View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/e16b28cc4171a3d42265a6d...