From 21e158606061246c7fcabb07b18bc5bc2f001054 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Wed, 7 Oct 2020 01:21:08 -0700 Subject: random: bugfix: incorrect WELL512a. * rand.c (rand32_bug): New static function formed by renaming the original buggy rand32. (rand32_good): Copy of rand32 with two bugfixes. The term involving variable r2 must be only left shifted by 28 bits, and not xor-ed with the original value. The order of operations is wrong in the term that contains the & operation. (rand32): New static function pointer variable, serving as the rand32 function. Points to rand32_good by default. (rand_compat_fixup): Test for 243 or lower compatibility, under which rand32 is made point to rand32_bug. This is done before the call to make_random_state for replacing *random-state*, which has to use the old function. * txr.1: compat note added. * tests/013/maze.expected: Updated. --- rand.c | 37 ++++++++++++--- tests/013/maze.expected | 118 ++++++++++++++++++++++++------------------------ txr.1 | 8 ++++ 3 files changed, 98 insertions(+), 65 deletions(-) diff --git a/rand.c b/rand.c index ba8c5ad9..731fd0ef 100644 --- a/rand.c +++ b/rand.c @@ -38,8 +38,9 @@ #include "signal.h" #include "unwind.h" #include "arith.h" -#include "rand.h" #include "eval.h" +#include "txr.h" +#include "rand.h" #define random_warmup (deref(lookup_var_l(nil, random_warmup_s))) @@ -90,7 +91,7 @@ INLINE rand32_t *rstate(struct rand_state *r, int offs) return &r->state[(r->cur + offs) % 16]; } -static rand32_t rand32(struct rand_state *r) +static rand32_t rand32_bug(struct rand_state *r) { rand32_t s0 = *rstate(r, 0); rand32_t s9 = *rstate(r, 9); @@ -109,6 +110,27 @@ static rand32_t rand32(struct rand_state *r) return ns15; } +static rand32_t rand32_good(struct rand_state *r) +{ + rand32_t s0 = *rstate(r, 0); + rand32_t s9 = *rstate(r, 9); + rand32_t s13 = *rstate(r, 13); + rand32_t s15 = *rstate(r, 15); + + rand32_t r1 = s0 ^ (s0 << 16) ^ s13 ^ (s13 << 15); + rand32_t r2 = s9 ^ (s9 >> 11); + + rand32_t ns0 = *rstate(r, 0) = r1 ^ r2; + rand32_t ns15 = s15 ^ (s15 << 2) ^ r1 ^ (r1 << 18) ^ (r2 << 28) ^ + (ns0 ^ ((ns0 << 5) & 0xDA442D24UL)); + + *rstate(r, 15) = ns15; + r->cur = (r->cur + 15) % 16; + return ns15; +} + +static rand32_t (*rand32)(struct rand_state *) = rand32_good; + val make_random_state(val seed, val warmup) { val self = lit("make-random-state"); @@ -342,11 +364,14 @@ val rnd(val modulus, val state) void rand_compat_fixup(int compat_ver) { - if (compat_ver <= 139) { + if (compat_ver <= 243) { loc l = lookup_var_l(nil, random_state_var_s); - memset(rand_tab, 0xAA, sizeof rand_tab); - if (compat_ver <= 114) - random_state_s = random_state_var_s; + if (compat_ver <= 139) { + memset(rand_tab, 0xAA, sizeof rand_tab); + if (compat_ver <= 114) + random_state_s = random_state_var_s; + } + rand32 = rand32_bug; set(l, make_random_state(num_fast(42), num_fast(8))); } } diff --git a/tests/013/maze.expected b/tests/013/maze.expected index b9c26ae0..8cf588e4 100644 --- a/tests/013/maze.expected +++ b/tests/013/maze.expected @@ -1,61 +1,61 @@ + +----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+ -| | | | | | | | | -| | | | | | | | | -+----+ + +----+ + + + + + +----+----+ + +----+----+ +----+ + + -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | -+ +----+ +----+----+----+ +----+----+ + + + + + + + + +----+ + -| | | | | | | | | -| | | | | | | | | -+----+----+----+----+----+ +----+ +----+----+----+ +----+ + +----+----+----+ +----+ -| | | | | | | | | | -| | | | | | | | | | -+ + +----+----+----+----+ +----+----+ + +----+ + + +----+----+ +----+ + -| | | | | | | | | | | | | -| | | | | | | | | | | | | -+ + + + +----+ + + + + + + +----+----+ +----+ + +----+----+ -| | | | | | | | | | | | | -| | | | | | | | | | | | | -+----+----+ +----+ + + +----+----+----+ +----+----+ +----+ +----+----+ + + -| | | | | | | | | | -| | | | | | | | | | -+ +----+----+ +----+ +----+ +----+ +----+ +----+----+ + + +----+----+ + -| | | | | | | | | | | | | -| | | | | | | | | | | | | -+----+ + +----+ + + +----+ +----+ +----+ + +----+ + +----+ + + -| | | | | | | | | | | | -| | | | | | | | | | | | -+ +----+----+ + + +----+ + + +----+ +----+----+ +----+----+----+----+ + -| | | | | | | | | | | -| | | | | | | | | | | -+----+----+ +----+----+----+ + + + + + +----+ +----+ + + + +----+ -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | -+ + + + + +----+----+ + + + +----+ +----+----+----+----+ + + + -| | | | | | | | | | | | -| | | | | | | | | | | | -+----+ + + +----+----+ + +----+----+----+ +----+----+ +----+----+ +----+ + -| | | | | | | | | | | | | -| | | | | | | | | | | | | -+ +----+ + +----+ + + +----+ + + + + +----+ + +----+ + + -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | -+ +----+----+ + +----+ + + +----+ +----+----+ +----+ + + +----+ + -| | | | | | | | | | | | -| | | | | | | | | | | | -+----+ + + +----+ +----+----+ +----+----+----+----+----+ + + +----+----+ + -| | | | | | | | | | -| | | | | | | | | | -+ + +----+----+ +----+ + +----+ +----+----+ + + + +----+ + + + -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | -+ + +----+----+----+ + +----+ +----+----+ + + + +----+----+----+ + + -| | | | | | | | | | | | -| | | | | | | | | | | | -+ +----+ + + +----+----+----+ +----+----+ + +----+----+ + + + +----+ -| | | | | | | | | | | | | -| | | | | | | | | | | | | -+ +----+----+ +----+ +----+----+ + + +----+----+ + +----+ + +----+ + -| | | | | | -| | | | | | +| | | | | | | | +| | | | | | | | ++ +----+----+ + +----+ + +----+ +----+----+ +----+ +----+----+ +----+ + +| | | | | | | | | | | +| | | | | | | | | | | ++ + +----+----+----+ +----+----+ +----+ + +----+----+----+ +----+----+ + + +| | | | | | | | | | | +| | | | | | | | | | | ++ +----+ + +----+ + +----+----+----+----+ + + + +----+ + +----+ + +| | | | | | | | | | +| | | | | | | | | | ++----+----+----+----+ + +----+ +----+ +----+----+ + +----+ + +----+----+ + +| | | | | | | | | | | +| | | | | | | | | | | ++ + + +----+----+ + +----+ + +----+ + +----+ +----+ +----+----+ + +| | | | | | | | | | | | +| | | | | | | | | | | | ++----+ +----+ +----+----+ +----+----+ + +----+ +----+----+----+----+----+ +----+ +| | | | | | | | | +| | | | | | | | | ++ +----+ +----+ + + +----+ + +----+----+----+----+ +----+ +----+ +----+ +| | | | | | | | | | | | | +| | | | | | | | | | | | | ++ + +----+ + + +----+----+ +----+ + +----+ + + +----+----+----+ + +| | | | | | | | | | | | +| | | | | | | | | | | | ++ + +----+----+ + +----+----+----+ + + + +----+ +----+ + +----+ + +| | | | | | | | | | | | +| | | | | | | | | | | | ++ +----+----+----+ + +----+ +----+ + + + +----+----+ + + +----+----+ +| | | | | | | | | | | | | +| | | | | | | | | | | | | ++ + + + + +----+----+----+ + +----+ +----+ + +----+ +----+----+ + +| | | | | | | | | | | | +| | | | | | | | | | | | ++ +----+ +----+----+ + +----+----+ + + + +----+ + +----+ +----+ + +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | ++----+ +----+ + + +----+----+ +----+ + + + + + + + + + + +| | | | | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | | | ++ +----+ +----+ +----+ + +----+ + + + + + + + + + +----+ +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | ++ + +----+ +----+ +----+ + +----+----+----+----+ + +----+ + +----+ + +| | | | | | | | | | | | +| | | | | | | | | | | | ++ + + +----+ + + + + +----+----+----+----+----+----+ + +----+----+ + +| | | | | | | | | | +| | | | | | | | | | ++----+----+ + +----+----+ + +----+----+----+----+----+ + +----+----+ + +----+ +| | | | | | | | | | | +| | | | | | | | | | | ++ +----+ + +----+----+----+ + +----+ + + + +----+ + +----+----+ + +| | | | | | | | | | | | | +| | | | | | | | | | | | | ++ +----+----+----+ + + +----+ +----+----+ +----+ + +----+ + + + + +| | | | | | | +| | | | | | | +----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+ + diff --git a/txr.1 b/txr.1 index 2088419c..067f9b80 100644 --- a/txr.1 +++ b/txr.1 @@ -75522,6 +75522,14 @@ 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 243 +Two mistakes in the pseudo-random-number generator (PRNG) were discovered, +affecting \*(TX 243 and older. Using this compatibility value, or lower, will +restore the buggy behavior, allowing pseudo-random number sequences produced +by those older versions can be reproduced. The PRNG is intended to be an +implementation of the WELL-512 PRNG described by Panneton and L'Ecuyer. +The coding mistakes, however, resulted in the PRNG being an implementation of +something other than WELL-512. .IP 242 In \*(TX 242 and older, the instantiation of an object whose type inherits from the same supertype more than once resulted in duplicate execution -- cgit v1.2.3