Changeset 7395 for branches/working-0710


Ignore:
Timestamp:
Oct 12, 2007, 9:27:23 AM (12 years ago)
Author:
gb
Message:

64/32-bit random-state changes.

File:
1 edited

Legend:

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

    r7354 r7395  
    17151715
    17161716(defun init-random-state-seeds ()
    1717   (let* ((ticks (ldb (byte 32 0) (+ (mixup-hash-code (%current-tcr))
    1718                                     (primary-ip-interface-address)
    1719                                     (mixup-hash-code
    1720                                      (logand (get-internal-real-time)
    1721                                              (1- most-positive-fixnum))))))
    1722          (high (ldb (byte 16 16) (if (zerop ticks) #x10000 ticks)))
     1717  (let* ((ticks (ldb (byte 32 0) (get-internal-real-time)))
     1718         (high (ldb (byte 16 16) ticks))
    17231719         (low (ldb (byte 16 0) ticks)))
    17241720    (declare (fixnum high low))
     
    17261722
    17271723
     1724#+32-bit-target
    17281725(defun random (number &optional (state *random-state*))
    17291726  (if (not (typep state 'random-state)) (report-bad-arg state 'random-state))
     
    17331730        (if (< number 65536)
    17341731          (fast-mod (%next-random-seed state) number)
    1735           (%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)))))))))
    17361738     ((and (typep number 'double-float) (> (the double-float number) 0.0))
    17371739      (%float-random number state))
     
    17421744     (t (report-bad-arg number '(or (integer (0)) (float (0.0)))))))
    17431745
     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
    17441766
    17451767#|
     
    17841806
    17851807#+64-bit-target
    1786 (defun %next-random-pair (high low)
    1787   (declare (type (unsigned-byte 16) high low))
    1788   (let* ((n0
    1789           (%i* 48271
    1790              (the  (unsigned-byte 31)
    1791                (logior (the (unsigned-byte 31)
    1792                          (ash (ldb (byte 15 0) high) 16))
    1793                        (the (unsigned-byte 16)
    1794                          (ldb (byte 16 0) low))))))
    1795          (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))))
    17961810    (declare (fixnum n))
    1797     (values (ldb (byte 15 16) n)
    1798             (ldb (byte 16 0) n))))
    1799 
     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
    18001815(defun %next-random-seed (state)
    18011816  (multiple-value-bind (high low) (%next-random-pair (%svref state 1)
     
    18071822    (logior high (the fixnum (logand low (ash 1 15))))))
    18081823
    1809 
     1824#+32-bit-target
    18101825(defun %bignum-random (number state)
    18111826  (let* ((bits (+ (integer-length number) 8))
     
    18361851
    18371852(defun %float-random (number state)
    1838   (if (zerop number)
    1839     number
    1840     (let ((ratio (gvector :ratio (random most-positive-fixnum state) most-positive-fixnum)))
    1841       (declare (dynamic-extent ratio))
    1842       (* number ratio))))
     1853  (let ((ratio (gvector :ratio (random most-positive-fixnum state) most-positive-fixnum)))
     1854    (declare (dynamic-extent ratio))
     1855    (* number ratio)))
    18431856
    18441857(eval-when (:compile-toplevel :execute)
Note: See TracChangeset for help on using the changeset viewer.