cmucl-cvs March 2024

cmucl-cvs@common-lisp.net

1 participants
54 discussions

[Git][cmucl/cmucl][issue-294-xoroshiro-lisp-assem-routine] 4 commits: generate-return-sequence generated incorrect :raw return
by Raymond Toy (＠rtoy) 31 Mar '24

31 Mar '24

Raymond Toy pushed to branch issue-294-xoroshiro-lisp-assem-routine at cmucl / cmucl Commits: 91a947c4 by Raymond Toy at 2024-03-31T07:52:16-07:00 generate-return-sequence generated incorrect :raw return When the return style is `:raw`, we generated the wrong sequence of instructions because `generate-return-sequence` is supposed to return a list of the instructions. We were returning the "instructions" `inst` and `ret` instead of `(inst ret)`. - - - - - 06445c08 by Raymond Toy at 2024-03-31T07:54:58-07:00 Define a vop for the xoroshiro-update assembly routine. The generated VOP basically does what we want and is the same as the hand-written one in compiler/x86/arith.lisp. To make this work, just needed to add `:arg-types` and `:result-types` options. - - - - - c42702ce by Raymond Toy at 2024-03-31T08:03:45-07:00 Some cleanups and comments Rename `result[01]` back to `r[01]`. Add some comments and move the description of the algorithm from the body of the assembly routine to the comment before the definition of the assembly routine. - - - - - 4910c4f0 by Raymond Toy at 2024-03-31T08:05:54-07:00 Remove the hand-written update VOP This VOP is now generated by the assembly routine and is basically identical to what we wrote here. Hence, we don't need this, which was commented out anyway. - - - - - 3 changed files: - src/assembly/x86/arith.lisp - src/assembly/x86/support.lisp - src/compiler/x86/arith.lisp Changes: ===================================== src/assembly/x86/arith.lisp ===================================== @@ -412,15 +412,41 @@ (inst pop k) (inst ret)) - -#+(and random-xoroshiro assembler) +;;; 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::xoroshiro-update) + (:translate kernel::random-xoroshiro-update) (:return-style :raw) (:cost 30) - (:policy :safe) - (:save-p t)) + (:policy :fast-safe) + (:arg-types simple-array-double-float) + (:result-types unsigned-num unsigned-num)) ((:arg state descriptor-reg eax-offset) (:res r1 unsigned-reg edx-offset) (:res r0 unsigned-reg ebx-offset) @@ -428,26 +454,6 @@ (:temp s1 double-reg xmm1-offset) (:temp t0 double-reg xmm2-offset) (:temp t1 double-reg xmm3-offset)) - ;; 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; - ;; } ;; s0 = state[0] (inst movsd s0 (make-ea :dword :base state @@ -522,5 +528,4 @@ vm:word-bytes) (* 8 1)) vm:other-pointer-type)) - s1) - (inst ret)) + 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 ===================================== @@ -1812,34 +1812,6 @@ ) #+random-xoroshiro -(progn (defknown kernel::random-xoroshiro-update ((simple-array double-float (2))) (values (unsigned-byte 32) (unsigned-byte 32)) (movable)) - - -(define-vop (random-xoroshiro-update) - (:policy :fast-safe) - (:translate kernel::random-xoroshiro-update) - (:args (state :scs (descriptor-reg) :target state-arg)) - (:arg-types simple-array-double-float) - (:results (hi :scs (unsigned-reg)) - (lo :scs (unsigned-reg))) - (:result-types unsigned-num unsigned-num) - (:temporary (:sc descriptor-reg :offset eax-offset) state-arg) - (:temporary (:sc double-reg :offset xmm0-offset) s0) - (:temporary (:sc double-reg :offset xmm1-offset) s1) - (:temporary (:sc double-reg :offset xmm2-offset) t0) - (:temporary (:sc double-reg :offset xmm3-offset) t1) - (:temporary (:sc unsigned-reg :offset edx-offset :target hi) r1) - (:temporary (:sc unsigned-reg :offset ebx-offset :target lo) r0) - (:generator 50 - (move state-arg state) - (move s0 s0) - (move s1 s1) - (move t0 t0) - (move t1 t1) - (inst call (make-fixup 'vm::xoroshiro-update :assembly-routine)) - (move hi r1) - (move lo r0))) -) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/204c9c34731d07e2b274c2… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/204c9c34731d07e2b274c2… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-294-xoroshiro-lisp-assem-routine
by Raymond Toy (＠rtoy) 31 Mar '24

