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

[Git][cmucl/cmucl][master] 38 commits: Initial support for xoroshiro128+ RNG
by Raymond Toy 29 Dec '17

29 Dec '17

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 9bba906a by Raymond Toy at 2017-12-14T19:31:56-08:00 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). - - - - - b119b34f by Raymond Toy at 2017-12-15T09:00:38-08:00 Initial implementation of xoroshiro rng Not yet tested or integrated. - - - - - 8707116f by Raymond Toy at 2017-12-15T15:40:08-08:00 Random cleanups and updates Make some things work on x86: * Can create a random state and initialize it to the desired state * xoroshiro-chunk produces the correct values for the first few calls - - - - - eea11e07 by Raymond Toy at 2017-12-15T15:41:13-08:00 Compile and load xoroshiro rng Make xoroshiro rng available in the core. Basic things work on x86 but not yet integrated in anyway. - - - - - 192fe3b6 by Raymond Toy at 2017-12-16T08:16:46-08:00 Simplify state Don't need an array for the cached value; (unsigned-byte 32) is a specialized structure slot, so no consing. Some random cleanups and comments. - - - - - c62e3467 by Raymond Toy at 2017-12-16T08:17:24-08:00 Add tests for xoroshiro generator - - - - - edcbb7d3 by Raymond Toy at 2017-12-16T20:53:21-08:00 Test portable version of xoroshiro-next - - - - - 95a01145 by Raymond Toy at 2017-12-16T21:05:41-08:00 Put back the original version, optimized for x86. - - - - - d539b6a0 by Raymond Toy at 2017-12-17T13:04:59-08:00 Define xoroshiro-next before xoroshiro-chunk. - - - - - 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.) - - - - - 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. - - - - - 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. - - - - - 09bbc248 by Raymond Toy at 2017-12-19T17:32:05-08:00 Add cross-compile scripts for building xoroshiro128+. - - - - - 38db18cb by Raymond Toy at 2017-12-19T17:33:27-08:00 Set version 21c now. Bootstrap files are from 21c directory instead of 21b. - - - - - cba9bad7 by Raymond Toy at 2017-12-19T17:34:28-08:00 Update xoroshiro methods to standard names - - - - - 8d363473 by Raymond Toy at 2017-12-19T17:35:19-08:00 Make random-mt19937 function only when :random-mt19937 is set - - - - - 7362e561 by Raymond Toy at 2017-12-19T17:35:41-08:00 Disable some deftransforms for now - - - - - 68596489 by Raymond Toy at 2017-12-19T17:36:27-08:00 Add rand-xoroshiro to the build files Compile/load rand-xoroshiro if :random-xoroshiro is a feature. - - - - - b8d326cc by Raymond Toy at 2017-12-19T17:46:39-08:00 Update CI to do the required cross-compile - - - - - f5df8745 by Raymond Toy at 2017-12-19T18:18:23-08:00 Update tests to match xoroshiro implementation. - - - - - 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 - - - - - 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 - - - - - 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. - - - - - 96c58393 by Raymond Toy at 2017-12-27T09:46:59-08:00 Modify random-state-jump to use 32-bit ints Break the constants in the jump function into 32-bit chunks so we operate on 32-bit integers instead of 64-bit integers. This is a minor optimization. - - - - - ab6d2c6a by Raymond Toy at 2017-12-27T10:29:26-08:00 Fix compiler warning in VEC-INIT-XORO-STATE Set default value for state in VEC-INIT-XORO-STATE. If not given, initialize it to the correct array. - - - - - 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. - - - - - 6fbd959e by Raymond Toy at 2017-12-28T09:04:13-08:00 Fix logic mistakes in sparc xoroshiro impl Also compute the array offsets just once so we're consistent between loading and storing. - - - - - 11a14537 by Raymond Toy at 2017-12-28T09:04:27-08:00 Export random-state-jump - - - - - 448e9970 by Raymond Toy at 2017-12-28T09:53:39-08:00 Use the xoroshiro vop on sparc The vop greatly speeds up the generator on sparc. The time to generate 10,000,000 single-floats (on a 1 GHz Ultrasparc 3i) is: mt19937: 1.32 sec xoroshiro: 1.03 sec So xoroshiro is 22% faster than mt19937. - - - - - 58f107b1 by Raymond Toy at 2017-12-28T12:26:31-08:00 Print random state in hex Add comment for %random-double-float to use xoroshiro-gen directly instead of random-chunk twice. A minor micro optimization. - - - - - 86599903 by Raymond Toy at 2017-12-28T19:53:42-08:00 Add comments. - - - - - 562752c0 by Raymond Toy at 2017-12-28T19:54:11-08:00 Regenerated from sources - - - - - e5bd7ef7 by Raymond Toy at 2017-12-29T08:57:34-08:00 Fix typo in reader conditional. Don't use the portable xoroshiro-gen on x86 and sparc! - - - - - d8ef7876 by Raymond Toy at 2017-12-29T10:20:13-08:00 Update release notes - - - - - fb3f58ea by Raymond Toy at 2017-12-29T18:32:07+00:00 Merge branch 'rtoy-xoro-default' into 'master' Change random number generator from MT19937 to xoroshiro128+ Closes #48 See merge request cmucl/cmucl!29 - - - - - 18 changed files: - .gitlab-ci.yml - bin/build.sh - + src/bootfiles/21c/boot-21c-cross-sparc.lisp - + src/bootfiles/21c/boot-21c-cross-x86.lisp - + src/bootfiles/21c/boot-21c-cross.lisp - src/code/exports.lisp - + src/code/rand-xoroshiro.lisp - src/code/x86-vm.lisp - src/compiler/float-tran.lisp - src/compiler/sparc/arith.lisp - src/compiler/x86/arith.lisp - src/compiler/x86/insts.lisp - src/general-info/release-21d.md - src/i18n/locale/cmucl.pot - src/tools/worldbuild.lisp - src/tools/worldcom.lisp - src/tools/worldload.lisp - + tests/rng.lisp Changes: ===================================== .gitlab-ci.yml ===================================== --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -8,7 +8,10 @@ linux-runner: - mkdir snapshot - (cd snapshot; tar xjf ../cmucl-21c-x86-linux.tar.bz2; tar xjf ../cmucl-21c-x86-linux.extra.tar.bz2) script: - - bin/build.sh -C "" -o ./snapshot/bin/lisp + - bin/create-target.sh xtarget x86_linux x86 + - bin/create-target.sh xcross x86_linux x86 + - bin/cross-build-world.sh -crl xtarget xcross src/bootfiles/21c/boot-21c-cross.lisp ./snapshot/bin/lisp + - bin/build.sh -C "" -o xtarget/lisp/lisp - bin/make-dist.sh -I dist linux-4 - bin/run-tests.sh -l dist/bin/lisp 2>&1 | tee test.log @@ -20,6 +23,9 @@ osx-runner: - mkdir snapshot - (cd snapshot; tar xjf ../cmucl-21c-x86-darwin.tar.bz2) script: - - bin/build.sh -C "" -o ./snapshot/bin/lisp + - bin/create-target.sh xtarget x86_darwin + - bin/create-target.sh xcross x86_darwin + - bin/cross-build-world.sh -crl xtarget xcross src/bootfiles/21c/boot-21c-cross.lisp ./snapshot/bin/lisp + - bin/build.sh -C "" -o xtarget/lisp/lisp - bin/make-dist.sh -I dist darwin-4 - bin/run-tests.sh -l dist/bin/lisp 2>&1 | tee test.log ===================================== bin/build.sh ===================================== --- a/bin/build.sh +++ b/bin/build.sh @@ -39,7 +39,7 @@ ENABLE2="yes" ENABLE3="yes" ENABLE4="yes" -version=21b +version=21c SRCDIR=src BINDIR=bin TOOLDIR=$BINDIR ===================================== 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 ===================================== --- /dev/null +++ b/src/bootfiles/21c/boot-21c-cross-x86.lisp @@ -0,0 +1,225 @@ +;; Basic cross-compile script for cross-compiling from x86 to x86. +;; May require tweaking for more difficult cross-compiles. + +(in-package :cl-user) + +;;; Rename the X86 package and backend so that new-backend does the +;;; right thing. +(rename-package "X86" "OLD-X86" '("OLD-VM")) +(setf (c:backend-name c:*native-backend*) "OLD-X86") + +(c::new-backend "X86" + ;; Features to add here. These are just examples. You may not + ;; need to list anything here. We list them here anyway as a + ;; record of typical features for all x86 ports. + '(:x86 :i486 :pentium + :stack-checking ; Catches stack overflow + :heap-overflow-check ; Catches heap overflows + :relative-package-names ; relative package names + :mp ; multiprocessing + :gencgc ; Generational GC + :conservative-float-type + :hash-new + :random-xoroshiro ; xoroshiro128+ RNG + :cmu :cmu20 :cmu20a ; Version features + :double-double ; double-double float support + ) + ;; Features to remove from current *features* here. Normally don't + ;; need to list anything here unless you are trying to remove a + ;; feature. + '(:x86-bootstrap + ;; :alpha :osf1 :mips + :propagate-fun-type :propagate-float-type :constrain-float-type + ;; :openbsd :freebsd :glibc2 :linux + :long-float :new-random :small + :random-mt19937)) + +;;; Compile the new backend. +(pushnew :bootstrap *features*) +(pushnew :building-cross-compiler *features*) + +;; Make fixup-code-object and sanctify-for-execution in the VM package +;; be the same as the original. Needed to get rid of a compiler error +;; in generic/core.lisp. (This halts cross-compilations if the +;; compiling lisp uses the -batch flag. +(import 'old-vm::fixup-code-object "VM") +(import 'old-vm::sanctify-for-execution "VM") +(export 'vm::fixup-code-object "VM") +(export 'vm::sanctify-for-execution "VM") + +(do-external-symbols (sym "OLD-VM") + (export (intern (symbol-name sym) "VM") "VM")) + +(load "target:tools/comcom") + +;;; Load the new backend. +(setf (search-list "c:") + '("target:compiler/")) +(setf (search-list "vm:") + '("c:x86/" "c:generic/")) +(setf (search-list "assem:") + '("target:assembly/" "target:assembly/x86/")) + +;; 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") +(when (target-featurep :sse2) + (load "vm:sse2-sap")) +(load "vm:system") +(load "vm:char") +(if (target-featurep :sse2) + (load "vm:float-sse2") + (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") +(if (target-featurep :sse2) + (load "vm:sse2-c-call") + (load "vm:x87-c-call")) + +(load "vm:print") +(load "vm:alloc") +(load "vm:call") +(load "vm:nlx") +(load "vm:values") +;; These need to be loaded before array because array wants to use +;; some vops as templates. +(load (if (target-featurep :sse2) + "vm:sse2-array" + "vm:x87-array")) +(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 + #+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-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 +(setf (fdefinition 'vm::ash-left-mod32) #'old-vm::ash-left-mod32) +(setf (fdefinition 'vm::lognot-mod32) #'old-vm::lognot-mod32) +;; End 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)) + #-elf + (concatenate 'simple-string "_" name) + #+elf + name) +(export 'extern-alien-name) +(in-package :cl-user) + +;;; Don't load compiler parts from the target compilation + +(defparameter *load-stuff* nil) + +;; hack, hack, hack: Make old-vm::any-reg the same as +;; x86::any-reg as an SC. Do this by adding old-vm::any-reg +;; to the hash table with the same value as x86::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.lisp ===================================== --- /dev/null +++ b/src/bootfiles/21c/boot-21c-cross.lisp @@ -0,0 +1,13 @@ +;; Cross-compile script to change the default random number generator +;; from MT19937 to xoroshiro128+. + +;; The cross-script is basically the default platform script, but we +;; remove :random-mt19937 and add :random-xoroshiro to the backend +;; features. + +#+x86 +(load "src/bootfiles/21c/boot-21c-cross-x86.lisp") + +#+sparc +(load "src/bootfiles/21c/boot-21c-cross-sparc.lisp") + ===================================== src/code/exports.lisp ===================================== --- a/src/code/exports.lisp +++ b/src/code/exports.lisp @@ -2550,7 +2550,9 @@ "SIMPLE-ARRAY-COMPLEX-DOUBLE-DOUBLE-FLOAT-P" "OBJECT-NOT-SIMPLE-ARRAY-COMPLEX-DOUBLE-DOUBLE-FLOAT-ERROR" "DD-PI" - "INVALID-CASE")) + "INVALID-CASE") + #+random-xoroshiro + (:export "RANDOM-STATE-JUMP")) (dolist (name ===================================== src/code/rand-xoroshiro.lisp ===================================== --- /dev/null +++ b/src/code/rand-xoroshiro.lisp @@ -0,0 +1,534 @@ +;;; -*- Mode: Lisp; Package: Kernel -*- +;;; +;;; ********************************************************************** +;;; This code was written as part of CMU Common Lisp and has been +;;; placed in the public domain, and is provided 'as is'. +;;; +(ext:file-comment + "$Header: src/code/rand-xoroshiro.lisp $") + +;;; +;;; ********************************************************************** +;;; +;;; Support for the xoroshiro128+ random number generator by David +;;; Blackman and Sebastiano Vigna (vigna(a)acm.org) See +;;; http://xoroshiro.di.unimi.it/. + +(in-package "LISP") +(intl:textdomain "cmucl") + +(export '(random-state random-state-p random *random-state* + make-random-state)) + +(in-package "KERNEL") +(export '(%random-single-float %random-double-float random-chunk init-random-state + random-state-jump)) + +(sys:register-lisp-feature :random-xoroshiro) + + +;;;; Random state hackery: + +;; Generate a random seed that can be used for seeding the generator. +;; If /dev/urandom is available, it is used to generate random data as +;; the seed. Otherwise, the current time is used as the seed. +(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))) + (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, is: + ;; + ;; 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)) + (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)))) + (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)))) + (let* ((s0 (splitmix64)) + (s1 (splitmix64))) + (setf (aref state 0) (make-double s0) + (aref state 1) (make-double s1)) + state)))) + +;; Initialize from an array. The KEY is a 2-element array of unsigned +;; 64-bit integers. The state is set to the given 64-bit integer +;; values. +(defun vec-init-xoro-state (key &optional (state (make-array 2 :element-type 'double-float))) + (declare (type (array (unsigned-byte 64) (2)) key) + (type (simple-array double-float (2)) state)) + (flet ((make-double (x) + (declare (type (unsigned-byte 64) 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)) + +;; The default seed is the digits of Euler's constant, 0.5772.... +(defun init-random-state (&optional (seed 5772156649015328606) state) + _N"Generate an random state vector from the given SEED. The seed can be + either an integer or a vector of (unsigned-byte 64)" + (declare (type (or null integer + (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 64) (2)) + (vec-init-xoro-state seed state))))) + +(defstruct (random-state + (:constructor make-random-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 + ;; since a double-float is 64 bits long. At no point do we operate + ;; on these as floats; they're just convenient objects to hold the + ;; state we need. + (state (init-random-state) + :type (simple-array double-float (2))) + ;; The generator produces 64-bit results. We separate the 64-bit + ;; result into two parts. One is returned and the other is cached + ;; here for later use. + (rand 0 :type (unsigned-byte 32)) + ;; Indicates if RAND holds a valid value. If NIL, we need to + ;; 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 (random-state-state rng-state))) + (pprint-logical-block (stream nil :prefix "#S(" :suffix ")") + (prin1 '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-random-state stream) + (write-char #\space stream) + (flet ((c (x) + (multiple-value-bind (hi lo) + (double-float-bits x) + (logior (ash (ldb (byte 32 0) hi) 32) + lo)))) + (write (make-array 2 :element-type '(unsigned-byte 64) + :initial-contents (list (c (aref state 0)) + (c (aref state 1)))) + :stream stream + :base 16 + :radix t))) + (write-char #\space stream) + (pprint-newline :linear stream) + + (prin1 :rand stream) + (write-char #\space stream) + (pprint-newline :miser stream) + (prin1 (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 (random-state-cached-p rng-state) stream)))) + +(defvar *random-state* + (make-random-object)) + +(defun make-random-state (&optional state) + _N"Make a random state object. If STATE is not supplied, return a copy + of the default random state. If STATE is a random state, then return a + copy of it. If STATE is T then return a random state generated from + the universal time or /dev/urandom if available." + (flet ((copy-random-state (state) + (let ((old-state (random-state-state state)) + (new-state + (make-array 2 :element-type 'double-float))) + (setf (aref new-state 0) (aref old-state 0)) + (setf (aref new-state 1) (aref old-state 1)) + (make-random-object :state new-state + :rand (random-state-rand state) + :cached-p (random-state-cached-p state))))) + (cond ((not state) + (copy-random-state *random-state*)) + ((random-state-p state) + (copy-random-state state)) + ((eq state t) + (make-random-object :state (init-random-state (generate-seed 4)) + :rand 0 + :cached-p nil)) + (t + (error _"Argument is not a RANDOM-STATE, T, or NIL: ~S" state))))) + +(defun rand-initializer () + (init-random-state (generate-seed) + (random-state-state *random-state*))) + +(pushnew 'rand-initializer ext:*after-save-initializations*) + +;;;; Random entries: + +;; Sparc and x86 have vops to implement xoroshiro-gen that are much +;; faster than the portable lisp version. Use them. +#+(or x86 sparc) +(declaim (inline xoroshiro-gen)) +#+(or x86 sparc) +(defun xoroshiro-gen (state) + (declare (type (simple-array double-float (2)) state) + (optimize (speed 3) (safety 0))) + (vm::xoroshiro-next state)) + +#-(or x86 sparc) +(defun xoroshiro-gen (state) + (declare (type (simple-array double-float (2)) state) + (optimize (speed 3) (safety 0))) + ;; Portable implementation 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 + (let ((sl55-h (ldb (byte 32 0) (ash x0 (- 55 32)))) + (sl55-l 0)) + ;; x >> 9 + (let ((sr9-h (ash x1 -9)) + (sr9-l (ldb (byte 32 0) + (logior (ash x0 -9) + (ash x1 23))))) + (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 + (let ((sl36-h (ldb (byte 32 0) (ash x0 4)))) + ;; x >> 28 + (let ((sr28-l (ldb (byte 32 0) + (logior (ash x0 -28) + (ash x1 4)))) + (sr28-h (ash x1 -28))) + (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) + (logior (ash x1 14) + (ash x0 (- 14 32)))) + (ldb (byte 32 0) + (ash x0 14)))) + (make-double (hi lo) + (kernel:make-double-float + (if (< hi #x80000000) + hi + (- hi #x100000000)) + lo))) + (let ((s0-1 0) + (s0-0 0) + (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) + s0-0 x0)) + (multiple-value-bind (x1 x0) + (kernel:double-float-bits (aref state 1)) + (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) + (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))) + + (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))))))) + +;;; Size of the chunks returned by random-chunk. +;;; +(defconstant random-chunk-length 32) + +;;; random-chunk -- Internal +;;; +;;; This function generaters a 32bit integer between 0 and #xffffffff +;;; inclusive. +;;; +(declaim (inline random-chunk)) + +(defun random-chunk (rng-state) + (declare (type random-state rng-state) + (optimize (speed 3) (safety 0))) + (let ((cached (random-state-cached-p rng-state))) + (cond (cached + (setf (random-state-cached-p rng-state) nil) + (random-state-rand rng-state)) + (t + (let ((s (random-state-state rng-state))) + (declare (type (simple-array double-float (2)) s)) + (multiple-value-bind (r1 r0) + (xoroshiro-gen s) + (setf (random-state-rand rng-state) r0) + (setf (random-state-cached-p rng-state) t) + r1)))))) + + +;;; %RANDOM-SINGLE-FLOAT, %RANDOM-DOUBLE-FLOAT -- Interface +;;; +;;; Handle the single or double float case of RANDOM. We generate a float +;;; 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 %random-single-float %random-double-float)) +(declaim (ftype (function ((single-float (0f0)) random-state) + (single-float 0f0)) + %random-single-float)) +;;; +(defun %random-single-float (arg state) + (declare (type (single-float (0f0)) arg) + (type random-state state)) + (* arg + (- (make-single-float + (dpb (ash (random-chunk state) + (- vm:single-float-digits random-chunk-length)) + vm:single-float-significand-byte + (single-float-bits 1.0))) + 1.0))) +;;; +(declaim (ftype (function ((double-float (0d0)) random-state) + (double-float 0d0)) + %random-double-float)) +;;; +;;; 53-bit version. +;;; +(defun %random-double-float (arg state) + (declare (type (double-float (0d0)) arg) + (type random-state state)) + ;; xoroshiro-gen produces 64-bit values. Should we use that + ;; directly to get the random bits instead of two calls to + ;; RANDOM-CHUNK? + (* arg + (- (lisp::make-double-float + (dpb (ash (random-chunk state) + (- vm:double-float-digits random-chunk-length + vm:word-bits)) + vm:double-float-significand-byte + (lisp::double-float-high-bits 1d0)) + (random-chunk state)) + 1d0))) + +#+double-double +(defun %random-double-double-float (arg state) + (declare (type (double-double-float (0w0)) arg) + (type random-state state)) + ;; Generate a 31-bit integer, scale it and sum them up + (let* ((r 0w0) + (scale (scale-float 1d0 -31)) + (mult scale)) + (declare (double-float mult) + (type double-double-float r) + (optimize (speed 3) (inhibit-warnings 3))) + (dotimes (k 4) + (setf r (+ r (* mult (ldb (byte 31 0) (random-chunk state))))) + (setf mult (* mult scale))) + (* arg r))) + +;;;; Random integers: + +;;; Amount we overlap chunks by when building a large integer to make up for +;;; the loss of randomness in the low bits. +;;; +(defconstant random-integer-overlap 3) + +;;; Extra bits of randomness that we generate before taking the value MOD the +;;; limit, to avoid loss of randomness near the limit. +;;; +(defconstant random-integer-extra-bits 10) + +;;; Largest fixnum we can compute from one chunk of bits. +;;; +(defconstant random-fixnum-max + (1- (ash 1 (- random-chunk-length random-integer-extra-bits)))) + + +;;; %RANDOM-INTEGER -- Internal +;;; +(defun %random-integer (arg state) + (declare (type (integer 1) arg) + (type random-state state)) + (let ((shift (- random-chunk-length random-integer-overlap))) + (do ((bits (random-chunk state) + (logxor (ash bits shift) (random-chunk state))) + (count (+ (integer-length arg) + (- random-integer-extra-bits shift)) + (- count shift))) + ((minusp count) + (rem bits arg)) + (declare (fixnum count))))) + +(defun random (arg &optional (state *random-state*)) + _N"Generate a uniformly distributed pseudo-random number between zero + and Arg. State, if supplied, is the random state to use." + (declare (inline %random-single-float %random-double-float)) + (cond + ((typep arg '(integer 1 #x100000000)) + ;; Let the compiler deftransform take care of this case. + (%random-integer arg state)) + ((and (typep arg 'single-float) (> arg 0.0F0)) + (%random-single-float arg state)) + ((and (typep arg 'double-float) (> arg 0.0D0)) + (%random-double-float arg state)) + #+double-double + ((and (typep arg 'double-double-float) (> arg 0.0w0)) + (%random-double-double-float arg state)) + ((and (integerp arg) (> arg 0)) + (%random-integer arg state)) + (t + (error 'simple-type-error + :expected-type '(or (integer 1) (float (0.0))) :datum arg + :format-control _"Argument is not a positive integer or a positive float: ~S") + :format-arguments (list arg))))) + +;; 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*)) + _N"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) + (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))) + ;; The constants are #xbeac0467eba5facb and #xd86b048b86aa9922, + ;; and we process these numbers starting from the LSB. We want ot + ;; process these in 32-bit chunks, so word-reverse the constants. + (dolist (jump '(#xeba5facb #xbeac0467 #x86aa9922 #xd86b048b)) + (declare (type (unsigned-byte 32) jump)) + (dotimes (b 32) + (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)))) + (xoroshiro-gen 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)) ===================================== src/code/x86-vm.lisp ===================================== --- a/src/code/x86-vm.lisp +++ b/src/code/x86-vm.lisp @@ -413,6 +413,7 @@ ;;; transformed to a call to this routine allowing its use in byte ;;; compiled code. ;;; +#+random-mt19937 (defun random-mt19937 (state) (declare (type (simple-array (unsigned-byte 32) (627)) state)) (random-mt19937 state)) ===================================== src/compiler/float-tran.lisp ===================================== --- a/src/compiler/float-tran.lisp +++ b/src/compiler/float-tran.lisp @@ -236,7 +236,7 @@ (frob %random-single-float single-float) (frob %random-double-float double-float)) -#-(or new-random random-mt19937) +#-(or new-random random-mt19937 rand-xoroshiro) (deftransform random ((num &optional state) ((integer 1 #.random-fixnum-max) &optional *)) _N"use inline fixnum operations" @@ -259,7 +259,7 @@ '(values (truncate (%random-double-float (coerce num 'double-float) (or state *random-state*))))) -#+random-mt19937 +#+(or random-mt19937) (deftransform random ((num &optional state) ((integer 1 #.(expt 2 32)) &optional *)) _N"use inline (unsigned-byte 32) operations" ===================================== src/compiler/sparc/arith.lisp ===================================== --- a/src/compiler/sparc/arith.lisp +++ b/src/compiler/sparc/arith.lisp @@ -2588,3 +2588,60 @@ (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 + (let ((s0-offset (+ (* 0 double-float-bytes) + (- (* vm:vector-data-offset vm:word-bytes) + vm:other-pointer-type))) + (s1-offset (+ (* 1 double-float-bytes) + (- (* vm:vector-data-offset vm:word-bytes) + vm:other-pointer-type)))) + (inst ldx s0 state s0-offset) + (inst ldx s1 state s1-offset) + ;; 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 s0) + + ;; s0 = rotl(s0,55) = s0 << 55 | s0 >> 9 + (inst sllx t0 s0 55) + (inst srlx s0 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 s0-offset) + + ;; s1 = rotl(s1, 36) = s1 << 36 | s1 >> 28, using t0 as temp + (inst sllx t0 s1 36) + (inst srlx s1 28) + (inst or s1 t0) + + (inst stx s1 state s1-offset)))) +) ===================================== src/compiler/x86/arith.lisp ===================================== --- a/src/compiler/x86/arith.lisp +++ b/src/compiler/x86/arith.lisp @@ -1833,3 +1833,78 @@ (vm::ash-right-unsigned num (- shift))))) (t (give-up))))) + +(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) + (: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 ===================================== src/compiler/x86/insts.lisp ===================================== --- a/src/compiler/x86/insts.lisp +++ b/src/compiler/x86/insts.lisp @@ -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)) - ===================================== src/general-info/release-21d.md ===================================== --- a/src/general-info/release-21d.md +++ b/src/general-info/release-21d.md @@ -21,6 +21,11 @@ public domain. * Feature enhancements * Update to ASDF 3.3.1, fixing issues introduced in 3.3.0 * Changes + * x86 and sparc have replaced the MT19937 RNG with xoroshiro128+ RNG. + * The required state for this generator is just 4 32-bit words instead of the 600+ for MT19937. + * The generator is also faster than MT19937 (approximately 28% faster on x86 and 18% on sparc). + * The new function `KERNEL:RANDOM-STATE-JUMP` modifies the given state to jump 2^64 samples ahead, allowing 2^64 non-overlapping sequences. + * ANSI compliance fixes: * Bug fixes: * Gitlab tickets: ===================================== src/i18n/locale/cmucl.pot ===================================== --- a/src/i18n/locale/cmucl.pot +++ b/src/i18n/locale/cmucl.pot @@ -33,7 +33,7 @@ msgstr "" #: src/code/intl.lisp src/compiler/globaldb.lisp src/code/defstruct.lisp #: src/code/remote.lisp src/code/wire.lisp src/code/internet.lisp #: src/code/loop.lisp src/code/run-program.lisp src/code/parse-time.lisp -#: src/code/profile.lisp src/code/ntrace.lisp src/code/rand-mt19937.lisp +#: src/code/profile.lisp src/code/ntrace.lisp src/code/rand-xoroshiro.lisp #: src/code/debug.lisp src/code/debug-int.lisp src/code/debug-info.lisp #: src/code/eval.lisp src/code/filesys.lisp src/code/pathname.lisp #: src/code/fd-stream.lisp src/code/extfmts.lisp src/code/serve-event.lisp @@ -12105,13 +12105,13 @@ msgstr "" msgid "Type \"yes\" for yes or \"no\" for no. " msgstr "" -#: src/code/rand-mt19937.lisp +#: src/code/rand-xoroshiro.lisp msgid "" "Generate an random state vector from the given SEED. The seed can be\n" -" either an integer or a vector of (unsigned-byte 32)" +" either an integer or a vector of (unsigned-byte 64)" msgstr "" -#: src/code/rand-mt19937.lisp +#: src/code/rand-xoroshiro.lisp msgid "" "Make a random state object. If STATE is not supplied, return a copy\n" " of the default random state. If STATE is a random state, then return a\n" @@ -12119,20 +12119,27 @@ msgid "" " the universal time or /dev/urandom if available." msgstr "" -#: src/code/rand-mt19937.lisp -msgid "Argument is not a RANDOM-STATE, T or NIL: ~S" +#: src/code/rand-xoroshiro.lisp +msgid "Argument is not a RANDOM-STATE, T, or NIL: ~S" msgstr "" -#: src/code/rand-mt19937.lisp +#: src/code/rand-xoroshiro.lisp msgid "" "Generate a uniformly distributed pseudo-random number between zero\n" " and Arg. State, if supplied, is the random state to use." msgstr "" -#: src/code/rand-mt19937.lisp +#: src/code/rand-xoroshiro.lisp msgid "Argument is not a positive integer or a positive float: ~S" msgstr "" +#: src/code/rand-xoroshiro.lisp +msgid "" +"Jump the RNG-STATE. This is equivalent to 2^64 calls to the\n" +" xoroshiro128+ generator. It can be used to generate 2^64\n" +" non-overlapping subsequences for parallel computations." +msgstr "" + #: src/code/ntrace.lisp msgid "" "This is bound to the returned values when evaluating :BREAK-AFTER and\n" @@ -18869,10 +18876,6 @@ msgid "use inline (unsigned-byte 32) operations" msgstr "" #: src/compiler/float-tran.lisp -msgid "Shouldn't happen" -msgstr "" - -#: src/compiler/float-tran.lisp msgid "Can't open-code float to rational comparison." msgstr "" ===================================== src/tools/worldbuild.lisp ===================================== --- a/src/tools/worldbuild.lisp +++ b/src/tools/worldbuild.lisp @@ -121,9 +121,13 @@ "target:code/scavhook" "target:code/save" - ,@(if (c:backend-featurep :random-mt19937) - '("target:code/rand-mt19937") - '("target:code/rand")) + ,@(cond ((c:backend-featurep :random-mt19937) + '("target:code/rand-mt19937")) + ((c:backend-featurep :random-xoroshiro) + '("target:code/rand-xoroshiro")) + (t + '("target:code/rand"))) + "target:code/rand-xoroshiro" "target:code/alieneval" "target:code/c-call" "target:code/sap" ===================================== src/tools/worldcom.lisp ===================================== --- a/src/tools/worldcom.lisp +++ b/src/tools/worldcom.lisp @@ -268,9 +268,12 @@ (comf "target:code/debug" :byte-compile t) (comf "target:code/query" :byte-compile *byte-compile*) -(if (c:backend-featurep :random-mt19937) - (comf "target:code/rand-mt19937") - (comf "target:code/rand")) +(cond ((c:backend-featurep :random-mt19937) + (comf "target:code/rand-mt19937")) + ((c:backend-featurep :random-xoroshiro) + (comf "target:code/rand-xoroshiro")) + (t + (comf "target:code/rand"))) (comf "target:code/ntrace" :byte-compile *byte-compile*) (comf "target:code/profile") (comf "target:code/sort") ===================================== src/tools/worldload.lisp ===================================== --- a/src/tools/worldload.lisp +++ b/src/tools/worldload.lisp @@ -96,8 +96,13 @@ (maybe-byte-load "code:time") (maybe-byte-load "code:tty-inspect") (maybe-byte-load "code:describe") -#+random-mt19937 (maybe-byte-load "code:rand-mt19937") -#-random-mt19937 (maybe-byte-load "code:rand") +#+random-mt19937 +(maybe-byte-load "code:rand-mt19937") +#+random-xoroshiro +(maybe-byte-load "code:rand-xoroshiro") +#-(or random-mt19937 random-xoroshiro) +(maybe-byte-load "code:rand") +(maybe-byte-load "code:rand-xoroshiro") (maybe-byte-load "target:pcl/walk") (maybe-byte-load "code:fwrappers") (maybe-byte-load "code:ntrace") ===================================== tests/rng.lisp ===================================== --- /dev/null +++ b/tests/rng.lisp @@ -0,0 +1,70 @@ +;; Tests for RNG + +(defpackage :rng-tests + (:use :cl :lisp-unit)) + +(in-package "RNG-TESTS") + +(defun 64-bit-rng-state (rng) + (let ((state (kernel::random-state-state rng))) + (flet ((convert (x) + (multiple-value-bind (hi lo) + (kernel:double-float-bits x) + (logior (ash (ldb (byte 32 0) hi) 32) + lo)))) + (values (convert (aref state 0)) (convert (aref state 1)))))) + +(defun 64-bit-value (rng) + (logior (ash (kernel::random-chunk rng) 32) + (kernel::random-chunk rng))) + +(defvar *test-state*) + +#+random-xoroshiro +(define-test rng.initial-state + (setf *test-state* + (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::random-state-rand *test-state*)) + (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*))) + (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)) + (#xb1e7538af0e454f7 (#x13e5253e242fac52 #xed380e70d10ab60e)) + (#x011d33aef53a6260 (#x9d0764952ca00d8a #x5251a5cfedd2b4ef)) + (#xef590a651a72c279 (#xba4ef2b425bda963 #x172b965cf56c15ac)) + (#xd17a89111b29bf0f (#x458277a5e5f0a21b #xd1bccfad6564e8d)) + (#x529e44a0bc46f0a8 (#x2becb68d5a7194c7 #x3a6ec964899bb5f3)) + (#x665b7ff1e40d4aba (#xededfd481d0a19fe #x3ea213411827fe9d)) + (#x2c9010893532189b (#xd7bb59bcd8fba26f #x52de763d34fee090)) + (#x2a99cffa0dfa82ff (#xf96e892c62d6ff2e #xc0542ff85652f81e)))) + (destructuring-bind (value state) + 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/compare/757fb170ee958123f0d44e7f… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/757fb170ee958123f0d44e7f… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-xoro-default] Update release notes
by Raymond Toy 29 Dec '17

29 Dec '17

Raymond Toy pushed to branch rtoy-xoro-default at cmucl / cmucl Commits: d8ef7876 by Raymond Toy at 2017-12-29T10:20:13-08:00 Update release notes - - - - - 1 changed file: - src/general-info/release-21d.md Changes: ===================================== src/general-info/release-21d.md ===================================== --- a/src/general-info/release-21d.md +++ b/src/general-info/release-21d.md @@ -21,6 +21,11 @@ public domain. * Feature enhancements * Update to ASDF 3.3.1, fixing issues introduced in 3.3.0 * Changes + * x86 and sparc have replaced the MT19937 RNG with xoroshiro128+ RNG. + * The required state for this generator is just 4 32-bit words instead of the 600+ for MT19937. + * The generator is also faster than MT19937 (approximately 28% faster on x86 and 18% on sparc). + * The new function `KERNEL:RANDOM-STATE-JUMP` modifies the given state to jump 2^64 samples ahead, allowing 2^64 non-overlapping sequences. + * ANSI compliance fixes: * Bug fixes: * Gitlab tickets: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/d8ef787644b5a460ff7fb0b37… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/d8ef787644b5a460ff7fb0b37… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-xoro-default] Fix typo in reader conditional.
by Raymond Toy 29 Dec '17

