- cmucl-cvs - mailman3.common-lisp.net

[Git][cmucl/cmucl] Deleted tag snapshot-2024-04
by Raymond Toy (＠rtoy) 19 Apr '24

19 Apr '24

Raymond Toy deleted tag snapshot-2024-04 at cmucl / cmucl -- You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Update with fixed tickets that we forgot to add earlier.
by Raymond Toy (＠rtoy) 19 Apr '24

19 Apr '24

Raymond Toy pushed to branch master at cmucl / cmucl Commits: a33e75ae by Raymond Toy at 2024-04-19T07:36:31-07:00 Update with fixed tickets that we forgot to add earlier. - - - - - 1 changed file: - src/general-info/release-21f.md Changes: ===================================== src/general-info/release-21f.md ===================================== @@ -30,14 +30,17 @@ public domain. * ANSI compliance fixes: * Bug fixes: * Gitlab tickets: + * * ~~#154~~ piglatin translation does not work anymore - * ~~#171~~ Readably print `(make-pathname :name :unspecfic)` + * ~~#171~~ Readably print `(make-pathname :name :unspecfic)` + * ~~#180~~ Move `get-page-size` to C * ~~#196~~ Fix issues with mapping and nconc accumulation (mapcan) * ~~#216~~ `enough-namestring` with relative pathname fails * ~~#234~~ Make :ASCII external format builtin * ~~#240~~ Speed up set operations * ~~#242~~ Fix bug in `alien-funcall` with `c-call:char` as result type * ~~#244~~ Add `c-call:signed-char` + * ~~#245~~ Replace `egrep` with `grep -E` in `make-dist.sh` * ~~#248~~ Print MOVS instruction with correct case * ~~#249~~ Replace LEA instruction with simpler shorter instructions in arithmetic vops for x86 * ~~#253~~ Block-compile list-to-hashtable and callers @@ -53,6 +56,7 @@ public domain. * ~~#265~~ CI for mac os is broken * ~~#266~~ Support "~user" in namestrings * ~~#269~~ Add function to get user's home directory + * ~~#270~~ Simplify `os_file_author` interface * ~~#271~~ Update ASDF to 3.3.7 * ~~#272~~ Move scavenge code for static vectors to its own function * ~~#274~~ 1d99999999 hangs @@ -67,7 +71,11 @@ public domain. * ~~#290~~ Pprint `with-float-traps-masked` better * ~~#291~~ Pprint `handler-case` neatly. * ~~#293~~ Allow restarts for FP overflow in reader. + * ~~#294~~ Implement assembly routine for xoroshiro update function + * ~~#296~~ Disassembly of movd instruction broken * ~~#297~~ Pprint `new-assem:assemble` with less indentation. + * ~~#298~~ Add `with-float-rounding-mode` macro + * ~~#299~~ Enable xoroshiro assembly routine * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/a33e75aed5ec46cd2ec116c… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/a33e75aed5ec46cd2ec116c… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new tag snapshot-2024-04
by Raymond Toy (＠rtoy) 19 Apr '24

19 Apr '24

Raymond Toy pushed new tag snapshot-2024-04 at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/snapshot-2024-04 You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #293: Allow restarts for FP overflow in reader
by Raymond Toy (＠rtoy) 19 Apr '24

19 Apr '24

