cmucl-cvs

cmucl-cvs@common-lisp.net

2904 discussions

[Git][cmucl/cmucl][issue-276-xoroshiro128starstar] 2 commits: Remove old implementation of xoroshiro-next
by Raymond Toy (＠rtoy) 14 Feb '24

14 Feb '24

Raymond Toy pushed to branch issue-276-xoroshiro128starstar at cmucl / cmucl Commits: 31b7ffd9 by Raymond Toy at 2024-02-13T19:57:48-08:00 Remove old implementation of xoroshiro-next This was for xoroshiro128+, and we're using xoroshiro128** now. - - - - - f452e5d2 by Raymond Toy at 2024-02-13T19:58:26-08:00 Update release notes Make an explicit note that we've changed the RNG generator. - - - - - 2 changed files: - src/compiler/x86/arith.lisp - src/general-info/release-21f.md Changes: ===================================== src/compiler/x86/arith.lisp ===================================== @@ -1678,79 +1678,6 @@ (in-package "VM") -#|| -#+random-xoroshiro -(progn -(defknown xoroshiro-next ((simple-array double-float (2))) - (values (unsigned-byte 32) (unsigned-byte 32)) - (movable)) - -(define-vop (xoroshiro-next) - (:policy :fast-safe) - (:translate xoroshiro-next) - (:args (state :scs (descriptor-reg) :to (:result 3))) - (:arg-types simple-array-double-float) - (:results (r1 :scs (unsigned-reg)) - (r0 :scs (unsigned-reg))) - (:result-types unsigned-num unsigned-num) - (:temporary (:sc double-reg) s0) - (:temporary (:sc double-reg) s1) - (:temporary (:sc double-reg) t0) - (:generator 10 - ;; 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))) - ;; 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))) - ;; Compute result = s0 + s1 - (inst movapd t0 s0) - (inst paddq t0 s1) - ;; Save the 64-bit result as two 32-bit results - (inst movd r0 t0) - (inst psrlq t0 32) - (inst movd r1 t0) - - ;; s1 = s1 ^ s0 - (inst xorpd s1 s0) - - ;; s0 = rotl(s0,55) = s0 << 55 | s0 >> 9 - (inst movapd t0 s0) - (inst psllq s0 55) ; s0 = s0 << 55 - (inst psrlq t0 9) ; t0 = s0 >> 9 - (inst orpd s0 t0) ; s0 = rotl(s0, 55) - - (inst movapd t0 s1) - (inst xorpd s0 s1) ; s0 = s0 ^ s1 - (inst psllq t0 14) ; t0 = s1 << 14 - (inst xorpd s0 t0) ; s0 = s0 ^ t0 - (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, 36) = s1 << 36 | s1 >> 28, using t0 as temp - (inst movapd t0 s1) - (inst psllq s1 36) - (inst psrlq t0 28) - (inst orpd s1 t0) - - (inst movsd (make-ea :dword :base state - :disp (- (+ (* vm:vector-data-offset - vm:word-bytes) - (* 8 1)) - vm:other-pointer-type)) - s1))) -) -||# #+random-xoroshiro (progn (defknown xoroshiro-next ((simple-array double-float (2))) @@ -1790,6 +1717,8 @@ ;; ;; return result; ;; } + + ;; s0 = state[0] (inst movsd s0 (make-ea :dword :base state :disp (- (+ (* vm:vector-data-offset vm:word-bytes) @@ -1819,6 +1748,7 @@ (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) ===================================== src/general-info/release-21f.md ===================================== @@ -23,6 +23,9 @@ public domain. * Add support for Gray streams implementation of file-length via `ext:stream-file-length` generic function. * Changes: + * The RNG has changed from an old version of xoroshiro128+ to + xoroshiro128**. This means sequences of random numbers will be + different from before. See ~~#276~~. * ANSI compliance fixes: * Bug fixes: * Gitlab tickets: @@ -40,6 +43,7 @@ public domain. * ~~#258~~ Remove `get-page-size` from linux-os.lisp * ~~#269~~ Add function to get user's home directory * ~~#266~~ Support "~user" in namestrings + * ~~#276~~ Implement xoroshiro128** generator for x86 * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1b1c57ad6e23556f6cf9ba… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1b1c57ad6e23556f6cf9ba… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-276-xoroshiro128starstar] 2 commits: Add some comments
by Raymond Toy (＠rtoy) 14 Feb '24

