Raymond Toy pushed to branch issue-299-enable-xoroshiro-assem-routine at cmucl / cmucl
Commits: 7543b720 by Raymond Toy at 2024-04-02T08:10:23-07:00 Fix #298: Add with-float-rounding-mode macro
Add `ext:with-float-rounding-mode` macro to set the FP rounding mode to be used when executing the body.
- - - - - bf417b47 by Raymond Toy at 2024-04-02T08:33:30-07:00 Update cmucl.pot with new docstrings
- - - - - e32034e0 by Raymond Toy at 2024-04-02T08:33:52-07:00 Add tests for with-float-rounding-mode
Not 100% sure the expected results are right. They seem plausible, but I didn't actually analyze that the rounding is correct.
- - - - - 3cdf6b8f by Raymond Toy at 2024-04-06T08:33:14-07:00 Reorder bug list to be numerically ascending.
No other changes.
- - - - - 62631e15 by Raymond Toy at 2024-04-07T22:52:52+00:00 Fix #297: Print new-assem:assemble with less indentation
- - - - - 7bec290f by Raymond Toy at 2024-04-07T22:53:01+00:00 Merge branch 'issue-297-pprint-assemble' into 'master'
Fix #297: Print new-assem:assemble with less indentation
Closes #297
See merge request cmucl/cmucl!203 - - - - - bb1bc462 by Raymond Toy at 2024-04-07T22:53:45+00:00 Fix #300: Reduce code duplication in random
- - - - - 94a2c674 by Raymond Toy at 2024-04-07T22:53:51+00:00 Merge branch 'issue-300-reduce-code-dup-in-random' into 'master'
Fix #300: Reduce code duplication in random
Closes #300
See merge request cmucl/cmucl!206 - - - - - 6ba75434 by Carl Shapiro at 2024-04-07T23:19:27+00:00 Make variable names consistent. - - - - - b8923ba5 by Raymond Toy at 2024-04-08T00:00:36+00:00 Fix #295: Add docstring for define-assembly-routine
- - - - - e77ded50 by Raymond Toy at 2024-04-08T00:00:39+00:00 Merge branch 'issue-295-docstring-for-define-assembly-routine' into 'master'
Fix #295: Add docstring for define-assembly-routine
Closes #295
See merge request cmucl/cmucl!204 - - - - - 0e716eab by Raymond Toy at 2024-04-07T17:02:55-07:00 Fix typos caused by renaming
We renamed `old-rounding-mode` to `old-mode`, but forgot to update all uses.
- - - - - 6181fd24 by Raymond Toy at 2024-04-08T05:52:20-07:00 Fix up docstring for with-float-rounding-mode
Mention that the allowed values are the same as the values for the rounding-mode in `set-floating-point-modes`.
Change indentation of docstring slightly so that it prints nicely via `describe`. (Emacs doesn't indent the docstring by the right amount for `describe`.)
- - - - - 659c41bc by Raymond Toy at 2024-04-08T05:58:05-07:00 Remove extra trailing space after period.
- - - - - 1cb2cb14 by Raymond Toy at 2024-04-08T13:00:08+00:00 Fix #294: Implement assembly routine for xoroshiro update
- - - - - 574eef63 by Raymond Toy at 2024-04-08T13:00:12+00:00 Merge branch 'issue-294-xoroshiro-lisp-assem-routine' into 'master'
Fix #294: Implement assembly routine for xoroshiro update
Closes #294
See merge request cmucl/cmucl!202 - - - - - 07a1669b by Raymond Toy at 2024-04-08T06:05:43-07:00 Update cmucl.pot for changed docstring for with-float-rounding-mode.
- - - - - a46a530e by Raymond Toy at 2024-04-08T14:00:18+00:00 Merge branch 'issue-298-with-float-rounding-mode' into 'master'
Fix #298: Add with-float-rounding-mode macro
Closes #298
See merge request cmucl/cmucl!205 - - - - - e03317ce by Raymond Toy at 2024-04-08T10:34:12-07:00 Merge branch 'master' into issue-299-enable-xoroshiro-assem-routine
- - - - -
4 changed files:
- src/code/exports.lisp - src/code/float-trap.lisp - src/i18n/locale/cmucl.pot - tests/float.lisp
Changes:
===================================== src/code/exports.lisp ===================================== @@ -1591,7 +1591,8 @@ "FLOAT-NAN-P" "FLOAT-TRAPPING-NAN-P" "FLOAT-SIGNALING-NAN-P" "WITH-FLOAT-TRAPS-MASKED" - "WITH-FLOAT-TRAPS-ENABLED") + "WITH-FLOAT-TRAPS-ENABLED" + "WITH-FLOAT-ROUNDING-MODE") ;; More float extensions #+double-double (:export "LEAST-POSITIVE-NORMALIZED-DOUBLE-DOUBLE-FLOAT"
===================================== src/code/float-trap.lisp ===================================== @@ -27,7 +27,8 @@ decode-floating-point-modes encode-floating-point-modes with-float-traps-masked - with-float-traps-enabled)) + with-float-traps-enabled + with-float-rounding-mode)) (in-package "VM")
(eval-when (compile load eval) @@ -495,3 +496,34 @@ accrued exceptions are cleared at the start of the body to support their testing within, and restored on exit."))
+(defmacro with-float-rounding-mode ((rounding-mode) &body body) + _N"Execute BODY with the floating-point rounding mode set to + ROUNDING-MODE. ROUNDING-MODE must be a one: + + :NEAREST + the default mode of round to nearest even. + :ZERO + round numbers down towards zero. Positive numbers round down + and negative numbers round up. + :POSITIVE-INFINITY + round numbers up towards positive infinity. + :NEGATIVE-INFINITY + round numbers down towards negative infinity. + + These are the same as the possible values for the rounding mode in + SET-FLOATING-POINT-MODES. + + Only the rounding mode is restored on exit; other floating-point + modes are not modified." + (let ((old-mode (gensym "OLD-MODE-")) + (new-mode (gensym "NEW-MODE-"))) + `(let ((,old-mode (ldb float-rounding-mode (floating-point-modes))) + (,new-mode (cdr (assoc ,rounding-mode rounding-mode-alist)))) + (unwind-protect + (progn + (setf (floating-point-modes) + (dpb ,new-mode float-rounding-mode (floating-point-modes))) + ,@body) + ;; Restore just the rounding mode to the original value. + (setf (floating-point-modes) + (dpb ,old-mode float-rounding-mode (floating-point-modes)))))))
===================================== src/i18n/locale/cmucl.pot ===================================== @@ -4868,6 +4868,28 @@ msgid "" " their testing within, and restored on exit." msgstr ""
+#: src/code/float-trap.lisp +msgid "" +"Execute BODY with the floating-point rounding mode set to\n" +" ROUNDING-MODE. ROUNDING-MODE must be a one:\n" +"\n" +" :NEAREST\n" +" the default mode of round to nearest even.\n" +" :ZERO\n" +" round numbers down towards zero. Positive numbers round down\n" +" and negative numbers round up.\n" +" :POSITIVE-INFINITY\n" +" round numbers up towards positive infinity.\n" +" :NEGATIVE-INFINITY\n" +" round numbers down towards negative infinity.\n" +"\n" +" These are the same as the possible values for the rounding mode in\n" +" SET-FLOATING-POINT-MODES.\n" +"\n" +" Only the rounding mode is restored on exit; other floating-point\n" +" modes are not modified." +msgstr "" + #: src/code/float.lisp msgid "Return true if the float X is denormalized." msgstr ""
===================================== tests/float.lisp ===================================== @@ -212,3 +212,38 @@ ;; most-positive-double-float. And a really big single-float. (assert-error 'reader-error (read-from-string "1.8d308")) (assert-error 'reader-error (read-from-string "1d999999999"))) + +(defun rounding-test (x) + (declare (double-float x) + (optimize (speed 3))) + (* x (/ 1d0 x))) + +(define-test rounding-mode.nearest + (:tag :issues) + (ext:with-float-rounding-mode (:nearest) + (assert-equal 1d0 (rounding-test 3d0)))) + +(define-test rounding-mode.zero.1 + (:tag :issues) + (ext:with-float-rounding-mode (:zero) + (assert-equal 0.9999999999999999d0 + (rounding-test 3d0)))) + +(define-test rounding-mode.zero.2 + (:tag :issues) + (ext:with-float-rounding-mode (:zero) + (assert-equal 0.9999999999999999d0 + (rounding-test -3d0)))) + +(define-test rounding-mode.positive-infinity + (:tag :issues) + (ext:with-float-rounding-mode (:positive-infinity) + (assert-equal 1.0000000000000002d0 + (rounding-test 3d0)))) + +(define-test rounding-mode.negative-infinity + (:tag :issues) + (ext:with-float-rounding-mode (:negative-infinity) + (assert-equal 0.9999999999999999d0 + (rounding-test 3d0)))) +
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/883a999e350cd4a0d86bddb...