Raymond Toy pushed to branch master at cmucl / cmucl Commits: c40327d1 by Raymond Toy at 2024-04-19T14:13:56+00:00 Fix #293: Allow restarts for FP overflow in reader - - - - - 787626ad by Raymond Toy at 2024-04-19T14:14:04+00:00 Merge branch 'issue-293-restart-on-reader-fp-overflow' into 'master' Fix #293: Allow restarts for FP overflow in reader Closes #293, #275, and #287 See merge request cmucl/cmucl!201 - - - - - 5 changed files: - src/code/bignum.lisp - src/code/reader.lisp - src/general-info/release-21f.md - src/i18n/locale/cmucl.pot - tests/float.lisp Changes: ===================================== src/code/bignum.lisp ===================================== @@ -2032,7 +2032,7 @@ down to individual words.") (declare (type bignum-index len)) (let ((exp (+ exp bias))) (when (> exp max) - (error 'simple-type-error + (error 'floating-point-overflow :datum x :format-control (intl:gettext "Too large to be represented as a ~S:~% ~S") :format-arguments (list format x) ===================================== src/code/reader.lisp ===================================== @@ -1823,6 +1823,51 @@ the end of the stream." num)))) (t (error _"Internal error in floating point reader."))))) +(defun restart-overflow (sign-num sign-div float-format stream) + (flet + ((floating-point-infinity (sign float-format) + (ecase float-format + ((short-float single-float) + (if (minusp sign) + ext:single-float-negative-infinity + ext:single-float-positive-infinity)) + ((double-float long-float) + (if (minusp sign) + ext:double-float-negative-infinity + ext:double-float-positive-infinity)) + #+double-double + ((kernel::double-double-float) + (if (minusp sign) + kernel::double-double-float-negative-infinity + kernel::double-double-float-positive-infinity)))) + (largest-float (sign float-format) + (ecase float-format + ((short-float single-float) + (if (minusp sign) + most-negative-single-float + most-positive-single-float)) + ((double-float long-float) + (if (minusp sign) + most-negative-double-float + most-positive-double-float)) + #+double-double + ((kernel::double-double-float) + (if (minusp sign) + ext:most-negative-double-double-float + ext:most-positive-double-double-float))))) + + (restart-case + (%reader-error stream _"Floating-point overflow reading ~S: ~S" + float-format (read-buffer-to-string)) + (infinity () + :report (lambda (stream) + (format stream "Return floating-point infinity")) + (floating-point-infinity (* sign-num sign-div) float-format)) + (largest-float () + :report (lambda (stream) + (format stream "Return largest floating-point value")) + (largest-float (* sign-num sign-div) float-format))))) + (defun make-float-aux (exponent number divisor float-format stream) ;; Computes x = number*10^exponent/divisor. ;; @@ -1867,7 +1912,7 @@ the end of the stream." (error 'floating-point-underflow)) (when (>= log2-num log2-high) ;; Number is definitely too large; signal an error - (error "Overflow")))))))) + (error 'floating-point-overflow)))))))) ;; Otherwise the number might fit, so we carefully compute the result. (handler-case @@ -1893,11 +1938,15 @@ the end of the stream." :report (lambda (stream) (format stream "Return ~A" zero)) zero)))) + (floating-point-overflow () + ;; Resignal a reader error, but allow the user to replace + ;; overflow with another value. + (restart-overflow (signum number) (signum divisor) + float-format stream)) (error () (%reader-error stream _"Number not representable as a ~S: ~S" float-format (read-buffer-to-string)))))) - (defun make-ratio (stream) ;;assume *read-buffer* contains a legal ratio. Build the number from ;;the string. ===================================== src/general-info/release-21f.md ===================================== @@ -66,6 +66,7 @@ public domain. * ~~#288~~ Re-enable `deftransform` for random integers. * ~~#290~~ Pprint `with-float-traps-masked` better * ~~#291~~ Pprint `handler-case` neatly. + * ~~#293~~ Allow restarts for FP overflow in reader. * ~~#297~~ Pprint `new-assem:assemble` with less indentation. * Other changes: * Improvements to the PCL implementation of CLOS: ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -8749,6 +8749,10 @@ msgstr "" msgid "Internal error in floating point reader." msgstr "" +#: src/code/reader.lisp +msgid "Floating-point overflow reading ~S: ~S" +msgstr "" + #: src/code/reader.lisp msgid "Floating point underflow when reading ~S: ~S" msgstr "" ===================================== tests/float.lisp ===================================== @@ -287,4 +287,49 @@ (invoke-restart 'lisp::continue)))) (read-from-string string))))))) +(define-test fp-overflow-restarts.infinity + (:tag :issues) + ;; Test that the "infinity" restart from reader on floating-point + ;; overflow returns an infinity of the correct type and sign. + (dolist (item (list (list "4e38" ext:single-float-positive-infinity) + (list "-4e38" ext:single-float-negative-infinity) + (list "2d308" ext:double-float-positive-infinity) + (list "-2d308" ext:double-float-negative-infinity) + ;; These test the short-cut case in the reader for + ;; very large numbers. + (list "4e999" ext:single-float-positive-infinity) + (list "-4e999" ext:single-float-negative-infinity) + (list "1d999" ext:double-float-positive-infinity) + (list "-1d999" ext:double-float-negative-infinity))) + (destructuring-bind (string expected-result) + item + (assert-equal expected-result + (values (handler-bind ((reader-error + (lambda (c) + (declare (ignore c)) + (invoke-restart 'lisp::infinity)))) + (read-from-string string))))))) +(define-test fp-overflow-restarts.huge + (:tag :issues) + ;; Test that the "largest-float" restart from reader on + ;; floating-point overflow returns the largest float of the correct + ;; type and sign. + (dolist (item (list (list "4e38" most-positive-single-float) + (list "-4e38" most-negative-single-float) + (list "2d308" most-positive-double-float) + (list "-2d308" most-negative-double-float) + ;; These test the short-cut case in the reader for + ;; very large numbers. + (list "4e999" most-positive-single-float) + (list "-4e999" most-negative-single-float) + (list "1d999" most-positive-double-float) + (list "-1d999" most-negative-double-float))) + (destructuring-bind (string expected-result) + item + (assert-equal expected-result + (handler-bind ((reader-error + (lambda (c) + (declare (ignore c)) + (values (invoke-restart 'lisp::largest-float))))) + (read-from-string string)))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/07c9c06b3d8f1c2f7072c9… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/07c9c06b3d8f1c2f7072c9… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-304-debug-handlers-defn
by Raymond Toy (＠rtoy) 17 Apr '24

