Changeset 13327 for trunk/source/level1/l1numbers.lisp
 Timestamp:
 Dec 22, 2009, 7:10:27 AM (11 years ago)
 Location:
 trunk/source
 Files:

 2 edited
Legend:
 Unmodified
 Added
 Removed

trunk/source
 Property svn:mergeinfo changed
/branches/newrandom (added) merged: 1331013326
 Property svn:mergeinfo changed

trunk/source/level1/l1numbers.lisp
r13067 r13327 422 422 nil))) 423 423 424 (defun %consrandomstate (seed1 seed2)425 #+32bittarget426 (%istruct 'randomstate seed1 seed2)427 #+64bittarget428 (%istruct 'randomstate (the fixnum (+ (the fixnum seed2)429 (the fixnum (ash (the fixnum seed1) 16))))))430 431 424 ;;; random associated stuff except for the printobject method which 432 425 ;;; is still in "lib;numbers.lisp" 433 (defun initializerandomstate (seed1 seed2) 434 (unless (and (fixnump seed1) (%i<= 0 seed1) (%i< seed1 #x10000)) 435 (reportbadarg seed1 '(unsignedbyte 16))) 436 (unless (and (fixnump seed2) (%i<= 0 seed2) (%i< seed2 #x10000)) 437 (reportbadarg seed2 '(unsignedbyte 16))) 438 (%consrandomstate seed1 seed2)) 426 427 (defun initrandomstateseeds () 428 (let* ((ticks (ldb (byte 32 0) 429 (+ (mixuphashcode (%currenttcr)) 430 (let* ((iface (primaryipinterface))) 431 (or (and iface (ipinterfaceaddr iface)) 432 0)) 433 (mixuphashcode 434 (logand (getinternalrealtime) 435 (1 target::targetmostpositivefixnum)))))) 436 (high (ldb (byte 16 16) (if (zerop ticks) #x10000 ticks))) 437 (low (ldb (byte 16 0) ticks))) 438 (declare (fixnum high low)) 439 (values high low))) 440 441 (defun %consmrg31k3pstate (x0 x1 x2 x3 x4 x5) 442 (let ((array (makearray 6 :elementtype '(unsignedbyte 32) 443 :initialcontents (list x0 x1 x2 x3 x4 x5)))) 444 (%istruct 'randomstate array))) 445 446 (defun initializemrg31k3pstate (x0 x1 x2 x3 x4 x5) 447 (let ((args (list x0 x1 x2 x3 x4 x5))) 448 (declare (dynamicextent args)) 449 (dolist (a args) 450 (unless (and (fixnump a) (%i<= 0 a) (< a mrg31k3plimit)) 451 (reportbadarg a `(integer 0 (,mrg31k3plimit))))) 452 (when (and (zerop x0) (zerop x1) (zerop x2)) 453 (error "The first three arguments must not all be zero.")) 454 (when (and (zerop x3) (zerop x4) (zerop x5)) 455 (error "The second three arguments must not all be zero.")) 456 (%consmrg31k3pstate x0 x1 x2 x3 x4 x5))) 457 458 (defun randommrg31k3pstate () 459 (loop repeat 6 460 for n = (initrandomstateseeds) 461 ;; The first three seed elements must not be all zero, and 462 ;; likewise for the second three. Avoid the issue by 463 ;; excluding zero values. 464 collect (1+ (mod n (1 mrg31k3plimit))) into seed 465 finally (return (apply #'%consmrg31k3pstate seed)))) 466 467 (defun initialrandomstate () 468 (initializemrg31k3pstate 12345 12345 12345 12345 12345 12345)) 439 469 440 470 (defun makerandomstate (&optional state) 441 "Make a random state object. If STATE is not supplied, return a copy 442 of the default random state. If STATE is a random state, then return a 443 copy of it. If STATE is T then return a random state generated from 444 the universal time." 445 (let* ((seed1 0) 446 (seed2 0)) 447 (if (eq state t) 448 (multiplevaluesetq (seed1 seed2) (initrandomstateseeds)) 449 (progn 450 (setq state (requiretype (or state *randomstate*) 'randomstate)) 451 #+32bittarget 452 (setq seed1 (random.seed1 state) seed2 (random.seed2 state)) 453 #+64bittarget 454 (let* ((seed (random.seed1 state))) 455 (declare (type (unsignedbyte 32) seed)) 456 (setq seed1 (ldb (byte 16 16) seed) 457 seed2 (ldb (byte 16 0) seed))))) 458 (%consrandomstate seed1 seed2))) 471 "Make a new random state object. If STATE is not supplied, return a 472 copy of the current random state. If STATE is a random state, then 473 return a copy of it. If STATE is T then return a randomly 474 initialized random state." 475 (if (eq state t) 476 (randommrg31k3pstate) 477 (progn 478 (setq state (requiretype (or state *randomstate*) 'randomstate)) 479 (let ((seed (coerce (random.mrg31k3pstate state) 'list))) 480 (apply #'%consmrg31k3pstate seed))))) 459 481 460 482 (defun randomstatep (thing) (istructtypep thing 'randomstate)) 483 484 (defun %randomstateequalp (x y) 485 ;; x and y are both randomstate objects 486 (equalp (random.mrg31k3pstate x) (random.mrg31k3pstate y))) 461 487 462 488 ;;; transcendental stuff. Should go in level0;l0float
Note: See TracChangeset
for help on using the changeset viewer.