- cmucl-cvs - mailman3.common-lisp.net

[Git][cmucl/cmucl][rtoy-xoro-default] Document the jump function and add test.
by Raymond Toy 21 Dec '17

21 Dec '17

Raymond Toy pushed to branch rtoy-xoro-default at cmucl / cmucl Commits: 9cd66071 by Raymond Toy at 2017-12-20T16:30:41-08:00 Document the jump function and add test. * rand-xoroshiro.lisp: * Rename xoroshiro-jump to random-state-jump * Add documentation/comments. * tests/rng.lisp * Add tests for the RNG jump function. - - - - - 2 changed files: - src/code/rand-xoroshiro.lisp - tests/rng.lisp Changes: ===================================== src/code/rand-xoroshiro.lisp ===================================== --- a/src/code/rand-xoroshiro.lisp +++ b/src/code/rand-xoroshiro.lisp @@ -18,7 +18,8 @@ make-random-state)) (in-package "KERNEL") -(export '(%random-single-float %random-double-float random-chunk init-random-state)) +(export '(%random-single-float %random-double-float random-chunk init-random-state + random-state-jump)) (sys:register-lisp-feature :random-xoroshiro) @@ -470,7 +471,12 @@ :format-control (intl:gettext "Argument is not a positive integer or a positive float: ~S") :format-arguments (list arg))))) -(defun xoroshiro-jump (rng-state) +;; Jump function for the generator. See the jump function in +;; http://xoroshiro.di.unimi.it/xoroshiro128plus.c +(defun random-state-jump (&optional (rng-state *random-state*)) + "Jump the RNG-STATE. This is equivalent to 2^64 calls to the + xoroshiro128+ generator. It can be used to generate 2^64 + non-overlapping subsequences for parallel computations." (declare (type random-state rng-state)) (let ((state (random-state-state rng-state)) (s0-0 0) @@ -493,7 +499,6 @@ (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-gen state))) (flet ((convert (x1 x0) @@ -504,4 +509,3 @@ (setf (aref state 0) (convert s0-1 s0-0)) (setf (aref state 1) (convert s1-1 s1-0))) rng-state)) - ===================================== tests/rng.lisp ===================================== --- a/tests/rng.lisp +++ b/tests/rng.lisp @@ -55,3 +55,16 @@ item (assert-equal value (64-bit-value *test-state*)) (assert-equal state (multiple-value-list (64-bit-rng-state *test-state*)))))) + +(define-test rng.jump + (setf *test-state* + (kernel::make-random-object :state (kernel::init-random-state #x12345678) + :rand 0 + :cached-p nil)) + (dolist (result '((#x291ddf8e6f6a7b67 #x1f9018a12f9e031f) + (#x88a7aa12158558d0 #xe264d785ab1472d9) + (#x207e16f73c51e7ba #x999c8a0a9a8d87c0) + (#x28f8959d3bcf5ff1 #x38091e563ab6eb98))) + (kernel:random-state-jump *test-state*) + (assert-equal result (multiple-value-list + (64-bit-rng-state *test-state*))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/9cd66071aa0b124404736b746… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/9cd66071aa0b124404736b746… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-xoro-default] 2 commits: Add documentation and inline xoroshiro-gen
by Raymond Toy 20 Dec '17

20 Dec '17

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(a)acm.org) +;;; Blackman and Sebastiano Vigna (vigna(a)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/4720c79403b1770bc7cb45ca… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/4720c79403b1770bc7cb45ca… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-xoro-default] 3 commits: Conditionalize on random-xoroshiro.
by Raymond Toy 20 Dec '17

20 Dec '17

