X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fthread.lisp;h=3d1ecd4086c76206f96621797818c88c0c1c7a2a;hb=829ced3e78a23ba153ba4db64e6ea6984c2313b6;hp=f73c9bd6eff758308b167583568d0455e3539cf9;hpb=239125681cb03e2cce08a50e9bf03589956fd125;p=sbcl.git

diff --git a/src/code/thread.lisp b/src/code/thread.lisp
index f73c9bd..3d1ecd4 100644
--- a/src/code/thread.lisp
+++ b/src/code/thread.lisp
@@ -11,6 +11,9 @@
 
 (in-package "SB!THREAD")
 
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (sb!xc:proclaim '(sb!ext:always-bound *current-thread*)))
+
 (def!type thread-name ()
   'simple-string)
 
@@ -20,6 +23,7 @@
 in future versions."
   (name          nil :type (or thread-name null))
   (%alive-p      nil :type boolean)
+  (%ephemeral-p  nil :type boolean)
   (os-thread     nil :type (or integer null))
   (interruptions nil :type list)
   (result        nil :type list)
@@ -31,6 +35,21 @@ in future versions."
    :type mutex)
   waiting-for)
 
+(def!struct (foreign-thread
+             (:include thread)
+             (:conc-name "THREAD-"))
+  #!+sb-doc
+  "Type of native threads which are attached to the runtime as Lisp threads
+temporarily.")
+
+#!+(and sb-safepoint-strictly (not win32))
+(def!struct (signal-handling-thread
+             (:include foreign-thread)
+             (:conc-name "THREAD-"))
+  #!+sb-doc
+  "Asynchronous signal handling thread."
+  (signal-number nil :type integer))
+
 (def!struct mutex
   #!+sb-doc
   "Mutex type."
@@ -228,7 +247,7 @@ held mutex, WITH-RECURSIVE-LOCK allows recursive lock attempts to succeed."
 #!-sb-thread
 (progn
   (defun call-with-mutex (function mutex value waitp timeout)
-    (declare (ignore mutex value waitp timeout)
+    (declare (ignore mutex waitp timeout)
              (function function))
     (unless (or (null value) (eq *current-thread* value))
       (error "~S called with non-nil :VALUE that isn't the current thread."
@@ -236,7 +255,8 @@ held mutex, WITH-RECURSIVE-LOCK allows recursive lock attempts to succeed."
     (funcall function))
 
   (defun call-with-recursive-lock (function mutex waitp timeout)
-    (declare (ignore mutex) (function function waitp timeout))
+    (declare (ignore mutex waitp timeout)
+             (function function))
     (funcall function))
 
   (defun call-with-recursive-system-lock (function lock)