Changeset 13313 for branches/newrandom/level1/l1numbers.lisp
 Timestamp:
 Dec 21, 2009, 11:54:55 PM (10 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

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