From: Matt Birkholz <matt@birchwood-abbey.net>
Date: Tue, 5 Jun 2018 17:11:05 +0000 (-0700)
Subject: Add thread-get and thread-put! for e.g. giving threads names.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~6^2~11
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b062deb22764c244a0150abfcada3ade34d45d8b;p=mit-scheme.git

Add thread-get and thread-put! for e.g. giving threads names.
---

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index fd3f32731..368368723 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4995,8 +4995,10 @@ USA.
 	  thread-continuation
 	  thread-dead?
 	  thread-execution-state
+	  thread-get
 	  thread-mutex-owner
 	  thread-mutex?
+	  thread-put!
 	  thread-timer-interval
 	  thread?
 	  threads-list
diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index 693aacd28..0ca02f92b 100644
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -99,6 +99,14 @@ USA.
 (define (thread-dead? thread)
   (guarantee thread? thread 'thread-dead?)
   (eq? 'dead (thread/execution-state thread)))
+
+(define (thread-get thread property)
+  (guarantee thread? thread 'thread-get)
+  (1d-table/get (thread/properties thread) property #f))
+
+(define (thread-put! thread property value)
+  (guarantee thread? thread 'thread-put!)
+  (1d-table/put! (thread/properties thread) property value))
 
 (define thread-population)
 (define first-running-thread)