Raymond Toy pushed to branch issue-275b-signal-float-underflow at cmucl / cmucl

Commits: f3b2f7d8 by Raymond Toy at 2024-04-10T08:12:12-07:00 Add test reading denormals with underflow enabled.

We should be able to read denormals without problems even if FP underflow is enabled.

- - - - - e27ac073 by Raymond Toy at 2024-04-10T13:08:05-07:00 Fix underflow test that was underflowing

In the test, we had underflow enabled, but computed numbers that would underflow. Hence, only wrap the part that reads floats with underflow enabled.

- - - - - 1e3a49ea by Raymond Toy at 2024-04-10T13:10:29-07:00 Just enable underflow only around reading from the string

- - - - - 3f4072b5 by Raymond Toy at 2024-04-10T13:11:16-07:00 Handle underflow for very tiny numbers

Previously, when the numbers were very tiny, we signaled a reader-error but didn't have a restart to return 0. Modify the code so that when we have very tiny numbers, we signal a `floating-point-underflow` error that we can catch and establish a restart to return 0.

For very large numbers that overflow, we just signal a reader-error for now.

Update cmucl.pot too for the new string.

- - - - -

3 changed files:

- src/code/reader.lisp - src/i18n/locale/cmucl.pot - tests/float.lisp

Changes:

===================================== src/code/reader.lisp ===================================== @@ -1832,67 +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) - ;; 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))))) - (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 '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))))) + (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/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 "Floating point underflow when reading ~S: ~S" +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/9a811166998f97f907d0f89...