17 Apr '24

Raymond Toy pushed new branch issue-304-debug-handlers-defn at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-304-debug-handlers-… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-293-restart-on-reader-fp-overflow] 5 commits: Fix #296: Fix disassembly of MOVD instruction
by Raymond Toy (＠rtoy) 11 Apr '24

11 Apr '24

Raymond Toy pushed to branch issue-293-restart-on-reader-fp-overflow at cmucl / cmucl Commits: 0cbb2264 by Raymond Toy at 2024-04-10T03:10:16+00:00 Fix #296: Fix disassembly of MOVD instruction - - - - - df78595e by Raymond Toy at 2024-04-10T03:10:20+00:00 Merge branch 'issue-296-fix-movd-disassembly' into 'master' Fix #296: Fix disassembly of MOVD instruction Closes #296 and #300 See merge request cmucl/cmucl!207 - - - - - 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 - - - - - c4cfca89 by Raymond Toy at 2024-04-11T16:01:24-07:00 Merge branch 'master' into issue-293-restart-on-reader-fp-overflow - - - - - 2 changed files: - src/compiler/x86/insts.lisp - src/general-info/release-21f.md Changes: ===================================== src/compiler/x86/insts.lisp ===================================== @@ -509,6 +509,14 @@ (print-byte-reg value stream dstate) (print-mem-access value stream t dstate))) +(defun print-word-reg/mem (value stream dstate) + (declare (type (or list reg) value) + (type stream stream) + (type disassem:disassem-state dstate)) + (if (typep value 'reg) + (print-word-reg value stream dstate) + (print-mem-access value stream nil dstate))) + (defun print-label (value stream dstate) (declare (ignore dstate)) (princ (if (and (numberp value) (minusp value)) @@ -716,7 +724,11 @@ (disassem:define-argument-type byte-reg/mem :prefilter #'prefilter-reg/mem :printer #'print-byte-reg/mem) - +(disassem:define-argument-type word-reg/mem + ;; Like reg/mem but if the reg/mem field is a register, it's a word + ;; register. + :prefilter #'prefilter-reg/mem + :printer #'print-word-reg/mem) ;;; ;;; added by jrd ;;; @@ -3478,7 +3490,7 @@ ;;; We do not support the MMX version of this instruction. (define-instruction movd (segment dst src) (:printer ext-xmm-reg/mem ((prefix #x66) (op #x6e))) - (:printer ext-xmm-reg/mem ((prefix #x66) (op #x7e)) + (:printer ext-xmm-reg/mem ((prefix #x66) (op #x7e) (reg/mem nil :type 'word-reg/mem)) '(:name :tab reg/mem ", " reg)) (:emitter (cond ((xmm-register-p dst) ===================================== 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 View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/da48651df72c0685a095cc… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/da48651df72c0685a095cc… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #275: FP underflow in reader allows restart with 0
by Raymond Toy (＠rtoy) 11 Apr '24

11 Apr '24

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/df78595ef611a98eb5fe6c… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/df78595ef611a98eb5fe6c… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-293-restart-on-reader-fp-overflow] Add issue #293 to release notes.
by Raymond Toy (＠rtoy) 10 Apr '24

10 Apr '24

Raymond Toy pushed to branch issue-293-restart-on-reader-fp-overflow at cmucl / cmucl Commits: da48651d by Raymond Toy at 2024-04-10T14:28:16-07:00 Add issue #293 to release notes. - - - - - 1 changed file: - src/general-info/release-21f.md Changes: ===================================== src/general-info/release-21f.md ===================================== @@ -65,6 +65,7 @@ public domain. * ~~#288~~ Re-enable `deftransform` for random integers. * ~~#290~~ Pprint `with-float-traps-masked` better * ~~#291~~ Pprint `handler-case` neatly. + * ~~#293~~ Allow restarts for FP overflow in reader. * ~~#297~~ Pprint `new-assem:assemble` with less indentation. * Other changes: * Improvements to the PCL implementation of CLOS: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/da48651df72c0685a095cca… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/da48651df72c0685a095cca… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-275b-signal-float-underflow] Add issue #275 to release notes.
by Raymond Toy (＠rtoy) 10 Apr '24

10 Apr '24

Raymond Toy pushed to branch issue-275b-signal-float-underflow at cmucl / cmucl Commits: 6b933b4a by Raymond Toy at 2024-04-10T14:26:39-07:00 Add issue #275 to release notes. - - - - - 1 changed file: - src/general-info/release-21f.md Changes: ===================================== 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 View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6b933b4a49b664564b45b28… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6b933b4a49b664564b45b28… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-275b-signal-float-underflow] 4 commits: Add test reading denormals with underflow enabled.
by Raymond Toy (＠rtoy) 10 Apr '24

10 Apr '24

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/9a811166998f97f907d0f8… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9a811166998f97f907d0f8… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0