[Git][cmucl/cmucl][rtoy-xoro] Test portable version of xoroshiro-next

[Raymond Toy]

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/edcbb7d34826926edc18b487cc1409177cdb60ef

---
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/edcbb7d34826926edc18b487cc1409177cdb60ef
You're receiving this email because of your account on gitlab.common-lisp.net.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20171217/4ecd25db/attachment-0001.html>