summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--rand.c150
-rw-r--r--tests/012/sort.tl2
-rw-r--r--tests/013/maze.expected118
-rw-r--r--txr.116
4 files changed, 225 insertions, 61 deletions
diff --git a/rand.c b/rand.c
index 4d068826..4610d8f7 100644
--- a/rand.c
+++ b/rand.c
@@ -63,12 +63,15 @@ typedef unsigned long rand32_t;
struct rand_state {
rand32_t state[16];
unsigned cur;
+ rand32_t shift;
};
val random_state_s, random_state_var_s, random_warmup_s;
struct cobj_class *random_state_cls;
+static int opt_noshift;
+
static val random_state_clone(val rand_state)
{
return make_random_state(rand_state, nil);
@@ -195,6 +198,7 @@ val make_random_state(val seed, val warmup)
r->state[i] = c_unum(seed->v.vec[i], self);
r->cur = c_num(seed->v.vec[i], self);
+ r->shift = 0;
return rs;
} else if (bufp(seed)) {
ucnum len = c_unum(seed->b.len, self);
@@ -246,6 +250,7 @@ val make_random_state(val seed, val warmup)
r->state[i] = rand_tab[i];
r->cur = 0;
+ r->shift = 0;
{
uses_or2;
@@ -411,7 +416,7 @@ val random(val state, val modulus)
cnum m = c_num(modulus, self);
if (m == 1) {
return zero;
- } else if (m > 1) {
+ } else if (m > 65536 || (opt_noshift && m > 1)) {
unsigned bits = highest_bit(m - 1);
#if CHAR_BIT * SIZEOF_PTR >= 64
ucnum rands_needed = (bits + 32 - 1) / 32;
@@ -437,6 +442,146 @@ val random(val state, val modulus)
continue;
return num(out);
}
+ } else if (m == 65536) {
+ rand32_t s = r->shift;
+
+ if (s <= 65535) {
+ s = rand32(r);
+ r->shift = s >> 16 | 0x00010000U;
+ } else {
+ r->shift = s >> 16;
+ }
+
+ return num_fast(s & 65535);
+ } else if (m > 256) {
+ rand32_t u = r->shift;
+ rand32_t mask = 65535;
+
+ while (mask >> 1 > convert(rand32_t, m))
+ mask >>= 1;
+
+ for (;;) {
+ rand32_t s = u;
+ if (s <= mask) {
+ s = rand32(r);
+ u = s >> 16 | 0x00010000U;
+ } else {
+ u = s >> 16;
+ }
+ if ((s & mask) < convert(rand32_t, m)) {
+ r->shift = u;
+ return num_fast(s & mask);
+ }
+ }
+ } else if (m == 256) {
+ rand32_t s = r->shift;
+
+ if (s <= 255) {
+ s = rand32(r);
+ r->shift = s >> 8 | 0x01000000U;
+ } else {
+ r->shift = s >> 8;
+ }
+
+ return num_fast(s & 255);
+ } else if (m > 16) {
+ rand32_t u = r->shift;
+ rand32_t mask = 255;
+
+ while (mask >> 1 > convert(rand32_t, m))
+ mask >>= 1;
+
+ for (;;) {
+ rand32_t s = u;
+ if (s <= mask) {
+ s = rand32(r);
+ u = s >> 8 | 0x01000000U;
+ } else {
+ u = s >> 8;
+ }
+ if ((s & mask) < convert(rand32_t, m)) {
+ r->shift = u;
+ return num_fast(s & mask);
+ }
+ }
+ } else if (m == 16) {
+ rand32_t s = r->shift;
+
+ if (s <= 15) {
+ s = rand32(r);
+ r->shift = s >> 4 | 0x10000000U;
+ } else {
+ r->shift = s >> 4;
+ }
+
+ return num_fast(s & 15);
+ } else if (m > 4) {
+ rand32_t u = r->shift;
+ rand32_t mask = 15;
+
+ while (mask >> 1 > convert(rand32_t, m))
+ mask >>= 1;
+
+ for (;;) {
+ rand32_t s = u;
+ if (s <= 15) {
+ s = rand32(r);
+ u = s >> 4 | 0x10000000U;
+ } else {
+ u = s >> 4;
+ }
+ if ((s & mask) < convert(rand32_t, m)) {
+ r->shift = u;
+ return num_fast(s & mask);
+ }
+ }
+ } else switch (m) {
+ case 4:
+ {
+ rand32_t s = r->shift;
+
+ if (s <= 3) {
+ s = rand32(r);
+ r->shift = s >> 2 | 0x40000000U;
+ } else {
+ r->shift = s >> 2;
+ }
+
+ return num_fast(s & 3);
+ }
+ case 3:
+ {
+ rand32_t u = r->shift;
+
+ for (;;) {
+ rand32_t s = u;
+ if (s <= 3) {
+ s = rand32(r);
+ u = s >> 2 | 0x40000000U;
+ } else {
+ u = s >> 2;
+ }
+ if ((s & 3) < 3) {
+ r->shift = u;
+ return num_fast(s & 3);
+ }
+ }
+ }
+ case 2:
+ {
+ rand32_t s = r->shift;
+
+ if (s <= 1) {
+ s = rand32(r);
+ r->shift = s >> 1 | 0x80000000U;
+ } else {
+ r->shift = s >> 1;
+ }
+
+ return s & 1 ? one : zero;
+ }
+ default:
+ break;
}
}
@@ -490,6 +635,9 @@ val random_buf(val size, val state)
void rand_compat_fixup(int compat_ver)
{
+ if (compat_ver <= 299)
+ opt_noshift = 1;
+
if (compat_ver <= 243) {
loc l = lookup_var_l(nil, random_state_var_s);
if (compat_ver <= 139) {
diff --git a/tests/012/sort.tl b/tests/012/sort.tl
index d08bce3a..8529160e 100644
--- a/tests/012/sort.tl
+++ b/tests/012/sort.tl
@@ -98,4 +98,4 @@
[hist-sort-by upcase-str '("a" "b" "c" "a" "b" "a" "b" "a")] (("A" . 4) ("B" . 3) ("C" . 1)))
(let ((*random-state* (make-random-state 0)))
- (test (shuffle 1..10) #(4 1 7 6 2 8 3 5 9)))
+ (test (shuffle 1..10) #(9 5 3 1 2 6 4 8 7)))
diff --git a/tests/013/maze.expected b/tests/013/maze.expected
index 8cf588e4..d44a5ff2 100644
--- a/tests/013/maze.expected
+++ b/tests/013/maze.expected
@@ -1,61 +1,61 @@
+ +----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+
-| | | | | | | |
-| | | | | | | |
-+ +----+----+ + +----+ + +----+ +----+----+ +----+ +----+----+ +----+ +
-| | | | | | | | | | |
-| | | | | | | | | | |
-+ + +----+----+----+ +----+----+ +----+ + +----+----+----+ +----+----+ + +
-| | | | | | | | | | |
-| | | | | | | | | | |
-+ +----+ + +----+ + +----+----+----+----+ + + + +----+ + +----+ +
-| | | | | | | | | |
-| | | | | | | | | |
-+----+----+----+----+ + +----+ +----+ +----+----+ + +----+ + +----+----+ +
-| | | | | | | | | | |
-| | | | | | | | | | |
-+ + + +----+----+ + +----+ + +----+ + +----+ +----+ +----+----+ +
-| | | | | | | | | | | |
-| | | | | | | | | | | |
-+----+ +----+ +----+----+ +----+----+ + +----+ +----+----+----+----+----+ +----+
-| | | | | | | | |
-| | | | | | | | |
-+ +----+ +----+ + + +----+ + +----+----+----+----+ +----+ +----+ +----+
-| | | | | | | | | | | | |
-| | | | | | | | | | | | |
-+ + +----+ + + +----+----+ +----+ + +----+ + + +----+----+----+ +
-| | | | | | | | | | | |
-| | | | | | | | | | | |
-+ + +----+----+ + +----+----+----+ + + + +----+ +----+ + +----+ +
-| | | | | | | | | | | |
-| | | | | | | | | | | |
-+ +----+----+----+ + +----+ +----+ + + + +----+----+ + + +----+----+
-| | | | | | | | | | | | |
-| | | | | | | | | | | | |
-+ + + + + +----+----+----+ + +----+ +----+ + +----+ +----+----+ +
-| | | | | | | | | | | |
-| | | | | | | | | | | |
-+ +----+ +----+----+ + +----+----+ + + + +----+ + +----+ +----+ +
-| | | | | | | | | | | | | |
-| | | | | | | | | | | | | |
-+----+ +----+ + + +----+----+ +----+ + + + + + + + + + +
-| | | | | | | | | | | | | | | | | |
-| | | | | | | | | | | | | | | | | |
-+ +----+ +----+ +----+ + +----+ + + + + + + + + + +----+
-| | | | | | | | | | | | | |
-| | | | | | | | | | | | | |
-+ + +----+ +----+ +----+ + +----+----+----+----+ + +----+ + +----+ +
-| | | | | | | | | | | |
-| | | | | | | | | | | |
-+ + + +----+ + + + + +----+----+----+----+----+----+ + +----+----+ +
-| | | | | | | | | |
-| | | | | | | | | |
-+----+----+ + +----+----+ + +----+----+----+----+----+ + +----+----+ + +----+
-| | | | | | | | | | |
-| | | | | | | | | | |
-+ +----+ + +----+----+----+ + +----+ + + + +----+ + +----+----+ +
-| | | | | | | | | | | | |
-| | | | | | | | | | | | |
-+ +----+----+----+ + + +----+ +----+----+ +----+ + +----+ + + + +
-| | | | | | |
-| | | | | | |
+| | | | | |
+| | | | | |
++ +----+----+----+----+ +----+----+ + +----+ + + + +----+----+ +----+ +
+| | | | | | | | | | | |
+| | | | | | | | | | | |
++----+ + + + +----+----+----+ + +----+ + + + + +----+----+ +----+
+| | | | | | | | | | | | | | |
+| | | | | | | | | | | | | | |
++ + + + + +----+----+----+----+----+ + +----+ +----+----+ + + + +
+| | | | | | | | | | | | |
+| | | | | | | | | | | | |
++ +----+----+ +----+ + + +----+----+ + + +----+----+ +----+----+ + +
+| | | | | | | | | |
+| | | | | | | | | |
++ + +----+----+----+----+ +----+ + +----+ + +----+----+----+ + +----+ +
+| | | | | | | | | |
+| | | | | | | | | |
++ + + +----+----+----+----+ +----+----+----+ + + + +----+----+----+----+ +
+| | | | | | | | | |
+| | | | | | | | | |
++ + +----+----+----+----+ +----+ + +----+----+----+ +----+ + +----+ + +
+| | | | | | | | | | |
+| | | | | | | | | | |
++ + + +----+----+ +----+----+----+ +----+----+----+----+ +----+----+ + +----+
+| | | | | | | | | | | |
+| | | | | | | | | | | |
++ +----+ + + +----+ + + +----+ + + +----+----+ + + +----+ +
+| | | | | | | | | | | |
+| | | | | | | | | | | |
++ + +----+ +----+ +----+----+ +----+ +----+----+----+----+ +----+----+ +----+
+| | | | | | | | | | | |
+| | | | | | | | | | | |
++ +----+ + +----+ +----+ + + +----+ + + + + + +----+----+ +
+| | | | | | | | | | | | | |
+| | | | | | | | | | | | | |
++ +----+ + + +----+ +----+ + + +----+----+ + +----+----+ + + +
+| | | | | | | | | | | |
+| | | | | | | | | | | |
++ +----+----+----+ + + + +----+ + + +----+----+----+ + +----+----+ +
+| | | | | | | | | | | | |
+| | | | | | | | | | | | |
++ + +----+ + +----+----+----+ +----+----+----+ + +----+----+ + + + +
+| | | | | | | | | | | | |
+| | | | | | | | | | | | |
++ + + +----+----+ +----+ + +----+ +----+----+ + +----+ + + + +
+| | | | | | | | | | | | |
+| | | | | | | | | | | | |
++----+ + + +----+----+ + + + +----+ +----+----+----+ + +----+----+ +
+| | | | | | | | | |
+| | | | | | | | | |
++ +----+ +----+ +----+----+----+ +----+ +----+----+----+----+----+ +----+ +----+
+| | | | | | | | | |
+| | | | | | | | | |
++ +----+ + +----+----+----+ +----+ +----+ + +----+----+ +----+ + + +
+| | | | | | | | | | |
+| | | | | | | | | | |
++----+ +----+----+----+----+ + +----+----+ +----+ +----+ +----+----+----+----+ +
+| | | |
+| | | |
+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+ +
diff --git a/txr.1 b/txr.1
index 599638bc..358c3ca8 100644
--- a/txr.1
+++ b/txr.1
@@ -95902,6 +95902,22 @@ of these version values, the described behaviors are provided if
is given an argument which is equal or lower. For instance
.code "-C 103"
selects the behaviors described below for version 105, but not those for 102.
+.IP 299
+Starting with \*(TX 300, the
+.code rand
+function produces different values in some cases, due to being better
+optimized for small moduli. Internally, the function obtains pseudo-random bits
+from the PRNG in blocks of 32; i.e. 32 bit words. The previous
+.code rand
+implementation always obtained at least one new 32 bit word from the PRNG for
+each call, even for small moduli. The new implementation of the function,
+for moduli less than or equal to 65536, can satisfy multiple calls by taking
+bits from a 32-bit shift register, maintained in the random state object.
+The register only has to be refilled by a new 32 bit word from the PRNG
+when its bits are exhausted.
+A compatibility value of 299 or lower will disable this optimization, causing
+.code rand
+to return the original sequence of values, for a given random state.
.IP 298
Until \*(TX 298, the
.code lop