-
Notifications
You must be signed in to change notification settings - Fork 11
/
Copy pathisaac-64.lisp
140 lines (128 loc) · 6.2 KB
/
isaac-64.lisp
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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
;;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-ISAAC; Base: 10 -*- file: isaac-64.lisp
;; Copyright (c) 2008 Doug Hoyte, HCSW
;; Copyright (c) 2014-2022, "the Phoeron" Colin J.E. Lupton
;; BSD license: you can do anything you want with it (but no warranty).
(in-package #:cl-isaac)
;; TODO: proof these against ISAAC-64 implementation from http://burtleburtle.net/bob/rand/isaacafa.html
(defstruct isaac64-ctx
(randcnt 0 :type (unsigned-byte 64))
(randrsl (make-array 256 :element-type '(unsigned-byte 64) :initial-element 0)
:type (simple-array (unsigned-byte 64) (256)))
(randmem (make-array 256 :element-type '(unsigned-byte 64) :initial-element 0)
:type (simple-array (unsigned-byte 64) (256)))
(a 0 :type (unsigned-byte 64))
(b 0 :type (unsigned-byte 64))
(c 0 :type (unsigned-byte 64)))
(defun generate-next-isaac64-block (ctx)
;(declare (optimize (speed 3) (safety 0)))
(incf (isaac64-ctx-c ctx))
(incf (isaac64-ctx-b ctx) (isaac64-ctx-c ctx))
(loop for i from 0 below 256 do
(setf (isaac64-ctx-a ctx)
(logxor (isaac64-ctx-a ctx)
(the (unsigned-byte 64)
(logand #xFFFFFFFFFFFFFFFF
(ash (isaac64-ctx-a ctx)
(ecase (logand i 3)
((0) 21)
((1) -5)
((2) 12)
((3) -33)))))))
(setf (isaac64-ctx-a ctx)
(logand #xFFFFFFFFFFFFFFFF
(+ (isaac64-ctx-a ctx)
(aref (isaac64-ctx-randmem ctx) (logand (+ i 128) #xFF)))))
(let* ((x (aref (isaac64-ctx-randmem ctx) i))
(y (logand #xFFFFFFFFFFFFFFFF
(+ (aref (isaac64-ctx-randmem ctx) (logand (ash x -2) #xFF))
(isaac64-ctx-a ctx)
(isaac64-ctx-b ctx)))))
(setf (aref (isaac64-ctx-randmem ctx) i) y)
(setf (isaac64-ctx-b ctx)
(logand #xFFFFFFFFFFFFFFFF
(+ (aref (isaac64-ctx-randmem ctx) (logand (ash y -10) #xFF)) x)))
(setf (aref (isaac64-ctx-randrsl ctx) i) (isaac64-ctx-b ctx)))))
(defun rand64 (ctx)
(let ((c (isaac64-ctx-randcnt ctx)))
;(declare (optimize (speed 3) (safety 0)))
(decf (isaac64-ctx-randcnt ctx))
(if (zerop c)
(progn
(generate-next-isaac64-block ctx)
(setf (isaac64-ctx-randcnt ctx) 255)
(aref (isaac64-ctx-randrsl ctx) 255))
(aref (isaac64-ctx-randrsl ctx) (isaac64-ctx-randcnt ctx)))))
(defun rand-bits-64 (ctx n)
(let ((v 0))
(loop while (> n 0) do
(setq v (logior (ash v (min n 64))
(logand (1- (ash 1 (min n 64)))
(rand64 ctx))))
(decf n (min n 64)))
v))
(defmacro incf-wrap64 (a b)
`(setf ,a (logand #xFFFFFFFFFFFFFFFF (+ ,a ,b))))
(defmacro decf-wrap64 (a b)
`(setf ,a (logand #xFFFFFFFFFFFFFFFF (- ,a ,b))))
(defmacro mix64 (a b c d e f g h)
`(progn
(decf-wrap64 ,a ,e) (setf ,f (logxor ,f (logand #xFFFFFFFFFFFFFFFF (ash ,h -9)))) (incf-wrap64 ,h ,a)
(decf-wrap64 ,b ,f) (setf ,g (logxor ,g (logand #xFFFFFFFFFFFFFFFF (ash ,a 9)))) (incf-wrap64 ,a ,b)
(decf-wrap64 ,c ,g) (setf ,h (logxor ,h (logand #xFFFFFFFFFFFFFFFF (ash ,b -23)))) (incf-wrap64 ,b ,c)
(decf-wrap64 ,d ,h) (setf ,a (logxor ,a (logand #xFFFFFFFFFFFFFFFF (ash ,c 15)))) (incf-wrap64 ,c ,d)
(decf-wrap64 ,e ,a) (setf ,b (logxor ,b (logand #xFFFFFFFFFFFFFFFF (ash ,d -14)))) (incf-wrap64 ,d ,e)
(decf-wrap64 ,f ,b) (setf ,c (logxor ,c (logand #xFFFFFFFFFFFFFFFF (ash ,e 20)))) (incf-wrap64 ,e ,f)
(decf-wrap64 ,g ,c) (setf ,d (logxor ,d (logand #xFFFFFFFFFFFFFFFF (ash ,f -17)))) (incf-wrap64 ,f ,g)
(decf-wrap64 ,h ,d) (setf ,e (logxor ,e (logand #xFFFFFFFFFFFFFFFF (ash ,g 14)))) (incf-wrap64 ,g ,h)))
(defun scramble64 (ctx)
(let (a b c d e f g h)
; golden ratio
(setf a #x9e3779b97f4a7c13 b a c a d a e a f a g a h a)
; scramble it
(loop for i from 0 below 4 do
(mix64 a b c d e f g h))
;; Pass #1
(loop for i from 0 below 256 by 8 do
(incf-wrap64 a (aref (isaac64-ctx-randrsl ctx) (+ i 0)))
(incf-wrap64 b (aref (isaac64-ctx-randrsl ctx) (+ i 1)))
(incf-wrap64 c (aref (isaac64-ctx-randrsl ctx) (+ i 2)))
(incf-wrap64 d (aref (isaac64-ctx-randrsl ctx) (+ i 3)))
(incf-wrap64 e (aref (isaac64-ctx-randrsl ctx) (+ i 4)))
(incf-wrap64 f (aref (isaac64-ctx-randrsl ctx) (+ i 5)))
(incf-wrap64 g (aref (isaac64-ctx-randrsl ctx) (+ i 6)))
(incf-wrap64 h (aref (isaac64-ctx-randrsl ctx) (+ i 7)))
(mix64 a b c d e f g h)
(setf (aref (isaac64-ctx-randmem ctx) (+ i 0)) a)
(setf (aref (isaac64-ctx-randmem ctx) (+ i 1)) b)
(setf (aref (isaac64-ctx-randmem ctx) (+ i 2)) c)
(setf (aref (isaac64-ctx-randmem ctx) (+ i 3)) d)
(setf (aref (isaac64-ctx-randmem ctx) (+ i 4)) e)
(setf (aref (isaac64-ctx-randmem ctx) (+ i 5)) f)
(setf (aref (isaac64-ctx-randmem ctx) (+ i 6)) g)
(setf (aref (isaac64-ctx-randmem ctx) (+ i 7)) h))
;; Pass #2
(loop for i from 0 below 256 by 8 do
(incf-wrap64 a (aref (isaac64-ctx-randmem ctx) (+ i 0)))
(incf-wrap64 b (aref (isaac64-ctx-randmem ctx) (+ i 1)))
(incf-wrap64 c (aref (isaac64-ctx-randmem ctx) (+ i 2)))
(incf-wrap64 d (aref (isaac64-ctx-randmem ctx) (+ i 3)))
(incf-wrap64 e (aref (isaac64-ctx-randmem ctx) (+ i 4)))
(incf-wrap64 f (aref (isaac64-ctx-randmem ctx) (+ i 5)))
(incf-wrap64 g (aref (isaac64-ctx-randmem ctx) (+ i 6)))
(incf-wrap64 h (aref (isaac64-ctx-randmem ctx) (+ i 7)))
(mix64 a b c d e f g h)
(setf (aref (isaac64-ctx-randmem ctx) (+ i 0)) a)
(setf (aref (isaac64-ctx-randmem ctx) (+ i 1)) b)
(setf (aref (isaac64-ctx-randmem ctx) (+ i 2)) c)
(setf (aref (isaac64-ctx-randmem ctx) (+ i 3)) d)
(setf (aref (isaac64-ctx-randmem ctx) (+ i 4)) e)
(setf (aref (isaac64-ctx-randmem ctx) (+ i 5)) f)
(setf (aref (isaac64-ctx-randmem ctx) (+ i 6)) g)
(setf (aref (isaac64-ctx-randmem ctx) (+ i 7)) h))
; fill in first set
(generate-next-isaac64-block ctx)
; prepare to use first set
(setf (isaac64-ctx-randcnt ctx) 256)
; return CTX
ctx))
;; EOF