31 Mar '24

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

1 0

[Git][cmucl/cmucl][issue-275b-signal-float-underflow] 6 commits: Fix #288: Re-enable deftransform for random integers
by Raymond Toy (＠rtoy) 29 Mar '24

29 Mar '24

Raymond Toy pushed to branch issue-275b-signal-float-underflow at cmucl / cmucl Commits: f6daa48c by Raymond Toy at 2024-03-29T13:17:17+00:00 Fix #288: Re-enable deftransform for random integers - - - - - 1bc97727 by Raymond Toy at 2024-03-29T13:18:30+00:00 Merge branch 'issue-288-re-enable-deftransform-random-int' into 'master' Fix #288: Re-enable deftransform for random integers Closes #288 See merge request cmucl/cmucl!198 - - - - - 3a206076 by Raymond Toy at 2024-03-29T15:43:02+00:00 Fix #291: pprint handler-case neatly - - - - - 7c6275a2 by Raymond Toy at 2024-03-29T15:43:03+00:00 Merge branch 'issue-291-pprint-handler-case' into 'master' Fix #291: pprint handler-case neatly Closes #291 See merge request cmucl/cmucl!200 - - - - - ca064da0 by Raymond Toy at 2024-03-29T08:56:28-07:00 Update notes with fixed issues Forgot to add #288, #290, and #291 to the list of fixed issues. - - - - - ca07a140 by Raymond Toy at 2024-03-29T15:45:54-07:00 Merge branch 'master' into issue-275b-signal-float-underflow - - - - - 7 changed files: - bin/run-ansi-tests.sh - src/code/pprint.lisp - src/compiler/float-tran.lisp - src/general-info/release-21f.md - src/i18n/locale/cmucl.pot - tests/pprint.lisp - tests/rng.lisp Changes: ===================================== bin/run-ansi-tests.sh ===================================== @@ -41,7 +41,7 @@ else fi cd ../ansi-test -git checkout cmucl-expected-failures +git checkout issue-288-new-failures make LISP="$LISP batch -noinit -nositeinit" # There should be no unexpected successes or failures; check these separately ===================================== src/code/pprint.lisp ===================================== @@ -1457,6 +1457,19 @@ When annotations are present, invoke them at the right positions." (declare (ignore noise)) (funcall (formatter "~:<~^~W~3I ~:_~W~1I~@{ ~:@_~W~}~:>") stream list)) + +(defun pprint-handler-case (stream list &rest noise) + (declare (ignore noise)) + ;; Like pprint-handler-bind, but each of the error clauses is + ;; printed with declarations and forms on a separate line, indented + ;; like a function body. The handler-case part, "~:<~^~W~3I + ;; ~:_~W~1I~@{ ~:@_...~:>" comes from pprint-handler-bind, but the + ;; last "~W" is replaced to print out the error clauses in the way + ;; we want. These are done with "~:<~W~^~3I ~:_~W~^~1I~@{ + ;; ~@:_~W~}~:>", taken from PPRINT-WITH-LIKE. + (funcall (formatter "~:<~^~W~3I ~:_~W~1I~@{ ~:@_~:<~W~^~3I ~:_~W~^~1I~@{ ~@:_~W~}~:>~}~:>") + stream list)) + (defun pprint-quote (stream list &rest noise) (declare (ignore noise)) @@ -2021,7 +2034,7 @@ When annotations are present, invoke them at the right positions." (ecase pprint-case) (etypecase pprint-typecase) (handler-bind pprint-handler-bind) - (handler-case pprint-handler-bind) + (handler-case pprint-handler-case) ;; Loop is handled by pprint-loop.lisp #+nil(loop pprint-loop) (multiple-value-bind pprint-multiple-value-bind) ===================================== src/compiler/float-tran.lisp ===================================== @@ -236,7 +236,7 @@ (frob %random-single-float single-float) (frob %random-double-float double-float)) -#-(or new-random random-mt19937 rand-xoroshiro) +#-(or new-random random-mt19937 random-xoroshiro) (deftransform random ((num &optional state) ((integer 1 #.random-fixnum-max) &optional *)) _N"use inline fixnum operations" @@ -259,7 +259,7 @@ '(values (truncate (%random-double-float (coerce num 'double-float) (or state *random-state*))))) -#+(or random-mt19937) +#+(or random-mt19937 random-xoroshiro) (deftransform random ((num &optional state) ((integer 1 #.(expt 2 32)) &optional *)) _N"use inline (unsigned-byte 32) operations" ===================================== src/general-info/release-21f.md ===================================== @@ -62,6 +62,9 @@ public domain. * ~~#278~~ Add some more debugging prints to gencgc * ~~#283~~ Add VOP for `integer-length` for `(unsigned-byte 32)` arg. * ~~#284~~ Microoptimize `signed-byte-32-int-len` VOP for x86. + * ~~#288~~ Re-enable `deftransform` for random integers. + * ~~#290~~ Pprint `with-float-traps-masked` better + * ~~#291~~ Pprint `handler-case` neatly. * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -19005,6 +19005,10 @@ msgstr "" msgid "use inline (unsigned-byte 32) operations" msgstr "" +#: src/compiler/float-tran.lisp +msgid "Shouldn't happen" +msgstr "" + #: src/compiler/float-tran.lisp msgid "Can't open-code float to rational comparison." msgstr "" ===================================== tests/pprint.lisp ===================================== @@ -26,3 +26,98 @@ (pprint '(ext:with-float-traps-enabled (:underflow) (print "Hello")) s)))) + +(define-test pprint.handler-case.1 + (:tag :issues) + ;; Just an expression + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition)) + s)))) + +(define-test pprint.handler-case.2 + (:tag :issues) + ;; One error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (WARNING NIL + \"Lots of smoke, but no fire.\"))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (warning () "Lots of smoke, but no fire.")) + s)))) + +(define-test pprint.handler-case.3 + (:tag :issues) + ;; More than one error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (WARNING NIL + \"Lots of smoke, but no fire.\") + ((OR ARITHMETIC-ERROR CONTROL-ERROR CELL-ERROR STREAM-ERROR) (CONDITION) + (FORMAT NIL \"~S looks especially bad.\" CONDITION)))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (warning () "Lots of smoke, but no fire.") + ((or arithmetic-error control-error cell-error stream-error) + (condition) + (format nil "~S looks especially bad." condition))) + s)))) + +(define-test pprint.handler-case.4 + (:tag :issues) + ;; An expression and a no-error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (:NO-ERROR NIL + (FORMAT NIL \"Nothing bad happened.\")))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (:no-error () + (format nil "Nothing bad happened."))) + s)))) + + +(define-test pprint.handler-case.5 + (:tag :issues) + ;; One error clause and a no-error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (WARNING NIL + \"Lots of smoke, but no fire.\") + (:NO-ERROR NIL + (FORMAT NIL \"Nothing bad happened.\")))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (warning () "Lots of smoke, but no fire.") + (:no-error () + (format nil "Nothing bad happened."))) + s)))) + +(define-test pprint.handler-case.6 + (:tag :issues) + ;; More than one error clause and a no-error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (WARNING NIL + \"Lots of smoke, but no fire.\") + ((OR ARITHMETIC-ERROR CONTROL-ERROR CELL-ERROR STREAM-ERROR) (CONDITION) + (FORMAT NIL \"~S looks especially bad.\" CONDITION)) + (:NO-ERROR NIL + (FORMAT NIL \"Nothing bad happened.\")))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (warning () "Lots of smoke, but no fire.") + ((or arithmetic-error control-error cell-error stream-error) + (condition) + (format nil "~S looks especially bad." condition)) + (:no-error () + (format nil "Nothing bad happened."))) + s)))) ===================================== tests/rng.lisp ===================================== @@ -82,3 +82,27 @@ (assert-equal result (multiple-value-list (64-bit-rng-state *test-state*))))) +;; Test that the deftransform for random integers is working. +(defun rng-int-trans (state) + (declare (type random-state state) + (optimize (speed 3))) + (random 100000 state)) + +(defun rng-int (n state) + (declare (type random-state state)) + (random n state)) + +(define-test deftransform-random-int + (:tag :issues) + ;; Using the same state, generate a random integer with RNG-INT. + ;; This is the expected value. The generate an integer with + ;; RNG-INT-TRANS. The compiler should have used a deftransform in + ;; this function. The values returned should be the same. + (let ((state (kernel::make-random-object :state (kernel::init-random-state 31415926535)))) + (dotimes (k 2) + (print state) + (assert-equal (rng-int 100000 (make-random-state state)) + (rng-int-trans (make-random-state state))) + ;; Generate a random number to change our state. + (random 100000 state)))) + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/047a0f088f75a6cb88e98e… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/047a0f088f75a6cb88e98e… 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] 2 commits: Add tests for the FP overflow restarts from the reader
by Raymond Toy (＠rtoy) 29 Mar '24

