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

Make random-mt19937 function only when :random-mt19937 is set

parent cba9bad7
No related branches found
No related tags found
No related merge requests found
...@@ -413,6 +413,7 @@ ...@@ -413,6 +413,7 @@
;;; transformed to a call to this routine allowing its use in byte ;;; transformed to a call to this routine allowing its use in byte
;;; compiled code. ;;; compiled code.
;;; ;;;
#+random-mt19937
(defun random-mt19937 (state) (defun random-mt19937 (state)
(declare (type (simple-array (unsigned-byte 32) (627)) state)) (declare (type (simple-array (unsigned-byte 32) (627)) state))
(random-mt19937 state)) (random-mt19937 state))
...@@ -698,129 +699,3 @@ ...@@ -698,129 +699,3 @@
(multiple-value-bind (fop dst src) (multiple-value-bind (fop dst src)
(get-fp-operation scp) (get-fp-operation scp)
(values fop (list dst src)))) (values fop (list dst src))))
(defstruct (xoro-state (:constructor %make-xoro-state))
(state (make-array 2 :element-type 'double-float)
:type (simple-array double-float (2)))
(rand (make-array 1 :element-type '(unsigned-byte 32))
:type (simple-array (unsigned-byte 32) (1)))
(cached-p nil :type (member t nil)))
(defun make-xoro-state (&optional init)
(let* ((s (%make-xoro-state))
(state (xoro-state-state s)))
(flet ((make-double (x)
(let ((lo (ldb (byte 32 0) x))
(hi (ldb (byte 32 32) x)))
(kernel:make-double-float
(if (< hi #x80000000)
hi
(- hi #x100000000))
lo))))
(etypecase init
(null
s)
((vector integer 2)
(setf (aref state 0) (make-double (ldb (byte 64 0) (aref init 0)))
(aref state 1) (make-double (ldb (byte 64 0) (aref init 1)))))
(integer
(set-state (ldb (byte 64 0) init))
(let* ((s0 (splitmix64))
(s1 (splitmix64)))
(setf (aref state 0) (make-double s0)
(aref state 1) (make-double s1)))
)))
s))
#||
(defun xoroshiro (rng-state)
(declare (type xoro-state rng-state)
(optimize (speed 3) (safety 0)))
(let ((s (xoro-state- rng-state)))
(declare (type (simple-array double-float (2)) s))
(multiple-value-bind (r1 r0 new-s1 new-s0)
(vm::xoroshiro-next (aref s 1) (aref s 0))
(setf (aref s 1) new-s1
(aref s 0) new-s0)
(values r1 r0))))
||#
(defun xoroshiro (rng-state)
(declare (type xoro-state rng-state)
(optimize (speed 3) (safety 0)))
(let ((cached (xoro-state-cached-p rng-state)))
(cond (cached
(setf (xoro-state-cached-p rng-state) nil)
(aref (xoro-state-rand rng-state) 0))
(t
(let ((s (xoro-state-state rng-state)))
(declare (type (simple-array double-float (2)) s))
(multiple-value-bind (r1 r0)
(vm::xoroshiro-next s)
(setf (aref (xoro-state-rand rng-state) 0) r1)
(setf (xoro-state-cached-p rng-state) t)
r0))))))
(defun xoroshiro-jump (rng-state)
(declare (type xoro-state rng-state))
(let ((state (xoro-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 (vm::xoro-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))))))
(let ((state 0))
(declare (type (unsigned-byte 64) state))
(defun set-state (x)
(setf state (ldb (byte 64 0) x)))
(defun get-state ()
state)
(defun splitmix64 ()
(let ((z (setf state
(ldb (byte 64 0) (+ state #x9e3779b97f4a7c15)))))
(declare (type (unsigned-byte 64) z))
(setf z (ldb (byte 64 0)
(* (logxor z (ash z -30))
#xbf58476d1ce4e5b9)))
(setf z (ldb (byte 64 0)
(* (logxor z (ash z -27))
#x94d049bb133111eb)))
(logxor z (ash z -31)))))
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