Commit cba9bad7 authored by Raymond Toy's avatar Raymond Toy
Browse files

Update xoroshiro methods to standard names

parent 38db18cb

src/code/rand-xoroshiro.lisp

+72 −74
Original line number Diff line number Diff line
@@ -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))

	   (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))