29 Mar '24

Raymond Toy pushed to branch issue-293-restart-on-reader-fp-overflow at cmucl / cmucl Commits: 142252fc by Raymond Toy at 2024-03-29T14:08:12-07:00 Add tests for the FP overflow restarts from the reader Verify that the two new restarts produce the correct values when selecting the "infinity" and "largest-float" restarts. - - - - - 9fe47ce1 by Raymond Toy at 2024-03-29T14:09:20-07:00 Update cmucl.pot for the new messages - - - - - 2 changed files: - src/i18n/locale/cmucl.pot - tests/float.lisp Changes: ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -8728,13 +8728,21 @@ msgid "Internal error in floating point reader." msgstr "" #: src/code/reader.lisp -msgid "Number not representable as a ~S: ~S" +msgid "~S overflow reading ~S" msgstr "" #: src/code/reader.lisp msgid "Underflow" msgstr "" +#: src/code/reader.lisp +msgid "Floating point underflow when reading ~S" +msgstr "" + +#: src/code/reader.lisp +msgid "Number not representable as a ~S: ~S" +msgstr "" + #: src/code/reader.lisp msgid "Invalid ratio: ~S/~S" msgstr "" ===================================== tests/float.lisp ===================================== @@ -212,3 +212,50 @@ ;; 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"))) + +(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/1a7b3a7ce614be51152e36… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1a7b3a7ce614be51152e36… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-293-restart-on-reader-fp-overflow
by Raymond Toy (＠rtoy) 29 Mar '24

