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

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.)
parent d539b6a0
Loading
Loading
Loading
Loading
+84 −30
Original line number Diff line number Diff line
@@ -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