[Git][cmucl/cmucl][rtoy-xoro-default] 3 commits: Conditionalize on random-xoroshiro.
Raymond Toy
rtoy at common-lisp.net
Wed Dec 20 03:03:39 UTC 2017
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/f5df87450892d588b44724bf9bce4af528ad036f...4720c79403b1770bc7cb45ca972d6443e05c0be5
---
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/f5df87450892d588b44724bf9bce4af528ad036f...4720c79403b1770bc7cb45ca972d6443e05c0be5
You're receiving this email because of your account on gitlab.common-lisp.net.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20171220/9ec6ac63/attachment-0001.html>
More information about the cmucl-cvs
mailing list