Raymond Toy pushed to branch rtoy-xoro at cmucl / cmucl
Commits: edcbb7d3 by Raymond Toy at 2017-12-16T20:53:21-08:00 Test portable version of xoroshiro-next
- - - - -
1 changed file:
- src/code/rand-xoroshiro.lisp
Changes:
===================================== src/code/rand-xoroshiro.lisp ===================================== --- a/src/code/rand-xoroshiro.lisp +++ b/src/code/rand-xoroshiro.lisp @@ -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 ;;;
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/edcbb7d34826926edc18b487cc...
--- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/edcbb7d34826926edc18b487cc... You're receiving this email because of your account on gitlab.common-lisp.net.