Raymond Toy pushed to branch issue-256-loop-var-nil at cmucl / cmucl
Commits:
701c8a64 by Raymond Toy at 2024-02-14T06:59:39-08:00
Refill comment to 80 columns as requested.
- - - - -
1 changed file:
- src/code/loop.lisp
Changes:
=====================================
src/code/loop.lisp
=====================================
@@ -1169,10 +1169,9 @@ collected result will be returned as the value of the LOOP."
;; these type symbols.
(let ((type-spec (or (gethash z (loop-universe-type-symbols *loop-universe*))
(gethash (symbol-name z) (loop-universe-type-keywords *loop-universe*)))))
- ;; If Z is NIL, we have something like (loop for var
- ;; nil ...). In that case, we need to pop the
- ;; source to skip over the type, just as if we had
- ;; (loop for var fixnum ...)
+ ;; If Z is NIL, we have something like (loop for var nil ...).
+ ;; In that case, we need to pop the source to skip over the
+ ;; type, just as if we had (loop for var fixnum ...)
(when (or type-spec (null z))
(loop-pop-source)
type-spec)))
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/701c8a646faf2d6d0e76807…
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/701c8a646faf2d6d0e76807…
You're receiving this email because of your account on gitlab.common-lisp.net.
Raymond Toy pushed to branch issue-256-loop-var-nil at cmucl / cmucl
Commits:
7d9e1761 by Carl Shapiro at 2024-02-14T14:45:19+00:00
Apply 1 suggestion(s) to 1 file(s)
- - - - -
1 changed file:
- src/code/loop.lisp
Changes:
=====================================
src/code/loop.lisp
=====================================
@@ -1163,7 +1163,7 @@ collected result will be returned as the value of the LOOP."
;; a common lisp type specifier or pattern (matching the variable) thereof.
(loop-pop-source)
(loop-pop-source))
-
+
((symbolp z)
;;This is the (sort of) "old" syntax, even though we didn't used to support all of
;; these type symbols.
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/7d9e176129b529e294bfe86…
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/7d9e176129b529e294bfe86…
You're receiving this email because of your account on gitlab.common-lisp.net.
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.
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.
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.
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.