29 Dec '17

Raymond Toy pushed to branch rtoy-xoro-default at cmucl / cmucl Commits: e5bd7ef7 by Raymond Toy at 2017-12-29T08:57:34-08:00 Fix typo in reader conditional. Don't use the portable xoroshiro-gen on x86 and sparc! - - - - - 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 @@ -235,11 +235,11 @@ (optimize (speed 3) (safety 0))) (vm::xoroshiro-next state)) -#+(or x86 sparc) +#-(or x86 sparc) (defun xoroshiro-gen (state) (declare (type (simple-array double-float (2)) state) (optimize (speed 3) (safety 0))) - ;; Portable implemenation of the xoroshiro128+ generator. See + ;; Portable implementation of the xoroshiro128+ generator. See ;; http://xoroshiro.di.unimi.it/xoroshiro128plus.c for the ;; definitive definition. ;; View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/e5bd7ef7412200ea1ec453382… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/e5bd7ef7412200ea1ec453382… 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 comments.
by Raymond Toy 29 Dec '17

29 Dec '17

Raymond Toy pushed to branch rtoy-xoro-default at cmucl / cmucl Commits: 86599903 by Raymond Toy at 2017-12-28T19:53:42-08:00 Add comments. - - - - - 562752c0 by Raymond Toy at 2017-12-28T19:54:11-08:00 Regenerated from sources - - - - - 2 changed files: - src/code/rand-xoroshiro.lisp - src/i18n/locale/cmucl.pot Changes: ===================================== src/code/rand-xoroshiro.lisp ===================================== --- a/src/code/rand-xoroshiro.lisp +++ b/src/code/rand-xoroshiro.lisp @@ -1,6 +1,9 @@ ;;; -*- Mode: Lisp; Package: Kernel -*- ;;; ;;; ********************************************************************** +;;; This code was written as part of CMU Common Lisp and has been +;;; placed in the public domain, and is provided 'as is'. +;;; (ext:file-comment "$Header: src/code/rand-xoroshiro.lisp $") @@ -23,6 +26,12 @@ (sys:register-lisp-feature :random-xoroshiro) + +;;;; Random state hackery: + +;; Generate a random seed that can be used for seeding the generator. +;; If /dev/urandom is available, it is used to generate random data as +;; the seed. Otherwise, the current time is used as the seed. (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, @@ -51,7 +60,7 @@ (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,: + ;; the 64-bit state of the generator, is: ;; ;; uint64_t z = (x += 0x9e3779b97f4a7c15); ;; z = (z ^ (z >> 30)) * 0xbf58476d1ce4e5b9; @@ -85,10 +94,14 @@ (aref state 1) (make-double s1)) state)))) +;; Initialize from an array. The KEY is a 2-element array of unsigned +;; 64-bit integers. The state is set to the given 64-bit integer +;; values. (defun vec-init-xoro-state (key &optional (state (make-array 2 :element-type 'double-float))) (declare (type (array (unsigned-byte 64) (2)) key) (type (simple-array double-float (2)) state)) (flet ((make-double (x) + (declare (type (unsigned-byte 64) x)) (let ((hi (ldb (byte 32 32) x)) (lo (ldb (byte 32 0) x))) (kernel:make-double-float @@ -99,11 +112,11 @@ (setf (aref state 0) (make-double (aref key 0)) (aref state 1) (make-double (aref key 1))) state)) - - + +;; The default seed is the digits of Euler's constant, 0.5772.... (defun init-random-state (&optional (seed 5772156649015328606) state) - "Generate an random state vector from the given SEED. The seed can be - either an integer or a vector of (unsigned-byte 32)" + _N"Generate an random state vector from the given SEED. The seed can be + either an integer or a vector of (unsigned-byte 64)" (declare (type (or null integer (array (unsigned-byte 64) (*))) seed)) @@ -180,6 +193,10 @@ (make-random-object)) (defun make-random-state (&optional state) + _N"Make a random state object. If STATE is not supplied, return a copy + of the default random state. If STATE is a random state, then return a + copy of it. If STATE is T then return a random state generated from + the universal time or /dev/urandom if available." (flet ((copy-random-state (state) (let ((old-state (random-state-state state)) (new-state @@ -198,7 +215,7 @@ :rand 0 :cached-p nil)) (t - (error "Argument is not a RANDOM-STATE, T, or NIL: ~S" state))))) + (error _"Argument is not a RANDOM-STATE, T, or NIL: ~S" state))))) (defun rand-initializer () (init-random-state (generate-seed) @@ -384,7 +401,7 @@ (double-float 0d0)) %random-double-float)) ;;; -;;; 53bit version. +;;; 53-bit version. ;;; (defun %random-double-float (arg state) (declare (type (double-float (0d0)) arg) @@ -452,10 +469,9 @@ (declare (fixnum count))))) (defun random (arg &optional (state *random-state*)) - "Generate a uniformly distributed pseudo-random number between zero + _N"Generate a uniformly distributed pseudo-random number between zero and Arg. State, if supplied, is the random state to use." - (declare (inline %random-single-float %random-double-float - #+long-float %long-float)) + (declare (inline %random-single-float %random-double-float)) (cond ((typep arg '(integer 1 #x100000000)) ;; Let the compiler deftransform take care of this case. @@ -464,9 +480,6 @@ (%random-single-float arg state)) ((and (typep arg 'double-float) (> arg 0.0D0)) (%random-double-float arg state)) - #+long-float - ((and (typep arg 'long-float) (> arg 0.0L0)) - (%random-long-float arg state)) #+double-double ((and (typep arg 'double-double-float) (> arg 0.0w0)) (%random-double-double-float arg state)) @@ -475,13 +488,13 @@ (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-control _"Argument is not a positive integer or a positive float: ~S") :format-arguments (list arg))))) ;; 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 + _N"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)) ===================================== src/i18n/locale/cmucl.pot ===================================== --- a/src/i18n/locale/cmucl.pot +++ b/src/i18n/locale/cmucl.pot @@ -33,7 +33,7 @@ msgstr "" #: src/code/intl.lisp src/compiler/globaldb.lisp src/code/defstruct.lisp #: src/code/remote.lisp src/code/wire.lisp src/code/internet.lisp #: src/code/loop.lisp src/code/run-program.lisp src/code/parse-time.lisp -#: src/code/profile.lisp src/code/ntrace.lisp src/code/rand-mt19937.lisp +#: src/code/profile.lisp src/code/ntrace.lisp src/code/rand-xoroshiro.lisp #: src/code/debug.lisp src/code/debug-int.lisp src/code/debug-info.lisp #: src/code/eval.lisp src/code/filesys.lisp src/code/pathname.lisp #: src/code/fd-stream.lisp src/code/extfmts.lisp src/code/serve-event.lisp @@ -12105,13 +12105,13 @@ msgstr "" msgid "Type \"yes\" for yes or \"no\" for no. " msgstr "" -#: src/code/rand-mt19937.lisp +#: src/code/rand-xoroshiro.lisp msgid "" "Generate an random state vector from the given SEED. The seed can be\n" -" either an integer or a vector of (unsigned-byte 32)" +" either an integer or a vector of (unsigned-byte 64)" msgstr "" -#: src/code/rand-mt19937.lisp +#: src/code/rand-xoroshiro.lisp msgid "" "Make a random state object. If STATE is not supplied, return a copy\n" " of the default random state. If STATE is a random state, then return a\n" @@ -12119,20 +12119,27 @@ msgid "" " the universal time or /dev/urandom if available." msgstr "" -#: src/code/rand-mt19937.lisp -msgid "Argument is not a RANDOM-STATE, T or NIL: ~S" +#: src/code/rand-xoroshiro.lisp +msgid "Argument is not a RANDOM-STATE, T, or NIL: ~S" msgstr "" -#: src/code/rand-mt19937.lisp +#: src/code/rand-xoroshiro.lisp msgid "" "Generate a uniformly distributed pseudo-random number between zero\n" " and Arg. State, if supplied, is the random state to use." msgstr "" -#: src/code/rand-mt19937.lisp +#: src/code/rand-xoroshiro.lisp msgid "Argument is not a positive integer or a positive float: ~S" msgstr "" +#: src/code/rand-xoroshiro.lisp +msgid "" +"Jump the RNG-STATE. This is equivalent to 2^64 calls to the\n" +" xoroshiro128+ generator. It can be used to generate 2^64\n" +" non-overlapping subsequences for parallel computations." +msgstr "" + #: src/code/ntrace.lisp msgid "" "This is bound to the returned values when evaluating :BREAK-AFTER and\n" @@ -18869,10 +18876,6 @@ msgid "use inline (unsigned-byte 32) operations" msgstr "" #: src/compiler/float-tran.lisp -msgid "Shouldn't happen" -msgstr "" - -#: src/compiler/float-tran.lisp msgid "Can't open-code float to rational comparison." msgstr "" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/58f107b1c475acf59797b016… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/58f107b1c475acf59797b016… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-xoro-default] Print random state in hex
by Raymond Toy 28 Dec '17

