[Git][cmucl/cmucl][rtoy-xoro] Fix typos add jump function
Raymond Toy
rtoy at common-lisp.net
Tue Dec 19 05:02:50 UTC 2017
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/dbc0518d7d280599ce5185ace3284d8ed4893312
---
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/dbc0518d7d280599ce5185ace3284d8ed4893312
You're receiving this email because of your account on gitlab.common-lisp.net.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20171219/a9cb16ea/attachment-0001.html>
More information about the cmucl-cvs
mailing list