smp: without-interrupts: random.scm

diff --git a/README.txt b/README.txt
index 5b3d80f3a0af9d3bba6e3dd0a179bfe54b23fef5..b87b351f9079ac14d3b2a59d94ff97fc1a2a7f60 100644 (file)
--- 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 6fbcc33f716598b4be8279eda80569ca680a3863..55b0d283dd0c34273df24cc497ec7de5ac7c126a 100644 (file)
--- 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)