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

Print and set state as 64-bit integers 

The xoroshiro128+ algorithm is defined using uint64_t types, but we
hack it to store the state as double-float's.  This is a bit
confusing, so add a printer to print the state as an array of two
uint64_t's.

Adjust init-xoro-state to allow initializing the state using an array
of 2 64-bit ints.
parent 0b94ee3d

src/code/rand-xoroshiro.lisp

+44 −19
Original line number Diff line number Diff line
@@ -22,6 +22,28 @@ 


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



(defun generate-seed (&optional (nwords 1))

  ;; On some systems (as reported by Ole Rohne on cmucl-imp),

  ;; /dev/urandom isn't what we think it is, so if it doesn't work,

  ;; silently generate the seed from the current time.

  (or (ignore-errors

	(let ((words (make-array nwords :element-type '(unsigned-byte 32))))

	  (with-open-file (rand "/dev/urandom"

				:direction :input

				:element-type '(unsigned-byte 32))

	    (read-sequence words rand))

	  (if (= nwords 1)

	      (aref words 0)

	      (let ((vec (make-array (floor nwords 2) :element-type '(unsigned-byte 64))))

		(do ((k 0 (+ k 1))

		     (j 0 (+ j 2)))

		    ((>= k (length vec))

		     vec)

		  (setf (aref vec k)

			(logior (ash (aref words j) 32)

				(aref words (+ j 1)))))))))

      (logand (get-universal-time) #xffffffff)))



(defun int-init-xoro-state (&optional (seed 5772156649015328606) state)

  (let ((state (or state (make-array 2 :element-type 'double-float)))

	(splitmix-state (ldb (byte 64 0) seed)))
@@ -51,16 +73,18 @@ 
	   state))))



(defun vec-init-xoro-state (key &optional state)

  (declare (type (array (unsigned-byte 32) (4)) key)

  (declare (type (array (unsigned-byte 64) (2)) key)

	   (type (simple-array double-float (2)) state))

  (flet ((make-double (hi lo)

  (flet ((make-double (x)

	   (let ((hi (ldb (byte 32 32) x))

		 (lo (ldb (byte 32 0) x)))

	     (kernel:make-double-float

	      (if (< hi #x80000000)

		  hi

		  (- hi #x100000000))

		lo)))

    (setf (aref state 0) (make-double (aref key 0) (aref key 1))

	  (aref state 1) (make-double (aref key 2) (aref key 3)))

	      lo))))

    (setf (aref state 0) (make-double (aref key 0))

	  (aref state 1) (make-double (aref key 1)))

    state))
@@ -68,13 +92,13 @@ 
  "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

		     (array (unsigned-byte 32) (*)))

		     (array (unsigned-byte 64) (*)))

		 seed))

  (let ((state (or state (make-array 2 :element-type 'double-float))))

    (etypecase seed

      (integer

       (int-init-xoro-state (ldb (byte 64 0) seed) state))

      ((array (unsigned-byte 32) (4))

      ((array (unsigned-byte 64) (2))

       (vec-init-xoro-state seed state)))))



(defstruct (xoro-random-state
@@ -113,14 +137,15 @@ 
      (pprint-logical-block (stream nil :prefix "#.(" :suffix ")")

	(prin1 'init-xoro-state stream)

	(write-char #\space stream)

	(prin1 (make-array 4 :element-type '(unsigned-byte 32)

			 :initial-contents (list (ldb (byte 32 0)

						      (double-float-high-bits (aref state 0)))

						 (double-float-low-bits (aref state 0))

						 (ldb (byte 32 0)

						      (double-float-high-bits (aref state 1)))

						 (double-float-low-bits (aref state 1))))

	       stream))

	(flet ((c (x)

		 (multiple-value-bind (hi lo)

		     (double-float-bits x)

		   (logior (ash (ldb (byte 32 0) hi) 32)

			   lo))))

	  (prin1 (make-array 2 :element-type '(unsigned-byte 64)

			     :initial-contents (list (c (aref state 0))

						     (c (aref state 1))))

		 stream)))

      (write-char #\space stream)

      (pprint-newline :linear stream)