add pseudo-random generator API
The MRG32k3a generator is fast when using unboxed floating-point arithemtic. Since the Scheme compiler doesn't yet support that, build MRG32k3a into the kernel and provide access via `pseudo-random-generator` functions. original commit: 3dd74679a6c2705440488d8c07c47852eb50a94b
This commit is contained in:
Matthew Flatt
parent
174c416f9e
commit
18d18b7ff6
|
|
@ -51,13 +51,13 @@ csrc=statics.c segment.c alloc.c symbol.c intern.c gcwrapper.c gc-oce.c gc-ocd.c
|
|||
number.c schsig.c io.c new-io.c print.c fasl.c vfasl.c stats.c\
|
||||
foreign.c prim.c prim5.c flushcache.c\
|
||||
windows.c\
|
||||
schlib.c thread.c expeditor.c scheme.c compress-io.c
|
||||
schlib.c thread.c expeditor.c scheme.c compress-io.c random.c
|
||||
|
||||
cobj=statics.obj segment.obj alloc.obj symbol.obj intern.obj gcwrapper.obj gc-oce.obj gc-ocd.obj\
|
||||
number.obj schsig.obj io.obj new-io.obj print.obj fasl.obj vfasl.obj stats.obj\
|
||||
foreign.obj prim.obj prim5.obj flushcache.obj\
|
||||
windows.obj\
|
||||
schlib.obj thread.obj expeditor.obj scheme.obj compress-io.obj
|
||||
schlib.obj thread.obj expeditor.obj scheme.obj compress-io.obj random.obj
|
||||
|
||||
hsrc=system.h types.h version.h globals.h externs.h compress-io.h segment.h gc.c thread.h sort.h itest.c
|
||||
|
||||
|
|
|
|||
|
|
@ -50,13 +50,13 @@ csrc=statics.c segment.c alloc.c symbol.c intern.c gcwrapper.c gc-oce.c gc-ocd.c
|
|||
number.c schsig.c io.c new-io.c print.c fasl.c vfasl.c stats.c\
|
||||
foreign.c prim.c prim5.c flushcache.c\
|
||||
windows.c\
|
||||
schlib.c thread.c expeditor.c scheme.c compress-io.c
|
||||
schlib.c thread.c expeditor.c scheme.c compress-io.c random.c
|
||||
|
||||
cobj=statics.obj segment.obj alloc.obj symbol.obj intern.obj gcwrapper.obj gc-oce.obj gc-ocd.obj\
|
||||
number.obj schsig.obj io.obj new-io.obj print.obj fasl.obj vfasl.obj stats.obj\
|
||||
foreign.obj prim.obj prim5.obj flushcache.obj\
|
||||
windows.obj\
|
||||
schlib.obj thread.obj expeditor.obj scheme.obj compress-io.obj
|
||||
schlib.obj thread.obj expeditor.obj scheme.obj compress-io.obj random.obj
|
||||
|
||||
hsrc=system.h types.h version.h globals.h externs.h compress-io.h segment.h gc.c thread.h sort.h itest.c
|
||||
|
||||
|
|
|
|||
|
|
@ -51,13 +51,13 @@ csrc=statics.c segment.c alloc.c symbol.c intern.c gcwrapper.c gc-oce.c gc-ocd.c
|
|||
number.c schsig.c io.c new-io.c print.c fasl.c vfasl.c stats.c\
|
||||
foreign.c prim.c prim5.c flushcache.c\
|
||||
windows.c\
|
||||
schlib.c thread.c expeditor.c scheme.c compress-io.c
|
||||
schlib.c thread.c expeditor.c scheme.c compress-io.c random.c
|
||||
|
||||
cobj=statics.obj segment.obj alloc.obj symbol.obj intern.obj gcwrapper.obj gc-oce.obj gc-ocd.obj\
|
||||
number.obj schsig.obj io.obj new-io.obj print.obj fasl.obj vfasl.obj stats.obj\
|
||||
foreign.obj prim.obj prim5.obj flushcache.obj\
|
||||
windows.obj\
|
||||
schlib.obj thread.obj expeditor.obj scheme.obj compress-io.obj
|
||||
schlib.obj thread.obj expeditor.obj scheme.obj compress-io.obj random.obj
|
||||
|
||||
hsrc=system.h types.h version.h globals.h externs.h compress-io.h segment.h gc.c thread.h sort.h itest.c
|
||||
|
||||
|
|
|
|||
|
|
@ -50,13 +50,13 @@ csrc=statics.c segment.c alloc.c symbol.c intern.c gcwrapper.c gc-oce.c gc-ocd.c
|
|||
number.c schsig.c io.c new-io.c print.c fasl.c vfasl.c stats.c\
|
||||
foreign.c prim.c prim5.c flushcache.c\
|
||||
windows.c\
|
||||
schlib.c thread.c expeditor.c scheme.c compress-io.c
|
||||
schlib.c thread.c expeditor.c scheme.c compress-io.c random.c
|
||||
|
||||
cobj=statics.obj segment.obj alloc.obj symbol.obj intern.obj gcwrapper.obj gc-oce.obj gc-ocd.obj\
|
||||
number.obj schsig.obj io.obj new-io.obj print.obj fasl.obj vfasl.obj stats.obj\
|
||||
foreign.obj prim.obj prim5.obj flushcache.obj\
|
||||
windows.obj\
|
||||
schlib.obj thread.obj expeditor.obj scheme.obj compress-io.obj
|
||||
schlib.obj thread.obj expeditor.obj scheme.obj compress-io.obj random.obj
|
||||
|
||||
hsrc=system.h types.h version.h globals.h externs.h compress-io.h segment.h gc.c thread.h sort.h itest.c
|
||||
|
||||
|
|
|
|||
|
|
@ -34,7 +34,7 @@ KernelLibLinkLibs=${zlibLib} ${LZ4Lib}
|
|||
|
||||
kernelsrc=statics.c segment.c alloc.c symbol.c intern.c gcwrapper.c gc-ocd.c gc-oce.c\
|
||||
number.c schsig.c io.c new-io.c print.c fasl.c vfasl.c stats.c foreign.c prim.c prim5.c flushcache.c\
|
||||
schlib.c thread.c expeditor.c scheme.c compress-io.c
|
||||
schlib.c thread.c expeditor.c scheme.c compress-io.c random.c
|
||||
|
||||
kernelobj=${kernelsrc:%.c=%.$o} ${mdobj}
|
||||
|
||||
|
|
|
|||
|
|
@ -420,5 +420,12 @@ extern char *S_windows_getcwd(char *buffer, int maxlen);
|
|||
extern void S_expeditor_init PROTO((void));
|
||||
#endif /* FEATURE_EXPEDITOR */
|
||||
|
||||
/* random.c */
|
||||
uptr S_random_state_next_integer PROTO((ptr s, uptr n));
|
||||
double S_random_state_next_double PROTO((ptr s));
|
||||
void S_random_state_init PROTO((ptr s, UINT x));
|
||||
IBOOL S_random_state_check PROTO((double x10, double x11, double x12,
|
||||
double x20, double x21, double x22));
|
||||
|
||||
/* statics.c */
|
||||
extern void scheme_statics();
|
||||
|
|
|
|||
|
|
@ -1596,6 +1596,10 @@ void S_prim5_init() {
|
|||
Sforeign_symbol("(cs)s_float", (void *)s_float);
|
||||
Sforeign_symbol("(cs)s_flrandom", (void *)s_flrandom);
|
||||
Sforeign_symbol("(cs)s_fxrandom", (void *)s_fxrandom);
|
||||
Sforeign_symbol("(cs)s_random_state_next_integer", (void *)S_random_state_next_integer);
|
||||
Sforeign_symbol("(cs)s_random_state_next_double", (void *)S_random_state_next_double);
|
||||
Sforeign_symbol("(cs)s_random_state_init", (void *)S_random_state_init);
|
||||
Sforeign_symbol("(cs)s_random_state_check", (void *)S_random_state_check);
|
||||
Sforeign_symbol("(cs)s_integer_length", (void *)S_integer_length);
|
||||
Sforeign_symbol("(cs)s_big_first_bit_set", (void *)S_big_first_bit_set);
|
||||
Sforeign_symbol("(cs)s_make_code", (void *)s_make_code);
|
||||
|
|
|
|||
188
c/random.c
Normal file
188
c/random.c
Normal file
|
|
@ -0,0 +1,188 @@
|
|||
#include "system.h"
|
||||
|
||||
/*
|
||||
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.
|
||||
*/
|
||||
|
||||
/* Representation is arecord with 6 `double` fields: */
|
||||
|
||||
#define RANDSTATEX10(x) (((double*)&RECORDINSTIT(x, 0))[0])
|
||||
#define RANDSTATEX11(x) (((double*)&RECORDINSTIT(x, 0))[1])
|
||||
#define RANDSTATEX12(x) (((double*)&RECORDINSTIT(x, 0))[2])
|
||||
#define RANDSTATEX20(x) (((double*)&RECORDINSTIT(x, 0))[3])
|
||||
#define RANDSTATEX21(x) (((double*)&RECORDINSTIT(x, 0))[4])
|
||||
#define RANDSTATEX22(x) (((double*)&RECORDINSTIT(x, 0))[5])
|
||||
|
||||
/* The Generator
|
||||
=============
|
||||
*/
|
||||
|
||||
/* moduli of the components */
|
||||
#define Im1 0xffffff2f
|
||||
#define Im2 0xffffa6bb
|
||||
#define m1 4294967087.0
|
||||
#define m2 4294944443.0
|
||||
|
||||
/* 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 */
|
||||
|
||||
static double mrg32k3a(ptr s) { /* (double), in {0..m1-1} */
|
||||
double x10, x20, y;
|
||||
iptr k10, k20;
|
||||
|
||||
/* component 1 */
|
||||
x10 = a12*(RANDSTATEX11(s)) - a13n*(RANDSTATEX12(s));
|
||||
k10 = (iptr)(x10 / m1);
|
||||
x10 -= k10 * m1;
|
||||
if (x10 < 0.0)
|
||||
x10 += m1;
|
||||
RANDSTATEX12(s) = RANDSTATEX11(s);
|
||||
RANDSTATEX11(s) = RANDSTATEX10(s);
|
||||
RANDSTATEX10(s) = x10;
|
||||
|
||||
/* component 2 */
|
||||
x20 = a21*(RANDSTATEX20(s)) - a23n*(RANDSTATEX22(s));
|
||||
k20 = (iptr)(x20 / m2);
|
||||
x20 -= k20 * m2;
|
||||
if (x20 < 0.0)
|
||||
x20 += m2;
|
||||
RANDSTATEX22(s) = RANDSTATEX21(s);
|
||||
RANDSTATEX21(s) = RANDSTATEX20(s);
|
||||
RANDSTATEX20(s) = x20;
|
||||
|
||||
/* combination of component */
|
||||
y = x10 - x20;
|
||||
if (y < 0.0)
|
||||
y += m1;
|
||||
return y;
|
||||
}
|
||||
|
||||
/**************************************************/
|
||||
|
||||
/* The number `n` must be no more than 4294967087 */
|
||||
uptr S_random_state_next_integer(ptr s, uptr n)
|
||||
{
|
||||
double x, q, qn, xq;
|
||||
|
||||
/* generate result in {0..n-1} using the rejection method */
|
||||
q = (double)( (uptr)(m1 / (double)n) );
|
||||
qn = q * n;
|
||||
do {
|
||||
x = mrg32k3a(s);
|
||||
} while (x >= qn);
|
||||
xq = x / q;
|
||||
|
||||
/* return result */
|
||||
return (uptr)xq;
|
||||
}
|
||||
|
||||
double S_random_state_next_double(ptr s)
|
||||
{
|
||||
double x;
|
||||
x = mrg32k3a(s);
|
||||
return (x + 1.0) * norm;
|
||||
}
|
||||
|
||||
/**************************************************/
|
||||
|
||||
static UINT _random_m(UINT *_x)
|
||||
{
|
||||
UINT x, y;
|
||||
x = *_x;
|
||||
y = x & 0xFFFF;
|
||||
x = (30903 * y) + (x >> 16);
|
||||
*_x = x;
|
||||
return y;
|
||||
}
|
||||
|
||||
static int _random_n(UINT *_x, int n)
|
||||
{
|
||||
return ((_random_m(_x) << 16) + _random_m(_x)) % n;
|
||||
}
|
||||
|
||||
static void sch_srand_half(UINT x, ptr s)
|
||||
{
|
||||
/* Due to integer overflow, this doesn't match the Scheme implementation!
|
||||
We use "int" instead of "long" to make the overflow consistent
|
||||
across platforms (since "long" is sometimes 64 bits). */
|
||||
UINT z;
|
||||
z = _random_n(&x, Im1-1);
|
||||
RANDSTATEX10(s) = (double)(1 + (((UINT)RANDSTATEX10(s) + z) % (Im1 - 1)));
|
||||
z = _random_n(&x, Im1);
|
||||
RANDSTATEX11(s) = (double)(((UINT)RANDSTATEX11(s) + z) % Im1);
|
||||
z = _random_n(&x, Im1);
|
||||
RANDSTATEX12(s) = (double)(((UINT)RANDSTATEX12(s) + z) % Im1);
|
||||
z = _random_n(&x, Im2-1);
|
||||
RANDSTATEX20(s) = (double)(1 + (((UINT)RANDSTATEX20(s) + z) % (Im2 - 1)));
|
||||
z = _random_n(&x, Im2);
|
||||
RANDSTATEX21(s) = (double)(((UINT)RANDSTATEX21(s) + z) % Im2);
|
||||
z = _random_n(&x, Im2);
|
||||
RANDSTATEX22(s) = (double)(((UINT)RANDSTATEX22(s) + z) % Im2);
|
||||
|
||||
/* Due to the mismatch, maybe it's possible that we can hit a degeneracy?
|
||||
Double-check, just in case... */
|
||||
if (!RANDSTATEX10(s) && !RANDSTATEX11(s) && !RANDSTATEX12(s))
|
||||
RANDSTATEX10(s) = 1;
|
||||
if (!RANDSTATEX20(s) && !RANDSTATEX21(s) && !RANDSTATEX22(s))
|
||||
RANDSTATEX20(s) = 1;
|
||||
}
|
||||
|
||||
void S_random_state_init(ptr s, UINT x)
|
||||
{
|
||||
/* Initial values are from Sebastian Egner's implementation: */
|
||||
RANDSTATEX10(s) = 1062452522.0;
|
||||
RANDSTATEX11(s) = 2961816100.0;
|
||||
RANDSTATEX12(s) = 342112271.0;
|
||||
RANDSTATEX20(s) = 2854655037.0;
|
||||
RANDSTATEX21(s) = 3321940838.0;
|
||||
RANDSTATEX22(s) = 3542344109.0;
|
||||
|
||||
sch_srand_half(x & 0xFFFF, s);
|
||||
sch_srand_half((x >> 16) & 0xFFFF, s);
|
||||
}
|
||||
|
||||
/**************************************************/
|
||||
|
||||
IBOOL S_random_state_check(double x10, double x11, double x12,
|
||||
double x20, double x21, double x22)
|
||||
{
|
||||
#define CHECK_RS_FIELD(x, top) if ((x < 0.0) || (x > ((top) - 1))) return 0;
|
||||
|
||||
CHECK_RS_FIELD(x10, Im1)
|
||||
CHECK_RS_FIELD(x11, Im1)
|
||||
CHECK_RS_FIELD(x12, Im1)
|
||||
CHECK_RS_FIELD(x20, Im2)
|
||||
CHECK_RS_FIELD(x21, Im2)
|
||||
CHECK_RS_FIELD(x22, Im2)
|
||||
|
||||
if ((x10 == 0.0) && (x11 == 0.0) && (x12 == 0.0))
|
||||
return 0;
|
||||
if ((x20 == 0.0) && (x21 == 0.0) && (x22 == 0.0))
|
||||
return 0;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
|
@ -1419,6 +1419,86 @@ random seed to the argument.
|
|||
(eqv? (random 1.0) r1))) ;=> #t
|
||||
\endschemedisplay
|
||||
|
||||
%----------------------------------------------------------------------------
|
||||
\entryheader
|
||||
\formdef{make-pseudo-random-generator}{\categoryprocedure}{(make-pseudo-random-generator)}
|
||||
\returns a fresh pseudo-random generator
|
||||
\listlibraries
|
||||
\endnoskipentryheader
|
||||
|
||||
\noindent
|
||||
Creates a pseduo-random generator state for use with
|
||||
\scheme{pseduo-random-generator-next!}. This generator use a more
|
||||
modern algorithm than \scheme{random} and generates number sequences
|
||||
that better approximate true randomness.
|
||||
|
||||
The initial state of the pseduo-random generator is based on the
|
||||
current time, which is good enough for generating variability in most
|
||||
programs but not good enough for security purposes.
|
||||
|
||||
%----------------------------------------------------------------------------
|
||||
\entryheader
|
||||
\formdef{pseudo-random-generator?}{\categoryprocedure}{(pseudo-random-generator? \var{val})}
|
||||
\returns a boolean
|
||||
\listlibraries
|
||||
\endnoskipentryheader
|
||||
|
||||
\noindent
|
||||
Checks whether \var{val} is a pseudo-random generator state.
|
||||
|
||||
%----------------------------------------------------------------------------
|
||||
\entryheader
|
||||
\formdef{pseudo-random-generator-next!}{\categoryprocedure}{(pseudo-random-generator-next! \var{prgen})}
|
||||
\formdef{pseudo-random-generator-next!}{\categoryprocedure}{(pseudo-random-generator-next! \var{prgen} \var{below-int})}
|
||||
\returns a pseduo-random number
|
||||
\listlibraries
|
||||
\endnoskipentryheader
|
||||
|
||||
\noindent
|
||||
\var{prgen} must be a psuedo-random generator state. If \var{below-int} is
|
||||
provided, it must be a positive, exact integer.
|
||||
|
||||
Steps a pseduo-random generator to produce a number. The result is an
|
||||
inexact number between \scheme{0.0} (inclusive) and \scheme{1.0}
|
||||
(exclusive) if \var{below-int} is not provided. If \scheme{below-int} is
|
||||
provided, the result is an exact integer between \scheme{0} (inclusive)
|
||||
and \scheme{below-int} (exclusive).
|
||||
|
||||
%----------------------------------------------------------------------------
|
||||
\entryheader
|
||||
\formdef{pseudo-random-generator-seed!}{\categoryprocedure}{(pseudo-random-generator-seed! \var{prgen} \var{seed-int})}
|
||||
\returns unspecified
|
||||
\listlibraries
|
||||
\endnoskipentryheader
|
||||
|
||||
\noindent
|
||||
\var{prgen} must be a psuedo-random generator state, and \var{seed-int} must
|
||||
be a positive, exact integer.
|
||||
|
||||
Sets the state of a pseduo-random generator using only 31 or so bits
|
||||
of \var{seed-int}. This procedure is useful for initializing the state
|
||||
of a pseduo-random generator to one of a small number of known states
|
||||
for triggering predicatble output, but it is not a good way to put a
|
||||
generator into an unpredictable state.
|
||||
|
||||
%----------------------------------------------------------------------------
|
||||
\entryheader
|
||||
\formdef{pseudo-random-generator->vector}{\categoryprocedure}{(pseudo-random-generator->vector \var{prgen})}
|
||||
\formdef{vector->pseudo-random-generator}{\categoryprocedure}{(vector->pseudo-random-generator \var{vec})}
|
||||
\formdef{vector->pseudo-random-generator!}{\categoryprocedure}{(vector->pseudo-random-generator! \var{prgen} \var{vec})}
|
||||
\returns unspecified
|
||||
\listlibraries
|
||||
\endnoskipentryheader
|
||||
|
||||
\noindent
|
||||
\var{prgen} must be a psuedo-random generator state, and \var{vec} must
|
||||
be a vector previously produced by \scheme{pseudo-random-generator->vector}.
|
||||
|
||||
\scheme{pseudo-random-generator->vector} converts the current state of
|
||||
a pseduo-random generator to a vector of numbers, \scheme{vector->pseudo-random-generator}
|
||||
creates a fresh pseudo-random generator with the same state, and
|
||||
\scheme{vector->pseudo-random-generator!}
|
||||
changes an existing pseudo-random generator to have the same state.
|
||||
|
||||
|
||||
\section{Miscellaneous Numeric Operations\label{SECTNUMERICMISC}}
|
||||
|
|
|
|||
|
|
@ -62,7 +62,7 @@ InstallLZ4Target=
|
|||
# no changes should be needed below this point #
|
||||
###############################################################################
|
||||
|
||||
Version=csv9.5.3.2
|
||||
Version=csv9.5.3.3
|
||||
Include=boot/$m
|
||||
PetiteBoot=boot/$m/petite.boot
|
||||
SchemeBoot=boot/$m/scheme.boot
|
||||
|
|
|
|||
74
mats/5_3.ms
74
mats/5_3.ms
|
|
@ -2567,6 +2567,80 @@
|
|||
#t)
|
||||
)
|
||||
|
||||
(mat pseudo-random-generator
|
||||
(pseudo-random-generator? (make-pseudo-random-generator))
|
||||
(not (pseudo-random-generator? 10))
|
||||
(not (pseudo-random-generator? (vector 1 2 3)))
|
||||
|
||||
(error? (pseudo-random-generator-next! 10))
|
||||
(error? (pseudo-random-generator-next! (vector 1 2 3)))
|
||||
|
||||
(error? (pseudo-random-generator-next! (make-pseudo-random-generator) "apple"))
|
||||
(error? (pseudo-random-generator-next! (make-pseudo-random-generator) 0))
|
||||
(error? (pseudo-random-generator-next! (make-pseudo-random-generator) -10))
|
||||
(error? (pseudo-random-generator-next! (make-pseudo-random-generator) (- (expt 2 100))))
|
||||
(error? (pseudo-random-generator-next! (make-pseudo-random-generator) 10.0))
|
||||
|
||||
(error? (pseudo-random-generator-seed! 10 10))
|
||||
(error? (pseudo-random-generator-seed! (vector 1 2 3) 10))
|
||||
(error? (pseudo-random-generator-seed! (make-pseudo-random-generator) 10.0))
|
||||
(error? (pseudo-random-generator-seed! (make-pseudo-random-generator) 0))
|
||||
(error? (pseudo-random-generator-seed! (make-pseudo-random-generator) -1))
|
||||
|
||||
(error? (pseudo-random-generator->vector 0))
|
||||
(error? (vector->pseudo-random-generator 0))
|
||||
(error? (vector->pseudo-random-generator (vector 1 2 3 4 5)))
|
||||
(error? (vector->pseudo-random-generator (vector 1.0 2 3 4 5 6)))
|
||||
(error? (vector->pseudo-random-generator (vector 1 #f 3 4 5 6)))
|
||||
(error? (vector->pseudo-random-generator (vector 0 0 0 0 0 0))) ; would be degenerate state
|
||||
(error? (vector->pseudo-random-generator! 0 (vector 1 2 3 4 5)))
|
||||
(error? (vector->pseudo-random-generator! (make-pseudo-random-generator) 0))
|
||||
(error? (vector->pseudo-random-generator! (make-pseudo-random-generator) (vector 0 0 0 0 0 0)))
|
||||
|
||||
(begin
|
||||
(define prgen (make-pseudo-random-generator))
|
||||
(define init-pregen-vec (pseudo-random-generator->vector prgen))
|
||||
(vector? init-pregen-vec))
|
||||
(equal? init-pregen-vec (pseudo-random-generator->vector prgen))
|
||||
(begin
|
||||
(define first-prgen-number (pseudo-random-generator-next! prgen))
|
||||
(inexact? first-prgen-number))
|
||||
(and (<= 0.0 first-prgen-number)
|
||||
(< first-prgen-number 1.0))
|
||||
(not (equal? init-pregen-vec (pseudo-random-generator->vector prgen)))
|
||||
(= first-prgen-number
|
||||
(pseudo-random-generator-next!
|
||||
(vector->pseudo-random-generator init-pregen-vec)))
|
||||
(let loop ([i 10000])
|
||||
(or (zero? i)
|
||||
(let ([n (pseudo-random-generator-next! prgen i)])
|
||||
(and (exact? n)
|
||||
(integer? n)
|
||||
(< -1 n i)
|
||||
(loop (sub1 i))))))
|
||||
(equal? (void) (vector->pseudo-random-generator! prgen init-pregen-vec))
|
||||
(= first-prgen-number (pseudo-random-generator-next! prgen))
|
||||
(equal? (void) (pseudo-random-generator-seed! prgen 45))
|
||||
(= 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))))))
|
||||
)
|
||||
|
||||
|
||||
(mat inexact
|
||||
(error? (inexact))
|
||||
(error? (inexact 1 2))
|
||||
|
|
|
|||
|
|
@ -424,6 +424,7 @@
|
|||
[(pathname) "a" 'a #f]
|
||||
[(pfixnum) 1 0 #f]
|
||||
[(phantom-bytevector) *phantom-bytevector '#vu8(0) #f]
|
||||
[(pseudo-random-generator) *pseudo-random-generator #f]
|
||||
[(port) (current-input-port) 0 #f]
|
||||
[(procedure) values 0 #f]
|
||||
[(ptr) 1.0+2.0i]
|
||||
|
|
|
|||
|
|
@ -1308,6 +1308,27 @@ primvars.mo:Expected error in mat trace-output-port: "trace-output-port: #<input
|
|||
5_3.mo:Expected error in mat random-seed: "random-seed: invalid argument 0".
|
||||
5_3.mo:Expected error in mat random-seed: "random-seed: invalid argument -1".
|
||||
5_3.mo:Expected error in mat random-seed: "random-seed: invalid argument <int>".
|
||||
5_3.mo:Expected error in mat pseudo-random-generator: "pseudo-random-generator-next!: not a pseudo-random generator 10".
|
||||
5_3.mo:Expected error in mat pseudo-random-generator: "pseudo-random-generator-next!: not a pseudo-random generator #(1 2 3)".
|
||||
5_3.mo:Expected error in mat pseudo-random-generator: "pseudo-random-generator-next!: not a positive exact integer "apple"".
|
||||
5_3.mo:Expected error in mat pseudo-random-generator: "pseudo-random-generator-next!: not a positive exact integer 0".
|
||||
5_3.mo:Expected error in mat pseudo-random-generator: "pseudo-random-generator-next!: not a positive exact integer -10".
|
||||
5_3.mo:Expected error in mat pseudo-random-generator: "pseudo-random-generator-next!: not a positive exact integer -1267650600228229401496703205376".
|
||||
5_3.mo:Expected error in mat pseudo-random-generator: "pseudo-random-generator-next!: not a positive exact integer 10.0".
|
||||
5_3.mo:Expected error in mat pseudo-random-generator: "pseudo-random-generator-seed!: not a pseudo-random generator 10".
|
||||
5_3.mo:Expected error in mat pseudo-random-generator: "pseudo-random-generator-seed!: not a pseudo-random generator #(1 2 3)".
|
||||
5_3.mo:Expected error in mat pseudo-random-generator: "pseudo-random-generator-seed!: not a positive exact integer 10.0".
|
||||
5_3.mo:Expected error in mat pseudo-random-generator: "pseudo-random-generator-seed!: not a positive exact integer 0".
|
||||
5_3.mo:Expected error in mat pseudo-random-generator: "pseudo-random-generator-seed!: not a positive exact integer -1".
|
||||
5_3.mo:Expected error in mat pseudo-random-generator: "pseudo-random-generator->vector: not a pseudo-random generator 0".
|
||||
5_3.mo:Expected error in mat pseudo-random-generator: "vector->pseudo-random-generator: not a valid pseudo-random generator state vector 0".
|
||||
5_3.mo:Expected error in mat pseudo-random-generator: "vector->pseudo-random-generator: not a valid pseudo-random generator state vector #(1 2 3 4 5)".
|
||||
5_3.mo:Expected error in mat pseudo-random-generator: "vector->pseudo-random-generator: not a valid pseudo-random generator state vector #(1.0 2 3 4 5 6)".
|
||||
5_3.mo:Expected error in mat pseudo-random-generator: "exact?: #f is not a number".
|
||||
5_3.mo:Expected error in mat pseudo-random-generator: "vector->pseudo-random-generator: not a valid pseudo-random generator state vector #(0 0 0 0 0 0)".
|
||||
5_3.mo:Expected error in mat pseudo-random-generator: "vector->pseudo-random-generator!: not a pseudo-random generator 0".
|
||||
5_3.mo:Expected error in mat pseudo-random-generator: "vector->pseudo-random-generator!: not a valid pseudo-random generator state vector 0".
|
||||
5_3.mo:Expected error in mat pseudo-random-generator: "vector->pseudo-random-generator!: not a valid pseudo-random generator state vector #(0 0 0 0 0 0)".
|
||||
5_3.mo:Expected error in mat inexact: "incorrect argument count in call (inexact)".
|
||||
5_3.mo:Expected error in mat inexact: "incorrect argument count in call (inexact 1 2)".
|
||||
5_3.mo:Expected error in mat inexact: "inexact: a is not a number".
|
||||
|
|
|
|||
109
s/5_3.ss
109
s/5_3.ss
|
|
@ -2597,6 +2597,115 @@
|
|||
[else (nonexact-integer-error '$quotient-remainder x)])]
|
||||
[else (nonexact-integer-error '$quotient-remainder y)])))
|
||||
|
||||
(let ()
|
||||
(define-record pseudo-random-generator
|
||||
((mutable double x10)
|
||||
(mutable double x11)
|
||||
(mutable double x12)
|
||||
(mutable double x20)
|
||||
(mutable double x21)
|
||||
(mutable double x22))
|
||||
()
|
||||
((constructor create-pseudo-random-generator)
|
||||
(predicate is-pseudo-random-generator?)))
|
||||
|
||||
(set! pseudo-random-generator?
|
||||
(lambda (x) (is-pseudo-random-generator? x)))
|
||||
|
||||
(let ([init! (foreign-procedure "(cs)s_random_state_init" (scheme-object unsigned) void)])
|
||||
(set! make-pseudo-random-generator
|
||||
(lambda ()
|
||||
(let ([s (create-pseudo-random-generator 0.0 0.0 0.0 0.0 0.0 0.0)]
|
||||
[t (current-time 'time-utc)])
|
||||
(init! s (bitwise-and (+ (time-second t) (time-nanosecond t))
|
||||
#xFFFFFFFF))
|
||||
s)))
|
||||
(set-who! pseudo-random-generator-seed!
|
||||
(lambda (s n)
|
||||
(unless (is-pseudo-random-generator? s) ($oops who "not a pseudo-random generator ~s" s))
|
||||
(unless (or (and (fixnum? n) (fxpositive? n))
|
||||
(and (bignum? n) ($bigpositive? n)))
|
||||
($oops who "not a positive exact integer ~s" n))
|
||||
(init! s (bitwise-and n #xFFFFFFFF)))))
|
||||
|
||||
(set-who! pseudo-random-generator-next!
|
||||
(let ([random-double (foreign-procedure "(cs)s_random_state_next_double"
|
||||
(scheme-object) double)]
|
||||
[random-int (foreign-procedure "(cs)s_random_state_next_integer"
|
||||
(scheme-object uptr) uptr)])
|
||||
(case-lambda
|
||||
[(s)
|
||||
(unless (is-pseudo-random-generator? s) ($oops who "not a pseudo-random generator ~s" s))
|
||||
(random-double s)]
|
||||
[(s x)
|
||||
(define (random-integer s x)
|
||||
(modulo (let loop ([bits (integer-length x)])
|
||||
(cond
|
||||
[(<= bits 0) 0]
|
||||
[else (bitwise-ior (bitwise-arithmetic-shift-left (loop (- bits 24)) 24)
|
||||
(random-int s #xFFFFFF))]))
|
||||
x))
|
||||
(unless (is-pseudo-random-generator? s) ($oops who "not a pseudo-random generator ~s" s))
|
||||
(cond
|
||||
[(fixnum? x)
|
||||
(unless (fxpositive? x) ($oops who "not a positive exact integer ~s" x))
|
||||
(meta-cond
|
||||
[(fixnum? 4294967087)
|
||||
(if (fx< x 4294967087)
|
||||
(random-int s x)
|
||||
(random-integer s x))]
|
||||
[else
|
||||
(random-int s x)])]
|
||||
[(bignum? x)
|
||||
(unless ($bigpositive? x) ($oops who "not a positive exact integer ~s" x))
|
||||
(random-integer s x)]
|
||||
[else
|
||||
($oops who "not a positive exact integer ~s" x)])])))
|
||||
|
||||
(set-who! pseudo-random-generator->vector
|
||||
(lambda (s)
|
||||
(unless (is-pseudo-random-generator? s) ($oops who "not a pseudo-random generator ~s" 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)))))
|
||||
|
||||
(let ([vector->prgen
|
||||
(let ([ok? (foreign-procedure "(cs)s_random_state_check" (double double double double double double) boolean)])
|
||||
(lambda (who s v)
|
||||
(define (bad-vector)
|
||||
($oops who "not a valid pseudo-random generator state vector ~s" v))
|
||||
(define (int->double i)
|
||||
(unless (and (exact? i) (integer? i)) (bad-vector))
|
||||
(exact->inexact i))
|
||||
(unless (and (vector? v) (= 6 (vector-length v))) (bad-vector))
|
||||
(let ([x10 (int->double (vector-ref v 0))]
|
||||
[x11 (int->double (vector-ref v 1))]
|
||||
[x12 (int->double (vector-ref v 2))]
|
||||
[x20 (int->double (vector-ref v 3))]
|
||||
[x21 (int->double (vector-ref v 4))]
|
||||
[x22 (int->double (vector-ref v 5))])
|
||||
(unless (ok? x10 x11 x12 x20 x21 x22) (bad-vector))
|
||||
(cond
|
||||
[s
|
||||
(set-pseudo-random-generator-x10! s x10)
|
||||
(set-pseudo-random-generator-x11! s x11)
|
||||
(set-pseudo-random-generator-x12! s x12)
|
||||
(set-pseudo-random-generator-x20! s x20)
|
||||
(set-pseudo-random-generator-x21! s x21)
|
||||
(set-pseudo-random-generator-x22! s x22)]
|
||||
[else
|
||||
(create-pseudo-random-generator x10 x11 x12 x20 x21 x22)]))))])
|
||||
|
||||
(set-who! vector->pseudo-random-generator
|
||||
(lambda (vec) (vector->prgen who #f vec)))
|
||||
(set-who! vector->pseudo-random-generator!
|
||||
(lambda (s vec)
|
||||
(unless (is-pseudo-random-generator? s) ($oops who "not a pseudo-random generator ~s" s))
|
||||
(vector->prgen who s vec)))))
|
||||
|
||||
(set! random
|
||||
(let ([fxrandom (foreign-procedure "(cs)s_fxrandom"
|
||||
(scheme-object) scheme-object)]
|
||||
|
|
|
|||
|
|
@ -328,7 +328,7 @@
|
|||
[(_ foo e1 e2) e1] ...
|
||||
[(_ bar e1 e2) e2]))))])))
|
||||
|
||||
(define-constant scheme-version #x09050302)
|
||||
(define-constant scheme-version #x09050303)
|
||||
|
||||
(define-syntax define-machine-types
|
||||
(lambda (x)
|
||||
|
|
|
|||
|
|
@ -1468,6 +1468,7 @@
|
|||
(make-output-port [sig [(procedure string) -> (textual-output-port)]] [flags alloc])
|
||||
(make-parameter [sig [(ptr) (ptr procedure) -> (procedure)]] [flags true cp02 cp03])
|
||||
(make-phantom-bytevector [sig [(uptr) -> (phantom-bytevector)]] [flags true])
|
||||
(make-pseudo-random-generator [sig [() -> (pseudo-random-generator)]] [flags true])
|
||||
(make-record-type [sig [(sub-ptr sub-list) (maybe-rtd sub-ptr sub-list) -> (rtd)]] [flags pure alloc cp02])
|
||||
(make-source-condition [sig [(ptr) -> (condition)]] [flags pure unrestricted mifoldable discard])
|
||||
(make-source-file-descriptor [sig [(string binary-input-port) (string binary-input-port ptr) (string binary-input-port ptr ptr) -> (sfd)]] [flags true])
|
||||
|
|
@ -1565,6 +1566,10 @@
|
|||
(putprop [sig [(symbol ptr ptr) -> (void)]] [flags true safeongoodargs])
|
||||
(putenv [sig [(string string) -> (void)]] [flags true])
|
||||
(profile-query-weight [sig [(ptr) -> (maybe-flonum)]] [flags unrestricted discard])
|
||||
(pseudo-random-generator->vector [sig [(pseudo-random-generator) -> (vector)]] [flags])
|
||||
(pseudo-random-generator-seed! [sig [(pseudo-random-generator sub-number) -> (void)]] [flags])
|
||||
(pseudo-random-generator-next! [sig [(pseudo-random-generator) -> (number)] [(sub-number pseudo-random-generator) -> (number)]] [flags])
|
||||
(pseudo-random-generator? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard])
|
||||
(random [sig [(sub-number) -> (number)]] [flags alloc])
|
||||
(ratnum? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard])
|
||||
(read-token [sig [() (textual-input-port) (textual-input-port sfd) -> (symbol ptr maybe-uint maybe-uint)]] [flags])
|
||||
|
|
@ -1733,6 +1738,8 @@
|
|||
(vector-cas! [sig [(vector sub-index ptr ptr) -> (boolean)]] [flags])
|
||||
(vector-copy [sig [(vector) -> (vector)]] [flags alloc safeongoodargs])
|
||||
(vector->immutable-vector [sig [(vector) -> (vector)]] [flags alloc safeongoodargs])
|
||||
(vector->pseudo-random-generator [sig [(vector) -> (pseudo-random-generator)]] [flags])
|
||||
(vector->pseudo-random-generator! [sig [(pseudo-random-generator vector) -> (void)]] [flags])
|
||||
(vector-set-fixnum! [sig [(vector sub-index fixnum) -> (void)]] [flags true])
|
||||
(virtual-register [sig [(sub-index) -> (ptr)]] [flags discard])
|
||||
(virtual-register-count [sig [() -> (length)]] [flags pure unrestricted true cp02])
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user