Changeset 7395 for branches/working0710
 Timestamp:
 Oct 12, 2007, 9:27:23 AM (14 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

branches/working0710/ccl/level0/l0numbers.lisp
r7354 r7395 1715 1715 1716 1716 (defun initrandomstateseeds () 1717 (let* ((ticks (ldb (byte 32 0) (+ (mixuphashcode (%currenttcr)) 1718 (primaryipinterfaceaddress) 1719 (mixuphashcode 1720 (logand (getinternalrealtime) 1721 (1 mostpositivefixnum)))))) 1722 (high (ldb (byte 16 16) (if (zerop ticks) #x10000 ticks))) 1717 (let* ((ticks (ldb (byte 32 0) (getinternalrealtime))) 1718 (high (ldb (byte 16 16) ticks)) 1723 1719 (low (ldb (byte 16 0) ticks))) 1724 1720 (declare (fixnum high low)) … … 1726 1722 1727 1723 1724 #+32bittarget 1728 1725 (defun random (number &optional (state *randomstate*)) 1729 1726 (if (not (typep state 'randomstate)) (reportbadarg state 'randomstate)) … … 1733 1730 (if (< number 65536) 1734 1731 (fastmod (%nextrandomseed state) number) 1735 (%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))))))))) 1736 1738 ((and (typep number 'doublefloat) (> (the doublefloat number) 0.0)) 1737 1739 (%floatrandom number state)) … … 1742 1744 (t (reportbadarg number '(or (integer (0)) (float (0.0))))))) 1743 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 1744 1766 1745 1767 # … … 1784 1806 1785 1807 #+64bittarget 1786 (defun %nextrandompair (high low) 1787 (declare (type (unsignedbyte 16) high low)) 1788 (let* ((n0 1789 (%i* 48271 1790 (the (unsignedbyte 31) 1791 (logior (the (unsignedbyte 31) 1792 (ash (ldb (byte 15 0) high) 16)) 1793 (the (unsignedbyte 16) 1794 (ldb (byte 16 0) low)))))) 1795 (n (fastmod n0 (1 (expt 2 31))))) 1808 (defun %nextrandomseed (state) 1809 (let* ((n (the fixnum (* (the fixnum (random.seed1 state)) 48271)))) 1796 1810 (declare (fixnum n)) 1797 (values (ldb (byte 15 16) n) 1798 (ldb (byte 16 0) n)))) 1799 1811 (setf (random.seed1 state) (fastmod n (1 (expt 2 31)))) 1812 (logand n (1 (ash 1 32))))) 1813 1814 #+32bittarget 1800 1815 (defun %nextrandomseed (state) 1801 1816 (multiplevaluebind (high low) (%nextrandompair (%svref state 1) … … 1807 1822 (logior high (the fixnum (logand low (ash 1 15)))))) 1808 1823 1809 1824 #+32bittarget 1810 1825 (defun %bignumrandom (number state) 1811 1826 (let* ((bits (+ (integerlength number) 8)) … … 1836 1851 1837 1852 (defun %floatrandom (number state) 1838 (if (zerop number) 1839 number 1840 (let ((ratio (gvector :ratio (random mostpositivefixnum state) mostpositivefixnum))) 1841 (declare (dynamicextent ratio)) 1842 (* number ratio)))) 1853 (let ((ratio (gvector :ratio (random mostpositivefixnum state) mostpositivefixnum))) 1854 (declare (dynamicextent ratio)) 1855 (* number ratio))) 1843 1856 1844 1857 (evalwhen (:compiletoplevel :execute)
Note: See TracChangeset
for help on using the changeset viewer.