From 8ea3146228744f8c2a4f8afbe00940d37248f8af Mon Sep 17 00:00:00 2001 From: dtc <dtc> Date: Thu, 11 Dec 1997 17:41:30 +0000 Subject: [PATCH] Hand crafted assembly support for the Mersenne Twister, MT19937, random number generator due to Matsumoto and Nishimura - a little faster than the portable lisp code. --- assembly/x86/arith.lisp | 119 +++++++++++++++++++++++++++++++++++++++- compiler/x86/arith.lisp | 69 ++++++++++++++++++++++- 2 files changed, 186 insertions(+), 2 deletions(-) diff --git a/assembly/x86/arith.lisp b/assembly/x86/arith.lisp index e7f29bf48..c8e7bc7ef 100644 --- a/assembly/x86/arith.lisp +++ b/assembly/x86/arith.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/x86/arith.lisp,v 1.8 1997/12/05 06:55:30 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/x86/arith.lisp,v 1.9 1997/12/11 17:41:26 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -294,3 +294,120 @@ RETURN-T (load-symbol res t)) + +;;; Support for the Mersenne Twister, MT19937, random number generator +;;; due to Matsumoto and Nishimura. +;;; +;;; Makoto Matsumoto and T. Nishimura, "Mersenne twister: A +;;; 623-dimensionally equidistributed uniform pseudorandom number +;;; generator.", ACM Transactions on Modeling and Computer Simulation, +;;; 1997, to appear. +;;; +;;; State: +;;; 0-1: Constant matrix A. [0, #x9908b0df] (not used here) +;;; 2: Index; init. to 1. +;;; 3-626: State. +;;; + +;;; This assembly routine is called from the inline VOP and updates +;;; the state vector with new random numbers. The state vector is +;;; passed in the EAX register. +;;; +#+assembler ; we don't want a vop for this one. +(define-assembly-routine + (random-mt19937-update) + ((:temp state dword-reg eax-offset) + (:temp k dword-reg ebx-offset) + (:temp y dword-reg ecx-offset) + (:temp tmp dword-reg edx-offset)) + + ;; Save the temporary registers. + (inst push k) + (inst push y) + (inst push tmp) + + ;; Generate a new set of results. + (inst xor k k) + LOOP1 + (inst mov y (make-ea :dword :base state :index k :scale 4 + :disp (- (* (+ 3 vm:vector-data-offset) vm:word-bytes) + vm:other-pointer-type))) + (inst mov tmp (make-ea :dword :base state :index k :scale 4 + :disp (- (* (+ 1 3 vm:vector-data-offset) + vm:word-bytes) + vm:other-pointer-type))) + (inst and y #x80000000) + (inst and tmp #x7fffffff) + (inst or y tmp) + (inst shr y 1) + (inst jmp :nc skip1) + (inst xor y #x9908b0df) + SKIP1 + (inst xor y (make-ea :dword :base state :index k :scale 4 + :disp (- (* (+ 397 3 vm:vector-data-offset) + vm:word-bytes) + vm:other-pointer-type))) + (inst mov (make-ea :dword :base state :index k :scale 4 + :disp (- (* (+ 3 vm:vector-data-offset) vm:word-bytes) + vm:other-pointer-type)) + y) + (inst inc k) + (inst cmp k (- 624 397)) + (inst jmp :b loop1) + LOOP2 + (inst mov y (make-ea :dword :base state :index k :scale 4 + :disp (- (* (+ 3 vm:vector-data-offset) vm:word-bytes) + vm:other-pointer-type))) + (inst mov tmp (make-ea :dword :base state :index k :scale 4 + :disp (- (* (+ 1 3 vm:vector-data-offset) + vm:word-bytes) + vm:other-pointer-type))) + (inst and y #x80000000) + (inst and tmp #x7fffffff) + (inst or y tmp) + (inst shr y 1) + (inst jmp :nc skip2) + (inst xor y #x9908b0df) + SKIP2 + (inst xor y (make-ea :dword :base state :index k :scale 4 + :disp (- (* (+ (- 397 624) 3 vm:vector-data-offset) + vm:word-bytes) + vm:other-pointer-type))) + (inst mov (make-ea :dword :base state :index k :scale 4 + :disp (- (* (+ 3 vm:vector-data-offset) vm:word-bytes) + vm:other-pointer-type)) + y) + (inst inc k) + (inst cmp k (- 624 1)) + (inst jmp :b loop2) + + (inst mov y (make-ea :dword :base state + :disp (- (* (+ (- 624 1) 3 vm:vector-data-offset) + vm:word-bytes) + vm:other-pointer-type))) + (inst mov tmp (make-ea :dword :base state + :disp (- (* (+ 0 3 vm:vector-data-offset) + vm:word-bytes) + vm:other-pointer-type))) + (inst and y #x80000000) + (inst and tmp #x7fffffff) + (inst or y tmp) + (inst shr y 1) + (inst jmp :nc skip3) + (inst xor y #x9908b0df) + SKIP3 + (inst xor y (make-ea :dword :base state + :disp (- (* (+ (- 397 1) 3 vm:vector-data-offset) + vm:word-bytes) + vm:other-pointer-type))) + (inst mov (make-ea :dword :base state + :disp (- (* (+ (- 624 1) 3 vm:vector-data-offset) + vm:word-bytes) + vm:other-pointer-type)) + y) + + ;; Restore the temporary registers and return. + (inst pop tmp) + (inst pop y) + (inst pop k) + (inst ret)) diff --git a/compiler/x86/arith.lisp b/compiler/x86/arith.lisp index cedbb2fba..a61d98024 100644 --- a/compiler/x86/arith.lisp +++ b/compiler/x86/arith.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/arith.lisp,v 1.8 1997/11/18 10:53:18 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/arith.lisp,v 1.9 1997/12/11 17:41:30 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1297,3 +1297,70 @@ (define-static-function two-arg-and (x y) :translate logand) (define-static-function two-arg-ior (x y) :translate logior) (define-static-function two-arg-xor (x y) :translate logxor) + + +;;; Support for the Mersenne Twister, MT19937, random number generator +;;; due to Matsumoto and Nishimura. +;;; +;;; Makoto Matsumoto and T. Nishimura, "Mersenne twister: A +;;; 623-dimensionally equidistributed uniform pseudorandom number +;;; generator.", ACM Transactions on Modeling and Computer Simulation, +;;; 1997, to appear. +;;; +;;; State: +;;; 0-1: Constant matrix A. [0, #x9908b0df] (not used here) +;;; 2: Index; init. to 1. +;;; 3-626: State. +;;; +(defknown random-mt19937 ((simple-array (unsigned-byte 32) (*))) + (unsigned-byte 32) ()) +;;; +(define-vop (random-mt19937) + (:policy :fast-safe) + (:translate random-mt19937) + (:args (state :scs (descriptor-reg) :to :result)) + (:arg-types simple-array-unsigned-byte-32) + (:temporary (:sc unsigned-reg :from (:eval 0) :to :result) k) + (:temporary (:sc unsigned-reg :offset eax-offset + :from (:eval 0) :to :result) tmp) + (:results (y :scs (unsigned-reg) :from (:eval 0))) + (:result-types unsigned-num) + (:generator 50 + (inst mov k (make-ea :dword :base state + :disp (- (* (+ 2 vm:vector-data-offset) vm:word-bytes) + vm:other-pointer-type))) + (inst cmp k 624) + (inst jmp :ne no-update) + (inst mov tmp state) ; The state is passed in EAX. + (inst call (make-fixup 'random-mt19937-update :assembly-routine)) + ;; Restore k, and set to 0. + (inst xor k k) + NO-UPDATE + ;; y = ptgfsr[k++]; + (inst mov y (make-ea :dword :base state :index k :scale 4 + :disp (- (* (+ 3 vm:vector-data-offset) vm:word-bytes) + vm:other-pointer-type))) + ;; y ^= (y >> 11); + (inst shr y 11) + (inst xor y (make-ea :dword :base state :index k :scale 4 + :disp (- (* (+ 3 vm:vector-data-offset) vm:word-bytes) + vm:other-pointer-type))) + ;; y ^= (y << 7) & #x9d2c5680 + (inst mov tmp y) + (inst inc k) + (inst shl tmp 7) + (inst mov (make-ea :dword :base state + :disp (- (* (+ 2 vm:vector-data-offset) vm:word-bytes) + vm:other-pointer-type)) + k) + (inst and tmp #x9d2c5680) + (inst xor y tmp) + ;; y ^= (y << 15) & #xefc60000 + (inst mov tmp y) + (inst shl tmp 15) + (inst and tmp #xefc60000) + (inst xor y tmp) + ;; y ^= (y >> 18); + (inst mov tmp y) + (inst shr tmp 18) + (inst xor y tmp))) -- GitLab