Changeset 7258
 Timestamp:
 Sep 19, 2007, 9:48:44 AM (13 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

branches/working0709/ccl/level0/l0numbers.lisp
r7195 r7258 1722 1722 1723 1723 1724 #+32bittarget 1724 1725 (defun random (number &optional (state *randomstate*)) 1725 1726 (if (not (typep state 'randomstate)) (reportbadarg state 'randomstate)) … … 1729 1730 (if (< number 65536) 1730 1731 (fastmod (%nextrandomseed state) number) 1731 (%bignumrandom number state)))) 1732 (let* ((n 0) 1733 (nhalf (ash (+ 15 (integerlength number)) 4))) 1734 (declare (fixnum n nhalf)) 1735 (dotimes (i nhalf (fastmod n number)) 1736 (setq n (logior (the fixnum (ash n 16)) 1737 (the fixnum (%nextrandomseed state))))))))) 1732 1738 ((and (typep number 'doublefloat) (> (the doublefloat number) 0.0)) 1733 1739 (%floatrandom number state)) … … 1738 1744 (t (reportbadarg number '(or (integer (0)) (float (0.0))))))) 1739 1745 1746 #+64bittarget 1747 (defun random (number &optional (state *randomstate*)) 1748 (if (not (typep state 'randomstate)) (reportbadarg state 'randomstate)) 1749 (cond 1750 ((and (fixnump number) (> (the fixnum number) 0)) 1751 (locally (declare (fixnum number)) 1752 (let* ((n 0) 1753 (n32 (ash (+ 31 (integerlength number)) 5))) 1754 (declare (fixnum n n32)) 1755 (dotimes (i n32 (fastmod n number)) 1756 (setq n (logior (the fixnum (ash n 16)) 1757 (the fixnum (%nextrandomseed state)))))))) 1758 ((and (typep number 'doublefloat) (> (the doublefloat number) 0.0)) 1759 (%floatrandom number state)) 1760 ((and (typep number 'shortfloat) (> (the shortfloat number) 0.0s0)) 1761 (%floatrandom number state)) 1762 ((and (bignump number) (> number 0)) 1763 (%bignumrandom number state)) 1764 (t (reportbadarg number '(or (integer (0)) (float (0.0))))))) 1765 1740 1766 1741 1767 # … … 1760 1786 1761 1787 What makes this generator so simple is that multiplication and addition mod 1762 2^n1 is easy. See Knuth Ch. 4.3.2 (2nd Ed. p 272).1788 2^n1 is easy. See Knuth Ch. 4.3.2 (2nd Ed. p 272). 1763 1789 1764 1790 ab mod m = ... … … 1780 1806 1781 1807 #+64bittarget 1782 (defun %nextrandompair (high low) 1783 (declare (type (unsignedbyte 16) high low)) 1784 (let* ((n0 1785 (%i* 42871 1786 (the (unsignedbyte 31) 1787 (logior (the (unsignedbyte 31) 1788 (ash (ldb (byte 15 0) high) 16)) 1789 (the (unsignedbyte 16) 1790 (ldb (byte 16 0) low)))))) 1791 (n (fastmod n0 (1 (expt 2 31))))) 1808 (defun %nextrandomseed (state) 1809 (let* ((n (the fixnum (* (the fixnum (random.seed1 state)) 48271)))) 1792 1810 (declare (fixnum n)) 1793 (values (ldb (byte 15 16) n) 1794 (ldb (byte 16 0) n)))) 1795 1811 (setf (random.seed1 state) (fastmod n (1 (expt 2 31)))) 1812 (logand n (1 (ash 1 32))))) 1813 1814 #+32bittarget 1796 1815 (defun %nextrandomseed (state) 1797 1816 (multiplevaluebind (high low) (%nextrandompair (%svref state 1) … … 1803 1822 (logior high (the fixnum (logand low (ash 1 15)))))) 1804 1823 1805 1824 #+32bittarget 1806 1825 (defun %bignumrandom (number state) 1807 1826 (let* ((bits (+ (integerlength number) 8)) … … 1832 1851 1833 1852 (defun %floatrandom (number state) 1834 (if (zerop number) 1835 number 1836 (let ((ratio (gvector :ratio (random mostpositivefixnum state) mostpositivefixnum))) 1837 (declare (dynamicextent ratio)) 1838 (* number ratio)))) 1853 (let ((ratio (gvector :ratio (random mostpositivefixnum state) mostpositivefixnum))) 1854 (declare (dynamicextent ratio)) 1855 (* number ratio))) 1839 1856 1840 1857 (evalwhen (:compiletoplevel :execute)
Note: See TracChangeset
for help on using the changeset viewer.