Serialize access to the population-of-1d-tables.

Allow create-thread to be run by multiple threads concurrently while
still accessing the population-of-1d-tables serially.

diff --git a/src/runtime/prop1d.scm b/src/runtime/prop1d.scm
index 223c1e9f4bea7d60d84b2a9aed844b91ca30a6be..e4e9e360fa5b52865ff908348794d888568ce4fe 100644 (file)
--- a/src/runtime/prop1d.scm
+++ b/src/runtime/prop1d.scm
@@ -30,8 +30,8 @@ USA.
 (declare (usual-integrations))
 \f
 (define (initialize-package!)
-  (set! population-of-1d-tables (make-population/unsafe))
-  (add-secondary-gc-daemon! gc-1d-tables!))
+  (set! population-of-1d-tables (make-serial-population/unsafe))
+  (add-secondary-gc-daemon! clean-1d-tables!))
 
 (define (initialize-unparser!)
   (unparser/set-tagged-pair-method! 1d-table-tag
@@ -39,10 +39,15 @@ USA.
 
 (define population-of-1d-tables)
 
-(define (gc-1d-tables!)
-  (map-over-population! population-of-1d-tables 1d-table/clean!))
+(define (clean-1d-tables!)
+  (for-each-inhabitant population-of-1d-tables 1d-table/clean!))
 
 (define (make-1d-table)
+  (let ((table (list 1d-table-tag)))
+    (add-to-population! population-of-1d-tables table)
+    table))
+
+(define (make-1d-table/unsafe)
   (let ((table (list 1d-table-tag)))
     (add-to-population!/unsafe population-of-1d-tables table)
     table))

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index b5f1bab6a0032746b62d9ca4fb4061eb30a2c7a3..858eea49f3faef907074086ce2aec7551394aa16 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1110,7 +1110,7 @@ USA.
          1d-table?
          make-1d-table)
   (import (runtime population)
-         make-population/unsafe
+         make-serial-population/unsafe
          add-to-population!/unsafe)
   (initialization (initialize-package!)))
 
@@ -5067,6 +5067,8 @@ USA.
   (import (runtime population)
          add-to-population!/unsafe
          make-population/unsafe)
+  (import (runtime 1d-property)
+         make-1d-table/unsafe)
   (export (runtime interrupt-handler)
          thread-timer-interrupt-handler)
   (export (runtime primitive-io)

diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index 000ae1888406dee3971dc018ba8d63138873fe0e..8bd9bafb92b0173bbff7416e98c6d8470eaec784 100644 (file)
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -48,7 +48,7 @@ USA.
       (without-interrupts thunk)))
 \f
 (define-structure (thread
-                  (constructor %make-thread ())
+                  (constructor %make-thread (properties))
                   (conc-name thread/))
   (execution-state 'RUNNING)
   ;; One of:
@@ -97,7 +97,7 @@ USA.
   ;; List of mutexes that this thread owns or is waiting to own.  Used
   ;; to disassociate the thread from those mutexes when it is exited.
 
-  (properties (make-1d-table) read-only #t))
+  (properties #f read-only #t))
 
 (define-integrable (guarantee-thread thread procedure)
   (if (not (thread? thread))
@@ -124,7 +124,7 @@ USA.
   (set! timer-records #f)
   (set! timer-interval 100)
   (reset-threads-low!)
-  (let ((first (%make-thread)))
+  (let ((first (%make-thread (make-1d-table/unsafe))))
     (set-thread/exit-value! first detached-thread-marker)
     (set-thread/root-state-point! first
                                  (current-state-point state-space:local))
@@ -172,7 +172,7 @@ USA.
   unspecific)
 
 (define (make-thread continuation)
-  (let ((thread (%make-thread)))
+  (let ((thread (%make-thread (make-1d-table))))
     (set-thread/continuation! thread continuation)
     (set-thread/root-state-point! thread
                                  (current-state-point state-space:local))