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

Initial support for xoroshiro128+ RNG

Not yet integrated but the basic vop and other methods do work and
produce the same output as the reference C code (not included).
parent cf370246
No related branches found
No related tags found
No related merge requests found
......@@ -698,3 +698,129 @@
(multiple-value-bind (fop dst src)
(get-fp-operation scp)
(values fop (list dst src))))
(defstruct (xoro-state (:constructor %make-xoro-state))
(state (make-array 2 :element-type 'double-float)
:type (simple-array double-float (2)))
(rand (make-array 1 :element-type '(unsigned-byte 32))
:type (simple-array (unsigned-byte 32) (1)))
(cached-p nil :type (member t nil)))
(defun make-xoro-state (&optional init)
(let* ((s (%make-xoro-state))
(state (xoro-state-state s)))
(flet ((make-double (x)
(let ((lo (ldb (byte 32 0) x))
(hi (ldb (byte 32 32) x)))
(kernel:make-double-float
(if (< hi #x80000000)
hi
(- hi #x100000000))
lo))))
(etypecase init
(null
s)
((vector integer 2)
(setf (aref state 0) (make-double (ldb (byte 64 0) (aref init 0)))
(aref state 1) (make-double (ldb (byte 64 0) (aref init 1)))))
(integer
(set-state (ldb (byte 64 0) init))
(let* ((s0 (splitmix64))
(s1 (splitmix64)))
(setf (aref state 0) (make-double s0)
(aref state 1) (make-double s1)))
)))
s))
#||
(defun xoroshiro (rng-state)
(declare (type xoro-state rng-state)
(optimize (speed 3) (safety 0)))
(let ((s (xoro-state- rng-state)))
(declare (type (simple-array double-float (2)) s))
(multiple-value-bind (r1 r0 new-s1 new-s0)
(vm::xoroshiro-next (aref s 1) (aref s 0))
(setf (aref s 1) new-s1
(aref s 0) new-s0)
(values r1 r0))))
||#
(defun xoroshiro (rng-state)
(declare (type xoro-state rng-state)
(optimize (speed 3) (safety 0)))
(let ((cached (xoro-state-cached-p rng-state)))
(cond (cached
(setf (xoro-state-cached-p rng-state) nil)
(aref (xoro-state-rand rng-state) 0))
(t
(let ((s (xoro-state-state rng-state)))
(declare (type (simple-array double-float (2)) s))
(multiple-value-bind (r1 r0)
(vm::xoroshiro-next s)
(setf (aref (xoro-state-rand rng-state) 0) r1)
(setf (xoro-state-cached-p rng-state) t)
r0))))))
(defun xoroshiro-jump (rng-state)
(declare (type xoro-state rng-state))
(let ((state (xoro-state-state rng-state))
(s0-0 0)
(s0-1 0)
(s1-0 0)
(s1-1 0))
(declare (type (unsigned-byte 32) s0-0 s0-1 s1-0 s1-1)
(optimize (speed 3) (safety 0)))
(dolist (jump '(#xbeac0467eba5facb #xd86b048b86aa9922))
(declare (type (unsigned-byte 64) jump))
(dotimes (b 64)
(declare (fixnum b))
(when (logbitp b jump)
(multiple-value-bind (x1 x0)
(kernel:double-float-bits (aref state 0))
(setf s0-1 (logxor s0-1 (ldb (byte 32 0) x1))
s0-0 (logxor s0-0 x0)))
(multiple-value-bind (x1 x0)
(kernel:double-float-bits (aref state 1))
(setf s1-1 (logxor s1-1 (ldb (byte 32 0) x1))
s1-0 (logxor s1-0 x0))))
(format t "jump: ~D s0, s1 = ~X~8,'0X ~X~8,'0X~%" b s0-1 s0-0 s1-1 s1-0)
(xoroshiro-next state)))
(flet ((convert (x1 x0)
(declare (type (unsigned-byte 32) x1 x0))
(kernel:make-double-float
(if (< x1 #x80000000) x1 (- x1 #x100000000))
x0)))
(setf (aref state 0) (convert s0-1 s0-0))
(setf (aref state 1) (convert s1-1 s1-0)))
rng-state))
(defun print-xoro-state (rng-state)
(let ((state (vm::xoro-state-state rng-state)))
(flet ((v (x)
(multiple-value-bind (hi lo)
(kernel:double-float-bits x)
(logior (ash (ldb (byte 32 0) hi) 32)
lo))))
(format t "~16,'0x ~16,'0x" (v (aref state 0)) (v (aref state 1))))))
(let ((state 0))
(declare (type (unsigned-byte 64) state))
(defun set-state (x)
(setf state (ldb (byte 64 0) x)))
(defun get-state ()
state)
(defun splitmix64 ()
(let ((z (setf state
(ldb (byte 64 0) (+ state #x9e3779b97f4a7c15)))))
(declare (type (unsigned-byte 64) z))
(setf z (ldb (byte 64 0)
(* (logxor z (ash z -30))
#xbf58476d1ce4e5b9)))
(setf z (ldb (byte 64 0)
(* (logxor z (ash z -27))
#x94d049bb133111eb)))
(logxor z (ash z -31)))))
......@@ -1833,3 +1833,121 @@
(vm::ash-right-unsigned num (- shift)))))
(t
(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)
))
)
(progn
(defknown xoroshiro-next ((simple-array double-float (2)))
(values (unsigned-byte 32) (unsigned-byte 32))
(movable))
(define-vop (xoroshiro-next)
(:policy :fast-safe)
(:translate xoroshiro-next)
(:args (state :scs (descriptor-reg) :to (:result 3)))
(:arg-types simple-array-double-float)
(:results (r1 :scs (unsigned-reg))
(r0 :scs (unsigned-reg)))
(:result-types unsigned-num unsigned-num)
(:temporary (:sc double-reg) s0)
(:temporary (:sc double-reg) s1)
(:temporary (:sc double-reg) t0)
(:generator 10
;; s0 = state[0]
(inst movsd s0 (make-ea :dword :base state
:disp (- (+ (* vm:vector-data-offset
vm:word-bytes)
(* 8 0))
vm:other-pointer-type)))
;; s1 = state[1]
(inst movsd s1 (make-ea :dword :base state
:disp (- (+ (* vm:vector-data-offset
vm:word-bytes)
(* 8 1))
vm:other-pointer-type)))
;; Compute result = s0 + s1
(inst movapd t0 s0)
(inst paddq t0 s1)
;; Save the 64-bit result as two 32-bit results
(inst movd r0 t0)
(inst psrlq t0 32)
(inst movd r1 t0)
;; s1 = s1 ^ s0
(inst xorpd s1 s0)
;; s0 = rotl(s0,55) = s0 << 55 | s0 >> 9
(inst movapd t0 s0)
(inst psllq s0 55) ; s0 = s0 << 55
(inst psrlq t0 9) ; t0 = s0 >> 9
(inst orpd s0 t0) ; s0 = rotl(s0, 55)
(inst movapd t0 s1)
(inst xorpd s0 s1) ; s0 = s0 ^ s1
(inst psllq t0 14) ; t0 = s1 << 14
(inst xorpd s0 t0) ; s0 = s0 ^ t0
(inst movsd (make-ea :dword :base state
:disp (- (+ (* vm:vector-data-offset
vm:word-bytes)
(* 8 0))
vm:other-pointer-type))
s0)
;; s1 = rotl(s1, 36) = s1 << 36 | s1 >> 28, using t0 as temp
(inst movapd t0 s1)
(inst psllq s1 36)
(inst psrlq t0 28)
(inst orpd s1 t0)
(inst movsd (make-ea :dword :base state
:disp (- (+ (* vm:vector-data-offset
vm:word-bytes)
(* 8 1))
vm:other-pointer-type))
s1)))
)
\ No newline at end of file
......@@ -3195,7 +3195,11 @@
;; dst[63:0] = dst[63:0]
;; dst[127:64] = src[63:0]
(define-regular-sse-inst unpcklpd #x66 #x14 t)
(define-regular-sse-inst unpcklps nil #x14 t))
(define-regular-sse-inst unpcklps nil #x14 t)
;; PADDQ 64-bit integer add
(define-regular-sse-inst paddq #x66 #xd4)
)
(define-instruction popcnt (segment dst src)
(:printer ext-reg-reg/mem
......@@ -3539,4 +3543,3 @@
(packed-shift psllw #x71 #xf1 6)
(packed-shift psrad #x72 #xe2 4)
(packed-shift psraw #x71 #xe1 4))
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