Raymond Toy pushed to branch master at cmucl / cmucl
Commits: e88d7ffe by Raymond Toy at 2024-04-11T22:11:51+00:00 Fix #275: FP underflow in reader allows restart with 0
- - - - - 07c9c06b by Raymond Toy at 2024-04-11T22:11:55+00:00 Merge branch 'issue-275b-signal-float-underflow' into 'master'
Fix #275: FP underflow in reader allows restart with 0
Closes #275 and #287
See merge request cmucl/cmucl!197 - - - - -
4 changed files:
- src/code/reader.lisp - src/general-info/release-21f.md - src/i18n/locale/cmucl.pot - tests/float.lisp
Changes:
===================================== src/code/reader.lisp ===================================== @@ -1832,56 +1832,70 @@ the end of the stream." ;; throw an error immediately. We don't need to be super accurate ;; with the limits. The rest of the code will handle it correctly, ;; even if we're too small or too large. - (unless (zerop number) - (flet ((fast-log2 (n) - ;; For an integer, the integer-length is close enough to - ;; the log2 of the number. - (integer-length n))) - ;; log2(x) = log(number*10^exponent/divisor) - ;; = exponent*log2(10) + log2(number)-log2(divisor) - (let ((log2-num (+ (* exponent #.(kernel::log2 10d0)) - (fast-log2 number) - (- (fast-log2 divisor))))) - (multiple-value-bind (log2-low log2-high) - (ecase float-format - ((short-float single-float) - ;; Single-float exponents range is -149 to 127, but we - ;; don't need to be super-accurate since we're - ;; multiplying the values by 2. - (values (* 2 (- vm:single-float-normal-exponent-min - vm:single-float-bias - vm:single-float-digits)) - (* 2 (- vm:single-float-normal-exponent-max - vm:single-float-bias)))) - ((double-float long-float - #+double-double kernel:double-double-float) - (values (* 2 (- vm:double-float-normal-exponent-min - vm:double-float-bias - vm:double-float-digits)) - (* 2 (- vm:double-float-normal-exponent-max - vm:double-float-bias))))) - ;; Double-float exponent range is -1074 to -1023 - (unless (< log2-low log2-num log2-high) - ;; The number is definitely too large or too small to fit. - ;; Signal an error. - (%reader-error stream _"Number not representable as a ~S: ~S" - float-format (read-buffer-to-string))))))) - - ;; Otherwise the number might fit, so we carefully compute the result. - (handler-case - (with-float-traps-masked (:underflow) - (let* ((ratio (/ (* (expt 10 exponent) number) - divisor)) - (result (coerce ratio float-format))) - (when (and (zerop result) (not (zerop number))) - ;; The number we've read is so small that it gets - ;; converted to 0.0, but is not actually zero. Signal an - ;; error. See CLHS 2.3.1.1. - (error _"Underflow")) - result)) - (error () - (%reader-error stream _"Number not representable as a ~S: ~S" - float-format (read-buffer-to-string))))) + (flet ((handle-extreme-numbers () + (unless (zerop number) + (flet ((fast-log2 (n) + ;; For an integer, the integer-length is close enough to + ;; the log2 of the number. + (integer-length n))) + ;; log2(x) = log(number*10^exponent/divisor) + ;; = exponent*log2(10) + log2(number)-log2(divisor) + (let ((log2-num (+ (* exponent #.(kernel::log2 10d0)) + (fast-log2 number) + (- (fast-log2 divisor))))) + (multiple-value-bind (log2-low log2-high) + (ecase float-format + ((short-float single-float) + ;; Single-float exponents range is -149 to 127, but we + ;; don't need to be super-accurate since we're + ;; multiplying the values by 2. + (values (* 2 (- vm:single-float-normal-exponent-min + vm:single-float-bias + vm:single-float-digits)) + (* 2 (- vm:single-float-normal-exponent-max + vm:single-float-bias)))) + ((double-float long-float + #+double-double kernel:double-double-float) + ;; Double-float exponent range is -1074 to -1023 + (values (* 2 (- vm:double-float-normal-exponent-min + vm:double-float-bias + vm:double-float-digits)) + (* 2 (- vm:double-float-normal-exponent-max + vm:double-float-bias))))) + (when (<= log2-num log2-low) + ;; Number is definitely too small; signal an underflow. + (error 'floating-point-underflow)) + (when (>= log2-num log2-high) + ;; Number is definitely too large; signal an error + (error "Overflow")))))))) + + ;; Otherwise the number might fit, so we carefully compute the result. + (handler-case + (with-float-traps-masked (:underflow) + (handle-extreme-numbers) + (let* ((ratio (/ (* (expt 10 exponent) number) + divisor)) + (result (coerce ratio float-format))) + (when (and (zerop result) (not (zerop number))) + ;; The number we've read is so small that it gets + ;; converted to 0.0, but is not actually zero. Signal an + ;; error. See CLHS 2.3.1.1. + (error 'floating-point-underflow)) + result)) + (floating-point-underflow () + ;; Resignal a reader error, but allow the user to continue with + ;; 0. + (let ((zero (coerce 0 float-format))) + (restart-case + (%reader-error stream _"Floating point underflow when reading ~S: ~S" + float-format (read-buffer-to-string)) + (continue () + :report (lambda (stream) + (format stream "Return ~A" zero)) + zero)))) + (error () + (%reader-error stream _"Number not representable as a ~S: ~S" + float-format (read-buffer-to-string))))))
(defun make-ratio (stream)
===================================== src/general-info/release-21f.md ===================================== @@ -56,6 +56,7 @@ public domain. * ~~#271~~ Update ASDF to 3.3.7 * ~~#272~~ Move scavenge code for static vectors to its own function * ~~#274~~ 1d99999999 hangs + * ~~#275~~ FP underflow in reader allows restarting with 0 * ~~#276~~ Implement xoroshiro128** generator for x86 * ~~#277~~ `float-ratio-float` returns 0 for numbers close to least-positive-float
===================================== src/i18n/locale/cmucl.pot ===================================== @@ -8750,11 +8750,11 @@ msgid "Internal error in floating point reader." msgstr ""
#: src/code/reader.lisp -msgid "Number not representable as a ~S: ~S" +msgid "Floating point underflow when reading ~S: ~S" msgstr ""
#: src/code/reader.lisp -msgid "Underflow" +msgid "Number not representable as a ~S: ~S" msgstr ""
#: src/code/reader.lisp
===================================== tests/float.lisp ===================================== @@ -247,3 +247,44 @@ (assert-equal 0.9999999999999999d0 (rounding-test 3d0))))
+(define-test reader.underflow-enabled + (:tag :issues) + ;; Test with FP underflow enabled, we can still read denormals + ;; without problem. For this test we only care that we get a + ;; number, not the actual value. + (dolist (n (list least-positive-single-float + least-positive-normalized-single-float + (/ (+ least-positive-single-float + least-positive-normalized-single-float) + 2) + least-positive-double-float + least-positive-normalized-double-float + (/ (+ least-positive-double-float + least-positive-normalized-double-float) + 2) + )) + (assert-true (floatp + (ext:with-float-traps-enabled (:underflow) + (read-from-string (format nil "~A" n))))))) + +(define-test reader-restarts.underflow + (:tag :issues) + ;; Test that we get a restart when reading floating-point numbers + ;; that are too small to fit in a float. Invoke the restart to + ;; return 0. All the numbers must be less than half the + ;; leasst-positive float. + (dolist (item '(("1e-46" 0f0) + ("1e-999" 0f0) + ("1d-324" 0d0) + ("1d-999" 0d0))) + (destructuring-bind (string expected-value) + item + (assert-equal expected-value + (values (handler-bind + ((reader-error + (lambda (c) + (declare (ignore c)) + (invoke-restart 'lisp::continue)))) + (read-from-string string))))))) + +
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/df78595ef611a98eb5fe6c8...