Changeset 7258


Ignore:
Timestamp:
Sep 19, 2007, 9:48:44 AM (12 years ago)
Author:
gb
Message:

random: do 32-bits at a time on 64-bit lisps, do fixnum random more sanely.
64-bit random state keeps 32-bit seed in seed1 field, seed2 unused.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0709/ccl/level-0/l0-numbers.lisp

    r7195 r7258  
    17221722
    17231723
     1724#+32-bit-target
    17241725(defun random (number &optional (state *random-state*))
    17251726  (if (not (typep state 'random-state)) (report-bad-arg state 'random-state))
     
    17291730        (if (< number 65536)
    17301731          (fast-mod (%next-random-seed state) number)
    1731           (%bignum-random number state))))
     1732          (let* ((n 0)
     1733                 (nhalf (ash (+ 15 (integer-length number)) -4)))
     1734            (declare (fixnum n nhalf))
     1735            (dotimes (i nhalf (fast-mod n number))
     1736              (setq n (logior (the fixnum (ash n 16))
     1737                              (the fixnum (%next-random-seed state)))))))))
    17321738     ((and (typep number 'double-float) (> (the double-float number) 0.0))
    17331739      (%float-random number state))
     
    17381744     (t (report-bad-arg number '(or (integer (0)) (float (0.0)))))))
    17391745
     1746#+64-bit-target
     1747(defun random (number &optional (state *random-state*))
     1748  (if (not (typep state 'random-state)) (report-bad-arg state 'random-state))
     1749  (cond
     1750    ((and (fixnump number) (> (the fixnum number) 0))
     1751     (locally (declare (fixnum number))
     1752       (let* ((n 0)
     1753              (n32 (ash (+ 31 (integer-length number)) -5)))
     1754         (declare (fixnum n n32))
     1755         (dotimes (i n32 (fast-mod n number))
     1756           (setq n (logior (the fixnum (ash n 16))
     1757                           (the fixnum (%next-random-seed state))))))))
     1758    ((and (typep number 'double-float) (> (the double-float number) 0.0))
     1759     (%float-random number state))
     1760    ((and (typep number 'short-float) (> (the short-float number) 0.0s0))
     1761     (%float-random number state))
     1762    ((and (bignump number) (> number 0))
     1763     (%bignum-random number state))
     1764    (t (report-bad-arg number '(or (integer (0)) (float (0.0)))))))
     1765
    17401766
    17411767#|
     
    17601786
    17611787What makes this generator so simple is that multiplication and addition mod
    1762 2^n-1 is easy.  See Knuth Ch. 4.3.2 (2nd Ed. p 272).
     1788  2^n-1 is easy.  See Knuth Ch. 4.3.2 (2nd Ed. p 272).
    17631789
    17641790    ab mod m = ...
     
    17801806
    17811807#+64-bit-target
    1782 (defun %next-random-pair (high low)
    1783   (declare (type (unsigned-byte 16) high low))
    1784   (let* ((n0
    1785           (%i* 42871
    1786              (the  (unsigned-byte 31)
    1787                (logior (the (unsigned-byte 31)
    1788                          (ash (ldb (byte 15 0) high) 16))
    1789                        (the (unsigned-byte 16)
    1790                          (ldb (byte 16 0) low))))))
    1791          (n (fast-mod n0 (1- (expt 2 31)))))
     1808(defun %next-random-seed (state)
     1809  (let* ((n (the fixnum (* (the fixnum (random.seed-1 state)) 48271))))
    17921810    (declare (fixnum n))
    1793     (values (ldb (byte 15 16) n)
    1794             (ldb (byte 16 0) n))))
    1795 
     1811    (setf (random.seed-1 state) (fast-mod n (1- (expt 2 31))))
     1812    (logand n (1- (ash 1 32)))))
     1813
     1814#+32-bit-target
    17961815(defun %next-random-seed (state)
    17971816  (multiple-value-bind (high low) (%next-random-pair (%svref state 1)
     
    18031822    (logior high (the fixnum (logand low (ash 1 15))))))
    18041823
    1805 
     1824#+32-bit-target
    18061825(defun %bignum-random (number state)
    18071826  (let* ((bits (+ (integer-length number) 8))
     
    18321851
    18331852(defun %float-random (number state)
    1834   (if (zerop number)
    1835     number
    1836     (let ((ratio (gvector :ratio (random most-positive-fixnum state) most-positive-fixnum)))
    1837       (declare (dynamic-extent ratio))
    1838       (* number ratio))))
     1853  (let ((ratio (gvector :ratio (random most-positive-fixnum state) most-positive-fixnum)))
     1854    (declare (dynamic-extent ratio))
     1855    (* number ratio)))
    18391856
    18401857(eval-when (:compile-toplevel :execute)
Note: See TracChangeset for help on using the changeset viewer.