cmucl-cvs

cmucl-cvs@common-lisp.net

2904 discussions

[Git][cmucl/cmucl][issue-297-pprint-assemble] 2 commits: Add a test for the pprinter for new-assem:assemble
by Raymond Toy (＠rtoy) 02 Apr '24

02 Apr '24

Raymond Toy pushed to branch issue-297-pprint-assemble at cmucl / cmucl Commits: a79e94ac by Raymond Toy at 2024-04-01T18:40:03-07:00 Add a test for the pprinter for new-assem:assemble - - - - - e9eed900 by Raymond Toy at 2024-04-01T18:40:20-07:00 Update release notes for issue #297 - - - - - 2 changed files: - src/general-info/release-21f.md - tests/pprint.lisp 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. + * ~~#297~~ Pprint `assemble` with less indentation. * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== tests/pprint.lisp ===================================== @@ -121,3 +121,16 @@ (:no-error () (format nil "Nothing bad happened."))) s)))) + +(define-test pprint.assemble + (:tag :issues) + (assert-equal + " +(NEW-ASSEM:ASSEMBLE (*CODE-SEGMENT* 'XOROSHIRO-UPDATE) + XOROSHIRO-UPDATE + (PUSH (CONS 'XOROSHIRO-UPDATE XOROSHIRO-UPDATE) C::*ASSEMBLER-ROUTINES*))" + (with-output-to-string (s) + (pprint '(new-assem:assemble (*code-segment* 'xoroshiro-update) + xoroshiro-update + (push (cons 'xoroshiro-update xoroshiro-update) c::*assembler-routines*)) + s)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/cf6803a34ed3ec008fb0c7… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/cf6803a34ed3ec008fb0c7… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-297-pprint-assemble
by Raymond Toy (＠rtoy) 02 Apr '24

02 Apr '24

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

1 0

[Git][cmucl/cmucl][issue-294-xoroshiro-lisp-assem-routine] Change the registers used for state, r1, and r0
by Raymond Toy (＠rtoy) 02 Apr '24

02 Apr '24

Raymond Toy pushed to branch issue-294-xoroshiro-lisp-assem-routine at cmucl / cmucl Commits: 1ec83248 by Raymond Toy at 2024-04-01T17:28:35-07:00 Change the registers used for state, r1, and r0 These registers show that in `xoroshiro-gen`, all the registers are in the right place so we don't need to do any additional moves. This is a nice micro-optimization. - - - - - 1 changed file: - src/assembly/x86/arith.lisp Changes: ===================================== src/assembly/x86/arith.lisp ===================================== @@ -447,8 +447,8 @@ (: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) + ((: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) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/1ec832483118f863620fd90… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/1ec832483118f863620fd90… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[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

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

cmucl-cvs