cs: use pseudo-random generator from Chez Scheme

Use the pseudo-random generator API that is now available from Chez
Scheme. While the generator can be written in Scheme, the lack of
unboxed floating-point arithmetic unfortunately makes it about 6 times
as slow as a built-in implementation. That difference is significant
when `sync` uses `random` for fair scheduling.

pkgs/base/info.rkt

@@ -12,7 +12,7 @@
 
 (define collection 'multi)
 
-(define version "7.4.0.12")
+(define version "7.4.0.13")
 
 (define deps `("racket-lib"
                ["racket" #:version ,version]))

pkgs/racket-benchmarks/tests/racket/benchmarks/control/sync.rkt

@@ -0,0 +1,38 @@
+#lang racket/base
+
+(require racket/include)
+
+(include "config.rktl")
+
+'----------------------------------------
+
+'semaphore-wait
+(times
+ (let ([s (make-semaphore M)])
+   (for ([i (in-range M)])
+     (semaphore-wait s))))
+
+'semaphore-post+wait
+(times
+ (let ([s (make-semaphore)])
+   (for ([i (in-range M)])
+     (semaphore-post s)
+     (semaphore-wait s))))
+
+'semaphore-peek-evt
+(times
+ (let ([e (semaphore-peek-evt (make-semaphore 1))])
+   (for ([i (in-range M)])
+     (sync e))))
+
+'sync-two
+(times
+ (let ([s (make-semaphore M)])
+   (for ([i (in-range M)])
+     (sync s never-evt))))
+
+'sync-three
+(times
+ (let ([s (make-semaphore M)])
+   (for ([i (in-range M)])
+     (sync s always-evt never-evt))))

pkgs/racket-benchmarks/tests/racket/benchmarks/control/thread.rkt

@@ -106,4 +106,3 @@
    (define t2 (make s2 s1))
    (thread-wait t1)
    (thread-wait t2)))
-

racket/src/cs/bootstrap/record.rkt

@@ -151,7 +151,7 @@
     (error 'normalize-fields "not a list: ~s" fields))
   (define (check-type t)
     (case t
-      [(scheme-object uptr ptr) t]
+      [(scheme-object uptr ptr double) t]
       [else
        (error 'make-struct-type "unsupported type ~s" t)]))
   (define (is-mut? m)
@@ -298,7 +298,7 @@
   (define (ptr-type? t)
     (case t
       [(scheme-object ptr) #t]
-      [(uptr) #f]
+      [(uptr double) #f]
       [else (error "unrecognized type")]))
   (define (assert-accessor)
     (when mut? (error 'csv7:record-field-mutator "immutable base-rtd field")))

racket/src/cs/compile-file.ss

@@ -2,7 +2,7 @@
 ;; Check to make we're using a build of Chez Scheme
 ;; that has all the features we need.
 (define-values (need-maj need-min need-sub need-dev)
-  (values 9 5 3 2))
+  (values 9 5 3 3))
 
 (unless (guard (x [else #f]) (eval 'scheme-fork-version-number))
   (error 'compile-file
@@ -13,7 +13,7 @@
               (and (= maj need-maj)
                    (or (> min need-min)
                        (and (= min need-min)
-                            (or (>= sub need-sub)
+                            (or (> sub need-sub)
                                 (and (= sub need-sub)
                                      (>= dev need-dev)))))))
     (error 'compile-file "need a newer Chez Scheme")))

racket/src/cs/rumble.sls

@@ -406,12 +406,7 @@
 
           random
           random-seed
-          pseudo-random-generator?
-          make-pseudo-random-generator
           current-pseudo-random-generator
-          vector->pseudo-random-generator
-          vector->pseudo-random-generator!
-          pseudo-random-generator->vector
           pseudo-random-generator-vector?
 
           mpair?

racket/src/cs/rumble/random.ss

@@ -1,175 +1,41 @@
-;; /*
-;;   Based on
-;; 
-;;    Implementation of SRFI-27 core generator in C for Racket.
-;;    dvanhorn@cs.uvm.edu
-;; 
-;;   and
-;; 
-;;    54-BIT (double) IMPLEMENTATION IN C OF THE "MRG32K3A" GENERATOR
-;;    ===============================================================
-;; 
-;;    Sebastian.Egner@philips.com, Mar-2002, in ANSI-C and Scheme 48 0.57
-;; 
-;;    This code is a C-implementation of Pierre L'Ecuyer's MRG32k3a generator.
-;;    The code uses (double)-arithmetics, assuming that it covers the range
-;;    {-2^53..2^53-1} exactly (!). The code of the generator is based on the
-;;    L'Ecuyer's own implementation of the generator. Please refer to the
-;;    file 'mrg32k3a.scm' for more information about the method.
-;; */
 
-;; The Generator
+(define/who current-pseudo-random-generator
-;; =============
+  (make-parameter (make-pseudo-random-generator)
+                  (lambda (v)
+                    (check who pseudo-random-generator? v)
+                    v)
+                  'current-pseudo-random-generator))
 
-;; moduli of the components
+(define/who random
-(define Im1 #xffffff2f)
+  (case-lambda
-(define Im2 #xffffa6bb)
+   [() (pseudo-random-generator-next! (current-pseudo-random-generator))]
-(define m1 4294967087.0)
+   [(n)
-(define m2 4294944443.0)
+    (cond
+     [(pseudo-random-generator? n)
+      (pseudo-random-generator-next! n)]
+     [else
+      (check who
+             :test (and (exact-integer? n)
+                        (<= 1 n 4294967087))
+             :contract "(or/c (integer-in 1 4294967087) pseudo-random-generator?)"
+             n)
+      (pseudo-random-generator-next! (current-pseudo-random-generator) n)])]
+   [(n prg)
+    (check who
+           :test (and (exact-integer? n)
+                      (<= 1 n 4294967087))
+           :contract "(or/c (integer-in 1 4294967087) pseudo-random-generator?)"
+           n)
+    (check who pseudo-random-generator? prg)
+    (pseudo-random-generator-next! prg n)]))
 
-;; recursion coefficients of the components
+(define/who (random-seed k)
-(define a12  1403580.0)
+  (check who
-(define a13n  810728.0)
+         :test (and (exact-nonnegative-integer? k)
-(define a21   527612.0)
+                    (<= k (sub1 (expt 2 31))))
-(define a23n 1370589.0)
+         :contract "(integer-in 0 (sub1 (expt 2 31)))"
-
+         k)
-;; normalization factor 1/(m1 + 1)
+  (pseudo-random-generator-seed! (current-pseudo-random-generator) k))
-(define norm 2.328306549295728e-10)
-
-;; the actual generator
-
-(define-record-type (pseudo-random-generator new-pseudo-random-generator pseudo-random-generator?)
-  (fields (mutable x10) (mutable x11) (mutable x12) (mutable x20) (mutable x21) (mutable x22))
-  (nongenerative))
-
-(define (mrg32k3a s) ;; -> flonum in {0..m1-1}
-  ;; component 1
-  (let* ([x10 (fl- (fl* a12 (pseudo-random-generator-x11 s))
-                   (fl* a13n (pseudo-random-generator-x12 s)))]
-         [k10 (fltruncate (fl/ x10 m1))]
-         [x10 (fl- x10 (fl* k10 m1))]
-         [x10 (if (fl< x10 0.0)
-                  (fl+ x10 m1)
-                  x10)])
-    (pseudo-random-generator-x12-set! s (pseudo-random-generator-x11 s))
-    (pseudo-random-generator-x11-set! s (pseudo-random-generator-x10 s))
-    (pseudo-random-generator-x10-set! s x10)
-    
-    ;; component 2
-    (let* ([x20 (fl- (fl* a21 (pseudo-random-generator-x20 s))
-                     (fl* a23n (pseudo-random-generator-x22 s)))]
-           [k20 (fltruncate (fl/ x20 m2))]
-           [x20 (fl- x20 (fl* k20 m2))]
-           [x20 (if (fl< x20 0.0)
-                    (fl+ x20 m2)
-                    x20)])
-      (pseudo-random-generator-x22-set! s (pseudo-random-generator-x21 s))
-      (pseudo-random-generator-x21-set! s (pseudo-random-generator-x20 s))
-      (pseudo-random-generator-x20-set! s x20)
-
-      ;; combination of components
-      (let* ([y (fl- x10 x20)])
-        (if (fl< y 0.0)
-            (fl+ y m1)
-            y)))))
-
-(define (make-pseudo-random-generator)
-  (let ([s (new-pseudo-random-generator 1.0 1.0 1.0 1.0 1.0 1.0)])
-    (pseudo-random-generator-seed! s (current-milliseconds))
-    s))
-
-(define (pseudo-random-generator-seed! s x)
-  ;; Initial values are from Sebastian Egner's implementation:
-  (pseudo-random-generator-x10-set! s 1062452522.0)
-  (pseudo-random-generator-x11-set! s 2961816100.0)
-  (pseudo-random-generator-x12-set! s 342112271.0)
-  (pseudo-random-generator-x20-set! s 2854655037.0)
-  (pseudo-random-generator-x21-set! s 3321940838.0)
-  (pseudo-random-generator-x22-set! s 3542344109.0)
-  (srand-half! s (bitwise-and x #xFFFF))
-  (srand-half! s (bitwise-and (bitwise-arithmetic-shift-right x 16) #xFFFF)))
-
-(define (srand-half! s x)
-  (let* ([u32+ (lambda (a b)
-                 (bitwise-and (+ a b) #xFFFFFFFF))]
-         [x (random-n! x
-                       (- Im1 1)
-                       (lambda (z)
-                         (pseudo-random-generator-x10-set!
-                          s
-                          (exact->inexact
-                           (+ 1 (modulo
-                                 (u32+ (inexact->exact (pseudo-random-generator-x10 s))
-                                       z)
-                                 (- Im1 1)))))))]
-         [x (random-n! x
-                       Im1
-                       (lambda (z)
-                         (pseudo-random-generator-x11-set!
-                          s
-                          (exact->inexact
-                           (modulo
-                            (u32+ (inexact->exact (pseudo-random-generator-x11 s))
-                                  z)
-                            Im1)))))]
-         [x (random-n! x
-                       Im1
-                       (lambda (z)
-                         (pseudo-random-generator-x12-set!
-                          s
-                          (exact->inexact
-                           (modulo
-                            (u32+ (inexact->exact (pseudo-random-generator-x12 s))
-                                  z)
-                            Im1)))))]
-         [x (random-n! x
-                       (- Im2 1)
-                       (lambda (z)
-                         (pseudo-random-generator-x20-set!
-                          s
-                          (exact->inexact
-                           (+ 1 (modulo
-                                 (u32+ (inexact->exact (pseudo-random-generator-x20 s))
-                                       z)
-                                 (- Im2 1)))))))]
-         [x (random-n! x
-                       Im2
-                       (lambda (z)
-                         (pseudo-random-generator-x21-set!
-                          s
-                          (exact->inexact
-                           (modulo
-                            (u32+ (inexact->exact (pseudo-random-generator-x21 s))
-                                  z)
-                            Im2)))))]
-         [x (random-n! x
-                       Im2
-                       (lambda (z)
-                         (pseudo-random-generator-x22-set!
-                          s
-                          (exact->inexact
-                           (modulo
-                            (u32+ (inexact->exact (pseudo-random-generator-x22 s))
-                                  z)
-                            Im2)))))])
-    (void)))
-
-(define (random-n! x Im k)
-  (let* ([y1 (bitwise-and x #xFFFF)]
-         [x (+ (* 30903 y1) (bitwise-arithmetic-shift-right x 16))]
-         [y2 (bitwise-and x #xFFFF)]
-         [x (+ (* 30903 y2) (bitwise-arithmetic-shift-right x 16))])
-    (k (modulo (+ (arithmetic-shift y1 16) y2) Im))
-    x))
-
-(define/who (pseudo-random-generator->vector s)
-  (check who pseudo-random-generator? s)
-  (vector (inexact->exact (pseudo-random-generator-x10 s))
-          (inexact->exact (pseudo-random-generator-x11 s))
-          (inexact->exact (pseudo-random-generator-x12 s))
-          (inexact->exact (pseudo-random-generator-x20 s))
-          (inexact->exact (pseudo-random-generator-x21 s))
-          (inexact->exact (pseudo-random-generator-x22 s))))
 
 (define (pseudo-random-generator-vector? v)
   (let ([in-range?
@@ -190,89 +56,3 @@
          (in-range? 5 4294944442)
          (or (nonzero? 0) (nonzero? 1) (nonzero? 2))
          (or (nonzero? 3) (nonzero? 4) (nonzero? 5)))))
-
-(define/who (vector->pseudo-random-generator orig-v)
-  (let ([iv (and (vector? orig-v)
-                 (= 6 (vector-length orig-v))
-                 (vector->immutable-vector orig-v))])
-    (check who pseudo-random-generator-vector? iv)
-    (let ([r (lambda (i) (exact->inexact (vector-ref iv i)))])
-      (new-pseudo-random-generator (r 0)
-                                   (r 1)
-                                   (r 2)
-                                   (r 3)
-                                   (r 4)
-                                   (r 5)))))
-
-(define/who (vector->pseudo-random-generator! s orig-v)
-  (check who pseudo-random-generator? s)
-  (let ([iv (and (vector? orig-v)
-                 (= 6 (vector-length orig-v))
-                 (vector->immutable-vector orig-v))])
-    (unless (pseudo-random-generator-vector? iv)
-      (raise-argument-error 'vector->pseudo-random-generator! "pseudo-random-generator-vector?" orig-v))
-    (let ([r (lambda (i) (exact->inexact (vector-ref iv i)))])
-      (pseudo-random-generator-x10-set! s (r 0))
-      (pseudo-random-generator-x11-set! s (r 1))
-      (pseudo-random-generator-x12-set! s (r 2))
-      (pseudo-random-generator-x20-set! s (r 3))
-      (pseudo-random-generator-x21-set! s (r 4))
-      (pseudo-random-generator-x22-set! s (r 5)))))
-
-(define (pseudo-random-generator-integer! s n)
-  ;; generate result in {0..n-1} using the rejection method
-  (let* ([n (exact->inexact n)]
-         [q (fltruncate (fl/ m1 n))]
-         [qn (fl* q n)]
-         [x (let loop ()
-              (let ([x (mrg32k3a s)])
-                (if (fl>= x qn)
-                    (loop)
-                    x)))]
-         [xq (fl/ x q)])
-    (inexact->exact (flfloor xq))))
-
-(define (pseudo-random-generator-real! s)
-  (fl* (fl+ (mrg32k3a s) 1.0) norm))
-
-;; ----------------------------------------
-
-(define/who current-pseudo-random-generator
-  (make-parameter (make-pseudo-random-generator)
-                  (lambda (v)
-                    (check who pseudo-random-generator? v)
-                    v)
-                  'current-pseudo-random-generator))
-
-(define/who random
-  (case-lambda
-   [() (pseudo-random-generator-real! (current-pseudo-random-generator))]
-   [(n)
-    (cond
-     [(pseudo-random-generator? n)
-      (pseudo-random-generator-real! n)]
-     [else
-      (check who
-             :test (and (integer? n)
-                        (exact? n)
-                        (<= 1 n 4294967087))
-             :contract "(or/c (integer-in 1 4294967087) pseudo-random-generator?)"
-             n)
-      (pseudo-random-generator-integer! (current-pseudo-random-generator) n)])]
-   [(n prg)
-    (check who
-           :test (and (integer? n)
-                      (exact? n)
-                      (<= 1 n 4294967087))
-           :contract "(or/c (integer-in 1 4294967087) pseudo-random-generator?)"
-           n)
-    (check who pseudo-random-generator? prg)
-    (pseudo-random-generator-integer! prg n)]))
-
-(define/who (random-seed k)
-  (check who
-         :test (and (exact-nonnegative-integer? k)
-                    (<= k (sub1 (expt 2 31))))
-         :contract "(integer-in 0 (sub1 (expt 2 31)))"
-         k)
-  (pseudo-random-generator-seed! (current-pseudo-random-generator) k))

racket/src/racket/src/schvers.h

@@ -16,7 +16,7 @@
 #define MZSCHEME_VERSION_X 7
 #define MZSCHEME_VERSION_Y 4
 #define MZSCHEME_VERSION_Z 0
-#define MZSCHEME_VERSION_W 12
+#define MZSCHEME_VERSION_W 13
 
 /* A level of indirection makes `#` work as needed: */
 #define AS_a_STR_HELPER(x) #x

racket/src/thread/sync.rkt

@@ -40,10 +40,10 @@
   #:transparent
         #:mutable)
 
-(define (make-syncer evt wraps)
+(define (make-syncer evt wraps prev)
-  (syncer evt wraps null #f null null null #f #f))
+  (syncer evt wraps null #f null null null prev #f))
 
-(define none-syncer (make-syncer #f null))
+(define none-syncer (make-syncer #f null #f))
 
 (define (make-syncing syncers #:disable-break [disable-break #f])
   (syncing #f ; selected
@@ -267,12 +267,11 @@
                 first
                 last)]
          [else
-          (define sr (make-syncer arg wraps))
+          (define sr (make-syncer arg wraps last))
           (unless (and (null? extended-commits)
                        (null? guarded-abandons))
             (set-syncer-commits! sr extended-commits)
             (set-syncer-abandons! sr guarded-abandons))
-          (set-syncer-prev! sr last)
           (when last
             (set-syncer-next! last sr))
           (loop (cdr evts)