From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Wed, 1 Jul 2015 14:34:59 +0000 (-0700)
Subject: Serialize access to the population-of-1d-tables.
X-Git-Tag: mit-scheme-pucked-9.2.12~376^2~35
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1ff514a49f243cea6bc1224931b14ab47414de15;p=mit-scheme.git

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 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 e8263956d..260d23022 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1131,7 +1131,7 @@ USA.
 	  1d-table?
 	  make-1d-table)
   (import (runtime population)
-	  make-population/unsafe
+	  make-serial-population/unsafe
 	  add-to-population!/unsafe)
   (initialization (initialize-package!)))
 
@@ -5094,6 +5094,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 6074bbb48..13d2eed7d 100644
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -33,7 +33,7 @@ USA.
 (define enable-smp? #f)
 
 (define-structure (thread
-		   (constructor %make-thread ())
+		   (constructor %make-thread (properties))
 		   (conc-name thread/))
   (execution-state 'RUNNING)
   ;; One of:
@@ -82,7 +82,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))
@@ -110,7 +110,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))
@@ -158,7 +158,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))