[Git][cmucl/cmucl][rtoy-xoro-default] Implement vop for xoroshiro-next

[Raymond Toy]

Raymond Toy pushed to branch rtoy-xoro-default at cmucl / cmucl


Commits:
164cf685 by Raymond Toy at 2017-12-27T12:17:25-08:00
Implement vop for xoroshiro-next

Not yet working.  Cross-compile works and generates appropriate code,
but can't rebuild lisp using the cross-compiled lisp.

- - - - -


1 changed file:

- src/compiler/sparc/arith.lisp


Changes:

=====================================
src/compiler/sparc/arith.lisp
=====================================
--- a/src/compiler/sparc/arith.lisp
+++ b/src/compiler/sparc/arith.lisp
@@ -2588,3 +2588,62 @@
 		 (unsigned-byte 32))
   "recode as shifts and adds"
   (*-transformer y))
+
+(in-package "VM")
+
+#+random-xoroshiro
+(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)
+  ;; Must be sure to use %o registers for temps because we want to use
+  ;; 64-bit registers that will get preserved.
+  (:temporary (:sc unsigned-reg :offset nl5-offset) s0)
+  (:temporary (:sc unsigned-reg :offset nl4-offset) s1)
+  (:temporary (:sc unsigned-reg :offset nl3-offset) t0)
+  (:generator 10
+    (inst ldx s0 state (+ (* 0 double-float-bytes)
+			  (- (* vm:vector-data-offset vm:word-bytes)
+			     vm:other-pointer-type)))
+    (inst ldx s1 state (+ (* 1 double-float-bytes)
+			  (- (* vm:vector-data-offset vm:word-bytes)
+			     vm:other-pointer-type)))
+    ;; result = s0 + s1, split into low 32-bits in r0 and high 32-bits
+    ;; in r1
+    (inst add r0 s0 s1)
+    (inst srlx r1 r0 32)
+
+    ;; s1 = s1 ^ s0
+    (inst xor s1 s1 s0)
+
+    ;; s0 = rotl(s0,55) = s0 << 55 | s0 >> 9
+    (inst sllx s0 s0 55)
+    (inst srlx t0 s0 9)
+    (inst or s0 t0)
+
+    (inst xor s0 s1)			; s0 = s0 ^ s1
+    (inst sllx t0 s1 14)		; t0 = s1 << 14
+    (inst xor s0 t0)			; s0 = s0 ^ t0
+
+    (inst stx s0 state (+ (* 0 double-float-bytes)
+			  (- (* vm:vector-data-offset vm:word-bytes)
+			     vm:other-pointer-type)))
+
+    ;; s1 = rotl(s1, 36) = s1 << 36 | s1 >> 28, using t0 as temp
+    (inst sllx s1 36)
+    (inst srlx t0 s1 28)
+    (inst or s1 t0)
+
+    (inst stx s1 state (+ (* 1 double-float-bytes)
+			  (- (* vm:vector-data-offset vm:word-bytes)
+			     vm:other-pointer-type)))))
+)



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/164cf685e3b50676afd9b7115f60e2e3b1a45c48

---
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/164cf685e3b50676afd9b7115f60e2e3b1a45c48
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/20171227/f20ee5cb/attachment-0001.html>