Commit fb3f58ea authored by Raymond Toy's avatar Raymond Toy

Merge branch 'rtoy-xoro-default' into 'master'

Change random number generator from MT19937 to xoroshiro128+ Closes #48 See merge request !29
parents 757fb170 d8ef7876
Pipeline #237 passed with stage
in 12 minutes 16 seconds
......@@ -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
......@@ -39,7 +39,7 @@ ENABLE2="yes"
ENABLE3="yes"
ENABLE4="yes"
version=21b
version=21c
SRCDIR=src
BINDIR=bin
TOOLDIR=$BINDIR
......
(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)))
;; 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)))
;; 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")
......@@ -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
......
This diff is collapsed.
......@@ -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))
......
......@@ -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"
......
......@@ -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))))
)
......@@ -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
......@@ -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))
......@@ -21,6 +21,11 @@ public domain.
* Feature enhancements
* Update to ASDF 3.3.1, fixing issues introduced in 3.3.0
* Changes