diff --git a/mats/5_3.ms b/mats/5_3.ms index 363a92e9e..dd7542a6a 100644 --- a/mats/5_3.ms +++ b/mats/5_3.ms @@ -2809,20 +2809,30 @@ (= 0.970453319804345 (pseudo-random-generator-next! prgen)) (= 0.41754101818626094 (pseudo-random-generator-next! prgen)) (= 0.13061439482676662 (pseudo-random-generator-next! prgen)) - (let ([hits (make-vector 10)]) - (let loop ([i 1000]) - (unless (zero? i) - (let* ([n (pseudo-random-generator-next! prgen (expt 10 1000))] - [k (quotient n (expt 10 999))]) - (vector-set! hits k (add1 (vector-ref hits k))) - (loop (sub1 i))))) - ;; We expect about 100 hits in each bin. Having less than 50 or - ;; more than 150 should be so etxremely unlikely that we can rely on - ;; it not happning: - (let loop ([i (vector-length hits)]) - (or (= i 0) - (and (< 50 (vector-ref hits (sub1 i)) 150) - (loop (sub1 i)))))) + (let nloop ([ns (list (expt 2 31) + (expt 2 32) + (expt 2 33) + (expt 2 64) + (expt 10 1000))]) + (or (null? ns) + (and + (let* ([M 64] + [hits (make-vector M)]) + (let loop ([i (* M 100)]) + (unless (zero? i) + (let* ([n (pseudo-random-generator-next! prgen (car ns))] + [k (quotient n (quotient (car ns) M))]) + (when (>= n (car ns)) (error 'random "too big")) + (vector-set! hits k (add1 (vector-ref hits k))) + (loop (sub1 i))))) + ;; We expect about 100 hits in each bin. Having less than 50 or + ;; more than 150 should be so extremely unlikely that we can rely on + ;; it not happening: + (let loop ([i (vector-length hits)]) + (or (= i 0) + (and (< 50 (vector-ref hits (sub1 i)) 150) + (loop (sub1 i)))))) + (nloop (cdr ns))))) ) diff --git a/release_notes/release_notes.stex b/release_notes/release_notes.stex index 74f9f1e40..8e69687db 100644 --- a/release_notes/release_notes.stex +++ b/release_notes/release_notes.stex @@ -2726,6 +2726,14 @@ in fasl files does not generally make sense. %----------------------------------------------------------------------------- \section{Bug Fixes}\label{section:bugfixes} +\subsection{Random number generation for large exact integers (10.1.0)} + +Given an exact integer greater than 4294967087, +\scheme{pseudo-random-generator-next!} did not produce a valid result. +Generated results did not cover the intended range uniformly, and by +mistreating the largest part of the integer, it could always produce +\scheme{0} (e.g., for \scheme{(expt 2 32)}). + \subsection{Missing memory fences for some platforms (10.1.0)} Compilation for tppc32le lacked memory fences that are needed to diff --git a/s/5_3.ss b/s/5_3.ss index eb328b822..473b8530d 100644 --- a/s/5_3.ss +++ b/s/5_3.ss @@ -3156,19 +3156,23 @@ (random-double s)] [(s x) (define (random-integer s x) - (let ([bits (integer-length x)]) - (let loop ([shift 0]) - (cond - [(<= bits shift) 0] - [else - ;; Assuming that a `uptr` is at least 32 bits: - (bitwise-ior (loop (+ shift 32)) - (let ([n (bitwise-bit-field x shift (+ shift 32))]) - (if (zero? n) - 0 - (bitwise-arithmetic-shift-left - (random-int s n) - shift))))])))) + ;; assumes that uptr is at least 32 bits + (let ([maybe-result + ;; get a number that might be too big, because we bump + ;; the high 31-bit digit by one to cover the range created + ;; by lower 31-bit digits (assuming that one of them is non-zero) + (let ([y (- x 1)]) ; might reduce bit width; more than compensated by `(+ z 1)` below + (let loop ([r 0] [len (integer-length y)] [shift 0]) + (if (< len 32) + (let ([z (bitwise-bit-field y shift (+ shift 31))]) + (+ r (bitwise-arithmetic-shift-left (random-int s (+ z 1)) shift))) + (loop (+ r (bitwise-arithmetic-shift-left (random-int s #x80000000) shift)) + (- len 31) + (+ shift 31)))))]) + ;; probability of a bad choice is at most 1/2 + (if (>= maybe-result x) + (random-integer s x) + maybe-result))) (unless (is-pseudo-random-generator? s) ($oops who "not a pseudo-random generator ~s" s)) (cond [(fixnum? x)