29 Mar '24

Raymond Toy pushed new branch issue-293-restart-on-reader-fp-overflow at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-293-restart-on-read… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Update notes with fixed issues
by Raymond Toy (＠rtoy) 29 Mar '24

29 Mar '24

Raymond Toy pushed to branch master at cmucl / cmucl Commits: ca064da0 by Raymond Toy at 2024-03-29T08:56:28-07:00 Update notes with fixed issues Forgot to add #288, #290, and #291 to the list of fixed issues. - - - - - 1 changed file: - src/general-info/release-21f.md Changes: ===================================== src/general-info/release-21f.md ===================================== @@ -62,6 +62,9 @@ public domain. * ~~#278~~ Add some more debugging prints to gencgc * ~~#283~~ Add VOP for `integer-length` for `(unsigned-byte 32)` arg. * ~~#284~~ Microoptimize `signed-byte-32-int-len` VOP for x86. + * ~~#288~~ Re-enable `deftransform` for random integers. + * ~~#290~~ Pprint `with-float-traps-masked` better + * ~~#291~~ Pprint `handler-case` neatly. * 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/ca064da0edb5ba58d8bf4bc… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ca064da0edb5ba58d8bf4bc… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #291: pprint handler-case neatly
by Raymond Toy (＠rtoy) 29 Mar '24

