cmucl-cvs

cmucl-cvs@common-lisp.net

2904 discussions

[Git][cmucl/cmucl][issue-299-enable-xoroshiro-assem-routine] Fix typo in version to use
by Raymond Toy (＠rtoy) 08 Apr '24

08 Apr '24

Raymond Toy pushed to branch issue-299-enable-xoroshiro-assem-routine at cmucl / cmucl Commits: f4d2b870 by Raymond Toy at 2024-04-08T10:40:12-07:00 Fix typo in version to use The version should be "xoroshiro-assembly-x86", not just "xoroshiro-assembly". - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1,6 +1,6 @@ variables: download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/2023/08" - version: "xoroshiro-assembly" + version: "xoroshiro-assembly-x86" bootstrap: "" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/f4d2b8708ded4704053af21… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/f4d2b8708ded4704053af21… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-299-enable-xoroshiro-assem-routine] 19 commits: Fix #298: Add with-float-rounding-mode macro
by Raymond Toy (＠rtoy) 08 Apr '24

08 Apr '24

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

1 0

[Git][cmucl/cmucl][issue-299-enable-xoroshiro-assem-routine] Use the xoroshiro-assembly snapshot for building
by Raymond Toy (＠rtoy) 08 Apr '24

08 Apr '24

Raymond Toy pushed to branch issue-299-enable-xoroshiro-assem-routine at cmucl / cmucl Commits: 883a999e by Raymond Toy at 2024-04-08T10:21:59-07:00 Use the xoroshiro-assembly snapshot for building - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1,7 +1,7 @@ variables: download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/2023/08" - version: "2023-08-x86" - bootstrap: "-B boot-2023-08" + version: "xoroshiro-assembly" + bootstrap: "" stages: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/883a999e350cd4a0d86bddb… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/883a999e350cd4a0d86bddb… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-299-enable-xoroshiro-assem-routine] 4 commits: Reorder bug list to be numerically ascending.
by Raymond Toy (＠rtoy) 08 Apr '24

08 Apr '24