Raymond Toy pushed to branch rtoy-xoro-default at cmucl / cmucl Commits: be17d9f4 by Raymond Toy at 2017-12-19T19:01:35-08:00 Conditionalize on random-xoroshiro. These tests test the actual implementation details of the xoroshiro128+ generator, so conditionalize it for this generator. - - - - - 0c2284a7 by Raymond Toy at 2017-12-19T19:03:21-08:00 Add cross script for sparc This changes the RNG to xoroshiro128+ for sparc. - - - - - 4720c794 by Raymond Toy at 2017-12-19T19:03:27-08:00 Add comment - - - - - 3 changed files: - + src/bootfiles/21c/boot-21c-cross-sparc.lisp - src/bootfiles/21c/boot-21c-cross-x86.lisp - tests/rng.lisp Changes: ===================================== src/bootfiles/21c/boot-21c-cross-sparc.lisp ===================================== --- /dev/null +++ b/src/bootfiles/21c/boot-21c-cross-sparc.lisp @@ -0,0 +1,237 @@ +(in-package :cl-user) + +;;; Rename the SPARC package and backend so that new-backend does the +;;; right thing. +(rename-package "SPARC" "OLD-SPARC" '("OLD-VM")) +(setf (c:backend-name c:*native-backend*) "OLD-SPARC") + +(c::new-backend "SPARC" + ;; Features to add here + '(:sparc + :sparc-v9 ; For Ultrasparc processors + :complex-fp-vops ; Some slightly faster FP vops on complex numbers + :linkage-table + :stack-checking ; Throw error if we run out of stack + :heap-overflow-check ; Throw error if we run out of + ; heap (This requires gencgc!) + :gencgc ; Generational GC + :relative-package-names ; Relative package names from Allegro + :conservative-float-type + :hash-new + :random-xoroshiro ; xoroshiro128+ RNG + :cmu ; Announce this is CMUCL + :cmu20 :cmu20a ; Current version identifier + :modular-arith ; Modular arithmetic + :double-double ; Double-double float support + ) + ;; Features to remove from current *features* here + '(:sparc-v8 :sparc-v7 ; Choose only one of :sparc-v7, :sparc-v8, :sparc-v9 + ;; Other architectures we aren't using. + :x86 :x86-bootstrap + :alpha :osf1 :mips + ;; Really old stuff that should have been removed long ago. + :propagate-fun-type :propagate-float-type :constrain-float-type + ;; Other OSes were not using + :openbsd :freebsd :glibc2 :linux + :pentium + :long-float + :new-random + :random-mt19937 ; MT-19937 generator + :small)) + +;;; May need to add some symbols to *features* and +;;; sys::*runtime-features* as well. This might be needed even if we +;;; have those listed above, because of the code checks for things in +;;; *features* and not in the backend-features.. So do that here. + + +;;; Extern-alien-name for the new backend. +(in-package :vm) +(defun extern-alien-name (name) + (declare (type simple-string name)) + #+(and bsd (not elf)) + (concatenate 'string "_" name) + #-(and bsd (not elf)) + name) +;; When compiling the compiler, vm:fixup-code-object and +;; vm:sanctify-for-execution are undefined. Import these to get rid +;; of that error. +(import 'old-vm::fixup-code-object) +(import 'old-vm::sanctify-for-execution) +(export 'extern-alien-name) +(export 'fixup-code-object) +(export 'sanctify-for-execution) + +(in-package :cl-user) + +;;; Compile the new backend. +(pushnew :bootstrap *features*) +(pushnew :building-cross-compiler *features*) +(load "target:tools/comcom") + +;;; Load the new backend. +(setf (search-list "c:") + '("target:compiler/")) +(setf (search-list "vm:") + '("c:sparc/" "c:generic/")) +(setf (search-list "assem:") + '("target:assembly/" "target:assembly/sparc/")) + +;; Load the backend of the compiler. + +(in-package "C") + +(load "vm:vm-macs") +(load "vm:parms") +(load "vm:objdef") +(load "vm:interr") +(load "assem:support") + +(load "target:compiler/srctran") +(load "vm:vm-typetran") +(load "target:compiler/float-tran") +(load "target:compiler/saptran") + +(load "vm:macros") +(load "vm:utils") + +(load "vm:vm") +(load "vm:insts") +(load "vm:primtype") +(load "vm:move") +(load "vm:sap") +(load "vm:system") +(load "vm:char") +(load "vm:float") + +(load "vm:memory") +(load "vm:static-fn") +(load "vm:arith") +(load "vm:cell") +(load "vm:subprim") +(load "vm:debug") +(load "vm:c-call") +(load "vm:print") +(load "vm:alloc") +(load "vm:call") +(load "vm:nlx") +(load "vm:values") +(load "vm:array") +(load "vm:pred") +(load "vm:type-vops") + +(load "assem:assem-rtns") + +(load "assem:array") +(load "assem:arith") +(load "assem:alloc") + +(load "c:pseudo-vops") + +(check-move-function-consistency) + +(load "vm:new-genesis") + +;;; OK, the cross compiler backend is loaded. + +(setf *features* (remove :building-cross-compiler *features*)) + +;;; Info environment hacks. +(macrolet ((frob (&rest syms) + `(progn ,@(mapcar #'(lambda (sym) + `(defconstant ,sym + (symbol-value + (find-symbol ,(symbol-name sym) + :vm)))) + syms)))) + (frob OLD-VM:BYTE-BITS OLD-VM:WORD-BITS + OLD-VM:CHAR-BITS + OLD-VM:CHAR-BYTES + OLD-VM:LOWTAG-BITS + #+long-float OLD-VM:SIMPLE-ARRAY-LONG-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-DOUBLE-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-SINGLE-FLOAT-TYPE + #+long-float OLD-VM:SIMPLE-ARRAY-COMPLEX-LONG-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-COMPLEX-DOUBLE-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-COMPLEX-SINGLE-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-2-TYPE + OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-4-TYPE + OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-8-TYPE + OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-16-TYPE + OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-32-TYPE + OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-8-TYPE + OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-16-TYPE + OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-30-TYPE + OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-32-TYPE + OLD-VM:SIMPLE-BIT-VECTOR-TYPE + OLD-VM:SIMPLE-STRING-TYPE OLD-VM:SIMPLE-VECTOR-TYPE + OLD-VM:SIMPLE-ARRAY-TYPE OLD-VM:VECTOR-DATA-OFFSET + OLD-VM:DOUBLE-FLOAT-DIGITS + old-vm:single-float-digits + OLD-VM:DOUBLE-FLOAT-EXPONENT-BYTE + OLD-VM:DOUBLE-FLOAT-NORMAL-EXPONENT-MAX + OLD-VM:DOUBLE-FLOAT-SIGNIFICAND-BYTE + OLD-VM:SINGLE-FLOAT-EXPONENT-BYTE + OLD-VM:SINGLE-FLOAT-NORMAL-EXPONENT-MAX + OLD-VM:SINGLE-FLOAT-SIGNIFICAND-BYTE + ) + #+double-double + (frob OLD-VM:SIMPLE-ARRAY-COMPLEX-DOUBLE-DOUBLE-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-DOUBLE-DOUBLE-FLOAT-TYPE) + ) + +;; Modular arith hacks. When cross-compiling, the compiler wants to +;; constant-fold some stuff, and it needs the following functions to +;; do so. This just gets rid of the hundreds of errors that happen. +(setf (fdefinition 'vm::ash-left-mod32) #'old-vm::ash-left-mod32) +(setf (fdefinition 'vm::lognot-mod32) #'old-vm::lognot-mod32) +;; End modular arith hacks + +(let ((function (symbol-function 'kernel:error-number-or-lose))) + (let ((*info-environment* (c:backend-info-environment c:*target-backend*))) + (setf (symbol-function 'kernel:error-number-or-lose) function) + (setf (info function kind 'kernel:error-number-or-lose) :function) + (setf (info function where-from 'kernel:error-number-or-lose) :defined))) + +(defun fix-class (name) + (let* ((new-value (find-class name)) + (new-layout (kernel::%class-layout new-value)) + (new-cell (kernel::find-class-cell name)) + (*info-environment* (c:backend-info-environment c:*target-backend*))) + (remhash name kernel::*forward-referenced-layouts*) + (kernel::%note-type-defined name) + (setf (info type kind name) :instance) + (setf (info type class name) new-cell) + (setf (info type compiler-layout name) new-layout) + new-value)) +(fix-class 'c::vop-parse) +(fix-class 'c::operand-parse) + +#+random-mt19937 +(declaim (notinline kernel:random-chunk)) + +(setf c:*backend* c:*target-backend*) + +;;; Extern-alien-name for the new backend. +(in-package :vm) +(defun extern-alien-name (name) + (declare (type simple-string name)) + name) +(export 'extern-alien-name) +(export 'fixup-code-object) +(export 'sanctify-for-execution) +(in-package :cl-user) + +;;; Don't load compiler parts from the target compilation + +(defparameter *load-stuff* nil) + +;; Sometimes during cross-compile sparc::any-reg isn't defined during +;; cross-compile. +;; +;; hack, hack, hack: Make old-vm::any-reg the same as +;; sparc::any-reg as an SC. Do this by adding old-vm::any-reg +;; to the hash table with the same value as sparc::any-reg. +(let ((ht (c::backend-sc-names c::*target-backend*))) + (setf (gethash 'old-vm::any-reg ht) + (gethash 'vm::any-reg ht))) ===================================== src/bootfiles/21c/boot-21c-cross-x86.lisp ===================================== --- a/src/bootfiles/21c/boot-21c-cross-x86.lisp +++ b/src/bootfiles/21c/boot-21c-cross-x86.lisp @@ -20,7 +20,7 @@ :gencgc ; Generational GC :conservative-float-type :hash-new - :random-xoroshiro + :random-xoroshiro ; xoroshiro128+ RNG :cmu :cmu20 :cmu20a ; Version features :double-double ; double-double float support ) ===================================== tests/rng.lisp ===================================== --- a/tests/rng.lisp +++ b/tests/rng.lisp @@ -20,6 +20,7 @@ (defvar *test-state*) +#+random-xoroshiro (define-test rng.initial-state (setf *test-state* (kernel::make-random-object :state (kernel::init-random-state #x12345678) @@ -33,6 +34,7 @@ (assert-equal nil (kernel::random-state-cached-p *test-state*)))) +#+random-xoroshiro (define-test rng.values-test (assert-equal (list #x38f1dc39d1906b6f #xdfe4142236dd9517) (multiple-value-list (64-bit-rng-state *test-state*))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/f5df87450892d588b44724bf… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/f5df87450892d588b44724bf… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-xoro-default] Update tests to match xoroshiro implementation.
by Raymond Toy 20 Dec '17

20 Dec '17

Raymond Toy pushed to branch rtoy-xoro-default at cmucl / cmucl Commits: f5df8745 by Raymond Toy at 2017-12-19T18:18:23-08:00 Update tests to match xoroshiro implementation. - - - - - 1 changed file: - tests/rng.lisp Changes: ===================================== tests/rng.lisp ===================================== --- a/tests/rng.lisp +++ b/tests/rng.lisp @@ -6,7 +6,7 @@ (in-package "RNG-TESTS") (defun 64-bit-rng-state (rng) - (let ((state (kernel::xoro-random-state-state rng))) + (let ((state (kernel::random-state-state rng))) (flet ((convert (x) (multiple-value-bind (hi lo) (kernel:double-float-bits x) @@ -15,29 +15,29 @@ (values (convert (aref state 0)) (convert (aref state 1)))))) (defun 64-bit-value (rng) - (logior (ash (kernel::xoroshiro-chunk rng) 32) - (kernel::xoroshiro-chunk rng))) + (logior (ash (kernel::random-chunk rng) 32) + (kernel::random-chunk rng))) (defvar *test-state*) (define-test rng.initial-state (setf *test-state* - (kernel::make-xoroshiro-object :state (kernel::init-xoro-state #x12345678) - :rand 0 - :cached-p nil)) + (kernel::make-random-object :state (kernel::init-random-state #x12345678) + :rand 0 + :cached-p nil)) (multiple-value-bind (s0 s1) (64-bit-rng-state *test-state*) (assert-equal #x38f1dc39d1906b6f s0) (assert-equal #xdfe4142236dd9517 s1) - (assert-equal 0 (kernel::xoro-random-state-rand *test-state*)) - (assert-equal nil (kernel::xoro-random-state-cached-p *test-state*)))) + (assert-equal 0 (kernel::random-state-rand *test-state*)) + (assert-equal nil (kernel::random-state-cached-p *test-state*)))) (define-test rng.values-test (assert-equal (list #x38f1dc39d1906b6f #xdfe4142236dd9517) (multiple-value-list (64-bit-rng-state *test-state*))) - (assert-equal 0 (kernel::xoro-random-state-rand *test-state*)) - (assert-equal nil (kernel::xoro-random-state-cached-p *test-state*)) + (assert-equal 0 (kernel::random-state-rand *test-state*)) + (assert-equal nil (kernel::random-state-cached-p *test-state*)) (dolist (item '((#x18d5f05c086e0086 (#x228f4926843b364d #x74dfe78e715c81be)) (#x976f30b4f597b80b (#x5b6bd4558bd96a68 #x567b7f35650aea8f)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/f5df87450892d588b44724bf9… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/f5df87450892d588b44724bf9… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch rtoy-xoro-default
by Raymond Toy 20 Dec '17

20 Dec '17

Raymond Toy pushed new branch rtoy-xoro-default at cmucl / cmucl --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/tree/rtoy-xoro-default You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-xoro] Print and set state as 64-bit integers
by Raymond Toy 19 Dec '17

19 Dec '17

Raymond Toy pushed to branch rtoy-xoro at cmucl / cmucl Commits: f9203f85 by Raymond Toy at 2017-12-19T10:04:50-08:00 Print and set state as 64-bit integers The xoroshiro128+ algorithm is defined using uint64_t types, but we hack it to store the state as double-float's. This is a bit confusing, so add a printer to print the state as an array of two uint64_t's. Adjust init-xoro-state to allow initializing the state using an array of 2 64-bit ints. - - - - - 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 @@ -22,6 +22,28 @@ (sys:register-lisp-feature :random-xoroshiro) +(defun generate-seed (&optional (nwords 1)) + ;; On some systems (as reported by Ole Rohne on cmucl-imp), + ;; /dev/urandom isn't what we think it is, so if it doesn't work, + ;; silently generate the seed from the current time. + (or (ignore-errors + (let ((words (make-array nwords :element-type '(unsigned-byte 32)))) + (with-open-file (rand "/dev/urandom" + :direction :input + :element-type '(unsigned-byte 32)) + (read-sequence words rand)) + (if (= nwords 1) + (aref words 0) + (let ((vec (make-array (floor nwords 2) :element-type '(unsigned-byte 64)))) + (do ((k 0 (+ k 1)) + (j 0 (+ j 2))) + ((>= k (length vec)) + vec) + (setf (aref vec k) + (logior (ash (aref words j) 32) + (aref words (+ j 1))))))))) + (logand (get-universal-time) #xffffffff))) + (defun int-init-xoro-state (&optional (seed 5772156649015328606) state) (let ((state (or state (make-array 2 :element-type 'double-float))) (splitmix-state (ldb (byte 64 0) seed))) @@ -51,16 +73,18 @@ state)))) (defun vec-init-xoro-state (key &optional state) - (declare (type (array (unsigned-byte 32) (4)) key) + (declare (type (array (unsigned-byte 64) (2)) key) (type (simple-array double-float (2)) state)) - (flet ((make-double (hi lo) - (kernel:make-double-float - (if (< hi #x80000000) - hi - (- hi #x100000000)) - lo))) - (setf (aref state 0) (make-double (aref key 0) (aref key 1)) - (aref state 1) (make-double (aref key 2) (aref key 3))) + (flet ((make-double (x) + (let ((hi (ldb (byte 32 32) x)) + (lo (ldb (byte 32 0) x))) + (kernel:make-double-float + (if (< hi #x80000000) + hi + (- hi #x100000000)) + lo)))) + (setf (aref state 0) (make-double (aref key 0)) + (aref state 1) (make-double (aref key 1))) state)) @@ -68,13 +92,13 @@ "Generate an random state vector from the given SEED. The seed can be either an integer or a vector of (unsigned-byte 32)" (declare (type (or null integer - (array (unsigned-byte 32) (*))) + (array (unsigned-byte 64) (*))) seed)) (let ((state (or state (make-array 2 :element-type 'double-float)))) (etypecase seed (integer (int-init-xoro-state (ldb (byte 64 0) seed) state)) - ((array (unsigned-byte 32) (4)) + ((array (unsigned-byte 64) (2)) (vec-init-xoro-state seed state))))) (defstruct (xoro-random-state @@ -113,14 +137,15 @@ (pprint-logical-block (stream nil :prefix "#.(" :suffix ")") (prin1 'init-xoro-state stream) (write-char #\space stream) - (prin1 (make-array 4 :element-type '(unsigned-byte 32) - :initial-contents (list (ldb (byte 32 0) - (double-float-high-bits (aref state 0))) - (double-float-low-bits (aref state 0)) - (ldb (byte 32 0) - (double-float-high-bits (aref state 1))) - (double-float-low-bits (aref state 1)))) - stream)) + (flet ((c (x) + (multiple-value-bind (hi lo) + (double-float-bits x) + (logior (ash (ldb (byte 32 0) hi) 32) + lo)))) + (prin1 (make-array 2 :element-type '(unsigned-byte 64) + :initial-contents (list (c (aref state 0)) + (c (aref state 1)))) + stream))) (write-char #\space stream) (pprint-newline :linear stream) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/f9203f85f2f65dd8b277f2910… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/f9203f85f2f65dd8b277f2910… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-xoro] Add custom xoro-random-state printer
by Raymond Toy 19 Dec '17

19 Dec '17

Raymond Toy pushed to branch rtoy-xoro at cmucl / cmucl Commits: 0b94ee3d by Raymond Toy at 2017-12-19T09:02:25-08:00 Add custom xoro-random-state printer Custom printer to print the state as array of integers instead of doubles. Makes it easier to see and match what the C code does. - - - - - 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 @@ -79,6 +79,7 @@ (defstruct (xoro-random-state (:constructor make-xoroshiro-object) + (:print-function %print-xoro-state) (:make-load-form-fun :just-dump-it-normally)) ;; The state of the RNG. The actual algorithm uses 2 64-bit words ;; of state. To reduce consing, we use an array of double-float's @@ -95,6 +96,46 @@ ;; generate a new 64-bit result. (cached-p nil :type (member t nil))) +(defun %print-xoro-state (rng-state stream depth) + (declare (ignore depth)) + ;; Basically the same as the default structure printer, but we want + ;; to print the state as an array of integers instead of doubles, + ;; because it's a bit confusing to see the state as doubles. + (let ((state (xoro-random-state-state rng-state))) + (pprint-logical-block (stream nil :prefix "#S(" :suffix ")") + (prin1 'xoro-random-state stream) + (write-char #\space stream) + (pprint-indent :block 2 stream) + (pprint-newline :linear stream) + (prin1 :state stream) + (write-char #\space stream) + (pprint-newline :miser stream) + (pprint-logical-block (stream nil :prefix "#.(" :suffix ")") + (prin1 'init-xoro-state stream) + (write-char #\space stream) + (prin1 (make-array 4 :element-type '(unsigned-byte 32) + :initial-contents (list (ldb (byte 32 0) + (double-float-high-bits (aref state 0))) + (double-float-low-bits (aref state 0)) + (ldb (byte 32 0) + (double-float-high-bits (aref state 1))) + (double-float-low-bits (aref state 1)))) + stream)) + (write-char #\space stream) + (pprint-newline :linear stream) + + (prin1 :rand stream) + (write-char #\space stream) + (pprint-newline :miser stream) + (prin1 (xoro-random-state-rand rng-state) stream) + (write-char #\space stream) + (pprint-newline :linear stream) + + (prin1 :cached-p stream) + (write-char #\space stream) + (pprint-newline :miser stream) + (prin1 (xoro-random-state-cached-p rng-state) stream)))) + (defvar *xoro-random-state* (make-xoroshiro-object)) @@ -396,11 +437,3 @@ (setf (aref state 1) (convert s1-1 s1-0))) rng-state)) -(defun print-xoro-state (rng-state) - (let ((state (xoro-random-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)))))) \ No newline at end of file View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/0b94ee3d6f6bdf7c2575678ef… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/0b94ee3d6f6bdf7c2575678ef… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-xoro] Fix typos add jump function
by Raymond Toy 19 Dec '17

19 Dec '17

Raymond Toy pushed to branch rtoy-xoro at cmucl / cmucl Commits: dbc0518d by Raymond Toy at 2017-12-18T21:02:39-08:00 Fix typos add jump function * Fix typos in names so we can call the functions. * Add jump function to allow generating new distinct sequences. * Add simple function to print the state using integers instead of doubles. (Untested.) - - - - - 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 @@ -18,7 +18,7 @@ make-xoro-random-state)) (in-package "KERNEL") -(export '(%xorohiro-single-float %xorohiro-double-float xoroshiro-chunk init-xoro-state)) +(export '(%xoroshiro-single-float %xoroshiro-double-float xoroshiro-chunk init-xoro-state)) (sys:register-lisp-feature :random-xoroshiro) @@ -95,7 +95,8 @@ ;; generate a new 64-bit result. (cached-p nil :type (member t nil))) -(defvar *xoro-random-state*) +(defvar *xoro-random-state* + (make-xoroshiro-object)) (defun make-xoro-random-state (&optional state) (flet ((copy-random-state (state) @@ -120,16 +121,23 @@ ;;;; Random entries: +(declaim (ext:start-block xoroshiro-gen xoroshiro-chunk + %xoroshiro-single-float %xoroshiro-double-float + %xoroshiro-integer + #+double-double + %xoroshiro-double-double-float)) +;;#+x86 +;;(declaim (inline xoroshiro-next)) #+x86 -(declaim (inline xoroshiro-next)) -#+x86 -(defun xoroshiro-next (state) - (declare (type (simple-array double-float (2)) state)) +(defun xoroshiro-gen (state) + (declare (type (simple-array double-float (2)) state) + (optimize (speed 3) (safety 0))) (vm::xoroshiro-next state)) #-x86 -(defun xoroshiro-next (state) - (declare (type (simple-array double-float (2)) state)) +(defun xoroshiro-gen (state) + (declare (type (simple-array double-float (2)) state) + (optimize (speed 3) (safety 0))) (flet ((rotl-55 (x1 x0) (declare (type (unsigned-byte 32) x0 x1) (optimize (speed 3) (safety 0))) @@ -228,7 +236,7 @@ (let ((s (xoro-random-state-state rng-state))) (declare (type (simple-array double-float (2)) s)) (multiple-value-bind (r1 r0) - (xoroshiro-next s) + (xoroshiro-gen s) (setf (xoro-random-state-rand rng-state) r0) (setf (xoro-random-state-cached-p rng-state) t) r1)))))) @@ -240,14 +248,14 @@ ;;; between 0.0 and 1.0 by clobbering the significand of 1.0 with random bits, ;;; then subtracting 1.0. This hides the fact that we have a hidden bit. ;;; -(declaim (inline %xorohiro-single-float %xorohiro-double-float)) -(declaim (ftype (function ((single-float (0f0)) random-state) +(declaim (inline %xoroshiro-single-float %xoroshiro-double-float)) +(declaim (ftype (function ((single-float (0f0)) xoro-random-state) (single-float 0f0)) - %xorohiro-single-float)) + %xoroshiro-single-float)) ;;; -(defun %xorohiro-single-float (arg state) +(defun %xoroshiro-single-float (arg state) (declare (type (single-float (0f0)) arg) - (type random-state state)) + (type xoro-random-state state)) (* arg (- (make-single-float (dpb (ash (xoroshiro-chunk state) @@ -256,15 +264,15 @@ (single-float-bits 1.0))) 1.0))) ;;; -(declaim (ftype (function ((double-float (0d0)) random-state) +(declaim (ftype (function ((double-float (0d0)) xoro-random-state) (double-float 0d0)) - %xorohiro-double-float)) + %xoroshiro-double-float)) ;;; ;;; 53bit version. ;;; -(defun %xorohiro-double-float (arg state) +(defun %xoroshiro-double-float (arg state) (declare (type (double-float (0d0)) arg) - (type random-state state)) + (type xoro-random-state state)) (* arg (- (lisp::make-double-float (dpb (ash (xoroshiro-chunk state) @@ -311,11 +319,12 @@ ;;; %RANDOM-INTEGER -- Internal ;;; -(defun %xorohiro-integer (arg state) - (declare (type (integer 1) arg) (type random-state state)) +(defun %xoroshiro-integer (arg state) + (declare (type (integer 1) arg) + (type xoro-random-state state)) (let ((shift (- random-chunk-length random-integer-overlap))) - (do ((bits (random-chunk state) - (logxor (ash bits shift) (random-chunk state))) + (do ((bits (xoroshiro-chunk state) + (logxor (ash bits shift) (xoroshiro-chunk state))) (count (+ (integer-length arg) (- random-integer-extra-bits shift)) (- count shift))) @@ -323,30 +332,75 @@ (rem bits arg)) (declare (fixnum count))))) -(defun xoro-random (arg &optional (state *random-state*)) +(declaim (ext:end-block)) + +(defun xoro-random (arg &optional (state *xoro-random-state*)) "Generate a uniformly distributed pseudo-random number between zero and Arg. State, if supplied, is the random state to use." - (declare (inline %xorohiro-single-float %xorohiro-double-float + (declare (inline %xoroshiro-single-float %xoroshiro-double-float #+long-float %long-float)) (cond ((typep arg '(integer 1 #x100000000)) ;; Let the compiler deftransform take care of this case. - (random arg state)) + (%xoroshiro-integer arg state)) ((and (typep arg 'single-float) (> arg 0.0F0)) - (%xorohiro-single-float arg state)) + (%xoroshiro-single-float arg state)) ((and (typep arg 'double-float) (> arg 0.0D0)) - (%xorohiro-double-float arg state)) + (%xoroshiro-double-float arg state)) #+long-float ((and (typep arg 'long-float) (> arg 0.0L0)) - (%xorohiro-long-float arg state)) + (%xoroshiro-long-float arg state)) #+double-double ((and (typep arg 'double-double-float) (> arg 0.0w0)) - (%xorohiro-double-double-float arg state)) + (%xoroshiro-double-double-float arg state)) ((and (integerp arg) (> arg 0)) - (%xorohiro-integer arg state)) + (%xoroshiro-integer arg state)) (t (error 'simple-type-error :expected-type '(or (integer 1) (float (0.0))) :datum arg :format-control (intl:gettext "Argument is not a positive integer or a positive float: ~S") :format-arguments (list arg))))) +(defun xoroshiro-jump (rng-state) + (declare (type xoro-random-state rng-state)) + (let ((state (xoro-random-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 (xoro-random-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)))))) \ No newline at end of file View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/dbc0518d7d280599ce5185ace… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/dbc0518d7d280599ce5185ace… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-xoro] Define xoroshiro-next before xoroshiro-chunk.
by Raymond Toy 17 Dec '17

17 Dec '17

Raymond Toy pushed to branch rtoy-xoro at cmucl / cmucl Commits: d539b6a0 by Raymond Toy at 2017-12-17T13:04:59-08:00 Define xoroshiro-next before xoroshiro-chunk. - - - - - 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 @@ -120,32 +120,12 @@ ;;;; Random entries: -;;; Size of the chunks returned by xoroshiro-chunk. -;;; -;;(defconstant random-chunk-length 32) - -;;; xoroshiro-chunk -- Internal -;;; -;;; This function generaters a 32bit integer between 0 and #xffffffff -;;; inclusive. -;;; -(declaim (inline xoroshiro-chunk)) - -(defun xoroshiro-chunk (rng-state) - (declare (type xoro-random-state rng-state) - (optimize (speed 3) (safety 0))) - (let ((cached (xoro-random-state-cached-p rng-state))) - (cond (cached - (setf (xoro-random-state-cached-p rng-state) nil) - (xoro-random-state-rand rng-state)) - (t - (let ((s (xoro-random-state-state rng-state))) - (declare (type (simple-array double-float (2)) s)) - (multiple-value-bind (r1 r0) - (xoroshiro-next s) - (setf (xoro-random-state-rand rng-state) r0) - (setf (xoro-random-state-cached-p rng-state) t) - r1)))))) +#+x86 +(declaim (inline xoroshiro-next)) +#+x86 +(defun xoroshiro-next (state) + (declare (type (simple-array double-float (2)) state)) + (vm::xoroshiro-next state)) #-x86 (defun xoroshiro-next (state) @@ -225,6 +205,34 @@ (rotl-36 s1-1 s1-0) (setf (aref state 0) (make-double s0-1 s0-0) (aref state 1) (make-double r1 r0))))))) + +;;; Size of the chunks returned by xoroshiro-chunk. +;;; +;;(defconstant random-chunk-length 32) + +;;; xoroshiro-chunk -- Internal +;;; +;;; This function generaters a 32bit integer between 0 and #xffffffff +;;; inclusive. +;;; +(declaim (inline xoroshiro-chunk)) + +(defun xoroshiro-chunk (rng-state) + (declare (type xoro-random-state rng-state) + (optimize (speed 3) (safety 0))) + (let ((cached (xoro-random-state-cached-p rng-state))) + (cond (cached + (setf (xoro-random-state-cached-p rng-state) nil) + (xoro-random-state-rand rng-state)) + (t + (let ((s (xoro-random-state-state rng-state))) + (declare (type (simple-array double-float (2)) s)) + (multiple-value-bind (r1 r0) + (xoroshiro-next s) + (setf (xoro-random-state-rand rng-state) r0) + (setf (xoro-random-state-cached-p rng-state) t) + r1)))))) + ;;; %RANDOM-SINGLE-FLOAT, %RANDOM-DOUBLE-FLOAT -- Interface ;;; View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/d539b6a06bf8d209c2678e3d2… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/d539b6a06bf8d209c2678e3d2… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-xoro] Put back the original version, optimized for x86.
by Raymond Toy 17 Dec '17

17 Dec '17

Raymond Toy pushed to branch rtoy-xoro at cmucl / cmucl Commits: 95a01145 by Raymond Toy at 2017-12-16T21:05:41-08:00 Put back the original version, optimized for x86. - - - - - 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,12 +142,13 @@ (let ((s (xoro-random-state-state rng-state))) (declare (type (simple-array double-float (2)) s)) (multiple-value-bind (r1 r0) - (xoroshiro-next-portable s) + (xoroshiro-next s) (setf (xoro-random-state-rand rng-state) r0) (setf (xoro-random-state-cached-p rng-state) t) r1)))))) -(defun xoroshiro-next-portable (state) +#-x86 +(defun xoroshiro-next (state) (declare (type (simple-array double-float (2)) state)) (flet ((rotl-55 (x1 x0) (declare (type (unsigned-byte 32) x0 x1) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/95a011458bb9f2bad346b92e9… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/95a011458bb9f2bad346b92e9… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0