diff --git a/src/code/rand-xoroshiro.lisp b/src/code/rand-xoroshiro.lisp index 6271f732785e9a060de8a63f813ea5c0014d5ffa..b55a1f262cf3b9e89cb59b4d332b75c53a6a4eff 100644 --- a/src/code/rand-xoroshiro.lisp +++ b/src/code/rand-xoroshiro.lisp @@ -13,12 +13,11 @@ (in-package "LISP") (intl:textdomain "cmucl") -#+nil -(export '(xoro-random-state xoro-random-state-p xoro-random *xoro-random-state* - make-xoro-random-state)) +(export '(random-state random-state-p random *random-state* + make-random-state)) (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) @@ -88,7 +87,7 @@ 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 either an integer or a vector of (unsigned-byte 32)" (declare (type (or null integer @@ -101,8 +100,8 @@ ((array (unsigned-byte 64) (2)) (vec-init-xoro-state seed state))))) -(defstruct (xoro-random-state - (:constructor make-xoroshiro-object) +(defstruct (random-state + (:constructor make-random-object) (:print-function %print-xoro-state) (:make-load-form-fun :just-dump-it-normally)) ;; The state of the RNG. The actual algorithm uses 2 64-bit words @@ -110,7 +109,7 @@ ;; 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-random-state) :type (simple-array double-float (2))) ;; The generator produces 64-bit results. We separate the 64-bit ;; result into two parts. One is returned and the other is cached @@ -125,9 +124,9 @@ ;; Basically the same as the default structure printer, but we want ;; to print the state as an array of integers instead of 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 ")") - (prin1 'xoro-random-state stream) + (prin1 'random-state stream) (write-char #\space stream) (pprint-indent :block 2 stream) (pprint-newline :linear stream) @@ -135,7 +134,7 @@ (write-char #\space stream) (pprint-newline :miser stream) (pprint-logical-block (stream nil :prefix "#.(" :suffix ")") - (prin1 'init-xoro-state stream) + (prin1 'init-random-state stream) (write-char #\space stream) (flet ((c (x) (multiple-value-bind (hi lo) @@ -152,46 +151,47 @@ (prin1 :rand stream) (write-char #\space stream) (pprint-newline :miser stream) - (prin1 (xoro-random-state-rand rng-state) stream) + (prin1 (random-state-rand rng-state) stream) (write-char #\space stream) (pprint-newline :linear stream) (prin1 :cached-p stream) (write-char #\space 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* - (make-xoroshiro-object)) +(defvar *random-state* + (make-random-object)) -(defun make-xoro-random-state (&optional state) +(defun make-random-state (&optional state) (flet ((copy-random-state (state) - (let ((old-state (xoro-random-state-state state)) + (let ((old-state (random-state-state state)) (new-state (make-array 2 :element-type 'double-float))) (setf (aref new-state 0) (aref old-state 0)) (setf (aref new-state 1) (aref old-state 1)) - (make-xoroshiro-object :state new-state - :rand (xoro-random-state-rand state) - :cached-p (xoro-random-state-cached-p state))))) + (make-random-object :state new-state + :rand (random-state-rand state) + :cached-p (random-state-cached-p state))))) (cond ((not state) - (copy-random-state *xoro-random-state*)) - ((xoro-random-state-p state) + (copy-random-state *random-state*)) + ((random-state-p state) (copy-random-state state)) ((eq state t) - (make-xoroshiro-object :state (init-xoro-state (generate-seed 4)) - :rand 0 - :cached-p nil)) + (make-random-object :state (init-random-state (generate-seed 4)) + :rand 0 + :cached-p nil)) (t (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: -(declaim (ext:start-block xoroshiro-gen xoroshiro-chunk - %xoroshiro-single-float %xoroshiro-double-float - %xoroshiro-integer - #+double-double - %xoroshiro-double-double-float)) ;;#+x86 ;;(declaim (inline xoroshiro-next)) #+x86 @@ -280,31 +280,31 @@ (setf (aref state 0) (make-double s0-1 s0-0) (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 ;;; inclusive. ;;; -(declaim (inline xoroshiro-chunk)) +(declaim (inline random-chunk)) -(defun xoroshiro-chunk (rng-state) - (declare (type xoro-random-state rng-state) +(defun random-chunk (rng-state) + (declare (type random-state rng-state) (optimize (speed 3) (safety 0))) - (let ((cached (xoro-random-state-cached-p rng-state))) + (let ((cached (random-state-cached-p rng-state))) (cond (cached - (setf (xoro-random-state-cached-p rng-state) nil) - (xoro-random-state-rand rng-state)) + (setf (random-state-cached-p rng-state) nil) + (random-state-rand rng-state)) (t - (let ((s (xoro-random-state-state rng-state))) + (let ((s (random-state-state rng-state))) (declare (type (simple-array double-float (2)) s)) (multiple-value-bind (r1 r0) (xoroshiro-gen s) - (setf (xoro-random-state-rand rng-state) r0) - (setf (xoro-random-state-cached-p rng-state) t) + (setf (random-state-rand rng-state) r0) + (setf (random-state-cached-p rng-state) t) r1)))))) @@ -314,45 +314,45 @@ ;;; 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. ;;; -(declaim (inline %xoroshiro-single-float %xoroshiro-double-float)) -(declaim (ftype (function ((single-float (0f0)) xoro-random-state) +(declaim (inline %random-single-float %random-double-float)) +(declaim (ftype (function ((single-float (0f0)) random-state) (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) - (type xoro-random-state state)) + (type random-state state)) (* arg (- (make-single-float - (dpb (ash (xoroshiro-chunk state) + (dpb (ash (random-chunk state) (- vm:single-float-digits random-chunk-length)) vm:single-float-significand-byte (single-float-bits 1.0))) 1.0))) ;;; -(declaim (ftype (function ((double-float (0d0)) xoro-random-state) +(declaim (ftype (function ((double-float (0d0)) random-state) (double-float 0d0)) - %xoroshiro-double-float)) + %random-double-float)) ;;; ;;; 53bit version. ;;; -(defun %xoroshiro-double-float (arg state) +(defun %random-double-float (arg state) (declare (type (double-float (0d0)) arg) - (type xoro-random-state state)) + (type random-state state)) (* arg (- (lisp::make-double-float - (dpb (ash (xoroshiro-chunk state) + (dpb (ash (random-chunk state) (- vm:double-float-digits random-chunk-length vm:word-bits)) vm:double-float-significand-byte (lisp::double-float-high-bits 1d0)) - (xoroshiro-chunk state)) + (random-chunk state)) 1d0))) #+double-double -(defun %xoroshiro-double-double-float (arg state) +(defun %random-double-double-float (arg state) (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 (let* ((r 0w0) (scale (scale-float 1d0 -31)) @@ -361,7 +361,7 @@ (type double-double-float r) (optimize (speed 3) (inhibit-warnings 3))) (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))) (* arg r))) @@ -385,12 +385,12 @@ ;;; %RANDOM-INTEGER -- Internal ;;; -(defun %xoroshiro-integer (arg state) +(defun %random-integer (arg state) (declare (type (integer 1) arg) - (type xoro-random-state state)) + (type random-state state)) (let ((shift (- random-chunk-length random-integer-overlap))) - (do ((bits (xoroshiro-chunk state) - (logxor (ash bits shift) (xoroshiro-chunk state))) + (do ((bits (random-chunk state) + (logxor (ash bits shift) (random-chunk state))) (count (+ (integer-length arg) (- random-integer-extra-bits shift)) (- count shift))) @@ -398,29 +398,27 @@ (rem bits arg)) (declare (fixnum count))))) -(declaim (ext:end-block)) - -(defun xoro-random (arg &optional (state *xoro-random-state*)) +(defun random (arg &optional (state *random-state*)) "Generate a uniformly distributed pseudo-random number between zero 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)) (cond ((typep arg '(integer 1 #x100000000)) ;; 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)) - (%xoroshiro-single-float arg state)) + (%random-single-float arg state)) ((and (typep arg 'double-float) (> arg 0.0D0)) - (%xoroshiro-double-float arg state)) + (%random-double-float arg state)) #+long-float ((and (typep arg 'long-float) (> arg 0.0L0)) - (%xoroshiro-long-float arg state)) + (%random-long-float arg state)) #+double-double ((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)) - (%xoroshiro-integer arg state)) + (%random-integer arg state)) (t (error 'simple-type-error :expected-type '(or (integer 1) (float (0.0))) :datum arg @@ -428,8 +426,8 @@ :format-arguments (list arg))))) (defun xoroshiro-jump (rng-state) - (declare (type xoro-random-state rng-state)) - (let ((state (xoro-random-state-state rng-state)) + (declare (type random-state rng-state)) + (let ((state (random-state-state rng-state)) (s0-0 0) (s0-1 0) (s1-0 0) @@ -451,7 +449,7 @@ (setf s1-1 (logxor s1-1 (ldb (byte 32 0) x1)) 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) - (xoroshiro-next state))) + (xoroshiro-gen state))) (flet ((convert (x1 x0) (declare (type (unsigned-byte 32) x1 x0))