Raymond Toy pushed to branch issue-299-enable-xoroshiro-assem-routine at cmucl / cmucl Commits: 14ac1bf7 by Raymond Toy at 2024-04-08T10:16:18-07:00 Reorder bug list to be numerically ascending. No other changes. - - - - - 77622bd0 by Raymond Toy at 2024-04-08T10:16:18-07:00 Fix #297: Print new-assem:assemble with less indentation - - - - - 6a4d4b5d by Raymond Toy at 2024-04-08T10:16:18-07:00 Fix #300: Reduce code duplication in random - - - - - c08895e5 by Raymond Toy at 2024-04-08T10:16:18-07:00 Fix #295: Add docstring for define-assembly-routine - - - - - 6 changed files: - src/assembly/assemfile.lisp - src/bootfiles/21e/boot-2023-08.lisp - src/code/pprint.lisp - src/code/rand-xoroshiro.lisp - src/general-info/release-21f.md - tests/pprint.lisp Changes: ===================================== src/assembly/assemfile.lisp ===================================== @@ -209,7 +209,61 @@ ,(reg-spec-temp res)))) results)))))) +;;; Define-Assembly-Routine -- Public +;;; +;;; Parse the code to produce an assembly routine and create a VOP +;;; that calls the assembly routine. (defmacro define-assembly-routine (name&options vars &rest code) + "Define-Assembly-Routine (Name&Options Vars Code*) + Define a Lisp assembly routine, and a VOP to that calls the assembly + routine, if enabled. (A VOP is not created if the reader + conditional #+assembler precedes the definition of the assembly + routine.) + + Name&Options + A list giving the name of the assembly routine and options + describing the assembly routine options and VOP options. The + format is (Name ({Key Value})*) where Name is the name of the + assembly routine. Options is a list of options: + + Options + + :Cost Cost + The cost of the VOP. This is used in the generated VOP. + + :Policy {:Small | :Fast | :Safe | :Fast-Safe} + The policy for the VOP. + + :Translate Name + The translation for the VOP. + + :Arg-Types arg-types + :Result-Types result-types + The template restrictions for the arguments of the VOP and the + results of the VOP. + + :Return-Style {:Raw :Full-Call :None} + + Vars is a list of the arguments and returned results and + temporaries used by the assembly routine. + + :Arg Arg-Name (SC*) SC-Offset + Input argument for the assembly routine with the name + Arg-Name. The argument must be one of the SC types. The register + assigned to this argument is given by SC-Offset which must be + the offset for the register holding this argument. + + :Res Res-Name SC SC-Offset + Result of the assembly routine with the name Res-Name. The + result must be a register of the specified storage class SC. The + Sc-offset is the register used for the result. + + :Temp Temp-Name SC SC-Offset + Like :Res, except this names a temporary register that the + assembly routine can use. + + Code + The code for the assembly routine." (multiple-value-bind (name options) (if (atom name&options) (values name&options nil) ===================================== src/bootfiles/21e/boot-2023-08.lisp ===================================== @@ -2,3 +2,46 @@ ;; *SOFTWARE-VERSION* from the LISP package to the SYSTEM package. (ext:without-package-locks (unintern 'lisp::*software-version* "LISP")) + +#+(or random-mt19937 random-xoroshiro) +(in-package "C") +#+(or random-mt19937 random-xoroshiro) +(deftransform random ((num &optional state) + ((integer 1 #.(expt 2 32)) &optional *)) + _N"use inline (unsigned-byte 32) operations" + (let* ((num-type (continuation-type num)) + (num-high (cond ((numeric-type-p num-type) + (numeric-type-high num-type)) + ((union-type-p num-type) + ;; Find the maximum of the union type. We + ;; know this works because if we're in this + ;; routine, NUM must be a subtype of + ;; (INTEGER 1 2^32), so each member of the + ;; union must be a subtype too. + (reduce #'max (union-type-types num-type) + :key #'numeric-type-high)) + (t + (give-up))))) + ;; Rather than doing (rem (random-chunk) num-high), we do, + ;; essentially, (rem (* num-high (random-chunk)) #x100000000). I + ;; (rtoy) believe this approach doesn't have the bias issue with + ;; doing rem. This method works by treating (random-chunk) as if + ;; it were a 32-bit fraction between 0 and 1, exclusive. Multiply + ;; this by num-high to get a random number between 0 and num-high, + ;; This should have no bias. + (cond ((constant-continuation-p num) + (if (= num-high (expt 2 32)) + '(random-chunk (or state *random-state*)) + '(values (bignum::%multiply + (random-chunk (or state *random-state*)) + num)))) + ((< num-high (expt 2 32)) + '(values (bignum::%multiply (random-chunk (or state *random-state*)) + num))) + ((= num-high (expt 2 32)) + '(if (= num (expt 2 32)) + (random-chunk (or state *random-state*)) + (values (bignum::%multiply (random-chunk (or state *random-state*)) + num)))) + (t + (error (intl:gettext "Shouldn't happen")))))) ===================================== src/code/pprint.lisp ===================================== @@ -2088,6 +2088,7 @@ When annotations are present, invoke them at the right positions." (c:define-vop pprint-define-vop) (c:sc-case pprint-sc-case) (c:define-assembly-routine pprint-define-assembly) + (new-assem:assemble pprint-multiple-value-bind) (c:deftransform pprint-defun) (c:defoptimizer pprint-defun) (ext:with-float-traps-masked pprint-with-like) ===================================== src/code/rand-xoroshiro.lisp ===================================== @@ -490,11 +490,8 @@ (declare (inline %random-single-float %random-double-float)) (cond ((typep arg '(integer 1 #x100000000)) - ;; Do the same thing as the deftransform would do. - (if (= arg (expt 2 32)) - (random-chunk state) - (values (bignum::%multiply (random-chunk state) - arg)))) + ;; Let the compiler deftransform take care of this case. + (random arg state)) ((and (typep arg 'single-float) (> arg 0.0F0)) (%random-single-float arg state)) ((and (typep arg 'double-float) (> arg 0.0D0)) ===================================== src/general-info/release-21f.md ===================================== @@ -51,8 +51,8 @@ public domain. * ~~#261~~ Remove `get-system-info` from "bsd-os.lisp" * ~~#268~~ Can't clone ansi-test repo on Mac OS CI box * ~~#265~~ CI for mac os is broken - * ~~#269~~ Add function to get user's home directory * ~~#266~~ Support "~user" in namestrings + * ~~#269~~ Add function to get user's home directory * ~~#271~~ Update ASDF to 3.3.7 * ~~#272~~ Move scavenge code for static vectors to its own function * ~~#274~~ 1d99999999 hangs @@ -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. + * ~~#297~~ Pprint `new-assem:assemble` with less indentation. * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== tests/pprint.lisp ===================================== @@ -121,3 +121,17 @@ (:no-error () (format nil "Nothing bad happened."))) s)))) + +(define-test pprint.assemble + (:tag :issues) + (assert-equal + " +(NEW-ASSEM:ASSEMBLE (C:*CODE-SEGMENT* 'X86::XOROSHIRO-UPDATE) + X86::XOROSHIRO-UPDATE + (PUSH (CONS 'X86::XOROSHIRO-UPDATE X86::XOROSHIRO-UPDATE) + C::*ASSEMBLER-ROUTINES*))" + (with-output-to-string (s) + (pprint '(new-assem:assemble (c::*code-segment* 'vm::xoroshiro-update) + vm::xoroshiro-update + (push (cons 'vm::xoroshiro-update vm::xoroshiro-update) c::*assembler-routines*)) + s)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6e139c98d38e389ebc46fb… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6e139c98d38e389ebc46fb… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new tag snapshot-xoroshiro-update-assembly
by Raymond Toy (＠rtoy) 08 Apr '24

