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