From 5cd4631c0b3eb2db11bf81c7d991177f41013990 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Wed, 13 Jan 1993 08:48:49 +0000 Subject: [PATCH] Install new version of RANDOM from slib1c4. --- v7/src/runtime/random.scm | 160 ++++++++++++++++++++++++------------- v7/src/runtime/runtime.pkg | 6 +- v8/src/runtime/runtime.pkg | 6 +- 3 files changed, 113 insertions(+), 59 deletions(-) diff --git a/v7/src/runtime/random.scm b/v7/src/runtime/random.scm index 7feefb409..ccabe1bb2 100644 --- a/v7/src/runtime/random.scm +++ b/v7/src/runtime/random.scm @@ -1,62 +1,112 @@ -#| -*-Scheme-*- +;;;; Pseudo-Random number generator for scheme. +;;; Copyright (C) 1991 Aubrey Jaffer. +;;; From slib1c4, modified for MIT Scheme by cph. +;;; $Id: random.scm,v 14.4 1993/01/13 08:48:34 cph Exp $ +;;; +;;; (random n) procedure +;;; (random n state) procedure +;;; +;;; Accepts a positive integer or real n and returns a number of the +;;; same type between zero (inclusive) and n (exclusive). The values +;;; returned have a uniform distribution. +;;; +;;; The optional argument state must be of the type produced by +;;; (make-random-state). It defaults to the value of the variable +;;; *random-state*. This object is used to maintain the state of the +;;; pseudo-random-number generator and is altered as a side effect of the +;;; RANDOM operation. +;;; +;;; *random-state* variable +;;; +;;; Holds a data structure that encodes the internal state of the +;;; random-number generator that RANDOM uses by default. The nature of +;;; this data structure is implementation-dependent. It may be printed +;;; out and successfully read back in, but may or may not function +;;; correctly as a random-number state object in another implementation. +;;; +;;; (make-random-state) procedure +;;; (make-random-state state) procedure +;;; +;;; Returns a new object of type suitable for use as the value of the +;;; variable *random-state* and as second argument to RANDOM. If argument +;;; state is given, a copy of it is returned. Otherwise a copy of +;;; *random-state* is returned. +;;;------------------------------------------------------------------ + +(define random + (let ((state-tap-1 24) + (state-size 55) + (chunk-size 24) + (chunk-sup #x1000000)) -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/random.scm,v 14.3 1989/10/26 06:46:47 cph Rel $ + (define (get-bits n state) + (let loop ((n n)) + (let ((p (vector-ref state state-size))) + (let ((i (fix:modulo (fix:- p state-tap-1) state-size)) + (chunk (vector-ref state p))) + (vector-set! state p (fix:xor (vector-ref state i) chunk)) + (vector-set! state state-size (fix:modulo (fix:- p 1) state-size)) + (cond ((fix:= n chunk-size) + chunk) + ((fix:< n chunk-size) + (fix:and chunk (fix:- (fix:lsh 1 n) 1))) + (else + (+ chunk (* chunk-sup (loop (fix:- n chunk-size)))))))))) -Copyright (c) 1988, 1989 Massachusetts Institute of Technology + (define (fix:modulo n d) + ;; Specialized for nonnegative D. + (let ((r (fix:remainder n d))) + (if (or (fix:= r 0) + (not (fix:< n 0))) + r + (fix:+ r d)))) -This material was developed by the Scheme project at the Massachusetts -Institute of Technology, Department of Electrical Engineering and -Computer Science. Permission to copy this software, to redistribute -it, and to use it for any purpose is granted, subject to the following -restrictions and understandings. + (lambda (modulus #!optional state) + (if (not (and (exact-integer? modulus) (> modulus 0))) + (error:wrong-type-argument modulus "exact positive integer" 'RANDOM)) + (let ((state (if (default-object? state) *random-state* state))) + (if (not (random-state? state)) + (error:wrong-type-argument state + "random number state" + 'MAKE-RANDOM-STATE)) + (let ((ilen (exact-nonnegative-integer-length modulus)) + (state (random-state-bits state))) + (do ((r (get-bits ilen state) + (get-bits ilen state))) ;this could be improved. + ((< r modulus) r))))))) -1. Any copy made of this software must include this copyright notice -in full. +(define-structure (random-state (constructor %make-random-state)) + (bits false read-only true)) -2. Users of this software agree to make their best efforts (a) to -return to the MIT Scheme project any improvements or extensions that -they make, so that these may be included in future releases; and (b) -to inform MIT of noteworthy uses of this software. +(define (make-random-state #!optional state) + (let ((state (if (default-object? state) *random-state* state))) + (if (not (random-state? state)) + (error:wrong-type-argument state + "random number state" + 'MAKE-RANDOM-STATE)) + (%make-random-state (vector-copy (random-state-bits state))))) -3. All materials developed as a consequence of the use of this -software shall duly acknowledge such use, in accordance with the usual -standards of acknowledging credit in academic research. +(define *random-state* + (%make-random-state + (vector #xd909ef #xfd330a #xe33f78 #x76783f #xf3675f + #xb54ef8 #x0be455 #xa67946 #x0bcd56 #xfabcde + #x9cbd3e #x3fd3ef #xe064ef #xdddecc #x344442 + #x854444 #x4c5192 #xc03662 #x547345 #x70abcd + #x1bbdac #x616c5a #xa982ef #x105996 #x5f0ccc + #x1ea055 #xfe2acd #x1891c1 #xe66902 #x6912bc + #x2678e1 #x612222 #x907abc #x4ad682 #x9cdd14 + #x577988 #x5b8924 #x871c9c #xd1e67b #x8b0a32 + #x578ef2 #x28274e #x823ef5 #x845678 #xe67890 + #x5890ab #x851fa9 #x13efa1 #xb12278 #xdaf805 + #xa0befc #x0068a7 #xe024fd #xa7b690 #x27f357 + 0))) -4. MIT has made no warrantee or representation that the operation of -this software will be error-free, and MIT is under no obligation to -provide any services, by way of maintenance, update, or otherwise. - -5. In conjunction with products arising from the use of this material, -there shall be no use of the name of the Massachusetts Institute of -Technology nor of any adaptation thereof in any advertising, -promotional, or sales literature without prior written consent from -MIT in each case. |# - -;;;; Random Number Generator -;;; package: (runtime random-number) - -(declare (usual-integrations)) - -(define seed) -(define a) -(define m) -(define c) - -(define (initialize-package!) - (set! seed 1) - (set! a (+ (* 3141 1000 1000) (* 592 1000) 621)) - (set! m (expt 2 63)) - (set! c 1) - unspecific) - -(define (random k) - (if (not (and (exact-integer? k) (<= 1 k m))) - (error "RANDOM is valid only for exact integers from 1 to" m)) - (set! seed (remainder (+ (* a seed) c) m)) - (quotient (* seed k) m)) - -(define (randomize k) - (if (not (and (exact-integer? k) (<= 1 k m))) - (error "RANDOMIZE is valid only for exact integers from 1 to" m)) - (set! seed k) - unspecific) \ No newline at end of file +(define exact-nonnegative-integer-length + (let ((powers-of-two + (let loop ((n 1)) + (cons n (delay (loop (* 2 n))))))) + (lambda (n) + (let loop ((powers-of-two powers-of-two) (e 0)) + (if (< n (car powers-of-two)) + e + (loop (force (cdr powers-of-two)) (fix:+ e 1))))))) \ No newline at end of file diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index 258ef2dad..2ecf678de 100644 --- a/v7/src/runtime/runtime.pkg +++ b/v7/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: runtime.pkg,v 14.170 1993/01/12 23:12:24 gjr Exp $ +$Id: runtime.pkg,v 14.171 1993/01/13 08:48:49 cph Exp $ Copyright (c) 1988-1993 Massachusetts Institute of Technology @@ -1687,8 +1687,10 @@ MIT in each case. |# (files "random") (parent ()) (export () + *random-state* + make-random-state random - randomize) + random-state?) (initialization (initialize-package!))) (define-package (runtime record) diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg index 258ef2dad..2ecf678de 100644 --- a/v8/src/runtime/runtime.pkg +++ b/v8/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: runtime.pkg,v 14.170 1993/01/12 23:12:24 gjr Exp $ +$Id: runtime.pkg,v 14.171 1993/01/13 08:48:49 cph Exp $ Copyright (c) 1988-1993 Massachusetts Institute of Technology @@ -1687,8 +1687,10 @@ MIT in each case. |# (files "random") (parent ()) (export () + *random-state* + make-random-state random - randomize) + random-state?) (initialization (initialize-package!))) (define-package (runtime record) -- 2.25.1