Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
cmucl
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Package registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Carl Shapiro
cmucl
Commits
cba9bad7
Commit
cba9bad7
authored
7 years ago
by
Raymond Toy
Browse files
Options
Downloads
Patches
Plain Diff
Update xoroshiro methods to standard names
parent
38db18cb
No related branches found
No related tags found
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
src/code/rand-xoroshiro.lisp
+72
-74
72 additions, 74 deletions
src/code/rand-xoroshiro.lisp
with
72 additions
and
74 deletions
src/code/rand-xoroshiro.lisp
+
72
−
74
View file @
cba9bad7
...
@@ -13,12 +13,11 @@
...
@@ -13,12 +13,11 @@
(
in-package
"LISP"
)
(
in-package
"LISP"
)
(
intl:textdomain
"cmucl"
)
(
intl:textdomain
"cmucl"
)
#+
nil
(
export
'
(
random-state
random-state-p
random
*random-state*
(
export
'
(
xoro-random-state
xoro-random-state-p
xoro-random
*xoro-random-state*
make-random-state
))
make-xoro-random-state
))
(
in-package
"KERNEL"
)
(
in-package
"KERNEL"
)
(
export
'
(
%
xoroshiro
-single-float
%
xoroshiro
-double-float
xoroshiro
-chunk
init-
xoro
-state
))
(
export
'
(
%
random
-single-float
%
random
-double-float
random
-chunk
init-
random
-state
))
(
sys:register-lisp-feature
:random-xoroshiro
)
(
sys:register-lisp-feature
:random-xoroshiro
)
...
@@ -88,7 +87,7 @@
...
@@ -88,7 +87,7 @@
state
))
state
))
(
defun
init-
xoro
-state
(
&optional
(
seed
5772156649015328606
)
state
)
(
defun
init-
random
-state
(
&optional
(
seed
5772156649015328606
)
state
)
"Generate an random state vector from the given SEED. The seed can be
"Generate an random state vector from the given SEED. The seed can be
either an integer or a vector of (unsigned-byte 32)"
either an integer or a vector of (unsigned-byte 32)"
(
declare
(
type
(
or
null
integer
(
declare
(
type
(
or
null
integer
...
@@ -101,8 +100,8 @@
...
@@ -101,8 +100,8 @@
((
array
(
unsigned-byte
64
)
(
2
))
((
array
(
unsigned-byte
64
)
(
2
))
(
vec-init-xoro-state
seed
state
)))))
(
vec-init-xoro-state
seed
state
)))))
(
defstruct
(
xoro-
random-state
(
defstruct
(
random-state
(
:constructor
make-
xoroshiro
-object
)
(
:constructor
make-
random
-object
)
(
:print-function
%print-xoro-state
)
(
:print-function
%print-xoro-state
)
(
:make-load-form-fun
:just-dump-it-normally
))
(
:make-load-form-fun
:just-dump-it-normally
))
;; The state of the RNG. The actual algorithm uses 2 64-bit words
;; The state of the RNG. The actual algorithm uses 2 64-bit words
...
@@ -110,7 +109,7 @@
...
@@ -110,7 +109,7 @@
;; since a double-float is 64 bits long. At no point do we operate
;; since a double-float is 64 bits long. At no point do we operate
;; on these as floats; they're just convenient objects to hold the
;; on these as floats; they're just convenient objects to hold the
;; state we need.
;; state we need.
(
state
(
init-
xoro
-state
)
(
state
(
init-
random
-state
)
:type
(
simple-array
double-float
(
2
)))
:type
(
simple-array
double-float
(
2
)))
;; The generator produces 64-bit results. We separate the 64-bit
;; The generator produces 64-bit results. We separate the 64-bit
;; result into two parts. One is returned and the other is cached
;; result into two parts. One is returned and the other is cached
...
@@ -125,9 +124,9 @@
...
@@ -125,9 +124,9 @@
;; Basically the same as the default structure printer, but we want
;; Basically the same as the default structure printer, but we want
;; to print the state as an array of integers instead of doubles,
;; to print the state as an array of integers instead of doubles,
;; because it's a bit confusing to see the state as doubles.
;; because it's a bit confusing to see the state as doubles.
(
let
((
state
(
xoro-
random-state-state
rng-state
)))
(
let
((
state
(
random-state-state
rng-state
)))
(
pprint-logical-block
(
stream
nil
:prefix
"#S("
:suffix
")"
)
(
pprint-logical-block
(
stream
nil
:prefix
"#S("
:suffix
")"
)
(
prin1
'
xoro-
random-state
stream
)
(
prin1
'random-state
stream
)
(
write-char
#\space
stream
)
(
write-char
#\space
stream
)
(
pprint-indent
:block
2
stream
)
(
pprint-indent
:block
2
stream
)
(
pprint-newline
:linear
stream
)
(
pprint-newline
:linear
stream
)
...
@@ -135,7 +134,7 @@
...
@@ -135,7 +134,7 @@
(
write-char
#\space
stream
)
(
write-char
#\space
stream
)
(
pprint-newline
:miser
stream
)
(
pprint-newline
:miser
stream
)
(
pprint-logical-block
(
stream
nil
:prefix
"#.("
:suffix
")"
)
(
pprint-logical-block
(
stream
nil
:prefix
"#.("
:suffix
")"
)
(
prin1
'init-
xoro
-state
stream
)
(
prin1
'init-
random
-state
stream
)
(
write-char
#\space
stream
)
(
write-char
#\space
stream
)
(
flet
((
c
(
x
)
(
flet
((
c
(
x
)
(
multiple-value-bind
(
hi
lo
)
(
multiple-value-bind
(
hi
lo
)
...
@@ -152,46 +151,47 @@
...
@@ -152,46 +151,47 @@
(
prin1
:rand
stream
)
(
prin1
:rand
stream
)
(
write-char
#\space
stream
)
(
write-char
#\space
stream
)
(
pprint-newline
:miser
stream
)
(
pprint-newline
:miser
stream
)
(
prin1
(
xoro-
random-state-rand
rng-state
)
stream
)
(
prin1
(
random-state-rand
rng-state
)
stream
)
(
write-char
#\space
stream
)
(
write-char
#\space
stream
)
(
pprint-newline
:linear
stream
)
(
pprint-newline
:linear
stream
)
(
prin1
:cached-p
stream
)
(
prin1
:cached-p
stream
)
(
write-char
#\space
stream
)
(
write-char
#\space
stream
)
(
pprint-newline
:miser
stream
)
(
pprint-newline
:miser
stream
)
(
prin1
(
xoro-
random-state-cached-p
rng-state
)
stream
))))
(
prin1
(
random-state-cached-p
rng-state
)
stream
))))
(
defvar
*
xoro-
random-state*
(
defvar
*random-state*
(
make-
xoroshiro
-object
))
(
make-
random
-object
))
(
defun
make-
xoro-
random-state
(
&optional
state
)
(
defun
make-random-state
(
&optional
state
)
(
flet
((
copy-random-state
(
state
)
(
flet
((
copy-random-state
(
state
)
(
let
((
old-state
(
xoro-
random-state-state
state
))
(
let
((
old-state
(
random-state-state
state
))
(
new-state
(
new-state
(
make-array
2
:element-type
'double-float
)))
(
make-array
2
:element-type
'double-float
)))
(
setf
(
aref
new-state
0
)
(
aref
old-state
0
))
(
setf
(
aref
new-state
0
)
(
aref
old-state
0
))
(
setf
(
aref
new-state
1
)
(
aref
old-state
1
))
(
setf
(
aref
new-state
1
)
(
aref
old-state
1
))
(
make-
xoroshiro
-object
:state
new-state
(
make-
random
-object
:state
new-state
:rand
(
xoro-
random-state-rand
state
)
:rand
(
random-state-rand
state
)
:cached-p
(
xoro-
random-state-cached-p
state
)))))
:cached-p
(
random-state-cached-p
state
)))))
(
cond
((
not
state
)
(
cond
((
not
state
)
(
copy-random-state
*
xoro-
random-state*
))
(
copy-random-state
*random-state*
))
((
xoro-
random-state-p
state
)
((
random-state-p
state
)
(
copy-random-state
state
))
(
copy-random-state
state
))
((
eq
state
t
)
((
eq
state
t
)
(
make-
xoroshiro
-object
:state
(
init-
xoro
-state
(
generate-seed
4
))
(
make-
random
-object
:state
(
init-
random
-state
(
generate-seed
4
))
:rand
0
:rand
0
:cached-p
nil
))
:cached-p
nil
))
(
t
(
t
(
error
"Argument is not a RANDOM-STATE, T, or NIL: ~S"
state
)))))
(
error
"Argument is not a RANDOM-STATE, T, or NIL: ~S"
state
)))))
(
defun
rand-initializer
()
(
init-random-state
(
generate-seed
)
(
random-state-state
*random-state*
)))
(
pushnew
'rand-initializer
ext:*after-save-initializations*
)
;;;; Random entries:
;;;; Random entries:
(
declaim
(
ext:start-block
xoroshiro-gen
xoroshiro-chunk
%xoroshiro-single-float
%xoroshiro-double-float
%xoroshiro-integer
#+
double-double
%xoroshiro-double-double-float
))
;;#+x86
;;#+x86
;;(declaim (inline xoroshiro-next))
;;(declaim (inline xoroshiro-next))
#+
x86
#+
x86
...
@@ -280,31 +280,31 @@
...
@@ -280,31 +280,31 @@
(
setf
(
aref
state
0
)
(
make-double
s0-1
s0-0
)
(
setf
(
aref
state
0
)
(
make-double
s0-1
s0-0
)
(
aref
state
1
)
(
make-double
r1
r0
)))))))
(
aref
state
1
)
(
make-double
r1
r0
)))))))
;;; Size of the chunks returned by
xoroshiro
-chunk.
;;; Size of the chunks returned by
random
-chunk.
;;;
;;;
;;
(defconstant random-chunk-length 32)
(
defconstant
random-chunk-length
32
)
;;;
xoroshiro
-chunk -- Internal
;;;
random
-chunk -- Internal
;;;
;;;
;;; This function generaters a 32bit integer between 0 and #xffffffff
;;; This function generaters a 32bit integer between 0 and #xffffffff
;;; inclusive.
;;; inclusive.
;;;
;;;
(
declaim
(
inline
xoroshiro
-chunk
))
(
declaim
(
inline
random
-chunk
))
(
defun
xoroshiro
-chunk
(
rng-state
)
(
defun
random
-chunk
(
rng-state
)
(
declare
(
type
xoro-
random-state
rng-state
)
(
declare
(
type
random-state
rng-state
)
(
optimize
(
speed
3
)
(
safety
0
)))
(
optimize
(
speed
3
)
(
safety
0
)))
(
let
((
cached
(
xoro-
random-state-cached-p
rng-state
)))
(
let
((
cached
(
random-state-cached-p
rng-state
)))
(
cond
(
cached
(
cond
(
cached
(
setf
(
xoro-
random-state-cached-p
rng-state
)
nil
)
(
setf
(
random-state-cached-p
rng-state
)
nil
)
(
xoro-
random-state-rand
rng-state
))
(
random-state-rand
rng-state
))
(
t
(
t
(
let
((
s
(
xoro-
random-state-state
rng-state
)))
(
let
((
s
(
random-state-state
rng-state
)))
(
declare
(
type
(
simple-array
double-float
(
2
))
s
))
(
declare
(
type
(
simple-array
double-float
(
2
))
s
))
(
multiple-value-bind
(
r1
r0
)
(
multiple-value-bind
(
r1
r0
)
(
xoroshiro-gen
s
)
(
xoroshiro-gen
s
)
(
setf
(
xoro-
random-state-rand
rng-state
)
r0
)
(
setf
(
random-state-rand
rng-state
)
r0
)
(
setf
(
xoro-
random-state-cached-p
rng-state
)
t
)
(
setf
(
random-state-cached-p
rng-state
)
t
)
r1
))))))
r1
))))))
...
@@ -314,45 +314,45 @@
...
@@ -314,45 +314,45 @@
;;; between 0.0 and 1.0 by clobbering the significand of 1.0 with random bits,
;;; between 0.0 and 1.0 by clobbering the significand of 1.0 with random bits,
;;; then subtracting 1.0. This hides the fact that we have a hidden bit.
;;; then subtracting 1.0. This hides the fact that we have a hidden bit.
;;;
;;;
(
declaim
(
inline
%
xoroshiro
-single-float
%
xoroshiro
-double-float
))
(
declaim
(
inline
%
random
-single-float
%
random
-double-float
))
(
declaim
(
ftype
(
function
((
single-float
(
0f0
))
xoro-
random-state
)
(
declaim
(
ftype
(
function
((
single-float
(
0f0
))
random-state
)
(
single-float
0f0
))
(
single-float
0f0
))
%
xoroshiro
-single-float
))
%
random
-single-float
))
;;;
;;;
(
defun
%
xoroshiro
-single-float
(
arg
state
)
(
defun
%
random
-single-float
(
arg
state
)
(
declare
(
type
(
single-float
(
0f0
))
arg
)
(
declare
(
type
(
single-float
(
0f0
))
arg
)
(
type
xoro-
random-state
state
))
(
type
random-state
state
))
(
*
arg
(
*
arg
(
-
(
make-single-float
(
-
(
make-single-float
(
dpb
(
ash
(
xoroshiro
-chunk
state
)
(
dpb
(
ash
(
random
-chunk
state
)
(
-
vm:single-float-digits
random-chunk-length
))
(
-
vm:single-float-digits
random-chunk-length
))
vm:single-float-significand-byte
vm:single-float-significand-byte
(
single-float-bits
1.0
)))
(
single-float-bits
1.0
)))
1.0
)))
1.0
)))
;;;
;;;
(
declaim
(
ftype
(
function
((
double-float
(
0d0
))
xoro-
random-state
)
(
declaim
(
ftype
(
function
((
double-float
(
0d0
))
random-state
)
(
double-float
0d0
))
(
double-float
0d0
))
%
xoroshiro
-double-float
))
%
random
-double-float
))
;;;
;;;
;;; 53bit version.
;;; 53bit version.
;;;
;;;
(
defun
%
xoroshiro
-double-float
(
arg
state
)
(
defun
%
random
-double-float
(
arg
state
)
(
declare
(
type
(
double-float
(
0d0
))
arg
)
(
declare
(
type
(
double-float
(
0d0
))
arg
)
(
type
xoro-
random-state
state
))
(
type
random-state
state
))
(
*
arg
(
*
arg
(
-
(
lisp::make-double-float
(
-
(
lisp::make-double-float
(
dpb
(
ash
(
xoroshiro
-chunk
state
)
(
dpb
(
ash
(
random
-chunk
state
)
(
-
vm:double-float-digits
random-chunk-length
(
-
vm:double-float-digits
random-chunk-length
vm:word-bits
))
vm:word-bits
))
vm:double-float-significand-byte
vm:double-float-significand-byte
(
lisp::double-float-high-bits
1d0
))
(
lisp::double-float-high-bits
1d0
))
(
xoroshiro
-chunk
state
))
(
random
-chunk
state
))
1d0
)))
1d0
)))
#+
double-double
#+
double-double
(
defun
%
xoroshiro
-double-double-float
(
arg
state
)
(
defun
%
random
-double-double-float
(
arg
state
)
(
declare
(
type
(
double-double-float
(
0w0
))
arg
)
(
declare
(
type
(
double-double-float
(
0w0
))
arg
)
(
type
xoro-
random-state
state
))
(
type
random-state
state
))
;; Generate a 31-bit integer, scale it and sum them up
;; Generate a 31-bit integer, scale it and sum them up
(
let*
((
r
0w0
)
(
let*
((
r
0w0
)
(
scale
(
scale-float
1d0
-31
))
(
scale
(
scale-float
1d0
-31
))
...
@@ -361,7 +361,7 @@
...
@@ -361,7 +361,7 @@
(
type
double-double-float
r
)
(
type
double-double-float
r
)
(
optimize
(
speed
3
)
(
inhibit-warnings
3
)))
(
optimize
(
speed
3
)
(
inhibit-warnings
3
)))
(
dotimes
(
k
4
)
(
dotimes
(
k
4
)
(
setf
r
(
+
r
(
*
mult
(
ldb
(
byte
31
0
)
(
xoroshiro
-chunk
state
)))))
(
setf
r
(
+
r
(
*
mult
(
ldb
(
byte
31
0
)
(
random
-chunk
state
)))))
(
setf
mult
(
*
mult
scale
)))
(
setf
mult
(
*
mult
scale
)))
(
*
arg
r
)))
(
*
arg
r
)))
...
@@ -385,12 +385,12 @@
...
@@ -385,12 +385,12 @@
;;; %RANDOM-INTEGER -- Internal
;;; %RANDOM-INTEGER -- Internal
;;;
;;;
(
defun
%
xoroshiro
-integer
(
arg
state
)
(
defun
%
random
-integer
(
arg
state
)
(
declare
(
type
(
integer
1
)
arg
)
(
declare
(
type
(
integer
1
)
arg
)
(
type
xoro-
random-state
state
))
(
type
random-state
state
))
(
let
((
shift
(
-
random-chunk-length
random-integer-overlap
)))
(
let
((
shift
(
-
random-chunk-length
random-integer-overlap
)))
(
do
((
bits
(
xoroshiro
-chunk
state
)
(
do
((
bits
(
random
-chunk
state
)
(
logxor
(
ash
bits
shift
)
(
xoroshiro
-chunk
state
)))
(
logxor
(
ash
bits
shift
)
(
random
-chunk
state
)))
(
count
(
+
(
integer-length
arg
)
(
count
(
+
(
integer-length
arg
)
(
-
random-integer-extra-bits
shift
))
(
-
random-integer-extra-bits
shift
))
(
-
count
shift
)))
(
-
count
shift
)))
...
@@ -398,29 +398,27 @@
...
@@ -398,29 +398,27 @@
(
rem
bits
arg
))
(
rem
bits
arg
))
(
declare
(
fixnum
count
)))))
(
declare
(
fixnum
count
)))))
(
declaim
(
ext:end-block
))
(
defun
random
(
arg
&optional
(
state
*random-state*
))
(
defun
xoro-random
(
arg
&optional
(
state
*xoro-random-state*
))
"Generate a uniformly distributed pseudo-random number between zero
"Generate a uniformly distributed pseudo-random number between zero
and Arg. State, if supplied, is the random state to use."
and Arg. State, if supplied, is the random state to use."
(
declare
(
inline
%
xoroshiro
-single-float
%
xoroshiro
-double-float
(
declare
(
inline
%
random
-single-float
%
random
-double-float
#+
long-float
%long-float
))
#+
long-float
%long-float
))
(
cond
(
cond
((
typep
arg
'
(
integer
1
#x100000000
))
((
typep
arg
'
(
integer
1
#x100000000
))
;; Let the compiler deftransform take care of this case.
;; Let the compiler deftransform take care of this case.
(
%
xoroshiro
-integer
arg
state
))
(
%
random
-integer
arg
state
))
((
and
(
typep
arg
'single-float
)
(
>
arg
0.0F0
))
((
and
(
typep
arg
'single-float
)
(
>
arg
0.0F0
))
(
%
xoroshiro
-single-float
arg
state
))
(
%
random
-single-float
arg
state
))
((
and
(
typep
arg
'double-float
)
(
>
arg
0.0D0
))
((
and
(
typep
arg
'double-float
)
(
>
arg
0.0D0
))
(
%
xoroshiro
-double-float
arg
state
))
(
%
random
-double-float
arg
state
))
#+
long-float
#+
long-float
((
and
(
typep
arg
'long-float
)
(
>
arg
0.0L0
))
((
and
(
typep
arg
'long-float
)
(
>
arg
0.0L0
))
(
%
xoroshiro
-long-float
arg
state
))
(
%
random
-long-float
arg
state
))
#+
double-double
#+
double-double
((
and
(
typep
arg
'double-double-float
)
(
>
arg
0.0w0
))
((
and
(
typep
arg
'double-double-float
)
(
>
arg
0.0w0
))
(
%
xoroshiro
-double-double-float
arg
state
))
(
%
random
-double-double-float
arg
state
))
((
and
(
integerp
arg
)
(
>
arg
0
))
((
and
(
integerp
arg
)
(
>
arg
0
))
(
%
xoroshiro
-integer
arg
state
))
(
%
random
-integer
arg
state
))
(
t
(
t
(
error
'simple-type-error
(
error
'simple-type-error
:expected-type
'
(
or
(
integer
1
)
(
float
(
0.0
)))
:datum
arg
:expected-type
'
(
or
(
integer
1
)
(
float
(
0.0
)))
:datum
arg
...
@@ -428,8 +426,8 @@
...
@@ -428,8 +426,8 @@
:format-arguments
(
list
arg
)))))
:format-arguments
(
list
arg
)))))
(
defun
xoroshiro-jump
(
rng-state
)
(
defun
xoroshiro-jump
(
rng-state
)
(
declare
(
type
xoro-
random-state
rng-state
))
(
declare
(
type
random-state
rng-state
))
(
let
((
state
(
xoro-
random-state-state
rng-state
))
(
let
((
state
(
random-state-state
rng-state
))
(
s0-0
0
)
(
s0-0
0
)
(
s0-1
0
)
(
s0-1
0
)
(
s1-0
0
)
(
s1-0
0
)
...
@@ -451,7 +449,7 @@
...
@@ -451,7 +449,7 @@
(
setf
s1-1
(
logxor
s1-1
(
ldb
(
byte
32
0
)
x1
))
(
setf
s1-1
(
logxor
s1-1
(
ldb
(
byte
32
0
)
x1
))
s1-0
(
logxor
s1-0
x0
))))
s1-0
(
logxor
s1-0
x0
))))
(
format
t
"jump: ~D s0, s1 = ~X~8,'0X ~X~8,'0X~%"
b
s0-1
s0-0
s1-1
s1-0
)
(
format
t
"jump: ~D s0, s1 = ~X~8,'0X ~X~8,'0X~%"
b
s0-1
s0-0
s1-1
s1-0
)
(
xoroshiro-
next
state
)))
(
xoroshiro-
gen
state
)))
(
flet
((
convert
(
x1
x0
)
(
flet
((
convert
(
x1
x0
)
(
declare
(
type
(
unsigned-byte
32
)
x1
x0
))
(
declare
(
type
(
unsigned-byte
32
)
x1
x0
))
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment