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

Test portable version of xoroshiro-next

parent c62e3467
No related branches found
No related tags found
No related merge requests found
......@@ -142,13 +142,12 @@
(let ((s (xoro-random-state-state rng-state)))
(declare (type (simple-array double-float (2)) s))
(multiple-value-bind (r1 r0)
(vm::xoroshiro-next s)
(xoroshiro-next-portable s)
(setf (xoro-random-state-rand rng-state) r0)
(setf (xoro-random-state-cached-p rng-state) t)
r1))))))
#-x86
(defun xoroshiro-next (state)
(defun xoroshiro-next-portable (state)
(declare (type (simple-array double-float (2)) state))
(flet ((rotl-55 (x1 x0)
(declare (type (unsigned-byte 32) x0 x1)
......@@ -192,10 +191,8 @@
(let ((s0-1 0)
(s0-0 0)
(s1-1 0)
(s1-0 0)
(r1 0)
(r0 0))
(declare (type (unsigned-byte 32)) s0-1 s0-0 s1-1 s1-0 r1 r0)
(s1-0 0))
(declare (type (unsigned-byte 32) s0-1 s0-0 s1-1 s1-0))
(multiple-value-bind (x1 x0)
(kernel:double-float-bits (aref state 0))
(setf s0-1 (ldb (byte 32 0) x1)
......@@ -210,27 +207,23 @@
(bignum::%add-with-carry s0-0 s1-0 0)
(values (bignum::%add-with-carry s0-1 s1-1 c)
sum-0))
;; s1 ^= s0
(setf s1-1 (logxor s1-1 s0-1)
s1-0 (logxor s1-0 s0-0))
;; s[0] = rotl(s0,55) ^ s1 ^ (s1 << 14)
(multiple-value-setq (s0-1 s0-0)
(rotl-55 s0-1 s0-0))
(setf s0-1 (logxor s0-1 s1-1)
s0-0 (logxor s0-0 s1-0))
(multiple-value-bind (s14-1 s14-0)
(shl-14 s1-1 s1-0)
(setf s0-1 (logxor s0-1 s14-1)
s0-0 (logxor s0-0 s14-0)))
(setf (aref s 0) s0-0)
(setf (aref s 1) s0-1)
;; s1 ^= s0
(setf s1-1 (logxor s1-1 s0-1)
s1-0 (logxor s1-0 s0-0))
;; s[0] = rotl(s0,55) ^ s1 ^ (s1 << 14)
(multiple-value-setq (s0-1 s0-0)
(rotl-55 s0-1 s0-0))
(setf s0-1 (logxor s0-1 s1-1)
s0-0 (logxor s0-0 s1-0))
(multiple-value-bind (s14-1 s14-0)
(shl-14 s1-1 s1-0)
(setf s0-1 (logxor s0-1 s14-1)
s0-0 (logxor s0-0 s14-0)))
(multiple-value-bind (r1 r0)
(rotl-36 s1-1 s1-0)
(setf (aref s 2) r0
(aref s 3) r1))
(setf (aref state 0) (make-double s0-1 s0-0)
(aref state 1) (make-double s1-1 s1-0))))))
(multiple-value-bind (r1 r0)
(rotl-36 s1-1 s1-0)
(setf (aref state 0) (make-double s0-1 s0-0)
(aref state 1) (make-double r1 r0)))))))
;;; %RANDOM-SINGLE-FLOAT, %RANDOM-DOUBLE-FLOAT -- Interface
;;;
......
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