repair pseudo-random-generator-next! for large integers

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)))))
  )
 
 

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

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)