29 Mar '24

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 3a206076 by Raymond Toy at 2024-03-29T15:43:02+00:00 Fix #291: pprint handler-case neatly - - - - - 7c6275a2 by Raymond Toy at 2024-03-29T15:43:03+00:00 Merge branch 'issue-291-pprint-handler-case' into 'master' Fix #291: pprint handler-case neatly Closes #291 See merge request cmucl/cmucl!200 - - - - - 3 changed files: - src/code/pprint.lisp - src/i18n/locale/cmucl.pot - tests/pprint.lisp Changes: ===================================== src/code/pprint.lisp ===================================== @@ -1457,6 +1457,19 @@ When annotations are present, invoke them at the right positions." (declare (ignore noise)) (funcall (formatter "~:<~^~W~3I ~:_~W~1I~@{ ~:@_~W~}~:>") stream list)) + +(defun pprint-handler-case (stream list &rest noise) + (declare (ignore noise)) + ;; Like pprint-handler-bind, but each of the error clauses is + ;; printed with declarations and forms on a separate line, indented + ;; like a function body. The handler-case part, "~:<~^~W~3I + ;; ~:_~W~1I~@{ ~:@_...~:>" comes from pprint-handler-bind, but the + ;; last "~W" is replaced to print out the error clauses in the way + ;; we want. These are done with "~:<~W~^~3I ~:_~W~^~1I~@{ + ;; ~@:_~W~}~:>", taken from PPRINT-WITH-LIKE. + (funcall (formatter "~:<~^~W~3I ~:_~W~1I~@{ ~:@_~:<~W~^~3I ~:_~W~^~1I~@{ ~@:_~W~}~:>~}~:>") + stream list)) + (defun pprint-quote (stream list &rest noise) (declare (ignore noise)) @@ -2021,7 +2034,7 @@ When annotations are present, invoke them at the right positions." (ecase pprint-case) (etypecase pprint-typecase) (handler-bind pprint-handler-bind) - (handler-case pprint-handler-bind) + (handler-case pprint-handler-case) ;; Loop is handled by pprint-loop.lisp #+nil(loop pprint-loop) (multiple-value-bind pprint-multiple-value-bind) ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -8731,6 +8731,10 @@ msgstr "" msgid "Number not representable as a ~S: ~S" msgstr "" +#: src/code/reader.lisp +msgid "Underflow" +msgstr "" + #: src/code/reader.lisp msgid "Invalid ratio: ~S/~S" msgstr "" ===================================== tests/pprint.lisp ===================================== @@ -26,3 +26,98 @@ (pprint '(ext:with-float-traps-enabled (:underflow) (print "Hello")) s)))) + +(define-test pprint.handler-case.1 + (:tag :issues) + ;; Just an expression + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition)) + s)))) + +(define-test pprint.handler-case.2 + (:tag :issues) + ;; One error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (WARNING NIL + \"Lots of smoke, but no fire.\"))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (warning () "Lots of smoke, but no fire.")) + s)))) + +(define-test pprint.handler-case.3 + (:tag :issues) + ;; More than one error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (WARNING NIL + \"Lots of smoke, but no fire.\") + ((OR ARITHMETIC-ERROR CONTROL-ERROR CELL-ERROR STREAM-ERROR) (CONDITION) + (FORMAT NIL \"~S looks especially bad.\" CONDITION)))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (warning () "Lots of smoke, but no fire.") + ((or arithmetic-error control-error cell-error stream-error) + (condition) + (format nil "~S looks especially bad." condition))) + s)))) + +(define-test pprint.handler-case.4 + (:tag :issues) + ;; An expression and a no-error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (:NO-ERROR NIL + (FORMAT NIL \"Nothing bad happened.\")))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (:no-error () + (format nil "Nothing bad happened."))) + s)))) + + +(define-test pprint.handler-case.5 + (:tag :issues) + ;; One error clause and a no-error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (WARNING NIL + \"Lots of smoke, but no fire.\") + (:NO-ERROR NIL + (FORMAT NIL \"Nothing bad happened.\")))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (warning () "Lots of smoke, but no fire.") + (:no-error () + (format nil "Nothing bad happened."))) + s)))) + +(define-test pprint.handler-case.6 + (:tag :issues) + ;; More than one error clause and a no-error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (WARNING NIL + \"Lots of smoke, but no fire.\") + ((OR ARITHMETIC-ERROR CONTROL-ERROR CELL-ERROR STREAM-ERROR) (CONDITION) + (FORMAT NIL \"~S looks especially bad.\" CONDITION)) + (:NO-ERROR NIL + (FORMAT NIL \"Nothing bad happened.\")))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (warning () "Lots of smoke, but no fire.") + ((or arithmetic-error control-error cell-error stream-error) + (condition) + (format nil "~S looks especially bad." condition)) + (:no-error () + (format nil "Nothing bad happened."))) + s)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1bc977276cfcbcf56e38bd… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1bc977276cfcbcf56e38bd… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-291-pprint-handler-case] Add a several smaller test cases for handler-case as requested
by Raymond Toy (＠rtoy) 29 Mar '24

