(FILECREATED " 2-Sep-86 17:33:58" {ERIS}<ROACH>CML>CMLRAND.;2 10326
changes to: (FNS RANDOM %%RANDOM-COPY-STATE %%PRINT-RANDOM-STATE MAKE-RANDOM-STATE
%%RANDOM-STATE %%RAND3 %%RANDOM-INIT %%RAND1)
(VARS CMLRANDCOMS)
(STRUCTURES RANDOM-STATE)
previous date: " 2-Sep-86 15:45:27" {ERIS}<ROACH>CML>CMLRAND.;1)
(* 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))
(STRUCTURES RANDOM-STATE)
(FNS RANDOM MAKE-RANDOM-STATE %%RANDOM-STATE)
(FNS %%RAND1 %%RAND3 %%RANDOM-SEED %%RANDOM-INIT %%RANDOM-COPY-STATE
%%PRINT-RANDOM-STATE)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (%%RANDOM-INIT)))
(PROP FILETYPE CMLRAND)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML)
(LAMA %%RANDOM-COPY-STATE %%RAND3 %%RAND1 %%RANDOM-STATE
MAKE-RANDOM-STATE 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)
(DEFSTRUCT (RANDOM-STATE (:CONSTRUCTOR %%MAKE-RANDOM-STATE)
(:PRINT-FUNCTION %%PRINT-RANDOM-STATE)) I J)
(DEFINEQ
(RANDOM
(CL:LAMBDA (NUMBER &OPTIONAL (STATE *RANDOM-STATE*)) (* kbr: " 2-Sep-86 17:27")
(CL:UNLESS (PLUSP NUMBER)
(CL:ERROR "RANDOM: ~A not a positive number." NUMBER))
(TYPECASE NUMBER (FIXNUM (IREMAINDER (%%RAND3 STATE)
NUMBER))
(FLOAT (FTIMES NUMBER (FQUOTIENT (FLOAT (%%RAND3 STATE))
(CONSTANT (FLOAT (1+ MAX.SMALLP))))))
(INTEGER (CL:DO ((TOT (%%RAND3 STATE)
(+ (ASH TOT RANDOM-FIXNUM-LENGTH)
(%%RAND3 STATE)))
(END (ASH NUMBER (- RANDOM-FIXNUM-LENGTH))
(ASH END (- RANDOM-FIXNUM-LENGTH))))
((ZEROP END)
(CL:MOD TOT NUMBER))))
(T (CL:ERROR "RANDOM: illegal arg ~A." NUMBER)))))
(MAKE-RANDOM-STATE
(CL:LAMBDA (&OPTIONAL STATE) (* kbr: " 2-Sep-86 16:13")
(* 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
((NULL STATE)
(%%RANDOM-COPY-STATE *RANDOM-STATE*))
((RANDOM-STATE-P STATE)
(%%RANDOM-COPY-STATE STATE))
((EQ STATE T)
(SETQ %%*RANDOM-SEED* (CLOCK))
(%%MAKE-RANDOM-STATE))
(T (CL:ERROR "MAKE-RANDOM-STATE: illegal arg ~A." STATE)))))
(%%RANDOM-STATE
(CL:LAMBDA (&REST NUMBERS) (* kbr: " 2-Sep-86 16:22")
(CL:BLOCK %%RANDOM-STATE (PROG (I J STATE)
(SETQ I (COPY NUMBERS))
(SETQ J (LAST I))
(NCONC J I)
(SETQ STATE (%%MAKE-RANDOM-STATE :I I :J J))
(RETURN STATE)))))
)
(DEFINEQ
(%%RAND1
(CL:LAMBDA NIL (* kbr: " 2-Sep-86 14:05")
(* Generates a random number from
%%*RANDOM-SEED*. *)
(PROG NIL
(SETQ %%*RANDOM-SEED* (CL:MOD (+ (CL:* %%*RANDOM-SEED* RANDOM-CONST-A)
RANDOM-CONST-C)
(1+ RANDOM-UPPER-BOUND)))
(RETURN (LOGAND %%*RANDOM-SEED* MAX.SMALLP)))))
(%%RAND3
(CL:LAMBDA (STATE) (* kbr: " 2-Sep-86 15:43")
(* This function implements the XRAND subroutine described in Stanford memo
STAN-CS-77-601, Analysis of Additive Random Number Generators, by John F.
Reiser, on p 28.0 Rather than storing the X values in an array and computing
indexes I and J, however, we have elected to retain state in a circular list of
51 elements. STATE is (RANDOM-STATE I X J
(NTH X 31)); each time %%RAND3 is called, both I and J of STATE are CDR'ed to
effectively increment the index. In addition, the numbers are stored as 16 bit
binary fractions (i.e. the decimal point is on the left of the 16-bit quantity))
(LET ((I (RANDOM-STATE-I STATE))
(J (RANDOM-STATE-J STATE)))
(SETF (RANDOM-STATE-I STATE)
(CDR I))
(SETF (RANDOM-STATE-J STATE)
(CDR J))
(RPLACA I (LOGAND (IDIFFERENCE (CAR I)
(CAR J))
MAX.SMALLP))
(CAR I))))
(%%RANDOM-SEED
(LAMBDA NIL (* kbr: "16-Jul-86 11:41")
(* Create random SEED array to be put
into a random state.
*)
(MAKE-ARRAY (1+ RANDOM-MAX)
:INITIAL-CONTENTS
(for I from 0 to RANDOM-MAX collect (%%RAND1)))))
(%%RANDOM-INIT
(LAMBDA NIL (* kbr: " 2-Sep-86 15:18")
(* Called when CMLRAND is loaded to
setup the initial contents of
*RANDOM-STATE* *)
(PROG (I J)
(SETQ I
(COPY '(30421 2750 41175 48002 45475 31246 7297 34649 8496 22596 37158 14196 64615 34095
5571 6848 22811 64854 25229 25623 3958 25842 53411 61732 52468 62426 18180
8970 56665 14188 10905 59879 36873 39586 51230 15836 19425 32885 41618 21246
40596 1613 10870 10263 65186 20344 50149 969 53627 42330 40523 26836 33531
41005 37487)))
(SETQ J (LAST I))
(NCONC J I)
(SETQ *RANDOM-STATE* (%%MAKE-RANDOM-STATE :I I :J J)))))
(%%RANDOM-COPY-STATE
(CL:LAMBDA (STATE) (* kbr: " 2-Sep-86 17:06")
(* Called by MAKE-RANDOM-STATE to
return a copy of STATE *)
(PROG (NEW-I NEW-J NEW-STATE) (* NEW-I = copy of circular list.
*)
(SETQ NEW-I (for ELEMENT in (RANDOM-STATE-I STATE) as N from 0 to RANDOM-MAX
collect ELEMENT))
(SETQ NEW-J (LAST NEW-I))
(NCONC NEW-J NEW-I)
(SETQ NEW-STATE (%%MAKE-RANDOM-STATE :I NEW-I :J NEW-J))
(RETURN NEW-STATE))))
(%%PRINT-RANDOM-STATE
(LAMBDA (STATE STREAM) (* kbr: " 2-Sep-86 16:56")
(* Print random state STATE out to STREAM in a way that when the expression
printed is read back in it will be a legal random state.
We need to print the STATE specially because it contains circular structure.
*)
(PROG NIL
(\OUTCHAR STREAM (fetch (READTABLEP HASHMACROCHAR) of *READTABLE*))
(PRIN3 ".'(" STREAM)
(PRIN2 '%%RANDOM-STATE STREAM *READTABLE*)
(for ELEMENT in (RANDOM-STATE-I STATE) as N from 0 to RANDOM-MAX
do (PRIN1 " " STREAM)
(PRIN2 ELEMENT STREAM *READTABLE*))
(PRIN1 ")" STREAM)
(RETURN T))))
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(%%RANDOM-INIT)
)
(PUTPROPS CMLRAND FILETYPE COMPILE-FILE)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA %%RANDOM-COPY-STATE %%RAND3 %%RAND1 %%RANDOM-STATE MAKE-RANDOM-STATE RANDOM)
)
(PUTPROPS CMLRAND COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2666 4945 (RANDOM 2676 . 3677) (MAKE-RANDOM-STATE 3679 . 4456) (%%RANDOM-STATE 4458 .
4943)) (4946 9945 (%%RAND1 4956 . 5551) (%%RAND3 5553 . 6776) (%%RANDOM-SEED 6778 . 7292) (
%%RANDOM-INIT 7294 . 8286) (%%RANDOM-COPY-STATE 8288 . 9115) (%%PRINT-RANDOM-STATE 9117 . 9943)))))
STOP