Raymond Toy pushed to branch rtoy-xoro at cmucl / cmucl

Commits: dbc0518d by Raymond Toy at 2017-12-18T21:02:39-08:00 Fix typos add jump function

* Fix typos in names so we can call the functions. * Add jump function to allow generating new distinct sequences. * Add simple function to print the state using integers instead of doubles. (Untested.)

- - - - -

1 changed file:

- src/code/rand-xoroshiro.lisp

Changes:

===================================== src/code/rand-xoroshiro.lisp ===================================== --- a/src/code/rand-xoroshiro.lisp +++ b/src/code/rand-xoroshiro.lisp @@ -18,7 +18,7 @@ make-xoro-random-state))

(in-package "KERNEL") -(export '(%xorohiro-single-float %xorohiro-double-float xoroshiro-chunk init-xoro-state)) +(export '(%xoroshiro-single-float %xoroshiro-double-float xoroshiro-chunk init-xoro-state))

(sys:register-lisp-feature :random-xoroshiro)

@@ -95,7 +95,8 @@ ;; generate a new 64-bit result. (cached-p nil :type (member t nil)))

-(defvar *xoro-random-state*) +(defvar *xoro-random-state* + (make-xoroshiro-object))

(defun make-xoro-random-state (&optional state) (flet ((copy-random-state (state) @@ -120,16 +121,23 @@  ;;;; 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 -(declaim (inline xoroshiro-next)) -#+x86 -(defun xoroshiro-next (state) - (declare (type (simple-array double-float (2)) state)) +(defun xoroshiro-gen (state) + (declare (type (simple-array double-float (2)) state) + (optimize (speed 3) (safety 0))) (vm::xoroshiro-next state))

#-x86 -(defun xoroshiro-next (state) - (declare (type (simple-array double-float (2)) state)) +(defun xoroshiro-gen (state) + (declare (type (simple-array double-float (2)) state) + (optimize (speed 3) (safety 0))) (flet ((rotl-55 (x1 x0) (declare (type (unsigned-byte 32) x0 x1) (optimize (speed 3) (safety 0))) @@ -228,7 +236,7 @@ (let ((s (xoro-random-state-state rng-state))) (declare (type (simple-array double-float (2)) s)) (multiple-value-bind (r1 r0) - (xoroshiro-next s) + (xoroshiro-gen s) (setf (xoro-random-state-rand rng-state) r0) (setf (xoro-random-state-cached-p rng-state) t) r1)))))) @@ -240,14 +248,14 @@ ;;; 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 %xorohiro-single-float %xorohiro-double-float)) -(declaim (ftype (function ((single-float (0f0)) random-state) +(declaim (inline %xoroshiro-single-float %xoroshiro-double-float)) +(declaim (ftype (function ((single-float (0f0)) xoro-random-state) (single-float 0f0)) - %xorohiro-single-float)) + %xoroshiro-single-float)) ;;; -(defun %xorohiro-single-float (arg state) +(defun %xoroshiro-single-float (arg state) (declare (type (single-float (0f0)) arg) - (type random-state state)) + (type xoro-random-state state)) (* arg (- (make-single-float (dpb (ash (xoroshiro-chunk state) @@ -256,15 +264,15 @@ (single-float-bits 1.0))) 1.0))) ;;; -(declaim (ftype (function ((double-float (0d0)) random-state) +(declaim (ftype (function ((double-float (0d0)) xoro-random-state) (double-float 0d0)) - %xorohiro-double-float)) + %xoroshiro-double-float)) ;;; ;;; 53bit version. ;;; -(defun %xorohiro-double-float (arg state) +(defun %xoroshiro-double-float (arg state) (declare (type (double-float (0d0)) arg) - (type random-state state)) + (type xoro-random-state state)) (* arg (- (lisp::make-double-float (dpb (ash (xoroshiro-chunk state) @@ -311,11 +319,12 @@

;;; %RANDOM-INTEGER -- Internal ;;; -(defun %xorohiro-integer (arg state) - (declare (type (integer 1) arg) (type random-state state)) +(defun %xoroshiro-integer (arg state) + (declare (type (integer 1) arg) + (type xoro-random-state state)) (let ((shift (- random-chunk-length random-integer-overlap))) - (do ((bits (random-chunk state) - (logxor (ash bits shift) (random-chunk state))) + (do ((bits (xoroshiro-chunk state) + (logxor (ash bits shift) (xoroshiro-chunk state))) (count (+ (integer-length arg) (- random-integer-extra-bits shift)) (- count shift))) @@ -323,30 +332,75 @@ (rem bits arg)) (declare (fixnum count)))))

-(defun xoro-random (arg &optional (state *random-state*)) +(declaim (ext:end-block)) + +(defun xoro-random (arg &optional (state *xoro-random-state*)) "Generate a uniformly distributed pseudo-random number between zero and Arg. State, if supplied, is the random state to use." - (declare (inline %xorohiro-single-float %xorohiro-double-float + (declare (inline %xoroshiro-single-float %xoroshiro-double-float #+long-float %long-float)) (cond ((typep arg '(integer 1 #x100000000)) ;; Let the compiler deftransform take care of this case. - (random arg state)) + (%xoroshiro-integer arg state)) ((and (typep arg 'single-float) (> arg 0.0F0)) - (%xorohiro-single-float arg state)) + (%xoroshiro-single-float arg state)) ((and (typep arg 'double-float) (> arg 0.0D0)) - (%xorohiro-double-float arg state)) + (%xoroshiro-double-float arg state)) #+long-float ((and (typep arg 'long-float) (> arg 0.0L0)) - (%xorohiro-long-float arg state)) + (%xoroshiro-long-float arg state)) #+double-double ((and (typep arg 'double-double-float) (> arg 0.0w0)) - (%xorohiro-double-double-float arg state)) + (%xoroshiro-double-double-float arg state)) ((and (integerp arg) (> arg 0)) - (%xorohiro-integer arg state)) + (%xoroshiro-integer arg state)) (t (error 'simple-type-error :expected-type '(or (integer 1) (float (0.0))) :datum arg :format-control (intl:gettext "Argument is not a positive integer or a positive float: ~S") :format-arguments (list arg)))))

+(defun xoroshiro-jump (rng-state) + (declare (type xoro-random-state rng-state)) + (let ((state (xoro-random-state-state rng-state)) + (s0-0 0) + (s0-1 0) + (s1-0 0) + (s1-1 0)) + (declare (type (unsigned-byte 32) s0-0 s0-1 s1-0 s1-1) + (optimize (speed 3) (safety 0))) + (dolist (jump '(#xbeac0467eba5facb #xd86b048b86aa9922)) + (declare (type (unsigned-byte 64) jump)) + (dotimes (b 64) + (declare (fixnum b)) + (when (logbitp b jump) + (multiple-value-bind (x1 x0) + (kernel:double-float-bits (aref state 0)) + (setf s0-1 (logxor s0-1 (ldb (byte 32 0) x1)) + s0-0 (logxor s0-0 x0))) + + (multiple-value-bind (x1 x0) + (kernel:double-float-bits (aref state 1)) + (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))) + + (flet ((convert (x1 x0) + (declare (type (unsigned-byte 32) x1 x0)) + (kernel:make-double-float + (if (< x1 #x80000000) x1 (- x1 #x100000000)) + x0))) + (setf (aref state 0) (convert s0-1 s0-0)) + (setf (aref state 1) (convert s1-1 s1-0))) + rng-state)) + +(defun print-xoro-state (rng-state) + (let ((state (xoro-random-state-state rng-state))) + (flet ((v (x) + (multiple-value-bind (hi lo) + (kernel:double-float-bits x) + (logior (ash (ldb (byte 32 0) hi) 32) + lo)))) + (format t "~16,'0x ~16,'0x" (v (aref state 0)) (v (aref state 1)))))) \ No newline at end of file

View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/dbc0518d7d280599ce5185ace3...

--- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/dbc0518d7d280599ce5185ace3... You're receiving this email because of your account on gitlab.common-lisp.net.