14 Feb '24

Raymond Toy pushed to branch issue-276-xoroshiro128starstar at cmucl / cmucl Commits: 52a08e62 by Raymond Toy at 2024-02-13T18:52:07-08:00 Add some comments For x86, we've switched to xoroshiro128**. But sparc still uses xoroshiro128+ which, of course, has different results. - - - - - 1b1c57ad by Raymond Toy at 2024-02-13T18:57:20-08:00 Add test program for generating reference results This test program generates reference outputs for the xoroshiro128** generator to be used in the rng unit test. - - - - - 2 changed files: - tests/rng.lisp - + tests/rng/test-128-star-star.c Changes: ===================================== tests/rng.lisp ===================================== @@ -48,28 +48,31 @@ (assert-equal 0 (kernel::random-state-rand *test-state*)) (assert-equal nil (kernel::random-state-cached-p *test-state*)) - (dolist (item #-x86 - '((#x18d5f05c086e0086 (#x228f4926843b364d #x74dfe78e715c81be)) - (#x976f30b4f597b80b (#x5b6bd4558bd96a68 #x567b7f35650aea8f)) - (#xb1e7538af0e454f7 (#x13e5253e242fac52 #xed380e70d10ab60e)) - (#x011d33aef53a6260 (#x9d0764952ca00d8a #x5251a5cfedd2b4ef)) - (#xef590a651a72c279 (#xba4ef2b425bda963 #x172b965cf56c15ac)) - (#xd17a89111b29bf0f (#x458277a5e5f0a21b #xd1bccfad6564e8d)) - (#x529e44a0bc46f0a8 (#x2becb68d5a7194c7 #x3a6ec964899bb5f3)) - (#x665b7ff1e40d4aba (#xededfd481d0a19fe #x3ea213411827fe9d)) - (#x2c9010893532189b (#xd7bb59bcd8fba26f #x52de763d34fee090)) - (#x2a99cffa0dfa82ff (#xf96e892c62d6ff2e #xc0542ff85652f81e))) - #+x86 - '((#x41db14eb317141fe (#x16dfbf3d760d0fa4 #xe9bfcf1ce2b9037c)) - (#xaa4ee6e025dfec01 (#xb237e99a3c7ad367 #x96819b1fec0e0432)) - (#xea080e50cb948fa5 (#xcc0fd8226093e0bc #x0e9aeaa496ce50ba)) - (#x647f057cff408a6e (#xd273573bfa97bfde #xcbb600d852a650de)) - (#x232ac586565d037e (#x75dc686d99e39c57 #x063de00338aafc75)) - (#xdf2da206813da6d6 (#x9616cabb961ebc4a #x292c044e7c310dd4)) - (#x00d17cb1b38c852f (#xca593a661127a754 #x45f633d7e759debd)) - (#xd7a1f881fc34e641 (#xe00fd868db5d20d3 #xcfcf3d31f5e1363e)) - (#x64853747af628d30 (#xa24296c5ebb11935 #xd782dda5f81cab25)) - (#xda40653710b7293d (#xfb4be9d4941ff086 #x75b6420eb8096c02)))) + (dolist (item + ;; Results for xoroshiro128+ + #-x86 + '((#x18d5f05c086e0086 (#x228f4926843b364d #x74dfe78e715c81be)) + (#x976f30b4f597b80b (#x5b6bd4558bd96a68 #x567b7f35650aea8f)) + (#xb1e7538af0e454f7 (#x13e5253e242fac52 #xed380e70d10ab60e)) + (#x011d33aef53a6260 (#x9d0764952ca00d8a #x5251a5cfedd2b4ef)) + (#xef590a651a72c279 (#xba4ef2b425bda963 #x172b965cf56c15ac)) + (#xd17a89111b29bf0f (#x458277a5e5f0a21b #xd1bccfad6564e8d)) + (#x529e44a0bc46f0a8 (#x2becb68d5a7194c7 #x3a6ec964899bb5f3)) + (#x665b7ff1e40d4aba (#xededfd481d0a19fe #x3ea213411827fe9d)) + (#x2c9010893532189b (#xd7bb59bcd8fba26f #x52de763d34fee090)) + (#x2a99cffa0dfa82ff (#xf96e892c62d6ff2e #xc0542ff85652f81e))) + ;; Results for xoroshiro128** + #+x86 + '((#x41db14eb317141fe (#x16dfbf3d760d0fa4 #xe9bfcf1ce2b9037c)) + (#xaa4ee6e025dfec01 (#xb237e99a3c7ad367 #x96819b1fec0e0432)) + (#xea080e50cb948fa5 (#xcc0fd8226093e0bc #x0e9aeaa496ce50ba)) + (#x647f057cff408a6e (#xd273573bfa97bfde #xcbb600d852a650de)) + (#x232ac586565d037e (#x75dc686d99e39c57 #x063de00338aafc75)) + (#xdf2da206813da6d6 (#x9616cabb961ebc4a #x292c044e7c310dd4)) + (#x00d17cb1b38c852f (#xca593a661127a754 #x45f633d7e759debd)) + (#xd7a1f881fc34e641 (#xe00fd868db5d20d3 #xcfcf3d31f5e1363e)) + (#x64853747af628d30 (#xa24296c5ebb11935 #xd782dda5f81cab25)) + (#xda40653710b7293d (#xfb4be9d4941ff086 #x75b6420eb8096c02)))) (destructuring-bind (value state) item (assert-equal value (64-bit-value *test-state*)) @@ -82,10 +85,12 @@ :rand 0 :cached-p nil)) (dolist (result + ;; Results for xoroshiro128+ jump function #-x86 '((#x291ddf8e6f6a7b67 #x1f9018a12f9e031f) (#x88a7aa12158558d0 #xe264d785ab1472d9) (#x207e16f73c51e7ba #x999c8a0a9a8d87c0) (#x28f8959d3bcf5ff1 #x38091e563ab6eb98)) + ;; Results for xoroshiro128** jump function #+x86 '((#x19a22191480b0a4e #x43b3d7ee592dd4cf) (#x76cb87035d0b6e99 #xb6827bcf2ef8267c) (#x5125201dbdf76860 #x8984c075043869e2) ===================================== tests/rng/test-128-star-star.c ===================================== @@ -0,0 +1,143 @@ +/* Written in 2018 by David Blackman and Sebastiano Vigna (vigna(a)acm.org) + +To the extent possible under law, the author has dedicated all copyright +and related and neighboring rights to this software to the public domain +worldwide. This software is distributed without any warranty. + +See <http://creativecommons.org/publicdomain/zero/1.0/>. */ + +#include <stdint.h> + +/* This is xoroshiro128** 1.0, one of our all-purpose, rock-solid, + small-state generators. It is extremely (sub-ns) fast and it passes all + tests we are aware of, but its state space is large enough only for + mild parallelism. + + For generating just floating-point numbers, xoroshiro128+ is even + faster (but it has a very mild bias, see notes in the comments). + + The state must be seeded so that it is not everywhere zero. If you have + a 64-bit seed, we suggest to seed a splitmix64 generator and use its + output to fill s. */ + + +static inline uint64_t rotl(const uint64_t x, int k) { + return (x << k) | (x >> (64 - k)); +} + + +static uint64_t s[2]; + +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; +} + + +/* This is the jump function for the generator. It is equivalent + to 2^64 calls to next(); it can be used to generate 2^64 + non-overlapping subsequences for parallel computations. */ + +void jump(void) { + static const uint64_t JUMP[] = { 0xdf900294d8f554a5, 0x170865df4b3201fc }; + + uint64_t s0 = 0; + uint64_t s1 = 0; + for(int i = 0; i < sizeof JUMP / sizeof *JUMP; i++) + for(int b = 0; b < 64; b++) { + if (JUMP[i] & UINT64_C(1) << b) { + s0 ^= s[0]; + s1 ^= s[1]; + } + next(); + } + + s[0] = s0; + s[1] = s1; +} + + +/* This is the long-jump function for the generator. It is equivalent to + 2^96 calls to next(); it can be used to generate 2^32 starting points, + from each of which jump() will generate 2^32 non-overlapping + subsequences for parallel distributed computations. */ + +void long_jump(void) { + static const uint64_t LONG_JUMP[] = { 0xd2a98b26625eee7b, 0xdddf9b1090aa7ac1 }; + + uint64_t s0 = 0; + uint64_t s1 = 0; + for(int i = 0; i < sizeof LONG_JUMP / sizeof *LONG_JUMP; i++) + for(int b = 0; b < 64; b++) { + if (LONG_JUMP[i] & UINT64_C(1) << b) { + s0 ^= s[0]; + s1 ^= s[1]; + } + next(); + } + + s[0] = s0; + s[1] = s1; +} + +/*********************************************************************/ + +#include <stdio.h> + +/* + * Print out the first 10 random numbers from the generator. This is + * used for the expected results in the rng unit test. + */ +void +test_rng() +{ + int k; + uint64_t r; + + + s[0] = 0x38f1dc39d1906b6full; + s[1] = 0xdfe4142236dd9517ull; + + printf(";; First 10 outputs\n"); + + for (k = 0; k < 10; ++k) { + r = next(); + printf("%2d: #x%016llx (#x%016llx #x%016llx)\n", k, r, s[0], s[1]); + } +} + +/* + * Print out the first 4 states from jumping generator by 2^64 steps. + * This is used for the expected results in the rng unit test. + */ +void +test_jump() +{ + int k; + + s[0] = 0x38f1dc39d1906b6full; + s[1] = 0xdfe4142236dd9517ull; + + printf(";; First 4 jumps\n"); + for (k = 0; k < 4; ++k) { + jump(); + printf("%2d: #x%016llx #x%016llx\n", k, s[0], s[1]); + } +} + + +int +main() +{ + test_rng(); + test_jump(); + + return 0; +} View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/3914424237eb1ad708c7da… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/3914424237eb1ad708c7da… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-276-xoroshiro128starstar] Implement random-state-jump for xoroshiro128**
by Raymond Toy (＠rtoy) 14 Feb '24

14 Feb '24

Raymond Toy pushed to branch issue-276-xoroshiro128starstar at cmucl / cmucl Commits: 39144242 by Raymond Toy at 2024-02-13T18:47:58-08:00 Implement random-state-jump for xoroshiro128** Update the test for the new jump function. - - - - - 3 changed files: - src/code/rand-xoroshiro.lisp - src/i18n/locale/cmucl.pot - tests/rng.lisp Changes: ===================================== src/code/rand-xoroshiro.lisp ===================================== @@ -496,6 +496,7 @@ ;; Jump function for the generator. See the jump function in ;; http://xoroshiro.di.unimi.it/xoroshiro128plus.c +#-x86 (defun random-state-jump (&optional (rng-state *random-state*)) _N"Jump the RNG-STATE. This is equivalent to 2^64 calls to the xoroshiro128+ generator. It can be used to generate 2^64 @@ -535,3 +536,44 @@ (setf (aref state 0) (convert s0-1 s0-0)) (setf (aref state 1) (convert s1-1 s1-0))) rng-state)) + +#+x86 +(defun random-state-jump (&optional (rng-state *random-state*)) + _N"Jump the RNG-STATE. This is equivalent to 2^64 calls to the + xoroshiro128** generator. It can be used to generate 2^64 + non-overlapping subsequences for parallel computations." + (declare (type random-state rng-state)) + (let ((state (random-state-state rng-state)) + (s0-0 0) + (s0-1 0) + (s1-0 0) + (s1-1 0)) + (declare (type (unsigned-byte 32) s0-0 s0-1 s1-0 s1-1) + (optimize (speed 3) (safety 0))) + ;; The constants are #xdf900294d8f554a5 and #x170865df4b3201fc, + ;; and we process these numbers starting from the LSB. We want ot + ;; process these in 32-bit chunks, so word-reverse the constants. + (dolist (jump '(#xdf900294d8f554a5 #x170865df4b3201fc)) + (declare (type (unsigned-byte 64) jump)) + (dotimes (b 64) + (declare (fixnum b)) + (when (logbitp b jump) + (multiple-value-bind (x1 x0) + (kernel:double-float-bits (aref state 0)) + (setf s0-1 (logxor s0-1 (ldb (byte 32 0) x1)) + s0-0 (logxor s0-0 x0))) + + (multiple-value-bind (x1 x0) + (kernel:double-float-bits (aref state 1)) + (setf s1-1 (logxor s1-1 (ldb (byte 32 0) x1)) + s1-0 (logxor s1-0 x0)))) + (xoroshiro-gen state))) + + (flet ((convert (x1 x0) + (declare (type (unsigned-byte 32) x1 x0)) + (kernel:make-double-float + (if (< x1 #x80000000) x1 (- x1 #x100000000)) + x0))) + (setf (aref state 0) (convert s0-1 s0-0)) + (setf (aref state 1) (convert s1-1 s1-0))) + rng-state)) ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -12237,6 +12237,13 @@ msgid "" " non-overlapping subsequences for parallel computations." msgstr "" +#: src/code/rand-xoroshiro.lisp +msgid "" +"Jump the RNG-STATE. This is equivalent to 2^64 calls to the\n" +" xoroshiro128** generator. It can be used to generate 2^64\n" +" non-overlapping subsequences for parallel computations." +msgstr "" + #: src/code/ntrace.lisp msgid "" "This is bound to the returned values when evaluating :BREAK-AFTER and\n" ===================================== tests/rng.lisp ===================================== @@ -81,10 +81,16 @@ (kernel::make-random-object :state (kernel::init-random-state #x12345678) :rand 0 :cached-p nil)) - (dolist (result '((#x291ddf8e6f6a7b67 #x1f9018a12f9e031f) - (#x88a7aa12158558d0 #xe264d785ab1472d9) - (#x207e16f73c51e7ba #x999c8a0a9a8d87c0) - (#x28f8959d3bcf5ff1 #x38091e563ab6eb98))) + (dolist (result + #-x86 '((#x291ddf8e6f6a7b67 #x1f9018a12f9e031f) + (#x88a7aa12158558d0 #xe264d785ab1472d9) + (#x207e16f73c51e7ba #x999c8a0a9a8d87c0) + (#x28f8959d3bcf5ff1 #x38091e563ab6eb98)) + #+x86 '((#x19a22191480b0a4e #x43b3d7ee592dd4cf) + (#x76cb87035d0b6e99 #xb6827bcf2ef8267c) + (#x5125201dbdf76860 #x8984c075043869e2) + (#x2c06f0667255309f #xa48cbe2e60fc1d65) + )) (kernel:random-state-jump *test-state*) (assert-equal result (multiple-value-list (64-bit-rng-state *test-state*))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/3914424237eb1ad708c7da5… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/3914424237eb1ad708c7da5… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-276-xoroshiro128starstar
by Raymond Toy (＠rtoy) 13 Feb '24

13 Feb '24

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

1 0

[Git][cmucl/cmucl][issue-277-float-ratio-float-least-positive-float] Disable FP underflow before running tests
by Raymond Toy (＠rtoy) 11 Feb '24

11 Feb '24

Raymond Toy pushed to branch issue-277-float-ratio-float-least-positive-float at cmucl / cmucl Commits: 6aec95c6 by Raymond Toy at 2024-02-11T11:33:57-08:00 Disable FP underflow before running tests These small numbers are new the least floats, which would signal an underflow. Make sure we disable the FP underflow trap. - - - - - 1 changed file: - tests/float.lisp Changes: ===================================== tests/float.lisp ===================================== @@ -142,20 +142,22 @@ ;; some rationals from 7/10*10^-45 to 1.41*10^-45 to make sure they ;; return 0 or least-positive-single-float (let ((expo (expt 10 -45))) - ;; 7/10*10^-45 is just under halfway between 0 and least-positive, - ;; so the answer is 0. - (assert-equal 0f0 (kernel::float-ratio-float (* 7/10 expo) 'single-float)) - - ;; These are all more than half way to - ;; least-positive-single-float, so they should return that. - (assert-equal least-positive-single-float - (kernel::float-ratio-float (* 8/10 expo) 'single-float)) - (assert-equal least-positive-single-float - (kernel::float-ratio-float (* 1 expo) 'single-float)) - (assert-equal least-positive-single-float - (kernel::float-ratio-float (* 14/10 expo) 'single-float)) - (assert-equal least-positive-single-float - (kernel::float-ratio-float (* 2 expo) 'single-float)))) + ;; Need to make sure underflows are masked. + (kernel::with-float-traps-masked (:underflow) + ;; 7/10*10^-45 is just under halfway between 0 and least-positive, + ;; so the answer is 0. + (assert-equal 0f0 (kernel::float-ratio-float (* 7/10 expo) 'single-float)) + + ;; These are all more than half way to + ;; least-positive-single-float, so they should return that. + (assert-equal least-positive-single-float + (kernel::float-ratio-float (* 8/10 expo) 'single-float)) + (assert-equal least-positive-single-float + (kernel::float-ratio-float (* 1 expo) 'single-float)) + (assert-equal least-positive-single-float + (kernel::float-ratio-float (* 14/10 expo) 'single-float)) + (assert-equal least-positive-single-float + (kernel::float-ratio-float (* 2 expo) 'single-float))))) (define-test float-ratio.double (:tag :issues) @@ -163,18 +165,20 @@ ;; test with some rationals from about 2*10^-324 to 4.94*10^-324 to make ;; sure they return 0 or least-positive-double-float (let ((expo (expt 10 -324))) - ;; 247/100*10^-45 is just under halfway between 0 and least-positive, - ;; so the answer is 0. - (assert-equal 0d0 (kernel::float-ratio-float (* 247/100 expo) 'double-float)) - - ;; These are all more than half way to - ;; least-positive-double-float, so they should return that. - (assert-equal least-positive-double-float - (kernel::float-ratio-float (* 248/100 expo) 'double-float)) - (assert-equal least-positive-double-float - (kernel::float-ratio-float (* 4 expo) 'double-float)) - (assert-equal least-positive-double-float - (kernel::float-ratio-float (* 494/100 expo) 'double-float)) - (assert-equal least-positive-double-float - (kernel::float-ratio-float (* 988/100 expo) 'double-float)))) + ;; Need to make sure underflows are masked. + (kernel::with-float-traps-masked (:underflow) + ;; 247/100*10^-324 is just under halfway between 0 and least-positive, + ;; so the answer is 0. + (assert-equal 0d0 (kernel::float-ratio-float (* 247/100 expo) 'double-float)) + + ;; These are all more than half way to + ;; least-positive-double-float, so they should return that. + (assert-equal least-positive-double-float + (kernel::float-ratio-float (* 248/100 expo) 'double-float)) + (assert-equal least-positive-double-float + (kernel::float-ratio-float (* 4 expo) 'double-float)) + (assert-equal least-positive-double-float + (kernel::float-ratio-float (* 494/100 expo) 'double-float)) + (assert-equal least-positive-double-float + (kernel::float-ratio-float (* 988/100 expo) 'double-float))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6aec95c6d40e6e83bfcb1b2… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6aec95c6d40e6e83bfcb1b2… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-274-make-float-of-huge-numbers] Use integer-length instead of log2
by Raymond Toy (＠rtoy) 09 Feb '24

09 Feb '24

Raymond Toy pushed to branch issue-274-make-float-of-huge-numbers at cmucl / cmucl Commits: 6bc0a576 by Raymond Toy at 2024-02-09T14:17:52-08:00 Use integer-length instead of log2 For positive integers, `integer-length` is close enough to `log2` for what we want; we only need an approximate value for log2(x) to know if x is too small or too large to fit in a float. This should make things a bit faster so this change has less of an impact on the speed of reading floats. - - - - - 1 changed file: - src/code/reader.lisp Changes: ===================================== src/code/reader.lisp ===================================== @@ -1833,25 +1833,31 @@ the end of the stream." ;; super accurate with the limits. The rest of the code will handle ;; it correctly, even if we're too small or too large. (unless (zerop number) - (let ((log2-num (+ (kernel::log2 (float (/ number divisor) 1d0)) - (* exponent #.(kernel::log2 10d0))))) - (multiple-value-bind (log2-low log2-high) - (ecase float-format - ((short-float single-float) - ;; Single-float exponents range is -149 to 127 - (values (* 2 -149) (* 2 127))) - ((double-float long-float - #+double-double kernel:double-double-float) - ;; Double-float exponent range is -1074 to -1023 - (values (* 2 -1074) (* 2 1023)))) - (when (< log2-num log2-low) - ;; If the number is too small, just return 0. - (return-from make-float-aux (coerce 0 float-format))) + (flet ((fast-log2 (n) + ;; For an integer, the integer-length is close enough to + ;; the log2 of the number. + (integer-length n))) + ;; log2(x) = exponent*log2(10) + log2(number)-log2(divisor) + (let ((log2-num (+ (* exponent #.(kernel::log2 10d0)) + (fast-log2 number) + (- (fast-log2 divisor))))) + (multiple-value-bind (log2-low log2-high) + (ecase float-format + ((short-float single-float) + ;; Single-float exponents range is -149 to 127 + (values (* 2 -149) (* 2 127))) + ((double-float long-float + #+double-double kernel:double-double-float) + ;; Double-float exponent range is -1074 to -1023 + (values (* 2 -1074) (* 2 1023)))) + (when (< log2-num log2-low) + ;; If the number is too small, just return 0. + (return-from make-float-aux (coerce 0 float-format))) - (when (> log2-num log2-high) - ;; The numbe is definitely too large to fit. Signal an error. - (%reader-error stream _"Number not representable as a ~S: ~S" - float-format (read-buffer-to-string)))))) + (when (> log2-num log2-high) + ;; The numbe is definitely too large to fit. Signal an error. + (%reader-error stream _"Number not representable as a ~S: ~S" + float-format (read-buffer-to-string))))))) ;; Otherwise the number might fit, so we carefully compute the result (handler-case View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6bc0a576b1b525875f6c6bb… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6bc0a576b1b525875f6c6bb… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-275-signal-underflow-in-float-reader] 2 commits: Update tests because we don't throw reader-errors anymore
by Raymond Toy (＠rtoy) 08 Feb '24

08 Feb '24

Raymond Toy pushed to branch issue-275-signal-underflow-in-float-reader at cmucl / cmucl Commits: 1cfafa5e by Raymond Toy at 2024-02-08T08:38:25-08:00 Update tests because we don't throw reader-errors anymore For small numbers we don't throw reader-errors anymore. We throw floating-point-underflow errors. (Some tests still fail; we need #277 fixed before we can pass these tests.) - - - - - 0a4e3670 by Raymond Toy at 2024-02-08T08:39:48-08:00 Update pot file - - - - - 2 changed files: - src/i18n/locale/cmucl.pot - tests/trac.lisp Changes: ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -8727,10 +8727,6 @@ msgstr "" msgid "Internal error in floating point reader." msgstr "" -#: src/code/reader.lisp -msgid "Underflow" -msgstr "" - #: src/code/reader.lisp msgid "Return ~A for ~A" msgstr "" ===================================== tests/trac.lisp ===================================== @@ -348,7 +348,7 @@ (ext:with-float-traps-masked (:divide-by-zero) (log -0w0))))) (define-test trac.93 - (:tag :trac) + (:tag :trac) ;; These small values should read to least-positive-foo-float ;; because that's the closest non-zero float. (assert-eql least-positive-short-float @@ -359,13 +359,21 @@ (values (read-from-string "4d-324"))) (assert-eql (kernel:make-double-double-float least-positive-double-float 0d0) (values (read-from-string "4w-324"))) - ;; These should signal reader errors because the numbers are not - ;; zero, but are too small to be represented by the corresponding - ;; float type. - (assert-error 'reader-error (read-from-string ".1s-45")) - (assert-error 'reader-error (read-from-string ".1e-45")) - (assert-error 'reader-error (read-from-string "1d-324")) - (assert-error 'reader-error (read-from-string "1w-324"))) + ;; When FP underflow is enabled, these should signal underflow + ;; errors because the numbers are not zero, but are too small to be + ;; represented by the corresponding float type. + (kernel::with-float-traps-enabled (:underflow) + (assert-error 'floating-point-underflow (read-from-string ".1s-45")) + (assert-error 'floating-point-underflow (read-from-string ".1e-45")) + (assert-error 'floating-point-underflow (read-from-string "1d-324")) + (assert-error 'floating-point-underflow (read-from-string "1w-324"))) + ;; The same tests above should return 0 when FP underflows are + ;; disabled. + (kernel::with-float-traps-masked (:underflow) + (assert-eql 0s0 (read-from-string ".1s-45")) + (assert-eql 0f0 (read-from-string ".1e-45")) + (assert-eql 0d0 (read-from-string "1d-324")) + (assert-eql 0w0 (read-from-string "1w-324")))) (defparameter *test-path* (merge-pathnames (make-pathname :name :unspecific :type :unspecific View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/3b6a71be4951000611aee0… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/3b6a71be4951000611aee0… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-277-float-ratio-float-least-positive-float] Update release info
by Raymond Toy (＠rtoy) 08 Feb '24

08 Feb '24

Raymond Toy pushed to branch issue-277-float-ratio-float-least-positive-float at cmucl / cmucl Commits: 2d297bad by Raymond Toy at 2024-02-08T07:49:53-08:00 Update release info - - - - - 1 changed file: - src/general-info/release-21f.md Changes: ===================================== src/general-info/release-21f.md ===================================== @@ -40,6 +40,8 @@ public domain. * ~~#258~~ Remove `get-page-size` from linux-os.lisp * ~~#269~~ Add function to get user's home directory * ~~#266~~ Support "~user" in namestrings + * ~~#277~~ `float-ratio-float` returns least postive float for + ratios closer to that than zero. * 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/2d297badcd7f1a7bfc10d74… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/2d297badcd7f1a7bfc10d74… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-277-float-ratio-float-least-positive-float] Remove debugging prints and tests
by Raymond Toy (＠rtoy) 08 Feb '24

08 Feb '24

Raymond Toy pushed to branch issue-277-float-ratio-float-least-positive-float at cmucl / cmucl Commits: 52bc51af by Raymond Toy at 2024-02-08T07:42:18-08:00 Remove debugging prints and tests Remove debugging prints from float-ratio-float and add some tests for rational numbers close to the least positive float. - - - - - 2 changed files: - src/code/float.lisp - tests/float.lisp Changes: ===================================== src/code/float.lisp ===================================== @@ -1135,8 +1135,9 @@ (assert (= len (the fixnum (1+ digits)))) (multiple-value-bind (f0) (floatit (ash bits -1)) - ;;#+nil + #+nil (progn + (format t "x = ~A~%" x) (format t "1: f0, f1 = ~A~%" f0) (format t " scale = ~A~%" (1+ scale))) ===================================== tests/float.lisp ===================================== @@ -136,5 +136,45 @@ (ext:with-float-traps-masked (:overflow) (* 100 most-negative-double-float))))) - - \ No newline at end of file +(define-test float-ratio.single + (:tag :issues) + ;; least-positive-single-float is 1.4012985e-45. Let's test with + ;; some rationals from 7/10*10^-45 to 1.41*10^-45 to make sure they + ;; return 0 or least-positive-single-float + (let ((expo (expt 10 -45))) + ;; 7/10*10^-45 is just under halfway between 0 and least-positive, + ;; so the answer is 0. + (assert-equal 0f0 (kernel::float-ratio-float (* 7/10 expo) 'single-float)) + + ;; These are all more than half way to + ;; least-positive-single-float, so they should return that. + (assert-equal least-positive-single-float + (kernel::float-ratio-float (* 8/10 expo) 'single-float)) + (assert-equal least-positive-single-float + (kernel::float-ratio-float (* 1 expo) 'single-float)) + (assert-equal least-positive-single-float + (kernel::float-ratio-float (* 14/10 expo) 'single-float)) + (assert-equal least-positive-single-float + (kernel::float-ratio-float (* 2 expo) 'single-float)))) + +(define-test float-ratio.double + (:tag :issues) + ;; least-positive-double-float is 4.9406564584124654d-324. Let's + ;; test with some rationals from about 2*10^-324 to 4.94*10^-324 to make + ;; sure they return 0 or least-positive-double-float + (let ((expo (expt 10 -324))) + ;; 247/100*10^-45 is just under halfway between 0 and least-positive, + ;; so the answer is 0. + (assert-equal 0d0 (kernel::float-ratio-float (* 247/100 expo) 'double-float)) + + ;; These are all more than half way to + ;; least-positive-double-float, so they should return that. + (assert-equal least-positive-double-float + (kernel::float-ratio-float (* 248/100 expo) 'double-float)) + (assert-equal least-positive-double-float + (kernel::float-ratio-float (* 4 expo) 'double-float)) + (assert-equal least-positive-double-float + (kernel::float-ratio-float (* 494/100 expo) 'double-float)) + (assert-equal least-positive-double-float + (kernel::float-ratio-float (* 988/100 expo) 'double-float)))) + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/52bc51afbe1505136c02310… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/52bc51afbe1505136c02310… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-277-float-ratio-float-least-positive-float
by Raymond Toy (＠rtoy) 08 Feb '24

08 Feb '24

Raymond Toy pushed new branch issue-277-float-ratio-float-least-positive-float at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-277-float-ratio-flo… 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