(FILECREATED "24-Jun-86 21:36:15" {ERIS}<LISPCORE>LIBRARY>CMLRAND.;20 10945
changes to: (FNS %%RAND3)
previous date: "17-Jun-86 22:42:02" {ERIS}<LISPCORE>LIBRARY>CMLRAND.;19)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT CMLRANDCOMS)
(RPAQQ CMLRANDCOMS ((* * CMLRAND -- Covers section 12.9, random numbers. -- By Kelly Roach. *)
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS (RANDOM-CONST-A 8373)
(RANDOM-CONST-C 101010101)
(RANDOM-UPPER-BOUND 134217726)
(RANDOM-MAX 54)
(RANDOM-FIXNUM-LENGTH 16)
(RANDOM-FLOAT-MANTISSA-LENGTH 23)))
(INITVARS (%%*RANDOM-SEED* 0)
(*RANDOM-STATE* NIL))
(GLOBALVARS *RANDOM-STATE*)
(STRUCTURES RANDOM-STATE)
(FNS RANDOM MAKE-RANDOM-STATE)
(FNS %%RAND1 %%RAND3 %%RANDOM-SEED %%RANDOM-INIT %%RANDOM-COPY-STATE)
(P (%%RANDOM-INIT))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS
(NLAMA)
(NLAML)
(LAMA RANDOM)))))
(* * CMLRAND -- Covers section 12.9, random numbers. -- By Kelly Roach. *)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ RANDOM-CONST-A 8373)
(RPAQQ RANDOM-CONST-C 101010101)
(RPAQQ RANDOM-UPPER-BOUND 134217726)
(RPAQQ RANDOM-MAX 54)
(RPAQQ RANDOM-FIXNUM-LENGTH 16)
(RPAQQ RANDOM-FLOAT-MANTISSA-LENGTH 23)
(CONSTANTS (RANDOM-CONST-A 8373)
(RANDOM-CONST-C 101010101)
(RANDOM-UPPER-BOUND 134217726)
(RANDOM-MAX 54)
(RANDOM-FIXNUM-LENGTH 16)
(RANDOM-FLOAT-MANTISSA-LENGTH 23))
)
)
(RPAQ? %%*RANDOM-SEED* 0)
(RPAQ? *RANDOM-STATE* NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS *RANDOM-STATE*)
)
(DEFSTRUCT (RANDOM-STATE (:CONSTRUCTOR MAKE-RANDOM-OBJECT)) (J 24 :TYPE INTEGER) (K 0 :TYPE INTEGER)
(SEED (%%RANDOM-SEED
)
:TYPE
(SIMPLE-VECTOR
CL:* FIXNUM)))
(DEFINEQ
(RANDOM
(CL:LAMBDA (ARG &OPTIONAL (STATE *RANDOM-STATE*)) (* kbr: "17-Jun-86 22:38")
(* Generate a uniformly distributed
pseudo-random number between zero and
ARG %. STATE if supplied, is the
random state to use.
*)
(CL:UNLESS (PLUSP ARG)
(CL:ERROR "Non-positive argument, ~A, to RANDOM." ARG))
(TYPECASE ARG (FIXNUM (REM (%%RAND3 STATE)
ARG))
(FLOAT (CL:* ARG (/ (RANDOM (ASH 2 RANDOM-FLOAT-MANTISSA-LENGTH)
STATE)
(ASH 2 RANDOM-FLOAT-MANTISSA-LENGTH))))
(INTEGER (CL:DO ((TOT (%%RAND3 STATE)
(+ (ASH TOT RANDOM-FIXNUM-LENGTH)
(%%RAND3 STATE)))
(END (ASH ARG (- RANDOM-FIXNUM-LENGTH))
(ASH END (- RANDOM-FIXNUM-LENGTH))))
((ZEROP END)
(CL:MOD TOT ARG))))
(T (CL:ERROR "Wrong type argument, ~A, to RANDOM." ARG)))))
(MAKE-RANDOM-STATE
(CL:LAMBDA (&OPTIONAL STATE) (* kbr: "31-Mar-86 11:18")
(* Make a random state object. If State is not supplied, return a copy of the
default random state. If State is a random state, then return a copy of it.
If state is T then return a random state generated from the universal time.
*)
(COND
((NOT STATE)
(%%RANDOM-COPY-STATE *RANDOM-STATE*))
((RANDOM-STATE-P STATE)
(%%RANDOM-COPY-STATE STATE))
((EQ STATE T)
(SETQ %%*RANDOM-SEED* (GET-UNIVERSAL-TIME))
(MAKE-RANDOM-OBJECT))
(T (CL:ERROR "Bad argument, ~A, for RANDOM-STATE." STATE)))))
)
(DEFINEQ
(%%RAND1
(CL:LAMBDA NIL (* kbr: "27-May-86 17:14")
(* Generates a random number from
%%*RANDOM-SEED*. *)
(SETQ %%*RANDOM-SEED* (CL:MOD (+ (CL:* %%*RANDOM-SEED* RANDOM-CONST-A)
RANDOM-CONST-C)
(1+ RANDOM-UPPER-BOUND)))))
(%%RAND3
(CL:LAMBDA (STATE) (* kbr: "24-Jun-86 21:35")
(* %%RAND3 -- Internal This function generates fixnums between 0 and
RANDOM-UPPER-BOUND, inclusive For the algorithm to work RANDOM-UPPER-BOUND must
be an even positive fixnum. STATE is the random state to use.
*)
(LET ((SEED (RANDOM-STATE-SEED STATE))
(J (RANDOM-STATE-J STATE))
(K (RANDOM-STATE-K STATE)))
(SETF (SVREF SEED K)
(LET ((A (- RANDOM-UPPER-BOUND (SVREF SEED (SETF (RANDOM-STATE-J STATE)
(CL:IF (= J 0)
RANDOM-MAX
(1- J))))
(SVREF SEED (SETF (RANDOM-STATE-K STATE)
(CL:IF (= K 0)
RANDOM-MAX
(1- K)))))))
(CL:IF (MINUSP A)
(- A)
(- RANDOM-UPPER-BOUND A)))))))
(%%RANDOM-SEED
(LAMBDA NIL (* kbr: "28-May-86 23:33")
(MAKE-ARRAY (1+ RANDOM-MAX)
:INITIAL-CONTENTS
(for I from 1 to RANDOM-MAX collect (%%RAND1)))))
(%%RANDOM-INIT
(CL:LAMBDA NIL (* kbr: "31-Mar-86 09:46")
(PROG NIL
(SETQ *RANDOM-STATE*
(MAKE-RANDOM-OBJECT :SEED
(MAKE-ARRAY (1+ RANDOM-MAX)
:INITIAL-CONTENTS
(QUOTE (45117816 133464727 86324180 99419799 68851957 87250180 52971860
84081967 30854110 121122797 70449044 18801152 45149898
15881380 27398356 117706009 49915564 80620628 120974070
98193932 43883764 53717012 100954825 82579490 17280729
118523949 42282975 127220348 6288263 56575578 2474156 47934425
561006 21989698 74046730 105055318 113363907 48749716 78183593
109613585 37323232 65101428 46453209 76906562 5371267 86544820
33922642 60765033 41889257 77176406 38775255 78514879 72553872
66916641 100613180))))))))
(%%RANDOM-COPY-STATE
(CL:LAMBDA (CUR-STATE) (* kbr: "31-Mar-86 11:43")
(PROG (STATE)
(SETQ STATE (MAKE-RANDOM-OBJECT :SEED (MAKE-ARRAY (1+ RANDOM-MAX))
:J
(RANDOM-STATE-J CUR-STATE)
:K
(RANDOM-STATE-K CUR-STATE)))
(for I from 0 to RANDOM-MAX do (SETF (AREF (RANDOM-STATE-SEED STATE)
I)
(AREF (RANDOM-STATE-SEED CUR-STATE)
I)))
(RETURN STATE))))
)
(%%RANDOM-INIT)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA RANDOM)
)
(PRETTYCOMPRINT CMLRANDCOMS)
(RPAQQ CMLRANDCOMS ((* * CMLRAND -- Covers section 12.9, random numbers. -- By Kelly Roach. *)
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS (RANDOM-CONST-A 8373)
(RANDOM-CONST-C 101010101)
(RANDOM-UPPER-BOUND 134217726)
(RANDOM-MAX 54)
(RANDOM-FIXNUM-LENGTH 16)
(RANDOM-FLOAT-MANTISSA-LENGTH 23)))
(INITVARS (%%*RANDOM-SEED* 0)
(*RANDOM-STATE* NIL))
(GLOBALVARS *RANDOM-STATE*)
(STRUCTURES RANDOM-STATE)
(FNS RANDOM MAKE-RANDOM-STATE)
(FNS %%RAND1 %%RAND3 %%RANDOM-SEED %%RANDOM-INIT %%RANDOM-COPY-STATE)
(P (%%RANDOM-INIT))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML)
(LAMA %%RANDOM-COPY-STATE %%RANDOM-INIT %%RAND3 %%RAND1
MAKE-RANDOM-STATE RANDOM)))))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA %%RANDOM-COPY-STATE %%RANDOM-INIT %%RAND3 %%RAND1 MAKE-RANDOM-STATE RANDOM)
)
(PUTPROPS CMLRAND COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2948 5200 (RANDOM 2958 . 4452) (MAKE-RANDOM-STATE 4454 . 5198)) (5201 9160 (%%RAND1
5211 . 5693) (%%RAND3 5695 . 7032) (%%RANDOM-SEED 7034 . 7290) (%%RANDOM-INIT 7292 . 8439) (
%%RANDOM-COPY-STATE 8441 . 9158)))))
STOP