From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Tue, 10 Mar 2015 21:24:36 +0000 (-0700)
Subject: smp: without-interrupts: random.scm
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=9837305c61c4d8e7250c3fc03c3cd3ff40a9589c;p=mit-scheme.git

smp: without-interrupts: random.scm
---

diff --git a/README.txt b/README.txt
index 5b3d80f3a..b87b351f9 100644
--- a/README.txt
+++ b/README.txt
@@ -1489,8 +1489,19 @@ The hits with accompanying analysis:
 	use define-structure (or even define-syntax!).
 
   random.scm:56:  (let ((mask ((ucode-primitive set-interrupt-enables!) interrupt-mask/gc-ok)))
+	Caller: flo:random-element
   random.scm:78:	((ucode-primitive set-interrupt-enables!) mask)
+	Caller: flo:random-element
   random.scm:360:  (without-interrupts
+	Caller: copy-random-state!
+
+	I assume a random-source/state will not be used by multiple
+	threads, EXCEPT for the default-random-source.  Serialized
+	access to this source only.  Serializing access to ALL random-
+	sources gets us into trouble during the cold loading when the
+	record-type-type is initialized.  Luckily get-dispatch-tag-
+	cache-number uses it own random-source, not the default-
+	random-source.
 
   rbtree.scm:131:	       (without-interrupts
   rbtree.scm:180:(define-integrable (without-interrupts thunk)
diff --git a/src/runtime/random.scm b/src/runtime/random.scm
index 6fbcc33f7..55b0d283d 100644
--- a/src/runtime/random.scm
+++ b/src/runtime/random.scm
@@ -52,8 +52,16 @@ USA.
 (define-integrable b 4294967291 #|(- (expt 2 32) 5)|#)
 (define-integrable b. 4294967291. #|(exact->inexact b)|#)
 
+(define-integrable (with-random-state-locked state thunk)
+  (if (eq? state default-random-source)
+      (with-thread-mutex-locked default-random-source-mutex
+	(lambda ()
+	  (without-interruption thunk)))
+      (thunk)))
+
 (define (flo:random-element state)
-  (let ((mask ((ucode-primitive set-interrupt-enables!) interrupt-mask/gc-ok)))
+  (with-random-state-locked state
+   (lambda ()
     (let ((index (random-state-index state))
 	  (vector (random-state-vector state)))
       (let ((element (flo:vector-ref vector index)))
@@ -75,8 +83,7 @@ USA.
 				   (if (fix:= (fix:+ index 1) r)
 				       0
 				       (fix:+ index 1))))
-	((ucode-primitive set-interrupt-enables!) mask)
-	element))))
+	element)))))
 
 (define-integrable (int:random-element state)
   (flo:truncate->exact (flo:random-element state)))
@@ -357,7 +364,7 @@ USA.
       result)))
 
 (define (copy-random-state! source target)
-  (without-interrupts
+  (with-random-state-locked source
    (lambda ()
      (set-random-state-index! target (random-state-index source))
      (set-random-state-borrow! target (random-state-borrow source))
@@ -387,6 +394,7 @@ USA.
 (define flimit.)
 (define flimit)
 (define default-random-source)
+(define default-random-source-mutex)
 (define random-integer)
 (define random-real)
 
@@ -398,6 +406,7 @@ USA.
 	      (loop (flo:/ x 2.)))))
   (set! flimit (flo:truncate->exact flimit.))
   (set! default-random-source (simple-random-state))
+  (set! default-random-source-mutex (make-thread-mutex))
   (set! random-integer (random-source-make-integers default-random-source))
   (set! random-real (random-source-make-reals default-random-source))
   unspecific)