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/f5df87450892d588b44724bf9...

--- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/f5df87450892d588b44724bf9... You're receiving this email because of your account on gitlab.common-lisp.net.