suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cs: use pseudo-random generator from Chez Scheme

Browse Source 
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.
This commit is contained in:
Matthew Flatt 2019-10-07 11:35:18 -06:00
parent eda5f7a817
commit 4c8168cc9d
9 changed files with 83 additions and 272 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

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

38
pkgs/racket-benchmarks/tests/racket/benchmarks/control/sync.rkt Normal file
View File

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

1
pkgs/racket-benchmarks/tests/racket/benchmarks/control/thread.rkt
View File

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

4
racket/src/cs/bootstrap/record.rkt
View File

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

4
racket/src/cs/compile-file.ss
View File

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

5
racket/src/cs/rumble.sls
View File

@ -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?

290
racket/src/cs/rumble/random.ss
View File

@ -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 Im1 #xffffff2f)
(define Im2 #xffffa6bb)
(define m1 4294967087.0)
(define m2 4294944443.0)
(define/who random
(case-lambda
[() (pseudo-random-generator-next! (current-pseudo-random-generator))]
[(n)
(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 a12 1403580.0)
(define a13n 810728.0)
(define a21 527612.0)
(define a23n 1370589.0)
;; normalization factor 1/(m1 + 1)
(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/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))
(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))

2
racket/src/racket/src/schvers.h
View File

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

9
racket/src/thread/sync.rkt
View File

@ -40,10 +40,10 @@
#:transparent
#:mutable)
(define (make-syncer evt wraps)
(syncer evt wraps null #f null null null #f #f))
(define (make-syncer evt wraps prev)
(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)