08 Apr '24

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

1 0

[Git][cmucl/cmucl][master] 9 commits: Fix #298: Add with-float-rounding-mode macro
by Raymond Toy (＠rtoy) 08 Apr '24

08 Apr '24

Raymond Toy pushed to branch master 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. - - - - - 6ba75434 by Carl Shapiro at 2024-04-07T23:19:27+00:00 Make variable names consistent. - - - - - 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. - - - - - 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 - - - - - 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/574eef63f932ae5da3fc56… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/574eef63f932ae5da3fc56… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-298-with-float-rounding-mode] Update cmucl.pot for changed docstring for with-float-rounding-mode.
by Raymond Toy (＠rtoy) 08 Apr '24

08 Apr '24

Raymond Toy pushed to branch issue-298-with-float-rounding-mode at cmucl / cmucl Commits: 07a1669b by Raymond Toy at 2024-04-08T06:05:43-07:00 Update cmucl.pot for changed docstring for with-float-rounding-mode. - - - - - 1 changed file: - src/i18n/locale/cmucl.pot Changes: ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -4871,20 +4871,23 @@ msgstr "" #: src/code/float-trap.lisp msgid "" "Execute BODY with the floating-point rounding mode set to\n" -" ROUNDING-MODE. ROUNDING-MODE must a one of\n" +" ROUNDING-MODE. ROUNDING-MODE must be a one:\n" "\n" -" :NEAREST\n" -" the default mode of round to nearest even\n" -" :ZERO\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" +" :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. " +" modes are not modified." msgstr "" #: src/code/float.lisp View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/07a1669bc15220db5ab70c4… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/07a1669bc15220db5ab70c4… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #294: Implement assembly routine for xoroshiro update
by Raymond Toy (＠rtoy) 08 Apr '24

08 Apr '24

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 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 - - - - - 3 changed files: - src/assembly/x86/arith.lisp - src/assembly/x86/support.lisp - src/compiler/x86/arith.lisp Changes: ===================================== src/assembly/x86/arith.lisp ===================================== @@ -411,3 +411,121 @@ (inst pop y) (inst pop k) (inst ret)) + +;;; Support for the xoroshiro128** generator. See +;;; https://prng.di.unimi.it/xoroshiro128starstar.c for the official +;;; code. +;;; +;;; This is what we're implementing, where s[] is our state vector. +;;; +;;; static uint64_t s[2]; +;;; static inline uint64_t rotl(const uint64_t x, int k) { +;;; return (x << k) | (x >> (64 - k)); +;;; } +;;; +;;; uint64_t next(void) { +;;; const uint64_t s0 = s[0]; +;;; uint64_t s1 = s[1]; +;;; const uint64_t result = rotl(s0 * 5, 7) * 9; +;;; +;;; s1 ^= s0; +;;; s[0] = rotl(s0, 24) ^ s1 ^ (s1 << 16); // a, b +;;; s[1] = rotl(s1, 37); // c +;;; +;;; return result; +;;; } +;;; +;;; A VOP is also generated to call this assembly routine. This +;;; routine computes a new 64-bit random number and also updates the +;;; state, which is (simple-array (double-float) (2)). +#+random-xoroshiro +(define-assembly-routine + (xoroshiro-update + (:translate kernel::random-xoroshiro-update) + (:return-style :raw) + (:cost 30) + (:policy :fast-safe) + (:arg-types simple-array-double-float) + (:result-types unsigned-num unsigned-num)) + ((:arg state descriptor-reg edx-offset) + (:res r1 unsigned-reg ecx-offset) + (:res r0 unsigned-reg ebx-offset) + (:temp s0 double-reg xmm0-offset) + (:temp s1 double-reg xmm1-offset) + (:temp t0 double-reg xmm2-offset) + (:temp t1 double-reg xmm3-offset)) + + ;; s0 = state[0] + (inst movsd s0 (make-ea :dword :base state + :disp (- (+ (* vm:vector-data-offset + vm:word-bytes) + (* 8 0)) + vm:other-pointer-type))) + ;; t0 = s0 * 5 = s0 << 2 + s0 + (inst movapd t0 s0) ; t0 = s0 + (inst psllq t0 2) ; t0 = t0 << 2 = 4*t0 + (inst paddq t0 s0) ; t0 = t0 + s0 = 5*t0 + + ;; t0 = rotl(t0, 7) = t0 << 7 | t0 >> (64-7) + ;; = rotl(s0*5, 7) + (inst movapd t1 t0) ; t1 = t0 + (inst psllq t1 7) ; t1 = t0 << 7 + (inst psrlq t0 (- 64 7)) ; t0 = t0 >> 57 + (inst orpd t0 t1) ; t0 = t0 << 7 | t0 >> 57 = rotl(t0, 7) + + ;; t0 = t0 * 9 = t0 << 3 + t0 + ;; = rotl(s0*5, 7) * 9 + (inst movapd t1 t0) ; t1 = t0 + (inst psllq t1 3) ; t1 = t0 << 3 + (inst paddq t0 t1) ; t0 = t0 << 3 + t0 = 9*t0 + + ;; Save the result as two 32-bit results. r1 is the high 32 bits + ;; and r0 is the low 32. + (inst movd r0 t0) + (inst psrlq t0 32) + (inst movd r1 t0) + + ;; s1 = state[1] + (inst movsd s1 (make-ea :dword :base state + :disp (- (+ (* vm:vector-data-offset + vm:word-bytes) + (* 8 1)) + vm:other-pointer-type))) + (inst xorpd s1 s0) ; s1 = s1 ^ s0 + + ;; s0 can now be reused as a temp. + ;; s0 = rotl(s0, 24) + (inst movapd t0 s0) ; t0 = s0 + (inst psllq t0 24) ; t0 = s0 << 24 + (inst psrlq s0 (- 64 24)) ; s0 = s0 >> 40 + (inst orpd s0 t0) ; s0 = s0 | t0 = rotl(s0, 24) + + ;; s0 = s0 ^ s1 = rotl(s0, 24) ^ s1 + (inst xorpd s0 s1) + + ;; s0 = s0 ^ (s1 << 16) + (inst movapd t0 s1) ; t0 = s1 + (inst psllq t0 16) ; t0 = s1 << 16 + (inst xorpd s0 t0) ; s0 = rotl(s0, 24) ^ s1 ^ (s1 << 16) + + ;; Save s0 to state[0] + (inst movsd (make-ea :dword :base state + :disp (- (+ (* vm:vector-data-offset + vm:word-bytes) + (* 8 0)) + vm:other-pointer-type)) + s0) + + ;; s1 = rotl(s1, 37) + (inst movapd t0 s1) ; t0 = s1 + (inst psllq t0 37) ; t0 = s1 << 37 + (inst psrlq s1 (- 64 37)) ; s1 = s1 >> 27 + (inst orpd s1 t0) ; s1 = t0 | s1 = rotl(s1, 37) + + ;; Save s1 to state[1] + (inst movsd (make-ea :dword :base state + :disp (- (+ (* vm:vector-data-offset + vm:word-bytes) + (* 8 1)) + vm:other-pointer-type)) + s1)) ===================================== src/assembly/x86/support.lisp ===================================== @@ -39,7 +39,7 @@ (def-vm-support-routine generate-return-sequence (style) (ecase style (:raw - `(inst ret)) + `((inst ret))) (:full-call `( (inst pop eax-tn) ===================================== src/compiler/x86/arith.lisp ===================================== @@ -1810,3 +1810,8 @@ vm:other-pointer-type)) s1))) ) + +#+random-xoroshiro +(defknown kernel::random-xoroshiro-update ((simple-array double-float (2))) + (values (unsigned-byte 32) (unsigned-byte 32)) + (movable)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/e77ded50bfd6c663157047… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/e77ded50bfd6c663157047… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-298-with-float-rounding-mode] Remove extra trailing space after period.
by Raymond Toy (＠rtoy) 08 Apr '24

08 Apr '24

Raymond Toy pushed to branch issue-298-with-float-rounding-mode at cmucl / cmucl Commits: 659c41bc by Raymond Toy at 2024-04-08T05:58:05-07:00 Remove extra trailing space after period. - - - - - 1 changed file: - src/code/float-trap.lisp Changes: ===================================== src/code/float-trap.lisp ===================================== @@ -514,7 +514,7 @@ SET-FLOATING-POINT-MODES. Only the rounding mode is restored on exit; other floating-point - modes are not modified. " + 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))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/659c41bc23701d1127d66ce… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/659c41bc23701d1127d66ce… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-298-with-float-rounding-mode] Fix up docstring for with-float-rounding-mode
by Raymond Toy (＠rtoy) 08 Apr '24

08 Apr '24

Raymond Toy pushed to branch issue-298-with-float-rounding-mode at cmucl / cmucl Commits: 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`.) - - - - - 1 changed file: - src/code/float-trap.lisp Changes: ===================================== src/code/float-trap.lisp ===================================== @@ -498,17 +498,20 @@ (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 a one of + ROUNDING-MODE. ROUNDING-MODE must be a one: - :NEAREST - the default mode of round to nearest even - :ZERO + :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 + :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. " View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6181fd24b8de80cde307ddf… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6181fd24b8de80cde307ddf… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

cmucl-cvs