X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-random.lisp;h=f0b740fd3afb4e501ec1058ce011d286d11ff042;hb=1dc38285834db2d374a156a4f68b19096341deb3;hp=c729bbab41363bb2471f645e9e37183b143a9ad3;hpb=78fa16bf55be44cc16845be84d98023e83fb14bc;p=sbcl.git diff --git a/src/code/target-random.lisp b/src/code/target-random.lisp index c729bba..f0b740f 100644 --- a/src/code/target-random.lisp +++ b/src/code/target-random.lisp @@ -18,20 +18,20 @@ ;;;; RANDOM-STATEs -(def!method make-load-form ((random-state random-state) &optional environment) +(def!method make-load-form ((random-state random-state) &optional environment) (make-load-form-saving-slots random-state :environment environment)) (def!method print-object ((state random-state) stream) (if (and *print-readably* (not *read-eval*)) (error 'print-not-readable :object state) (format stream "#S(~S ~S #.~S)" - 'random-state - ':state - `(make-array 627 - :element-type - '(unsigned-byte 32) - :initial-contents - ',(coerce (random-state-state state) 'list))))) + 'random-state + ':state + `(make-array 627 + :element-type + '(unsigned-byte 32) + :initial-contents + ',(coerce (random-state-state state) 'list))))) ;;; The state is stored in a (simple-array (unsigned-byte 32) (627)) ;;; wrapped in a random-state structure: @@ -55,10 +55,10 @@ (setf (aref state 2) 1) (setf (aref state 3) seed) (do ((k 1 (1+ k))) - ((>= k 624)) + ((>= k 624)) (declare (type (mod 625) k)) (setf (aref state (+ 3 k)) - (logand (* 69069 (aref state (+ 3 (1- k)))) #xffffffff))) + (logand (* 69069 (aref state (+ 3 (1- k)))) #xffffffff))) state)) (defvar *random-state*) @@ -75,15 +75,15 @@ the universal time." (/show0 "entering MAKE-RANDOM-STATE") (flet ((copy-random-state (state) - (/show0 "entering COPY-RANDOM-STATE") - (let ((state (random-state-state state)) - (new-state - (make-array 627 :element-type '(unsigned-byte 32)))) - (/show0 "made NEW-STATE, about to DOTIMES") - (dotimes (i 627) - (setf (aref new-state i) (aref state i))) - (/show0 "falling through to %MAKE-RANDOM-STATE") - (%make-random-state :state new-state)))) + (/show0 "entering COPY-RANDOM-STATE") + (let ((state (random-state-state state)) + (new-state + (make-array 627 :element-type '(unsigned-byte 32)))) + (/show0 "made NEW-STATE, about to DOTIMES") + (dotimes (i 627) + (setf (aref new-state i) (aref state i))) + (/show0 "falling through to %MAKE-RANDOM-STATE") + (%make-random-state :state new-state)))) (/show0 "at head of ETYPECASE in MAKE-RANDOM-STATE") (etypecase state (null @@ -95,8 +95,8 @@ ((member t) (/show0 "T clause") (%make-random-state :state (init-random-state - (logand (get-universal-time) - #xffffffff))))))) + (logand (get-universal-time) + #xffffffff))))))) ;;;; random entries @@ -113,35 +113,35 @@ #!-x86 (defun random-mt19937-update (state) (declare (type (simple-array (unsigned-byte 32) (627)) state) - (optimize (speed 3) (safety 0))) + (optimize (speed 3) (safety 0))) (let ((y 0)) (declare (type (unsigned-byte 32) y)) (do ((kk 3 (1+ kk))) - ((>= kk (+ 3 (- mt19937-n mt19937-m)))) + ((>= kk (+ 3 (- mt19937-n mt19937-m)))) (declare (type (mod 628) kk)) (setf y (logior (logand (aref state kk) mt19937-upper-mask) - (logand (aref state (1+ kk)) mt19937-lower-mask))) + (logand (aref state (1+ kk)) mt19937-lower-mask))) (setf (aref state kk) (logxor (aref state (+ kk mt19937-m)) - (ash y -1) (aref state (logand y 1))))) + (ash y -1) (aref state (logand y 1))))) (do ((kk (+ (- mt19937-n mt19937-m) 3) (1+ kk))) - ((>= kk (+ (1- mt19937-n) 3))) + ((>= kk (+ (1- mt19937-n) 3))) (declare (type (mod 628) kk)) (setf y (logior (logand (aref state kk) mt19937-upper-mask) - (logand (aref state (1+ kk)) mt19937-lower-mask))) + (logand (aref state (1+ kk)) mt19937-lower-mask))) (setf (aref state kk) (logxor (aref state (+ kk (- mt19937-m mt19937-n))) - (ash y -1) (aref state (logand y 1))))) + (ash y -1) (aref state (logand y 1))))) (setf y (logior (logand (aref state (+ 3 (1- mt19937-n))) - mt19937-upper-mask) - (logand (aref state 3) mt19937-lower-mask))) + mt19937-upper-mask) + (logand (aref state 3) mt19937-lower-mask))) (setf (aref state (+ 3 (1- mt19937-n))) - (logxor (aref state (+ 3 (1- mt19937-m))) - (ash y -1) (aref state (logand y 1))))) + (logxor (aref state (+ 3 (1- mt19937-m))) + (ash y -1) (aref state (logand y 1))))) (values)) #!-x86 (defun random-chunk (state) (declare (type random-state state)) (let* ((state (random-state-state state)) - (k (aref state 2))) + (k (aref state 2))) (declare (type (mod 628) k)) (when (= k mt19937-n) (random-mt19937-update state) @@ -164,6 +164,13 @@ (defun random-chunk (state) (declare (type random-state state)) (sb!vm::random-mt19937 (random-state-state state))) + +#!-sb-fluid (declaim (inline big-random-chunk)) +(defun big-random-chunk (state) + (declare (type random-state state)) + (logand (1- (expt 2 64)) + (logior (ash (random-chunk state) 32) + (random-chunk state)))) ;;; 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 @@ -171,58 +178,58 @@ ;;; we have a hidden bit. #!-sb-fluid (declaim (inline %random-single-float %random-double-float)) (declaim (ftype (function ((single-float (0f0)) random-state) - (single-float 0f0)) - %random-single-float)) + (single-float 0f0)) + %random-single-float)) (defun %random-single-float (arg state) (declare (type (single-float (0f0)) arg) - (type random-state state)) + (type random-state state)) (* arg (- (make-single-float - (dpb (ash (random-chunk state) - (- sb!vm:single-float-digits random-chunk-length)) - sb!vm:single-float-significand-byte - (single-float-bits 1.0))) - 1.0))) + (dpb (ash (random-chunk state) + (- sb!vm:single-float-digits random-chunk-length)) + sb!vm:single-float-significand-byte + (single-float-bits 1.0))) + 1.0))) (declaim (ftype (function ((double-float (0d0)) random-state) - (double-float 0d0)) - %random-double-float)) + (double-float 0d0)) + %random-double-float)) ;;; 32-bit version #!+nil (defun %random-double-float (arg state) (declare (type (double-float (0d0)) arg) - (type random-state state)) + (type random-state state)) (* (float (random-chunk state) 1d0) (/ 1d0 (expt 2 32)))) ;;; 53-bit version #!-x86 (defun %random-double-float (arg state) (declare (type (double-float (0d0)) arg) - (type random-state state)) + (type random-state state)) (* arg (- (sb!impl::make-double-float - (dpb (ash (random-chunk state) - (- sb!vm:double-float-digits random-chunk-length 32)) - sb!vm:double-float-significand-byte - (sb!impl::double-float-high-bits 1d0)) - (random-chunk state)) - 1d0))) + (dpb (ash (random-chunk state) + (- sb!vm:double-float-digits random-chunk-length 32)) + sb!vm:double-float-significand-byte + (sb!impl::double-float-high-bits 1d0)) + (random-chunk state)) + 1d0))) ;;; using a faster inline VOP #!+x86 (defun %random-double-float (arg state) (declare (type (double-float (0d0)) arg) - (type random-state state)) + (type random-state state)) (let ((state-vector (random-state-state state))) (* arg (- (sb!impl::make-double-float - (dpb (ash (sb!vm::random-mt19937 state-vector) - (- sb!vm:double-float-digits random-chunk-length - sb!vm:n-word-bits)) - sb!vm:double-float-significand-byte - (sb!impl::double-float-high-bits 1d0)) - (sb!vm::random-mt19937 state-vector)) - 1d0)))) + (dpb (ash (sb!vm::random-mt19937 state-vector) + (- sb!vm:double-float-digits random-chunk-length + sb!vm:n-word-bits)) + sb!vm:double-float-significand-byte + (sb!impl::double-float-high-bits 1d0)) + (sb!vm::random-mt19937 state-vector)) + 1d0)))) ;;;; random integers @@ -231,17 +238,17 @@ (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)) + (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))))) (defun random (arg &optional (state *random-state*)) (declare (inline %random-single-float %random-double-float - #!+long-float %random-long-float)) + #!+long-float %random-long-float)) (cond ((and (fixnump arg) (<= arg random-fixnum-max) (> arg 0)) (rem (random-chunk state) arg)) @@ -256,7 +263,7 @@ (%random-integer arg state)) (t (error 'simple-type-error - :expected-type '(or (integer 1) (float (0))) :datum arg - :format-control "~@" - :format-arguments (list arg))))) + :format-arguments (list arg)))))