Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
cmucl
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Package Registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Carl Shapiro
cmucl
Commits
0164a05c
Commit
0164a05c
authored
31 years ago
by
ram
Browse files
Options
Downloads
Patches
Plain Diff
Tuning make stuff faster. Random double floats are now much, much faster.
parent
cd28c1f9
No related branches found
No related tags found
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
code/rand.lisp
+143
-59
143 additions, 59 deletions
code/rand.lisp
with
143 additions
and
59 deletions
code/rand.lisp
+
143
−
59
View file @
0164a05c
;;; -*- Mode: Lisp; Package:
Lisp; Log: code.log
-*-
;;; -*- Mode: Lisp; Package:
Kernel
-*-
;;;
;;; **********************************************************************
;;; This code was written as part of the CMU Common Lisp project at
...
...
@@ -7,70 +7,61 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/rand.lisp,v 1.
4
199
1/12/14 0
9:01:
0
1
wlott
Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/rand.lisp,v 1.
5
199
3/05/07 1
9:01:
5
1
ram
Exp $"
)
;;;
;;; **********************************************************************
;;;
;;; Functions to random number functions for Spice Lisp
;;; Written by David Adam.
;;; Functions to random number functions for Spice Lisp
;;;
;;; The random number functions are part of the standard Spicelisp environment.
;;; Originally written by David Adam. Python tuning, better large integer
;;; randomness and efficient IEEE float support by Rob MacLachlan.
;;;
;;; **********************************************************************
;;;
(
in-package
'lisp
)
(
in-package
"LISP"
)
(
export
'
(
random-state
random-state-p
random
*random-state*
make-random-state
))
(
in-package
"KERNEL"
)
(
export
'
(
%random-single-float
%random-double-float
random-chunk
random-fixnum-max
))
;;;; Random state hackery:
(
defconstant
random-const-a
8373
)
(
defconstant
random-const-c
101010101
)
(
defconstant
random-upper-bound
(
1-
most-positive-fixnum
))
(
defconstant
random-max
54
)
(
defconstant
%fixnum-length
(
integer-length
most-positive-fixnum
))
(
defvar
rand-seed
0
)
;;; Inclusive upper bound on the size of fixnum kept in the state (and returned
;;; by random-chunk.) Must be even.
;;;
(
defconstant
random-upper-bound
(
-
most-positive-fixnum
3
))
(
defconstant
random-chunk-length
(
integer-length
random-upper-bound
))
(
deftype
random-chunk
()
`
(
integer
0
,
random-upper-bound
))
(
defvar
rand-seed
0
)
(
defstruct
(
random-state
(
:constructor
make-random-object
)
(
:make-load-form-fun
:just-dump-it-normally
))
(
j
24
:type
in
teger
)
(
k
0
:type
in
teger
)
(
j
24
:type
in
dex
)
(
k
0
:type
in
dex
)
(
seed
(
make-array
(
1+
random-max
)
:initial-contents
(
do
((
list-rands
()
(
cons
(
rand1
)
list-rands
))
(
i
0
(
1+
i
)))
((
>
i
random-max
)
list-rands
)))
((
>
i
random-max
)
list-rands
)
(
declare
(
fixnum
i
))))
:type
simple-vector
))
;;; Generates a random number from rand-seed.
(
defun
rand1
()
(
setq
rand-seed
(
mod
(
+
(
*
rand-seed
random-const-a
)
random-const-c
)
(
1+
random-upper-bound
))))
(
declare
(
optimize
(
inhibit-warnings
3
)))
(
setq
rand-seed
(
mod
(
+
(
*
rand-seed
random-const-a
)
random-const-c
)
(
1+
random-upper-bound
))))
(
defvar
*random-state*
(
make-random-object
))
;;; rand3 -- Internal
;;;
;;; This function generates fixnums between 0 and random-upper-bound,
;;; inclusive For the algorithm to work random-upper-bound must be an
;;; even positive fixnum. State is the random state to use.
;;;
(
defun
rand3
(
state
)
(
let
((
seed
(
random-state-seed
state
))
(
j
(
random-state-j
state
))
(
k
(
random-state-k
state
)))
(
declare
(
fixnum
j
k
)
(
simple-vector
seed
))
(
setf
(
svref
seed
k
)
(
let
((
a
(
-
random-upper-bound
(
svref
seed
(
setf
(
random-state-j
state
)
(
if
(
=
j
0
)
random-max
(
1-
j
))))
(
svref
seed
(
setf
(
random-state-k
state
)
(
if
(
=
k
0
)
random-max
(
1-
k
)))))))
(
if
(
minusp
a
)
(
-
a
)
(
-
random-upper-bound
a
))))))
(
defun
copy-state
(
cur-state
)
(
let
((
state
(
make-random-object
...
...
@@ -92,28 +83,121 @@
((
random-state-p
state
)
(
copy-state
state
))
((
eq
state
t
)
(
setq
rand-seed
(
get-universal-time
))
(
make-random-object
))
(
t
(
error
"Bad argument, ~A, for RANDOM-STATE."
state
))))
(
t
(
error
"Argument is not a RANDOM-STATE, T or NIL: ~S"
state
))))
;;;; Random entries:
(
declaim
(
start-block
random
%random-single-float
%random-double-float
random-chunk
))
;;; random-chunk -- Internal
;;;
;;; This function generates fixnums between 0 and random-upper-bound,
;;; inclusive. For the algorithm to work random-upper-bound must be an
;;; even positive fixnum. State is the random state to use.
;;;
(
declaim
(
ftype
(
function
(
random-state
)
random-chunk
)
random-chunk
))
(
defun
random-chunk
(
state
)
(
let*
((
seed
(
random-state-seed
state
))
(
j
(
random-state-j
state
))
(
k
(
random-state-k
state
))
(
a
(
-
(
-
random-upper-bound
(
the
random-chunk
(
svref
seed
(
setf
(
random-state-j
state
)
(
if
(
=
j
0
)
random-max
(
1-
j
))))))
(
the
random-chunk
(
svref
seed
(
setf
(
random-state-k
state
)
(
if
(
=
k
0
)
random-max
(
1-
k
))))))))
(
declare
(
fixnum
a
))
(
setf
(
svref
seed
k
)
(
the
random-chunk
(
if
(
minusp
a
)
(
-
a
)
(
-
random-upper-bound
a
))))))
;;; %RANDOM-SINGLE-FLOAT, %RANDOM-DOUBLE-FLOAT -- Interface
;;;
;;; Handle the single or double float case of RANDOM. We generate a float
;;; between 0.0 and 1.0 by clobbering the significand of 1.0 with random bits,
;;; then subtracting 1.0. This hides the fact that we have a hidden bit.
;;;
(
declaim
(
inline
%random-single-float
%random-double-float
))
(
defun
%random-single-float
(
arg
state
)
(
declare
(
type
(
single-float
(
0f0
))
arg
)
(
type
(
or
random-state
null
)
state
))
(
*
arg
(
-
(
make-single-float
(
dpb
(
ash
(
random-chunk
(
or
state
*random-state*
))
(
-
vm:single-float-digits
random-chunk-length
))
vm:single-float-significand-byte
(
single-float-bits
1.0
)))
1.0
)))
;;;
(
defun
%random-double-float
(
arg
state
)
(
declare
(
type
(
double-float
(
0d0
))
arg
)
(
type
(
or
random-state
null
)
state
))
(
let
((
state
(
or
state
*random-state*
)))
(
*
arg
(
-
(
make-double-float
(
dpb
(
ash
(
random-chunk
state
)
(
-
vm:double-float-digits
random-chunk-length
vm:word-bits
))
vm:double-float-significand-byte
(
double-float-high-bits
1d0
))
(
logxor
(
ash
(
random-chunk
state
)
(
-
vm:word-bits
random-chunk-length
))
(
ash
(
random-chunk
state
)
(
-
random-chunk-length
vm:word-bits
))))
1d0
))))
;;;; Random integers:
;;; Amount we overlap chunks by when building a large integer to make up for
;;; the loss of randomness in the low bits.
;;;
(
defconstant
random-integer-overlap
3
)
;;; Extra bits of randomness that we generate before taking the value MOD the
;;; limit, to avoid loss of randomness near the limit.
;;;
(
defconstant
random-integer-extra-bits
10
)
;;; Largest fixnum we can compute from one chunk of bits.
;;;
(
defconstant
random-fixnum-max
(
1-
(
ash
1
(
-
random-chunk-length
random-integer-extra-bits
))))
;;; %RANDOM-INTEGER -- Internal
;;;
(
defun
%random-integer
(
arg
state
)
(
declare
(
type
(
integer
1
)
arg
)
(
type
random-state
state
))
(
let
((
shift
(
-
random-chunk-length
random-integer-overlap
)))
(
do
((
bits
(
random-chunk
state
)
(
logxor
(
ash
bits
shift
)
(
random-chunk
state
)))
(
count
(
+
(
integer-length
arg
)
(
-
random-integer-extra-bits
shift
))
(
-
count
shift
)))
((
minusp
count
)
(
rem
bits
arg
))
(
declare
(
fixnum
count
)))))
(
proclaim
'
(
ftype
(
function
(
t
)
fixnum
)
rand3
))
(
defun
random
(
arg
&optional
(
state
*random-state*
))
"Generate a uniformly distributed pseudo-random number between zero
and Arg. State, if supplied, is the random state to use."
(
typecase
arg
(
fixnum
(
unless
(
plusp
(
the
fixnum
arg
))
(
error
"Non-positive argument, ~A, to RANDOM."
arg
))
(
rem
(
the
fixnum
(
rand3
state
))
(
the
fixnum
arg
)))
(
float
(
unless
(
plusp
arg
)
(
error
"Non-positive argument, ~A, to RANDOM."
arg
))
(
let
((
arg-length
(
float-digits
arg
)))
(
*
arg
(
/
(
float
(
random
(
ash
2
arg-length
)
state
))
(
float
(
ash
2
arg-length
))))))
(
integer
(
unless
(
plusp
arg
)
(
error
"Non-positive argument, ~A, to RANDOM."
arg
))
(
do
((
tot
(
rand3
state
)
(
+
(
ash
tot
%fixnum-length
)
(
rand3
state
)))
(
end
(
ash
arg
(
-
%fixnum-length
))
(
ash
end
(
-
%fixnum-length
))))
((
zerop
end
)
(
mod
tot
arg
))))
(
t
(
error
"Wrong type argument, ~A, to RANDOM."
arg
))))
(
declare
(
inline
%random-single-float
%random-double-float
))
(
cond
((
and
(
fixnump
arg
)
(
<=
arg
random-fixnum-max
))
(
rem
(
random-chunk
state
)
arg
))
((
typep
arg
'single-float
)
(
%random-single-float
arg
state
))
((
typep
arg
'double-float
)
(
%random-double-float
arg
state
))
((
integerp
arg
)
(
%random-integer
arg
state
))
(
t
(
error
'simple-type-error
:expected-type
'
(
real
(
0
))
:datum
arg
:format-string
"Argument is not a positive real number: ~S"
:format-arguments
(
list
arg
)))))
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment