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:

 	   "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"

 	  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)

   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)))))))

 "  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 ""

   ;; 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))))

+