[Git][cmucl/cmucl][rtoy-xoro-default] 2 commits: Add documentation and inline xoroshiro-gen
Raymond Toy
rtoy at common-lisp.net
Wed Dec 20 23:25:23 UTC 2017
Raymond Toy pushed to branch rtoy-xoro-default at cmucl / cmucl
Commits:
5ca98fb1 by Raymond Toy at 2017-12-20T13:59:20-08:00
Add documentation and inline xoroshiro-gen
Not sure about inlining that; it makes random-chunk bigger and all
callers of random-chunk bigger too.
Nice speed win, however. A test of generating 50000000 single-float
values shows xoroshiro128+ takes 0.58 sec vs 0.98 using MT19937 on my
machine.
- - - - -
96c90caf by Raymond Toy at 2017-12-20T14:00:25-08:00
Remove old stuff; conditionalize on :random-xoroshiro
- - - - -
2 changed files:
- src/code/rand-xoroshiro.lisp
- src/compiler/x86/arith.lisp
Changes:
=====================================
src/code/rand-xoroshiro.lisp
=====================================
--- a/src/code/rand-xoroshiro.lisp
+++ b/src/code/rand-xoroshiro.lisp
@@ -8,7 +8,8 @@
;;; **********************************************************************
;;;
;;; Support for the xoroshiro128+ random number generator by David
-;;; Blackman and Sebastiano Vigna (vigna at acm.org)
+;;; Blackman and Sebastiano Vigna (vigna at acm.org). See
+;;; http://xoroshiro.di.unimi.it/.
(in-package "LISP")
(intl:textdomain "cmucl")
@@ -47,6 +48,18 @@
(let ((state (or state (make-array 2 :element-type 'double-float)))
(splitmix-state (ldb (byte 64 0) seed)))
(flet ((splitmix64 ()
+ ;; See http://xoroshiro.di.unimi.it/splitmix64.c for the
+ ;; definitive reference. The basic algorithm, where x is
+ ;; the 64-bit state of the generator,:
+ ;;
+ ;; uint64_t z = (x += 0x9e3779b97f4a7c15);
+ ;; z = (z ^ (z >> 30)) * 0xbf58476d1ce4e5b9;
+ ;; z = (z ^ (z >> 27)) * 0x94d049bb133111eb;
+ ;; return z ^ (z >> 31);
+ ;;
+ ;; This is only used occasionally for initializing the
+ ;; RNG, so this is a very straight-forward
+ ;; implementation.
(let ((z (setf splitmix-state
(ldb (byte 64 0) (+ splitmix-state #x9e3779b97f4a7c15)))))
(declare (type (unsigned-byte 64) z))
@@ -192,8 +205,8 @@
;;;; Random entries:
-;;#+x86
-;;(declaim (inline xoroshiro-next))
+#+x86
+(declaim (inline xoroshiro-gen))
#+x86
(defun xoroshiro-gen (state)
(declare (type (simple-array double-float (2)) state)
@@ -204,7 +217,31 @@
(defun xoroshiro-gen (state)
(declare (type (simple-array double-float (2)) state)
(optimize (speed 3) (safety 0)))
+ ;; Portable implemenation of the xoroshiro128+ generator. See
+ ;; http://xoroshiro.di.unimi.it/xoroshiro128plus.c for the
+ ;; definitive definition.
+ ;;
+ ;; uint64_t s[2];
+ ;;
+ ;; static inline uint64_t rotl(const uint64_t x, int k) {
+ ;; return (x << k) | (x >> (64 - k));
+ ;; }
+ ;;
+ ;; uint64_t next(void) {
+ ;; const uint64_t s0 = s[0];
+ ;; uint64_t s1 = s[1];
+ ;; const uint64_t result = s0 + s1;
+ ;;
+ ;; s1 ^= s0;
+ ;; s[0] = rotl(s0, 55) ^ s1 ^ (s1 << 14); // a, b
+ ;; s[1] = rotl(s1, 36); // c
+ ;;
+ ;; return result;
+ ;; }
+ ;;
(flet ((rotl-55 (x1 x0)
+ ;; Rotate [x1|x0] left 55 bits, returning the result as two
+ ;; values.
(declare (type (unsigned-byte 32) x0 x1)
(optimize (speed 3) (safety 0)))
;; x << 55
@@ -218,6 +255,8 @@
(values (logior sl55-h sr9-h)
(logior sl55-l sr9-l)))))
(rotl-36 (x1 x0)
+ ;; Rotate [x1|x0] left 36 bits, returning the result as two
+ ;; values.
(declare (type (unsigned-byte 32) x0 x1)
(optimize (speed 3) (safety 0)))
;; x << 36
@@ -230,6 +269,8 @@
(values (logior sl36-h sr28-h)
sr28-l))))
(shl-14 (x1 x0)
+ ;; Shift [x1|x0] left by 14 bits, returning the result as
+ ;; two values.
(declare (type (unsigned-byte 32) x1 x0)
(optimize (speed 3) (safety 0)))
(values (ldb (byte 32 0)
@@ -248,6 +289,9 @@
(s1-1 0)
(s1-0 0))
(declare (type (unsigned-byte 32) s0-1 s0-0 s1-1 s1-0))
+ ;; Load the state to s0 and s1. s0-1 is the high 32-bit part and
+ ;; s0-0 is the low 32-bit part of the 64-bit value. Similarly
+ ;; for s1.
(multiple-value-bind (x1 x0)
(kernel:double-float-bits (aref state 0))
(setf s0-1 (ldb (byte 32 0) x1)
@@ -257,6 +301,7 @@
(setf s1-1 (ldb (byte 32 0) x1)
s1-0 x0))
+ ;; Compute the 64-bit random value: s0 + s1
(multiple-value-prog1
(multiple-value-bind (sum-0 c)
(bignum::%add-with-carry s0-0 s1-0 0)
=====================================
src/compiler/x86/arith.lisp
=====================================
--- a/src/compiler/x86/arith.lisp
+++ b/src/compiler/x86/arith.lisp
@@ -1835,51 +1835,8 @@
(give-up)))))
(in-package "VM")
-#+nil
-(progn
-(defknown xoroshiro-next (double-float double-float)
- (values (unsigned-byte 32) (unsigned-byte 32) double-float double-float)
- (movable))
-
-(define-vop (xoroshiro-next)
- (:policy :fast-safe)
- (:translate xoroshiro-next)
- (:args (old-s1 :scs (double-reg) :to (:result 3))
- (old-s0 :scs (double-reg) :to (:result 3)))
- (:arg-types double-float double-float)
- (:results (r1 :scs (unsigned-reg))
- (r0 :scs (unsigned-reg))
- (s1 :scs (double-reg))
- (s0 :scs (double-reg)))
- (:result-types unsigned-num unsigned-num double-float double-float)
- (:temporary (:sc double-reg) t0)
- (:generator 10
- (inst movapd t0 old-s0)
- (inst paddq t0 old-s1) ; t0 = old-s0 + old-s1
- (inst movd r0 t0) ; r0 = low 32-bits of t0
- (inst psrlq t0 32)
- (inst movd r1 t0) ; r1 = high 32-bits of t0
- ;; s1 ^= s0
- (inst movapd s1 old-s1) ; s1 = old-s1
- (inst xorpd s1 old-s0) ; s1 = old-s0 ^ old-s1
- ;; rotl(s0, 55) = s0 << 55 | (s0 >> 9)
- (inst movapd s0 old-s0) ; s0 = old-s0
- (inst movapd t0 old-s0) ; t0 = old-s0
- (inst psllq s0 55) ; s0 = s0 << 55
- (inst psrlq t0 9) ; t0 = s0 >> 9
- (inst orpd s0 t0) ; s0 = rotl(s0,55) = s0 << 55 | s0 >> 9
- (inst xorpd s0 s1) ; s0 = rotl(s0,55) ^ s1
- (inst movapd t0 s1) ; t0 = s1
- (inst psllq t0 14) ; t0 = s1 << 14
- (inst xorpd s0 t0) ; s0 = rotl(s0,55) ^ s1 ^ (s1 << 14)
- (inst movapd t0 s1) ; t0 = s1
- (inst psllq t0 36) ; t0 = s1 << 36
- (inst psrlq s1 28) ; s1 = s1 >> 28
- (inst orpd s1 t0) ; s1 = rotl(new-s1, 36)
-
- ))
-)
+#+random-xoroshiro
(progn
(defknown xoroshiro-next ((simple-array double-float (2)))
(values (unsigned-byte 32) (unsigned-byte 32))
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/4720c79403b1770bc7cb45ca972d6443e05c0be5...96c90caf2198db424bab95123e017979fc0eb655
---
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/4720c79403b1770bc7cb45ca972d6443e05c0be5...96c90caf2198db424bab95123e017979fc0eb655
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/20171220/c9e55e51/attachment-0001.html>
More information about the cmucl-cvs
mailing list