From a987d443ea0935bfdfa2eb8547218fef9730a14f Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Thu, 27 Apr 2006 15:56:50 +0000 Subject: [PATCH] 0.9.12.3: Make all internals calls to RANDOM use their own random states instead of *RANDOM-STATE*. --- NEWS | 1 + src/code/typedefs.lisp | 8 +++++++- src/pcl/cache.lisp | 5 ++++- src/pcl/dfun.lisp | 3 ++- tests/compiler.pure.lisp | 13 +++++++++++++ version.lisp-expr | 2 +- 6 files changed, 28 insertions(+), 4 deletions(-) diff --git a/NEWS b/NEWS index 487e684..b14071b 100644 --- a/NEWS +++ b/NEWS @@ -2,6 +2,7 @@ changes in sbcl-0.9.13 relative to sbcl-0.9.12: * new feature: source path information is generated for macro-expansion errors for use in IDE's like Slime (thanks to Helmut Eller) + * bug fix: calls to the compiler no longer modify *RANDOM-STATE* changes in sbcl-0.9.12 relative to sbcl-0.9.11: * minor incompatible change: in sbcl-0.9.11 (but not earlier diff --git a/src/code/typedefs.lisp b/src/code/typedefs.lisp index 2aca4c3..340d3dd 100644 --- a/src/code/typedefs.lisp +++ b/src/code/typedefs.lisp @@ -59,6 +59,8 @@ ;;; DEFVARs for these come later, after we have enough stuff defined. (declaim (special *wild-type* *universal-type* *empty-type*)) +(defvar *type-random-state*) + ;;; the base class for the internal representation of types (def!struct (ctype (:conc-name type-) (:constructor nil) @@ -77,7 +79,11 @@ (enumerable nil :read-only t) ;; an arbitrary hash code used in EQ-style hashing of identity ;; (since EQ hashing can't be done portably) - (hash-value (random #.(ash 1 15)) + (hash-value (random #.(ash 1 15) + (if (boundp '*type-random-state*) + *type-random-state* + (setf *type-random-state* + (make-random-state)))) :type (and fixnum unsigned-byte) :read-only t) ;; Can this object contain other types? A global property of our diff --git a/src/pcl/cache.lisp b/src/pcl/cache.lisp index 4b0fbc4..313d96d 100644 --- a/src/pcl/cache.lisp +++ b/src/pcl/cache.lisp @@ -1160,6 +1160,8 @@ (do-one-fill wrappers value)) (maybe-check-cache ncache))))) +(defvar *pcl-misc-random-state* (make-random-state)) + ;;; This is the heart of the cache filling mechanism. It implements ;;; the decisions about where entries are placed. ;;; @@ -1196,7 +1198,8 @@ (when (>= osep limit) (return-from find-free-cache-line (values primary nil))) (when (cond ((= nsep limit) t) - ((= nsep osep) (zerop (random 2))) + ((= nsep osep) + (zerop (random 2 *pcl-misc-random-state*))) ((> nsep osep) t) (t nil)) ;; See whether we can displace what is in this line so that we diff --git a/src/pcl/dfun.lisp b/src/pcl/dfun.lisp index ab34a56..1db2f02 100644 --- a/src/pcl/dfun.lisp +++ b/src/pcl/dfun.lisp @@ -987,7 +987,8 @@ Except see also BREAK-VICIOUS-METACIRCLE. -- CSR, 2003-05-28 ;; which are the parameters of the new state, and get other ;; information from the lexical variables bound above. (flet ((two-class (index w0 w1) - (when (zerop (random 2)) (psetf w0 w1 w1 w0)) + (when (zerop (random 2 *pcl-misc-random-state*)) + (psetf w0 w1 w1 w0)) (dfun-update gf #'make-two-class-accessor-dfun ntype diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index 4b0af78..213aaa7 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -2086,3 +2086,16 @@ (f (compile nil l))) (assert (funcall f :good)) (assert (nth-value 1 (ignore-errors (funcall f 42))))) + +;;; Check that the compiler doesn't munge *RANDOM-STATE*. +(let* ((state (make-random-state)) + (*random-state* (make-random-state state)) + (a (random most-positive-fixnum))) + (setf *random-state* state) + (compile nil `(lambda (x a) + (declare (single-float x) + (type (simple-array double-float) a)) + (+ (loop for i across a + summing i) + x))) + (assert (= a (random most-positive-fixnum)))) diff --git a/version.lisp-expr b/version.lisp-expr index 70626aa..291b8b1 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.12.2" +"0.9.12.3" -- 1.7.10.4