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
|
;;;; "random.scm" Pseudo-Random number generator for scheme.
;;; Copyright (C) 1991, 1993 Aubrey Jaffer.
;
;Permission to copy this software, to redistribute it, and to use it
;for any purpose is granted, subject to the following restrictions and
;understandings.
;
;1. Any copy made of this software must include this copyright notice
;in full.
;
;2. I have made no warrantee or representation that the operation of
;this software will be error-free, and I am under no obligation to
;provide any services, by way of maintenance, update, or otherwise.
;
;3. In conjunction with products arising from the use of this
;material, there shall be no use of my name in any advertising,
;promotional, or sales literature without prior written consent in
;each case.
(require 'byte)
(require 'logical)
(define (make-rng seed)
(define mutex #f)
(define idx 0)
(define idy 0)
(define sta (make-bytes 256))
; initialize state
(do ((idx #xff (+ -1 idx)))
((negative? idx))
(byte-set! sta idx idx))
(if (number? seed)
(set! seed (number->string seed)))
; merge seed into state
(do ((idx 0 (+ 1 idx))
(kdx 0 (modulo (+ 1 kdx) seed-len))
(seed-len (bytes-length seed)))
((>= idx 256) (set! idy 0))
(let ((swp (byte-ref sta idx)))
(set! idy (logand #xff (+ idy (byte-ref seed kdx) swp)))
(byte-set! sta idx (byte-ref sta idy))
(byte-set! sta idy swp)))
; spew
(lambda ()
(if mutex (slib:error "random state called reentrantly"))
(set! mutex #t)
(set! idx (logand #xff (+ 1 idx)))
(let ((xtm (byte-ref sta idx)))
(set! idy (logand #xff (+ idy xtm)))
(let ((ytm (byte-ref sta idy)))
(byte-set! sta idy xtm)
(byte-set! sta idx ytm)
(let ((ans (byte-ref sta (logand #xff (+ ytm xtm)))))
(set! mutex #f)
ans)))))
(define *random-state*
(make-rng "http://swissnet.ai.mit.edu/~jaffer/SLIB.html"))
;;; random:chunk returns an integer in the range of 0 to 255.
(define (random:chunk v) (v))
(define (random:random modu . args)
(let ((state (if (null? args) *random-state* (car args))))
(if (exact? modu)
(let ((bitlen (integer-length (+ -1 modu))))
(do ((bln bitlen (+ -8 bln))
(rbs 0 (+ (ash rbs 8) (random:chunk state))))
((<= bln 7)
(modulo
(if (zero? bln) rbs
(+ (ash rbs bln)
(logand (bit-field (random:chunk state) 0 bln))))
modu))))
(* (random:uniform state) modu))))
;;;random:uniform is in randinex.scm. It is needed only if inexact is
;;;supported.
(define (make-random-state . args)
(let ((seed (if (null? args)
(do ((bts (make-bytes 10))
(idx 0 (+ 1 idx)))
((>= idx 10) bts)
(byte-set! bts idx (random:random 256)))
(let ()
(require 'object->string)
(object->limited-string (car args) 20)))))
(make-rng seed)))
(define random random:random)
(provide 'random) ;to prevent loops
(if (provided? 'inexact) (require 'random-inexact))
|
