random-state/tt800.lisp at master · bornhoeft/random-state · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
#|
 This file is a part of random-state
 (c) 2015 Shirakumo http://tymoon.eu (shinmera@tymoon.eu)
 Author: Nicolas Hafner <shinmera@tymoon.eu>
|#

(in-package :random-state)

;; Adapted from
;;   http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/VERSIONS/C-LANG/tt800.c

(defclass tt800 (generator)
  ((magic :initform (barr 32 0 #x8ebfd028) :reader magic)
   (shiftops :initform #((  7 #x2b5b2500)
                         ( 15 #xdb8b0000)
                         (-16 #xffffffff)) :reader shiftops)
   (n :initform 25 :reader n)
   (m :initform 7 :reader m)
   (index :initform 0 :accessor index)
   (matrix :initform NIL :reader matrix :writer set-matrix)
   (bytes :initform 32)))

(defmethod reseed ((generator tt800) &optional new-seed)
  (set-matrix (32bit-seed-array (n generator) new-seed) generator)
  (setf (index generator) (n generator)))

(defmethod random-byte ((generator tt800))
  (let ((i 0)
        (n (n generator))
        (m (m generator))
        (matrix (matrix generator))
        (magic (magic generator))
        (shiftops (shiftops generator)))
    (declare (optimize speed)
             (ftype (function (tt800) (unsigned-byte 8)) index)
             (type (simple-array (unsigned-byte 32)) matrix magic)
             (type (simple-array list 1) shiftops)
             (type (unsigned-byte 8) n m i))
    (flet ((matrix (n) (aref matrix n))
           (magic (n) (aref magic n)))
      (declare (inline matrix magic))
      (when (= (the integer (index generator)) n)
        (loop while (< i (- n m))
              do (setf (aref matrix i)
                       (logxor (matrix (+ i m))
                               (ash (matrix i) -1)
                               (magic (mod (matrix i) 2))))
                 (incf i))
        (loop while (< i n)
              do (setf (aref matrix i)
                       (logxor (matrix (+ i (- m n)))
                               (ash (matrix i) -1)
                               (magic (mod (matrix i) 2))))
                 (incf i))
        (setf (index generator) 0))
      (let ((result (matrix (index generator))))
        (declare (type (unsigned-byte 32) result))
        (incf (index generator))
        (loop for (shift mask) across shiftops
              do (setf result (logxor result (logand (ash result (the (signed-byte 6) shift))
                                                     (the (unsigned-byte 32) mask)))))
        result))))