29 Mar '24

Raymond Toy pushed to branch issue-291-pprint-handler-case at cmucl / cmucl Commits: ac5dde80 by Raymond Toy at 2024-03-29T08:25:47-07:00 Add a several smaller test cases for handler-case as requested - - - - - 1 changed file: - tests/pprint.lisp Changes: ===================================== tests/pprint.lisp ===================================== @@ -27,26 +27,97 @@ (print "Hello")) s)))) -(define-test pprint.handler-case +(define-test pprint.handler-case.1 (:tag :issues) + ;; Just an expression (assert-equal -" + " +(HANDLER-CASE (SIGNAL CONDITION))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition)) + s)))) + +(define-test pprint.handler-case.2 + (:tag :issues) + ;; One error clause + (assert-equal + " (HANDLER-CASE (SIGNAL CONDITION) (WARNING NIL - \"Lots of smoke, but no fire.\") - ((OR ARITHMETIC-ERROR CONTROL-ERROR CELL-ERROR STREAM-ERROR) (CONDITION) - (FORMAT NIL \"~S looks especially bad.\" CONDITION)) - (SERIOUS-CONDITION (CONDITION) - (FORMAT NIL \"~S looks serious.\" CONDITION)) - (CONDITION NIL - \"Hardly worth mentioning.\"))" + \"Lots of smoke, but no fire.\"))" (with-output-to-string (s) (pprint '(handler-case (signal condition) - (warning () "Lots of smoke, but no fire.") - ((or arithmetic-error control-error cell-error stream-error) - (condition) - (format nil "~S looks especially bad." condition)) - (serious-condition (condition) - (format nil "~S looks serious." condition)) - (condition () "Hardly worth mentioning.")) + (warning () "Lots of smoke, but no fire.")) s)))) + +(define-test pprint.handler-case.3 + (:tag :issues) + ;; More than one error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (WARNING NIL + \"Lots of smoke, but no fire.\") + ((OR ARITHMETIC-ERROR CONTROL-ERROR CELL-ERROR STREAM-ERROR) (CONDITION) + (FORMAT NIL \"~S looks especially bad.\" CONDITION)))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (warning () "Lots of smoke, but no fire.") + ((or arithmetic-error control-error cell-error stream-error) + (condition) + (format nil "~S looks especially bad." condition))) + s)))) + +(define-test pprint.handler-case.4 + (:tag :issues) + ;; An expression and a no-error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (:NO-ERROR NIL + (FORMAT NIL \"Nothing bad happened.\")))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (:no-error () + (format nil "Nothing bad happened."))) + s)))) + + +(define-test pprint.handler-case.5 + (:tag :issues) + ;; One error clause and a no-error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (WARNING NIL + \"Lots of smoke, but no fire.\") + (:NO-ERROR NIL + (FORMAT NIL \"Nothing bad happened.\")))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (warning () "Lots of smoke, but no fire.") + (:no-error () + (format nil "Nothing bad happened."))) + s)))) + +(define-test pprint.handler-case.6 + (:tag :issues) + ;; More than one error clause and a no-error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (WARNING NIL + \"Lots of smoke, but no fire.\") + ((OR ARITHMETIC-ERROR CONTROL-ERROR CELL-ERROR STREAM-ERROR) (CONDITION) + (FORMAT NIL \"~S looks especially bad.\" CONDITION)) + (:NO-ERROR NIL + (FORMAT NIL \"Nothing bad happened.\")))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (warning () "Lots of smoke, but no fire.") + ((or arithmetic-error control-error cell-error stream-error) + (condition) + (format nil "~S looks especially bad." condition)) + (:no-error () + (format nil "Nothing bad happened."))) + s)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ac5dde808d1f1332da7268d… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ac5dde808d1f1332da7268d… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-275b-signal-float-underflow] 6 commits: Signal reader-error on underflow instead of FP underflow.
by Raymond Toy (＠rtoy) 29 Mar '24

29 Mar '24

Raymond Toy pushed to branch issue-275b-signal-float-underflow at cmucl / cmucl Commits: ba400bf5 by Raymond Toy at 2024-03-29T07:11:07-07:00 Signal reader-error on underflow instead of FP underflow. The error message makes it clear we have a FP underflow like so: ``` * 1d-308 Reader error on #<Two-Way Stream, Input = #<Synonym Stream to SYSTEM:*STDIN*>, Output = #<Synonym Stream to SYSTEM:*STDOUT*>>: Underflow when reading "1d-308" [Condition of type READER-ERROR] Restarts: 0: [CONTINUE] Return 0.0d0 1: [ABORT ] Return to Top-Level. ``` - - - - - f3d64ced by Raymond Toy at 2024-03-29T07:16:02-07:00 Change message to mention floating point Instead of just saying "Underflow when reading...", say "Floating point underflow when reading..." to make it a bit clearer what happened. - - - - - 4ba5145d by Raymond Toy at 2024-03-29T07:20:32-07:00 Undo some space changes and correct a comment. Undo some tab vs space changes at the end of make-float-aux. The comment about double-float exponent range was in the wrong place so put it in the right place. - - - - - e1a35617 by Raymond Toy at 2024-03-29T07:55:55-07:00 Test FP underflow signals reader-error We now signal a `reader-error` on a FP underflow. Thus, test that we get a reader error. Also test that the message says we got an underflow. This is to verify that we tell the user that it's an underflow and not some other reader error. - - - - - 031b5ce0 by Raymond Toy at 2024-03-29T07:58:47-07:00 Update pot file for updated message string. - - - - - 047a0f08 by Raymond Toy at 2024-03-29T08:00:08-07:00 Add comment on where the expected string comes from. - - - - - 3 changed files: - src/code/reader.lisp - src/i18n/locale/cmucl.pot - tests/float.lisp Changes: ===================================== src/code/reader.lisp ===================================== @@ -1855,12 +1855,12 @@ the end of the stream." 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))))) - ;; 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. @@ -1879,18 +1879,19 @@ the end of the stream." (error _"Underflow")) result) (floating-point-underflow () - ;; Resignal the underflow, but allow the user to continue with + ;; Resignal a reader error, but allow the user to continue with ;; 0. (let ((zero (coerce 0 float-format))) (restart-case - (error 'floating-point-underflow) + (%reader-error stream _"Floating point underflow when reading ~S" + (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))))) + (%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 ===================================== @@ -8731,6 +8731,14 @@ msgstr "" msgid "Number not representable as a ~S: ~S" msgstr "" +#: src/code/reader.lisp +msgid "Underflow" +msgstr "" + +#: src/code/reader.lisp +msgid "Floating point underflow when reading ~S" +msgstr "" + #: src/code/reader.lisp msgid "Invalid ratio: ~S/~S" msgstr "" ===================================== tests/float.lisp ===================================== @@ -217,12 +217,31 @@ (:tag :issues) (lisp::with-float-traps-enabled (:underflow) ;; A denormal - (assert-error 'floating-point-underflow + (assert-error 'reader-error (read-from-string "1e-40")) - (assert-error 'floating-point-underflow + (assert-error 'reader-error (read-from-string (format nil "~A" least-positive-single-float))) ;; The same for double-floats - (assert-error 'floating-point-underflow + (assert-error 'reader-error (read-from-string "1d-308")) - (assert-error 'floating-point-underflow + (assert-error 'reader-error (read-from-string (format nil "~A" least-positive-double-float))))) + +(define-test reader.float-underflow + (:tag :issues) + (lisp::with-float-traps-enabled (:underflow) + ;; The expected string comes from make-float-aux. + (let ((expected "Floating point underflow when reading ~S")) + (flet ((test-reader-underflow (string) + ;; Test that the we got a reader-error when a number + ;; would underflow and that the message says we got an + ;; underflow. + (let ((condition (nth-value 1 (ignore-errors (read-from-string string))))) + (assert-equal 'reader-error (type-of condition)) + (assert-equal expected (lisp::reader-error-format-control condition))))) + ;; Underflow single-floats + (test-reader-underflow "1e-40") + (test-reader-underflow (format nil "~A" least-positive-single-float)) + ;; Underflow double-floats + (test-reader-underflow "1d-308") + (test-reader-underflow (format nil "~A" least-positive-double-float)))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/bb8eb44c424cc0ab2dba0e… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/bb8eb44c424cc0ab2dba0e… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #288: Re-enable deftransform for random integers
by Raymond Toy (＠rtoy) 29 Mar '24

29 Mar '24

Raymond Toy pushed to branch master at cmucl / cmucl Commits: f6daa48c by Raymond Toy at 2024-03-29T13:17:17+00:00 Fix #288: Re-enable deftransform for random integers - - - - - 1bc97727 by Raymond Toy at 2024-03-29T13:18:30+00:00 Merge branch 'issue-288-re-enable-deftransform-random-int' into 'master' Fix #288: Re-enable deftransform for random integers Closes #288 See merge request cmucl/cmucl!198 - - - - - 4 changed files: - bin/run-ansi-tests.sh - src/compiler/float-tran.lisp - src/i18n/locale/cmucl.pot - tests/rng.lisp Changes: ===================================== bin/run-ansi-tests.sh ===================================== @@ -41,7 +41,7 @@ else fi cd ../ansi-test -git checkout cmucl-expected-failures +git checkout issue-288-new-failures make LISP="$LISP batch -noinit -nositeinit" # There should be no unexpected successes or failures; check these separately ===================================== src/compiler/float-tran.lisp ===================================== @@ -236,7 +236,7 @@ (frob %random-single-float single-float) (frob %random-double-float double-float)) -#-(or new-random random-mt19937 rand-xoroshiro) +#-(or new-random random-mt19937 random-xoroshiro) (deftransform random ((num &optional state) ((integer 1 #.random-fixnum-max) &optional *)) _N"use inline fixnum operations" @@ -259,7 +259,7 @@ '(values (truncate (%random-double-float (coerce num 'double-float) (or state *random-state*))))) -#+(or random-mt19937) +#+(or random-mt19937 random-xoroshiro) (deftransform random ((num &optional state) ((integer 1 #.(expt 2 32)) &optional *)) _N"use inline (unsigned-byte 32) operations" ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -18997,6 +18997,10 @@ msgstr "" msgid "use inline (unsigned-byte 32) operations" msgstr "" +#: src/compiler/float-tran.lisp +msgid "Shouldn't happen" +msgstr "" + #: src/compiler/float-tran.lisp msgid "Can't open-code float to rational comparison." msgstr "" ===================================== tests/rng.lisp ===================================== @@ -82,3 +82,27 @@ (assert-equal result (multiple-value-list (64-bit-rng-state *test-state*))))) +;; Test that the deftransform for random integers is working. +(defun rng-int-trans (state) + (declare (type random-state state) + (optimize (speed 3))) + (random 100000 state)) + +(defun rng-int (n state) + (declare (type random-state state)) + (random n state)) + +(define-test deftransform-random-int + (:tag :issues) + ;; Using the same state, generate a random integer with RNG-INT. + ;; This is the expected value. The generate an integer with + ;; RNG-INT-TRANS. The compiler should have used a deftransform in + ;; this function. The values returned should be the same. + (let ((state (kernel::make-random-object :state (kernel::init-random-state 31415926535)))) + (dotimes (k 2) + (print state) + (assert-equal (rng-int 100000 (make-random-state state)) + (rng-int-trans (make-random-state state))) + ;; Generate a random number to change our state. + (random 100000 state)))) + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/8ed3d1d3bf250cfe50691e… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/8ed3d1d3bf250cfe50691e… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

cmucl-cvs March 2024