From: Tobias C. Rittweiler <trittweiler@users.sourceforge.net>
Date: Sat, 3 Apr 2010 13:25:34 +0000 (+0000)
Subject: 1.0.37.30: OAOOize type of NAME slots between THREAD, MUTEX &c.
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=17fc7b64d2125ab8cb9d19c5e730c8ea5de38d1b;p=sbcl.git

1.0.37.30: OAOOize type of NAME slots between THREAD, MUTEX &c.

  * Introduce new type THREAD-NAME; it expands to SIMPLE-STRING for
    now; that's what some of the thread-related data structures
    (MUTEX, WAITQUEUE) used in past whereas others allowed anything
    (THREAD).

  * Use that type consistently for THREADs, MUTEXes, WAITQUEUES,
    SPINLOCKs and SEMAPHOREs.
---

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index 2e5edfa..dbc145d 100644
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -500,7 +500,7 @@ IF-NOT-OWNER is :FORCE)."
 (defstruct (waitqueue (:constructor %make-waitqueue))
   #!+sb-doc
   "Waitqueue type."
-  (name nil :type (or null simple-string))
+  (name nil :type (or null thread-name))
   #!+(and sb-lutex sb-thread)
   (lutex (make-lutex))
   #!-sb-lutex
@@ -642,8 +642,8 @@ this call."
   "Semaphore type. The fact that a SEMAPHORE is a STRUCTURE-OBJECT
 should be considered an implementation detail, and may change in the
 future."
-  (name nil :type (or null simple-string))
-  (%count 0 :type (integer 0))
+  (name    nil :type (or null thread-name))
+  (%count    0 :type (integer 0))
   (waitcount 0 :type sb!vm:word)
   (mutex (make-mutex))
   (queue (make-waitqueue)))
diff --git a/src/code/thread.lisp b/src/code/thread.lisp
index dc92196..7a2e567 100644
--- a/src/code/thread.lisp
+++ b/src/code/thread.lisp
@@ -11,25 +11,32 @@
 
 (in-package "SB!THREAD")
 
+(def!type thread-name ()
+  'simple-string)
+
 (def!struct (thread (:constructor %make-thread))
   #!+sb-doc
   "Thread type. Do not rely on threads being structs as it may change
 in future versions."
-  name
-  %alive-p
-  os-thread
-  interruptions
-  (interruptions-lock (make-mutex :name "thread interruptions lock"))
-  result
-  (result-lock (make-mutex :name "thread result lock")))
+  (name          nil :type (or thread-name null))
+  (%alive-p      nil :type boolean)
+  (os-thread     nil :type (or integer null))
+  (interruptions nil :type list)
+  (result        nil :type list)
+  (interruptions-lock
+   (make-mutex :name "thread interruptions lock")
+   :type mutex)
+  (result-lock
+   (make-mutex :name "thread result lock")
+   :type mutex))
 
 (def!struct mutex
   #!+sb-doc
   "Mutex type."
-  (name nil :type (or null simple-string))
+  (name   nil :type (or null thread-name))
   (%owner nil :type (or null thread))
   #!+(and (not sb-lutex) sb-thread)
-  (state 0 :type fixnum)
+  (state    0 :type fixnum)
   #!+(and sb-lutex sb-thread)
   (lutex (make-lutex)))
 
@@ -60,7 +67,7 @@ stale value, use MUTEX-OWNER instead."
 (def!struct spinlock
   #!+sb-doc
   "Spinlock type."
-  (name nil :type (or null simple-string))
+  (name  nil :type (or null thread-name))
   (value nil))
 
 (sb!xc:defmacro with-mutex ((mutex &key (value '*current-thread*) (wait-p t))
diff --git a/version.lisp-expr b/version.lisp-expr
index bbe15b8..d0ef31b 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.37.29"
+"1.0.37.30"