28 Dec '17

Raymond Toy pushed to branch rtoy-xoro-default at cmucl / cmucl Commits: 58f107b1 by Raymond Toy at 2017-12-28T12:26:31-08:00 Print random state in hex Add comment for %random-double-float to use xoroshiro-gen directly instead of random-chunk twice. A minor micro optimization. - - - - - 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 @@ -155,10 +155,12 @@ (double-float-bits x) (logior (ash (ldb (byte 32 0) hi) 32) lo)))) - (prin1 (make-array 2 :element-type '(unsigned-byte 64) + (write (make-array 2 :element-type '(unsigned-byte 64) :initial-contents (list (c (aref state 0)) (c (aref state 1)))) - stream))) + :stream stream + :base 16 + :radix t))) (write-char #\space stream) (pprint-newline :linear stream) @@ -387,6 +389,9 @@ (defun %random-double-float (arg state) (declare (type (double-float (0d0)) arg) (type random-state state)) + ;; xoroshiro-gen produces 64-bit values. Should we use that + ;; directly to get the random bits instead of two calls to + ;; RANDOM-CHUNK? (* arg (- (lisp::make-double-float (dpb (ash (random-chunk state) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/58f107b1c475acf59797b016f… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/58f107b1c475acf59797b016f… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-xoro-default] Use the xoroshiro vop on sparc
by Raymond Toy 28 Dec '17

28 Dec '17

Raymond Toy pushed to branch rtoy-xoro-default at cmucl / cmucl Commits: 448e9970 by Raymond Toy at 2017-12-28T09:53:39-08:00 Use the xoroshiro vop on sparc The vop greatly speeds up the generator on sparc. The time to generate 10,000,000 single-floats (on a 1 GHz Ultrasparc 3i) is: mt19937: 1.32 sec xoroshiro: 1.03 sec So xoroshiro is 22% faster than mt19937. - - - - - 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 @@ -206,15 +206,17 @@ ;;;; Random entries: -#+x86 +;; Sparc and x86 have vops to implement xoroshiro-gen that are much +;; faster than the portable lisp version. Use them. +#+(or x86 sparc) (declaim (inline xoroshiro-gen)) -#+x86 +#+(or x86 sparc) (defun xoroshiro-gen (state) (declare (type (simple-array double-float (2)) state) (optimize (speed 3) (safety 0))) (vm::xoroshiro-next state)) -#-x86 +#+(or x86 sparc) (defun xoroshiro-gen (state) (declare (type (simple-array double-float (2)) state) (optimize (speed 3) (safety 0))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/448e99705bdfbc1a9e77756e3… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/448e99705bdfbc1a9e77756e3… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-xoro-default] 2 commits: Fix logic mistakes in sparc xoroshiro impl
by Raymond Toy 28 Dec '17

28 Dec '17

Raymond Toy pushed to branch rtoy-xoro-default at cmucl / cmucl Commits: 6fbd959e by Raymond Toy at 2017-12-28T09:04:13-08:00 Fix logic mistakes in sparc xoroshiro impl Also compute the array offsets just once so we're consistent between loading and storing. - - - - - 11a14537 by Raymond Toy at 2017-12-28T09:04:27-08:00 Export random-state-jump - - - - - 2 changed files: - src/code/exports.lisp - src/compiler/sparc/arith.lisp Changes: ===================================== src/code/exports.lisp ===================================== --- a/src/code/exports.lisp +++ b/src/code/exports.lisp @@ -2550,7 +2550,9 @@ "SIMPLE-ARRAY-COMPLEX-DOUBLE-DOUBLE-FLOAT-P" "OBJECT-NOT-SIMPLE-ARRAY-COMPLEX-DOUBLE-DOUBLE-FLOAT-ERROR" "DD-PI" - "INVALID-CASE")) + "INVALID-CASE") + #+random-xoroshiro + (:export "RANDOM-STATE-JUMP")) (dolist (name ===================================== src/compiler/sparc/arith.lisp ===================================== --- a/src/compiler/sparc/arith.lisp +++ b/src/compiler/sparc/arith.lisp @@ -2611,39 +2611,37 @@ (: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))))) + (let ((s0-offset (+ (* 0 double-float-bytes) + (- (* vm:vector-data-offset vm:word-bytes) + vm:other-pointer-type))) + (s1-offset (+ (* 1 double-float-bytes) + (- (* vm:vector-data-offset vm:word-bytes) + vm:other-pointer-type)))) + (inst ldx s0 state s0-offset) + (inst ldx s1 state s1-offset) + ;; 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 s0) + + ;; s0 = rotl(s0,55) = s0 << 55 | s0 >> 9 + (inst sllx t0 s0 55) + (inst srlx s0 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 s0-offset) + + ;; s1 = rotl(s1, 36) = s1 << 36 | s1 >> 28, using t0 as temp + (inst sllx t0 s1 36) + (inst srlx s1 28) + (inst or s1 t0) + + (inst stx s1 state s1-offset)))) ) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/164cf685e3b50676afd9b711… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/164cf685e3b50676afd9b711… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Remove extra trailing unmatched parenthesis
by Raymond Toy 27 Dec '17

27 Dec '17

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 757fb170 by Raymond Toy at 2017-12-27T15:25:08-08:00 Remove extra trailing unmatched parenthesis - - - - - 1 changed file: - src/code/commandline.lisp Changes: ===================================== src/code/commandline.lisp ===================================== --- a/src/code/commandline.lisp +++ b/src/code/commandline.lisp @@ -136,7 +136,7 @@ (setf str nil)) (return nil)) (push str word-list)) - (setq str (pop cmd-strings))))))))) + (setq str (pop cmd-strings)))))))) (defun get-command-line-switch (sname) "Accepts the name of a switch as a string and returns the value of View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/757fb170ee958123f0d44e7f0… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/757fb170ee958123f0d44e7f0… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-xoro-default] Implement vop for xoroshiro-next
by Raymond Toy 27 Dec '17

27 Dec '17

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/164cf685e3b50676afd9b7115… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/164cf685e3b50676afd9b7115… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-xoro-default] Fix compiler warning in VEC-INIT-XORO-STATE
by Raymond Toy 27 Dec '17

27 Dec '17

Raymond Toy pushed to branch rtoy-xoro-default at cmucl / cmucl Commits: ab6d2c6a by Raymond Toy at 2017-12-27T10:29:26-08:00 Fix compiler warning in VEC-INIT-XORO-STATE Set default value for state in VEC-INIT-XORO-STATE. If not given, initialize it to the correct array. - - - - - 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 @@ -85,7 +85,7 @@ (aref state 1) (make-double s1)) state)))) -(defun vec-init-xoro-state (key &optional state) +(defun vec-init-xoro-state (key &optional (state (make-array 2 :element-type 'double-float))) (declare (type (array (unsigned-byte 64) (2)) key) (type (simple-array double-float (2)) state)) (flet ((make-double (x) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/ab6d2c6a540ff87109a6bbcd7… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/ab6d2c6a540ff87109a6bbcd7… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0