Skip to content
Snippets Groups Projects
Commit 192fe3b6 authored by Raymond Toy's avatar Raymond Toy
Browse files

Simplify state

Don't need an array for the cached value; (unsigned-byte 32) is a
specialized structure slot, so no consing.

Some random cleanups and comments.
parent eea11e07
No related branches found
No related tags found
No related merge requests found
...@@ -18,7 +18,7 @@ ...@@ -18,7 +18,7 @@
make-xoro-random-state)) make-xoro-random-state))
(in-package "KERNEL") (in-package "KERNEL")
(export '(%xorohiro-single-float %xorohiro-double-float xoroshiro-chunk init-random-state)) (export '(%xorohiro-single-float %xorohiro-double-float xoroshiro-chunk init-xoro-state))
(sys:register-lisp-feature :random-xoroshiro) (sys:register-lisp-feature :random-xoroshiro)
...@@ -80,10 +80,19 @@ ...@@ -80,10 +80,19 @@
(defstruct (xoro-random-state (defstruct (xoro-random-state
(:constructor make-xoroshiro-object) (:constructor make-xoroshiro-object)
(: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
;; of state. To reduce consing, we use an array of double-float's
;; 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
;; state we need.
(state (init-xoro-state) (state (init-xoro-state)
:type (simple-array double-float (2))) :type (simple-array double-float (2)))
(rand (make-array 1 :element-type '(unsigned-byte 32) :initial-element 0) ;; The generator produces 64-bit results. We separate the 64-bit
:type (simple-array (unsigned-byte 32) (1))) ;; result into two parts. One is returned and the other is cached
;; here for later use.
(rand 0 :type (unsigned-byte 32))
;; Indicates if RAND holds a valid value. If NIL, we need to
;; generate a new 64-bit result.
(cached-p nil :type (member t nil))) (cached-p nil :type (member t nil)))
(defvar *xoro-random-state*) (defvar *xoro-random-state*)
...@@ -92,13 +101,11 @@ ...@@ -92,13 +101,11 @@
(flet ((copy-random-state (state) (flet ((copy-random-state (state)
(let ((old-state (xoro-random-state-state state)) (let ((old-state (xoro-random-state-state state))
(new-state (new-state
(make-array 2 :element-type 'double-float)) (make-array 2 :element-type 'double-float)))
(new-rand (make-array 1 :element-type '(unsigned-byte 32))))
(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))
(setf (aref new-rand 0) (aref (xoro-random-state-rand state) 0))
(make-xoroshiro-object :state new-state (make-xoroshiro-object :state new-state
:rand new-rand :rand (xoro-random-state-rand state)
:cached-p (xoro-random-state-cached-p state))))) :cached-p (xoro-random-state-cached-p state)))))
(cond ((not state) (cond ((not state)
(copy-random-state *xoro-random-state*)) (copy-random-state *xoro-random-state*))
...@@ -106,7 +113,7 @@ ...@@ -106,7 +113,7 @@
(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-xoroshiro-object :state (init-xoro-state (generate-seed 4))
:rand (make-array 1 :element-type '(unsigned-byte 32) :initial-element 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)))))
...@@ -130,15 +137,15 @@ ...@@ -130,15 +137,15 @@
(let ((cached (xoro-random-state-cached-p rng-state))) (let ((cached (xoro-random-state-cached-p rng-state)))
(cond (cached (cond (cached
(setf (xoro-random-state-cached-p rng-state) nil) (setf (xoro-random-state-cached-p rng-state) nil)
(aref (xoro-random-state-rand rng-state) 0)) (xoro-random-state-rand rng-state))
(t (t
(let ((s (xoro-random-state-state rng-state))) (let ((s (xoro-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)
(vm::xoroshiro-next s) (vm::xoroshiro-next s)
(setf (aref (xoro-random-state-rand rng-state) 0) r1) (setf (xoro-random-state-rand rng-state) r0)
(setf (xoro-random-state-cached-p rng-state) t) (setf (xoro-random-state-cached-p rng-state) t)
r0)))))) r1))))))
#-x86 #-x86
(defun xoroshiro-next (state) (defun xoroshiro-next (state)
...@@ -267,7 +274,7 @@ ...@@ -267,7 +274,7 @@
1d0))) 1d0)))
#+double-double #+double-double
(defun %random-double-double-float (arg state) (defun %xoroshiro-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 xoro-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
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment