From 4319583316d983f067e1fb466f853453fc8c21d1 Mon Sep 17 00:00:00 2001
From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Wed, 1 Jul 2015 07:34:59 -0700
Subject: [PATCH] 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.
---
 src/runtime/prop1d.scm  | 13 +++++++++----
 src/runtime/runtime.pkg |  4 +++-
 src/runtime/thread.scm  |  8 ++++----
 3 files changed, 16 insertions(+), 9 deletions(-)

diff --git a/src/runtime/prop1d.scm b/src/runtime/prop1d.scm
index 223c1e9f4..e4e9e360f 100644
--- a/src/runtime/prop1d.scm
+++ b/src/runtime/prop1d.scm
@@ -30,8 +30,8 @@ USA.
 (declare (usual-integrations))
 
 (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 b5f1bab6a..858eea49f 100644
--- 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 000ae1888..8bd9bafb9 100644
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -48,7 +48,7 @@ USA.
       (without-interrupts thunk)))
 
 (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))
-- 
2.25.1